diff --git a/.gitignore b/.gitignore index 4a5972e2ef8d5e5d4b8aeeb1f88c594e00564a41..cfe191626e507468214428936ffe92a8082db4ee 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ compile_flags.txt _verif/ +*.DS_Store diff --git a/.verifyignore b/.verifyignore index 4a6b1442725e40ad5c03301ac6738fefda9d1625..4a79fcc7fadf94b8e7ea89732fd5cacffdc17c4f 100644 --- a/.verifyignore +++ b/.verifyignore @@ -11,4 +11,9 @@ # Teaching exercise skeletons — left incomplete for students to fill in, so # they are expected not to verify. strategy_demo/exercises/ -strategy_demo/examples/reverse_clean.c \ No newline at end of file +strategy_demo/examples/reverse_clean.c + +# Physical-only array examples retained as explicit migration references. +# Their assertions have the old `hprop` carrier and are intentionally not part +# of the default selected-resource regression suite. +*_legacy.c diff --git a/array/binsearch_legacy.c b/array/binsearch_legacy.c index 3bad39e85b06cad5edd42c7f44b40f48f543294d..2fcb2dd78109f6da3322b5fc393a9448cee7ac9d 100644 --- a/array/binsearch_legacy.c +++ b/array/binsearch_legacy.c @@ -169,7 +169,7 @@ int binsearch(char *a, int n, char v) PROOF { char_array_add_length(`a__pre:addr`); - add_fact_st(ispec_rule(`l:(int)list`, get_ILENGTH_NONNEG())); + add_fact_st(ispec_rule(`l:(int)list`, ILENGTH_NONNEG)); add_fact_st(int_arith_rule(` 0i <= ilength (l:(int)list) ==> ilength l == n__pre ==> 0i <= n__pre `)); diff --git a/array/clear_legacy.c b/array/clear_legacy.c index 191c27b476a03b645dc6dc608523d39c96594a79..0fef683f1fea5d4e83afa4d1735800d714117dce 100644 --- a/array/clear_legacy.c +++ b/array/clear_legacy.c @@ -1,9 +1,9 @@ #include "array/lib/array_legacy.h" #require "array/lib/array_legacy.c" -PROOF thm REPLICATE_def = get_REPLICATE(); -PROOF thm APPEND_def = get_APPEND(); -PROOF thm IREPLICATE_def = get_IREPLICATE_DEF(); +PROOF thm REPLICATE_def = HOL_REPLICATE; +PROOF thm APPEND_def = HOL_APPEND; +PROOF thm IREPLICATE_def = IREPLICATE_DEF; PROOF thm NUM_OF_INT_ADD = get_theorem_by_name("NUM_OF_INT_ADD"); PROOF thm NUM_OF_INT_OF_NUM = get_theorem_by_name("NUM_OF_INT_OF_NUM"); PROOF thm ADD1 = get_theorem_by_name("ADD1"); diff --git a/array/lib/array.c b/array/lib/array.c index 392034eb300059fd14d26d204cf23d4a90e1153a..306c50d664d45e88f3c4a0c9c5f3cad909e03617 100644 --- a/array/lib/array.c +++ b/array/lib/array.c @@ -153,7 +153,7 @@ PROOF static thm INT_INDEX_ADDRESS = prove_int_index_address(); PROOF static thm prove_char_array_open_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. + forall p:int. forall i:int. forall xs:(int)list. 0i <= i ==> i < &(LENGTH xs) ==> (char_array p xs -|- data_at (p + i * sizeof Tchar) Tchar @@ -170,7 +170,7 @@ PROOF static thm prove_char_array_open_eq(void) { ARRAY_SEG_OPEN); opened = mp_rule(opened, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `sizeof Tchar`, `i:int`), INT_INDEX_ADDRESS); + TERM_LIST(`p:int`, `sizeof Tchar`, `i:int`), INT_INDEX_ADDRESS); address = mp_rule(address, nonnegative); opened = conv_rule(rewrite_conv(THM_LIST( char_cell_def, address, get_theorem_by_name("ADD_CLAUSES"))), opened); @@ -183,7 +183,7 @@ PROOF static thm CHAR_ARRAY_OPEN_EQ = prove_char_array_open_eq(); PROOF static thm prove_char_array_close_write_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. forall v:int. + forall p:int. forall i:int. forall xs:(int)list. forall v:int. 0i <= i ==> i < &(LENGTH xs) ==> (data_at (p + i * sizeof Tchar) Tchar v ** char_focus p i xs -|- @@ -200,7 +200,7 @@ PROOF static thm prove_char_array_close_write_eq(void) { ARRAY_SEG_CLOSE_WRITE); closed = mp_rule(closed, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `sizeof Tchar`, `i:int`), INT_INDEX_ADDRESS); + TERM_LIST(`p:int`, `sizeof Tchar`, `i:int`), INT_INDEX_ADDRESS); address = mp_rule(address, nonnegative); closed = conv_rule(rewrite_conv(THM_LIST( char_cell_def, address, get_theorem_by_name("ADD_CLAUSES"))), closed); @@ -214,7 +214,7 @@ PROOF static thm CHAR_ARRAY_CLOSE_WRITE_EQ = PROOF static thm prove_int_array_open_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. + forall p:int. forall i:int. forall xs:(int)list. 0i <= i ==> i < &(LENGTH xs) ==> (int_array p xs -|- data_at (p + i * sizeof Tint) Tint @@ -231,7 +231,7 @@ PROOF static thm prove_int_array_open_eq(void) { ARRAY_SEG_OPEN); opened = mp_rule(opened, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `sizeof Tint`, `i:int`), INT_INDEX_ADDRESS); + TERM_LIST(`p:int`, `sizeof Tint`, `i:int`), INT_INDEX_ADDRESS); address = mp_rule(address, nonnegative); opened = conv_rule(rewrite_conv(THM_LIST( int_cell_def, address, get_theorem_by_name("ADD_CLAUSES"))), opened); @@ -244,7 +244,7 @@ PROOF static thm INT_ARRAY_OPEN_EQ = prove_int_array_open_eq(); PROOF static thm prove_int_array_close_write_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. forall v:int. + forall p:int. forall i:int. forall xs:(int)list. forall v:int. 0i <= i ==> i < &(LENGTH xs) ==> (data_at (p + i * sizeof Tint) Tint v ** int_focus p i xs -|- @@ -261,7 +261,7 @@ PROOF static thm prove_int_array_close_write_eq(void) { ARRAY_SEG_CLOSE_WRITE); closed = mp_rule(closed, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `sizeof Tint`, `i:int`), INT_INDEX_ADDRESS); + TERM_LIST(`p:int`, `sizeof Tint`, `i:int`), INT_INDEX_ADDRESS); address = mp_rule(address, nonnegative); closed = conv_rule(rewrite_conv(THM_LIST( int_cell_def, address, get_theorem_by_name("ADD_CLAUSES"))), closed); @@ -295,7 +295,7 @@ PROOF static thm INT_OFFSET_SUB = int_arith_rule(` PROOF static thm prove_char_seg_shift(void) { gnode root = gnode_new_with_ccl(` - forall xs:(int)list. forall p:addr. forall k j:num. + forall xs:(int)list. forall p:int. forall k j:num. array_seg (char_cell p) (k + j) xs -|- array_seg (char_cell (p + &k * sizeof Tchar)) j xs `); @@ -320,7 +320,7 @@ PROOF static thm CHAR_SEG_SHIFT = prove_char_seg_shift(); PROOF static thm prove_int_seg_shift(void) { gnode root = gnode_new_with_ccl(` - forall xs:(int)list. forall p:addr. forall k j:num. + forall xs:(int)list. forall p:int. forall k j:num. array_seg (int_cell p) (k + j) xs -|- array_seg (int_cell (p + &k * sizeof Tint)) j xs `); @@ -345,13 +345,13 @@ PROOF static thm INT_SEG_SHIFT = prove_int_seg_shift(); PROOF static thm prove_char_seg_rebase(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall s:num. forall xs:(int)list. + forall p:int. forall s:num. forall xs:(int)list. array_seg (char_cell p) s xs -|- char_array (p + &s * sizeof Tchar) xs `); gnode g = AUTO_INTROS_TAC(root); thm shifted = ispecl_rule( - TERM_LIST(`xs:(int)list`, `p:addr`, `s:num`, `0:num`), + TERM_LIST(`xs:(int)list`, `p:int`, `s:num`, `0:num`), CHAR_SEG_SHIFT); shifted = conv_rule(rewrite_conv(THM_LIST( get_theorem_by_name("ADD_CLAUSES"))), shifted); @@ -364,13 +364,13 @@ PROOF static thm CHAR_SEG_REBASE = prove_char_seg_rebase(); PROOF static thm prove_int_seg_rebase(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall s:num. forall xs:(int)list. + forall p:int. forall s:num. forall xs:(int)list. array_seg (int_cell p) s xs -|- int_array (p + &s * sizeof Tint) xs `); gnode g = AUTO_INTROS_TAC(root); thm shifted = ispecl_rule( - TERM_LIST(`xs:(int)list`, `p:addr`, `s:num`, `0:num`), + TERM_LIST(`xs:(int)list`, `p:int`, `s:num`, `0:num`), INT_SEG_SHIFT); shifted = conv_rule(rewrite_conv(THM_LIST( get_theorem_by_name("ADD_CLAUSES"))), shifted); @@ -381,9 +381,135 @@ PROOF static thm prove_int_seg_rebase(void) { PROOF static thm INT_SEG_REBASE = prove_int_seg_rebase(); +PROOF static thm prove_undef_char_seg_shift(void) { + gnode root = gnode_new_with_ccl(` + forall n:num. forall p:int. forall k j:num. + undef_seg (undef_char_cell p) (k + j) n -|- + undef_seg (undef_char_cell (p + &k * sizeof Tchar)) j n + `); + gnode body = GEN_TAC(root, "n"); + gnode_list cases = INDUCT_TAC(body, `n:num`); + + gnode base = AUTO_INTROS_TAC(cases[0]); + CONV_TAC(base, rewrite_conv(THM_LIST(undef_seg_def))); + + gnode step = AUTO_INTROS_TAC(cases[1]); + thm suc_offset = arith_rule(`SUC (k + j) = k + SUC j`); + CONV_WITH_ASMP_TAC(step, rewrite_conv, THM_LIST( + undef_seg_def, + undef_char_cell_def, + suc_offset, + gsym_rule(get_theorem_by_name("INT_OF_NUM_ADD")), + INT_OFFSET_ADD)); + return gnode_prove(root); +} + +PROOF static thm UNDEF_CHAR_SEG_SHIFT = + prove_undef_char_seg_shift(); + +PROOF static thm prove_undef_char_seg_rebase(void) { + gnode root = gnode_new_with_ccl(` + forall p:int. forall s n:num. + undef_seg (undef_char_cell p) s n -|- + undef_seg + (undef_char_cell (p + &s * sizeof Tchar)) + 0 n + `); + gnode g = AUTO_INTROS_TAC(root); + thm shifted = ispecl_rule( + TERM_LIST(`n:num`, `p:int`, `s:num`, `0:num`), + UNDEF_CHAR_SEG_SHIFT); + shifted = conv_rule(rewrite_conv(THM_LIST( + get_theorem_by_name("ADD_CLAUSES"))), shifted); + ACCEPT_TAC(g, shifted); + return gnode_prove(root); +} + +PROOF static thm UNDEF_CHAR_SEG_REBASE = + prove_undef_char_seg_rebase(); + +PROOF static thm prove_num_of_int_sub(void) { + gnode root = gnode_new_with_ccl(` + forall n k:int. + 0i <= n ==> 0i <= k ==> k <= n ==> + num_of_int n - num_of_int k = num_of_int (n - k) + `); + gnode g = AUTO_INTROS_TAC(root); + thm n_nonnegative = assume_rule(`0i <= n`); + thm k_nonnegative = assume_rule(`0i <= k`); + thm order = assume_rule(`k <= n`); + thm natural_order = num_of_int_le_rule( + `k:int`, `n:int`, k_nonnegative, n_nonnegative, order); + thm cast_sub = mp_rule( + ispecl_rule( + TERM_LIST(`num_of_int k`, `num_of_int n`), + get_theorem_by_name("INT_OF_NUM_SUB")), + natural_order); + thm n_roundtrip = int_of_num_of_int_rule(`n:int`, n_nonnegative); + thm k_roundtrip = int_of_num_of_int_rule(`k:int`, k_nonnegative); + cast_sub = conv_rule(once_rewrite_conv(THM_LIST( + n_roundtrip, k_roundtrip)), cast_sub); + thm decoded = ap_term_rule(`num_of_int:int->num`, cast_sub); + decoded = conv_rule(rewrite_conv(THM_LIST( + get_theorem_by_name("NUM_OF_INT_OF_NUM"))), decoded); + ACCEPT_TAC(g, sym_rule(decoded)); + return gnode_prove(root); +} + +PROOF static thm NUM_OF_INT_SUB_NONNEG = + prove_num_of_int_sub(); + +PROOF static thm prove_undef_char_array_split_eq(void) { + gnode root = gnode_new_with_ccl(` + forall p:int. forall n k:int. + 0i <= n ==> 0i <= k ==> k <= n ==> + (undef_char_array p n -|- + undef_char_array p k ** + undef_char_array (p + k * sizeof Tchar) (n - k)) + `); + gnode g = AUTO_INTROS_TAC(root); + thm n_nonnegative = assume_rule(`0i <= n`); + thm k_nonnegative = assume_rule(`0i <= k`); + thm order = assume_rule(`k <= n`); + thm natural_order = num_of_int_le_rule( + `k:int`, `n:int`, k_nonnegative, n_nonnegative, order); + thm split = ispecl_rule( + TERM_LIST(`undef_char_cell p`, `0:num`, + `num_of_int n`, `num_of_int k`), + UNDEF_SEG_SPLIT); + split = mp_rule(split, natural_order); + thm k_roundtrip = int_of_num_of_int_rule(`k:int`, k_nonnegative); + thm count_sub = ispecl_rule( + TERM_LIST(`n:int`, `k:int`), NUM_OF_INT_SUB_NONNEG); + count_sub = mp_rule(mp_rule(mp_rule( + count_sub, n_nonnegative), k_nonnegative), order); + thm remaining_nonnegative = match_mp_rule( + int_arith_rule(`forall n k:int. k <= n ==> 0i <= n - k`), + order); + split = conv_rule( + rand_conv(rand_conv( + once_rewrite_conv(THM_LIST(UNDEF_CHAR_SEG_REBASE)))), + split); + split = conv_rule(rewrite_conv(THM_LIST( + count_sub, + k_roundtrip, + get_theorem_by_name("ADD_CLAUSES"))), split); + g = CONV_WITH_ASMP_TAC(g, simp_conv, THM_LIST( + undef_char_array_def, + split, + remaining_nonnegative, + sl_fact_true_emp(), + sl_sep_emp_left(), + sl_sep_emp_right())); + return gnode_prove(root); +} + +PROOF static thm UNDEF_CHAR_ARRAY_SPLIT_EQ = + prove_undef_char_array_split_eq(); + PROOF static thm prove_char_array_append_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall xs ys:(int)list. + forall p:int. forall xs ys:(int)list. char_array p (xs ++ ys) -|- char_array p xs ** char_array (p + &(LENGTH xs) * sizeof Tchar) ys @@ -405,7 +531,7 @@ PROOF static thm CHAR_ARRAY_APPEND_EQ = prove_char_array_append_eq(); PROOF static thm prove_int_array_append_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall xs ys:(int)list. + forall p:int. forall xs ys:(int)list. int_array p (xs ++ ys) -|- int_array p xs ** int_array (p + &(LENGTH xs) * sizeof Tint) ys @@ -427,7 +553,7 @@ PROOF static thm INT_ARRAY_APPEND_EQ = prove_int_array_append_eq(); PROOF static thm prove_char_array_split_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. + forall p:int. forall i:int. forall xs:(int)list. 0i <= i ==> i <= &(LENGTH xs) ==> (char_array p xs -|- char_array p (list_take (num_of_int i) xs) ** @@ -444,7 +570,7 @@ PROOF static thm prove_char_array_split_eq(void) { ARRAY_SEG_SPLIT); split = mp_rule(split, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `sizeof Tchar`, `i:int`), INT_INDEX_ADDRESS); + TERM_LIST(`p:int`, `sizeof Tchar`, `i:int`), INT_INDEX_ADDRESS); address = mp_rule(address, nonnegative); split = conv_rule(rewrite_conv(THM_LIST( CHAR_SEG_REBASE, @@ -460,7 +586,7 @@ PROOF static thm CHAR_ARRAY_SPLIT_EQ = prove_char_array_split_eq(); PROOF static thm prove_int_array_split_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. + forall p:int. forall i:int. forall xs:(int)list. 0i <= i ==> i <= &(LENGTH xs) ==> (int_array p xs -|- int_array p (list_take (num_of_int i) xs) ** @@ -477,7 +603,7 @@ PROOF static thm prove_int_array_split_eq(void) { ARRAY_SEG_SPLIT); split = mp_rule(split, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `sizeof Tint`, `i:int`), INT_INDEX_ADDRESS); + TERM_LIST(`p:int`, `sizeof Tint`, `i:int`), INT_INDEX_ADDRESS); address = mp_rule(address, nonnegative); split = conv_rule(rewrite_conv(THM_LIST( INT_SEG_REBASE, @@ -535,7 +661,7 @@ PROOF static thm prove_split_right_endpoint(void) { cast_sub = mp_rule(cast_sub, index_bound); thm cast = int_of_num_of_int_rule(`i:int`, nonnegative); thm drop_cast = list_trans_rule(THM_LIST( - ap_term_rule(`int_of_num`, drop_length), + ap_term_rule(`int_of_num:num->int`, drop_length), gsym_rule(cast_sub), beta_rule(ap_term_rule( `\z:int. &(LENGTH (xs:(int)list)) - z`, cast)))); @@ -575,7 +701,7 @@ PROOF static thm open_char_array_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), CHAR_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -585,7 +711,7 @@ PROOF static thm open_char_array_operation_proof(const term goal_tm) { } decl_operation(open_char_array_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), term_list_n(1, `char_array (KEY p) (CAPTURE xs)`), TERM_LIST(`0i <= i`, `i < &(LENGTH (xs:(int)list))`), `data_at (p + i * sizeof Tchar) Tchar @@ -601,7 +727,7 @@ PROOF static thm close_char_array_read_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), CHAR_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -617,7 +743,7 @@ PROOF static thm close_char_array_read_operation_proof(const term goal_tm) { } decl_operation(close_char_array_read_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `char_focus (KEY p) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tchar)) Tchar @@ -635,7 +761,7 @@ PROOF static thm close_char_array_write_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm closed = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`, `v:int`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`, `v:int`), CHAR_ARRAY_CLOSE_WRITE_EQ); closed = mp_rule(closed, assume_rule(`0i <= i`)); closed = mp_rule(closed, @@ -650,7 +776,7 @@ PROOF static thm close_char_array_write_operation_proof(const term goal_tm) { } decl_operation(close_char_array_write_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `char_focus (KEY p) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tchar)) Tchar (CAPTURE v)` @@ -667,7 +793,7 @@ PROOF static thm open_int_array_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), INT_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -677,7 +803,7 @@ PROOF static thm open_int_array_operation_proof(const term goal_tm) { } decl_operation(open_int_array_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), term_list_n(1, `int_array (KEY p) (CAPTURE xs)`), TERM_LIST(`0i <= i`, `i < &(LENGTH (xs:(int)list))`), `data_at (p + i * sizeof Tint) Tint @@ -693,7 +819,7 @@ PROOF static thm close_int_array_read_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), INT_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -709,7 +835,7 @@ PROOF static thm close_int_array_read_operation_proof(const term goal_tm) { } decl_operation(close_int_array_read_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `int_focus (KEY p) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tint)) Tint @@ -727,7 +853,7 @@ PROOF static thm close_int_array_write_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm closed = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`, `v:int`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`, `v:int`), INT_ARRAY_CLOSE_WRITE_EQ); closed = mp_rule(closed, assume_rule(`0i <= i`)); closed = mp_rule(closed, @@ -742,7 +868,7 @@ PROOF static thm close_int_array_write_operation_proof(const term goal_tm) { } decl_operation(close_int_array_write_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `int_focus (KEY p) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tint)) Tint (CAPTURE v)` @@ -760,7 +886,7 @@ PROOF void close_int_array_write(const term p, const term i) { PROOF static thm prove_char_span_open_eq(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall i:int. forall xs:(int)list. + forall p q:int. forall i:int. forall xs:(int)list. 0i <= i ==> i < &(LENGTH xs) ==> (char_span p q xs -|- data_at (p + i * sizeof Tchar) Tchar @@ -769,7 +895,7 @@ PROOF static thm prove_char_span_open_eq(void) { `); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), CHAR_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -796,7 +922,7 @@ PROOF static thm CHAR_SPAN_OPEN_EQ = prove_char_span_open_eq(); PROOF static thm prove_char_span_close_write_eq(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall i:int. forall xs:(int)list. forall v:int. + forall p q:int. forall i:int. forall xs:(int)list. forall v:int. 0i <= i ==> i < &(LENGTH xs) ==> (data_at (p + i * sizeof Tchar) Tchar v ** char_span_focus p q i xs -|- @@ -804,7 +930,7 @@ PROOF static thm prove_char_span_close_write_eq(void) { `); gnode g = AUTO_INTROS_TAC(root); thm closed = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`, `v:int`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`, `v:int`), CHAR_ARRAY_CLOSE_WRITE_EQ); closed = mp_rule(closed, assume_rule(`0i <= i`)); closed = mp_rule(closed, @@ -823,7 +949,7 @@ PROOF static thm prove_char_span_close_write_eq(void) { thm reorder = acu_slrule( dest_sl_eq(concl(lhs_expanded)).tm2, framed_cell); thm framed_closed = beta_rule(ap_term_rule(` - \h:hprop. + \h:cprop. fact(q = p + &(LENGTH (xs:(int)list)) * sizeof Tchar) ** h `, closed)); thm rhs_expanded = apply_conversion(rewrite_conv(THM_LIST( @@ -841,7 +967,7 @@ PROOF static thm CHAR_SPAN_CLOSE_WRITE_EQ = PROOF static thm prove_int_span_open_eq(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall i:int. forall xs:(int)list. + forall p q:int. forall i:int. forall xs:(int)list. 0i <= i ==> i < &(LENGTH xs) ==> (int_span p q xs -|- data_at (p + i * sizeof Tint) Tint @@ -850,7 +976,7 @@ PROOF static thm prove_int_span_open_eq(void) { `); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), INT_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -877,7 +1003,7 @@ PROOF static thm INT_SPAN_OPEN_EQ = prove_int_span_open_eq(); PROOF static thm prove_int_span_close_write_eq(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall i:int. forall xs:(int)list. forall v:int. + forall p q:int. forall i:int. forall xs:(int)list. forall v:int. 0i <= i ==> i < &(LENGTH xs) ==> (data_at (p + i * sizeof Tint) Tint v ** int_span_focus p q i xs -|- @@ -885,7 +1011,7 @@ PROOF static thm prove_int_span_close_write_eq(void) { `); gnode g = AUTO_INTROS_TAC(root); thm closed = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`, `v:int`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`, `v:int`), INT_ARRAY_CLOSE_WRITE_EQ); closed = mp_rule(closed, assume_rule(`0i <= i`)); closed = mp_rule(closed, @@ -904,7 +1030,7 @@ PROOF static thm prove_int_span_close_write_eq(void) { thm reorder = acu_slrule( dest_sl_eq(concl(lhs_expanded)).tm2, framed_cell); thm framed_closed = beta_rule(ap_term_rule(` - \h:hprop. + \h:cprop. fact(q = p + &(LENGTH (xs:(int)list)) * sizeof Tint) ** h `, closed)); thm rhs_expanded = apply_conversion(rewrite_conv(THM_LIST( @@ -926,7 +1052,7 @@ PROOF static thm INT_SPAN_CLOSE_WRITE_EQ = */ PROOF static thm prove_char_span_split_eq(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall xs:(int)list. forall k:int. + forall p q:int. forall xs:(int)list. forall k:int. 0i <= k ==> k <= &(LENGTH xs) ==> (char_span p q xs -|- char_span p (p + k * sizeof Tchar) @@ -938,15 +1064,15 @@ PROOF static thm prove_char_span_split_eq(void) { thm nonnegative = assume_rule(`0i <= k`); thm upper = assume_rule(`k <= &(LENGTH (xs:(int)list))`); thm split = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `xs:(int)list`), CHAR_ARRAY_SPLIT_EQ); split = mp_rule(mp_rule(split, nonnegative), upper); thm left_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tchar`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tchar`, `xs:(int)list`), SPLIT_LEFT_ENDPOINT); left_endpoint = mp_rule(mp_rule(left_endpoint, nonnegative), upper); thm right_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tchar`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tchar`, `xs:(int)list`), SPLIT_RIGHT_ENDPOINT); right_endpoint = mp_rule(mp_rule(right_endpoint, nonnegative), upper); @@ -954,7 +1080,7 @@ PROOF static thm prove_char_span_split_eq(void) { split = conv_rule( once_rewrite_conv(THM_LIST(left_endpoint)), split); thm framed_split = beta_rule(ap_term_rule(` - \h:hprop. + \h:cprop. fact(q = p + &(LENGTH (xs:(int)list)) * sizeof Tchar) ** h `, split)); @@ -997,7 +1123,7 @@ PROOF static thm CHAR_SPAN_SPLIT_EQ = prove_char_span_split_eq(); PROOF static thm prove_int_span_split_eq(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall xs:(int)list. forall k:int. + forall p q:int. forall xs:(int)list. forall k:int. 0i <= k ==> k <= &(LENGTH xs) ==> (int_span p q xs -|- int_span p (p + k * sizeof Tint) @@ -1009,22 +1135,22 @@ PROOF static thm prove_int_span_split_eq(void) { thm nonnegative = assume_rule(`0i <= k`); thm upper = assume_rule(`k <= &(LENGTH (xs:(int)list))`); thm split = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `xs:(int)list`), INT_ARRAY_SPLIT_EQ); split = mp_rule(mp_rule(split, nonnegative), upper); thm left_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tint`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tint`, `xs:(int)list`), SPLIT_LEFT_ENDPOINT); left_endpoint = mp_rule(mp_rule(left_endpoint, nonnegative), upper); thm right_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tint`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tint`, `xs:(int)list`), SPLIT_RIGHT_ENDPOINT); right_endpoint = mp_rule(mp_rule(right_endpoint, nonnegative), upper); split = conv_rule( once_rewrite_conv(THM_LIST(left_endpoint)), split); thm framed_split = beta_rule(ap_term_rule(` - \h:hprop. + \h:cprop. fact(q = p + &(LENGTH (xs:(int)list)) * sizeof Tint) ** h `, split)); @@ -1071,15 +1197,15 @@ PROOF static thm split_char_array_operation_proof(const term goal_tm) { thm nonnegative = assume_rule(`0i <= k`); thm upper = assume_rule(`k <= &(LENGTH (xs:(int)list))`); thm split = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `xs:(int)list`), CHAR_ARRAY_SPLIT_EQ); split = mp_rule(mp_rule(split, nonnegative), upper); thm left_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tchar`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tchar`, `xs:(int)list`), SPLIT_LEFT_ENDPOINT); left_endpoint = mp_rule(mp_rule(left_endpoint, nonnegative), upper); thm right_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tchar`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tchar`, `xs:(int)list`), SPLIT_RIGHT_ENDPOINT); right_endpoint = mp_rule(mp_rule(right_endpoint, nonnegative), upper); split = conv_rule(once_rewrite_conv( @@ -1105,7 +1231,7 @@ PROOF static thm split_char_array_operation_proof(const term goal_tm) { } decl_operation(split_char_array_operation, - TERM_LIST(`p:addr`, `k:int`), + TERM_LIST(`p:int`, `k:int`), term_list_n(1, `char_array (KEY p) (CAPTURE xs)`), TERM_LIST(`0i <= k`, `k <= &(LENGTH (xs:(int)list))`), `char_span p (p + k * sizeof Tchar) @@ -1124,7 +1250,7 @@ PROOF static thm split_char_span_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm split = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `xs:(int)list`, `k:int`), + TERM_LIST(`p:int`, `q:int`, `xs:(int)list`, `k:int`), CHAR_SPAN_SPLIT_EQ); split = mp_rule(split, assume_rule(`0i <= k`)); split = mp_rule( @@ -1134,7 +1260,7 @@ PROOF static thm split_char_span_operation_proof( } decl_operation(split_char_span_operation, - TERM_LIST(`p:addr`, `q:addr`, `k:int`), + TERM_LIST(`p:int`, `q:int`, `k:int`), term_list_n(1, `char_span (KEY p) (KEY q) (CAPTURE xs)`), TERM_LIST(`0i <= k`, `k <= &(LENGTH (xs:(int)list))`), `char_span p (p + k * sizeof Tchar) @@ -1152,7 +1278,7 @@ PROOF static thm open_char_span_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `q:int`, `i:int`, `xs:(int)list`), CHAR_SPAN_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -1162,7 +1288,7 @@ PROOF static thm open_char_span_operation_proof(const term goal_tm) { } decl_operation(open_char_span_operation, - TERM_LIST(`p:addr`, `q:addr`, `i:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`), term_list_n(1, `char_span (KEY p) (KEY q) (CAPTURE xs)`), TERM_LIST(`0i <= i`, `i < &(LENGTH (xs:(int)list))`), `data_at (p + i * sizeof Tchar) Tchar @@ -1178,7 +1304,7 @@ PROOF static thm close_char_span_read_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `q:int`, `i:int`, `xs:(int)list`), CHAR_SPAN_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -1194,7 +1320,7 @@ PROOF static thm close_char_span_read_operation_proof(const term goal_tm) { } decl_operation(close_char_span_read_operation, - TERM_LIST(`p:addr`, `q:addr`, `i:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`), TERM_LIST( `char_span_focus (KEY p) (KEY q) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tchar)) Tchar @@ -1213,7 +1339,7 @@ PROOF static thm close_char_span_write_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm closed = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `i:int`, `xs:(int)list`, `v:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`, `xs:(int)list`, `v:int`), CHAR_SPAN_CLOSE_WRITE_EQ); closed = mp_rule(closed, assume_rule(`0i <= i`)); closed = mp_rule(closed, @@ -1228,7 +1354,7 @@ PROOF static thm close_char_span_write_operation_proof(const term goal_tm) { } decl_operation(close_char_span_write_operation, - TERM_LIST(`p:addr`, `q:addr`, `i:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`), TERM_LIST( `char_span_focus (KEY p) (KEY q) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tchar)) Tchar (CAPTURE v)` @@ -1255,12 +1381,12 @@ PROOF static thm join_char_spans_operation_proof(const term goal_tm) { thm right_endpoint = assume_rule( `r = q + &(LENGTH (ys:(int)list)) * sizeof Tchar`); thm endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `r:addr`, `sizeof Tchar`, + TERM_LIST(`p:int`, `q:int`, `r:int`, `sizeof Tchar`, `xs:(int)list`, `ys:(int)list`), APPEND_ENDPOINT); endpoint = mp_rule(mp_rule(endpoint, left_endpoint), right_endpoint); thm appended = ispecl_rule( - TERM_LIST(`p:addr`, `xs:(int)list`, `ys:(int)list`), + TERM_LIST(`p:int`, `xs:(int)list`, `ys:(int)list`), CHAR_ARRAY_APPEND_EQ); appended = conv_rule(once_rewrite_conv( THM_LIST(gsym_rule(left_endpoint))), appended); @@ -1275,7 +1401,7 @@ PROOF static thm join_char_spans_operation_proof(const term goal_tm) { } decl_operation(join_char_spans_operation, - TERM_LIST(`p:addr`, `q:addr`), + TERM_LIST(`p:int`, `q:int`), TERM_LIST( `char_span (KEY p) (KEY q) (CAPTURE xs)`, `char_span (KEY q) (CAPTURE r) (CAPTURE ys)` @@ -1296,7 +1422,7 @@ PROOF static thm forget_char_span_operation_proof(const term goal_tm) { } decl_operation(forget_char_span_operation, - TERM_LIST(`p:addr`, `q:addr`), + TERM_LIST(`p:int`, `q:int`), term_list_n(1, `char_span (KEY p) (KEY q) (CAPTURE xs)`), term_list_n(0), `char_array p xs` @@ -1313,15 +1439,15 @@ PROOF static thm split_int_array_operation_proof(const term goal_tm) { thm nonnegative = assume_rule(`0i <= k`); thm upper = assume_rule(`k <= &(LENGTH (xs:(int)list))`); thm split = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `xs:(int)list`), INT_ARRAY_SPLIT_EQ); split = mp_rule(mp_rule(split, nonnegative), upper); thm left_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tint`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tint`, `xs:(int)list`), SPLIT_LEFT_ENDPOINT); left_endpoint = mp_rule(mp_rule(left_endpoint, nonnegative), upper); thm right_endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `sizeof Tint`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `sizeof Tint`, `xs:(int)list`), SPLIT_RIGHT_ENDPOINT); right_endpoint = mp_rule(mp_rule(right_endpoint, nonnegative), upper); split = conv_rule(once_rewrite_conv( @@ -1347,7 +1473,7 @@ PROOF static thm split_int_array_operation_proof(const term goal_tm) { } decl_operation(split_int_array_operation, - TERM_LIST(`p:addr`, `k:int`), + TERM_LIST(`p:int`, `k:int`), term_list_n(1, `int_array (KEY p) (CAPTURE xs)`), TERM_LIST(`0i <= k`, `k <= &(LENGTH (xs:(int)list))`), `int_span p (p + k * sizeof Tint) @@ -1366,7 +1492,7 @@ PROOF static thm split_int_span_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm split = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `xs:(int)list`, `k:int`), + TERM_LIST(`p:int`, `q:int`, `xs:(int)list`, `k:int`), INT_SPAN_SPLIT_EQ); split = mp_rule(split, assume_rule(`0i <= k`)); split = mp_rule( @@ -1376,7 +1502,7 @@ PROOF static thm split_int_span_operation_proof( } decl_operation(split_int_span_operation, - TERM_LIST(`p:addr`, `q:addr`, `k:int`), + TERM_LIST(`p:int`, `q:int`, `k:int`), term_list_n(1, `int_span (KEY p) (KEY q) (CAPTURE xs)`), TERM_LIST(`0i <= k`, `k <= &(LENGTH (xs:(int)list))`), `int_span p (p + k * sizeof Tint) @@ -1394,7 +1520,7 @@ PROOF static thm open_int_span_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `q:int`, `i:int`, `xs:(int)list`), INT_SPAN_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -1404,7 +1530,7 @@ PROOF static thm open_int_span_operation_proof(const term goal_tm) { } decl_operation(open_int_span_operation, - TERM_LIST(`p:addr`, `q:addr`, `i:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`), term_list_n(1, `int_span (KEY p) (KEY q) (CAPTURE xs)`), TERM_LIST(`0i <= i`, `i < &(LENGTH (xs:(int)list))`), `data_at (p + i * sizeof Tint) Tint @@ -1420,7 +1546,7 @@ PROOF static thm close_int_span_read_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `q:int`, `i:int`, `xs:(int)list`), INT_SPAN_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -1436,7 +1562,7 @@ PROOF static thm close_int_span_read_operation_proof(const term goal_tm) { } decl_operation(close_int_span_read_operation, - TERM_LIST(`p:addr`, `q:addr`, `i:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`), TERM_LIST( `int_span_focus (KEY p) (KEY q) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tint)) Tint @@ -1455,7 +1581,7 @@ PROOF static thm close_int_span_write_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm closed = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `i:int`, `xs:(int)list`, `v:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`, `xs:(int)list`, `v:int`), INT_SPAN_CLOSE_WRITE_EQ); closed = mp_rule(closed, assume_rule(`0i <= i`)); closed = mp_rule(closed, @@ -1470,7 +1596,7 @@ PROOF static thm close_int_span_write_operation_proof(const term goal_tm) { } decl_operation(close_int_span_write_operation, - TERM_LIST(`p:addr`, `q:addr`, `i:int`), + TERM_LIST(`p:int`, `q:int`, `i:int`), TERM_LIST( `int_span_focus (KEY p) (KEY q) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tint)) Tint (CAPTURE v)` @@ -1497,12 +1623,12 @@ PROOF static thm join_int_spans_operation_proof(const term goal_tm) { thm right_endpoint = assume_rule( `r = q + &(LENGTH (ys:(int)list)) * sizeof Tint`); thm endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `q:addr`, `r:addr`, `sizeof Tint`, + TERM_LIST(`p:int`, `q:int`, `r:int`, `sizeof Tint`, `xs:(int)list`, `ys:(int)list`), APPEND_ENDPOINT); endpoint = mp_rule(mp_rule(endpoint, left_endpoint), right_endpoint); thm appended = ispecl_rule( - TERM_LIST(`p:addr`, `xs:(int)list`, `ys:(int)list`), + TERM_LIST(`p:int`, `xs:(int)list`, `ys:(int)list`), INT_ARRAY_APPEND_EQ); appended = conv_rule(once_rewrite_conv( THM_LIST(gsym_rule(left_endpoint))), appended); @@ -1517,7 +1643,7 @@ PROOF static thm join_int_spans_operation_proof(const term goal_tm) { } decl_operation(join_int_spans_operation, - TERM_LIST(`p:addr`, `q:addr`), + TERM_LIST(`p:int`, `q:int`), TERM_LIST( `int_span (KEY p) (KEY q) (CAPTURE xs)`, `int_span (KEY q) (CAPTURE r) (CAPTURE ys)` @@ -1538,7 +1664,7 @@ PROOF static thm forget_int_span_operation_proof(const term goal_tm) { } decl_operation(forget_int_span_operation, - TERM_LIST(`p:addr`, `q:addr`), + TERM_LIST(`p:int`, `q:int`), term_list_n(1, `int_span (KEY p) (KEY q) (CAPTURE xs)`), term_list_n(0), `int_array p xs` @@ -1553,7 +1679,7 @@ PROOF void forget_int_span(const term p, const term q) { PROOF static thm prove_char_fill_begin_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall n:num. + forall p:int. forall n:num. undef_seg (undef_char_cell p) 0 n -|- fill_cursor (char_cell p) (undef_char_cell p) 0 [] n `); @@ -1569,7 +1695,7 @@ PROOF static thm CHAR_FILL_BEGIN_EQ = prove_char_fill_begin_eq(); PROOF static thm prove_int_fill_begin_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall n:num. + forall p:int. forall n:num. undef_seg (undef_int_cell p) 0 n -|- fill_cursor (int_cell p) (undef_int_cell p) 0 [] n `); @@ -1594,7 +1720,7 @@ PROOF static thm begin_char_fill_operation_proof(const term goal_tm) { } decl_operation(begin_char_fill_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `undef_char_array (KEY p) (CAPTURE n)`), term_list_n(0), `char_fill p [] (num_of_int n)` @@ -1618,7 +1744,7 @@ PROOF static thm open_char_fill_operation_proof(const term goal_tm) { } decl_operation(open_char_fill_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), term_list_n(1, `char_fill (KEY p) (CAPTURE xs) (SUC (CAPTURE remaining))`), term_list_n(1, `i = &(LENGTH (xs:(int)list))`), @@ -1644,7 +1770,7 @@ PROOF static thm close_char_fill_operation_proof(const term goal_tm) { } decl_operation(close_char_fill_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `char_fill_focus (KEY p) (CAPTURE xs) (CAPTURE remaining)`, `data_at (KEY (p + i * sizeof Tchar)) Tchar (CAPTURE v)` @@ -1668,7 +1794,7 @@ PROOF static thm finish_char_fill_operation_proof(const term goal_tm) { } decl_operation(finish_char_fill_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `char_fill (KEY p) (CAPTURE xs) 0`), term_list_n(0), `char_array p xs` @@ -1678,6 +1804,33 @@ PROOF void finish_char_fill(const term p) { apply_operation_st(finish_char_fill_operation, TERM_LIST(p)); } +PROOF static thm split_undef_char_array_operation_proof( + const term goal_tm) { + gnode root = gnode_new_with_ccl(goal_tm); + gnode g = AUTO_INTROS_TAC(root); + thm split = ispecl_rule( + TERM_LIST(`p:int`, `n:int`, `k:int`), + UNDEF_CHAR_ARRAY_SPLIT_EQ); + split = mp_rule(split, assume_rule(`0i <= n`)); + split = mp_rule(split, assume_rule(`0i <= k`)); + split = mp_rule(split, assume_rule(`k <= n`)); + ACCEPT_TAC(g, eq2ent(split)); + return gnode_prove(root); +} + +decl_operation(split_undef_char_array_operation, + TERM_LIST(`p:int`, `k:int`), + term_list_n(1, `undef_char_array (KEY p) (CAPTURE n)`), + TERM_LIST(`0i <= n`, `0i <= k`, `k <= n`), + `undef_char_array p k ** + undef_char_array (p + k * sizeof Tchar) (n - k)` +) + +PROOF void split_undef_char_array(const term p, const term k) { + apply_operation_st( + split_undef_char_array_operation, TERM_LIST(p, k)); +} + PROOF static thm begin_int_fill_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = CONV_TAC(root, simp_conv(THM_LIST( @@ -1689,7 +1842,7 @@ PROOF static thm begin_int_fill_operation_proof(const term goal_tm) { } decl_operation(begin_int_fill_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `undef_int_array (KEY p) (CAPTURE n)`), term_list_n(0), `int_fill p [] (num_of_int n)` @@ -1713,7 +1866,7 @@ PROOF static thm open_int_fill_operation_proof(const term goal_tm) { } decl_operation(open_int_fill_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), term_list_n(1, `int_fill (KEY p) (CAPTURE xs) (SUC (CAPTURE remaining))`), term_list_n(1, `i = &(LENGTH (xs:(int)list))`), @@ -1739,7 +1892,7 @@ PROOF static thm close_int_fill_operation_proof(const term goal_tm) { } decl_operation(close_int_fill_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `int_fill_focus (KEY p) (CAPTURE xs) (CAPTURE remaining)`, `data_at (KEY (p + i * sizeof Tint)) Tint (CAPTURE v)` @@ -1763,7 +1916,7 @@ PROOF static thm finish_int_fill_operation_proof(const term goal_tm) { } decl_operation(finish_int_fill_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `int_fill (KEY p) (CAPTURE xs) 0`), term_list_n(0), `int_array p xs` @@ -1813,6 +1966,10 @@ PROOF static int audit_concrete_arrays(void) { INT_SEG_SHIFT, CHAR_SEG_REBASE, INT_SEG_REBASE, + UNDEF_CHAR_SEG_SHIFT, + UNDEF_CHAR_SEG_REBASE, + NUM_OF_INT_SUB_NONNEG, + UNDEF_CHAR_ARRAY_SPLIT_EQ, CHAR_ARRAY_APPEND_EQ, INT_ARRAY_APPEND_EQ, CHAR_ARRAY_SPLIT_EQ, @@ -1846,6 +2003,7 @@ PROOF static int audit_concrete_arrays(void) { open_char_fill_operation.lemma, close_char_fill_operation.lemma, finish_char_fill_operation.lemma, + split_undef_char_array_operation.lemma, begin_int_fill_operation.lemma, open_int_fill_operation.lemma, close_int_fill_operation.lemma, @@ -1896,20 +2054,20 @@ PROOF int install_array_qcp_interface(void) { `APPEND:(int)list->(int)list->(int)list`, `LENGTH:(int)list->num`, `EL:num->(int)list->int`, `REPLICATE:num->int->(int)list`, - `char_array:addr->(int)list->hprop`, - `int_array:addr->(int)list->hprop`, - `char_focus:addr->int->(int)list->hprop`, - `int_focus:addr->int->(int)list->hprop`, - `char_span:addr->addr->(int)list->hprop`, - `int_span:addr->addr->(int)list->hprop`, - `char_span_focus:addr->addr->int->(int)list->hprop`, - `int_span_focus:addr->addr->int->(int)list->hprop`, - `undef_char_array:addr->int->hprop`, - `undef_int_array:addr->int->hprop`, - `char_fill:addr->(int)list->num->hprop`, - `int_fill:addr->(int)list->num->hprop`, - `char_fill_focus:addr->(int)list->num->hprop`, - `int_fill_focus:addr->(int)list->num->hprop`)) == 0, + `char_array:int->(int)list->cprop`, + `int_array:int->(int)list->cprop`, + `char_focus:int->int->(int)list->cprop`, + `int_focus:int->int->(int)list->cprop`, + `char_span:int->int->(int)list->cprop`, + `int_span:int->int->(int)list->cprop`, + `char_span_focus:int->int->int->(int)list->cprop`, + `int_span_focus:int->int->int->(int)list->cprop`, + `undef_char_array:int->int->cprop`, + `undef_int_array:int->int->cprop`, + `char_fill:int->(int)list->num->cprop`, + `int_fill:int->(int)list->num->cprop`, + `char_fill_focus:int->(int)list->num->cprop`, + `int_fill_focus:int->(int)list->num->cprop`)) == 0, "Failed to install the array QCP interface"); installed = true; diff --git a/array/lib/array.h b/array/lib/array.h index 65d522149b88235ca72329602057d6bb27b01e69..001c85efc203933ba3195b00d8ceca41a4eeda09 100644 --- a/array/lib/array.h +++ b/array/lib/array.h @@ -75,6 +75,12 @@ PROOF void open_char_fill(const term p, const term i); PROOF void close_char_fill(const term p, const term i); PROOF void finish_char_fill(const term p); +/* Split an uninitialized char array at an integer element index `k`. + * Requires top-level facts `0 <= k` and `k <= n`; preserves the two resulting + * extents as `k` and `n-k` without exposing the generic natural-index segment. + */ +PROOF void split_undef_char_array(const term p, const term k); + PROOF void begin_int_fill(const term p); PROOF void open_int_fill(const term p, const term i); PROOF void close_int_fill(const term p, const term i); diff --git a/array/lib/array_core.c b/array/lib/array_core.c index 3610bbd0572babe68b1258a9d75105e3bc09abe1..59cc35bc5741c57279459d07c937c705cd7b2c5e 100644 --- a/array/lib/array_core.c +++ b/array/lib/array_core.c @@ -42,12 +42,12 @@ PROOF thm array_seg_def = define_fresh_recursive_constant( "array_seg", get_theorem_by_name("list_RECURSION"), ` - ((array_seg:(num->A->hprop)->num->(A)list->hprop) - (P:num->A->hprop) (s:num) ([]:(A)list) -|- emp) && - ((array_seg:(num->A->hprop)->num->(A)list->hprop) + ((array_seg:(num->A->cprop)->num->(A)list->cprop) + (P:num->A->cprop) (s:num) ([]:(A)list) -|- emp) && + ((array_seg:(num->A->cprop)->num->(A)list->cprop) P s ((x:A) :: (xs:(A)list)) -|- P s x ** - (array_seg:(num->A->hprop)->num->(A)list->hprop) + (array_seg:(num->A->cprop)->num->(A)list->cprop) P (SUC s) xs) `); @@ -59,7 +59,7 @@ PROOF thm array_seg_def = define_fresh_recursive_constant( PROOF thm array_focus_def = define_fresh_function_constant( "array_focus", ` - array_focus (P:num->A->hprop) s (xs:(A)list) k -|- + array_focus (P:num->A->cprop) s (xs:(A)list) k -|- array_seg P s (list_take k xs) ** array_seg P (s + SUC k) (list_drop (SUC k) xs) `); @@ -68,7 +68,7 @@ PROOF thm undef_seg_def = define_fresh_recursive_constant( "undef_seg", get_theorem_by_name("num_RECURSION"), ` - (undef_seg (U:num->hprop) s 0 -|- emp) && + (undef_seg (U:num->cprop) s 0 -|- emp) && (undef_seg U s (SUC n) -|- U s ** undef_seg U (SUC s) n) `); @@ -80,7 +80,7 @@ PROOF thm undef_seg_def = define_fresh_recursive_constant( PROOF thm fill_cursor_def = define_fresh_function_constant( "fill_cursor", ` - fill_cursor (P:num->A->hprop) (U:num->hprop) s + fill_cursor (P:num->A->cprop) (U:num->cprop) s (xs:(A)list) remaining -|- array_seg P s xs ** undef_seg U (s + LENGTH xs) remaining @@ -90,7 +90,7 @@ PROOF thm fill_cursor_def = define_fresh_function_constant( PROOF thm fill_focus_def = define_fresh_function_constant( "fill_focus", ` - fill_focus (P:num->A->hprop) (U:num->hprop) s + fill_focus (P:num->A->cprop) (U:num->cprop) s (xs:(A)list) remaining -|- array_seg P s xs ** undef_seg U (SUC (s + LENGTH xs)) remaining @@ -100,7 +100,7 @@ PROOF thm fill_focus_def = define_fresh_function_constant( PROOF static thm prove_array_seg_append(void) { term goal_tm = ` - forall (P:num->A->hprop) (xs:(A)list) s ys. + forall (P:num->A->cprop) (xs:(A)list) s ys. array_seg P s (xs ++ ys) -|- array_seg P s xs ** array_seg P (s + LENGTH xs) ys `; @@ -111,8 +111,8 @@ PROOF static thm prove_array_seg_append(void) { g = CONV_TAC(cases[0], rewrite_conv(THM_LIST( array_seg_def, - get_APPEND(), - get_LENGTH(), + HOL_APPEND, + HOL_LENGTH, get_theorem_by_name("ADD_CLAUSES"), sl_sep_emp_left()))); @@ -120,8 +120,8 @@ PROOF static thm prove_array_seg_append(void) { gnode_get_asmps(cases[1], CONST_STRING_LIST("H"))[0]); g = CONV_TAC(cases[1], rewrite_conv(THM_LIST( array_seg_def, - get_APPEND(), - get_LENGTH(), + HOL_APPEND, + HOL_LENGTH, get_theorem_by_name("ADD_CLAUSES"), ih, sl_sep_assoc()))); @@ -132,14 +132,14 @@ PROOF thm ARRAY_SEG_APPEND = prove_array_seg_append(); PROOF static thm prove_array_seg_join(void) { term goal_tm = ` - forall (P:num->A->hprop) (xs:(A)list) s ys. + forall (P:num->A->cprop) (xs:(A)list) s ys. array_seg P s xs ** array_seg P (s + LENGTH xs) ys -|- array_seg P s (xs ++ ys) `; gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm split = ispecl_rule( - TERM_LIST(`P:num->A->hprop`, `xs:(A)list`, `s:num`, `ys:(A)list`), + TERM_LIST(`P:num->A->cprop`, `xs:(A)list`, `s:num`, `ys:(A)list`), ARRAY_SEG_APPEND); ACCEPT_TAC(g, gsym_rule(split)); return gnode_prove(root); @@ -149,7 +149,7 @@ PROOF thm ARRAY_SEG_JOIN = prove_array_seg_join(); PROOF static thm prove_array_seg_split(void) { term goal_tm = ` - forall (P:num->A->hprop) s (xs:(A)list) k. + forall (P:num->A->cprop) s (xs:(A)list) k. k <= LENGTH xs ==> (array_seg P s xs -|- array_seg P s (list_take k xs) ** @@ -176,7 +176,7 @@ PROOF thm ARRAY_SEG_SPLIT = prove_array_seg_split(); PROOF static thm prove_array_seg_open(void) { term goal_tm = ` - forall (P:num->A->hprop) s (xs:(A)list) k. + forall (P:num->A->cprop) s (xs:(A)list) k. k < LENGTH xs ==> (array_seg P s xs -|- P (s + k) (EL k xs) ** array_focus P s xs k) @@ -200,12 +200,11 @@ PROOF static thm prove_array_seg_open(void) { array_seg_def, array_focus_def, take_length, - get_LENGTH(), + HOL_LENGTH, get_theorem_by_name("ADD_CLAUSES"), sl_sep_emp_right()))); - gnode_list directions = EQ_SLTAC(g, "HL", "HR"); - AUTO_FRAME_SLTAC(directions[0]); - AUTO_FRAME_SLTAC(directions[1]); + dest_binop_results endpoints = dest_sl_eq(goal_ccl(g->g)); + ACCEPT_TAC(g, ac_slrule(endpoints.tm1, endpoints.tm2)); return gnode_prove(root); } @@ -213,7 +212,7 @@ PROOF thm ARRAY_SEG_OPEN = prove_array_seg_open(); PROOF static thm prove_array_seg_close_read(void) { term goal_tm = ` - forall (P:num->A->hprop) s (xs:(A)list) k. + forall (P:num->A->cprop) s (xs:(A)list) k. k < LENGTH xs ==> (P (s + k) (EL k xs) ** array_focus P s xs k -|- array_seg P s xs) @@ -222,7 +221,7 @@ PROOF static thm prove_array_seg_close_read(void) { gnode g = AUTO_INTROS_TAC(root); thm opened = mp_rule( ispecl_rule( - TERM_LIST(`P:num->A->hprop`, `s:num`, `xs:(A)list`, `k:num`), + TERM_LIST(`P:num->A->cprop`, `s:num`, `xs:(A)list`, `k:num`), ARRAY_SEG_OPEN), assume_rule(gnode_get_asmps(g, CONST_STRING_LIST("H"))[0])); ACCEPT_TAC(g, gsym_rule(opened)); @@ -233,7 +232,7 @@ PROOF thm ARRAY_SEG_CLOSE_READ = prove_array_seg_close_read(); PROOF static thm prove_array_seg_close_write(void) { term goal_tm = ` - forall (P:num->A->hprop) s (xs:(A)list) k (v:A). + forall (P:num->A->cprop) s (xs:(A)list) k (v:A). k < LENGTH xs ==> (P (s + k) v ** array_focus P s xs k -|- array_seg P s (list_update k v xs)) @@ -259,12 +258,11 @@ PROOF static thm prove_array_seg_close_write(void) { array_seg_def, array_focus_def, take_length, - get_LENGTH(), + HOL_LENGTH, get_theorem_by_name("ADD_CLAUSES"), sl_sep_emp_right()))); - gnode_list directions = EQ_SLTAC(g, "HL", "HR"); - AUTO_FRAME_SLTAC(directions[0]); - AUTO_FRAME_SLTAC(directions[1]); + dest_binop_results endpoints = dest_sl_eq(goal_ccl(g->g)); + ACCEPT_TAC(g, ac_slrule(endpoints.tm1, endpoints.tm2)); return gnode_prove(root); } @@ -274,7 +272,7 @@ PROOF thm ARRAY_SEG_CLOSE_WRITE = prove_array_seg_close_write(); PROOF static thm prove_undef_seg_append(void) { term goal_tm = ` - forall (U:num->hprop) m s n. + forall (U:num->cprop) m s n. undef_seg U s (m + n) -|- undef_seg U s m ** undef_seg U (s + m) n `; @@ -302,14 +300,14 @@ PROOF thm UNDEF_SEG_APPEND = prove_undef_seg_append(); PROOF static thm prove_undef_seg_join(void) { term goal_tm = ` - forall (U:num->hprop) m s n. + forall (U:num->cprop) m s n. undef_seg U s m ** undef_seg U (s + m) n -|- undef_seg U s (m + n) `; gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm split = ispecl_rule( - TERM_LIST(`U:num->hprop`, `m:num`, `s:num`, `n:num`), + TERM_LIST(`U:num->cprop`, `m:num`, `s:num`, `n:num`), UNDEF_SEG_APPEND); ACCEPT_TAC(g, gsym_rule(split)); return gnode_prove(root); @@ -319,7 +317,7 @@ PROOF thm UNDEF_SEG_JOIN = prove_undef_seg_join(); PROOF static thm prove_undef_seg_split(void) { term goal_tm = ` - forall (U:num->hprop) s n k. + forall (U:num->cprop) s n k. k <= n ==> (undef_seg U s n -|- undef_seg U s k ** undef_seg U (s + k) (n - k)) @@ -339,7 +337,7 @@ PROOF thm UNDEF_SEG_SPLIT = prove_undef_seg_split(); PROOF static thm prove_fill_begin(void) { term goal_tm = ` - forall (P:num->A->hprop) (U:num->hprop) s n. + forall (P:num->A->cprop) (U:num->cprop) s n. undef_seg U s n -|- fill_cursor P U s ([]:(A)list) n `; gnode root = gnode_new_with_ccl(goal_tm); @@ -347,7 +345,7 @@ PROOF static thm prove_fill_begin(void) { g = CONV_TAC(g, rewrite_conv(THM_LIST( fill_cursor_def, array_seg_def, - get_LENGTH(), + HOL_LENGTH, get_theorem_by_name("ADD_CLAUSES"), sl_sep_emp_left()))); return gnode_prove(root); @@ -357,7 +355,7 @@ PROOF thm FILL_BEGIN = prove_fill_begin(); PROOF static thm prove_fill_open(void) { term goal_tm = ` - forall (P:num->A->hprop) (U:num->hprop) s (xs:(A)list) remaining. + forall (P:num->A->cprop) (U:num->cprop) s (xs:(A)list) remaining. fill_cursor P U s xs (SUC remaining) -|- U (s + LENGTH xs) ** fill_focus P U s xs remaining `; @@ -367,9 +365,8 @@ PROOF static thm prove_fill_open(void) { fill_cursor_def, fill_focus_def, undef_seg_def))); - gnode_list directions = EQ_SLTAC(g, "HL", "HR"); - AUTO_FRAME_SLTAC(directions[0]); - AUTO_FRAME_SLTAC(directions[1]); + dest_binop_results endpoints = dest_sl_eq(goal_ccl(g->g)); + ACCEPT_TAC(g, ac_slrule(endpoints.tm1, endpoints.tm2)); return gnode_prove(root); } @@ -377,7 +374,7 @@ PROOF thm FILL_OPEN = prove_fill_open(); PROOF static thm prove_fill_close(void) { term goal_tm = ` - forall (P:num->A->hprop) (U:num->hprop) s + forall (P:num->A->cprop) (U:num->cprop) s (xs:(A)list) remaining (v:A). P (s + LENGTH xs) v ** fill_focus P U s xs remaining -|- fill_cursor P U s (xs ++ [v]) remaining @@ -389,8 +386,8 @@ PROOF static thm prove_fill_close(void) { fill_focus_def, ARRAY_SEG_APPEND, array_seg_def, - get_APPEND(), - get_LENGTH(), + HOL_APPEND, + HOL_LENGTH, get_theorem_by_name("LENGTH_APPEND"), get_theorem_by_name("ADD_CLAUSES"), sl_sep_emp_right()))); @@ -403,7 +400,7 @@ PROOF thm FILL_CLOSE = prove_fill_close(); PROOF static thm prove_fill_finish(void) { term goal_tm = ` - forall (P:num->A->hprop) (U:num->hprop) s (xs:(A)list). + forall (P:num->A->cprop) (U:num->cprop) s (xs:(A)list). fill_cursor P U s xs 0 -|- array_seg P s xs `; gnode root = gnode_new_with_ccl(goal_tm); diff --git a/array/lib/array_legacy.c b/array/lib/array_legacy.c index 954267aeab90d5716765330d17b59ced3805e870..c3efa7bd38e75aadfe3bfe3da977a88f94d4b168 100644 --- a/array/lib/array_legacy.c +++ b/array/lib/array_legacy.c @@ -1,5 +1,36 @@ #include "array/lib/array_legacy.h" +/* These array lemmas remain provided by the legacy HOL theory, but their + * generated proof-kernel accessors are no longer part of the runtime API. + * Resolve each theorem once through the theorem database and reuse the + * resulting handle throughout this compatibility implementation. */ +PROOF static thm LEGACY_ARRAY_AT_DIVIDE = + get_theorem_by_name("array_at_divide"); +PROOF static thm LEGACY_ARRAY_AT_DIVIDE2 = + get_theorem_by_name("array_at_divide2"); +PROOF static thm LEGACY_ARRAY_AT_LENGTH = + get_theorem_by_name("array_at_length"); +PROOF static thm LEGACY_ARRAY_AT_MERGE = + get_theorem_by_name("array_at_merge"); +PROOF static thm LEGACY_ARRAY_AT_MERGE_LAST = + get_theorem_by_name("array_at_merge_last"); +PROOF static thm LEGACY_ARRAY_AT_RANGE = + get_theorem_by_name("array_at_range"); +PROOF static thm LEGACY_ARRAY_AT_SPLIT = + get_theorem_by_name("array_at_split"); +PROOF static thm LEGACY_ARRAY_AT_ZERO = + get_theorem_by_name("array_at_zero"); +PROOF static thm LEGACY_MAX_OF_DEF = get_theorem_by_name("max_of_def"); +PROOF static thm LEGACY_MIN_OF_DEF = get_theorem_by_name("min_of_def"); +PROOF static thm LEGACY_UNDEF_ARRAY_AT_DEF = + get_theorem_by_name("undef_array_at_def"); +PROOF static thm LEGACY_UNDEF_ARRAY_AT_REC_BASE = + get_theorem_by_name("undef_array_at_rec_base"); +PROOF static thm LEGACY_UNDEF_ARRAY_AT_SPLIT_FIRST = + get_theorem_by_name("undef_array_at_split_first"); +PROOF static thm LEGACY_UNDEF_ARRAY_AT_ZERO = + get_theorem_by_name("undef_array_at_zero"); + /********************************************************** * Representation Predicates * **********************************************************/ @@ -57,16 +88,16 @@ PROOF thm undef_array_at_rec_empty() { gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); thm base = specl_rule(TERM_LIST(`x:addr`, `ty:ctype`, `0i`, `i:int`, `i:int`, `0i`), - get_undef_array_at_rec_base()); + LEGACY_UNDEF_ARRAY_AT_REC_BASE); base = conv_rule(rewrite_conv(THM_LIST( int_arith_rule(`0i + i == i`), int_arith_rule(`i - i == 0i`))), base); g = CONV_TAC(g, once_rewrite_conv(THM_LIST(base))); - g = CONV_TAC(g, once_rewrite_conv(THM_LIST(gsym_rule(get_undef_array_at_def())))); - thm zero = specl_rule(TERM_LIST(`x + i * sizeof ty`, `ty:ctype`, `0i`), get_undef_array_at_zero()); + g = CONV_TAC(g, once_rewrite_conv(THM_LIST(gsym_rule(LEGACY_UNDEF_ARRAY_AT_DEF)))); + thm zero = specl_rule(TERM_LIST(`x + i * sizeof ty`, `ty:ctype`, `0i`), LEGACY_UNDEF_ARRAY_AT_ZERO); zero = mp_rule(zero, int_arith_rule(`0i == 0i`)); g = CONV_TAC(g, once_rewrite_conv(THM_LIST(zero))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_hentail_refl()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(sl_ent_refl()))); return gnode_prove(root); } @@ -96,18 +127,18 @@ PROOF thm store_undef_char_array_rec_split_head(term pt, term i, term n) { g = CONV_TAC(g, rewrite_conv(THM_LIST(store_undef_char_array_rec_def))); thm base = specl_rule(TERM_LIST(pt, `Tchar`, `0i`, i, n, `${n:int} - ${i:int}`), - get_undef_array_at_rec_base()); + LEGACY_UNDEF_ARRAY_AT_REC_BASE); base = conv_rule(rewrite_conv(THM_LIST( int_arith_rule(`0i + i == i`), int_arith_rule(`n - i == n - i`))), base); g = CONV_TAC(g, once_rewrite_conv(THM_LIST(base))); - g = CONV_TAC(g, once_rewrite_conv(THM_LIST(gsym_rule(get_undef_array_at_def())))); + g = CONV_TAC(g, once_rewrite_conv(THM_LIST(gsym_rule(LEGACY_UNDEF_ARRAY_AT_DEF)))); thm len_ge_one = mp_rule(int_arith_rule(`${i:int} < ${n:int} ==> ${n:int} - ${i:int} >= 1i`), assume_rule(`${i:int} < ${n:int}`)); thm split = mp_rule( specl_rule(TERM_LIST(`${pt:addr} + ${i:int} * sizeof Tchar`, `Tchar`, `${n:int} - ${i:int}`), - get_undef_array_at_split_first()), + LEGACY_UNDEF_ARRAY_AT_SPLIT_FIRST), len_ge_one); g = CONV_TAC(g, rewrite_conv(THM_LIST(int_arith_rule(` @@ -134,13 +165,13 @@ PROOF void unfold_store_undef_char_array_rec_head(term pt, term i, term n) { * Intended action: apply_hconv_st after writing `v` to `pt + i * sizeof Tchar`. */ PROOF thm store_char_array_extend_tail(term pt, term i, term l, term v) { - thm th = specl_rule(TERM_LIST(pt, `Tchar`, i, v, l), get_array_at_merge_last()); + thm th = specl_rule(TERM_LIST(pt, `Tchar`, i, v, l), LEGACY_ARRAY_AT_MERGE_LAST); return rewrite_rule(THM_LIST(sym_rule(store_char_array_def)), th); } /* Splits off the permission for element `i` from `store_char_array pt n l`. */ PROOF thm store_char_array_split_at(term pt, term n, term l, term i) { - thm th = specl_rule(TERM_LIST(pt, `Tchar`, i, n, l), get_array_at_split()); + thm th = specl_rule(TERM_LIST(pt, `Tchar`, i, n, l), LEGACY_ARRAY_AT_SPLIT); return rewrite_rule(THM_LIST( sym_rule(store_char_array_def), sym_rule(store_char_array_missing_i_rec_def)), th); @@ -152,7 +183,7 @@ PROOF void unfold_store_char_array_at(term pt, term n, term l, term i) { /* Merges the element permission back into `store_char_array pt n l`. */ PROOF thm store_char_array_merge_at(term pt, term n, term l, term i, term v) { - thm th = specl_rule(TERM_LIST(pt, `Tchar`, i, n, v, l), get_array_at_merge()); + thm th = specl_rule(TERM_LIST(pt, `Tchar`, i, n, v, l), LEGACY_ARRAY_AT_MERGE); return rewrite_rule(THM_LIST( sym_rule(store_char_array_def), sym_rule(store_char_array_missing_i_rec_def)), th); @@ -163,14 +194,14 @@ PROOF void fold_store_char_array_at(term pt, term n, term l, term i, term v) { } PROOF void add_store_char_array_length_fact(term pt, term n, term l) { - thm th = specl_rule(TERM_LIST(pt, `Tchar`, n, l), get_array_at_length()); + thm th = specl_rule(TERM_LIST(pt, `Tchar`, n, l), LEGACY_ARRAY_AT_LENGTH); th = rewrite_rule(THM_LIST(sym_rule(store_char_array_def)), th); apply_hconv_st(th); } PROOF void add_store_char_array_range_fact(term pt, term n, term l) { - thm th = specl_rule(TERM_LIST(pt, `Tchar`, n, l), get_array_at_range()); - th = rewrite_rule(THM_LIST(get_min_of_def(), get_max_of_def()), th); + thm th = specl_rule(TERM_LIST(pt, `Tchar`, n, l), LEGACY_ARRAY_AT_RANGE); + th = rewrite_rule(THM_LIST(LEGACY_MIN_OF_DEF, LEGACY_MAX_OF_DEF), th); th = rewrite_rule(THM_LIST(sym_rule(store_char_array_def)), th); apply_hconv_st(th); } @@ -187,7 +218,7 @@ PROOF void add_store_char_array_range_fact(term pt, term n, term l) { PROOF static thm char_array_length_local_ent( const term p, const term n, const term xs) { thm length = specl_rule( - TERM_LIST(p, `Tchar`, n, xs), get_array_at_length()); + TERM_LIST(p, `Tchar`, n, xs), LEGACY_ARRAY_AT_LENGTH); return rewrite_rule(THM_LIST(sym_rule(store_char_array_def)), length); } @@ -214,8 +245,8 @@ PROOF thm char_array_add_range_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); thm th = specl_rule( TERM_LIST(`p:addr`, `Tchar`, `n:int`, `xs:(int)list`), - get_array_at_range()); - th = rewrite_rule(THM_LIST(get_min_of_def(), get_max_of_def()), th); + LEGACY_ARRAY_AT_RANGE); + th = rewrite_rule(THM_LIST(LEGACY_MIN_OF_DEF, LEGACY_MAX_OF_DEF), th); th = rewrite_rule(THM_LIST(sym_rule(store_char_array_def)), th); ACCEPT_TAC(g, th); return gnode_prove(root); @@ -347,7 +378,7 @@ PROOF thm char_array_split_operation_proof(const term goal_tm) { `p:addr`, `n:int`, `xs:(int)list`); thm split = specl_rule( TERM_LIST(`p:addr`, `Tchar`, `n:int`, `xs:(int)list`, `k:int`), - get_array_at_divide()); + LEGACY_ARRAY_AT_DIVIDE); split = mp_rule(split, assume_rule(`0i <= k`)); split = mp_rule(split, assume_rule(`k <= n`)); split = mp_rule(split, assume_rule(length)); @@ -392,7 +423,7 @@ PROOF thm char_array_join_operation_proof(const term goal_tm) { thm join = specl_rule( TERM_LIST(`p:addr`, `Tchar`, `n:int`, `m:int`, `xs:(int)list`, `ys:(int)list`), - get_array_at_divide2()); + LEGACY_ARRAY_AT_DIVIDE2); join = mp_rule(join, assume_rule(left_length)); join = mp_rule(join, assume_rule(right_length)); join = eq2ent(gsym_rule(join)); @@ -449,10 +480,10 @@ PROOF thm char_array_begin_fill_entailment(const term p, const term n) { g = CONV_TAC(g, rewrite_conv(THM_LIST(store_char_array_def))); g = CONV_TAC(g, rewrite_conv(THM_LIST(store_undef_char_array_rec_def))); g = CONV_TAC(g, rewrite_conv(THM_LIST(int_arith_rule(`n - 0i == n`)))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(gsym_rule(get_undef_array_at_def())))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(gsym_rule(LEGACY_UNDEF_ARRAY_AT_DEF)))); thm zero = specl_rule( - TERM_LIST(p, `Tchar`, `0i`, `[]:(int)list`), get_array_at_zero()); + TERM_LIST(p, `Tchar`, `0i`, `[]:(int)list`), LEGACY_ARRAY_AT_ZERO); zero = mp_rule(zero, int_arith_rule(`0i == 0i`)); zero = mp_rule(zero, refl_rule(`[]:(int)list`)); g = CONV_TAC(g, rewrite_conv(THM_LIST(zero))); @@ -571,7 +602,7 @@ PROOF thm num_of_int_ilength() { g = gs[0]; g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_ILENGTH_DEF(), + ILENGTH_DEF, get_theorem_by_name("LENGTH"), num_of_int_zero() ))); @@ -579,10 +610,10 @@ PROOF thm num_of_int_ilength() { g = gs[1]; thm len_suc = mp_rule( num_of_int_suc_at(`ilength (a1:(int)list)`), - ispec_rule(`a1:(int)list`, get_ILENGTH_NONNEG()) + ispec_rule(`a1:(int)list`, ILENGTH_NONNEG) ); g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_ILENGTH_DEF(), + ILENGTH_DEF, get_theorem_by_name("LENGTH"), int_arith_rule(`1i + ilength (a1:(int)list) == ilength a1 + 1i`), len_suc, @@ -605,7 +636,7 @@ PROOF thm int_index_lt_length() { g = CONV_TAC(g, rewrite_conv(THM_LIST(match_mp_rule( get_theorem_by_name("INT_OF_NUM_OF_INT"), assume_rule(`0i <= i`))))); g = CONV_TAC(g, rewrite_conv(THM_LIST(match_mp_rule( - get_theorem_by_name("INT_OF_NUM_OF_INT"), ispec_rule(`l:(int)list`, get_ILENGTH_NONNEG()))))); + get_theorem_by_name("INT_OF_NUM_OF_INT"), ispec_rule(`l:(int)list`, ILENGTH_NONNEG))))); ACCEPT_TAC(g, assume_rule(gnode_get_asmps(g, CONST_STRING_LIST("H_0"))[0])); return gnode_prove(root); } @@ -619,7 +650,7 @@ PROOF thm int_index_lt_length_at(term l, term i) { PROOF thm ilength_eq_nonneg_rule(term goal_tm) { thm th = int_arith_rule(`0i <= ilength (l:(int)list) ==> ilength l == n ==> 0i <= n`); - th = mp_rule(th, ispec_rule(`l:(int)list`, get_ILENGTH_NONNEG())); + th = mp_rule(th, ispec_rule(`l:(int)list`, ILENGTH_NONNEG)); th = mp_rule(th, assume_rule(`ilength (l:(int)list) == n`)); return th; } @@ -643,12 +674,12 @@ PROOF thm firstn_length_all() { gnode_list gs = INDUCT_TAC(g, `l:(int)list`); g = gs[0]; - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_theorem_by_name("LENGTH"), get_FIRSTN_DEF()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(get_theorem_by_name("LENGTH"), FIRSTN_DEF))); g = gs[1]; g = CONV_TAC(g, rewrite_conv(THM_LIST( get_theorem_by_name("LENGTH"), - get_FIRSTN_DEF(), + FIRSTN_DEF, assume_rule(gnode_get_asmps(g, CONST_STRING_LIST("H"))[0]) ))); @@ -667,14 +698,14 @@ PROOF thm replace_nth_self() { gnode_list gs = INDUCT_TAC(g, `l:(int)list`); g = GEN_TAC(gs[0], "n"); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_REPLACE_NTH_DEF()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(REPLACE_NTH_DEF))); g = GEN_TAC(gs[1], "n"); gnode_list cases = CASES_TAC(g, `n:num`, "C_n"); g = CONV_WITH_ASMP_TAC(cases[0], rewrite_conv, - THM_LIST(get_REPLACE_NTH_DEF(), get_NTH_DEF())); + THM_LIST(REPLACE_NTH_DEF, NTH_DEF)); g = CONV_WITH_ASMP_TAC(cases[1], rewrite_conv, - THM_LIST(get_REPLACE_NTH_DEF(), get_NTH_DEF())); + THM_LIST(REPLACE_NTH_DEF, NTH_DEF)); return gnode_prove(root); } @@ -686,8 +717,8 @@ PROOF thm replace_inth_self() { gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_REPLACE_INTH_DEF(), - get_INTH_DEF(), + REPLACE_INTH_DEF, + INTH_DEF, replace_nth_self() ))); return gnode_prove(root); @@ -736,10 +767,10 @@ PROOF thm int_sum_sublist_zero() { gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_SUBLIST_DEF(), + SUBLIST_DEF, num_of_int_zero(), - get_FIRSTN_DEF(), - get_SKIPN_DEF(), + FIRSTN_DEF, + SKIPN_DEF, int_sum_def ))); return gnode_prove(root); @@ -805,8 +836,8 @@ PROOF thm int_sum_firstn_snoc() { get_theorem_by_name("LT_0"), get_theorem_by_name("ADD_CLAUSES"), get_theorem_by_name("ONE"), - get_FIRSTN_DEF(), - get_NTH_DEF(), + FIRSTN_DEF, + NTH_DEF, int_sum_def )); RULE_TAC(g, int_arith_rule); @@ -819,8 +850,8 @@ PROOF thm int_sum_firstn_snoc() { g = DISCH_TAC(g, NULL); g = CONV_WITH_ASMP_TAC(g, rewrite_conv, THM_LIST( get_theorem_by_name("ADD_CLAUSES"), - get_FIRSTN_DEF(), - get_NTH_DEF(), + FIRSTN_DEF, + NTH_DEF, int_sum_def )); thm tail_sum = spec_rule(`n_:num`, assume_rule(gnode_get_asmps(g, CONST_STRING_LIST("H"))[0])); @@ -840,10 +871,10 @@ PROOF thm int_sum_sublist_snoc() { gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); g = ASSUME_TAC(g, int_index_lt_length_at(`l:(int)list`, `i:int`), "IDX"); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SUBLIST_DEF()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(SUBLIST_DEF))); g = CONV_TAC(g, rewrite_conv(THM_LIST(num_of_int_zero()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SKIPN_DEF()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_INTH_DEF()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(SKIPN_DEF))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(INTH_DEF))); g = CONV_TAC(g, rewrite_conv(THM_LIST(undisch_all_rule(num_of_int_suc_at(`i:int`))))); g = CONV_TAC(g, rewrite_conv(THM_LIST(gsym_rule(undisch_all_rule(num_of_int_suc_at(`i:int`)))))); g = CONV_TAC(g, rewrite_conv(THM_LIST(undisch_all_rule( @@ -878,9 +909,9 @@ PROOF thm int_sum_sublist_all() { term goal_tm = `forall n l:(int)list. ilength l == n ==> int_sum (sublist 0i n l) == int_sum l`; gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SUBLIST_DEF()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(SUBLIST_DEF))); g = CONV_TAC(g, rewrite_conv(THM_LIST(num_of_int_zero()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SKIPN_DEF()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(SKIPN_DEF))); thm len_to_num = ap_term_rule(`num_of_int`, assume_rule(`ilength (l:(int)list) == n`)); len_to_num = conv_rule(rewrite_conv(THM_LIST(num_of_int_ilength())), len_to_num); g = CONV_TAC(g, rewrite_conv(THM_LIST(gsym_rule(len_to_num)))); diff --git a/array/lib/array_legacy.h b/array/lib/array_legacy.h index 0128851d174dcafff90b3da737bb009d53a5edac..c7c95edf7ee3a83b6091943a3c143f503b2d7380 100644 --- a/array/lib/array_legacy.h +++ b/array/lib/array_legacy.h @@ -15,6 +15,9 @@ #include "userlib/operational/operational.h" #require "userlib/operational/operational.c" +#include "proof/theory/data/int_list.h" +#require "proof/theory/data/int_list.c" + PROOF extern thm store_char_array_def; PROOF extern thm store_char_array_missing_i_rec_def; PROOF extern thm store_undef_char_array_def; diff --git a/array/lib/index.c b/array/lib/index.c index 5c34d4057087e23379109a78b008b2fe47357f4c..5fb9e90286a3ab131131588ab9f9fc3dd790b0fa 100644 --- a/array/lib/index.c +++ b/array/lib/index.c @@ -148,7 +148,11 @@ PROOF static thm prove_num_of_int_eq_length(void) { term i = `i:int`; term xs = `xs:(A)list`; term premise = `i = &(LENGTH (xs:(A)list))`; - thm lifted = ap_term_rule(`num_of_int`, assume_rule(premise)); + type num_of_int_type = parse_type("int->num"); + term num_of_int_function = + mk_const("num_of_int", num_of_int_type); + thm lifted = + ap_term_rule(num_of_int_function, assume_rule(premise)); thm result = conv_rule( rewrite_conv(THM_LIST(get_theorem_by_name("NUM_OF_INT_OF_NUM"))), lifted); @@ -222,7 +226,7 @@ PROOF static thm prove_unsigned_last_nbits_64_id(void) { then_conv( rewrite_conv(THM_LIST(get_theorem_by_name("NUM_OF_INT_OF_NUM"))), get_conversion_by_name("NUM_REDUCE_CONV")), - ispec_rule(`64i`, get_theorem_by_name("INT_EXP_2_DEF"))); + ispec_rule(`64i`, get_theorem_by_name("int_exp_2_def"))); thm below_modulus = conv_rule( once_rewrite_conv(THM_LIST(sym_rule(modulus))), mp_rule(int_arith_rule( @@ -245,22 +249,13 @@ PROOF static thm prove_signed_last_nbits_32_id(void) { thm nonnegative = conjunct1_rule(hpremise); thm at_most = conjunct2_rule(hpremise); - /* `cast_signed` is opaque in the searchable database; recover its defining - equation from the definition table. */ - thm cast_signed_def = {0}; - thm_list defs = get_all_definitions(); - for (size_t i = 0; i < vector_size(defs); ++i) { - if (strstr(cstr_term(dest_eq(concl(defs[i])).tm1), "cast_signed")) - cast_signed_def = defs[i]; - } - conv reduce_modulus = then_conv( rewrite_conv(THM_LIST(get_theorem_by_name("NUM_OF_INT_OF_NUM"))), get_conversion_by_name("NUM_REDUCE_CONV")); thm modulus = conv_rule(reduce_modulus, - ispec_rule(`32i`, get_theorem_by_name("INT_EXP_2_DEF"))); + ispec_rule(`32i`, get_theorem_by_name("int_exp_2_def"))); thm sign_bit = conv_rule(reduce_modulus, - ispec_rule(`31i`, get_theorem_by_name("INT_EXP_2_DEF"))); + ispec_rule(`31i`, get_theorem_by_name("int_exp_2_def"))); /* cast_unsigned 32i x == x from the unsigned identity. */ thm below_modulus = conv_rule( @@ -279,7 +274,18 @@ PROOF static thm prove_signed_last_nbits_32_id(void) { /* Unfold cast_signed; with the sign bit clear the conditional collapses. */ thm unfolded = apply_conversion( - rewrite_conv(THM_LIST(cast_signed_def)), `cast_signed 32i x`); + rewrite_conv(THM_LIST(get_theorem_by_name("cast_signed_def"))), + `cast_signed 32i x`); + /* The definition has one intentional local `let`. Expose its single + application, contract precisely that beta redex, then remove LET_END. Do + not put beta reduction into a general rewrite set. */ + unfolded = conv_rule( + once_rewrite_conv(THM_LIST(get_theorem_by_name("LET_DEF"))), + unfolded); + unfolded = beta_rule(unfolded); + unfolded = conv_rule( + once_rewrite_conv(THM_LIST(get_theorem_by_name("LET_END_DEF"))), + unfolded); thm width = apply_conversion( get_conversion_by_name("INT_REDUCE_CONV"), `32i - 1i`); thm reduced = conv_rule( diff --git a/array/lib/index.h b/array/lib/index.h index 01a5c2edd14be1af394ef5d482bb12cba143c295..e5e2f835fb5a8e0b852b04dec718168e0c87a2a3 100644 --- a/array/lib/index.h +++ b/array/lib/index.h @@ -11,6 +11,8 @@ #include "userlib/qcp/veriftime.h" #require "userlib/qcp/veriftime.c" +#include "proof/theory/c_program_logic/c_integer.h" +#require "proof/theory/c_program_logic/c_integer.c" /* Cursor arithmetic. */ PROOF extern thm NUM_OF_INT_SUC; diff --git a/array/lib/lomuto_int.c b/array/lib/lomuto_int.c index 297f5fbeee30f1110eda5b0f28668270f4f76b19..adc6f273b04fb521c833a85403e2e03e58f72892 100644 --- a/array/lib/lomuto_int.c +++ b/array/lib/lomuto_int.c @@ -11,9 +11,9 @@ PROOF static thm prove_lomuto_int_init(void) { 2i <= n ==> n = &(LENGTH xs) ==> list_permuted xs xs && 0i <= 0i && 0i <= 0i && 0i <= n - 1i && - (forall k. k < num_of_int 0i ==> + (forall k. k < (0:num) ==> EL k xs <= EL (num_of_int (n - 1i)) xs) && - (forall k. num_of_int 0i <= k && k < num_of_int 0i ==> + (forall k. (0:num) <= k && k < 0 ==> EL (num_of_int (n - 1i)) xs < EL k xs) && EL (num_of_int (n - 1i)) xs = EL (num_of_int (n - 1i)) xs @@ -33,20 +33,14 @@ PROOF static thm prove_lomuto_int_init(void) { gnode_list left_empty = CONJ_TAC(last_nonnegative[1]); gnode left_k = GEN_TAC(left_empty[0], "k"); gnode left_body = DISCH_TAC(left_k, "Hleft"); - thm left_impossible = conv_rule(simp_conv(THM_LIST( - get_theorem_by_name("NUM_OF_INT_OF_NUM"))), - assume_rule(`k:num < num_of_int 0i`)); + thm left_impossible = assume_rule(`k:num < 0`); CONTR_TAC(left_body, match_mp_rule( arith_rule(`forall k:num. k < 0 ==> F`), left_impossible)); gnode_list middle_empty = CONJ_TAC(left_empty[1]); gnode middle_k = GEN_TAC(middle_empty[0], "k"); gnode middle_body = DISCH_TAC(middle_k, "Hmiddle"); - thm middle_range = assume_rule(` - num_of_int 0i <= k:num && k < num_of_int 0i - `); - thm middle_impossible = conv_rule(simp_conv(THM_LIST( - get_theorem_by_name("NUM_OF_INT_OF_NUM"))), - conjunct2_rule(middle_range)); + thm middle_range = assume_rule(`(0:num) <= k && k < 0`); + thm middle_impossible = conjunct2_rule(middle_range); CONTR_TAC(middle_body, match_mp_rule( arith_rule(`forall k:num. k < 0 ==> F`), middle_impossible)); ACCEPT_TAC(middle_empty[1], refl_rule(` @@ -116,7 +110,7 @@ PROOF static thm prove_lomuto_int_step_le(void) { `original:(int)list`, `current:(int)list`), LIST_PERMUTED_LENGTH), hperm); thm hn_current = trans_rule(hn_original, - ap_term_rule(`int_of_num`, current_length)); + ap_term_rule(`int_of_num:num->int`, current_length)); thm int_indices = match_mp_rule(int_arith_rule(` forall i j n len:int. 2i <= n && n = len && 0i <= i && i <= j && j < n - 1i ==> @@ -244,7 +238,7 @@ PROOF static thm prove_lomuto_int_step_gt(void) { `original:(int)list`, `current:(int)list`), LIST_PERMUTED_LENGTH), hperm); thm hn_current = trans_rule(hn_original, - ap_term_rule(`int_of_num`, current_length)); + ap_term_rule(`int_of_num:num->int`, current_length)); thm int_indices = match_mp_rule(int_arith_rule(` forall i j n len:int. 2i <= n && n = len && 0i <= i && i <= j && j < n - 1i ==> @@ -379,7 +373,7 @@ PROOF static thm prove_lomuto_int_finish(void) { `original:(int)list`, `current:(int)list`), LIST_PERMUTED_LENGTH), hperm); thm hn_current = trans_rule(hn_original, - ap_term_rule(`int_of_num`, current_length)); + ap_term_rule(`int_of_num:num->int`, current_length)); thm last_info = num_of_int_last_index_rule( `n:int`, `current:(int)list`, match_mp_rule(int_arith_rule( @@ -443,7 +437,7 @@ PROOF static thm prove_lomuto_int_access(void) { LIST_PERMUTED_LENGTH), hperm); thm n_current = trans_rule( assume_rule(`n:int = &(LENGTH (original:(int)list))`), - ap_term_rule(`int_of_num`, length_equal)); + ap_term_rule(`int_of_num:num->int`, length_equal)); thm bounds = match_mp_rule(int_arith_rule(` forall i j n:int. 2i <= n && 0i <= i && i <= j && j < n - 1i ==> @@ -485,7 +479,7 @@ PROOF static thm prove_lomuto_int_final_access(void) { LIST_PERMUTED_LENGTH), hperm); thm n_current = trans_rule( assume_rule(`n:int = &(LENGTH (original:(int)list))`), - ap_term_rule(`int_of_num`, length_equal)); + ap_term_rule(`int_of_num:num->int`, length_equal)); thm bounds = match_mp_rule(int_arith_rule(` forall i j n:int. (2i <= n && 0i <= i && i <= j && j <= n - 1i) && @@ -550,7 +544,7 @@ PROOF static thm prove_lomuto_int_recursive_split(void) { LIST_PERMUTED_LENGTH), hperm); thm hn_part = trans_rule( - hn_original, ap_term_rule(`int_of_num`, hlength)); + hn_original, ap_term_rule(`int_of_num:num->int`, hlength)); thm hk_lt_part = eq_mp_rule(beta_rule(ap_term_rule( `\limit:int. k < limit`, hn_part)), hk_lt_n); thm hk_cast = int_of_num_of_int_rule(`k:int`, hk_nonnegative); @@ -561,7 +555,7 @@ PROOF static thm prove_lomuto_int_recursive_split(void) { ispecl_rule(TERM_LIST(`num_of_int k`, `part:(int)list`), LENGTH_LIST_TAKE), hk_le); - thm take_cast = ap_term_rule(`int_of_num`, take_length); + thm take_cast = ap_term_rule(`int_of_num:num->int`, take_length); take_cast = list_trans_rule(THM_LIST(take_cast, hk_cast)); thm left_length = gsym_rule(take_cast); @@ -590,7 +584,7 @@ PROOF static thm prove_lomuto_int_recursive_split(void) { ispecl_rule(TERM_LIST(`SUC (num_of_int k)`, `part:(int)list`), LENGTH_LIST_DROP), hsuc_le); - thm right_cast = ap_term_rule(`int_of_num`, right_length); + thm right_cast = ap_term_rule(`int_of_num:num->int`, right_length); thm cast_sub = mp_rule( ispecl_rule(TERM_LIST(`SUC (num_of_int k)`, `LENGTH (part:(int)list)`), diff --git a/array/lib/order.c b/array/lib/order.c index 68daaf495b9f2bd66338eb1e3761c3e6d4b5f7c5..cc6edd4f4bd3e8de903ad6a5355ee1756b348c62 100644 --- a/array/lib/order.c +++ b/array/lib/order.c @@ -278,7 +278,7 @@ PROOF static thm prove_lb_init(void) { forall (xs:(int)list) key n:int. n = &(LENGTH xs) ==> 0i <= 0i && 0i <= n && n <= &(LENGTH xs) && - (forall j. j < num_of_int 0i ==> EL j xs < key) && + (forall j. j < (0:num) ==> EL j xs < key) && (forall j. num_of_int n <= j && j < LENGTH xs ==> key <= EL j xs) `); diff --git a/array/lib/ptr_array.c b/array/lib/ptr_array.c index 0876dca3673c8dbf874ce2059240aa806d10f470..327b2fea76ac6052ab29f2cd95cbab8752c8655e 100644 --- a/array/lib/ptr_array.c +++ b/array/lib/ptr_array.c @@ -62,7 +62,7 @@ PROOF static thm PTR_INDEX_ADDRESS = prove_ptr_index_address(); PROOF static thm prove_ptr_array_open_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. + forall p:int. forall i:int. forall xs:(int)list. 0i <= i ==> i < &(LENGTH xs) ==> (ptr_array p xs -|- data_at (p + i * sizeof Tptr) Tptr @@ -79,7 +79,7 @@ PROOF static thm prove_ptr_array_open_eq(void) { ARRAY_SEG_OPEN); opened = mp_rule(opened, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`), PTR_INDEX_ADDRESS); + TERM_LIST(`p:int`, `i:int`), PTR_INDEX_ADDRESS); address = mp_rule(address, nonnegative); opened = conv_rule(rewrite_conv(THM_LIST( ptr_cell_def, @@ -94,7 +94,7 @@ PROOF static thm PTR_ARRAY_OPEN_EQ = prove_ptr_array_open_eq(); PROOF static thm prove_ptr_array_close_write_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. forall v:addr. + forall p:int. forall i:int. forall xs:(int)list. forall v:int. 0i <= i ==> i < &(LENGTH xs) ==> (data_at (p + i * sizeof Tptr) Tptr v ** ptr_focus p i xs -|- @@ -107,11 +107,11 @@ PROOF static thm prove_ptr_array_close_write_eq(void) { `i:int`, `xs:(int)list`, nonnegative, upper); thm closed = ispecl_rule( TERM_LIST(`ptr_cell p`, `0:num`, `xs:(int)list`, - `num_of_int i`, `v:addr`), + `num_of_int i`, `v:int`), ARRAY_SEG_CLOSE_WRITE); closed = mp_rule(closed, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`), PTR_INDEX_ADDRESS); + TERM_LIST(`p:int`, `i:int`), PTR_INDEX_ADDRESS); address = mp_rule(address, nonnegative); closed = conv_rule(rewrite_conv(THM_LIST( ptr_cell_def, @@ -143,7 +143,7 @@ PROOF static thm PTR_OFFSET_ADD = prove_ptr_offset_add(); PROOF static thm prove_ptr_seg_shift(void) { gnode root = gnode_new_with_ccl(` - forall xs:(int)list. forall p:addr. forall k j:num. + forall xs:(int)list. forall p:int. forall k j:num. array_seg (ptr_cell p) (k + j) xs -|- array_seg (ptr_cell (p + &k * sizeof Tptr)) j xs `); @@ -168,13 +168,13 @@ PROOF static thm PTR_SEG_SHIFT = prove_ptr_seg_shift(); PROOF static thm prove_ptr_seg_rebase(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall s:num. forall xs:(int)list. + forall p:int. forall s:num. forall xs:(int)list. array_seg (ptr_cell p) s xs -|- ptr_array (p + &s * sizeof Tptr) xs `); gnode g = AUTO_INTROS_TAC(root); thm shifted = ispecl_rule( - TERM_LIST(`xs:(int)list`, `p:addr`, `s:num`, `0:num`), + TERM_LIST(`xs:(int)list`, `p:int`, `s:num`, `0:num`), PTR_SEG_SHIFT); shifted = conv_rule(rewrite_conv(THM_LIST( get_theorem_by_name("ADD_CLAUSES"))), shifted); @@ -187,7 +187,7 @@ PROOF static thm PTR_SEG_REBASE = prove_ptr_seg_rebase(); PROOF static thm prove_ptr_array_append_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall xs ys:(int)list. + forall p:int. forall xs ys:(int)list. ptr_array p (xs ++ ys) -|- ptr_array p xs ** ptr_array (p + &(LENGTH xs) * sizeof Tptr) ys @@ -209,7 +209,7 @@ PROOF static thm PTR_ARRAY_APPEND_EQ = prove_ptr_array_append_eq(); PROOF static thm prove_ptr_array_split_eq(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall i:int. forall xs:(int)list. + forall p:int. forall i:int. forall xs:(int)list. 0i <= i ==> i <= &(LENGTH xs) ==> (ptr_array p xs -|- ptr_array p (list_take (num_of_int i) xs) ** @@ -226,7 +226,7 @@ PROOF static thm prove_ptr_array_split_eq(void) { ARRAY_SEG_SPLIT); split = mp_rule(split, index_bound); thm address = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`), PTR_INDEX_ADDRESS); + TERM_LIST(`p:int`, `i:int`), PTR_INDEX_ADDRESS); address = mp_rule(address, nonnegative); split = conv_rule(rewrite_conv(THM_LIST( PTR_SEG_REBASE, @@ -268,7 +268,7 @@ PROOF static thm open_ptr_array_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), PTR_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -278,7 +278,7 @@ PROOF static thm open_ptr_array_operation_proof(const term goal_tm) { } decl_operation(open_ptr_array_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), term_list_n(1, `ptr_array (KEY p) (CAPTURE xs)`), TERM_LIST(`0i <= i`, `i < &(LENGTH (xs:(int)list))`), `data_at (p + i * sizeof Tptr) Tptr @@ -295,7 +295,7 @@ PROOF static thm close_ptr_array_read_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`), PTR_ARRAY_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -311,7 +311,7 @@ PROOF static thm close_ptr_array_read_operation_proof( } decl_operation(close_ptr_array_read_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `ptr_focus (KEY p) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tptr)) Tptr @@ -330,7 +330,7 @@ PROOF static thm close_ptr_array_write_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm closed = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, `xs:(int)list`, `v:addr`), + TERM_LIST(`p:int`, `i:int`, `xs:(int)list`, `v:int`), PTR_ARRAY_CLOSE_WRITE_EQ); closed = mp_rule(closed, assume_rule(`0i <= i`)); closed = mp_rule(closed, @@ -345,7 +345,7 @@ PROOF static thm close_ptr_array_write_operation_proof( } decl_operation(close_ptr_array_write_operation, - TERM_LIST(`p:addr`, `i:int`), + TERM_LIST(`p:int`, `i:int`), TERM_LIST( `ptr_focus (KEY p) (KEY i) (CAPTURE xs)`, `data_at (KEY (p + i * sizeof Tptr)) Tptr (CAPTURE v)` @@ -364,11 +364,11 @@ PROOF static thm split_ptr_array_operation_proof(const term goal_tm) { thm nonnegative = assume_rule(`0i <= k`); thm upper = assume_rule(`k <= &(LENGTH (xs:(int)list))`); thm split = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `xs:(int)list`), PTR_ARRAY_SPLIT_EQ); split = mp_rule(mp_rule(split, nonnegative), upper); thm endpoint = ispecl_rule( - TERM_LIST(`p:addr`, `k:int`, `xs:(int)list`), + TERM_LIST(`p:int`, `k:int`, `xs:(int)list`), PTR_SPLIT_ENDPOINT); endpoint = mp_rule(mp_rule(endpoint, nonnegative), upper); thm with_endpoint = intro_fact_slrule(endpoint, eq2ent(split)); @@ -377,7 +377,7 @@ PROOF static thm split_ptr_array_operation_proof(const term goal_tm) { } decl_operation(split_ptr_array_operation, - TERM_LIST(`p:addr`, `k:int`), + TERM_LIST(`p:int`, `k:int`), term_list_n(1, `ptr_array (KEY p) (CAPTURE xs)`), TERM_LIST(`0i <= k`, `k <= &(LENGTH (xs:(int)list))`), `fact(p + k * sizeof Tptr = @@ -397,7 +397,7 @@ PROOF static thm join_ptr_arrays_operation_proof(const term goal_tm) { thm endpoint = assume_rule( `q = p + &(LENGTH (xs:(int)list)) * sizeof Tptr`); thm appended = ispecl_rule( - TERM_LIST(`p:addr`, `xs:(int)list`, `ys:(int)list`), + TERM_LIST(`p:int`, `xs:(int)list`, `ys:(int)list`), PTR_ARRAY_APPEND_EQ); appended = conv_rule(once_rewrite_conv( THM_LIST(gsym_rule(endpoint))), appended); @@ -410,7 +410,7 @@ PROOF static thm join_ptr_arrays_operation_proof(const term goal_tm) { } decl_operation(join_ptr_arrays_operation, - TERM_LIST(`p:addr`, `q:addr`), + TERM_LIST(`p:int`, `q:int`), TERM_LIST( `ptr_array (KEY p) (CAPTURE xs)`, `ptr_array (KEY q) (CAPTURE ys)` @@ -487,8 +487,8 @@ PROOF int install_ptr_array_qcp_interface(void) { `APPEND:(int)list->(int)list->(int)list`, `LENGTH:(int)list->num`, `EL:num->(int)list->int`, - `ptr_array:addr->(int)list->hprop`, - `ptr_focus:addr->int->(int)list->hprop`)) == 0, + `ptr_array:int->(int)list->cprop`, + `ptr_focus:int->int->(int)list->cprop`)) == 0, "Failed to install the pointer-array QCP interface"); installed = true; diff --git a/array/linsearch_legacy.c b/array/linsearch_legacy.c index 6c880d54c27de9cc459a57e663e4c95cb1512c4a..f36b8d17d5997448a79eb33f0fcb98bcc5dba257 100644 --- a/array/linsearch_legacy.c +++ b/array/linsearch_legacy.c @@ -2,9 +2,7 @@ #require "array/lib/array_legacy.c" PROOF void add_data_at_range_fact(term x, term ty, term v) { - thm ent = ispecl_rule(TERM_LIST(x, ty, v), get_data_at_range()); - ent = rewrite_rule(THM_LIST(get_min_of_def(), get_max_of_def()), ent); - apply_hconv_st(ent); + add_data_at_range_st(x, ty, v); } /* The search value was already excluded below the current index. */ diff --git a/array/memset.c b/array/memset.c index e48f2850fd183521ac692f72e3712704ca210151..e25e79de761d676c038533ff30ba23e4b7057e37 100644 --- a/array/memset.c +++ b/array/memset.c @@ -37,19 +37,18 @@ void memset_char(char *p, int n, char v) int i = 0; PROOF { - add_data_at_range_st(`n__addr:addr`, `Tint`, `n__pre:int`); + add_data_at_range_st(`n__addr:int`, `Tint`, `n__pre:int`); thm n_nonnegative = int_eq_length_nonnegative_rule( `n__pre:int`, `xs:(int)list`, assume_rule(`n__pre = &(LENGTH (xs:(int)list))`)); add_fact_st(conj_rule(int_arith_rule(`0i <= 0i`), n_nonnegative)); thm initial_shape = apply_conversion(rewrite_conv(THM_LIST( - get_theorem_by_name("NUM_OF_INT_OF_NUM"), get_theorem_by_name("REPLICATE"), LIST_DROP_DEF, get_theorem_by_name("APPEND"))), - `APPEND (REPLICATE (num_of_int 0i) v__pre) - (list_drop (num_of_int 0i) (xs:(int)list))`); + `APPEND (REPLICATE (0:num) v__pre) + (list_drop (0:num) (xs:(int)list))`); thm initial_array = ap_term_rule( `char_array p__pre`, initial_shape); apply_hconv_st(eq2ent(sym_rule(initial_array))); @@ -80,7 +79,7 @@ void memset_char(char *p, int n, char v) LENGTH_FILL_CURSOR), match_mp_rule( get_theorem_by_name("LT_IMP_LE"), hnatural_lt)); - thm hint_length = ap_term_rule(`int_of_num`, hlength); + thm hint_length = ap_term_rule(`int_of_num:num->int`, hlength); add_fact_st(conv_rule( rewrite_conv(THM_LIST(sym_rule(hint_length))), hlt_original)); diff --git a/array/quicksort.c b/array/quicksort.c index 82fa1545479028fa73b84be0db239c78da5101b4..58f34a6d29a329c2be3662fb8ae1db0d2d9cc9a8 100644 --- a/array/quicksort.c +++ b/array/quicksort.c @@ -79,7 +79,7 @@ err: decl_operation(qs_certify_operation, TERM_LIST( - `p:addr`, `q:addr`, + `p:int`, `q:int`, `original:(int)list`, `whole:(int)list`, `left:(int)list`, `right:(int)list`, `pivot:int`, `k:num` @@ -144,7 +144,7 @@ PROOF static thm partition_step_fact( } static int partition_int_span(int *p, int n) - PARAM(`q:addr`, `xs:(int)list`) + PARAM(`q:int`, `xs:(int)list`) REQUIRE(` int_span p q xs ** fact(2i <= n) ** @@ -157,7 +157,7 @@ static int partition_int_span(int *p, int n) `) { PROOF { - add_data_at_range_st(`n__addr:addr`, `Tint`, `n__pre:int`); + add_data_at_range_st(`n__addr:int`, `Tint`, `n__pre:int`); thm hn_two = assume_rule(`2i <= n__pre`); thm last = num_of_int_last_index_rule( `n__pre:int`, `xs:(int)list`, @@ -314,7 +314,7 @@ static int partition_int_span(int *p, int n) * opposite side. */ static void quicksort_int_span(int *p, int n) - PARAM(`q:addr`, `xs:(int)list`) + PARAM(`q:int`, `xs:(int)list`) REQUIRE(` int_span p q xs ** fact(n = &(LENGTH xs)) @@ -326,7 +326,7 @@ static void quicksort_int_span(int *p, int n) `) { PROOF add_data_at_range_st( - `n__addr:addr`, `Tint`, `n__pre:int`); + `n__addr:int`, `Tint`, `n__pre:int`); if (n <= 1) { PROOF { thm cast_small = eq_mp_rule(beta_rule(ap_term_rule( @@ -361,9 +361,9 @@ static void quicksort_int_span(int *p, int n) split = mp_rule(split, assume_rule(`retval < n__pre`)); add_conjuncts_st(split); - split_int_span(`p__pre:addr`, `q:addr`, `retval:int`); + split_int_span(`p__pre:int`, `q:int`, `retval:int`); split_int_span( - `p__pre + retval * sizeof Tint`, `q:addr`, `1i:int`); + `p__pre + retval * sizeof Tint`, `q:int`, `1i:int`); thm middle = find_conjunct_rule(split, ` list_take 1 (list_drop (num_of_int retval) (part:(int)list)) = @@ -387,14 +387,14 @@ static void quicksort_int_span(int *p, int n) PROOF { join_int_spans( - `p__pre:addr`, `p__pre + retval * sizeof Tint`); + `p__pre:int`, `p__pre + retval * sizeof Tint`); join_int_spans( - `p__pre:addr`, `p__pre + (retval + 1i) * sizeof Tint`); + `p__pre:int`, `p__pre + (retval + 1i) * sizeof Tint`); rewrite_st(THM_LIST( get_theorem_by_name("APPEND_ASSOC"), get_theorem_by_name("APPEND"))); apply_operation_st(qs_certify_operation, TERM_LIST( - `p__pre:addr`, `q:addr`, + `p__pre:int`, `q:int`, `xs:(int)list`, `part:(int)list`, `list_take (num_of_int retval) (part:(int)list)`, `list_drop (SUC (num_of_int retval)) (part:(int)list)`, @@ -426,7 +426,7 @@ void quicksort_int(int *p, int n) int_arith_rule(`forall n len:int. n = len ==> n <= len`), length_equal); add_conjuncts_st(conj_rule(nonnegative, upper)); - split_int_array(`p__pre:addr`, `n__pre:int`); + split_int_array(`p__pre:int`, `n__pre:int`); thm natural_length = num_of_int_eq_length_rule( `n__pre:int`, `xs:(int)list`, length_equal); @@ -441,10 +441,10 @@ void quicksort_int(int *p, int n) quicksort_int_span(p, n); PROOF { join_int_spans( - `p__pre:addr`, `p__pre + n__pre * sizeof Tint`); + `p__pre:int`, `p__pre + n__pre * sizeof Tint`); rewrite_st(THM_LIST(get_theorem_by_name("APPEND_NIL"))); forget_int_span( - `p__pre:addr`, + `p__pre:int`, `p__pre + &(LENGTH (xs:(int)list)) * sizeof Tint`); } } diff --git a/array/units/array_access.c b/array/units/array_access.c index 03999144fe0f9932f2fd6618ae23117c704c1e64..1f168422716a58a350c76849cdff8c832f5171aa 100644 --- a/array/units/array_access.c +++ b/array/units/array_access.c @@ -7,33 +7,33 @@ PROOF static int _ARRAY_ACCESS_QCP = void store_char_array_cell(char *p, int i, char new_value) STORE_CHAR_ARRAY_CELL_SPEC { - PROOF open_char_array(`p__pre:addr`, `i__pre:int`); + PROOF open_char_array(`p__pre:int`, `i__pre:int`); p[i] = new_value; - PROOF close_char_array_write(`p__pre:addr`, `i__pre:int`); + PROOF close_char_array_write(`p__pre:int`, `i__pre:int`); } int load_int_array_cell(int *p, int i) LOAD_INT_ARRAY_CELL_SPEC { - PROOF open_int_array(`p__pre:addr`, `i__pre:int`); + PROOF open_int_array(`p__pre:int`, `i__pre:int`); int value = p[i]; - PROOF close_int_array_read(`p__pre:addr`, `i__pre:int`); + PROOF close_int_array_read(`p__pre:int`, `i__pre:int`); return value; } int load_int_span_cell(int *p, int i) LOAD_INT_SPAN_CELL_SPEC { - PROOF open_int_span(`p__pre:addr`, `q:addr`, `i__pre:int`); + PROOF open_int_span(`p__pre:int`, `q:int`, `i__pre:int`); int value = p[i]; - PROOF close_int_span_read(`p__pre:addr`, `q:addr`, `i__pre:int`); + PROOF close_int_span_read(`p__pre:int`, `q:int`, `i__pre:int`); return value; } void store_int_span_cell(int *p, int i, int new_value) STORE_INT_SPAN_CELL_SPEC { - PROOF open_int_span(`p__pre:addr`, `q:addr`, `i__pre:int`); + PROOF open_int_span(`p__pre:int`, `q:int`, `i__pre:int`); p[i] = new_value; - PROOF close_int_span_write(`p__pre:addr`, `q:addr`, `i__pre:int`); + PROOF close_int_span_write(`p__pre:int`, `q:int`, `i__pre:int`); } diff --git a/array/units/array_access.h b/array/units/array_access.h index d22badf1a2efd9af6ade4fb0d5da83ad6b2ddb9e..948eee00ca54903b858e91b91710f7e06546e42c 100644 --- a/array/units/array_access.h +++ b/array/units/array_access.h @@ -40,7 +40,7 @@ int load_int_array_cell(int *p, int i) * metadata: no extra run-time argument is needed. */ #define LOAD_INT_SPAN_CELL_SPEC \ - PARAM(`q:addr`, `xs:(int)list`) \ + PARAM(`q:int`, `xs:(int)list`) \ REQUIRE(`int_span p q xs`, \ `fact(0i <= i)`, \ `fact(i < &(LENGTH (xs:(int)list)))`) \ @@ -51,7 +51,7 @@ int load_int_span_cell(int *p, int i) LOAD_INT_SPAN_CELL_SPEC; #define STORE_INT_SPAN_CELL_SPEC \ - PARAM(`q:addr`, `xs:(int)list`) \ + PARAM(`q:int`, `xs:(int)list`) \ REQUIRE(`int_span p q xs`, \ `fact(0i <= i)`, \ `fact(i < &(LENGTH (xs:(int)list)))`) \ diff --git a/array/units/bounded_midpoint.c b/array/units/bounded_midpoint.c index 9bd5e836af24c24f6253c73b7b9a50d1b5138a45..64437e2cd10a6604fa51051980835fe7f09366bc 100644 --- a/array/units/bounded_midpoint.c +++ b/array/units/bounded_midpoint.c @@ -6,7 +6,7 @@ int bounded_midpoint(int lo, int hi) BOUNDED_MIDPOINT_SPEC { PROOF { - add_data_at_range_st(`hi__addr:addr`, `Tint`, `hi__pre:int`); + add_data_at_range_st(`hi__addr:int`, `Tint`, `hi__pre:int`); thm bounds = specl_rule( TERM_LIST(`lo__pre:int`, `hi__pre:int`), MIDPOINT_BOUNDS); bounds = mp_rule(bounds, conj_rule( diff --git a/array/units/span_swap.h b/array/units/span_swap.h index 268c01bec8b6c6bdd25d80f0a05d12fd12c930de..a706a7b18d6d20f0435ea68f54835ea91f72e7ec 100644 --- a/array/units/span_swap.h +++ b/array/units/span_swap.h @@ -17,7 +17,7 @@ #require "array/lib/sort.c" #define SPAN_SWAP_SPEC \ - PARAM(`q:addr`, `xs:(int)list`) \ + PARAM(`q:int`, `xs:(int)list`) \ REQUIRE(`int_span p q xs`, \ `fact(0i <= i && i < &(LENGTH (xs:(int)list)))`, \ `fact(0i <= j && j < &(LENGTH (xs:(int)list)))`) \ diff --git a/bst/delete.c b/bst/delete.c index 7f1c998ff9e43758cb7ffdd7a1ea956faa637c46..233f73fcc3cf789993f5bf7f41f6977a4ea2a43e 100644 --- a/bst/delete.c +++ b/bst/delete.c @@ -6,7 +6,7 @@ void left_rotate(struct tree **tr) REQUIRE(`treebox_rep tr (Node l k v (Node rl rk rv rr))`) ENSURE(`treebox_rep tr (Node (Node l k v rl) rk rv rr)`) { - PROOF unfold_treebox_rep(`tr__pre:addr`, `Node l k v (Node rl rk rv rr)`); + PROOF unfold_treebox_rep(`tr__pre:int`, `Node l k v (Node rl rk rv rr)`); struct tree *root = *tr; @@ -19,11 +19,11 @@ void left_rotate(struct tree **tr) *tr = pivot; PROOF { - fold_tree_not_null(`pt:addr`, `pa:addr`, `pa_1:addr`, + fold_tree_not_null(`pt:int`, `pa:int`, `pa_1:int`, `l:indtree`, `k:int`, `v:int`, `rl:indtree`); - fold_tree_not_null(`pb:addr`, `pt:addr`, `pb_:addr`, + fold_tree_not_null(`pb:int`, `pt:int`, `pb_:int`, `Node l k v rl`, `rk:int`, `rv:int`, `rr:indtree`); - fold_treebox_rep(`tr__pre:addr`, `pb:addr`, `Node (Node l k v rl) rk rv rr`); + fold_treebox_rep(`tr__pre:int`, `pb:int`, `Node (Node l k v rl) rk rv rr`); } } @@ -32,7 +32,7 @@ void right_rotate(struct tree **tr) REQUIRE(`treebox_rep tr (Node (Node ll lk lv lr) k v r)`) ENSURE(`treebox_rep tr (Node ll lk lv (Node lr k v r))`) { - PROOF unfold_treebox_rep(`tr__pre:addr`, `Node (Node ll lk lv lr) k v r`); + PROOF unfold_treebox_rep(`tr__pre:int`, `Node (Node ll lk lv lr) k v r`); struct tree *root = *tr; @@ -44,11 +44,11 @@ void right_rotate(struct tree **tr) *tr = pivot; PROOF { - fold_tree_not_null(`pt:addr`, `pb_1:addr`, `pb:addr`, + fold_tree_not_null(`pt:int`, `pb_1:int`, `pb:int`, `lr:indtree`, `k:int`, `v:int`, `r:indtree`); - fold_tree_not_null(`pa:addr`, `pa_:addr`, `pt:addr`, + fold_tree_not_null(`pa:int`, `pa_:int`, `pt:int`, `ll:indtree`, `lk:int`, `lv:int`, `Node lr k v r`); - fold_treebox_rep(`tr__pre:addr`, `pa:addr`, `Node ll lk lv (Node lr k v r)`); + fold_treebox_rep(`tr__pre:int`, `pa:int`, `Node ll lk lv (Node lr k v r)`); } } @@ -163,46 +163,46 @@ void delete(struct tree **tr, int x) REQUIRE(`treebox_rep tr t`) ENSURE(`treebox_rep tr (tree_delete x t)`) { - PROOF unfold_treebox_rep(`tr__pre:addr`, `t:indtree`); + PROOF unfold_treebox_rep(`tr__pre:int`, `t:indtree`); struct tree *root = *tr; if (root == (void *)0) { PROOF { - unfold_tree_null(`pt:addr`, `t:indtree`); - fold_tree_null(`pt:addr`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Leaf`); + unfold_tree_null(`pt:int`, `t:indtree`); + fold_tree_null(`pt:int`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Leaf`); substitute_st(delete_leaf_result()); } return; }; - PROOF unfold_tree_not_null(`pt:addr`, `t:indtree`); + PROOF unfold_tree_not_null(`pt:int`, `t:indtree`); int key = root->key; if (x < key) { - PROOF fold_treebox_rep(`field_addr pt Ttree Fleft`, `pa:addr`, `l:indtree`); + PROOF fold_treebox_rep(`field_addr pt Ttree Fleft`, `pa:int`, `l:indtree`); delete(&(root->left), x); PROOF { unfold_treebox_rep(`field_addr pt Ttree Fleft`, `tree_delete x__pre l`); - fold_tree_not_null(`pt:addr`, `pt_:addr`, `pb:addr`, + fold_tree_not_null(`pt:int`, `pt_:int`, `pb:int`, `tree_delete x__pre l`, `k:int`, `v:int`, `r:indtree`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Node (tree_delete x__pre l) k v r`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Node (tree_delete x__pre l) k v r`); substitute_st(delete_left_result()); } } else if (x > key) { - PROOF fold_treebox_rep(`field_addr pt Ttree Fright`, `pb:addr`, `r:indtree`); + PROOF fold_treebox_rep(`field_addr pt Ttree Fright`, `pb:int`, `r:indtree`); delete(&(root->right), x); PROOF { unfold_treebox_rep(`field_addr pt Ttree Fright`, `tree_delete x__pre r`); - fold_tree_not_null(`pt:addr`, `pa:addr`, `pt_:addr`, + fold_tree_not_null(`pt:int`, `pa:int`, `pt_:int`, `l:indtree`, `k:int`, `v:int`, `tree_delete x__pre r`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Node l k v (tree_delete x__pre r)`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Node l k v (tree_delete x__pre r)`); substitute_st(delete_right_result()); } @@ -212,41 +212,41 @@ void delete(struct tree **tr, int x) *tr = (void *)0; PROOF { - unfold_tree_null(`pa:addr`, `l:indtree`); - unfold_tree_null(`pb:addr`, `r:indtree`); + unfold_tree_null(`pa:int`, `l:indtree`); + unfold_tree_null(`pb:int`, `r:indtree`); apply_hconv_st(mp_rule(disch_all_rule(get_fold_tree_null(`0i`)), refl_rule(`0i`))); - fold_treebox_rep(`tr__pre:addr`, `0i`, `Leaf`); + fold_treebox_rep(`tr__pre:int`, `0i`, `Leaf`); substitute_st(delete_found_leaf_result()); } } else if (root->left != (void *)0) { /* Found, with a left child: rotate it up, then delete from the right. */ PROOF { - unfold_tree_not_null(`pa:addr`, `l:indtree`); - fold_tree_not_null(`pa:addr`, `pa_:addr`, `pb_1:addr`, + unfold_tree_not_null(`pa:int`, `l:indtree`); + fold_tree_not_null(`pa:int`, `pa_:int`, `pb_1:int`, `l_:indtree`, `k_1:int`, `v_1:int`, `r_1:indtree`); - fold_tree_not_null(`pt:addr`, `pa:addr`, `pb:addr`, + fold_tree_not_null(`pt:int`, `pa:int`, `pb:int`, `Node l_ k_1 v_1 r_1`, `k:int`, `v:int`, `r:indtree`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Node (Node l_ k_1 v_1 r_1) k v r`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Node (Node l_ k_1 v_1 r_1) k v r`); } right_rotate(tr); PROOF { - unfold_treebox_rep(`tr__pre:addr`, `Node l_ k_1 v_1 (Node r_1 k v r)`); + unfold_treebox_rep(`tr__pre:int`, `Node l_ k_1 v_1 (Node r_1 k v r)`); rewrite_st(THM_LIST(tree_rep_def)); - fold_tree_not_null(`pb:addr`, `pa_2:addr`, `pb_:addr`, + fold_tree_not_null(`pb:int`, `pa_2:int`, `pb_:int`, `r_1:indtree`, `k:int`, `v:int`, `r:indtree`); - fold_treebox_rep(`field_addr pt_1 Ttree Fright`, `pb:addr`, `Node r_1 k v r`); + fold_treebox_rep(`field_addr pt_1 Ttree Fright`, `pb:int`, `Node r_1 k v r`); } delete(&((*tr)->right), x); PROOF { unfold_treebox_rep(`field_addr pt_1 Ttree Fright`, `tree_delete x__pre (Node r_1 k v r)`); - fold_tree_not_null(`pt_1:addr`, `pa_1:addr`, `pt_1:addr`, + fold_tree_not_null(`pt_1:int`, `pa_1:int`, `pt_1:int`, `l_:indtree`, `k_1:int`, `v_1:int`, `tree_delete x__pre (Node r_1 k v r)`); - fold_treebox_rep(`tr__pre:addr`, `pt_1:addr`, + fold_treebox_rep(`tr__pre:int`, `pt_1:int`, `Node l_ k_1 v_1 (tree_delete x__pre (Node r_1 k v r))`); substitute_st(inst_rule(TERM_PAIR_LIST( (term_pair){`k_1:int`, `k_:int`}, @@ -258,34 +258,34 @@ void delete(struct tree **tr, int x) } else { /* Found, with only a right child: rotate it up, then delete from the left. */ PROOF { - unfold_tree_null(`pa:addr`, `l:indtree`); - fold_tree_null(`pa:addr`); - unfold_tree_not_null(`pb:addr`, `r:indtree`); - fold_tree_not_null(`pb:addr`, `pa_1:addr`, `pb_:addr`, + unfold_tree_null(`pa:int`, `l:indtree`); + fold_tree_null(`pa:int`); + unfold_tree_not_null(`pb:int`, `r:indtree`); + fold_tree_not_null(`pb:int`, `pa_1:int`, `pb_:int`, `l_1:indtree`, `k_1:int`, `v_1:int`, `r_:indtree`); - fold_tree_not_null(`pt:addr`, `pa:addr`, `pb:addr`, + fold_tree_not_null(`pt:int`, `pa:int`, `pb:int`, `Leaf`, `k:int`, `v:int`, `Node l_1 k_1 v_1 r_`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Node Leaf k v (Node l_1 k_1 v_1 r_)`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Node Leaf k v (Node l_1 k_1 v_1 r_)`); } left_rotate(tr); PROOF { - unfold_treebox_rep(`tr__pre:addr`, `Node (Node Leaf k v l_1) k_1 v_1 r_`); + unfold_treebox_rep(`tr__pre:int`, `Node (Node Leaf k v l_1) k_1 v_1 r_`); rewrite_st(THM_LIST(tree_rep_def)); - fold_tree_null(`pa_:addr`); - fold_tree_not_null(`pa_1:addr`, `pa_:addr`, `pb_2:addr`, + fold_tree_null(`pa_:int`); + fold_tree_not_null(`pa_1:int`, `pa_:int`, `pb_2:int`, `Leaf`, `k:int`, `v:int`, `l_1:indtree`); - fold_treebox_rep(`field_addr pt_1 Ttree Fleft`, `pa_1:addr`, `Node Leaf k v l_1`); + fold_treebox_rep(`field_addr pt_1 Ttree Fleft`, `pa_1:int`, `Node Leaf k v l_1`); } delete(&((*tr)->left), x); PROOF { unfold_treebox_rep(`field_addr pt_1 Ttree Fleft`, `tree_delete x__pre (Node Leaf k v l_1)`); - fold_tree_not_null(`pt_1:addr`, `pt_1:addr`, `pb_1:addr`, + fold_tree_not_null(`pt_1:int`, `pt_1:int`, `pb_1:int`, `tree_delete x__pre (Node Leaf k v l_1)`, `k_1:int`, `v_1:int`, `r_:indtree`); - fold_treebox_rep(`tr__pre:addr`, `pt_1:addr`, + fold_treebox_rep(`tr__pre:int`, `pt_1:int`, `Node (tree_delete x__pre (Node Leaf k v l_1)) k_1 v_1 r_`); substitute_st(inst_rule(TERM_PAIR_LIST( (term_pair){`l_1:indtree`, `l_:indtree`}, diff --git a/bst/insert_rec.c b/bst/insert_rec.c index ef29b417e1596dfb70ffc7a16864da1ab4ac2ee0..97f7cff6512df5fd7a28789339ca01dfea8e857e 100644 --- a/bst/insert_rec.c +++ b/bst/insert_rec.c @@ -64,11 +64,11 @@ void insert(struct tree **tr, int x, int valu) REQUIRE(`treebox_rep tr t`) ENSURE(`treebox_rep tr (tree_insert x valu t)`) { - PROOF unfold_treebox_rep(`tr__pre:addr`, `t:indtree`); + PROOF unfold_treebox_rep(`tr__pre:int`, `t:indtree`); struct tree *ptr = *tr; if (ptr == (void *)0) { - PROOF unfold_tree_null(`pt:addr`, `t:indtree`); + PROOF unfold_tree_null(`pt:int`, `t:indtree`); struct tree *new_node = malloc_tree_node(); new_node->key = x; @@ -81,38 +81,38 @@ void insert(struct tree **tr, int x, int valu) /* Both children of the fresh node are null, hence both are `Leaf`. */ apply_hconv_st(mp_rule(disch_all_rule(get_fold_tree_null(`0i`)), refl_rule(`0i`))); apply_hconv_st(mp_rule(disch_all_rule(get_fold_tree_null(`0i`)), refl_rule(`0i`))); - fold_tree_not_null(`retval:addr`, `0i`, `0i`, `Leaf`, `x__pre:int`, `valu__pre:int`, `Leaf`); - fold_treebox_rep(`tr__pre:addr`, `retval:addr`, `Node Leaf x__pre valu__pre Leaf`); + fold_tree_not_null(`retval:int`, `0i`, `0i`, `Leaf`, `x__pre:int`, `valu__pre:int`, `Leaf`); + fold_treebox_rep(`tr__pre:int`, `retval:int`, `Node Leaf x__pre valu__pre Leaf`); substitute_st(insert_leaf_result()); } } else { - PROOF unfold_tree_not_null(`pt:addr`, `t:indtree`); + PROOF unfold_tree_not_null(`pt:int`, `t:indtree`); int y = ptr->key; if (x < y) { - PROOF fold_treebox_rep(`field_addr pt Ttree Fleft`, `pa:addr`, `l:indtree`); + PROOF fold_treebox_rep(`field_addr pt Ttree Fleft`, `pa:int`, `l:indtree`); insert(&(ptr->left), x, valu); PROOF { unfold_treebox_rep(`field_addr pt Ttree Fleft`, `tree_insert x__pre valu__pre l`); - fold_tree_not_null(`pt:addr`, `pt_:addr`, `pb:addr`, + fold_tree_not_null(`pt:int`, `pt_:int`, `pb:int`, `tree_insert x__pre valu__pre l`, `k:int`, `v:int`, `r:indtree`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Node (tree_insert x__pre valu__pre l) k v r`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Node (tree_insert x__pre valu__pre l) k v r`); substitute_st(insert_left_result()); } } else if (x > y) { - PROOF fold_treebox_rep(`field_addr pt Ttree Fright`, `pb:addr`, `r:indtree`); + PROOF fold_treebox_rep(`field_addr pt Ttree Fright`, `pb:int`, `r:indtree`); insert(&(ptr->right), x, valu); PROOF { unfold_treebox_rep(`field_addr pt Ttree Fright`, `tree_insert x__pre valu__pre r`); - fold_tree_not_null(`pt:addr`, `pa:addr`, `pt_:addr`, + fold_tree_not_null(`pt:int`, `pa:int`, `pt_:int`, `l:indtree`, `k:int`, `v:int`, `tree_insert x__pre valu__pre r`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Node l k v (tree_insert x__pre valu__pre r)`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Node l k v (tree_insert x__pre valu__pre r)`); substitute_st(insert_right_result()); } @@ -120,9 +120,9 @@ void insert(struct tree **tr, int x, int valu) ptr->data = valu; PROOF { - fold_tree_not_null(`pt:addr`, `pa:addr`, `pb:addr`, + fold_tree_not_null(`pt:int`, `pa:int`, `pb:int`, `l:indtree`, `k:int`, `valu__pre:int`, `r:indtree`); - fold_treebox_rep(`tr__pre:addr`, `pt:addr`, `Node l k valu__pre r`); + fold_treebox_rep(`tr__pre:int`, `pt:int`, `Node l k valu__pre r`); substitute_st(insert_replace_result()); } } diff --git a/bst/lib/bst.c b/bst/lib/bst.c index d1b40be11d4a8031b565537322de1b4790bff6e0..c756023b7019dde50a49c2c9105c1d0bed7fccbb 100644 --- a/bst/lib/bst.c +++ b/bst/lib/bst.c @@ -28,13 +28,13 @@ PROOF thm tree_rep_def = cst_new_rec_definition( data_at (field_addr pt Ttree Fright) Tptr pb ** tree_rep pa l ** tree_rep pb r ) `, - `:addr->indtree->hprop` + `:int->indtree->cprop` ); PROOF thm treebox_rep_def = cst_new_fun_definition( "treebox_rep", `treebox_rep pp t -|- exists pt. data_at pp Tptr pt ** tree_rep pt t`, - `:addr->indtree->hprop` + `:int->indtree->cprop` ); /********************************************************** @@ -113,10 +113,12 @@ PROOF thm _hwand_refl = empty_theorem; PROOF thm hwand_refl() { if (IS_NULL(_hwand_refl)) { - term goal_tm = `forall hp. emp |-- (hp -* hp)`; + term hp = mk_var("hp", sl_prop()); + term goal_tm = mk_forall( + hp, mk_sl_ent(sl_emp(), mk_sl_wand(hp, hp))); gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(gsym_rule(get_hwand_hsep_adjoint())))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(gsym_rule(sl_wand_sep_adjoint())))); AUTO_INIT_SLTAC(g); _hwand_refl = gnode_prove(root); } @@ -127,11 +129,15 @@ PROOF thm _hwand_cancel = empty_theorem; PROOF thm hwand_cancel() { if (IS_NULL(_hwand_cancel)) { - term goal_tm = `forall hp hq. (hp -* hq) ** hp |-- hq`; + term hp = mk_var("hp", sl_prop()); + term hq = mk_var("hq", sl_prop()); + term goal_tm = list_mk_forall( + TERM_LIST(hp, hq), + mk_sl_ent(mk_sl_sep(mk_sl_wand(hp, hq), hp), hq)); gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_hwand_hsep_adjoint()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_hentail_refl()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(sl_wand_sep_adjoint()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(sl_ent_refl()))); _hwand_cancel = gnode_prove(root); } return _hwand_cancel; @@ -211,15 +217,15 @@ PROOF void unfold_tree_not_null(term pt, term t) { g = asm_rewrite_nth(g, 0); g = gs[1]; - g = EXISTS_SLTAC(g, `pa:addr`); + g = EXISTS_SLTAC(g, `pa:int`); g = LIST_EXISTS_SLTAC(g, - TERM_LIST(`pb:addr`, `a0:indtree`, `a1:int`, `a2:int`, `a3:indtree`)); + TERM_LIST(`pb:int`, `a0:indtree`, `a1:int`, `a2:int`, `a3:indtree`)); gnode_list gs2 = PURE_SLTAC(g); g = gs2[0]; g = CONV_TAC(g, rewrite_conv(THM_LIST(refl_rule(`Node a0 a1 a2 a3`)))); g = gs2[1]; g = asm_rewrite_nth(g, 1); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_hentail_refl()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(sl_ent_refl()))); _unfold_tree_not_null = gnode_prove(root); } @@ -272,7 +278,7 @@ PROOF thm get_fold_tree_not_null(term pt, term pa, term pb, term l, term k, term sl_fact_true_emp() ))); g = CLEAN_SLTAC(g); - g = LIST_EXISTS_SLTAC(g, TERM_LIST(`pa:addr`, `pb:addr`)); + g = LIST_EXISTS_SLTAC(g, TERM_LIST(`pa:int`, `pb:int`)); g = AUTO_FRAME_SLTAC(g); _fold_tree_not_null = gnode_prove(root); } @@ -296,7 +302,7 @@ PROOF thm get_fold_treebox_rep(term pp, term pt, term t) { g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, rewrite_conv(THM_LIST(treebox_rep_def))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `pt:addr`); + g = EXISTS_SLTAC(g, `pt:int`); g = AUTO_FRAME_SLTAC(g); _fold_treebox_rep = gnode_prove(root); } @@ -315,7 +321,7 @@ PROOF void unfold_treebox_rep(term pp, term t) { gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, rewrite_conv(THM_LIST(treebox_rep_def))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_hentail_refl()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(sl_ent_refl()))); _unfold_treebox_rep = gnode_prove(root); } apply_hconv_st(specl_rule(TERM_LIST(pp, t), _unfold_treebox_rep)); @@ -346,7 +352,7 @@ PROOF term _hwand_tree_rep_whole = ` PROOF thm hwand_tree_rep_child(term frame, term child, term hcon) { term rebuild_wand = `(tree_rep pt (Node l k v r) -* tree_rep pr t)`; thm fold = get_fold_tree_not_null( - `pt:addr`, `pa:addr`, `pb:addr`, + `pt:int`, `pa:int`, `pb:int`, `l:indtree`, `k:int`, `v:int`, `r:indtree`); fold = frame_left_slrule(rebuild_wand, fold); fold = rehant_slrule(fold, _hwand_tree_rep_whole); @@ -359,15 +365,15 @@ PROOF thm hwand_tree_rep_child(term frame, term child, term hcon) { thm result = rehcon_slrule(rehant_slrule(framed, _hwand_tree_rep_whole), hcon); result = disch_rule(`~(pt == 0i)`, result); - result = gen_rule(`pb:addr`, result); - result = gen_rule(`pa:addr`, result); + result = gen_rule(`pb:int`, result); + result = gen_rule(`pa:int`, result); result = gen_rule(`t:indtree`, result); - result = gen_rule(`pr:addr`, result); + result = gen_rule(`pr:int`, result); result = gen_rule(`r:indtree`, result); result = gen_rule(`v:int`, result); result = gen_rule(`k:int`, result); result = gen_rule(`l:indtree`, result); - return gen_rule(`pt:addr`, result); + return gen_rule(`pt:int`, result); } PROOF thm _fold_hwand_tree_rep_left = empty_theorem; @@ -418,7 +424,7 @@ PROOF thm tree_rep_transport(term pt, term from, term to) { gnode root = gnode_new_with_ccl(goal_tm), g; g = AUTO_INTROS_TAC(root); g = asm_rewrite_nth(g, 0); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_hentail_refl()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(sl_ent_refl()))); return specl_rule(TERM_LIST(pt, from, to), gnode_prove(root)); } @@ -428,6 +434,6 @@ PROOF thm tree_rep_transport(term pt, term from, term to) { PROOF thm hwand_tree_rep_transport(term pt, term from, term to, term target) { term eq = mk_eq(from, to); thm rw = rewrite(THM_LIST(assume_rule(eq)), - `(tree_rep ${pt:addr} ${from:indtree} -* ${target:hprop})`); + `(tree_rep ${pt:int} ${from:indtree} -* ${target:cprop})`); return disch_rule(eq, rw); } diff --git a/bst/lookup_loop.c b/bst/lookup_loop.c index a4ad582319358c50247269d8cc8aa0e8a39bb90b..0951e1ffb5718c061f6d63784c72b7b3072225c2 100644 --- a/bst/lookup_loop.c +++ b/bst/lookup_loop.c @@ -90,7 +90,7 @@ int lookup_loop(struct tree *tr, int x) /* The guard gives `pt != 0`, so unfolding exposes the node's fields and the * shape `subt == Node l k v r` the branch facts below need. */ - PROOF unfold_tree_not_null(`pt:addr`, `subt:indtree`); + PROOF unfold_tree_not_null(`pt:int`, `subt:indtree`); int key = tr->key; int val = tr->data; @@ -99,10 +99,10 @@ int lookup_loop(struct tree *tr, int x) tr = tr->left; PROOF { - substitute_st(hwand_tree_rep_transport(`pt:addr`, `subt:indtree`, + substitute_st(hwand_tree_rep_transport(`pt:int`, `subt:indtree`, `Node l k v r`, `tree_rep tr__pre t`)); - fold_hwand_tree_rep_left(`pt:addr`, `l:indtree`, `k:int`, `v:int`, `r:indtree`, - `tr__pre:addr`, `t:indtree`, `pa:addr`, `pb:addr`); + fold_hwand_tree_rep_left(`pt:int`, `l:indtree`, `k:int`, `v:int`, `r:indtree`, + `tr__pre:int`, `t:indtree`, `pa:int`, `pb:int`); add_fact_st(lookup_loop_left_result()); } @@ -110,10 +110,10 @@ int lookup_loop(struct tree *tr, int x) tr = tr->right; PROOF { - substitute_st(hwand_tree_rep_transport(`pt:addr`, `subt:indtree`, + substitute_st(hwand_tree_rep_transport(`pt:int`, `subt:indtree`, `Node l k v r`, `tree_rep tr__pre t`)); - fold_hwand_tree_rep_right(`pt:addr`, `l:indtree`, `k:int`, `v:int`, `r:indtree`, - `tr__pre:addr`, `t:indtree`, `pa:addr`, `pb:addr`); + fold_hwand_tree_rep_right(`pt:int`, `l:indtree`, `k:int`, `v:int`, `r:indtree`, + `tr__pre:int`, `t:indtree`, `pa:int`, `pb:int`); add_fact_st(lookup_loop_right_result()); } @@ -122,9 +122,9 @@ int lookup_loop(struct tree *tr, int x) * `tree_rep tr__pre t` for the postcondition. */ PROOF { - fold_tree_not_null(`pt:addr`, `pa:addr`, `pb:addr`, + fold_tree_not_null(`pt:int`, `pa:int`, `pb:int`, `l:indtree`, `k:int`, `v:int`, `r:indtree`); - substitute_st(hwand_tree_rep_transport(`pt:addr`, `subt:indtree`, + substitute_st(hwand_tree_rep_transport(`pt:int`, `subt:indtree`, `Node l k v r`, `tree_rep tr__pre t`)); apply_hconv_st(specl_rule(TERM_LIST(`tree_rep pt (Node l k v r)`, `tree_rep tr__pre t`), hwand_cancel())); @@ -137,9 +137,9 @@ int lookup_loop(struct tree *tr, int x) /* Exiting the loop means the current pointer is null, so `subt == Leaf`. */ PROOF { - unfold_tree_null(`pt:addr`, `subt:indtree`); - fold_tree_null(`pt:addr`); - substitute_st(hwand_tree_rep_transport(`pt:addr`, `subt:indtree`, + unfold_tree_null(`pt:int`, `subt:indtree`); + fold_tree_null(`pt:int`); + substitute_st(hwand_tree_rep_transport(`pt:int`, `subt:indtree`, `Leaf`, `tree_rep tr__pre t`)); apply_hconv_st(specl_rule(TERM_LIST(`tree_rep pt Leaf`, `tree_rep tr__pre t`), hwand_cancel())); diff --git a/bst/lookup_rec.c b/bst/lookup_rec.c index 195cabf6880165f7f3b45e12de46d8cf24d2922d..d63056fbd759193aad92ee6034ed63ea4ace2927 100644 --- a/bst/lookup_rec.c +++ b/bst/lookup_rec.c @@ -66,14 +66,14 @@ int lookup(struct tree *tr, int x) { if (tr == (void *)0) { PROOF { - unfold_tree_null(`tr__pre:addr`, `t:indtree`); - fold_tree_null(`tr__pre:addr`); + unfold_tree_null(`tr__pre:int`, `t:indtree`); + fold_tree_null(`tr__pre:int`); add_fact_st(lookup_leaf_result()); - apply_hconv_st(tree_rep_transport(`tr__pre:addr`, `Leaf`, `t:indtree`)); + apply_hconv_st(tree_rep_transport(`tr__pre:int`, `Leaf`, `t:indtree`)); } return 0; } else { - PROOF unfold_tree_not_null(`tr__pre:addr`, `t:indtree`); + PROOF unfold_tree_not_null(`tr__pre:int`, `t:indtree`); int key = tr->key; int val = tr->data; @@ -82,7 +82,7 @@ int lookup(struct tree *tr, int x) int ret = lookup(tr->left, x); PROOF { - fold_tree_not_null(`tr__pre:addr`, `pa:addr`, `pb:addr`, + fold_tree_not_null(`tr__pre:int`, `pa:int`, `pb:int`, `l:indtree`, `k:int`, `v:int`, `r:indtree`); add_fact_st(lookup_left_result()); } @@ -92,7 +92,7 @@ int lookup(struct tree *tr, int x) int ret = lookup(tr->right, x); PROOF { - fold_tree_not_null(`tr__pre:addr`, `pa:addr`, `pb:addr`, + fold_tree_not_null(`tr__pre:int`, `pa:int`, `pb:int`, `l:indtree`, `k:int`, `v:int`, `r:indtree`); add_fact_st(lookup_right_result()); } @@ -100,7 +100,7 @@ int lookup(struct tree *tr, int x) } else { PROOF { - fold_tree_not_null(`tr__pre:addr`, `pa:addr`, `pb:addr`, + fold_tree_not_null(`tr__pre:int`, `pa:int`, `pb:int`, `l:indtree`, `k:int`, `v:int`, `r:indtree`); add_fact_st(lookup_found_result()); } diff --git a/docs/PERFORMANCE_REGRESSION_ANALYSIS.md b/docs/PERFORMANCE_REGRESSION_ANALYSIS.md new file mode 100644 index 0000000000000000000000000000000000000000..7c9ab0eac59af01ffc73ec40df762e3dc9b20f12 --- /dev/null +++ b/docs/PERFORMANCE_REGRESSION_ANALYSIS.md @@ -0,0 +1,228 @@ +# Ghost-resource migration performance analysis + +Date: 2026-07-29 + +This document records the measured causes of the verification-time regression +after the user-defined ghost-resource migration. It distinguishes measured +costs from hypotheses and keeps the soundness checks of complete-state +transitions out of the optimization target. + +## Baselines + +The historical comparison must use fixed commits rather than the moving +`origin/main`, which now contains part of the ghost-resource work: + +- examples/userlib: `bda47c3`; +- proof standard library: `da9dd55`; +- verifier runtime: `16b0fb9`. + +The supplied complete-suite measurements give: + +| Example | Historical | Current | Difference | +|---|---:|---:|---:| +| `migrations/verifast/sorted_bintree.c` | 43.241 s | 75.416 s | +32.175 s | +| `migrations/vst/memmgr/malloc.c` | 143.335 s | 267.118 s | +123.783 s | + +The example diffs do not add enough proof work to explain these differences. +Sorted-bintree mostly changes `addr` annotations to `int` and removes several +cleanup calls. Malloc adds a small number of necessary mapping/alignment facts, +but retains the same overall proof structure. + +## Ruled-out explanations + +### The unit ghost RA does not deepen the assertion AST + +The selected SL operators are installed as closed monomorphic aliases. The +resource type `prod(mem_ra,gheap_ra(unit_ra))` occurs in their types and +definitions, not as repeated term arguments in every symbolic-state node. +Programs which do not use `own` therefore retain essentially the old +application tree. The assertion type is more complex, which can make type +matching more expensive, but it does not make a full-term traversal visit more +nodes. + +### Source alignment is not a main cost + +The descriptor-aware transition performs a proof-side ACU alignment and the +native setter validates the exact current source again. This is important for +soundness, but direct timing shows the proof-side alignment is negligible: + +| Example | Transitions | Source alignment | +|---|---:|---:| +| sorted-bintree | 117 | 0.047 s | +| VST malloc | 188 | 0.075 s | + +The old native setter also read the current state and checked an AC match, so +the entire native-setter time must not be attributed to a newly duplicated +check. + +### Recursive sampler counts are inclusive + +The earlier `qcp_boundary_eq` sample count included every active recursive +stack frame. It identifies a hot path, but cannot be compared directly with a +non-recursive function's sample count or interpreted as an RPC count. + +## Phase measurements + +Instrumentation around the existing descriptor-aware transition produced the +following results. The instrumentation only accumulated wall-clock time and +all runs completed with no VCs and no axioms. + +| Phase | sorted-bintree (117) | VST malloc (188) | +|---|---:|---:| +| read QCP state | 0.488 s | 1.646 s | +| decode boundary | 8.097 s | 21.543 s | +| source alignment | 0.047 s | 0.075 s | +| encode boundary | 9.304 s | 25.537 s | +| theorem transport | 0.020 s | 0.046 s | +| native setter | 10.996 s | 38.087 s | +| measured transition path | 28.952 s | 86.934 s | + +Malloc costs more per transition as well as having more transitions. This +shows that the regression scales with the size of the complete assertion, not +only with the number of commits. + +## Confirmed hotspot 1: recursive QCP boundary conversion + +The historical `bool_calls_eq` treated an ordinary `fact(p)` as opaque. It +only inspected `p` when it was a boolean call which required the QCP wrapper. + +The current `qcp_boundary_eq` additionally canonicalizes natural numerals. At +every visited node it can call `is_qcp_nat_literal`, `is_nat`, `is_int`, +`is_sl_fact`, and the combination/abstraction destructors. It also descends +into every pure predicate. Thus the same assertion AST now causes many more +synchronous HOL requests, even when it contains no ghost ownership. + +The implemented semantics-preserving conversion makes the direction tests +exclusive, stops at integer literals, decomposes an application spine once, +and removes redundant `is_comb` calls. On the same warm server, changing only +this implementation changed sorted-bintree from 78.17 s to 70.09 s, a gain of +8.08 s (10.3%). A subsequent uninstrumented run completed in 65.35 s. Both +the boundary regression and sorted-bintree completed with no verification +conditions and no axioms. The boundary regression explicitly checks exact +theorem endpoints, encode/decode idempotence, and preservation of an +existential binder. + +This client-side optimization was an intermediate step. The final +implementation removes the recursive C proof entirely: one +`qcpBoundaryRule(fact, tm, encode)` request traverses the complete term in the +HOL process and returns a theorem `|- tm = tm'`. The theorem is assembled only +with kernel rules (`REFL`, `ISPEC`, `SYM`, `TRANS`, `MK_COMB`, and `ABS`); the +caller still checks and transports the exact theorem endpoints. The selected, +closed `fact` constant is passed explicitly, so the RPC has no hidden assertion +model or mutable conversion registration. + +On a clean server this reduced sorted-bintree to **42.21 s**, compared with the +historical **43.241 s** and the regressed **75.416 s**. VST malloc completed in +**162.01 s**, compared with the historical **143.335 s** and the regressed +**267.118 s**. Both runs produced no verification conditions and no axioms. +The different residual result is useful: the ordinary-SL sorted-bintree case is +back at baseline, while the larger malloc proof still has about 18.7 s of +non-boundary overhead to investigate separately. + +The final complete-suite run, which reuses one warm server in the normal +`verify_all.sh` order, measured sorted-bintree at **40.491 s** and VST malloc at +**148.980 s**. It verified **152/152** included files with no failures (11 +explicitly ignored migration/teaching files) in **827.285 s** of total `cstarc` +time. This reduces malloc's residual gap to about 5.6 s in the representative +suite mode; no further speculative micro-optimization is justified by the +current data. + +The descriptor-backed transition path was subsequently batched one level +higher. A single +`qcpTransitionRule(fact, relation, sepAC, unitRules, qcpState, transition)` RPC +now performs boundary decode, certified SEP-ACU source alignment, target encode, +and theorem transport. All selected-theory operators and laws are explicit +arguments; the HOL server retains no SL theory state. The native setter still +re-reads and checks the exact current source, so this removes repeated RPCs +without weakening the concurrent/re-entrant state-change guard. Focused +boundary, ACU-alignment, and ghost/viewshift regressions passed without VCs or +axioms. The subsequent complete-suite run verified **152/152** included files +with no failures in **801.147 s**. Relative to the preceding boundary-only +batching run, total `cstarc` time fell from 827.285 s by 26.138 s (3.2%); +sorted-bintree remained within measurement noise at **40.214 s**, while VST +malloc decreased from 148.980 s to **147.620 s**. + +## Confirmed hotspot 2: descriptor-aware assertion serialization + +The native setter is dominated by `cst_print_assertion`, not by transition +validation. Calling the serializer once more for the same 117 targets cost +10.35 s, while the complete native setter cost 11.16 s in that run. + +The historical printer decomposed applications and dispatched mostly with a +local `strcmp` on the constant name. The current printer first invokes +`print_model_assertion` at every node. That function can try remote +`equals_term` checks for `emp`, `exists`, `pure`, `fact`, `equiv`, `bupd`, +`viewshift`, `sep`, conjunction, disjunction, and entailment. A miss then +falls through to the generic printer, which repeats node classification and +application decomposition. + +The implementation caches the names of descriptor-certified SL operator +constants per assertion-model generation and dispatches them locally. +It retained exact term identity for the operationally privileged `data_at` and +`undef_data_at` atoms. In a strict same-server A/B with a deliberately repeated +serializer probe: + +| Measurement | Current | Cached operator dispatch | +|---|---:|---:| +| native setter | 10.669 s | 4.981 s | +| independent serializer probe | 9.994 s | 4.300 s | +| total instrumented run | 85.39 s | 71.81 s | + +Because a normal verifier serializes once rather than twice, the directly +attributable normal-run gain is about 5.7 s; allowing for linked traversal work, +the expected sorted-bintree improvement is approximately 6--8 s. The installed +implementation also shares one application decomposition between the model and +generic printers. + +## Confirmed hotspot 3: polymorphic SL-binder recognition + +The old `is_sl_exists` used a binder-name check. The current implementation +constructs `mk_icomb(sl_exists(), abstraction)` so that the witness type is +instantiated and then performs an alpha comparison. This is precise but calls +the recursive type matcher on every recognition attempt. + +Replacing only this path in a temporary A/B with one server-side term match +reduced sorted-bintree by approximately 2--4 s. The final implementation is +simpler still: theory installation requires the selected binder heads to be HOL +constants and caches their globally unique constant names. Recognition checks +the application/abstraction shape, calls `dest_const` once, and compares the +name locally. The same implementation is used for `is_sl_exists` and +`is_sl_forall`; HOL's ordinary boolean quantifiers remain distinct. Regression +tests cover `num` and `int` witness instances and exact returned binder bodies. + +The current batched existential monotonicity rule and +`EXISTS_PULL_SLTAC`'s `PURE_REWRITE_CONV` are not the main regression. The +latter does not perform unrelated beta reduction, and the current monotonicity +implementation avoids repeatedly rebuilding its closed theorem. + +## Fixed initialization cost + +Small examples commonly increased from roughly 1--2 s to roughly 4--5 s. This +supports a fixed initialization cost of about 3--4 s from the larger selected +proof dependency graph and assertion-model installation. It matters for the +suite total, but cannot explain the size-dependent growth in sorted-bintree and +malloc. + +## Recommended implementation order + +1. **Implemented.** Optimize `qcp_boundary_eq` without changing its theorem + result: exclusive direction checks, integer short-circuiting, and one + application-spine decomposition. The regression covers encode/decode + idempotence and bound existentials. +2. **Implemented.** Cache descriptor-certified SL operator roles in the QCP printer, keyed by + assertion-model generation. Keep memory atoms on exact certified term + identity and share the generic/model application view. +3. **Implemented.** Recognize installed existential/universal binders by their + certified constant names instead of `mk_icomb` plus recursive client-side + type matching. +4. **Implemented.** Move boundary conversion into one theorem-producing HOL + RPC. This removes the per-node network multiplier without adding a trusted + syntactic equality or global conversion state. +5. **Implemented.** Re-run the two large benchmarks, focused runtime/proof + regressions, and the complete 152-file suite. All passed; improvements were + measured rather than assumed additive. + +Do not optimize by removing proof-side alignment, native exact-current-state +validation, theorem monomorphism checks, or the exact `data_at` codec boundary. +Their measured cost is small and they enforce the soundness properties of the +complete-state design. diff --git a/migrations/liveverif/array.c b/migrations/liveverif/array.c index 593fd0dc6a6e673e3a3f6ce91673bf509c29def2..d26e89038a57a7782db8d2977cc41d4aebd036b5 100644 --- a/migrations/liveverif/array.c +++ b/migrations/liveverif/array.c @@ -1,465 +1,8 @@ #include "migrations/liveverif/array.h" -/* Symbols used by specifications in clients. */ -PROOF static int _lv_ilength = - cst_add_const_to_header(`ilength:(A)list->int`); -PROOF static int _lv_inth = - cst_add_const_to_header(`inth:int->(int)list->int`); -PROOF static int _lv_replace_inth = - cst_add_const_to_header(`replace_inth:int->A->(A)list->(A)list`); -PROOF static int _lv_ireplicate = - cst_add_const_to_header(`ireplicate:int->A->(A)list`); - -PROOF static thm commute_antecedent(term a, term b, thm ent) { - thm commute = ispecl_rule(TERM_LIST(a, b), get_hsep_comm()); - return trans_slrule(eq2ent(sym_rule(commute)), ent); -} - -/********************************************************** - * Random-access array operations * - **********************************************************/ - -PROOF thm lv_array_add_length_operation_proof(const term goal_tm) { - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - thm th = specl_rule(TERM_LIST(`p:addr`, `ty:ctype`, `n:int`, - `xs:(int)list`), - get_array_at_length()); - ACCEPT_TAC(g, th); - return gnode_prove(root); -} - -decl_operation(lv_array_add_length_operation, - TERM_LIST(`p:addr`, `ty:ctype`), - TERM_LIST(`array_at (KEY p) (KEY ty) (CAPTURE (n:int)) - (CAPTURE (xs:(int)list))`), - term_list_n(0), - `array_at p ty n xs ** fact(ilength (xs:(int)list) == n)` -) - -PROOF void lv_array_add_length(term p, term ty) { - apply_operation_st(lv_array_add_length_operation, TERM_LIST(p, ty)); -} - -PROOF thm lv_array_open_cell_operation_proof(const term goal_tm) { - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - thm split = specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `i:int`, `n:int`, `xs:(int)list`), - get_array_at_split()); - split = mp_rule(split, assume_rule(`0i <= i`)); - split = mp_rule(split, assume_rule(`i < n`)); - ACCEPT_TAC(g, split); - return gnode_prove(root); -} - -decl_operation(lv_array_open_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`, `i:int`), - TERM_LIST(`array_at (KEY p) (KEY ty) (CAPTURE (n:int)) - (CAPTURE (xs:(int)list))`), - TERM_LIST(`0i <= i`, `i < n`), - `data_at (p + i * sizeof ty) ty (inth i xs) ** - array_at_missing_i_rec p ty i 0i n xs` -) - -PROOF void lv_array_open_cell(term p, term ty, term i) { - apply_operation_st(lv_array_open_cell_operation, TERM_LIST(p, ty, i)); -} - -PROOF thm lv_array_close_cell_operation_proof(const term goal_tm) { - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - term cell = `data_at (p + i * sizeof ty) ty v`; - term hole = `array_at_missing_i_rec p ty i 0i n xs`; - thm merge = specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `i:int`, `n:int`, `v:int`, - `xs:(int)list`), - get_array_at_merge()); - merge = mp_rule(merge, assume_rule(`0i <= i`)); - merge = mp_rule(merge, assume_rule(`i < n`)); - merge = commute_antecedent(cell, hole, merge); - ACCEPT_TAC(g, merge); - return gnode_prove(root); -} - -decl_operation(lv_array_close_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`, `i:int`), - TERM_LIST( - `array_at_missing_i_rec (KEY p) (KEY ty) (KEY i) (KEY 0i) - (CAPTURE (n:int)) (CAPTURE (xs:(int)list))`, - `data_at (KEY (p + i * sizeof ty)) (KEY ty) (CAPTURE (v:int))`), - TERM_LIST(`0i <= i`, `i < n`), - `array_at p ty n (replace_inth i v xs)` -) - -PROOF void lv_array_close_cell(term p, term ty, term i) { - apply_operation_st(lv_array_close_cell_operation, TERM_LIST(p, ty, i)); -} - -/********************************************************** - * Left-to-right overwrite cursor * - **********************************************************/ - -PROOF static thm lv_undef_array_rec_empty(term p, term ty, term i) { - term goal_tm = `undef_array_at_rec ${p:addr} ${ty:ctype} - ${i:int} ${i:int} 0i |-- emp`; - gnode root = gnode_new_with_ccl(goal_tm), g = root; - - thm base = specl_rule( - TERM_LIST(p, ty, `0i`, i, i, `0i`), get_undef_array_at_rec_base()); - base = conv_rule(rewrite_conv(THM_LIST(int_arith_rule(`0i + i == i`))), - base); - g = CONV_TAC(g, once_rewrite_conv(THM_LIST(base))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(int_arith_rule(`i - i == 0i`)))); - g = CONV_TAC(g, once_rewrite_conv( - THM_LIST(gsym_rule(get_undef_array_at_def())))); - thm zero = specl_rule( - TERM_LIST(`${p:addr} + ${i:int} * sizeof ${ty:ctype}`, ty, `0i`), - get_undef_array_at_zero()); - zero = mp_rule(zero, int_arith_rule(`0i == 0i`)); - g = CONV_TAC(g, once_rewrite_conv(THM_LIST(zero))); - AUTO_INIT_SLTAC(g); - return gnode_prove(root); -} - -PROOF static thm lv_undef_array_rec_split_head(term p, term ty, - term i, term n) { - term goal_tm = ` - ${i:int} < ${n:int} ==> - (undef_array_at_rec ${p:addr} ${ty:ctype} ${i:int} ${n:int} - (${n:int} - ${i:int}) |-- - undef_data_at (${p:addr} + ${i:int} * sizeof ${ty:ctype}) ${ty:ctype} ** - undef_array_at_rec ${p:addr} ${ty:ctype} (${i:int} + 1i) ${n:int} - (${n:int} - (${i:int} + 1i)))`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - - thm base = specl_rule( - TERM_LIST(p, ty, `0i`, i, n, `${n:int} - ${i:int}`), - get_undef_array_at_rec_base()); - base = conv_rule(rewrite_conv(THM_LIST( - int_arith_rule(`0i + i == i`))), base); - g = CONV_TAC(g, once_rewrite_conv(THM_LIST(base))); - g = CONV_TAC(g, once_rewrite_conv( - THM_LIST(gsym_rule(get_undef_array_at_def())))); - - thm positive = mp_rule( - int_arith_rule(`${i:int} < ${n:int} ==> ${n:int} - ${i:int} >= 1i`), - assume_rule(`${i:int} < ${n:int}`)); - thm split = mp_rule( - specl_rule( - TERM_LIST(`${p:addr} + ${i:int} * sizeof ${ty:ctype}`, ty, - `${n:int} - ${i:int}`), - get_undef_array_at_split_first()), - positive); - - g = CONV_TAC(g, rewrite_conv(THM_LIST(int_arith_rule(` - ${p:addr} + (${i:int} + 1i) * sizeof ${ty:ctype} == - (${p:addr} + ${i:int} * sizeof ${ty:ctype}) + sizeof ${ty:ctype}`)))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(int_arith_rule(` - ${n:int} - (${i:int} + 1i) == ${n:int} - ${i:int} - 1i`)))); - g = CONV_TAC(g, once_rewrite_conv(THM_LIST(split))); - return gnode_prove(root); -} - -PROOF static thm lv_array_begin_fill_entailment(term p, term ty, term n) { - term goal_tm = `undef_array_at ${p:addr} ${ty:ctype} ${n:int} |-- - array_at ${p:addr} ${ty:ctype} 0i ([]:(int)list) ** - undef_array_at_rec ${p:addr} ${ty:ctype} 0i ${n:int} ${n:int}`; - gnode root = gnode_new_with_ccl(goal_tm), g = root; - g = CONV_TAC(g, rewrite_conv( - THM_LIST(gsym_rule(get_undef_array_at_def())))); - thm zero = specl_rule( - TERM_LIST(p, ty, `0i`, `[]:(int)list`), get_array_at_zero()); - zero = mp_rule(zero, int_arith_rule(`0i == 0i`)); - zero = mp_rule(zero, refl_rule(`[]:(int)list`)); - g = CONV_TAC(g, rewrite_conv(THM_LIST(zero))); - AUTO_INIT_SLTAC(g); - return gnode_prove(root); -} - -PROOF thm lv_array_begin_fill_operation_proof(const term goal_tm) { - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - ACCEPT_TAC(g, lv_array_begin_fill_entailment( - `p:addr`, `ty:ctype`, `n:int`)); - return gnode_prove(root); -} - -decl_operation(lv_array_begin_fill_operation, - TERM_LIST(`p:addr`, `ty:ctype`), - TERM_LIST(`undef_array_at (KEY p) (KEY ty) (CAPTURE (n:int))`), - term_list_n(0), - `array_at p ty 0i ([]:(int)list) ** - undef_array_at_rec p ty 0i n n` -) - -PROOF void lv_array_begin_fill(term p, term ty) { - apply_operation_st(lv_array_begin_fill_operation, TERM_LIST(p, ty)); -} - -PROOF thm lv_array_open_fill_cell_operation_proof(const term goal_tm) { - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - thm split = lv_undef_array_rec_split_head( - `p:addr`, `ty:ctype`, `i:int`, `n:int`); - split = mp_rule(split, assume_rule(`i < n`)); - ACCEPT_TAC(g, split); - return gnode_prove(root); -} - -decl_operation(lv_array_open_fill_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`, `i:int`), - TERM_LIST(`undef_array_at_rec (KEY p) (KEY ty) (KEY i) - (CAPTURE (n:int)) - (KEY (n - i))`), - TERM_LIST(`i < n`), - `undef_data_at (p + i * sizeof ty) ty ** - undef_array_at_rec p ty (i + 1i) n (n - (i + 1i))` -) - -PROOF void lv_array_open_fill_cell(term p, term ty, term i) { - apply_operation_st(lv_array_open_fill_cell_operation, TERM_LIST(p, ty, i)); -} - -PROOF thm lv_array_close_fill_cell_operation_proof(const term goal_tm) { - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - thm close = specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `i:int`, `v:int`, `xs:(int)list`), - get_array_at_merge_last()); - ACCEPT_TAC(g, close); - return gnode_prove(root); -} - -decl_operation(lv_array_close_fill_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`), - TERM_LIST( - `array_at (KEY p) (KEY ty) (CAPTURE (i:int)) - (CAPTURE (xs:(int)list))`, - `data_at (KEY (p + i * sizeof ty)) (KEY ty) (CAPTURE (v:int))`), - term_list_n(0), - `array_at p ty (i + 1i) (xs ++ [v])` -) - -PROOF void lv_array_close_fill_cell(term p, term ty) { - apply_operation_st(lv_array_close_fill_cell_operation, TERM_LIST(p, ty)); -} - -PROOF thm lv_array_finish_fill_operation_proof(const term goal_tm) { - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - ACCEPT_TAC(g, lv_undef_array_rec_empty(`p:addr`, `ty:ctype`, `i:int`)); - return gnode_prove(root); -} - -decl_operation(lv_array_finish_fill_operation, - TERM_LIST(`p:addr`, `ty:ctype`, `i:int`), - TERM_LIST(`undef_array_at_rec (KEY p) (KEY ty) (KEY i) (KEY i) (KEY 0i)`), - term_list_n(0), - `emp` -) - -PROOF void lv_array_finish_fill(term p, term ty, term i) { - apply_operation_st(lv_array_finish_fill_operation, TERM_LIST(p, ty, i)); -} - -/********************************************************** - * Replication lemmas * - **********************************************************/ - -PROOF static thm lv_replicate_snoc(term n, term v) { - term goal_tm = `!(v:A) n. REPLICATE n v ++ [v] == REPLICATE (SUC n) v`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - gnode_list cases = INDUCT_TAC(g, `n:num`); - g = CONV_TAC(cases[0], rewrite_conv( - THM_LIST(get_REPLICATE(), get_APPEND()))); - thm ih = assume_rule(gnode_get_asmps(cases[1], CONST_STRING_LIST("H"))[0]); - g = CONV_TAC(cases[1], rewrite_conv( - THM_LIST(get_REPLICATE(), get_APPEND(), ih))); - return ispecl_rule(TERM_LIST(v, n), gnode_prove(root)); -} - -PROOF thm lv_ireplicate_zero_nil(term v) { - term goal_tm = `forall v:int. ireplicate 0i v == ([]:(int)list)`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_IREPLICATE_DEF(), - get_theorem_by_name("NUM_OF_INT_OF_NUM"), - get_REPLICATE()))); - return spec_rule(v, gnode_prove(root)); -} - -PROOF thm lv_ireplicate_snoc(term n, term v) { - term goal_tm = `!(v:A) n. 0i <= n ==> - ireplicate n v ++ [v] == ireplicate (n + 1i) v`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - thm num_add = match_mp_rule( - get_theorem_by_name("NUM_OF_INT_ADD"), - conj_rule(assume_rule(`0i <= n`), int_arith_rule(`0i <= 1i`))); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_IREPLICATE_DEF(), num_add, - get_theorem_by_name("NUM_OF_INT_OF_NUM"), - gsym_rule(get_theorem_by_name("ADD1")), - lv_replicate_snoc(`num_of_int n`, `v:A`)))); - return ispecl_rule(TERM_LIST(v, n), gnode_prove(root)); -} - -/********************************************************** - * Prefix lemmas * - **********************************************************/ - -PROOF static thm lv_num_of_int_zero(void) { - return ispec_rule(`0`, get_theorem_by_name("NUM_OF_INT_OF_NUM")); -} - -PROOF static thm lv_num_of_int_suc(void) { - thm add = specl_rule(TERM_LIST(`i:int`, `1i:int`), - get_theorem_by_name("NUM_OF_INT_ADD")); - add = conv_rule(rewrite_conv(THM_LIST( - get_theorem_by_name("NUM_OF_INT_OF_NUM"), - get_theorem_by_name("ADD1"))), add); - thm nonnegative = int_arith_rule(`0i <= i ==> 0i <= i && 0i <= 1i`); - return disch_rule(`0i <= i`, mp_rule(add, undisch_all_rule(nonnegative))); -} - -PROOF static thm lv_num_of_int_suc_at(term i) { - return inst_rule(TERM_PAIR_LIST((term_pair){i, `i:int`}), - lv_num_of_int_suc()); -} - -PROOF static thm lv_num_of_int_ilength(void) { - term goal_tm = `forall xs:(int)list. - num_of_int (ilength xs) == LENGTH xs`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - gnode_list cases = INDUCT_TAC(g, `xs:(int)list`); - - g = CONV_TAC(cases[0], rewrite_conv(THM_LIST( - get_ILENGTH_DEF(), get_theorem_by_name("LENGTH"), - lv_num_of_int_zero()))); - - thm length_suc = mp_rule( - lv_num_of_int_suc_at(`ilength (a1:(int)list)`), - ispec_rule(`a1:(int)list`, get_ILENGTH_NONNEG())); - g = CONV_TAC(cases[1], rewrite_conv(THM_LIST( - get_ILENGTH_DEF(), get_theorem_by_name("LENGTH"), - int_arith_rule(`1i + ilength (a1:(int)list) == ilength a1 + 1i`), - length_suc, get_theorem_by_name("ADD1"), - assume_rule(gnode_get_asmps(cases[1], CONST_STRING_LIST("H"))[0])))); - return gnode_prove(root); -} - -PROOF static thm lv_int_index_lt_length(term xs, term i) { - term goal_tm = `forall xs:(int)list i:int. - 0i <= i ==> i < ilength xs ==> num_of_int i < LENGTH xs`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - gsym_rule(ispec_rule(`xs:(int)list`, lv_num_of_int_ilength()))))); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - gsym_rule(get_theorem_by_name("INT_OF_NUM_LT"))))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(match_mp_rule( - get_theorem_by_name("INT_OF_NUM_OF_INT"), - assume_rule(`0i <= i`))))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(match_mp_rule( - get_theorem_by_name("INT_OF_NUM_OF_INT"), - ispec_rule(`xs:(int)list`, get_ILENGTH_NONNEG()))))); - ACCEPT_TAC(g, assume_rule( - gnode_get_asmps(g, CONST_STRING_LIST("H_0"))[0])); - thm result = gnode_prove(root); - result = specl_rule(TERM_LIST(xs, i), result); - result = mp_rule(result, assume_rule(`0i <= ${i:int}`)); - term required = dest_imp(concl(result)).tm1; - return mp_rule(result, assume_rule(required)); -} - -PROOF static thm lv_firstn_snoc(void) { - term goal_tm = `forall xs:(int)list n. - n < LENGTH xs ==> - FIRSTN n xs ++ [NTH n xs] == FIRSTN (n + 1) xs`; - gnode root = gnode_new_with_ccl(goal_tm), g = GEN_TAC(root, "xs"); - gnode_list list_cases = INDUCT_TAC(g, `xs:(int)list`); - - g = GEN_TAC(list_cases[0], "n"); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_theorem_by_name("LENGTH"), - conjunct1_rule(get_theorem_by_name("LT"))))); - - g = GEN_TAC(list_cases[1], "n"); - gnode_list n_cases = CASES_TAC(g, `n:num`, "C_n"); - - g = CONV_WITH_ASMP_TAC(n_cases[0], rewrite_conv, THM_LIST( - get_theorem_by_name("LENGTH"), - get_theorem_by_name("LT_0"), - get_theorem_by_name("ADD_CLAUSES"), - get_theorem_by_name("ONE"), - get_FIRSTN_DEF(), get_NTH_DEF(), get_APPEND())); - - g = CONV_WITH_ASMP_TAC(n_cases[1], rewrite_conv, THM_LIST( - get_theorem_by_name("LENGTH"), - get_theorem_by_name("LT_SUC"))); - g = DISCH_TAC(g, NULL); - thm ih = spec_rule(`n_:num`, assume_rule( - gnode_get_asmps(g, CONST_STRING_LIST("H"))[0])); - ih = mp_rule(ih, assume_rule( - gnode_get_asmps(g, CONST_STRING_LIST("H_0"))[0])); - g = CONV_WITH_ASMP_TAC(g, rewrite_conv, THM_LIST( - get_theorem_by_name("ADD_CLAUSES"), - get_FIRSTN_DEF(), get_NTH_DEF(), get_APPEND(), ih)); - return gnode_prove(root); -} - -PROOF thm lv_sublist_zero_nil(term xs) { - term goal_tm = `forall xs:(int)list. - sublist 0i 0i xs == ([]:(int)list)`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - get_SUBLIST_DEF(), lv_num_of_int_zero(), - get_FIRSTN_DEF(), get_SKIPN_DEF()))); - return spec_rule(xs, gnode_prove(root)); -} - -PROOF thm lv_sublist_snoc(term xs, term i) { - term goal_tm = `forall i xs:(int)list. - 0i <= i ==> i < ilength xs ==> - sublist 0i i xs ++ [inth i xs] == sublist 0i (i + 1i) xs`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - g = ASSUME_TAC(g, - lv_int_index_lt_length(`xs:(int)list`, `i:int`), "IDX"); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SUBLIST_DEF()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(lv_num_of_int_zero()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SKIPN_DEF()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_INTH_DEF()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - undisch_all_rule(lv_num_of_int_suc_at(`i:int`))))); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - gsym_rule(undisch_all_rule(lv_num_of_int_suc_at(`i:int`)))))); - thm firstn = specl_rule( - TERM_LIST(`xs:(int)list`, `num_of_int i`), lv_firstn_snoc()); - g = CONV_TAC(g, rewrite_conv(THM_LIST(undisch_all_rule(firstn)))); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - undisch_all_rule(lv_num_of_int_suc_at(`i:int`))))); - thm result = gnode_prove(root); - return specl_rule(TERM_LIST(i, xs), result); -} - -PROOF static thm lv_firstn_length_all(void) { - term goal_tm = `forall xs:(int)list. FIRSTN (LENGTH xs) xs == xs`; - gnode root = gnode_new_with_ccl(goal_tm), g = GEN_TAC(root, "xs"); - gnode_list cases = INDUCT_TAC(g, `xs:(int)list`); - g = CONV_TAC(cases[0], rewrite_conv(THM_LIST( - get_theorem_by_name("LENGTH"), get_FIRSTN_DEF()))); - g = CONV_TAC(cases[1], rewrite_conv(THM_LIST( - get_theorem_by_name("LENGTH"), get_FIRSTN_DEF(), - assume_rule(gnode_get_asmps( - cases[1], CONST_STRING_LIST("H"))[0])))); - return gnode_prove(root); -} - -PROOF thm lv_sublist_all(term xs, term n) { - term goal_tm = `forall n xs:(int)list. ilength xs == n ==> - sublist 0i n xs == xs`; - gnode root = gnode_new_with_ccl(goal_tm), g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SUBLIST_DEF()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(lv_num_of_int_zero()))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_SKIPN_DEF()))); - thm length_eq = ap_term_rule( - `num_of_int`, assume_rule(`ilength (xs:(int)list) == n`)); - length_eq = conv_rule(rewrite_conv(THM_LIST(lv_num_of_int_ilength())), - length_eq); - g = CONV_TAC(g, rewrite_conv(THM_LIST(gsym_rule(length_eq)))); - g = CONV_TAC(g, rewrite_conv(THM_LIST(lv_firstn_length_all()))); - thm result = gnode_prove(root); - return specl_rule(TERM_LIST(n, xs), result); -} +/* + * The old migration layer exposed one QCP predicate parameterized by + * `ctype`. The active array library instead exports only monomorphic + * char/int predicates, so there is no additional proof-time installation or + * compatibility definition here. + */ diff --git a/migrations/liveverif/array.h b/migrations/liveverif/array.h index 898b50bb14c12bf7bb8ee31398f67420a3550766..e7423a9f7c60bc9681e1d3ab7ee8f8159839e6d1 100644 --- a/migrations/liveverif/array.h +++ b/migrations/liveverif/array.h @@ -1,30 +1,13 @@ #pragma once -/* Generic array operations used by the LiveVerif translations. - * - * LiveVerif's `array elem n xs p` is represented by C*'s primitive - * `array_at p ty n xs`. The cursor predicate below describes the untouched - * suffix of a left-to-right overwrite. All operations preserve unmentioned - * resources by framing and apply independently to every state branch. +/* + * LiveVerif array migrations use the active monomorphic C array model. + * QCP-visible assertions therefore contain `char_array`, `char_fill`, or + * `undef_char_array`; no predicate carries a `ctype` argument. */ -#include "userlib/qcp/veriftime.h" -#require "userlib/qcp/veriftime.c" +#include "array/lib/array.h" +#require "array/lib/array.c" -#include "userlib/operational/operational.h" -#require "userlib/operational/operational.c" - -PROOF void lv_array_add_length(term p, term ty); -PROOF void lv_array_open_cell(term p, term ty, term i); -PROOF void lv_array_close_cell(term p, term ty, term i); - -PROOF void lv_array_begin_fill(term p, term ty); -PROOF void lv_array_open_fill_cell(term p, term ty, term i); -PROOF void lv_array_close_fill_cell(term p, term ty); -PROOF void lv_array_finish_fill(term p, term ty, term i); - -PROOF thm lv_ireplicate_zero_nil(term v); -PROOF thm lv_ireplicate_snoc(term n, term v); -PROOF thm lv_sublist_zero_nil(term xs); -PROOF thm lv_sublist_snoc(term xs, term i); -PROOF thm lv_sublist_all(term xs, term n); +#include "array/lib/list.h" +#require "array/lib/list.c" diff --git a/migrations/liveverif/fibonacci.c b/migrations/liveverif/fibonacci.c index 7095b0ea12f831f05004560647f16db66699c790..f0645adc0525bb1eb81b48f3569ca593b5f32eb6 100644 --- a/migrations/liveverif/fibonacci.c +++ b/migrations/liveverif/fibonacci.c @@ -1,5 +1,7 @@ #include "userlib/qcp/veriftime.h" #require "userlib/qcp/veriftime.c" +#include "proof/theory/c_program_logic/c_integer.h" +#require "proof/theory/c_program_logic/c_integer.c" #include "userlib/operational/operational.h" #require "userlib/operational/operational.c" diff --git a/migrations/liveverif/fmalloc.c b/migrations/liveverif/fmalloc.c index abaaae3dea0d26137e6b41c14f90e7bab0596624..42d8b1113b75f1e05badd385a49297ad6dce4aff 100644 --- a/migrations/liveverif/fmalloc.c +++ b/migrations/liveverif/fmalloc.c @@ -1,12 +1,18 @@ #include "userlib/qcp/veriftime.h" #require "userlib/qcp/veriftime.c" +#include "proof/theory/data/int_list.h" +#require "proof/theory/data/int_list.c" + #include "userlib/proof/probes.h" #require "userlib/proof/probes.c" #include "userlib/operational/operational.h" #require "userlib/operational/operational.c" +#include "array/lib/array.h" +#require "array/lib/array.c" + /* LiveVerifExamples/fmalloc.v. * * A free block stores the next pointer in its first pointer-sized slot. The @@ -44,10 +50,13 @@ PROOF static int _lv_free_list_field = PROOF thm lv_block_tail_def = cst_new_fun_definition( "lv_block_tail", `lv_block_tail p bs = - undef_array_at (p + sizeof Tptr) Tchar (bs - sizeof Tptr)`, - `:addr->int->hprop` + undef_char_array (p + sizeof Tptr) (bs - sizeof Tptr)`, + `:int->int->cprop` ); +PROOF static int _LV_FMALLOC_ARRAY_QCP = + install_array_qcp_interface(); + PROOF thm lv_free_list_def = cst_new_rec_definition( "lv_free_list", get_theorem_by_name("list_RECURSION"), @@ -59,7 +68,7 @@ PROOF thm lv_free_list_def = cst_new_rec_definition( lv_block_tail p bs ** lv_free_list bs q t)) `, - `:int->addr->(int)list->hprop` + `:int->int->(int)list->cprop` ); /* A contiguous sequence of still-uninitialized fixed-size blocks. Each @@ -77,7 +86,7 @@ PROOF thm lv_uninit_blocks_def = cst_new_rec_definition( lv_block_tail p bs ** lv_uninit_blocks bs (p + bs * sizeof Tchar) t)) `, - `:int->addr->(int)list->hprop` + `:int->int->(int)list->cprop` ); PROOF thm lv_ilength_zero_nil(void) { @@ -88,16 +97,16 @@ PROOF thm lv_ilength_zero_nil(void) { gnode_list cases = CASES_TAC(g, `xs:(int)list`, "C_xs"); g = CONV_WITH_ASMP_TAC( - cases[0], rewrite_conv, THM_LIST(get_ILENGTH_DEF())); + cases[0], rewrite_conv, THM_LIST(ILENGTH_DEF)); g = cases[1]; thm shape_length = ap_term_rule( `ilength:(int)list->int`, assume_rule(`xs == a0 :: a1:(int)list`)); shape_length = conv_rule( - rewrite_conv(THM_LIST(get_ILENGTH_DEF())), shape_length); + rewrite_conv(THM_LIST(ILENGTH_DEF)), shape_length); thm tail_nonnegative = ispec_rule( - `a1:(int)list`, get_ILENGTH_NONNEG()); + `a1:(int)list`, ILENGTH_NONNEG); thm impossible = mp_rule( mp_rule( mp_rule( @@ -124,7 +133,7 @@ PROOF thm lv_open_uninit_block_proof(const term goal_tm) { `ilength:(int)list->int`, assume_rule(`blocks == []:(int)list`)); length_zero = conv_rule( - rewrite_conv(THM_LIST(get_ILENGTH_DEF())), length_zero); + rewrite_conv(THM_LIST(ILENGTH_DEF)), length_zero); thm impossible = mp_rule( mp_rule( int_arith_rule(` @@ -143,7 +152,7 @@ PROOF thm lv_open_uninit_block_proof(const term goal_tm) { } decl_operation(lv_open_uninit_block, - TERM_LIST(`p:addr`, `bs:int`), + TERM_LIST(`p:int`, `bs:int`), TERM_LIST(`lv_uninit_blocks (KEY bs) (KEY p) (CAPTURE (blocks:(int)list))`), TERM_LIST(`0i < ilength (blocks:(int)list)`), @@ -163,7 +172,7 @@ decl_operation(lv_open_uninit_block, PROOF thm lv_advance_init_lengths_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(get_ILENGTH_DEF()))); + g = CONV_TAC(g, rewrite_conv(THM_LIST(ILENGTH_DEF))); gnode_list leaves = AUTO_INIT_SLTAC(g); gnode_list pure = PURE_SLTAC(leaves[0]); term_list arithmetic_asmps = labeled_term_list_to_term_list( @@ -238,7 +247,7 @@ PROOF thm lv_finish_init_blocks_proof(const term goal_tm) { } decl_operation(lv_finish_init_blocks, - TERM_LIST(`p:addr`, `bs:int`, `todo:(int)list`, + TERM_LIST(`p:int`, `bs:int`, `todo:(int)list`, `done:(int)list`, `remaining:int`, `n:int`), TERM_LIST(`lv_uninit_blocks (KEY bs) (KEY p) (KEY todo)`), TERM_LIST( @@ -267,7 +276,7 @@ PROOF thm lv_unfold_free_list_null_proof(const term goal_tm) { } decl_operation(lv_unfold_free_list_null, - TERM_LIST(`p:addr`, `bs:int`), + TERM_LIST(`p:int`, `bs:int`), TERM_LIST(`lv_free_list (KEY bs) (KEY p) (CAPTURE (blocks:(int)list))`), TERM_LIST(`p == 0i`), @@ -301,14 +310,14 @@ PROOF thm lv_unfold_free_list_cons_proof(const term goal_tm) { cases[1], rewrite_conv, THM_LIST(lv_free_list_def)); g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; g = LIST_EXISTS_SLTAC(g, - TERM_LIST(`a0:int`, `a1:(int)list`, `q:addr`)); + TERM_LIST(`a0:int`, `a1:(int)list`, `q:int`)); g = CONV_SLTAC(g, simp_conv(thm_list_n(0))); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(lv_unfold_free_list_cons, - TERM_LIST(`p:addr`, `bs:int`), + TERM_LIST(`p:int`, `bs:int`), TERM_LIST(`lv_free_list (KEY bs) (KEY p) (CAPTURE (blocks:(int)list))`), TERM_LIST(`~(p == 0i)`), @@ -325,16 +334,16 @@ PROOF thm lv_fold_free_list_cons_proof(const term goal_tm) { g = CONV_WITH_ASMP_SLTAC( g, rewrite_conv, THM_LIST(lv_free_list_def)); g = CLEAN_SLTAC(g); - g = EXISTS_SLTAC(g, `q:addr`); + g = EXISTS_SLTAC(g, `q:int`); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(lv_fold_free_list_cons, - TERM_LIST(`p:addr`, `bs:int`, `token:int`), + TERM_LIST(`p:int`, `bs:int`, `token:int`), TERM_LIST( `data_at (field_addr (KEY p) Tlv_free_node Fnext) Tptr - (CAPTURE (q:addr))`, + (CAPTURE (q:int))`, `lv_block_tail (KEY p) (KEY bs)`, `lv_free_list (KEY bs) (KEY q) (CAPTURE (tail:(int)list))`), TERM_LIST(`~(p == 0i)`), @@ -385,7 +394,7 @@ void fmalloc_init(struct lv_fmalloc_state *al, void *buf, apply_operation_st(lv_fold_free_list_null, TERM_LIST(`bs__pre:int`)); assert_fact_st( `ilength ([]:(int)list) + ilength (blocks:(int)list) == n__pre`, simp_conv, - THM_LIST(get_ILENGTH_DEF(), int_arith_rule(`0i + x == x`))); + THM_LIST(ILENGTH_DEF, int_arith_rule(`0i + x == x`))); } while (remaining > 0) @@ -394,7 +403,7 @@ void fmalloc_init(struct lv_fmalloc_state *al, void *buf, PROOF { apply_operation_named_st( lv_open_uninit_block, - TERM_LIST(`cursor_v:addr`, `bs__pre:int`), + TERM_LIST(`cursor_v:int`, `bs__pre:int`), TERM_LIST(`token:int`, `rest:(int)list`)); } @@ -406,13 +415,13 @@ void fmalloc_init(struct lv_fmalloc_state *al, void *buf, PROOF { apply_operation_st(lv_fold_free_list_cons, - TERM_LIST(`cursor_v:addr`, `bs__pre:int`, `token:int`)); + TERM_LIST(`cursor_v:int`, `bs__pre:int`, `token:int`)); thm todo_length = ap_term_rule( `ilength:(int)list->int`, assume_rule(`todo == token :: rest:(int)list`)); todo_length = conv_rule( - rewrite_conv(THM_LIST(get_ILENGTH_DEF())), todo_length); + rewrite_conv(THM_LIST(ILENGTH_DEF)), todo_length); add_fact_st(todo_length); apply_operation_st(lv_advance_init_lengths, TERM_LIST(`token:int`, `done:(int)list`, `todo:(int)list`, @@ -422,7 +431,7 @@ void fmalloc_init(struct lv_fmalloc_state *al, void *buf, PROOF { apply_operation_st(lv_finish_init_blocks, - TERM_LIST(`cursor_v:addr`, `bs__pre:int`, `todo:(int)list`, + TERM_LIST(`cursor_v:int`, `bs__pre:int`, `todo:(int)list`, `done:(int)list`, `remaining_v:int`, `n__pre:int`)); } @@ -434,7 +443,7 @@ void fmalloc_init(struct lv_fmalloc_state *al, void *buf, * while preserving the allocator state and every free block. */ unsigned int fmalloc_has_space(struct lv_fmalloc_state *al) - PARAM(`bs:int`, `head:addr`, `blocks:(int)list`) + PARAM(`bs:int`, `head:int`, `blocks:(int)list`) REQUIRE( `data_at (field_addr al Tlv_fmalloc_state Fblock_size) Tuint bs ** data_at (field_addr al Tlv_fmalloc_state Ffree_list) Tptr head ** @@ -452,9 +461,9 @@ unsigned int fmalloc_has_space(struct lv_fmalloc_state *al) if (head_value == (void *)0) { PROOF { apply_operation_st(lv_unfold_free_list_null, - TERM_LIST(`head:addr`, `bs:int`)); + TERM_LIST(`head:int`, `bs:int`)); assert_fact_st(`ilength (blocks:(int)list) == 0i`, simp_conv, - THM_LIST(get_ILENGTH_DEF())); + THM_LIST(ILENGTH_DEF)); apply_operation_st(lv_fold_free_list_null, TERM_LIST(`bs:int`)); } return 0; @@ -462,19 +471,19 @@ unsigned int fmalloc_has_space(struct lv_fmalloc_state *al) PROOF { apply_operation_named_st( lv_unfold_free_list_cons, - TERM_LIST(`head:addr`, `bs:int`), - TERM_LIST(`token:int`, `remaining:(int)list`, `next:addr`)); + TERM_LIST(`head:int`, `bs:int`), + TERM_LIST(`token:int`, `remaining:(int)list`, `next:int`)); thm remaining_nonnegative = ispec_rule( - `remaining:(int)list`, get_ILENGTH_NONNEG()); + `remaining:(int)list`, ILENGTH_NONNEG); thm remaining_positive = mp_rule( int_arith_rule( `0i <= ilength (remaining:(int)list) ==> 0i < 1i + ilength remaining`), remaining_nonnegative); assert_fact_st(`0i < ilength (blocks:(int)list)`, simp_conv, - THM_LIST(get_ILENGTH_DEF(), remaining_positive)); + THM_LIST(ILENGTH_DEF, remaining_positive)); apply_operation_st(lv_fold_free_list_cons, - TERM_LIST(`head:addr`, `bs:int`, `token:int`)); + TERM_LIST(`head:int`, `bs:int`, `token:int`)); } return 1; } @@ -484,7 +493,7 @@ unsigned int fmalloc_has_space(struct lv_fmalloc_state *al) * counterpart of LiveVerif's result-dependent postcondition. */ struct lv_free_node *fmalloc(struct lv_fmalloc_state *al) - PARAM(`bs:int`, `head:addr`, `blocks:(int)list`) + PARAM(`bs:int`, `head:int`, `blocks:(int)list`) REQUIRE( `data_at (field_addr al Tlv_fmalloc_state Fblock_size) Tuint bs ** data_at (field_addr al Tlv_fmalloc_state Ffree_list) Tptr head ** @@ -510,15 +519,15 @@ struct lv_free_node *fmalloc(struct lv_fmalloc_state *al) if (result == (void *)0) { PROOF { apply_operation_st(lv_unfold_free_list_null, - TERM_LIST(`head:addr`, `bs:int`)); + TERM_LIST(`head:int`, `bs:int`)); apply_operation_st(lv_fold_free_list_null, TERM_LIST(`bs:int`)); } return (void *)0; } else { PROOF apply_operation_named_st( lv_unfold_free_list_cons, - TERM_LIST(`head:addr`, `bs:int`), - TERM_LIST(`token:int`, `remaining:(int)list`, `next:addr`)); + TERM_LIST(`head:int`, `bs:int`), + TERM_LIST(`token:int`, `remaining:(int)list`, `next:int`)); struct lv_free_node *next_value = result->next; al->free_list = next_value; @@ -530,7 +539,7 @@ struct lv_free_node *fmalloc(struct lv_fmalloc_state *al) * form of LiveVerif's `n_remaining + 1` postcondition. */ void fmalloc_free(struct lv_fmalloc_state *al, struct lv_free_node *p) - PARAM(`bs:int`, `head:addr`, `blocks:(int)list`, `old_next:addr`) + PARAM(`bs:int`, `head:int`, `blocks:(int)list`, `old_next:int`) REQUIRE( `data_at (field_addr al Tlv_fmalloc_state Fblock_size) Tuint bs ** data_at (field_addr al Tlv_fmalloc_state Ffree_list) Tptr head ** @@ -549,5 +558,5 @@ void fmalloc_free(struct lv_fmalloc_state *al, struct lv_free_node *p) p->next = head_value; al->free_list = p; PROOF apply_operation_st(lv_fold_free_list_cons, - TERM_LIST(`p__pre:addr`, `bs:int`, `0i:int`)); + TERM_LIST(`p__pre:int`, `bs:int`, `0i:int`)); } diff --git a/migrations/liveverif/linked_list.c b/migrations/liveverif/linked_list.c index 0bc6aacffd6ab75bbcfc74217d441a73c74f52a4..1d1461af1d271cbaa0315241d9c803237e3ee9eb 100644 --- a/migrations/liveverif/linked_list.c +++ b/migrations/liveverif/linked_list.c @@ -1,5 +1,7 @@ #include "userlib/qcp/veriftime.h" #require "userlib/qcp/veriftime.c" +#include "proof/theory/c_program_logic/c_integer.h" +#require "proof/theory/c_program_logic/c_integer.c" #include "userlib/proof/probes.h" #require "userlib/proof/probes.c" @@ -39,7 +41,7 @@ PROOF thm lv_sll_def = cst_new_rec_definition( data_at (field_addr p Tlv_node Fnext) Tptr q ** lv_sll q t)) `, - `:addr->(int)list->hprop` + `:int->(int)list->cprop` ); PROOF thm lv_unfold_sll_null_proof(const term goal_tm) { @@ -59,7 +61,7 @@ PROOF thm lv_unfold_sll_null_proof(const term goal_tm) { } decl_operation(lv_unfold_sll_null, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), TERM_LIST(`lv_sll (KEY p) (CAPTURE (xs:(int)list))`), TERM_LIST(`p == 0i`), `fact(xs == []:(int)list)` @@ -92,14 +94,14 @@ PROOF thm lv_unfold_sll_cons_proof(const term goal_tm) { cases[1], rewrite_conv, THM_LIST(lv_sll_def)); g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; g = LIST_EXISTS_SLTAC(g, - TERM_LIST(`a0:int`, `a1:(int)list`, `q:addr`)); + TERM_LIST(`a0:int`, `a1:(int)list`, `q:int`)); g = CONV_SLTAC(g, simp_conv(thm_list_n(0))); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(lv_unfold_sll_cons, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), TERM_LIST(`lv_sll (KEY p) (CAPTURE (xs:(int)list))`), TERM_LIST(`~(p == 0i)`), `exists h t q. @@ -114,18 +116,18 @@ PROOF thm lv_fold_sll_cons_proof(const term goal_tm) { gnode g = AUTO_INIT_SLTAC(root)[0]; g = CONV_WITH_ASMP_SLTAC(g, rewrite_conv, THM_LIST(lv_sll_def)); g = CLEAN_SLTAC(g); - g = EXISTS_SLTAC(g, `q:addr`); + g = EXISTS_SLTAC(g, `q:int`); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(lv_fold_sll_cons, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), TERM_LIST( `data_at (field_addr (KEY p) Tlv_node Fdata) Tuint (CAPTURE (h:int))`, `data_at (field_addr (KEY p) Tlv_node Fnext) Tptr - (CAPTURE (q:addr))`, + (CAPTURE (q:int))`, `lv_sll (KEY q) (CAPTURE (t:(int)list))`), TERM_LIST(`~(p == 0i)`), `lv_sll p (h :: t)` @@ -150,7 +152,7 @@ struct lv_node *sll_reverse(struct lv_node *p) PROOF { apply_operation_st(lv_fold_sll_null, term_list_n(0)); assert_fact_st(`xs == (REVERSE []) ++ xs:(int)list`, simp_conv, - THM_LIST(get_REVERSE(), get_APPEND())); + THM_LIST(HOL_REVERSE, HOL_APPEND)); } while (cur != (void *)0) @@ -158,8 +160,8 @@ struct lv_node *sll_reverse(struct lv_node *p) { PROOF apply_operation_named_st( lv_unfold_sll_cons, - TERM_LIST(`cur_v:addr`), - TERM_LIST(`hd:int`, `tl:(int)list`, `next:addr`)); + TERM_LIST(`cur_v:int`), + TERM_LIST(`hd:int`, `tl:(int)list`, `next:int`)); struct lv_node *tail = cur->next; cur->next = acc; @@ -167,16 +169,16 @@ struct lv_node *sll_reverse(struct lv_node *p) cur = tail; PROOF { - apply_operation_st(lv_fold_sll_cons, TERM_LIST(`cur_v:addr`)); + apply_operation_st(lv_fold_sll_cons, TERM_LIST(`cur_v:int`)); assert_fact_st( `xs == (REVERSE (hd :: done)) ++ tl:(int)list`, simp_conv, - THM_LIST(get_REVERSE(), get_APPEND(), + THM_LIST(HOL_REVERSE, HOL_APPEND, gsym_rule(get_theorem_by_name("APPEND_ASSOC")))); } } PROOF { - apply_operation_st(lv_unfold_sll_null, TERM_LIST(`cur_v:addr`)); + apply_operation_st(lv_unfold_sll_null, TERM_LIST(`cur_v:int`)); assert_fact_st(`done == (REVERSE xs):(int)list`, simp_conv, THM_LIST(get_theorem_by_name("APPEND_NIL"), get_theorem_by_name("REVERSE_REVERSE"))); @@ -209,7 +211,7 @@ PROOF thm lv_sll_transport(term p, term from, term to) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm represented_equal = ap_term_rule( - `lv_sll (p:addr)`, assume_rule(`(b:(int)list) == a`)); + `lv_sll (p:int)`, assume_rule(`(b:(int)list) == a`)); ACCEPT_TAC(g, eq2ent(sym_rule(represented_equal))); return specl_rule(TERM_LIST(p, from, to), gnode_prove(root)); } @@ -221,7 +223,7 @@ void sll_inc(struct lv_node *p) { if (p == (void *)0) { PROOF { - apply_operation_st(lv_unfold_sll_null, TERM_LIST(`p__pre:addr`)); + apply_operation_st(lv_unfold_sll_null, TERM_LIST(`p__pre:int`)); apply_operation_st(lv_fold_sll_null, term_list_n(0)); assert_fact_st( `lv_inc_values xs == []:(int)list`, simp_conv, @@ -229,25 +231,25 @@ void sll_inc(struct lv_node *p) rewrite_st(THM_LIST( gsym_rule(assume_rule(`p__pre == 0i`)))); apply_hconv_st(lv_sll_transport( - `p__pre:addr`, `[]:(int)list`, `lv_inc_values xs`)); + `p__pre:int`, `[]:(int)list`, `lv_inc_values xs`)); } } else { PROOF apply_operation_named_st( lv_unfold_sll_cons, - TERM_LIST(`p__pre:addr`), - TERM_LIST(`head:int`, `tail:(int)list`, `next:addr`)); + TERM_LIST(`p__pre:int`), + TERM_LIST(`head:int`, `tail:(int)list`, `next:int`)); p->data = p->data + 1; sll_inc(p->next); PROOF { - apply_operation_st(lv_fold_sll_cons, TERM_LIST(`p__pre:addr`)); + apply_operation_st(lv_fold_sll_cons, TERM_LIST(`p__pre:int`)); assert_fact_st( `lv_inc_values xs == unsigned_last_nbits (head + 1i) 32i :: lv_inc_values tail`, simp_conv, THM_LIST(lv_inc_values_def)); apply_hconv_st(lv_sll_transport( - `p__pre:addr`, + `p__pre:int`, `unsigned_last_nbits (head + 1i) 32i :: lv_inc_values tail`, `lv_inc_values xs`)); } diff --git a/migrations/liveverif/memcpy.c b/migrations/liveverif/memcpy.c index cfb7cd3e0124b3b377a774f9a195339ae26cd96f..c0cc338193213f346113d941b081edea3bd485a1 100644 --- a/migrations/liveverif/memcpy.c +++ b/migrations/liveverif/memcpy.c @@ -1,86 +1,199 @@ #include "migrations/liveverif/array.h" #require "migrations/liveverif/array.c" -#include "array/lib/array_legacy.h" -#require "array/lib/array_legacy.c" - -/* Prefix extension with hypotheses phrased exactly as they occur in the loop - * state. The proof is a specialization of the generic list lemma; no array - * or memory facts are trusted. - */ -PROOF thm memcpy_prefix_snoc(term xs, term i, term n) { - thm step = lv_sublist_snoc(xs, i); - step = mp_rule(step, assume_rule(`0i <= ${i:int}`)); - thm in_range = int_arith_rule(` - ${i:int} < ${n:int} ==> - (ilength:(int)list->int) ${xs:(int)list} == ${n:int} ==> - ${i:int} < (ilength:(int)list->int) ${xs:(int)list}`); - in_range = mp_rule(in_range, assume_rule(`${i:int} < ${n:int}`)); - in_range = mp_rule(in_range, - assume_rule(`(ilength:(int)list->int) ${xs:(int)list} == ${n:int}`)); - return mp_rule(step, in_range); +PROOF static thm lv_memcpy_remaining_suc(term i, term n) { + gnode root = gnode_new_with_ccl(` + forall i n:int. + 0i <= i ==> i < n ==> + num_of_int (n - i) = SUC (num_of_int (n - (i + 1i))) + `); + gnode g = AUTO_INTROS_TAC(root); + thm tail_nonnegative = match_mp_rule( + int_arith_rule(`forall i n:int. + 0i <= i ==> i < n ==> 0i <= n - (i + 1i)`), + assume_rule(`0i <= i`)); + tail_nonnegative = match_mp_rule( + tail_nonnegative, assume_rule(`i < n`)); + thm num_add = match_mp_rule( + get_theorem_by_name("NUM_OF_INT_ADD"), + conj_rule(tail_nonnegative, int_arith_rule(`0i <= 1i`))); + thm expose = ap_term_rule( + `num_of_int`, + int_arith_rule(`n - i = (n - (i + 1i)) + 1i`)); + thm successor = conv_rule(rewrite_conv(THM_LIST( + get_theorem_by_name("NUM_OF_INT_OF_NUM"), + gsym_rule(get_theorem_by_name("ADD1")))), num_add); + ACCEPT_TAC(g, trans_rule(expose, successor)); + thm result = gnode_prove(root); + result = specl_rule(TERM_LIST(i, n), result); + result = mp_rule(result, assume_rule(`0i <= ${i:int}`)); + return mp_rule(result, assume_rule(`${i:int} < ${n:int}`)); } -/* LiveVerifExamples/memcpy.v. - * - * As in memset.c, C `char` is the signed logical view of a physical byte. - * The destination's old values are hidden by `store_undef_char_array`; the - * source list is preserved exactly and becomes the destination list. - */ +PROOF static thm lv_list_take_snoc(void) { + gnode root = gnode_new_with_ccl(` + forall xs:(int)list. forall k:num. + k < LENGTH xs ==> + list_take k xs ++ [EL k xs] = list_take (SUC k) xs + `); + gnode body = GEN_TAC(root, "xs"); + gnode_list xs_cases = INDUCT_TAC(body, `xs:(int)list`); + + gnode nil_case = GEN_TAC(xs_cases[0], "k"); + CONV_TAC(nil_case, rewrite_conv(THM_LIST( + get_theorem_by_name("LENGTH"), + conjunct1_rule(get_theorem_by_name("LT"))))); + + gnode cons_case = GEN_TAC(xs_cases[1], "k"); + gnode_list k_cases = CASES_TAC(cons_case, `k:num`, "C_k"); + CONV_WITH_ASMP_TAC(k_cases[0], rewrite_conv, THM_LIST( + get_theorem_by_name("LENGTH"), + get_theorem_by_name("LT_0"), + LIST_TAKE_DEF, + get_theorem_by_name("EL"), + get_theorem_by_name("HD"), + get_theorem_by_name("TL"), + get_theorem_by_name("APPEND"))); + + gnode step = CONV_WITH_ASMP_TAC(k_cases[1], rewrite_conv, THM_LIST( + get_theorem_by_name("LENGTH"), + get_theorem_by_name("LT_SUC"))); + step = DISCH_TAC(step, NULL); + thm ih = spec_rule(`n:num`, assume_rule( + gnode_get_asmps(step, CONST_STRING_LIST("H"))[0])); + ih = mp_rule(ih, assume_rule(`n < LENGTH (a1:(int)list)`)); + CONV_WITH_ASMP_TAC(step, rewrite_conv, THM_LIST( + LIST_TAKE_DEF, + get_theorem_by_name("EL"), + get_theorem_by_name("HD"), + get_theorem_by_name("TL"), + get_theorem_by_name("APPEND"), + ih)); + return gnode_prove(root); +} + +PROOF static thm lv_memcpy_prefix_length( + term i, term xs, thm nonnegative, thm upper) { + thm natural_bound = num_of_int_le_length_rule( + i, xs, nonnegative, + match_mp_rule( + int_arith_rule(`forall i n:int. i < n ==> i <= n`), + upper)); + thm length = mp_rule( + ispecl_rule(TERM_LIST(`num_of_int ${i:int}`, xs), + LENGTH_LIST_TAKE), + natural_bound); + thm integer_length = ap_term_rule(`int_of_num:num->int`, length); + thm roundtrip = int_of_num_of_int_rule(i, nonnegative); + integer_length = conv_rule( + once_rewrite_conv(THM_LIST(roundtrip)), integer_length); + return sym_rule(integer_length); +} + +PROOF static thm lv_memcpy_take_snoc( + term i, term xs, thm nonnegative, thm upper) { + thm natural_bound = num_of_int_lt_length_rule( + i, xs, nonnegative, upper); + thm step = mp_rule( + ispecl_rule(TERM_LIST(xs, `num_of_int ${i:int}`), + lv_list_take_snoc()), + natural_bound); + thm successor = num_of_int_suc_rule(i, nonnegative); + return conv_rule(once_rewrite_conv(THM_LIST(gsym_rule(successor))), step); +} + +PROOF static int _LV_MEMCPY_ARRAY_QCP = + install_array_qcp_interface(); + +/* LiveVerifExamples/memcpy.v over the selected-resource monomorphic char + * array interface. */ void Memcpy(void *dst, void *src, unsigned int n) PARAM(`src_data:(int)list`) - REQUIRE(`fact(0i <= n && n <= 4294967295i) ** - store_undef_char_array dst n ** - store_char_array src n src_data`) - ENSURE(`store_char_array dst n src_data ** - store_char_array src n src_data`) + REQUIRE(`fact(0i <= n && n <= 4294967295i && + n = &(LENGTH (src_data:(int)list))) ** + undef_char_array dst n ** + char_array src src_data`) + ENSURE(`char_array dst src_data ** char_array src src_data`) { unsigned int i = 0; + PROOF { + begin_char_fill(`dst__pre:int`); + thm initial = apply_conversion(rewrite_conv(THM_LIST( + int_arith_rule(`n__pre - 0i = n__pre`), + LIST_TAKE_DEF)), + `char_fill dst__pre + (list_take (0:num) (src_data:(int)list)) + (num_of_int (n__pre - 0i))`); + apply_hconv_st(eq2ent(sym_rule(initial))); + } + PROOF term loop_inv = `exists i_v. fact(0i <= i_v && i_v <= n__pre && - 0i <= n__pre && n__pre <= 4294967295i) ** - fact(ilength (src_data:(int)list) == n__pre) ** + n__pre = &(LENGTH (src_data:(int)list))) ** data_at i__addr Tuint i_v ** - store_char_array src__pre n__pre src_data ** - store_char_array dst__pre i_v (sublist 0i i_v src_data) ** - store_undef_char_array_rec dst__pre i_v n__pre + char_array src__pre src_data ** + char_fill dst__pre + (list_take (num_of_int i_v) src_data) + (num_of_int (n__pre - i_v)) `; - PROOF { - char_array_add_length(`src__pre:addr`); - char_array_begin_fill(`dst__pre:addr`); - rewrite_st(THM_LIST( - gsym_rule(lv_sublist_zero_nil(`src_data:(int)list`)))); - } - while (i < n) PART_INV(loop_inv) { PROOF { - char_array_open_cell(`src__pre:addr`, `i_v:int`); - char_array_open_fill_cell(`dst__pre:addr`, `i_v:int`); + thm nonnegative = assume_rule(`0i <= i_v`); + thm source_upper = rewrite_rule( + THM_LIST(assume_rule( + `n__pre = &(LENGTH (src_data:(int)list))`)), + assume_rule(`i_v < n__pre`)); + add_fact_st(source_upper); + add_fact_st(lv_memcpy_prefix_length( + `i_v:int`, `src_data:(int)list`, nonnegative, source_upper)); + rewrite_st(THM_LIST(lv_memcpy_remaining_suc( + `i_v:int`, `n__pre:int`))); + open_char_array(`src__pre:int`, `i_v:int`); + open_char_fill(`dst__pre:int`, `i_v:int`); } char v = *((char *)src + i); *((char *)dst + i) = v; PROOF { - char_array_close_read_cell(`src__pre:addr`, `i_v:int`); - char_array_close_fill_cell(`dst__pre:addr`); - rewrite_st(THM_LIST(memcpy_prefix_snoc( - `src_data:(int)list`, `i_v:int`, `n__pre:int`))); + close_char_array_read(`src__pre:int`, `i_v:int`); + close_char_fill(`dst__pre:int`, `i_v:int`); + thm nonnegative = assume_rule(`0i <= i_v`); + thm source_upper = assume_rule( + `i_v < &(LENGTH (src_data:(int)list))`); + substitute_st(lv_memcpy_take_snoc( + `i_v:int`, `src_data:(int)list`, nonnegative, source_upper)); } i = i + 1; + + PROOF add_fact_st(int_arith_rule(` + 0i <= i_v ==> i_v <= n__pre ==> i_v < n__pre ==> + 0i <= i_v + 1i && i_v + 1i <= n__pre + `)); } PROOF { - rewrite_st(THM_LIST(int_arith_rule(` - i_v:int <= n__pre ==> i_v >= n__pre ==> i_v == n__pre - `))); - char_array_finish_fill(`dst__pre:addr`, `n__pre:int`); + thm finished = match_mp_rule( + int_arith_rule(`forall i n:int. + i <= n ==> i >= n ==> i = n`), + assume_rule(`i_v <= n__pre`)); + finished = match_mp_rule(finished, assume_rule(`i_v >= n__pre`)); + thm index_length = trans_rule( + finished, + assume_rule(`n__pre = &(LENGTH (src_data:(int)list))`)); + thm natural_length = num_of_int_eq_length_rule( + `i_v:int`, `src_data:(int)list`, index_length); rewrite_st(THM_LIST( - lv_sublist_all(`src_data:(int)list`, `n__pre:int`))); + finished, + natural_length, + LIST_TAKE_LENGTH, + int_arith_rule(`n__pre - n__pre = 0i`), + get_theorem_by_name("NUM_OF_INT_OF_NUM"))); + finish_char_fill(`dst__pre:int`); } } diff --git a/migrations/liveverif/memset.c b/migrations/liveverif/memset.c index 5927909514bae832e8aada9956963cdbf161f208..e99de1954f3f2f84691ee4846945063cc73c7de3 100644 --- a/migrations/liveverif/memset.c +++ b/migrations/liveverif/memset.c @@ -1,57 +1,140 @@ #include "migrations/liveverif/array.h" #require "migrations/liveverif/array.c" -#include "array/lib/array_legacy.h" -#require "array/lib/array_legacy.c" - -/* LiveVerifExamples/memset.v. - * - * LiveVerif's arbitrary input byte list is observationally irrelevant because - * every cell is overwritten. The C* precondition therefore uses - * `undef_array_at`: ownership and extent are retained, while old values are - * existentially hidden. Because the legacy QCP parser currently rejects - * `unsigned char`, bytes use C `char`. This is a bijective signed view of the - * same 256 bit patterns; the verified statement is otherwise unchanged. - */ +/* A positive remaining integer count is the successor shape consumed by the + * monomorphic `char_fill` cursor. */ +PROOF static thm lv_memset_remaining_suc(term i, term n) { + gnode root = gnode_new_with_ccl(` + forall i n:int. + 0i <= i ==> i < n ==> + num_of_int (n - i) = SUC (num_of_int (n - (i + 1i))) + `); + gnode g = AUTO_INTROS_TAC(root); + thm tail_nonnegative = match_mp_rule( + int_arith_rule(`forall i n:int. + 0i <= i ==> i < n ==> 0i <= n - (i + 1i)`), + assume_rule(`0i <= i`)); + tail_nonnegative = match_mp_rule( + tail_nonnegative, assume_rule(`i < n`)); + thm num_add = match_mp_rule( + get_theorem_by_name("NUM_OF_INT_ADD"), + conj_rule(tail_nonnegative, int_arith_rule(`0i <= 1i`))); + thm expose = ap_term_rule( + `num_of_int`, + int_arith_rule(`n - i = (n - (i + 1i)) + 1i`)); + thm successor = conv_rule(rewrite_conv(THM_LIST( + get_theorem_by_name("NUM_OF_INT_OF_NUM"), + gsym_rule(get_theorem_by_name("ADD1")))), num_add); + ACCEPT_TAC(g, trans_rule(expose, successor)); + thm result = gnode_prove(root); + result = specl_rule(TERM_LIST(i, n), result); + result = mp_rule(result, assume_rule(`0i <= ${i:int}`)); + return mp_rule(result, assume_rule(`${i:int} < ${n:int}`)); +} + +PROOF static thm lv_replicate_snoc_nat(term n, term value) { + gnode root = gnode_new_with_ccl(` + forall n:num. forall v:int. + REPLICATE n v ++ [v] = REPLICATE (SUC n) v + `); + gnode body = GEN_TAC(root, "n"); + gnode_list cases = INDUCT_TAC(body, `n:num`); + CONV_TAC(AUTO_INTROS_TAC(cases[0]), rewrite_conv(THM_LIST( + HOL_REPLICATE, HOL_APPEND))); + CONV_WITH_ASMP_TAC(AUTO_INTROS_TAC(cases[1]), rewrite_conv, THM_LIST( + HOL_REPLICATE, HOL_APPEND)); + return ispecl_rule(TERM_LIST(n, value), gnode_prove(root)); +} + +PROOF static thm lv_memset_replicate_snoc( + term i, term value, thm nonnegative) { + thm step = lv_replicate_snoc_nat(`num_of_int ${i:int}`, value); + thm successor = num_of_int_suc_rule(i, nonnegative); + return conv_rule(once_rewrite_conv(THM_LIST(gsym_rule(successor))), step); +} + +PROOF static thm lv_memset_prefix_length( + term i, term value, thm nonnegative) { + thm length = ispecl_rule( + TERM_LIST(`num_of_int ${i:int}`, value), + get_theorem_by_name("LENGTH_REPLICATE")); + thm integer_length = ap_term_rule(`int_of_num:num->int`, length); + thm roundtrip = int_of_num_of_int_rule(i, nonnegative); + integer_length = conv_rule( + once_rewrite_conv(THM_LIST(roundtrip)), integer_length); + return sym_rule(integer_length); +} + +PROOF static int _LV_MEMSET_ARRAY_QCP = + install_array_qcp_interface(); + +/* LiveVerifExamples/memset.v, using the selected-resource char fill cursor. + * No QCP-visible predicate is parameterized by `ctype`. */ void Memset(void *a, char b, unsigned int n) REQUIRE(`fact(0i <= n && n <= 4294967295i) ** - store_undef_char_array a n`) - ENSURE(`store_char_array a n (ireplicate n b)`) + undef_char_array a n`) + ENSURE(`char_array a (REPLICATE (num_of_int n) b)`) { unsigned int i = 0; + PROOF { + begin_char_fill(`a__pre:int`); + thm initial = apply_conversion(rewrite_conv(THM_LIST( + int_arith_rule(`n__pre - 0i = n__pre`), + HOL_REPLICATE)), + `char_fill a__pre + (REPLICATE (0:num) b__pre) + (num_of_int (n__pre - 0i))`); + apply_hconv_st(eq2ent(sym_rule(initial))); + } + PROOF term loop_inv = `exists i_v. fact(0i <= i_v && i_v <= n__pre) ** data_at i__addr Tuint i_v ** - store_char_array a__pre i_v (ireplicate i_v b__pre) ** - store_undef_char_array_rec a__pre i_v n__pre + char_fill a__pre + (REPLICATE (num_of_int i_v) b__pre) + (num_of_int (n__pre - i_v)) `; - PROOF { - char_array_begin_fill(`a__pre:addr`); - rewrite_st(THM_LIST( - gsym_rule(lv_ireplicate_zero_nil(`b__pre:int`)))); - } - while (i < n) PART_INV(loop_inv) { - PROOF char_array_open_fill_cell(`a__pre:addr`, `i_v:int`); + PROOF { + thm nonnegative = assume_rule(`0i <= i_v`); + add_fact_st(lv_memset_prefix_length( + `i_v:int`, `b__pre:int`, nonnegative)); + rewrite_st(THM_LIST(lv_memset_remaining_suc( + `i_v:int`, `n__pre:int`))); + open_char_fill(`a__pre:int`, `i_v:int`); + } *((char *)a + i) = b; - i = i + 1; PROOF { - char_array_close_fill_cell(`a__pre:addr`); - rewrite_st(THM_LIST( - lv_ireplicate_snoc(`i_v:int`, `b__pre:int`))); + close_char_fill(`a__pre:int`, `i_v:int`); + thm nonnegative = assume_rule(`0i <= i_v`); + substitute_st(lv_memset_replicate_snoc( + `i_v:int`, `b__pre:int`, nonnegative)); } + + i = i + 1; + + PROOF add_fact_st(int_arith_rule(` + 0i <= i_v ==> i_v <= n__pre ==> i_v < n__pre ==> + 0i <= i_v + 1i && i_v + 1i <= n__pre + `)); } PROOF { - rewrite_st(THM_LIST(int_arith_rule(` - i_v:int <= n__pre ==> i_v >= n__pre ==> i_v == n__pre - `))); - char_array_finish_fill(`a__pre:addr`, `n__pre:int`); + thm finished = match_mp_rule( + int_arith_rule(`forall i n:int. + i <= n ==> i >= n ==> i = n`), + assume_rule(`i_v <= n__pre`)); + finished = match_mp_rule(finished, assume_rule(`i_v >= n__pre`)); + rewrite_st(THM_LIST( + finished, + int_arith_rule(`n__pre - n__pre = 0i`), + get_theorem_by_name("NUM_OF_INT_OF_NUM"))); + finish_char_fill(`a__pre:int`); } } diff --git a/migrations/liveverif/sort3.c b/migrations/liveverif/sort3.c index 04652289644eab955ad8a393e5d5cc3d7d4f6d77..d4375360066c46406cf083dea601bd07518d62f3 100644 --- a/migrations/liveverif/sort3.c +++ b/migrations/liveverif/sort3.c @@ -35,7 +35,7 @@ PROOF thm certify_sort3_result_proof(const term goal_tm) { } decl_operation(certify_sort3_result, - TERM_LIST(`p0:addr`, `p1:addr`, `p2:addr`, + TERM_LIST(`p0:int`, `p1:int`, `p2:int`, `a:int`, `b:int`, `c:int`), TERM_LIST( `data_at (KEY p0) (KEY Tuint) (CAPTURE (x:int))`, @@ -91,7 +91,7 @@ void sort3(unsigned int *a) } PROOF apply_operation_st(certify_sort3_result, - TERM_LIST(`a__pre:addr`, `a__pre + 1i * sizeof Tuint`, + TERM_LIST(`a__pre:int`, `a__pre + 1i * sizeof Tuint`, `a__pre + 2i * sizeof Tuint`, `in0:int`, `in1:int`, `in2:int`)); } @@ -133,6 +133,6 @@ void sort3_separate_args(unsigned int *a0, unsigned int *a1, } PROOF apply_operation_st(certify_sort3_result, - TERM_LIST(`a0__pre:addr`, `a1__pre:addr`, `a2__pre:addr`, + TERM_LIST(`a0__pre:int`, `a1__pre:int`, `a2__pre:int`, `in0:int`, `in1:int`, `in2:int`)); } diff --git a/migrations/verifast/lib/rep.c b/migrations/verifast/lib/rep.c index 42b09c1ae6a26c15aad6fad2d808de6cae2d7c20..110d328ce94d5696b2f89b9b036d79cd5e2ceb1f 100644 --- a/migrations/verifast/lib/rep.c +++ b/migrations/verifast/lib/rep.c @@ -26,9 +26,9 @@ PROOF static int _Fright = new_const_safe("Fright", `:field`); /* Only the assumed allocator creates this linear deallocation capability. */ PROOF static int _sb_node_token = - new_const_safe("sb_node_token", `:addr->hprop`); + new_const_safe("sb_node_token", `:int->cprop`); PROOF static int _sb_node_token_export = - cst_add_const_to_header(`sb_node_token:addr->hprop`); + cst_add_const_to_header(`sb_node_token:int->cprop`); PROOF thm SB_SHAPE_DEF = cst_new_rec_definition( "sb_shape", sorted_bintree.rec, @@ -42,12 +42,12 @@ PROOF thm SB_SHAPE_DEF = cst_new_rec_definition( data_at (field_addr p Ttree Fright) Tptr rp ** sb_shape lp l ** sb_shape rp r) `, - `:addr->sorted_bintree->hprop`); + `:int->sorted_bintree->cprop`); PROOF thm SORTED_BTREE_DEF = cst_new_fun_definition( "sorted_btree", `sorted_btree p t -|- sb_shape p t ** fact(sb_ordered t)`, - `:addr->sorted_bintree->hprop`); + `:int->sorted_bintree->cprop`); /*--------------------------- proof helpers ---------------------------*/ @@ -86,7 +86,7 @@ opened: PROOF static thm prove_sb_open_null_rule(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall t:sorted_bintree. + forall p:int. forall t:sorted_bintree. p = 0i ==> (sorted_btree p t |-- fact(t = SBEmpty)) `); gnode g = AUTO_INTROS_TAC(root); @@ -115,7 +115,7 @@ PROOF thm SB_OPEN_NULL_RULE = prove_sb_open_null_rule(); PROOF static thm prove_sb_open_node_rule(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall t:sorted_bintree. + forall p:int. forall t:sorted_bintree. ~(p = 0i) ==> (sorted_btree p t |-- exists root_key l r lp rp. @@ -149,7 +149,7 @@ PROOF static thm prove_sb_open_node_rule(void) { g = sb_open_all_spatial_existentials(g); g = LIST_EXISTS_SLTAC(g, TERM_LIST( `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`, - `lp:addr`, `rp:addr`)); + `lp:int`, `rp:int`)); gnode_list pure = PURE_SLTAC(g); for (size_t i = 0; i + 1 < vector_size(pure); ++i) { CONV_WITH_ASMP_TAC(pure[i], simp_conv, thm_list_n(0)); @@ -225,7 +225,7 @@ PROOF static thm prove_sb_concrete_node_nonnull(void) { thm result = trans_slrule(open_public, retain_nonnull); return genl_rule(TERM_LIST( - `p:addr`, `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`), + `p:int`, `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`), result); } @@ -234,7 +234,7 @@ PROOF static thm SB_CONCRETE_NODE_NONNULL = PROOF static thm prove_sb_nonnull_rule(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall t:sorted_bintree. + forall p:int. forall t:sorted_bintree. ~(t = SBEmpty) ==> (sorted_btree p t |-- sorted_btree p t ** fact(~(p = 0i))) @@ -253,7 +253,7 @@ PROOF static thm prove_sb_nonnull_rule(void) { g = sb_choose_assumption(g, 1, "r"); g = sb_rewrite_by_assumption(g, 1); ACCEPT_TAC(g, specl_rule( - TERM_LIST(`p:addr`, `root_key:int`, + TERM_LIST(`p:int`, `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`), SB_CONCRETE_NODE_NONNULL)); return gnode_prove(root); @@ -276,7 +276,7 @@ PROOF static thm prove_sb_concrete_node_model_nonempty(void) { result, `sorted_btree p (SBNode root_key l r) ** fact( ~(SBNode root_key l r = SBEmpty))`); return genl_rule(TERM_LIST( - `p:addr`, `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`), + `p:int`, `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`), result); } @@ -285,7 +285,7 @@ PROOF static thm SB_CONCRETE_NODE_MODEL_NONEMPTY = PROOF static thm prove_sb_model_nonempty_rule(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall t:sorted_bintree. + forall p:int. forall t:sorted_bintree. ~(p = 0i) ==> (sorted_btree p t |-- sorted_btree p t ** fact(~(t = SBEmpty))) @@ -307,7 +307,7 @@ PROOF static thm prove_sb_model_nonempty_rule(void) { g = sb_choose_assumption(g, 1, "r"); g = sb_rewrite_by_assumption(g, 1); ACCEPT_TAC(g, specl_rule( - TERM_LIST(`p:addr`, `root_key:int`, + TERM_LIST(`p:int`, `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`), SB_CONCRETE_NODE_MODEL_NONEMPTY)); return gnode_prove(root); @@ -320,7 +320,7 @@ PROOF thm SB_MODEL_NONEMPTY_RULE = PROOF static thm prove_sb_close_empty_rule(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. p = 0i ==> (emp |-- sorted_btree p SBEmpty) + forall p:int. p = 0i ==> (emp |-- sorted_btree p SBEmpty) `); gnode g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, rewrite_conv(THM_LIST( @@ -334,7 +334,7 @@ PROOF thm SB_CLOSE_EMPTY_RULE = prove_sb_close_empty_rule(); PROOF static thm prove_sb_close_node_rule(void) { gnode root = gnode_new_with_ccl(` - forall p lp rp:addr. forall root_key:int. + forall p lp rp:int. forall root_key:int. forall l r:sorted_bintree. ~(p = 0i) ==> (fact(sb_ordered (SBNode root_key l r)) ** sb_node_token p ** @@ -352,7 +352,7 @@ PROOF static thm prove_sb_close_node_rule(void) { g = AUTO_INIT_SLTAC(g)[0]; g = HCON_CONV_SLTAC( g, rewrite_conv(THM_LIST(sl_sep_exists_left()))); - g = LIST_EXISTS_SLTAC(g, TERM_LIST(`lp:addr`, `rp:addr`)); + g = LIST_EXISTS_SLTAC(g, TERM_LIST(`lp:int`, `rp:int`)); gnode_list pure = PURE_SLTAC(g); for (size_t i = 0; i + 1 < vector_size(pure); ++i) { CONV_WITH_ASMP_TAC(pure[i], simp_conv, thm_list_n(0)); @@ -363,28 +363,6 @@ PROOF static thm prove_sb_close_node_rule(void) { PROOF thm SB_CLOSE_NODE_RULE = prove_sb_close_node_rule(); -/*---------------------- initialized-to-undef rule --------------------*/ - -PROOF static thm prove_sb_forget_node_fields_rule(void) { - thm root_key = specl_rule( - TERM_LIST(`field_addr p Ttree Fvalue`, `Tint`, `root_key:int`), - get_data_at_to_undef_data_at()); - thm left = specl_rule( - TERM_LIST(`field_addr p Ttree Fleft`, `Tptr`, `lp:addr`), - get_data_at_to_undef_data_at()); - thm right = specl_rule( - TERM_LIST(`field_addr p Ttree Fright`, `Tptr`, `rp:addr`), - get_data_at_to_undef_data_at()); - thm fields = frame_mono_slrule(root_key, - frame_mono_slrule(left, right)); - thm with_token = frame_left_slrule(`sb_node_token p`, fields); - return genl_rule(TERM_LIST( - `p:addr`, `root_key:int`, `lp:addr`, `rp:addr`), with_token); -} - -PROOF thm SB_FORGET_NODE_FIELDS_RULE = - prove_sb_forget_node_fields_rule(); - /*-------------------------- PSI operations --------------------------*/ PROOF static thm open_sorted_btree_null_operation_proof( @@ -393,7 +371,7 @@ PROOF static thm open_sorted_btree_null_operation_proof( } decl_operation(open_sorted_btree_null_operation, - TERM_LIST(`p:addr`, `t:sorted_bintree`), + TERM_LIST(`p:int`, `t:sorted_bintree`), term_list_n(1, `sorted_btree (KEY p) (KEY t)`), term_list_n(1, `p = 0i`), `fact(t = SBEmpty)`) @@ -408,7 +386,7 @@ PROOF static thm open_sorted_btree_node_operation_proof( } decl_operation(open_sorted_btree_node_operation, - TERM_LIST(`p:addr`, `t:sorted_bintree`), + TERM_LIST(`p:int`, `t:sorted_bintree`), term_list_n(1, `sorted_btree (KEY p) (KEY t)`), term_list_n(1, `~(p = 0i)`), `exists root_key l r lp rp. @@ -437,7 +415,7 @@ PROOF static thm assert_sorted_btree_nonnull_operation_proof( } decl_operation(assert_sorted_btree_nonnull_operation, - TERM_LIST(`p:addr`, `t:sorted_bintree`), + TERM_LIST(`p:int`, `t:sorted_bintree`), term_list_n(1, `sorted_btree (KEY p) (KEY t)`), term_list_n(1, `~(t = SBEmpty)`), `sorted_btree p t ** fact(~(p = 0i))`) @@ -454,7 +432,7 @@ PROOF static thm assert_sorted_btree_model_nonempty_operation_proof( } decl_operation(assert_sorted_btree_model_nonempty_operation, - TERM_LIST(`p:addr`, `t:sorted_bintree`), + TERM_LIST(`p:int`, `t:sorted_bintree`), term_list_n(1, `sorted_btree (KEY p) (KEY t)`), term_list_n(1, `~(p = 0i)`), `sorted_btree p t ** fact(~(t = SBEmpty))`) @@ -471,7 +449,7 @@ PROOF static thm close_sorted_btree_empty_operation_proof( } decl_operation(close_sorted_btree_empty_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(0), term_list_n(1, `p = 0i`), `sorted_btree p SBEmpty`) @@ -486,9 +464,9 @@ PROOF static thm close_sorted_btree_node_operation_proof( } decl_operation(close_sorted_btree_node_operation, - TERM_LIST(`p:addr`, `root_key:int`, + TERM_LIST(`p:int`, `root_key:int`, `l:sorted_bintree`, `r:sorted_bintree`, - `lp:addr`, `rp:addr`), + `lp:int`, `rp:int`), TERM_LIST( `fact(sb_ordered (SBNode (KEY root_key) (KEY l) (KEY r)))`, `sb_node_token (KEY p)`, @@ -508,32 +486,6 @@ PROOF void close_sorted_btree_node( TERM_LIST(p, root_key, left_tree, right_tree, left_ptr, right_ptr)); } -PROOF static thm forget_sb_node_fields_operation_proof( - const term goal_tm) { - return prove_operation_by_closed_rule( - goal_tm, SB_FORGET_NODE_FIELDS_RULE); -} - -decl_operation(forget_sb_node_fields_operation, - TERM_LIST(`p:addr`, `root_key:int`, `lp:addr`, `rp:addr`), - TERM_LIST( - `sb_node_token (KEY p)`, - `data_at (field_addr (KEY p) Ttree Fvalue) Tint (KEY root_key)`, - `data_at (field_addr (KEY p) Ttree Fleft) Tptr (KEY lp)`, - `data_at (field_addr (KEY p) Ttree Fright) Tptr (KEY rp)`), - term_list_n(0), - `sb_node_token p ** - undef_data_at (field_addr p Ttree Fvalue) Tint ** - undef_data_at (field_addr p Ttree Fleft) Tptr ** - undef_data_at (field_addr p Ttree Fright) Tptr`) - -PROOF void forget_sb_node_fields( - const term p, const term root_key, - const term left_ptr, const term right_ptr) { - apply_operation_st(forget_sb_node_fields_operation, - TERM_LIST(p, root_key, left_ptr, right_ptr)); -} - PROOF static int _SORTED_BINTREE_REP_AUDIT = audit_closed_proof_unit( "sorted_bintree_rep", SORTED_BINTREE_REP_AXIOMS_BEFORE, THM_LIST( @@ -542,14 +494,12 @@ PROOF static int _SORTED_BINTREE_REP_AUDIT = audit_closed_proof_unit( SB_CONCRETE_NODE_NONNULL, SB_NONNULL_RULE, SB_CONCRETE_NODE_MODEL_NONEMPTY, SB_MODEL_NONEMPTY_RULE, SB_CLOSE_EMPTY_RULE, SB_CLOSE_NODE_RULE, - SB_FORGET_NODE_FIELDS_RULE, open_sorted_btree_null_operation.lemma, open_sorted_btree_node_operation.lemma, assert_sorted_btree_nonnull_operation.lemma, assert_sorted_btree_model_nonempty_operation.lemma, close_sorted_btree_empty_operation.lemma, - close_sorted_btree_node_operation.lemma, - forget_sb_node_fields_operation.lemma)); + close_sorted_btree_node_operation.lemma)); /* * Keep assumed C interfaces after all logical exports: the verification @@ -558,7 +508,7 @@ PROOF static int _SORTED_BINTREE_REP_AUDIT = audit_closed_proof_unit( */ void sb_alloc_node(struct tree **out) REQUIRE(`undef_data_at out Tptr`) - ENSURE_EX(TERM_LIST(`fresh:addr`), + ENSURE_EX(TERM_LIST(`fresh:int`), `data_at out Tptr fresh`, `fact(~(fresh = 0i))`, `sb_node_token fresh`, @@ -568,10 +518,11 @@ void sb_alloc_node(struct tree **out) ; void sb_free_node(struct tree *p) + PARAM(`root_key:int`, `lp:int`, `rp:int`) REQUIRE(`fact(~(p = 0i))`, `sb_node_token p`, - `undef_data_at (field_addr p Ttree Fvalue) Tint`, - `undef_data_at (field_addr p Ttree Fleft) Tptr`, - `undef_data_at (field_addr p Ttree Fright) Tptr`) + `data_at (field_addr p Ttree Fvalue) Tint root_key`, + `data_at (field_addr p Ttree Fleft) Tptr lp`, + `data_at (field_addr p Ttree Fright) Tptr rp`) ENSURE(`emp`) ; diff --git a/migrations/verifast/lib/rep.h b/migrations/verifast/lib/rep.h index c47be76a2d227293aaeb7d6d368171907c1120e8..f9808a135d4cd6fd57683555bf0f91df05578c9c 100644 --- a/migrations/verifast/lib/rep.h +++ b/migrations/verifast/lib/rep.h @@ -32,7 +32,6 @@ PROOF extern thm SB_NONNULL_RULE; PROOF extern thm SB_MODEL_NONEMPTY_RULE; PROOF extern thm SB_CLOSE_EMPTY_RULE; PROOF extern thm SB_CLOSE_NODE_RULE; -PROOF extern thm SB_FORGET_NODE_FIELDS_RULE; /* * Open an empty/nonempty public tree. The nonempty operation exposes the @@ -60,18 +59,13 @@ PROOF void close_sorted_btree_node( const term left_tree, const term right_tree, const term left_ptr, const term right_ptr); -/* Convert all initialized node fields to the undef resources required by free. */ -PROOF void forget_sb_node_fields( - const term p, const term value, - const term left_ptr, const term right_ptr); - /* * Foreign allocation boundary. The output cell is initialized with a fresh, * nonnull node carrying opaque deallocation provenance and three undef fields. */ void sb_alloc_node(struct tree **out) REQUIRE(`undef_data_at out Tptr`) - ENSURE_EX(TERM_LIST(`fresh:addr`), + ENSURE_EX(TERM_LIST(`fresh:int`), `data_at out Tptr fresh`, `fact(~(fresh = 0i))`, `sb_node_token fresh`, @@ -82,10 +76,11 @@ void sb_alloc_node(struct tree **out) /* Matching foreign deallocation boundary. */ void sb_free_node(struct tree *p) + PARAM(`root_key:int`, `lp:int`, `rp:int`) REQUIRE(`fact(~(p = 0i))`, `sb_node_token p`, - `undef_data_at (field_addr p Ttree Fvalue) Tint`, - `undef_data_at (field_addr p Ttree Fleft) Tptr`, - `undef_data_at (field_addr p Ttree Fright) Tptr`) + `data_at (field_addr p Ttree Fvalue) Tint root_key`, + `data_at (field_addr p Ttree Fleft) Tptr lp`, + `data_at (field_addr p Ttree Fright) Tptr rp`) ENSURE(`emp`) ; diff --git a/migrations/verifast/sorted_bintree.c b/migrations/verifast/sorted_bintree.c index 7de23dbea21db29b41ea193f5fdc2c130ebd0871..0c3ced2b2a9fda39891e26858279f220342e1d1a 100644 --- a/migrations/verifast/sorted_bintree.c +++ b/migrations/verifast/sorted_bintree.c @@ -329,7 +329,7 @@ struct tree *init_tree(int x) close_sorted_btree_empty(`0i`); prove_fresh_node_ordered(`x__pre:int`); close_sorted_btree_node( - `fresh:addr`, `x__pre:int`, `SBEmpty`, `SBEmpty`, `0i`, `0i`); + `fresh:int`, `x__pre:int`, `SBEmpty`, `SBEmpty`, `0i`, `0i`); } return result; @@ -341,18 +341,16 @@ void free_tree(struct tree *tree) ENSURE(`emp`) { if (tree == (void *)0) { - PROOF open_sorted_btree_null(`tree__pre:addr`, `model:sorted_bintree`); + PROOF open_sorted_btree_null(`tree__pre:int`, `model:sorted_bintree`); } else { PROOF open_ordered_node_as( - `tree__pre:addr`, `model:sorted_bintree`, + `tree__pre:int`, `model:sorted_bintree`, `root_value:int`, `left_model:sorted_bintree`, - `right_model:sorted_bintree`, `left_ptr:addr`, `right_ptr:addr`); + `right_model:sorted_bintree`, `left_ptr:int`, `right_ptr:int`); free_tree(tree->left); free_tree(tree->right); - PROOF forget_sb_node_fields( - `tree__pre:addr`, `root_value:int`, `left_ptr:addr`, `right_ptr:addr`); sb_free_node(tree); } } @@ -365,8 +363,8 @@ int contains(struct tree *tree, int x) { if (tree == (void *)0) { PROOF { - open_sorted_btree_null(`tree__pre:addr`, `model:sorted_bintree`); - close_sorted_btree_empty(`tree__pre:addr`); + open_sorted_btree_null(`tree__pre:int`, `model:sorted_bintree`); + close_sorted_btree_empty(`tree__pre:int`); prove_contains_result( `model:sorted_bintree`, `x__pre:int`, `0i`); align_model_result(`model = SBEmpty`); @@ -374,17 +372,17 @@ int contains(struct tree *tree, int x) return 0; } else { PROOF open_ordered_node_as( - `tree__pre:addr`, `model:sorted_bintree`, + `tree__pre:int`, `model:sorted_bintree`, `root_value:int`, `left_model:sorted_bintree`, - `right_model:sorted_bintree`, `left_ptr:addr`, `right_ptr:addr`); + `right_model:sorted_bintree`, `left_ptr:int`, `right_ptr:int`); int value = tree->value; if (x == value) { PROOF { close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `right_model:sorted_bintree`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); prove_contains_result( `model:sorted_bintree`, `x__pre:int`, `1i`); align_model_result( @@ -395,9 +393,9 @@ int contains(struct tree *tree, int x) int result = contains(tree->left, x); PROOF { close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `right_model:sorted_bintree`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); prove_contains_result( `model:sorted_bintree`, `x__pre:int`, `sb_contains_int left_model x__pre`); @@ -413,9 +411,9 @@ int contains(struct tree *tree, int x) int result = contains(tree->right, x); PROOF { close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `right_model:sorted_bintree`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); prove_contains_result( `model:sorted_bintree`, `x__pre:int`, `sb_contains_int right_model x__pre`); @@ -438,17 +436,17 @@ void add(struct tree *tree, int x) ENSURE(`sorted_btree tree (sb_add model x)`) { PROOF assert_sorted_btree_nonnull( - `tree__pre:addr`, `model:sorted_bintree`); + `tree__pre:int`, `model:sorted_bintree`); PROOF open_ordered_node_as( - `tree__pre:addr`, `model:sorted_bintree`, + `tree__pre:int`, `model:sorted_bintree`, `root_value:int`, `left_model:sorted_bintree`, - `right_model:sorted_bintree`, `left_ptr:addr`, `right_ptr:addr`); + `right_model:sorted_bintree`, `left_ptr:int`, `right_ptr:int`); int value = tree->value; if (x < value) { if (tree->left == (void *)0) { PROOF open_sorted_btree_null( - `left_ptr:addr`, `left_model:sorted_bintree`); + `left_ptr:int`, `left_model:sorted_bintree`); struct tree *child = init_tree(x); tree->left = child; @@ -457,9 +455,9 @@ void add(struct tree *tree, int x) `model:sorted_bintree`, `x__pre:int`, `SBNode root_value (SBNode x__pre SBEmpty SBEmpty) right_model`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `SBNode x__pre SBEmpty SBEmpty`, `right_model:sorted_bintree`, - `retval:addr`, `right_ptr:addr`); + `retval:int`, `right_ptr:int`); align_model_result( `sb_add model x__pre = SBNode root_value (SBNode x__pre SBEmpty SBEmpty) right_model`); @@ -467,7 +465,7 @@ void add(struct tree *tree, int x) } else { PROOF { expose_nonempty_child( - `left_ptr:addr`, `left_model:sorted_bintree`); + `left_ptr:int`, `left_model:sorted_bintree`); expose_left_child_absence( `model:sorted_bintree`, `root_value:int`, `left_model:sorted_bintree`, `right_model:sorted_bintree`, @@ -480,9 +478,9 @@ void add(struct tree *tree, int x) `model:sorted_bintree`, `x__pre:int`, `SBNode root_value (sb_add left_model x__pre) right_model`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `sb_add left_model x__pre`, `right_model:sorted_bintree`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); align_model_result( `sb_add model x__pre = SBNode root_value (sb_add left_model x__pre) right_model`); @@ -492,7 +490,7 @@ void add(struct tree *tree, int x) PROOF prove_add_right_branch_guard(`x__pre:int`, `root_value:int`); if (tree->right == (void *)0) { PROOF open_sorted_btree_null( - `right_ptr:addr`, `right_model:sorted_bintree`); + `right_ptr:int`, `right_model:sorted_bintree`); struct tree *child = init_tree(x); tree->right = child; @@ -501,9 +499,9 @@ void add(struct tree *tree, int x) `model:sorted_bintree`, `x__pre:int`, `SBNode root_value left_model (SBNode x__pre SBEmpty SBEmpty)`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `SBNode x__pre SBEmpty SBEmpty`, - `left_ptr:addr`, `retval:addr`); + `left_ptr:int`, `retval:int`); align_model_result( `sb_add model x__pre = SBNode root_value left_model (SBNode x__pre SBEmpty SBEmpty)`); @@ -511,7 +509,7 @@ void add(struct tree *tree, int x) } else { PROOF { expose_nonempty_child( - `right_ptr:addr`, `right_model:sorted_bintree`); + `right_ptr:int`, `right_model:sorted_bintree`); expose_right_child_absence( `model:sorted_bintree`, `root_value:int`, `left_model:sorted_bintree`, `right_model:sorted_bintree`, @@ -524,9 +522,9 @@ void add(struct tree *tree, int x) `model:sorted_bintree`, `x__pre:int`, `SBNode root_value left_model (sb_add right_model x__pre)`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `sb_add right_model x__pre`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); align_model_result( `sb_add model x__pre = SBNode root_value left_model (sb_add right_model x__pre)`); @@ -539,9 +537,9 @@ void add(struct tree *tree, int x) `model:sorted_bintree`, `x__pre:int`, `SBNode root_value left_model right_model`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `right_model:sorted_bintree`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); align_model_result( `sb_add model x__pre = SBNode root_value left_model right_model`); } @@ -556,22 +554,22 @@ int maximum(struct tree *tree) return_int(`sb_max model`)) { PROOF assert_sorted_btree_nonnull( - `tree__pre:addr`, `model:sorted_bintree`); + `tree__pre:int`, `model:sorted_bintree`); PROOF open_ordered_node_as( - `tree__pre:addr`, `model:sorted_bintree`, + `tree__pre:int`, `model:sorted_bintree`, `root_value:int`, `left_model:sorted_bintree`, - `right_model:sorted_bintree`, `left_ptr:addr`, `right_ptr:addr`); + `right_model:sorted_bintree`, `left_ptr:int`, `right_ptr:int`); if (tree->right == (void *)0) { int result = tree->value; PROOF { - open_sorted_btree_null(`right_ptr:addr`, `right_model:sorted_bintree`); - close_sorted_btree_empty(`right_ptr:addr`); + open_sorted_btree_null(`right_ptr:int`, `right_model:sorted_bintree`); + close_sorted_btree_empty(`right_ptr:int`); substitute_st(assume_rule(`right_model = SBEmpty`)); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `SBEmpty`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); prove_maximum_value(`model:sorted_bintree`, `root_value:int`); align_model_result( `model = SBNode root_value left_model SBEmpty`); @@ -579,14 +577,14 @@ int maximum(struct tree *tree) return result; } else { PROOF expose_nonempty_child( - `right_ptr:addr`, `right_model:sorted_bintree`); + `right_ptr:int`, `right_model:sorted_bintree`); int result = maximum(tree->right); PROOF { substitute_fact_st(`retval = sb_max right_model`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `right_model:sorted_bintree`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `right_ptr:int`); prove_maximum_value( `model:sorted_bintree`, `sb_max right_model`); align_model_result( @@ -607,22 +605,18 @@ struct tree *remove_tree(struct tree *tree, int x) `fact(sb_absent (sb_remove model x) x)`) { PROOF assert_sorted_btree_nonnull( - `tree__pre:addr`, `model:sorted_bintree`); + `tree__pre:int`, `model:sorted_bintree`); PROOF open_ordered_node_as( - `tree__pre:addr`, `model:sorted_bintree`, + `tree__pre:int`, `model:sorted_bintree`, `root_value:int`, `left_model:sorted_bintree`, - `right_model:sorted_bintree`, `left_ptr:addr`, `right_ptr:addr`); + `right_model:sorted_bintree`, `left_ptr:int`, `right_ptr:int`); int value = tree->value; if (x == value) { if (tree->left == (void *)0) { struct tree *result = tree->right; - PROOF { - open_sorted_btree_null(`left_ptr:addr`, `left_model:sorted_bintree`); - forget_sb_node_fields( - `tree__pre:addr`, `root_value:int`, - `left_ptr:addr`, `right_ptr:addr`); - } + PROOF open_sorted_btree_null( + `left_ptr:int`, `left_model:sorted_bintree`); sb_free_node(tree); PROOF { prove_remove_result_absent(`model:sorted_bintree`, `x__pre:int`); @@ -637,11 +631,8 @@ struct tree *remove_tree(struct tree *tree, int x) struct tree *result = tree->left; PROOF { expose_nonempty_child( - `left_ptr:addr`, `left_model:sorted_bintree`); - open_sorted_btree_null(`right_ptr:addr`, `right_model:sorted_bintree`); - forget_sb_node_fields( - `tree__pre:addr`, `root_value:int`, - `left_ptr:addr`, `right_ptr:addr`); + `left_ptr:int`, `left_model:sorted_bintree`); + open_sorted_btree_null(`right_ptr:int`, `right_model:sorted_bintree`); } sb_free_node(tree); PROOF { @@ -656,9 +647,9 @@ struct tree *remove_tree(struct tree *tree, int x) } else { PROOF { expose_nonempty_child( - `left_ptr:addr`, `left_model:sorted_bintree`); + `left_ptr:int`, `left_model:sorted_bintree`); expose_nonempty_child( - `right_ptr:addr`, `right_model:sorted_bintree`); + `right_ptr:int`, `right_model:sorted_bintree`); prove_maximum_is_present(`left_model:sorted_bintree`); } int predecessor = maximum(tree->left); @@ -673,9 +664,9 @@ struct tree *remove_tree(struct tree *tree, int x) `SBNode (sb_max left_model) (sb_remove left_model (sb_max left_model)) right_model`); close_sorted_btree_node( - `tree__pre:addr`, `sb_max left_model`, + `tree__pre:int`, `sb_max left_model`, `sb_remove left_model (sb_max left_model)`, - `right_model:sorted_bintree`, `retval:addr`, `right_ptr:addr`); + `right_model:sorted_bintree`, `retval:int`, `right_ptr:int`); align_model_result( `sb_remove model x__pre = SBNode (sb_max left_model) @@ -698,9 +689,9 @@ struct tree *remove_tree(struct tree *tree, int x) `model:sorted_bintree`, `x__pre:int`, `SBNode root_value (sb_remove left_model x__pre) right_model`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `sb_remove left_model x__pre`, `right_model:sorted_bintree`, - `retval:addr`, `right_ptr:addr`); + `retval:int`, `right_ptr:int`); align_model_result( `sb_remove model x__pre = SBNode root_value (sb_remove left_model x__pre) right_model`); @@ -722,9 +713,9 @@ struct tree *remove_tree(struct tree *tree, int x) `model:sorted_bintree`, `x__pre:int`, `SBNode root_value left_model (sb_remove right_model x__pre)`); close_sorted_btree_node( - `tree__pre:addr`, `root_value:int`, + `tree__pre:int`, `root_value:int`, `left_model:sorted_bintree`, `sb_remove right_model x__pre`, - `left_ptr:addr`, `retval:addr`); + `left_ptr:int`, `retval:int`); align_model_result( `sb_remove model x__pre = SBNode root_value left_model (sb_remove right_model x__pre)`); diff --git a/migrations/vst/append/append.c b/migrations/vst/append/append.c index c602c136d1cd691029bdb6773d755c192ef6e675..a87d9bba1bdf4af1492245c2eb5926fd835cebf0 100644 --- a/migrations/vst/append/append.c +++ b/migrations/vst/append/append.c @@ -20,25 +20,25 @@ struct vst_append_node *vst_append( if (x == (void *)0) { PROOF { - open_vst_append_list_null(`x__pre:addr`); + open_vst_append_list_null(`x__pre:int`); finish_vst_append_empty( - `y__pre:addr`, `xs:(int)list`, `ys:(int)list`); + `y__pre:int`, `xs:(int)list`, `ys:(int)list`); } return y; } else { PROOF open_vst_append_list_nonnull_as( - `x__pre:addr`, `current_head:int`, - `rest:(int)list`, `next:addr`); + `x__pre:int`, `current_head:int`, + `rest:(int)list`, `next:int`); t = x; u = t->tail; PROOF begin_vst_append_context( - `x__pre:addr`, `xs:(int)list`, `ys:(int)list`, + `x__pre:int`, `xs:(int)list`, `ys:(int)list`, `current_head:int`, `rest:(int)list`); PROOF term loop_inv = ` - exists current:addr. exists next_ptr:addr. + exists current:int. exists next_ptr:int. exists current_value:int. exists remaining:(int)list. data_at x__addr Tptr x__pre ** data_at y__addr Tptr y__pre ** @@ -61,28 +61,28 @@ struct vst_append_node *vst_append( PART_INV(loop_inv) { PROOF open_vst_append_list_nonnull_as( - `next_ptr:addr`, `next_head:int`, - `next_rest:(int)list`, `after_next:addr`); + `next_ptr:int`, `next_head:int`, + `next_rest:(int)list`, `after_next:int`); t = u; u = t->tail; PROOF advance_vst_append_context( - `current:addr`, `x__pre:addr`, - `current_value:int`, `next_ptr:addr`, + `current:int`, `x__pre:int`, + `current_value:int`, `next_ptr:int`, `remaining:(int)list`, `next_head:int`, `next_rest:(int)list`, `xs:(int)list`, `ys:(int)list`); } - PROOF open_vst_append_list_null(`next_ptr:addr`); + PROOF open_vst_append_list_null(`next_ptr:int`); t->tail = y; PROOF finish_vst_append_context( - `current:addr`, `x__pre:addr`, + `current:int`, `x__pre:int`, `current_value:int`, `remaining:(int)list`, - `y__pre:addr`, `xs:(int)list`, `ys:(int)list`); + `y__pre:int`, `xs:(int)list`, `ys:(int)list`); return x; } diff --git a/migrations/vst/append/list.c b/migrations/vst/append/list.c index 712cc4534c965668d05d16fbc5e3084c4c0821a8..1266b70f9cbb39861b1d5d4d3006207c1119e679 100644 --- a/migrations/vst/append/list.c +++ b/migrations/vst/append/list.c @@ -24,15 +24,15 @@ PROOF thm VST_APPEND_LIST_DEF = cst_new_rec_definition( "vst_append_list", get_theorem_by_name("list_RECURSION"), ` - ((vst_append_list:addr->(int)list->hprop) p [] -|- + ((vst_append_list:int->(int)list->cprop) p [] -|- fact(p = 0i)) && - ((vst_append_list:addr->(int)list->hprop) p (h :: t) -|- - fact(~(p = 0i)) ** exists q:addr. + ((vst_append_list:int->(int)list->cprop) p (h :: t) -|- + fact(~(p = 0i)) ** exists q:int. data_at (field_addr p Tvst_append_node Fhead) Tint h ** data_at (field_addr p Tvst_append_node Ftail) Tptr q ** vst_append_list q t) `, - `:addr->(int)list->hprop`); + `:int->(int)list->cprop`); /* A first-order symbolic-state wrapper around the stable rebuild wand. */ PROOF thm VST_APPEND_CONTEXT_DEF = cst_new_fun_definition( @@ -41,10 +41,10 @@ PROOF thm VST_APPEND_CONTEXT_DEF = cst_new_fun_definition( (rest:(int)list) (whole:(int)list) (suffix:(int)list) -|- (vst_append_list current (APPEND rest suffix) -* vst_append_list root (APPEND whole suffix))`, - `:addr->addr->(int)list->(int)list->(int)list->hprop`); + `:int->int->(int)list->(int)list->(int)list->cprop`); PROOF static thm VST_APPEND_CONTEXT_LAW = prove_definitional_law(` - forall current root:addr. forall rest whole suffix:(int)list. + forall current root:int. forall rest whole suffix:(int)list. vst_append_context current root rest whole suffix -|- (vst_append_list current (APPEND rest suffix) -* vst_append_list root (APPEND whole suffix)) @@ -54,7 +54,7 @@ PROOF static thm VST_APPEND_CONTEXT_LAW = prove_definitional_law(` PROOF static thm prove_vst_append_list_nil(void) { return prove_definitional_law(` - forall p:addr. + forall p:int. vst_append_list p ([]:(int)list) -|- fact(p = 0i) `, VST_APPEND_LIST_DEF); } @@ -63,9 +63,9 @@ PROOF thm VST_APPEND_LIST_NIL = prove_vst_append_list_nil(); PROOF static thm prove_vst_append_list_cons(void) { return prove_definitional_law(` - forall p:addr. forall h:int. forall t:(int)list. + forall p:int. forall h:int. forall t:(int)list. vst_append_list p (h :: t) -|- - fact(~(p = 0i)) ** exists q:addr. + fact(~(p = 0i)) ** exists q:int. data_at (field_addr p Tvst_append_node Fhead) Tint h ** data_at (field_addr p Tvst_append_node Ftail) Tptr q ** vst_append_list q t @@ -76,7 +76,7 @@ PROOF thm VST_APPEND_LIST_CONS = prove_vst_append_list_cons(); PROOF static thm prove_vst_append_open_null_rule(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall xs:(int)list. + forall p:int. forall xs:(int)list. p = 0i ==> (vst_append_list p xs |-- fact(xs = [])) `); gnode g = AUTO_INTROS_TAC(root); @@ -85,7 +85,7 @@ PROOF static thm prove_vst_append_open_null_rule(void) { g = CONV_WITH_ASMP_TAC( cases[0], simp_conv, THM_LIST(VST_APPEND_LIST_DEF)); CONV_TAC(g, rewrite_conv(THM_LIST( - sl_fact_true_emp(), get_hentail_refl()))); + sl_fact_true_emp(), sl_ent_refl()))); g = CONV_WITH_ASMP_TAC( cases[1], simp_conv, THM_LIST(VST_APPEND_LIST_DEF)); @@ -99,10 +99,10 @@ PROOF thm VST_APPEND_OPEN_NULL_RULE = PROOF static thm prove_vst_append_open_nonnull_rule(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall xs:(int)list. + forall p:int. forall xs:(int)list. ~(p = 0i) ==> (vst_append_list p xs |-- - exists h:int. exists t:(int)list. exists q:addr. + exists h:int. exists t:(int)list. exists q:int. fact(xs = h :: t) ** data_at (field_addr p Tvst_append_node Fhead) Tint h ** data_at (field_addr p Tvst_append_node Ftail) Tptr q ** @@ -120,7 +120,7 @@ PROOF static thm prove_vst_append_open_nonnull_rule(void) { cases[1], simp_conv, THM_LIST(VST_APPEND_LIST_DEF)); g = AUTO_INIT_SLTAC(g)[0]; g = LIST_EXISTS_SLTAC( - g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:addr`)); + g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:int`)); gnode_list pure_and_spatial = PURE_SLTAC(g); CONV_TAC(pure_and_spatial[0], rewrite_conv(THM_LIST( refl_rule(`a0 :: (a1:(int)list)`)))); @@ -133,7 +133,7 @@ PROOF thm VST_APPEND_OPEN_NONNULL_RULE = PROOF static thm prove_vst_append_close_cons_rule(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall h:int. forall t:(int)list. + forall p q:int. forall h:int. forall t:(int)list. ~(p = 0i) ==> (data_at (field_addr p Tvst_append_node Fhead) Tint h ** data_at (field_addr p Tvst_append_node Ftail) Tptr q ** @@ -145,7 +145,7 @@ PROOF static thm prove_vst_append_close_cons_rule(void) { g = CONV_SLTAC(g, rewrite_conv(THM_LIST( assume_rule(`~(p = 0i)`), sl_fact_true_emp()))); g = CLEAN_SLTAC(g); - g = EXISTS_SLTAC(g, `q:addr`); + g = EXISTS_SLTAC(g, `q:int`); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } @@ -157,7 +157,7 @@ PROOF thm VST_APPEND_CLOSE_CONS_RULE = PROOF static thm prove_vst_append_begin_context_rule(void) { gnode root = gnode_new_with_ccl(` - forall root:addr. forall whole suffix:(int)list. + forall root:int. forall whole suffix:(int)list. forall head:int. forall rest:(int)list. whole = head :: rest ==> (emp |-- vst_append_context root root @@ -179,7 +179,7 @@ PROOF thm VST_APPEND_BEGIN_CONTEXT_RULE = /* One node reconstructs the old hole from the new tail hole. */ PROOF static thm prove_vst_append_node_rebuild(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall h:int. forall tail suffix:(int)list. + forall p q:int. forall h:int. forall tail suffix:(int)list. ~(p = 0i) ==> ((data_at (field_addr p Tvst_append_node Fhead) Tint h ** data_at (field_addr p Tvst_append_node Ftail) Tptr q) ** @@ -188,7 +188,7 @@ PROOF static thm prove_vst_append_node_rebuild(void) { `); gnode g = AUTO_INTROS_TAC(root); thm fold = specl_rule( - TERM_LIST(`p:addr`, `q:addr`, `h:int`, + TERM_LIST(`p:int`, `q:int`, `h:int`, `APPEND (tail:(int)list) (suffix:(int)list)`), VST_APPEND_CLOSE_CONS_RULE); fold = mp_rule(fold, assume_rule(`~(p = 0i)`)); @@ -208,7 +208,7 @@ PROOF static thm VST_APPEND_NODE_REBUILD = PROOF static thm prove_vst_append_advance_context_rule(void) { gnode root = gnode_new_with_ccl(` - forall current next root:addr. + forall current next root:int. forall current_head next_head:int. forall rest next_rest whole suffix:(int)list. ~(current = 0i) ==> rest = next_head :: next_rest ==> @@ -226,7 +226,7 @@ PROOF static thm prove_vst_append_advance_context_rule(void) { gnode g = AUTO_INTROS_TAC(root); thm rebuild = specl_rule( - TERM_LIST(`current:addr`, `next:addr`, `current_head:int`, + TERM_LIST(`current:int`, `next:int`, `current_head:int`, `next_head :: (next_rest:(int)list)`, `suffix:(int)list`), VST_APPEND_NODE_REBUILD); @@ -237,12 +237,12 @@ PROOF static thm prove_vst_append_advance_context_rule(void) { thm advanced = wand_frame_transport(rebuild, global); thm open_context = eq2ent(specl_rule( - TERM_LIST(`current:addr`, `root:addr`, + TERM_LIST(`current:int`, `root:int`, `current_head :: next_head :: (next_rest:(int)list)`, `whole:(int)list`, `suffix:(int)list`), VST_APPEND_CONTEXT_LAW)); thm close_context = eq2ent(sym_rule(specl_rule( - TERM_LIST(`next:addr`, `root:addr`, + TERM_LIST(`next:int`, `root:int`, `next_head :: (next_rest:(int)list)`, `whole:(int)list`, `suffix:(int)list`), VST_APPEND_CONTEXT_LAW))); @@ -255,7 +255,7 @@ PROOF static thm prove_vst_append_advance_context_rule(void) { open_context = frame_left_slrule(layer, open_context); thm context_eq = ap_term_rule( `\r:(int)list. - vst_append_context (current:addr) (root:addr) + vst_append_context (current:int) (root:int) ((current_head:int) :: r) (whole:(int)list) (suffix:(int)list)`, assume_rule(`(rest:(int)list) = @@ -283,7 +283,7 @@ PROOF thm VST_APPEND_ADVANCE_CONTEXT_RULE = PROOF static thm prove_vst_append_finish_context_rule(void) { gnode root = gnode_new_with_ccl(` - forall current suffix_ptr root:addr. forall current_head:int. + forall current suffix_ptr root:int. forall current_head:int. forall rest whole suffix:(int)list. ~(current = 0i) ==> rest = [] ==> (data_at (field_addr current Tvst_append_node Fhead) @@ -298,7 +298,7 @@ PROOF static thm prove_vst_append_finish_context_rule(void) { gnode g = AUTO_INTROS_TAC(root); thm fold = specl_rule( - TERM_LIST(`current:addr`, `suffix_ptr:addr`, + TERM_LIST(`current:int`, `suffix_ptr:int`, `current_head:int`, `suffix:(int)list`), VST_APPEND_CLOSE_CONS_RULE); fold = mp_rule(fold, assume_rule(`~(current = 0i)`)); @@ -309,11 +309,11 @@ PROOF static thm prove_vst_append_finish_context_rule(void) { `APPEND ((current_head:int) :: (rest:(int)list)) (suffix:(int)list)`); thm represented_eq = ap_term_rule( - `vst_append_list (current:addr)`, appended_eq); + `vst_append_list (current:int)`, appended_eq); fold = trans_slrule(fold, eq2ent(sym_rule(represented_eq))); thm open_context = eq2ent(specl_rule( - TERM_LIST(`current:addr`, `root:addr`, + TERM_LIST(`current:int`, `root:int`, `current_head :: (rest:(int)list)`, `whole:(int)list`, `suffix:(int)list`), VST_APPEND_CONTEXT_LAW)); @@ -352,7 +352,7 @@ PROOF thm VST_APPEND_FINISH_CONTEXT_RULE = PROOF static thm prove_vst_append_empty_result_rule(void) { gnode root = gnode_new_with_ccl(` - forall suffix_ptr:addr. forall whole suffix:(int)list. + forall suffix_ptr:int. forall whole suffix:(int)list. whole = [] ==> (vst_append_list suffix_ptr suffix |-- vst_append_list suffix_ptr (APPEND whole suffix)) @@ -377,7 +377,7 @@ PROOF static thm open_vst_append_list_null_operation_proof( } decl_operation(open_vst_append_list_null_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `vst_append_list (KEY p) (CAPTURE xs)`), term_list_n(1, `p = 0i`), `fact((xs:(int)list) = [])` @@ -395,10 +395,10 @@ PROOF static thm open_vst_append_list_nonnull_operation_proof( } decl_operation(open_vst_append_list_nonnull_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `vst_append_list (KEY p) (CAPTURE xs)`), term_list_n(1, `~(p = 0i)`), - `exists h:int. exists t:(int)list. exists q:addr. + `exists h:int. exists t:(int)list. exists q:int. fact(xs = h :: t) ** data_at (field_addr p Tvst_append_node Fhead) Tint h ** data_at (field_addr p Tvst_append_node Ftail) Tptr q ** @@ -417,7 +417,7 @@ PROOF void open_vst_append_list_nonnull_as( PROOF static thm begin_vst_append_context_operation_proof( const term goal_tm) { thm local_ent = specl_rule( - TERM_LIST(`root:addr`, `whole:(int)list`, + TERM_LIST(`root:int`, `whole:(int)list`, `suffix:(int)list`, `head:int`, `rest:(int)list`), VST_APPEND_BEGIN_CONTEXT_RULE); @@ -426,12 +426,12 @@ PROOF static thm begin_vst_append_context_operation_proof( } decl_operation(begin_vst_append_context_operation, - TERM_LIST(`root:addr`, `whole:(int)list`, `suffix:(int)list`, + TERM_LIST(`root:int`, `whole:(int)list`, `suffix:(int)list`, `head:int`, `rest:(int)list`), term_list_n(0), term_list_n(1, `(whole:(int)list) = (head:int) :: (rest:(int)list)`), - `vst_append_context (root:addr) root + `vst_append_context (root:int) root ((head:int) :: (rest:(int)list)) (whole:(int)list) (suffix:(int)list)` ) @@ -449,7 +449,7 @@ PROOF void begin_vst_append_context( PROOF static thm advance_vst_append_context_operation_proof( const term goal_tm) { thm local_ent = specl_rule( - TERM_LIST(`current:addr`, `current_next:addr`, `root:addr`, + TERM_LIST(`current:int`, `current_next:int`, `root:int`, `current_head:int`, `next_head:int`, `rest:(int)list`, `next_rest:(int)list`, `whole:(int)list`, `suffix:(int)list`), @@ -459,8 +459,8 @@ PROOF static thm advance_vst_append_context_operation_proof( } decl_operation(advance_vst_append_context_operation, - TERM_LIST(`current:addr`, `root:addr`, - `current_head:int`, `current_next:addr`, + TERM_LIST(`current:int`, `root:int`, + `current_head:int`, `current_next:int`, `rest:(int)list`, `next_head:int`, `next_rest:(int)list`, `whole:(int)list`, `suffix:(int)list`), @@ -475,10 +475,10 @@ decl_operation(advance_vst_append_context_operation, (KEY current) (KEY root) ((KEY current_head) :: (KEY rest)) (KEY whole) (KEY suffix)`), - TERM_LIST(`~((current:addr) = 0i)`, + TERM_LIST(`~((current:int) = 0i)`, `(rest:(int)list) = (next_head:int) :: (next_rest:(int)list)`), - `vst_append_context (current_next:addr) (root:addr) + `vst_append_context (current_next:int) (root:int) ((next_head:int) :: (next_rest:(int)list)) (whole:(int)list) (suffix:(int)list)` ) @@ -499,7 +499,7 @@ PROOF void advance_vst_append_context( PROOF static thm finish_vst_append_context_operation_proof( const term goal_tm) { thm local_ent = specl_rule( - TERM_LIST(`current:addr`, `suffix_ptr:addr`, `root:addr`, + TERM_LIST(`current:int`, `suffix_ptr:int`, `root:int`, `current_head:int`, `rest:(int)list`, `whole:(int)list`, `suffix:(int)list`), VST_APPEND_FINISH_CONTEXT_RULE); @@ -508,8 +508,8 @@ PROOF static thm finish_vst_append_context_operation_proof( } decl_operation(finish_vst_append_context_operation, - TERM_LIST(`current:addr`, `root:addr`, `current_head:int`, - `rest:(int)list`, `suffix_ptr:addr`, + TERM_LIST(`current:int`, `root:int`, `current_head:int`, + `rest:(int)list`, `suffix_ptr:int`, `whole:(int)list`, `suffix:(int)list`), TERM_LIST( `data_at @@ -523,9 +523,9 @@ decl_operation(finish_vst_append_context_operation, (KEY current) (KEY root) ((KEY current_head) :: (KEY rest)) (KEY whole) (KEY suffix)`), - TERM_LIST(`~((current:addr) = 0i)`, + TERM_LIST(`~((current:int) = 0i)`, `(rest:(int)list) = []`), - `vst_append_list (root:addr) + `vst_append_list (root:int) (APPEND (whole:(int)list) (suffix:(int)list))` ) @@ -541,7 +541,7 @@ PROOF void finish_vst_append_context( PROOF static thm finish_vst_append_empty_operation_proof( const term goal_tm) { thm local_ent = specl_rule( - TERM_LIST(`suffix_ptr:addr`, `whole:(int)list`, + TERM_LIST(`suffix_ptr:int`, `whole:(int)list`, `suffix:(int)list`), VST_APPEND_EMPTY_RESULT_RULE); return prove_operation_by_entailment( @@ -549,12 +549,12 @@ PROOF static thm finish_vst_append_empty_operation_proof( } decl_operation(finish_vst_append_empty_operation, - TERM_LIST(`suffix_ptr:addr`, `whole:(int)list`, + TERM_LIST(`suffix_ptr:int`, `whole:(int)list`, `suffix:(int)list`), term_list_n(1, `vst_append_list (KEY suffix_ptr) (KEY suffix)`), term_list_n(1, `(whole:(int)list) = []`), - `vst_append_list (suffix_ptr:addr) + `vst_append_list (suffix_ptr:int) (APPEND (whole:(int)list) (suffix:(int)list))` ) @@ -573,12 +573,12 @@ PROOF static int install_vst_append_qcp_interface(void) { `APPEND:(int)list->(int)list->(int)list`) == 0, "Failed to export APPEND"); ENSURE_COND(cst_add_const_to_header( - `vst_append_list:addr->(int)list->hprop`) == 0, + `vst_append_list:int->(int)list->cprop`) == 0, "Failed to export vst_append_list"); ENSURE_COND(cst_add_const_to_header( `vst_append_context: - addr->addr->(int)list->(int)list-> - (int)list->hprop`) == 0, + int->int->(int)list->(int)list-> + (int)list->cprop`) == 0, "Failed to export vst_append_context"); installed = true; return 0; diff --git a/migrations/vst/io/io.c b/migrations/vst/io/io.c index 460a621b5f7e795d7249160863ce6807041a39ef..0ab989d3e7715b342ca0ec3b4ed955e056174fc7 100644 --- a/migrations/vst/io/io.c +++ b/migrations/vst/io/io.c @@ -35,9 +35,9 @@ PROOF static int _io_event_append = /* No user theorem constructs or duplicates this environment capability. */ PROOF static int _io_trace = - new_const_safe("io_trace", `:(io_event)list->hprop`); + new_const_safe("io_trace", `:(io_event)list->cprop`); PROOF static int _io_trace_export = - cst_add_const_to_header(`io_trace:(io_event)list->hprop`); + cst_add_const_to_header(`io_trace:(io_event)list->cprop`); /* * The result predicates package the two states of a retrying call. Keeping @@ -51,14 +51,14 @@ PROOF thm IO_READ_RESULT_DEF = cst_new_fun_definition( if r = --1i then io_trace tr else fact(0i <= r && r <= 255i) ** io_trace (tr ++ [IORead r])`, - `:(io_event)list->int->hprop`); + `:(io_event)list->int->cprop`); PROOF thm IO_WRITE_RESULT_DEF = cst_new_fun_definition( "io_write_result", `io_write_result (tr:(io_event)list) (c:int) (r:int) -|- if r = --1i then io_trace tr else fact(r = c) ** io_trace (tr ++ [IOWrite c])`, - `:(io_event)list->int->int->hprop`); + `:(io_event)list->int->int->cprop`); /*---------------------- closed cursor rules ----------------------*/ diff --git a/migrations/vst/memmgr/lib/memmgr.c b/migrations/vst/memmgr/lib/memmgr.c index c1fec1461e9c451035d2d0ed8495588ad3ec3d52..449f6f0106b04df8f2dde6634f190c6d9ce0543b 100644 --- a/migrations/vst/memmgr/lib/memmgr.c +++ b/migrations/vst/memmgr/lib/memmgr.c @@ -60,7 +60,85 @@ err: /* Opaque linear provenance: only the assumed mapping boundary creates it. */ PROOF static int _MM_MAPPING_DECL = - declare_fresh_memmgr_constant("mm_mapping", `:addr->int->hprop`); + declare_fresh_memmgr_constant("mm_mapping", `:int->int->cprop`); + +/* + * Pure address-validity guarantee supplied by the foreign mapping boundary. + * A zero layout size selects the single large-allocation header. A nonzero + * size selects every header/payload-link pair in the small-page layout. + */ +PROOF thm mm_mapping_layout_ok_def = define_fresh_memmgr_function( + "mm_mapping_layout_ok", + `mm_mapping_layout_ok (base:int) (size:int) <=> + if size = 0i then + pmem_uint64_address_ok + (base + mm_waste * sizeof Tuchar) + else + forall i:int. + 0i <= i && i < mm_chunk_count size ==> + pmem_uint64_address_ok + (base + + (mm_waste + i * (size + mm_word)) * sizeof Tuchar) && + pmem_ptr_address_ok + ((base + + (mm_waste + i * (size + mm_word)) * sizeof Tuchar) + + mm_word)`); + +PROOF static thm prove_mm_mapping_layout_large(void) { + gnode root = gnode_new_with_ccl(` + forall base:int. + mm_mapping_layout_ok base 0i ==> + pmem_uint64_address_ok + (base + mm_waste * sizeof Tuchar) + `); + gnode g = AUTO_INTROS_TAC(root); + thm layout = assume_rule(`mm_mapping_layout_ok (base:int) 0i`); + layout = pure_rewrite_rule(THM_LIST( + mm_mapping_layout_ok_def, + get_theorem_by_name("REFL_CLAUSE"), + get_theorem_by_name("COND_CLAUSES")), layout); + ACCEPT_TAC(g, layout); + return gnode_prove(root); +} + +PROOF thm MM_MAPPING_LAYOUT_LARGE = + prove_mm_mapping_layout_large(); + +PROOF static thm prove_mm_mapping_layout_small(void) { + gnode root = gnode_new_with_ccl(` + forall (base:int) (size:int) (i:int). + ~(size = 0i) ==> + 0i <= i ==> + i < mm_chunk_count size ==> + mm_mapping_layout_ok base size ==> + pmem_uint64_address_ok + (base + + (mm_waste + i * (size + mm_word)) * sizeof Tuchar) && + pmem_ptr_address_ok + ((base + + (mm_waste + i * (size + mm_word)) * sizeof Tuchar) + + mm_word) + `); + gnode g = AUTO_INTROS_TAC(root); + thm layout = assume_rule(` + mm_mapping_layout_ok (base:int) (size:int) + `); + layout = pure_rewrite_rule(THM_LIST( + mm_mapping_layout_ok_def, + assume_rule(`~((size:int) = 0i)`), + get_theorem_by_name("COND_CLAUSES")), layout); + layout = spec_rule(`i:int`, layout); + layout = match_mp_rule( + layout, + conj_rule( + assume_rule(`0i <= (i:int)`), + assume_rule(`(i:int) < mm_chunk_count (size:int)`))); + ACCEPT_TAC(g, layout); + return gnode_prove(root); +} + +PROOF thm MM_MAPPING_LAYOUT_SMALL = + prove_mm_mapping_layout_small(); /* The raw remainder of a free payload after its intrusive next pointer. */ PROOF thm mm_block_tail_def = define_fresh_memmgr_function( @@ -72,6 +150,7 @@ PROOF thm mm_free_node_def = define_fresh_memmgr_function( "mm_free_node", `mm_free_node s p next -|- fact(~(p = 0i)) ** + fact(pmem_ptr_address_ok p) ** data_at (p - sizeof Tuint64) Tuint64 s ** data_at p Tptr next ** mm_block_tail p s`); @@ -158,6 +237,7 @@ PROOF thm mm_token_rest_def = define_fresh_memmgr_function( "mm_token_rest", `mm_token_rest p n s -|- if s <= mm_max_small then + fact(pmem_ptr_address_ok p) ** fact(0i <= n && n <= mm_max_small) ** fact(s = mm_bin_size (mm_size_to_bin n)) ** raw_bytes (p + n * sizeof Tuchar) (s - n) @@ -188,7 +268,7 @@ PROOF thm mm_owned_block_def = define_fresh_memmgr_function( PROOF static thm prove_mm_free_segment_join(void) { gnode root = gnode_new_with_ccl(` forall tokens:(int)list. forall s:int. - forall first cursor:addr. forall tail:(int)list. + forall first cursor:int. forall tail:(int)list. mm_free_segment s first cursor tokens ** mm_free_chain s cursor tail |-- mm_free_chain s first (tokens ++ tail) @@ -198,7 +278,7 @@ PROOF static thm prove_mm_free_segment_join(void) { gnode base = AUTO_INTROS_TAC(cases[0]); base = CONV_TAC(base, rewrite_conv(THM_LIST( - mm_free_segment_def, get_APPEND()))); + mm_free_segment_def, HOL_APPEND))); base = AUTO_INIT_SLTAC(base)[0]; base = AUTO_INTRO_FACT_SLTAC(base); base = CONV_WITH_ASMP_SLTAC( @@ -209,14 +289,14 @@ PROOF static thm prove_mm_free_segment_join(void) { thm ih = assume_rule( gnode_get_asmps(step, CONST_STRING_LIST("H"))[0]); step = CONV_TAC(step, rewrite_conv(THM_LIST( - mm_free_segment_def, mm_free_chain_def, get_APPEND()))); + mm_free_segment_def, mm_free_chain_def, HOL_APPEND))); step = SL_MODE(step, "HSEG * HCHAIN")[0]; step = HANT_EXISTS_SLTAC(step, "HSEG", "mid"); step = HANT_SEP_SLTAC(step, "HSEG", "HN", "HREST"); - step = EXISTS_SLTAC(step, `mid:addr`); + step = EXISTS_SLTAC(step, `mid:int`); step = AUTO_FRAME_SLTAC(step); ih = ispecl_rule( - TERM_LIST(`s:int`, `mid:addr`, `cursor:addr`, `tail:(int)list`), + TERM_LIST(`s:int`, `mid:int`, `cursor:int`, `tail:(int)list`), ih); ih = rehant_slrule(ih, ` mm_free_chain s cursor tail ** @@ -231,7 +311,7 @@ PROOF static thm MM_FREE_SEGMENT_JOIN = prove_mm_free_segment_join(); PROOF static thm prove_mm_free_segment_append(void) { gnode root = gnode_new_with_ccl(` forall left:(int)list. forall s:int. - forall first cursor stop:addr. forall right:(int)list. + forall first cursor stop:int. forall right:(int)list. mm_free_segment s first cursor left ** mm_free_segment s cursor stop right |-- mm_free_segment s first stop (left ++ right) @@ -241,7 +321,7 @@ PROOF static thm prove_mm_free_segment_append(void) { gnode base = AUTO_INTROS_TAC(cases[0]); base = CONV_TAC(base, rewrite_conv(THM_LIST( - mm_free_segment_def, get_APPEND()))); + mm_free_segment_def, HOL_APPEND))); base = AUTO_INIT_SLTAC(base)[0]; base = AUTO_INTRO_FACT_SLTAC(base); base = CONV_WITH_ASMP_SLTAC( @@ -252,14 +332,14 @@ PROOF static thm prove_mm_free_segment_append(void) { thm ih = assume_rule( gnode_get_asmps(step, CONST_STRING_LIST("H"))[0]); step = CONV_TAC(step, rewrite_conv(THM_LIST( - mm_free_segment_def, get_APPEND()))); + mm_free_segment_def, HOL_APPEND))); step = SL_MODE(step, "HSEG * HREST2")[0]; step = HANT_EXISTS_SLTAC(step, "HSEG", "mid2"); step = HANT_SEP_SLTAC(step, "HSEG", "HN2", "HREST1"); - step = EXISTS_SLTAC(step, `mid2:addr`); + step = EXISTS_SLTAC(step, `mid2:int`); step = AUTO_FRAME_SLTAC(step); ih = ispecl_rule( - TERM_LIST(`s:int`, `mid2:addr`, `cursor:addr`, `stop:addr`, + TERM_LIST(`s:int`, `mid2:int`, `cursor:int`, `stop:int`, `right:(int)list`), ih); ih = rehant_slrule(ih, ` @@ -283,7 +363,7 @@ PROOF static thm open_mm_manager_operation_proof(const term goal_tm) { } decl_operation(open_mm_manager_operation, - TERM_LIST(`anchor:addr`), + TERM_LIST(`anchor:int`), term_list_n(1, `mm_manager (KEY anchor)`), term_list_n(0), `exists base bins pages. @@ -307,7 +387,7 @@ PROOF static thm close_mm_manager_operation_proof(const term goal_tm) { g = CONV_TAC(g, rewrite_conv(THM_LIST(mm_manager_def))); g = AUTO_INIT_SLTAC(g)[0]; g = LIST_EXISTS_SLTAC( - g, TERM_LIST(`base:addr`, `bins:((int)list)list`, + g, TERM_LIST(`base:int`, `bins:((int)list)list`, `pages:(int)list`)); gnode_list parts = PURE_SLTAC(g); ACCEPT_TAC(parts[0], assume_rule( @@ -317,9 +397,9 @@ PROOF static thm close_mm_manager_operation_proof(const term goal_tm) { } decl_operation(close_mm_manager_operation, - TERM_LIST(`anchor:addr`), + TERM_LIST(`anchor:int`), TERM_LIST( - `data_at (KEY anchor) Tptr (CAPTURE (base:addr))`, + `data_at (KEY anchor) Tptr (CAPTURE (base:int))`, `mm_bins (KEY base) (CAPTURE (bins:((int)list)list))`, `fact(&(LENGTH (KEY (bins:((int)list)list))) = mm_bin_count)`, `mm_page_bank (CAPTURE (pages:(int)list))` @@ -336,7 +416,7 @@ PROOF void close_mm_manager(const term anchor) { PROOF static thm prove_mm_bins_open_eq(void) { gnode root = gnode_new_with_ccl(` - forall base:addr. forall i:int. forall bins:((int)list)list. + forall base:int. forall i:int. forall bins:((int)list)list. 0i <= i ==> i < &(LENGTH bins) ==> (mm_bins base bins -|- mm_bin_cell base (num_of_int i) (EL (num_of_int i) bins) ** @@ -366,7 +446,7 @@ PROOF static thm open_mm_bins_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm opened = ispecl_rule( - TERM_LIST(`base:addr`, `i:int`, `bins:((int)list)list`), + TERM_LIST(`base:int`, `i:int`, `bins:((int)list)list`), MM_BINS_OPEN_EQ); opened = mp_rule(opened, assume_rule(`0i <= i`)); opened = mp_rule(opened, @@ -376,7 +456,7 @@ PROOF static thm open_mm_bins_operation_proof(const term goal_tm) { } decl_operation(open_mm_bins_operation, - TERM_LIST(`base:addr`, `i:int`), + TERM_LIST(`base:int`, `i:int`), term_list_n(1, `mm_bins (KEY base) (CAPTURE bins)`), TERM_LIST(`0i <= i`, `i < &(LENGTH (bins:((int)list)list))`), `mm_bin_cell base (num_of_int i) (EL (num_of_int i) bins) ** @@ -392,13 +472,13 @@ PROOF static thm open_mm_bin_cell_operation_proof(const term goal_tm) { mm_bin_cell_def, cast))); g = AUTO_INIT_SLTAC(g)[0]; g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `head:addr`); + g = EXISTS_SLTAC(g, `head:int`); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(open_mm_bin_cell_operation, - TERM_LIST(`base:addr`, `i:int`), + TERM_LIST(`base:int`, `i:int`), term_list_n(1, `mm_bin_cell (KEY base) (KEY (num_of_int i)) (CAPTURE blocks)`), term_list_n(1, `0i <= i`), @@ -423,13 +503,13 @@ PROOF static thm close_mm_bin_cell_operation_proof(const term goal_tm) { g = CONV_TAC(g, rewrite_conv(THM_LIST( mm_bin_cell_def, cast))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `head:addr`); + g = EXISTS_SLTAC(g, `head:int`); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(close_mm_bin_cell_operation, - TERM_LIST(`base:addr`, `i:int`), + TERM_LIST(`base:int`, `i:int`), TERM_LIST( `data_at (KEY (base + i * sizeof Tptr)) Tptr (CAPTURE head)`, `mm_free_chain (KEY (mm_bin_size i)) (KEY head) (CAPTURE blocks)` @@ -486,7 +566,7 @@ PROOF static thm close_mm_bins_operation_proof(const term goal_tm) { } decl_operation(close_mm_bins_operation, - TERM_LIST(`base:addr`, `i:int`), + TERM_LIST(`base:int`, `i:int`), TERM_LIST( `mm_bins_focus (KEY base) (KEY i) (CAPTURE bins)`, `mm_bin_cell (KEY base) (KEY (num_of_int i)) (CAPTURE blocks)` @@ -517,7 +597,7 @@ PROOF static thm open_mm_block_tail_operation_proof( } decl_operation(open_mm_block_tail_operation, - TERM_LIST(`p:addr`, `s:int`), + TERM_LIST(`p:int`, `s:int`), term_list_n(1, `mm_block_tail (KEY p) (KEY s)`), term_list_n(0), `raw_bytes (p + sizeof Tptr) (s - sizeof Tptr)` @@ -537,7 +617,7 @@ PROOF static thm close_mm_block_tail_operation_proof( } decl_operation(close_mm_block_tail_operation, - TERM_LIST(`p:addr`, `s:int`), + TERM_LIST(`p:int`, `s:int`), term_list_n(1, `raw_bytes (KEY (p + sizeof Tptr)) (KEY (s - sizeof Tptr))`), term_list_n(0), @@ -553,7 +633,9 @@ PROOF void close_mm_block_tail(const term payload, const term size) { PROOF static thm prove_mm_raw_free_node_carve(void) { gnode root = gnode_new_with_ccl(` - forall header:addr. forall remaining s:int. + forall header:int. forall remaining s:int. + pmem_uint64_address_ok header ==> + pmem_ptr_address_ok (header + mm_word) ==> mm_word <= s ==> s + mm_word <= remaining ==> (raw_bytes header remaining |-- undef_data_at header Tuint64 ** @@ -568,7 +650,7 @@ PROOF static thm prove_mm_raw_free_node_carve(void) { gnode g = AUTO_INTROS_TAC(root); thm word_nonnegative_eq = apply_conversion( - rewrite_conv(THM_LIST(MM_WORD_DEF, get_sizeof_def())), + rewrite_conv(THM_LIST(MM_WORD_DEF, sizeof_def)), `0i <= mm_word`); thm word_nonnegative = eq_mp_rule( sym_rule(word_nonnegative_eq), int_arith_rule(`0i <= 8i`)); @@ -577,7 +659,7 @@ PROOF static thm prove_mm_raw_free_node_carve(void) { `), word_nonnegative), assume_rule(`mm_word <= s`)); thm split = ispecl_rule( - TERM_LIST(`header:addr`, `remaining:int`, `s + mm_word:int`), + TERM_LIST(`header:int`, `remaining:int`, `s + mm_word:int`), RAW_BYTES_SPLIT); split = mp_rule(split, total_nonnegative); split = mp_rule(split, assume_rule(`s + mm_word <= remaining`)); @@ -591,12 +673,15 @@ PROOF static thm prove_mm_raw_free_node_carve(void) { thm uint64_bound = eq_mp_rule( sym_rule(uint64_bound_eq), word_le_total); thm carve_header = ispecl_rule( - TERM_LIST(`header:addr`, `Tuint64`, `s + mm_word:int`), - RAW_BYTES_CARVE); + TERM_LIST(`header:int`, `s + mm_word:int`), + RAW_BYTES_CARVE_TUINT64); + carve_header = mp_rule( + carve_header, + assume_rule(`pmem_uint64_address_ok (header:int)`)); carve_header = mp_rule(carve_header, uint64_bound); thm ptr_equals_word_eq = apply_conversion( - rewrite_conv(THM_LIST(MM_WORD_DEF, get_sizeof_def())), + rewrite_conv(THM_LIST(MM_WORD_DEF, sizeof_def)), `sizeof Tptr = mm_word`); thm ptr_equals_word = eqt_elim_rule(ptr_equals_word_eq); thm ptr_bound_eq = beta_rule(ap_term_rule( @@ -604,26 +689,56 @@ PROOF static thm prove_mm_raw_free_node_carve(void) { thm ptr_bound = eq_mp_rule( sym_rule(ptr_bound_eq), assume_rule(`mm_word <= s`)); thm carve_next = ispecl_rule( - TERM_LIST(`header + mm_word:addr`, `Tptr`, `s:int`), - RAW_BYTES_CARVE); + TERM_LIST(`header + mm_word:int`, `s:int`), + RAW_BYTES_CARVE_TPTR); + carve_next = mp_rule( + carve_next, + assume_rule(` + pmem_ptr_address_ok ((header:int) + mm_word) + `)); carve_next = mp_rule(carve_next, ptr_bound); thm header_remainder = mp_rule(int_arith_rule(` mm_word = sizeof Tuint64 ==> (s + mm_word) - sizeof Tuint64 = s `), MM_WORD_DEF); - thm tail_address = int_arith_rule(` - ((header:addr) + mm_word) + sizeof Tptr = + carve_header = pure_rewrite_rule(THM_LIST( + gsym_rule(MM_WORD_DEF), header_remainder), carve_header); + + term rest = `raw_bytes + ((header:int) + (s + mm_word) * sizeof Tuchar) + (remaining - (s + mm_word))`; + thm split_ent = eq2ent(split); + thm carve_header_framed = frame_right_slrule(carve_header, rest); + thm first = trans_slrule(split_ent, carve_header_framed); + + thm carve_next_framed = frame_right_slrule(carve_next, rest); + carve_next_framed = frame_left_slrule( + `undef_data_at (header:int) Tuint64`, carve_next_framed); + thm tail_address = int_ring_rule(` + ((header:int) + mm_word) + sizeof Tptr = header + (mm_word + sizeof Tptr) `); - g = CONV_TAC(g, land_conv(rewrite_conv(THM_LIST( - split, - carve_header, - sym_rule(MM_WORD_DEF), - header_remainder, - carve_next, - tail_address)))); - AUTO_INIT_SLTAC(g); + carve_next_framed = pure_once_rewrite_rule( + THM_LIST(tail_address), carve_next_framed); + carve_next_framed = rehant_slrule(carve_next_framed, ` + (undef_data_at (header:int) Tuint64 ** + raw_bytes (header + mm_word) s) ** + raw_bytes + (header + (s + mm_word) * sizeof Tuchar) + (remaining - (s + mm_word)) + `); + carve_next_framed = rehcon_slrule(carve_next_framed, ` + undef_data_at (header:int) Tuint64 ** + undef_data_at (header + mm_word) Tptr ** + raw_bytes (header + mm_word + sizeof Tptr) + (s - sizeof Tptr) ** + raw_bytes + (header + (s + mm_word) * sizeof Tuchar) + (remaining - (s + mm_word)) + `); + thm result = trans_slrule(first, carve_next_framed); + ACCEPT_TAC(g, result); return gnode_prove(root); } @@ -635,8 +750,16 @@ PROOF static thm open_mm_raw_free_node_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm carved = ispecl_rule( - TERM_LIST(`header:addr`, `remaining:int`, `s:int`), + TERM_LIST(`header:int`, `remaining:int`, `s:int`), MM_RAW_FREE_NODE_CARVE); + carved = mp_rule( + carved, + assume_rule(`pmem_uint64_address_ok (header:int)`)); + carved = mp_rule( + carved, + assume_rule(` + pmem_ptr_address_ok ((header:int) + mm_word) + `)); carved = mp_rule(carved, assume_rule(`mm_word <= s`)); carved = mp_rule( carved, assume_rule(`s + mm_word <= remaining`)); @@ -645,9 +768,13 @@ PROOF static thm open_mm_raw_free_node_operation_proof( } decl_operation(open_mm_raw_free_node_operation, - TERM_LIST(`header:addr`, `s:int`), + TERM_LIST(`header:int`, `s:int`), term_list_n(1, `raw_bytes (KEY header) (CAPTURE remaining)`), - TERM_LIST(`mm_word <= s`, `s + mm_word <= remaining`), + TERM_LIST( + `pmem_uint64_address_ok header`, + `pmem_ptr_address_ok (header + mm_word)`, + `mm_word <= s`, + `s + mm_word <= remaining`), `undef_data_at header Tuint64 ** undef_data_at (header + mm_word) Tptr ** raw_bytes @@ -685,7 +812,7 @@ PROOF static thm open_mm_free_chain_null_operation_proof( } decl_operation(open_mm_free_chain_null_operation, - TERM_LIST(`s:int`, `head:addr`), + TERM_LIST(`s:int`, `head:int`), term_list_n(1, `mm_free_chain (KEY s) (KEY head) (CAPTURE blocks)`), term_list_n(1, `head = 0i`), @@ -713,20 +840,21 @@ PROOF static thm open_mm_free_chain_cons_operation_proof( THM_LIST(mm_free_chain_def, mm_free_node_def)); g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; g = LIST_EXISTS_SLTAC( - g, TERM_LIST(`a0:int`, `a1:(int)list`, `next:addr`)); + g, TERM_LIST(`a0:int`, `a1:(int)list`, `next:int`)); g = CONV_SLTAC(g, simp_conv(thm_list_n(0))); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(open_mm_free_chain_cons_operation, - TERM_LIST(`s:int`, `head:addr`), + TERM_LIST(`s:int`, `head:int`), term_list_n(1, `mm_free_chain (KEY s) (KEY head) (CAPTURE blocks)`), term_list_n(1, `~(head = 0i)`), `exists token tail next. fact(blocks = token :: tail) ** fact(~(head = 0i)) ** + fact(pmem_ptr_address_ok head) ** data_at (head - sizeof Tuint64) Tuint64 s ** data_at head Tptr next ** mm_block_tail head s ** @@ -769,17 +897,21 @@ PROOF static thm close_mm_free_chain_cons_operation_proof( g = CONV_TAC(g, rewrite_conv(THM_LIST( mm_free_chain_def, mm_free_node_def))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `next:addr`); + g = EXISTS_SLTAC(g, `next:int`); gnode_list parts = PURE_SLTAC(g); - ACCEPT_TAC(parts[0], assume_rule(`~((head:addr) = 0i)`)); - AUTO_FRAME_SLTAC(parts[1]); + ACCEPT_TAC(parts[0], assume_rule(`~((head:int) = 0i)`)); + ACCEPT_TAC( + parts[1], + assume_rule(`pmem_ptr_address_ok (head:int)`)); + AUTO_FRAME_SLTAC(parts[2]); return gnode_prove(root); } decl_operation(close_mm_free_chain_cons_operation, - TERM_LIST(`s:int`, `head:addr`, `token:int`), + TERM_LIST(`s:int`, `head:int`, `token:int`), TERM_LIST( `fact(~((KEY head) = 0i))`, + `fact(pmem_ptr_address_ok (KEY head))`, `data_at (KEY (head - sizeof Tuint64)) Tuint64 (KEY s)`, `data_at (KEY head) Tptr (CAPTURE next)`, `mm_block_tail (KEY head) (KEY s)`, @@ -806,7 +938,7 @@ PROOF static thm begin_mm_free_segment_operation_proof( } decl_operation(begin_mm_free_segment_operation, - TERM_LIST(`s:int`, `cursor:addr`), + TERM_LIST(`s:int`, `cursor:int`), term_list_n(1, `emp`), term_list_n(0), `mm_free_segment s cursor cursor ([]:(int)list)` @@ -825,18 +957,22 @@ PROOF static thm close_mm_free_segment_singleton_operation_proof( g = CONV_TAC(g, rewrite_conv(THM_LIST( mm_free_segment_def, mm_free_node_def))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `next:addr`); + g = EXISTS_SLTAC(g, `next:int`); gnode_list parts = PURE_SLTAC(g); - ACCEPT_TAC(parts[0], assume_rule(`~((cursor:addr) = 0i)`)); - ACCEPT_TAC(parts[1], refl_rule(`next:addr`)); - AUTO_FRAME_SLTAC(parts[2]); + ACCEPT_TAC(parts[0], assume_rule(`~((cursor:int) = 0i)`)); + ACCEPT_TAC( + parts[1], + assume_rule(`pmem_ptr_address_ok (cursor:int)`)); + ACCEPT_TAC(parts[2], refl_rule(`next:int`)); + AUTO_FRAME_SLTAC(parts[3]); return gnode_prove(root); } decl_operation(close_mm_free_segment_singleton_operation, - TERM_LIST(`s:int`, `cursor:addr`, `next:addr`, `token:int`), + TERM_LIST(`s:int`, `cursor:int`, `next:int`, `token:int`), TERM_LIST( `fact(~((KEY cursor) = 0i))`, + `fact(pmem_ptr_address_ok (KEY cursor))`, `data_at (KEY (cursor - sizeof Tuint64)) Tuint64 (KEY s)`, `data_at (KEY cursor) Tptr (KEY next)`, `mm_block_tail (KEY cursor) (KEY s)` @@ -850,15 +986,15 @@ PROOF static thm append_mm_free_segments_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm joined = ispecl_rule( - TERM_LIST(`left:(int)list`, `s:int`, `first:addr`, - `cursor:addr`, `stop:addr`, `right:(int)list`), + TERM_LIST(`left:(int)list`, `s:int`, `first:int`, + `cursor:int`, `stop:int`, `right:(int)list`), MM_FREE_SEGMENT_APPEND); ACCEPT_TAC(g, joined); return gnode_prove(root); } decl_operation(append_mm_free_segments_operation, - TERM_LIST(`s:int`, `first:addr`, `cursor:addr`, `stop:addr`), + TERM_LIST(`s:int`, `first:int`, `cursor:int`, `stop:int`), TERM_LIST( `mm_free_segment (KEY s) (KEY first) (KEY cursor) (CAPTURE left)`, @@ -885,15 +1021,15 @@ PROOF static thm join_mm_free_segment_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); thm joined = ispecl_rule( - TERM_LIST(`prefix:(int)list`, `s:int`, `first:addr`, - `cursor:addr`, `tail:(int)list`), + TERM_LIST(`prefix:(int)list`, `s:int`, `first:int`, + `cursor:int`, `tail:(int)list`), MM_FREE_SEGMENT_JOIN); ACCEPT_TAC(g, joined); return gnode_prove(root); } decl_operation(join_mm_free_segment_operation, - TERM_LIST(`s:int`, `first:addr`, `cursor:addr`), + TERM_LIST(`s:int`, `first:int`, `cursor:int`), TERM_LIST( `mm_free_segment (KEY s) (KEY first) (KEY cursor) (CAPTURE prefix)`, @@ -951,7 +1087,7 @@ PROOF static thm close_mm_page_ticket_operation_proof( assume_rule(`mm_word <= s`), assume_rule(`s:int <= mm_max_small`)); thm add_positive = intro_fact_slrule( - assume_rule(`0i < (base:addr)`), refl_slrule(resources)); + assume_rule(`0i < (base:int)`), refl_slrule(resources)); thm add_bounds = intro_fact_slrule(bounds, add_positive); add_bounds = rehcon_slrule(add_bounds, ticket_body); thm pack = exists_slrule(packed, `s:int`, add_bounds); @@ -963,7 +1099,7 @@ PROOF static thm close_mm_page_ticket_operation_proof( } decl_operation(close_mm_page_ticket_operation, - TERM_LIST(`base:addr`, `s:int`), + TERM_LIST(`base:int`, `s:int`), TERM_LIST( `mm_mapping (KEY base) (KEY mm_bigblock)`, `raw_bytes (KEY base) (KEY mm_waste)`, @@ -999,7 +1135,7 @@ PROOF static thm add_mm_page_ticket_operation_proof( } decl_operation(add_mm_page_ticket_operation, - TERM_LIST(`base:addr`), + TERM_LIST(`base:int`), TERM_LIST( `mm_page_ticket (KEY base)`, `mm_page_bank (CAPTURE pages)` @@ -1023,7 +1159,7 @@ PROOF static thm open_mm_malloc_token_operation_proof( } decl_operation(open_mm_malloc_token_operation, - TERM_LIST(`p:addr`, `n:int`), + TERM_LIST(`p:int`, `n:int`), term_list_n(1, `mm_malloc_token (KEY p) (KEY n)`), term_list_n(0), `exists s. @@ -1050,7 +1186,7 @@ PROOF static thm close_mm_malloc_token_operation_proof( } decl_operation(close_mm_malloc_token_operation, - TERM_LIST(`p:addr`, `n:int`, `s:int`), + TERM_LIST(`p:int`, `n:int`, `s:int`), TERM_LIST( `data_at (KEY (p - sizeof Tuint64)) Tuint64 (KEY s)`, `mm_token_rest (KEY p) (KEY n) (KEY s)` @@ -1080,10 +1216,11 @@ PROOF static thm open_mm_token_rest_small_operation_proof( } decl_operation(open_mm_token_rest_small_operation, - TERM_LIST(`p:addr`, `n:int`, `s:int`), + TERM_LIST(`p:int`, `n:int`, `s:int`), term_list_n(1, `mm_token_rest (KEY p) (KEY n) (KEY s)`), term_list_n(1, `s <= mm_max_small`), - `fact(0i <= n && n <= mm_max_small) ** + `fact(pmem_ptr_address_ok p) ** + fact(0i <= n && n <= mm_max_small) ** fact(s = mm_bin_size (mm_size_to_bin n)) ** raw_bytes (p + n * sizeof Tuchar) (s - n)` ) @@ -1104,8 +1241,9 @@ PROOF static thm close_mm_token_rest_small_operation_proof( } decl_operation(close_mm_token_rest_small_operation, - TERM_LIST(`p:addr`, `n:int`, `s:int`), + TERM_LIST(`p:int`, `n:int`, `s:int`), TERM_LIST( + `fact(pmem_ptr_address_ok (KEY p))`, `fact(0i <= (KEY n) && n <= mm_max_small)`, `fact((KEY s) = mm_bin_size (mm_size_to_bin n))`, `raw_bytes (KEY (p + n * sizeof Tuchar)) (KEY (s - n))` @@ -1138,7 +1276,7 @@ PROOF static thm open_mm_token_rest_large_operation_proof( } decl_operation(open_mm_token_rest_large_operation, - TERM_LIST(`p:addr`, `n:int`, `s:int`), + TERM_LIST(`p:int`, `n:int`, `s:int`), term_list_n(1, `mm_token_rest (KEY p) (KEY n) (KEY s)`), term_list_n(1, `mm_max_small < s`), `fact(mm_max_small < n) ** @@ -1166,7 +1304,7 @@ PROOF static thm close_mm_token_rest_large_operation_proof( } decl_operation(close_mm_token_rest_large_operation, - TERM_LIST(`p:addr`, `n:int`, `s:int`), + TERM_LIST(`p:int`, `n:int`, `s:int`), TERM_LIST( `fact(mm_max_small < (KEY n))`, `fact((KEY (s:int)) = (KEY (n:int)))`, @@ -1193,6 +1331,8 @@ PROOF static thm close_mm_malloc_token_small_operation_proof( const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); + g = AUTO_INIT_SLTAC(g)[0]; + g = AUTO_INTRO_FACT_SLTAC(g); thm small = conj_rule( assume_rule(`0i <= n`), assume_rule(`n:int <= mm_max_small`)); @@ -1212,6 +1352,8 @@ PROOF static thm close_mm_malloc_token_small_operation_proof( thm add_facts = intro_fact_slrule( eqt_elim_rule(refl_rule(mk_true())), refl_slrule(slack)); add_facts = intro_fact_slrule(small, add_facts); + add_facts = intro_fact_slrule( + assume_rule(`pmem_ptr_address_ok (p:int)`), add_facts); thm fold_rest = trans_slrule( add_facts, eq2ent(sym_rule(rest_view))); @@ -1233,8 +1375,9 @@ PROOF static thm close_mm_malloc_token_small_operation_proof( } decl_operation(close_mm_malloc_token_small_operation, - TERM_LIST(`p:addr`, `n:int`), + TERM_LIST(`p:int`, `n:int`), TERM_LIST( + `fact(pmem_ptr_address_ok (KEY p))`, `data_at (KEY (p - sizeof Tuint64)) Tuint64 (KEY (mm_bin_size (mm_size_to_bin n)))`, `raw_bytes (KEY (p + n * sizeof Tuchar)) @@ -1270,7 +1413,7 @@ PROOF static thm close_mm_malloc_token_large_operation_proof( (n + mm_waste + mm_word) ** raw_bytes (p - (mm_waste + mm_word)) mm_waste`; thm add_facts = intro_fact_slrule( - assume_rule(`0i < (p:addr) - (mm_waste + mm_word)`), + assume_rule(`0i < (p:int) - (mm_waste + mm_word)`), refl_slrule(retained)); add_facts = intro_fact_slrule( eqt_elim_rule(refl_rule(mk_true())), add_facts); @@ -1294,7 +1437,7 @@ PROOF static thm close_mm_malloc_token_large_operation_proof( } decl_operation(close_mm_malloc_token_large_operation, - TERM_LIST(`p:addr`, `n:int`), + TERM_LIST(`p:int`, `n:int`), TERM_LIST( `data_at (KEY (p - sizeof Tuint64)) Tuint64 (KEY n)`, `mm_mapping @@ -1327,7 +1470,7 @@ PROOF static thm close_mm_owned_block_nonnull_operation_proof( } decl_operation(close_mm_owned_block_nonnull_operation, - TERM_LIST(`p:addr`, `n:int`), + TERM_LIST(`p:int`, `n:int`), TERM_LIST( `mm_malloc_token (KEY p) (KEY n)`, `raw_bytes (KEY p) (KEY n)` @@ -1354,7 +1497,7 @@ PROOF static thm open_mm_owned_block_nonnull_operation_proof( } decl_operation(open_mm_owned_block_nonnull_operation, - TERM_LIST(`p:addr`, `n:int`), + TERM_LIST(`p:int`, `n:int`), term_list_n(1, `mm_owned_block (KEY p) (KEY n)`), term_list_n(1, `~(p = 0i)`), `mm_malloc_token p n ** raw_bytes p n` @@ -1372,13 +1515,13 @@ PROOF static thm close_mm_owned_block_null_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, simp_conv(THM_LIST( - mm_owned_block_def, assume_rule(`p:addr = 0i`)))); + mm_owned_block_def, assume_rule(`p:int = 0i`)))); AUTO_INIT_SLTAC(g); return gnode_prove(root); } decl_operation(close_mm_owned_block_null_operation, - TERM_LIST(`p:addr`, `n:int`), + TERM_LIST(`p:int`, `n:int`), term_list_n(1, `emp`), term_list_n(1, `p = 0i`), `mm_owned_block p n` @@ -1396,13 +1539,13 @@ PROOF static thm open_mm_owned_block_null_operation_proof( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, simp_conv(THM_LIST( - mm_owned_block_def, assume_rule(`p:addr = 0i`)))); + mm_owned_block_def, assume_rule(`p:int = 0i`)))); AUTO_INIT_SLTAC(g); return gnode_prove(root); } decl_operation(open_mm_owned_block_null_operation, - TERM_LIST(`p:addr`, `n:int`), + TERM_LIST(`p:int`, `n:int`), term_list_n(1, `mm_owned_block (KEY p) (KEY n)`), term_list_n(1, `p = 0i`), `emp` @@ -1444,20 +1587,21 @@ PROOF int install_memmgr_qcp_interface(void) { `EL:num->(A)list->A`, `APPEND:(A)list->(A)list->(A)list`, `list_update:num->A->(A)list->(A)list`, - `mm_mapping:addr->int->hprop`, - `mm_block_tail:addr->int->hprop`, - `mm_free_node:int->addr->addr->hprop`, - `mm_free_chain:int->addr->(int)list->hprop`, - `mm_free_segment:int->addr->addr->(int)list->hprop`, - `mm_bin_cell:addr->num->((int)list)->hprop`, - `mm_bins:addr->((int)list)list->hprop`, - `mm_bins_focus:addr->int->((int)list)list->hprop`, - `mm_page_ticket:addr->hprop`, - `mm_page_bank:(int)list->hprop`, - `mm_manager:addr->hprop`, - `mm_token_rest:addr->int->int->hprop`, - `mm_malloc_token:addr->int->hprop`, - `mm_owned_block:addr->int->hprop`)) == 0, + `mm_mapping:int->int->cprop`, + `mm_mapping_layout_ok:int->int->bool`, + `mm_block_tail:int->int->cprop`, + `mm_free_node:int->int->int->cprop`, + `mm_free_chain:int->int->(int)list->cprop`, + `mm_free_segment:int->int->int->(int)list->cprop`, + `mm_bin_cell:int->num->((int)list)->cprop`, + `mm_bins:int->((int)list)list->cprop`, + `mm_bins_focus:int->int->((int)list)list->cprop`, + `mm_page_ticket:int->cprop`, + `mm_page_bank:(int)list->cprop`, + `mm_manager:int->cprop`, + `mm_token_rest:int->int->int->cprop`, + `mm_malloc_token:int->int->cprop`, + `mm_owned_block:int->int->cprop`)) == 0, "Failed to install allocator list interface"); installed = true; return 0; @@ -1469,6 +1613,9 @@ err: PROOF static int audit_memmgr(void) { thm_list checked = THM_LIST( mm_block_tail_def, + mm_mapping_layout_ok_def, + MM_MAPPING_LAYOUT_LARGE, + MM_MAPPING_LAYOUT_SMALL, mm_free_node_def, mm_free_chain_def, mm_free_segment_def, @@ -1533,7 +1680,8 @@ PROOF static int _MEMMGR_AUDIT = audit_memmgr(); PROOF static int _MEMMGR_QCP_INTERFACE = install_memmgr_qcp_interface(); /* Contracted prototypes are the only assumed specifications in this unit. */ -void *mm_mmap0(void *requested, unsigned long long bytes, int fd) +void *mm_mmap0(void *requested, unsigned long long bytes, int fd, + unsigned long long layout_size) REQUIRE(`emp`, `fact(requested = 0i)`, `fact(fd = --1i)`, @@ -1543,6 +1691,7 @@ void *mm_mmap0(void *requested, unsigned long long bytes, int fd) TERM_LIST( `mm_mapping __return bytes`, `raw_bytes __return bytes`, + `fact(mm_mapping_layout_ok __return layout_size)`, `fact(0i < __return)`))); int mm_munmap(void *base, unsigned long long bytes) diff --git a/migrations/vst/memmgr/lib/memmgr.h b/migrations/vst/memmgr/lib/memmgr.h index d2003c0b798c4976fdcb095193a0ac47640ebf30..2a41d700768fedb461ef4c6a8b5b74d16552d8de 100644 --- a/migrations/vst/memmgr/lib/memmgr.h +++ b/migrations/vst/memmgr/lib/memmgr.h @@ -24,6 +24,11 @@ PROOF extern thm mm_token_rest_def; PROOF extern thm mm_malloc_token_def; PROOF extern thm mm_owned_block_def; +/* Address-validity guarantee returned by the foreign mapping boundary. */ +PROOF extern thm mm_mapping_layout_ok_def; +PROOF extern thm MM_MAPPING_LAYOUT_LARGE; +PROOF extern thm MM_MAPPING_LAYOUT_SMALL; + /* Representation vocabulary used by the verified allocator implementation. */ PROOF extern thm mm_block_tail_def; PROOF extern thm mm_free_node_def; @@ -107,7 +112,8 @@ PROOF void open_mm_owned_block_null( const term payload, const term requested); /* Assumed foreign boundary: a raw byte mapping and its inverse. */ -void *mm_mmap0(void *requested, unsigned long long bytes, int fd) +void *mm_mmap0(void *requested, unsigned long long bytes, int fd, + unsigned long long layout_size) REQUIRE(`emp`, `fact(requested = 0i)`, `fact(fd = --1i)`, @@ -117,6 +123,7 @@ void *mm_mmap0(void *requested, unsigned long long bytes, int fd) TERM_LIST( `mm_mapping __return bytes`, `raw_bytes __return bytes`, + `fact(mm_mapping_layout_ok __return layout_size)`, `fact(0i < __return)`))); int mm_munmap(void *base, unsigned long long bytes) diff --git a/migrations/vst/memmgr/lib/memmgr_math.c b/migrations/vst/memmgr/lib/memmgr_math.c index 95b74f92189a90497823f252269779a6e450906e..089ea3b5c49e3f9135731fc9cbc713a9cf96ef7a 100644 --- a/migrations/vst/memmgr/lib/memmgr_math.c +++ b/migrations/vst/memmgr/lib/memmgr_math.c @@ -68,7 +68,7 @@ PROOF thm MM_CHUNK_COUNT_DEF = define_fresh_mm_constant( PROOF static thm_list mm_constant_rewrites(void) { return THM_LIST( MM_WORD_DEF, - get_sizeof_def(), + sizeof_def, MM_ALIGN_DEF, MM_WASTE_DEF, MM_BIN_COUNT_DEF, @@ -260,7 +260,7 @@ PROOF static thm prove_mm_size_to_bin_range(void) { MM_SIZE_TO_BIN_DEF, not_large, MM_WORD_DEF, - get_sizeof_def(), + sizeof_def, MM_ALIGN_DEF, MM_BIN_COUNT_DEF, MM_BIN_SIZE_DEF, @@ -306,7 +306,7 @@ PROOF static thm prove_mm_size_to_bin_bin_size(void) { MM_SIZE_TO_BIN_DEF, not_large, MM_WORD_DEF, - get_sizeof_def(), + sizeof_def, MM_ALIGN_DEF, MM_BIN_COUNT_DEF, MM_BIN_SIZE_DEF, @@ -371,7 +371,7 @@ PROOF static thm prove_mm_rounding_bounds(void) { MM_SIZE_TO_BIN_DEF, not_large, MM_WORD_DEF, - get_sizeof_def(), + sizeof_def, MM_ALIGN_DEF, MM_BIN_SIZE_DEF, MM_MAX_SMALL_DEF))); diff --git a/migrations/vst/memmgr/lib/raw_memory.c b/migrations/vst/memmgr/lib/raw_memory.c index 95549642d5a2392dfaa032b3ac036f269f42958a..108c2135095b104c952e15c8566f409b9a175891 100644 --- a/migrations/vst/memmgr/lib/raw_memory.c +++ b/migrations/vst/memmgr/lib/raw_memory.c @@ -28,27 +28,78 @@ err: PROOF thm raw_bytes_def = define_fresh_raw_constant( "raw_bytes", - `raw_bytes (p:addr) (n:int) -|- - undef_array_at p Tuchar n`); + `raw_bytes (p:int) (n:int) -|- + c_allocated_at unit_ra p (num_of_int n)`); + +/*-------------------------- Arithmetic facts --------------------------*/ + +PROOF static thm raw_num_of_int_sum( + const term n, const term k, + const thm k_nonnegative, const thm k_bounded) { + thm remainder_nonnegative = list_match_mp_rule(int_arith_rule(` + forall n k:int. 0i <= k ==> k <= n ==> 0i <= n - k + `), THM_LIST(k_nonnegative, k_bounded)); + thm decomposition = list_match_mp_rule(int_arith_rule(` + forall n k:int. 0i <= k ==> k <= n ==> n = k + (n - k) + `), THM_LIST(k_nonnegative, k_bounded)); + thm expose_num_of_int = mk_comb_rule( + refl_rule(`num_of_int:int->num`), decomposition); + term remainder = mk_binop(`(-):int->int->int`, n, k); + thm distribute = ispecl_rule( + TERM_LIST(k, remainder), + get_theorem_by_name("NUM_OF_INT_ADD")); + distribute = match_mp_rule( + distribute, + conj_rule(k_nonnegative, remainder_nonnegative)); + return trans_rule(expose_num_of_int, distribute); +} + +PROOF static thm raw_nat_address(const term p, const term k, + const thm k_nonnegative) { + thm cast = ispec_rule( + k, get_theorem_by_name("INT_OF_NUM_OF_INT")); + cast = match_mp_rule(cast, k_nonnegative); + thm uchar_size = eqt_elim_rule(apply_conversion( + rewrite_conv(THM_LIST(sizeof_def)), + `sizeof Tuchar = 1i`)); + term z = mk_var("z", mk_int_type()); + term add_p = mk_abs( + z, mk_binop(`(+):int->int->int`, p, z)); + thm expose_cast = beta_rule(ap_term_rule(add_p, cast)); + thm scale = ispecl_rule(TERM_LIST(p, k), int_ring_rule(` + forall p k:int. + sizeof Tuchar = 1i ==> + p + k = p + k * sizeof Tuchar + `)); + scale = match_mp_rule(scale, uchar_size); + return trans_rule(expose_cast, scale); +} -/*-------------------------- Closed laws ---------------------------*/ +/*---------------------------- Range laws ----------------------------*/ PROOF static thm prove_raw_bytes_split(void) { - term goal_tm = ` - forall (p:addr) (n:int) (k:int). + gnode root = gnode_new_with_ccl(` + forall (p:int) (n:int) (k:int). 0i <= k ==> k <= n ==> (raw_bytes p n -|- raw_bytes p k ** raw_bytes (p + k * sizeof Tuchar) (n - k)) - `; - gnode root = gnode_new_with_ccl(goal_tm); + `); gnode g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(raw_bytes_def))); - thm split = specl_rule( - TERM_LIST(`p:addr`, `Tuchar`, `n:int`, `k:int`), - get_undef_array_at_divide()); - split = mp_rule(split, assume_rule(`0i <= k`)); - split = mp_rule(split, assume_rule(`k:int <= n`)); + thm hk = assume_rule(`0i <= k`); + thm hkn = assume_rule(`k:int <= n`); + thm count = raw_num_of_int_sum(`n:int`, `k:int`, hk, hkn); + thm address = raw_nat_address(`p:int`, `k:int`, hk); + + thm split = ispecl_rule( + TERM_LIST( + `p:int`, + `num_of_int (k:int)`, + `num_of_int ((n:int) - k)`), + c_logic_current()->allocated_at_append); + split = pure_rewrite_rule( + THM_LIST(gsym_rule(count), address), split); + g = CONV_TAC(g, pure_rewrite_conv(THM_LIST(raw_bytes_def))); ACCEPT_TAC(g, split); return gnode_prove(root); } @@ -56,158 +107,418 @@ PROOF static thm prove_raw_bytes_split(void) { PROOF thm RAW_BYTES_SPLIT = prove_raw_bytes_split(); PROOF static thm prove_raw_bytes_join(void) { - term goal_tm = ` - forall (p:addr) (k:int) (n:int). + gnode root = gnode_new_with_ccl(` + forall (p:int) (k:int) (n:int). 0i <= k ==> 0i <= n ==> (raw_bytes p k ** raw_bytes (p + k * sizeof Tuchar) n |-- raw_bytes p (k + n)) - `; - gnode root = gnode_new_with_ccl(goal_tm); + `); gnode g = AUTO_INTROS_TAC(root); - thm hk = assume_rule(`0i <= k`); thm hn = assume_rule(`0i <= n`); - thm upper = mp_rule(mp_rule(int_arith_rule(` - 0i <= k ==> 0i <= n ==> k <= k + n - `), hk), hn); - thm remainder = mp_rule(mp_rule(int_arith_rule(` - 0i <= k ==> 0i <= n ==> (k + n) - k = n - `), hk), hn); - thm split = specl_rule( - TERM_LIST(`p:addr`, `Tuchar`, `k + n:int`, `k:int`), - get_undef_array_at_divide()); - split = mp_rule(split, hk); - split = mp_rule(split, upper); - thm join = eq2ent(sym_rule(split)); - thm suffix_eq = beta_rule(ap_term_rule(` - \r:int. undef_array_at - (p + k * sizeof Tuchar) Tuchar r - `, remainder)); - thm antecedent_eq = beta_rule(ap_term_rule(` - \suffix:hprop. undef_array_at p Tuchar k ** suffix - `, suffix_eq)); - join = trans_slrule(eq2ent(sym_rule(antecedent_eq)), join); - - g = CONV_TAC(g, rewrite_conv(THM_LIST(raw_bytes_def))); - ACCEPT_TAC(g, join); + thm upper = list_match_mp_rule(int_arith_rule(` + forall k n:int. 0i <= k ==> 0i <= n ==> k <= k + n + `), THM_LIST(hk, hn)); + thm remainder = list_match_mp_rule(int_arith_rule(` + forall k n:int. 0i <= k ==> 0i <= n ==> (k + n) - k = n + `), THM_LIST(hk, hn)); + thm split = ispecl_rule( + TERM_LIST(`p:int`, `k + n:int`, `k:int`), + RAW_BYTES_SPLIT); + split = mp_rule(mp_rule(split, hk), upper); + split = pure_rewrite_rule(THM_LIST(remainder), split); + ACCEPT_TAC(g, eq2ent(sym_rule(split))); return gnode_prove(root); } PROOF thm RAW_BYTES_JOIN = prove_raw_bytes_join(); -PROOF static thm prove_raw_bytes_carve(void) { - term goal_tm = ` - forall (p:addr) (ty:ctype) (n:int). - sizeof ty <= n ==> - (raw_bytes p n -|- - undef_data_at p ty ** - raw_bytes (p + sizeof ty) (n - sizeof ty)) - `; - gnode root = gnode_new_with_ccl(goal_tm); +PROOF static thm prove_raw_bytes_zero(void) { + gnode root = gnode_new_with_ccl(` + forall p:int. raw_bytes p 0i -|- emp + `); + thm num_zero = ispec_rule( + `0:num`, get_theorem_by_name("NUM_OF_INT_OF_NUM")); + gnode body = GEN_TAC(root, "p"); + gnode g = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(raw_bytes_def, num_zero))); + ACCEPT_TAC( + g, + ispec_rule(`p:int`, c_logic_current()->allocated_at_zero)); + return gnode_prove(root); +} + +PROOF thm RAW_BYTES_ZERO = prove_raw_bytes_zero(); + +/*---------------------- Raw-to-QCP typed views ----------------------*/ + +PROOF static thm prove_raw_bytes_tptr_to_undef_data_at(void) { + gnode root = gnode_new_with_ccl(` + forall p:int. + pmem_ptr_address_ok p ==> + (raw_bytes p (sizeof Tptr) |-- undef_data_at p Tptr) + `); gnode g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(raw_bytes_def))); - thm carve = specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `n:int`), - get_undef_Tuchar_array_at_split()); - thm bound = mp_rule(int_arith_rule(` - sizeof ty <= n ==> n >= sizeof ty - `), assume_rule(`sizeof ty <= n`)); - carve = mp_rule(carve, bound); - ACCEPT_TAC(g, carve); + thm law = ispecl_rule( + TERM_LIST(`p:int`, `Tptr`), + c_logic_current()->allocated_at_to_undef_data_at); + thm address_ok = pure_once_rewrite_rule( + THM_LIST(pmem_ptr_address_ok_def), + assume_rule(`pmem_ptr_address_ok (p:int)`)); + law = match_mp_rule(law, address_ok); + law = pure_rewrite_rule(THM_LIST( + pmem_c_width_def, + pmem_ctype_distinct, + get_theorem_by_name("REFL_CLAUSE"), + get_theorem_by_name("COND_CLAUSES")), law); + g = CONV_TAC(g, pure_rewrite_conv(THM_LIST( + raw_bytes_def, + sizeof_def, + get_theorem_by_name("NUM_OF_INT_OF_NUM")))); + ACCEPT_TAC(g, law); return gnode_prove(root); } -PROOF thm RAW_BYTES_CARVE = prove_raw_bytes_carve(); +PROOF thm RAW_BYTES_TPTR_TO_UNDEF_DATA_AT = + prove_raw_bytes_tptr_to_undef_data_at(); -PROOF static thm prove_raw_bytes_uncarve(void) { - term goal_tm = ` - forall (p:addr) (ty:ctype) (n:int). - 0i <= n ==> - (undef_data_at p ty ** raw_bytes (p + sizeof ty) n -|- - raw_bytes p (sizeof ty + n)) - `; - gnode root = gnode_new_with_ccl(goal_tm); +PROOF static thm prove_raw_bytes_tuint64_to_undef_data_at(void) { + gnode root = gnode_new_with_ccl(` + forall p:int. + pmem_uint64_address_ok p ==> + (raw_bytes p (sizeof Tuint64) |-- undef_data_at p Tuint64) + `); gnode g = AUTO_INTROS_TAC(root); + thm law = ispecl_rule( + TERM_LIST(`p:int`, `Tuint64`), + c_logic_current()->allocated_at_to_undef_data_at); + thm address_ok = pure_once_rewrite_rule( + THM_LIST(pmem_uint64_address_ok_def), + assume_rule(`pmem_uint64_address_ok (p:int)`)); + law = match_mp_rule(law, address_ok); + law = pure_rewrite_rule(THM_LIST( + pmem_c_width_def, + pmem_ctype_distinct, + get_theorem_by_name("REFL_CLAUSE"), + get_theorem_by_name("COND_CLAUSES")), law); + g = CONV_TAC(g, pure_rewrite_conv(THM_LIST( + raw_bytes_def, + sizeof_def, + get_theorem_by_name("NUM_OF_INT_OF_NUM")))); + ACCEPT_TAC(g, law); + return gnode_prove(root); +} - thm hn = assume_rule(`0i <= n`); - thm upper = mp_rule(int_arith_rule(` - 0i <= n ==> sizeof ty + n >= sizeof ty - `), hn); - thm remainder = mp_rule(int_arith_rule(` - 0i <= n ==> (sizeof ty + n) - sizeof ty = n - `), hn); - thm carve = specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `sizeof ty + n:int`), - get_undef_Tuchar_array_at_split()); - carve = mp_rule(carve, upper); - thm uncarve = sym_rule(carve); - thm suffix_eq = beta_rule(ap_term_rule(` - \r:int. undef_array_at (p + sizeof ty) Tuchar r - `, remainder)); - thm antecedent_eq = beta_rule(ap_term_rule(` - \suffix:hprop. undef_data_at p ty ** suffix - `, suffix_eq)); - uncarve = trans_rule(sym_rule(antecedent_eq), uncarve); - - g = CONV_TAC(g, rewrite_conv(THM_LIST(raw_bytes_def))); - ACCEPT_TAC(g, uncarve); +PROOF thm RAW_BYTES_TUINT64_TO_UNDEF_DATA_AT = + prove_raw_bytes_tuint64_to_undef_data_at(); + +PROOF static thm raw_bytes_carve_typed( + const term p, const term n, const term ty, + const thm address_ok, const thm size_bounded, + const thm raw_to_undef) { + term width = mk_icomb(`sizeof:ctype->int`, ty); + thm width_value = eqt_elim_rule(apply_conversion( + rewrite_conv(THM_LIST(sizeof_def)), + mk_eq(width, `8i`))); + thm width_nonnegative = ispec_rule(width, int_arith_rule(` + forall width:int. width = 8i ==> 0i <= width + `)); + width_nonnegative = match_mp_rule(width_nonnegative, width_value); + + thm split = ispecl_rule( + TERM_LIST(p, n, width), RAW_BYTES_SPLIT); + split = mp_rule(mp_rule(split, width_nonnegative), size_bounded); + + thm uchar_size = eqt_elim_rule(apply_conversion( + rewrite_conv(THM_LIST(sizeof_def)), + `sizeof Tuchar = 1i`)); + thm suffix_address = ispecl_rule( + TERM_LIST(p, width), int_ring_rule(` + forall p width:int. + sizeof Tuchar = 1i ==> + p + width * sizeof Tuchar = p + width + `)); + suffix_address = match_mp_rule(suffix_address, uchar_size); + split = pure_once_rewrite_rule(THM_LIST(suffix_address), split); + + thm typed = match_mp_rule(raw_to_undef, address_ok); + term suffix_address_tm = mk_binop(`(+):int->int->int`, p, width); + term remaining = mk_binop(`(-):int->int->int`, n, width); + term suffix = mk_icomb( + mk_icomb(`raw_bytes:int->int->cprop`, suffix_address_tm), + remaining); + thm weaken = frame_right_slrule(typed, suffix); + return trans_slrule(eq2ent(split), weaken); +} + +PROOF static thm prove_raw_bytes_carve_tptr(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (n:int). + pmem_ptr_address_ok p ==> + sizeof Tptr <= n ==> + (raw_bytes p n |-- + undef_data_at p Tptr ** + raw_bytes (p + sizeof Tptr) (n - sizeof Tptr)) + `); + gnode g = AUTO_INTROS_TAC(root); + ACCEPT_TAC(g, raw_bytes_carve_typed( + `p:int`, `n:int`, `Tptr`, + assume_rule(`pmem_ptr_address_ok (p:int)`), + assume_rule(`sizeof Tptr <= (n:int)`), + ispec_rule(`p:int`, RAW_BYTES_TPTR_TO_UNDEF_DATA_AT))); return gnode_prove(root); } -PROOF thm RAW_BYTES_UNCARVE = prove_raw_bytes_uncarve(); +PROOF thm RAW_BYTES_CARVE_TPTR = + prove_raw_bytes_carve_tptr(); + +PROOF static thm prove_raw_bytes_carve_tuint64(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (n:int). + pmem_uint64_address_ok p ==> + sizeof Tuint64 <= n ==> + (raw_bytes p n |-- + undef_data_at p Tuint64 ** + raw_bytes (p + sizeof Tuint64) (n - sizeof Tuint64)) + `); + gnode g = AUTO_INTROS_TAC(root); + ACCEPT_TAC(g, raw_bytes_carve_typed( + `p:int`, `n:int`, `Tuint64`, + assume_rule(`pmem_uint64_address_ok (p:int)`), + assume_rule(`sizeof Tuint64 <= (n:int)`), + ispec_rule(`p:int`, RAW_BYTES_TUINT64_TO_UNDEF_DATA_AT))); + return gnode_prove(root); +} -PROOF static thm prove_data_at_forget(void) { - term goal_tm = ` - forall (p:addr) (ty:ctype) (v:int). - data_at p ty v |-- undef_data_at p ty - `; - gnode root = gnode_new_with_ccl(goal_tm); +PROOF thm RAW_BYTES_CARVE_TUINT64 = + prove_raw_bytes_carve_tuint64(); + +/*---------------------- Typed-to-raw weakening ----------------------*/ + +PROOF static thm prove_data_at_tptr_to_raw_bytes(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (v:int). + data_at p Tptr v |-- raw_bytes p (sizeof Tptr) + `); + gnode g = AUTO_INTROS_TAC(root); + thm law = ispecl_rule( + TERM_LIST(`p:int`, `Tptr`, `v:int`), + c_logic_current()->data_at_allocated_at); + law = pure_rewrite_rule( + THM_LIST( + pmem_c_width_def, + pmem_ctype_distinct, + get_theorem_by_name("REFL_CLAUSE"), + get_theorem_by_name("COND_CLAUSES")), + law); + g = CONV_TAC(g, pure_rewrite_conv(THM_LIST( + raw_bytes_def, + sizeof_def, + get_theorem_by_name("NUM_OF_INT_OF_NUM")))); + ACCEPT_TAC(g, law); + return gnode_prove(root); +} + +PROOF thm DATA_AT_TPTR_TO_RAW_BYTES = + prove_data_at_tptr_to_raw_bytes(); + +PROOF static thm prove_data_at_tuint64_to_raw_bytes(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (v:int). + data_at p Tuint64 v |-- raw_bytes p (sizeof Tuint64) + `); + gnode g = AUTO_INTROS_TAC(root); + thm law = ispecl_rule( + TERM_LIST(`p:int`, `Tuint64`, `v:int`), + c_logic_current()->data_at_allocated_at); + law = pure_rewrite_rule( + THM_LIST( + pmem_c_width_def, + pmem_ctype_distinct, + get_theorem_by_name("REFL_CLAUSE"), + get_theorem_by_name("COND_CLAUSES")), + law); + g = CONV_TAC(g, pure_rewrite_conv(THM_LIST( + raw_bytes_def, + sizeof_def, + get_theorem_by_name("NUM_OF_INT_OF_NUM")))); + ACCEPT_TAC(g, law); + return gnode_prove(root); +} + +PROOF thm DATA_AT_TUINT64_TO_RAW_BYTES = + prove_data_at_tuint64_to_raw_bytes(); + +PROOF static thm prove_undef_data_at_tptr_to_raw_bytes(void) { + gnode root = gnode_new_with_ccl(` + forall p:int. + undef_data_at p Tptr |-- raw_bytes p (sizeof Tptr) + `); gnode g = AUTO_INTROS_TAC(root); - ACCEPT_TAC(g, specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `v:int`), - get_data_at_to_undef_data_at())); + thm law = ispecl_rule( + TERM_LIST(`p:int`, `Tptr`), + c_logic_current()->undef_data_at_allocated_at); + law = pure_rewrite_rule( + THM_LIST( + pmem_c_width_def, + pmem_ctype_distinct, + get_theorem_by_name("REFL_CLAUSE"), + get_theorem_by_name("COND_CLAUSES")), + law); + g = CONV_TAC(g, pure_rewrite_conv(THM_LIST( + raw_bytes_def, + sizeof_def, + get_theorem_by_name("NUM_OF_INT_OF_NUM")))); + ACCEPT_TAC(g, law); return gnode_prove(root); } -PROOF thm DATA_AT_FORGET = prove_data_at_forget(); +PROOF thm UNDEF_DATA_AT_TPTR_TO_RAW_BYTES = + prove_undef_data_at_tptr_to_raw_bytes(); -PROOF static thm prove_raw_bytes_forget_cell(void) { - term goal_tm = ` - forall (p:addr) (ty:ctype) (v:int) (n:int). +PROOF static thm prove_undef_data_at_tuint64_to_raw_bytes(void) { + gnode root = gnode_new_with_ccl(` + forall p:int. + undef_data_at p Tuint64 |-- raw_bytes p (sizeof Tuint64) + `); + gnode g = AUTO_INTROS_TAC(root); + thm law = ispecl_rule( + TERM_LIST(`p:int`, `Tuint64`), + c_logic_current()->undef_data_at_allocated_at); + law = pure_rewrite_rule( + THM_LIST( + pmem_c_width_def, + pmem_ctype_distinct, + get_theorem_by_name("REFL_CLAUSE"), + get_theorem_by_name("COND_CLAUSES")), + law); + g = CONV_TAC(g, pure_rewrite_conv(THM_LIST( + raw_bytes_def, + sizeof_def, + get_theorem_by_name("NUM_OF_INT_OF_NUM")))); + ACCEPT_TAC(g, law); + return gnode_prove(root); +} + +PROOF thm UNDEF_DATA_AT_TUINT64_TO_RAW_BYTES = + prove_undef_data_at_tuint64_to_raw_bytes(); + +PROOF static thm raw_bytes_merge_typed_cell( + const term p, const term n, + const term ty, + const thm typed_to_raw, + const thm n_nonnegative) { + thm weaken = frame_right_slrule( + typed_to_raw, + mk_icomb(mk_icomb(`raw_bytes:int->int->cprop`, + mk_binop(`(+):int->int->int`, p, + mk_icomb(`sizeof:ctype->int`, ty))), + n)); + term width = mk_icomb(`sizeof:ctype->int`, ty); + thm width_value = eqt_elim_rule(apply_conversion( + rewrite_conv(THM_LIST(sizeof_def)), + mk_eq(width, `8i`))); + thm width_nonnegative = ispec_rule(width, int_arith_rule(` + forall width:int. width = 8i ==> 0i <= width + `)); + width_nonnegative = match_mp_rule(width_nonnegative, width_value); + thm uchar_size = eqt_elim_rule(apply_conversion( + rewrite_conv(THM_LIST(sizeof_def)), + `sizeof Tuchar = 1i`)); + thm suffix_address = ispecl_rule( + TERM_LIST(p, width), int_ring_rule(` + forall p width:int. + sizeof Tuchar = 1i ==> + p + width * sizeof Tuchar = p + width + `)); + suffix_address = match_mp_rule(suffix_address, uchar_size); + thm join = ispecl_rule( + TERM_LIST(p, mk_icomb(`sizeof:ctype->int`, ty), n), + RAW_BYTES_JOIN); + join = mp_rule(mp_rule(join, width_nonnegative), n_nonnegative); + join = pure_once_rewrite_rule(THM_LIST(suffix_address), join); + return trans_slrule(weaken, join); +} + +PROOF static thm prove_raw_bytes_forget_tptr_cell(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (v:int) (n:int). 0i <= n ==> - (data_at p ty v ** raw_bytes (p + sizeof ty) n |-- - raw_bytes p (sizeof ty + n)) - `; - gnode root = gnode_new_with_ccl(goal_tm); + (data_at p Tptr v ** raw_bytes (p + sizeof Tptr) n |-- + raw_bytes p (sizeof Tptr + n)) + `); gnode g = AUTO_INTROS_TAC(root); - thm forget = specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `v:int`), DATA_AT_FORGET); - forget = frame_right_slrule( - forget, `raw_bytes (p + sizeof ty) n`); - thm uncarve = specl_rule( - TERM_LIST(`p:addr`, `ty:ctype`, `n:int`), RAW_BYTES_UNCARVE); - uncarve = mp_rule(uncarve, assume_rule(`0i <= n`)); - ACCEPT_TAC(g, trans_slrule(forget, eq2ent(uncarve))); + thm weaken = ispecl_rule( + TERM_LIST(`p:int`, `v:int`), DATA_AT_TPTR_TO_RAW_BYTES); + ACCEPT_TAC(g, raw_bytes_merge_typed_cell( + `p:int`, `n:int`, `Tptr`, weaken, + assume_rule(`0i <= n`))); return gnode_prove(root); } -PROOF thm RAW_BYTES_FORGET_CELL = prove_raw_bytes_forget_cell(); +PROOF thm RAW_BYTES_FORGET_TPTR_CELL = + prove_raw_bytes_forget_tptr_cell(); -PROOF static thm prove_raw_bytes_zero(void) { - term goal_tm = `forall p:addr. raw_bytes p 0i -|- emp`; - gnode root = gnode_new_with_ccl(goal_tm); +PROOF static thm prove_raw_bytes_forget_tuint64_cell(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (v:int) (n:int). + 0i <= n ==> + (data_at p Tuint64 v ** + raw_bytes (p + sizeof Tuint64) n |-- + raw_bytes p (sizeof Tuint64 + n)) + `); gnode g = AUTO_INTROS_TAC(root); - g = CONV_TAC(g, rewrite_conv(THM_LIST(raw_bytes_def))); - thm zero = specl_rule( - TERM_LIST(`p:addr`, `Tuchar`, `0i:int`), - get_undef_array_at_zero()); - zero = mp_rule(zero, refl_rule(`0i:int`)); - ACCEPT_TAC(g, zero); + thm weaken = ispecl_rule( + TERM_LIST(`p:int`, `v:int`), DATA_AT_TUINT64_TO_RAW_BYTES); + ACCEPT_TAC(g, raw_bytes_merge_typed_cell( + `p:int`, `n:int`, `Tuint64`, weaken, + assume_rule(`0i <= n`))); return gnode_prove(root); } -PROOF thm RAW_BYTES_ZERO = prove_raw_bytes_zero(); +PROOF thm RAW_BYTES_FORGET_TUINT64_CELL = + prove_raw_bytes_forget_tuint64_cell(); + +PROOF static thm prove_raw_bytes_uncarve_tptr(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (n:int). + 0i <= n ==> + (undef_data_at p Tptr ** raw_bytes (p + sizeof Tptr) n |-- + raw_bytes p (sizeof Tptr + n)) + `); + gnode g = AUTO_INTROS_TAC(root); + thm weaken = ispec_rule( + `p:int`, UNDEF_DATA_AT_TPTR_TO_RAW_BYTES); + ACCEPT_TAC(g, raw_bytes_merge_typed_cell( + `p:int`, `n:int`, `Tptr`, weaken, + assume_rule(`0i <= n`))); + return gnode_prove(root); +} + +PROOF thm RAW_BYTES_UNCARVE_TPTR = + prove_raw_bytes_uncarve_tptr(); + +PROOF static thm prove_raw_bytes_uncarve_tuint64(void) { + gnode root = gnode_new_with_ccl(` + forall (p:int) (n:int). + 0i <= n ==> + (undef_data_at p Tuint64 ** + raw_bytes (p + sizeof Tuint64) n |-- + raw_bytes p (sizeof Tuint64 + n)) + `); + gnode g = AUTO_INTROS_TAC(root); + thm weaken = ispec_rule( + `p:int`, UNDEF_DATA_AT_TUINT64_TO_RAW_BYTES); + ACCEPT_TAC(g, raw_bytes_merge_typed_cell( + `p:int`, `n:int`, `Tuint64`, weaken, + assume_rule(`0i <= n`))); + return gnode_prove(root); +} + +PROOF thm RAW_BYTES_UNCARVE_TUINT64 = + prove_raw_bytes_uncarve_tuint64(); /*---------------------- Operation proof helpers ----------------------*/ @@ -241,7 +552,7 @@ PROOF static thm split_raw_bytes_operation_proof(const term goal_tm) { } decl_operation(split_raw_bytes_operation, - TERM_LIST(`p:addr`, `k:int`), + TERM_LIST(`p:int`, `k:int`), term_list_n(1, `raw_bytes (KEY p) (CAPTURE n)`), TERM_LIST(`0i <= k`, `k <= n`), `raw_bytes p k ** raw_bytes (p + k * sizeof Tuchar) (n - k)` @@ -256,7 +567,7 @@ PROOF static thm join_raw_bytes_operation_proof(const term goal_tm) { } decl_operation(join_raw_bytes_operation, - TERM_LIST(`p:addr`, `k:int`), + TERM_LIST(`p:int`, `k:int`), TERM_LIST( `raw_bytes (KEY p) (KEY k)`, `raw_bytes (KEY (p + k * sizeof Tuchar)) (CAPTURE n)`), @@ -268,76 +579,150 @@ PROOF void join_raw_bytes(const term p, const term k) { apply_operation_st(join_raw_bytes_operation, TERM_LIST(p, k)); } -PROOF static thm carve_raw_cell_operation_proof(const term goal_tm) { - return prove_raw_operation_by_equality( - goal_tm, RAW_BYTES_CARVE, false); +PROOF static thm carve_raw_ptr_cell_operation_proof( + const term goal_tm) { + return prove_raw_operation_by_entailment( + goal_tm, RAW_BYTES_CARVE_TPTR); } -decl_operation(carve_raw_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`), +decl_operation(carve_raw_ptr_cell_operation, + term_list_n(1, `p:int`), term_list_n(1, `raw_bytes (KEY p) (CAPTURE n)`), - term_list_n(1, `sizeof ty <= n`), - `undef_data_at p ty ** raw_bytes (p + sizeof ty) (n - sizeof ty)` + TERM_LIST(`pmem_ptr_address_ok p`, `sizeof Tptr <= n`), + `undef_data_at p Tptr ** + raw_bytes (p + sizeof Tptr) (n - sizeof Tptr)` ) -PROOF void carve_raw_cell(const term p, const term ty) { - apply_operation_st(carve_raw_cell_operation, TERM_LIST(p, ty)); +PROOF void carve_raw_ptr_cell(const term p) { + apply_operation_st(carve_raw_ptr_cell_operation, term_list_n(1, p)); } -PROOF static thm uncarve_raw_cell_operation_proof( +PROOF static thm carve_raw_uint64_cell_operation_proof( const term goal_tm) { - return prove_raw_operation_by_equality( - goal_tm, RAW_BYTES_UNCARVE, false); + return prove_raw_operation_by_entailment( + goal_tm, RAW_BYTES_CARVE_TUINT64); } -decl_operation(uncarve_raw_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`), - TERM_LIST( - `undef_data_at (KEY p) (KEY ty)`, - `raw_bytes (KEY (p + sizeof ty)) (CAPTURE n)`), - term_list_n(1, `0i <= n`), - `raw_bytes p (sizeof ty + n)` +decl_operation(carve_raw_uint64_cell_operation, + term_list_n(1, `p:int`), + term_list_n(1, `raw_bytes (KEY p) (CAPTURE n)`), + TERM_LIST(`pmem_uint64_address_ok p`, `sizeof Tuint64 <= n`), + `undef_data_at p Tuint64 ** + raw_bytes (p + sizeof Tuint64) (n - sizeof Tuint64)` ) -PROOF void uncarve_raw_cell(const term p, const term ty) { - apply_operation_st(uncarve_raw_cell_operation, TERM_LIST(p, ty)); +PROOF void carve_raw_uint64_cell(const term p) { + apply_operation_st( + carve_raw_uint64_cell_operation, term_list_n(1, p)); } -PROOF static thm forget_data_cell_operation_proof(const term goal_tm) { - return prove_raw_operation_by_entailment(goal_tm, DATA_AT_FORGET); +PROOF void carve_raw_cell(const term p, const term ty) { + if (equals_term(ty, `Tptr`)) { + carve_raw_ptr_cell(p); + return; + } + if (equals_term(ty, `Tuint64`)) { + carve_raw_uint64_cell(p); + return; + } + ERR_FUN_PUTS( + "carve_raw_cell", + cstr_term(p), + cstr_term(ty), + "expected literal Tptr or Tuint64"); } -decl_operation(forget_data_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`), - term_list_n(1, - `data_at (KEY p) (KEY ty) (CAPTURE v)`), +#define DEFINE_TYPED_RAW_OPERATION( \ + op_name, public_name, closed_law, antecedents, side_conditions, \ + consequent) \ + PROOF static thm op_name##_proof(const term goal_tm) { \ + return prove_raw_operation_by_entailment(goal_tm, closed_law); \ + } \ + decl_operation(op_name, term_list_n(1, `p:int`), antecedents, \ + side_conditions, consequent) \ + PROOF void public_name(const term p) { \ + apply_operation_st(op_name, term_list_n(1, p)); \ + } + +DEFINE_TYPED_RAW_OPERATION( + forget_data_ptr_cell_operation, + forget_data_ptr_cell, + DATA_AT_TPTR_TO_RAW_BYTES, + term_list_n(1, `data_at (KEY p) Tptr (CAPTURE v)`), term_list_n(0), - `undef_data_at p ty` + `raw_bytes p (sizeof Tptr)` ) -PROOF void forget_data_cell(const term p, const term ty) { - apply_operation_st(forget_data_cell_operation, TERM_LIST(p, ty)); -} +DEFINE_TYPED_RAW_OPERATION( + forget_data_uint64_cell_operation, + forget_data_uint64_cell, + DATA_AT_TUINT64_TO_RAW_BYTES, + term_list_n(1, `data_at (KEY p) Tuint64 (CAPTURE v)`), + term_list_n(0), + `raw_bytes p (sizeof Tuint64)` +) -PROOF static thm forget_and_uncarve_raw_cell_operation_proof( - const term goal_tm) { - return prove_raw_operation_by_entailment( - goal_tm, RAW_BYTES_FORGET_CELL); -} +DEFINE_TYPED_RAW_OPERATION( + forget_and_merge_data_ptr_cell_operation, + forget_and_merge_data_ptr_cell, + RAW_BYTES_FORGET_TPTR_CELL, + TERM_LIST( + `data_at (KEY p) Tptr (CAPTURE v)`, + `raw_bytes (KEY (p + sizeof Tptr)) (CAPTURE n)`), + term_list_n(1, `0i <= n`), + `raw_bytes p (sizeof Tptr + n)` +) -decl_operation(forget_and_uncarve_raw_cell_operation, - TERM_LIST(`p:addr`, `ty:ctype`), +DEFINE_TYPED_RAW_OPERATION( + forget_and_merge_data_uint64_cell_operation, + forget_and_merge_data_uint64_cell, + RAW_BYTES_FORGET_TUINT64_CELL, TERM_LIST( - `data_at (KEY p) (KEY ty) (CAPTURE v)`, - `raw_bytes (KEY (p + sizeof ty)) (CAPTURE n)`), + `data_at (KEY p) Tuint64 (CAPTURE v)`, + `raw_bytes (KEY (p + sizeof Tuint64)) (CAPTURE n)`), term_list_n(1, `0i <= n`), - `raw_bytes p (sizeof ty + n)` + `raw_bytes p (sizeof Tuint64 + n)` ) +DEFINE_TYPED_RAW_OPERATION( + merge_undef_ptr_cell_operation, + merge_undef_ptr_cell, + RAW_BYTES_UNCARVE_TPTR, + TERM_LIST( + `undef_data_at (KEY p) Tptr`, + `raw_bytes (KEY (p + sizeof Tptr)) (CAPTURE n)`), + term_list_n(1, `0i <= n`), + `raw_bytes p (sizeof Tptr + n)` +) + +DEFINE_TYPED_RAW_OPERATION( + merge_undef_uint64_cell_operation, + merge_undef_uint64_cell, + RAW_BYTES_UNCARVE_TUINT64, + TERM_LIST( + `undef_data_at (KEY p) Tuint64`, + `raw_bytes (KEY (p + sizeof Tuint64)) (CAPTURE n)`), + term_list_n(1, `0i <= n`), + `raw_bytes p (sizeof Tuint64 + n)` +) + +#undef DEFINE_TYPED_RAW_OPERATION + PROOF void forget_and_uncarve_raw_cell( const term p, const term ty) { - apply_operation_st( - forget_and_uncarve_raw_cell_operation, TERM_LIST(p, ty)); + if (equals_term(ty, `Tptr`)) { + forget_and_merge_data_ptr_cell(p); + return; + } + if (equals_term(ty, `Tuint64`)) { + forget_and_merge_data_uint64_cell(p); + return; + } + ERR_FUN_PUTS( + "forget_and_uncarve_raw_cell", + cstr_term(p), + cstr_term(ty), + "expected literal Tptr or Tuint64"); } PROOF static thm erase_zero_raw_bytes_operation_proof( @@ -347,7 +732,7 @@ PROOF static thm erase_zero_raw_bytes_operation_proof( } decl_operation(erase_zero_raw_bytes_operation, - term_list_n(1, `p:addr`), + term_list_n(1, `p:int`), term_list_n(1, `raw_bytes (KEY p) (KEY 0i)`), term_list_n(0), `emp` @@ -364,7 +749,7 @@ PROOF static thm introduce_zero_raw_bytes_operation_proof( } decl_operation(introduce_zero_raw_bytes_operation, - term_list_n(1, `p:addr`), + term_list_n(1, `p:int`), term_list_n(0), term_list_n(0), `raw_bytes p 0i` @@ -381,7 +766,7 @@ PROOF int install_raw_memory_qcp_interface(void) { static bool installed = false; if (installed) return 0; ENSURE_COND( - cst_add_const_to_header(`raw_bytes:addr->int->hprop`) == 0, + cst_add_const_to_header(`raw_bytes:int->int->cprop`) == 0, "Failed to export logical constant `raw_bytes`"); installed = true; return 0; @@ -395,17 +780,29 @@ PROOF static int audit_raw_memory(void) { raw_bytes_def, RAW_BYTES_SPLIT, RAW_BYTES_JOIN, - RAW_BYTES_CARVE, - RAW_BYTES_UNCARVE, - DATA_AT_FORGET, - RAW_BYTES_FORGET_CELL, RAW_BYTES_ZERO, + RAW_BYTES_TPTR_TO_UNDEF_DATA_AT, + RAW_BYTES_TUINT64_TO_UNDEF_DATA_AT, + RAW_BYTES_CARVE_TPTR, + RAW_BYTES_CARVE_TUINT64, + DATA_AT_TPTR_TO_RAW_BYTES, + DATA_AT_TUINT64_TO_RAW_BYTES, + UNDEF_DATA_AT_TPTR_TO_RAW_BYTES, + UNDEF_DATA_AT_TUINT64_TO_RAW_BYTES, + RAW_BYTES_FORGET_TPTR_CELL, + RAW_BYTES_FORGET_TUINT64_CELL, + RAW_BYTES_UNCARVE_TPTR, + RAW_BYTES_UNCARVE_TUINT64, split_raw_bytes_operation.lemma, join_raw_bytes_operation.lemma, - carve_raw_cell_operation.lemma, - uncarve_raw_cell_operation.lemma, - forget_data_cell_operation.lemma, - forget_and_uncarve_raw_cell_operation.lemma, + carve_raw_ptr_cell_operation.lemma, + carve_raw_uint64_cell_operation.lemma, + forget_data_ptr_cell_operation.lemma, + forget_data_uint64_cell_operation.lemma, + forget_and_merge_data_ptr_cell_operation.lemma, + forget_and_merge_data_uint64_cell_operation.lemma, + merge_undef_ptr_cell_operation.lemma, + merge_undef_uint64_cell_operation.lemma, erase_zero_raw_bytes_operation.lemma, introduce_zero_raw_bytes_operation.lemma); for (size_t i = 0; i < vector_size(published); ++i) { diff --git a/migrations/vst/memmgr/lib/raw_memory.h b/migrations/vst/memmgr/lib/raw_memory.h index 9930a65c90cd3ce294a542af1a1b7b0e67ee0c32..75a76da180a8199712e4977b06ab1986f37463da 100644 --- a/migrations/vst/memmgr/lib/raw_memory.h +++ b/migrations/vst/memmgr/lib/raw_memory.h @@ -1,41 +1,114 @@ -#pragma once - -/* - * Typed raw-byte views used by the VST memmgr migration. +/** + * @file raw_memory.h + * @brief Arbitrary allocated-byte ownership for the VST memmgr migration. + * + * `raw_bytes p n` owns `n` consecutive allocated bytes starting at `p` but + * deliberately forgets their values and per-byte initialization states. It + * is an ordinary opaque spatial predicate as far as QCP is concerned; QCP's + * only operational memory atoms remain `data_at` and `undef_data_at`. * - * `raw_bytes p n` is only a user-side name for the primitive unsigned-byte - * array. The operations below split and join byte ranges, or temporarily - * carve a typed first cell so QCP can execute a C load/store against a literal - * `data_at` / `undef_data_at` resource. + * Initialized or QCP-unknown typed storage may be weakened to `raw_bytes`. + * Conversely, an aligned, in-range typed prefix of `raw_bytes` may be viewed + * as `undef_data_at`: that atom means writable owned storage whose current + * value is unknown, not physically strict uninitialization. */ +#pragma once + +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + #include "userlib/operational/operational.h" #require "userlib/operational/operational.c" +#include "userlib/qcp/c_logic.h" + +/** + * Definition over the default unit-ghost C resource: + * + * raw_bytes p n = + * c_allocated_at unit_ra p (num_of_int n). + * + * Public rules that construct, split, or join this predicate require the + * relevant integer lengths to be nonnegative. + */ PROOF extern thm raw_bytes_def; -/* Closed range and typed-cell laws. */ +/** Split a nonnegative range at a bounded byte offset. */ PROOF extern thm RAW_BYTES_SPLIT; + +/** Join two adjacent nonnegative ranges. */ PROOF extern thm RAW_BYTES_JOIN; -PROOF extern thm RAW_BYTES_CARVE; -PROOF extern thm RAW_BYTES_UNCARVE; -PROOF extern thm DATA_AT_FORGET; -PROOF extern thm RAW_BYTES_FORGET_CELL; + +/** Zero bytes are exactly `emp`. */ PROOF extern thm RAW_BYTES_ZERO; -/* Export `raw_bytes` to the QCP assertion parser of a verification root. */ +/** A valid pointer-sized raw range can be viewed as QCP unknown storage. */ +PROOF extern thm RAW_BYTES_TPTR_TO_UNDEF_DATA_AT; + +/** A valid uint64-sized raw range can be viewed as QCP unknown storage. */ +PROOF extern thm RAW_BYTES_TUINT64_TO_UNDEF_DATA_AT; + +/** Carve an address-valid pointer cell from a sufficiently long raw range. */ +PROOF extern thm RAW_BYTES_CARVE_TPTR; + +/** Carve an address-valid uint64 cell from a sufficiently long raw range. */ +PROOF extern thm RAW_BYTES_CARVE_TUINT64; + +/** Initialized pointer storage weakens to eight arbitrary allocated bytes. */ +PROOF extern thm DATA_AT_TPTR_TO_RAW_BYTES; + +/** Initialized uint64 storage weakens to eight arbitrary allocated bytes. */ +PROOF extern thm DATA_AT_TUINT64_TO_RAW_BYTES; + +/** QCP unknown-content pointer storage weakens to raw bytes. */ +PROOF extern thm UNDEF_DATA_AT_TPTR_TO_RAW_BYTES; + +/** QCP unknown-content uint64 storage weakens to raw bytes. */ +PROOF extern thm UNDEF_DATA_AT_TUINT64_TO_RAW_BYTES; + +/** Merge an initialized pointer cell with an adjacent raw suffix. */ +PROOF extern thm RAW_BYTES_FORGET_TPTR_CELL; + +/** Merge an initialized uint64 cell with an adjacent raw suffix. */ +PROOF extern thm RAW_BYTES_FORGET_TUINT64_CELL; + +/** Merge an unknown-content pointer cell with an adjacent raw suffix. */ +PROOF extern thm RAW_BYTES_UNCARVE_TPTR; + +/** Merge an unknown-content uint64 cell with an adjacent raw suffix. */ +PROOF extern thm RAW_BYTES_UNCARVE_TUINT64; + +/* Export `raw_bytes` as an opaque QCP spatial predicate. */ PROOF int install_raw_memory_qcp_interface(void); /* Split/join at a nonnegative byte offset. */ PROOF void split_raw_bytes(const term p, const term k); PROOF void join_raw_bytes(const term p, const term k); -/* Convert the first bytes of a range to/from one arbitrary typed cell. */ +/* + * Typed carve operations; callers supply `pmem_ptr_address_ok p` or + * `pmem_uint64_address_ok p`, never a generic `ctype`-taking QCP predicate. + */ +PROOF void carve_raw_ptr_cell(const term p); +PROOF void carve_raw_uint64_cell(const term p); + +/* + * Literal-type dispatcher retained for allocator proof readability. This is + * not a generic QCP operation: only the exact terms `Tptr` and `Tuint64` are + * accepted, and each selects one of the closed operations above. + */ PROOF void carve_raw_cell(const term p, const term ty); -PROOF void uncarve_raw_cell(const term p, const term ty); -/* Forget an initialized value, optionally merging the cell into its suffix. */ -PROOF void forget_data_cell(const term p, const term ty); +/* Sound typed-to-raw weakenings, specialized before crossing QCP. */ +PROOF void forget_data_ptr_cell(const term p); +PROOF void forget_data_uint64_cell(const term p); +PROOF void forget_and_merge_data_ptr_cell(const term p); +PROOF void forget_and_merge_data_uint64_cell(const term p); +PROOF void merge_undef_ptr_cell(const term p); +PROOF void merge_undef_uint64_cell(const term p); + +/** Closed-operation dispatcher for initialized-cell-to-raw merging. */ PROOF void forget_and_uncarve_raw_cell(const term p, const term ty); /* The zero-length ownership assertion is exactly `emp`. */ diff --git a/migrations/vst/memmgr/malloc.c b/migrations/vst/memmgr/malloc.c index 483eb84ee6146a03a2fdb52980ea6d7b3e7657d8..d71200d7ecde7837c3c99619ca5b02bca9bd239f 100644 --- a/migrations/vst/memmgr/malloc.c +++ b/migrations/vst/memmgr/malloc.c @@ -36,15 +36,15 @@ PROOF static thm MM_PROGRAM_MAX_SMALL_VALUE = conjunct2_rule(MM_PROGRAM_CONSTANTS_4); PROOF static thm MM_PROGRAM_UCHAR_SIZE_VALUE = eqt_elim_rule(apply_conversion( - rewrite_conv(THM_LIST(get_sizeof_def())), + rewrite_conv(THM_LIST(sizeof_def)), `sizeof Tuchar = 1i`)); PROOF static thm MM_PROGRAM_PTR_SIZE_VALUE = eqt_elim_rule(apply_conversion( - rewrite_conv(THM_LIST(get_sizeof_def())), + rewrite_conv(THM_LIST(sizeof_def)), `sizeof Tptr = 8i`)); PROOF static thm MM_PROGRAM_UINT64_SIZE_VALUE = eqt_elim_rule(apply_conversion( - rewrite_conv(THM_LIST(get_sizeof_def())), + rewrite_conv(THM_LIST(sizeof_def)), `sizeof Tuint64 = 8i`)); PROOF static thm mm_program_word_uchar_offset_rule(void) { @@ -357,8 +357,8 @@ PROOF static void abstract_mm_bigblock_mapping(void) { convert_conjuncts_st( rewrite_conv(THM_LIST(sym_rule(MM_PROGRAM_BIGBLOCK_VALUE))), TERM_LIST( - `\p:addr. mm_mapping p 1048576i`, - `\p:addr. raw_bytes p 1048576i`)); + `\p:int. mm_mapping p 1048576i`, + `\p:int. raw_bytes p 1048576i`)); } PROOF static void certify_mm_try_pre_fill_step(void) { @@ -497,7 +497,7 @@ PROOF static void normalize_mm_large_payload(void) { sizeof Tuchar = 1i ==> mm_waste = 8i ==> mm_word = 8i ==> - 0i < (retval:addr) ==> + 0i < (retval:int) ==> ~((retval + 8i * sizeof Tuchar) + 8i * sizeof Tuchar = 0i) /\ 0i < @@ -545,7 +545,7 @@ PROOF static void normalize_mm_large_stored_header(void) { sym_rule(normalized_address), int_ring_rule(dest_eq(concl(normalized_address)).tm2)); thm header_cell = beta_rule(ap_term_rule( - `\p:addr. data_at p Tuint64 bytes__pre`, address)); + `\p:int. data_at p Tuint64 bytes__pre`, address)); substitute_st(header_cell); } @@ -592,14 +592,14 @@ PROOF static void normalize_mm_free_small_bin(void) { /* Recombine client bytes and slack, then expose the intrusive link cell. */ PROOF static void carve_mm_freed_small_payload(void) { - join_raw_bytes(`block__pre:addr`, `requested_bytes:int`); + join_raw_bytes(`block__pre:int`, `requested_bytes:int`); substitute_st(int_ring_rule(` requested_bytes + (mm_bin_size (mm_size_to_bin requested_bytes) - requested_bytes) = mm_bin_size (mm_size_to_bin requested_bytes) `)); - carve_raw_cell(`block__pre:addr`, `Tptr`); + carve_raw_cell(`block__pre:int`, `Tptr`); } PROOF static thm mm_free_large_literal_total_rule(void) { @@ -637,7 +637,7 @@ PROOF static void prepare_mm_free_large(void) { add_mm_program_constants(); term base_address_tm = ` - (block__pre:addr) - (8i + 8i) * sizeof Tuchar = + (block__pre:int) - (8i + 8i) * sizeof Tuchar = block__pre - (mm_waste + mm_word) `; thm normalized_base_address = apply_conversion( @@ -681,11 +681,11 @@ PROOF static void recombine_mm_free_large_mapping(void) { block__pre `); thm payload_raw = beta_rule(ap_term_rule( - `\p:addr. raw_bytes p requested_bytes`, + `\p:int. raw_bytes p requested_bytes`, sym_rule(payload_start))); substitute_st(payload_raw); forget_and_uncarve_raw_cell( - `block__pre - sizeof Tuint64:addr`, `Tuint64`); + `block__pre - sizeof Tuint64:int`, `Tuint64`); term header_address_tm = ` block__pre - sizeof Tuint64 = @@ -703,7 +703,7 @@ PROOF static void recombine_mm_free_large_mapping(void) { sym_rule(normalized_header_address), int_ring_rule(dest_eq(concl(normalized_header_address)).tm2)); thm header_raw = beta_rule(ap_term_rule( - `\p:addr. raw_bytes p (sizeof Tuint64 + requested_bytes)`, + `\p:int. raw_bytes p (sizeof Tuint64 + requested_bytes)`, header_address)); substitute_st(header_raw); @@ -719,7 +719,7 @@ PROOF static void recombine_mm_free_large_mapping(void) { add_facts_st(THM_LIST( conjunct1_rule(join_bounds), conjunct2_rule(join_bounds))); join_raw_bytes( - `block__pre - (mm_waste + mm_word):addr`, + `block__pre - (mm_waste + mm_word):int`, `mm_waste:int`); thm whole_length = list_match_mp_rule(int_arith_rule(` @@ -776,7 +776,7 @@ PROOF static thm mm_list_cursor_nonnull_rule(void) { conj_rule( assume_rule(`0i <= built_v`), stride_nonnegative)); term rule_tm = ` - forall base:addr. forall used:int. + forall base:int. forall used:int. 0i < base ==> 0i <= used ==> ~((base + (mm_waste + used) * sizeof Tuchar) + @@ -792,7 +792,7 @@ PROOF static thm mm_list_cursor_nonnull_rule(void) { sym_rule(normalized_eq), int_arith_rule(dest_eq(concl(normalized_eq)).tm2)); rule = ispecl_rule(TERM_LIST( - `page__pre:addr`, + `page__pre:int`, `built_v * (size__pre + mm_word):int`), rule); rule = mp_rule(rule, assume_rule(`0i < page__pre`)); return mp_rule(rule, used_nonnegative); @@ -804,7 +804,7 @@ PROOF static void add_mm_list_cursor_nonnull(void) { PROOF static thm mm_list_first_nonnull_rule(void) { term rule_tm = ` - forall base:addr. + forall base:int. 0i < base ==> ~(base + (mm_waste + mm_word) * sizeof Tuchar = 0i) `; @@ -817,7 +817,7 @@ PROOF static thm mm_list_first_nonnull_rule(void) { thm rule = eq_mp_rule( sym_rule(normalized_eq), int_arith_rule(dest_eq(concl(normalized_eq)).tm2)); - rule = ispec_rule(`page__pre:addr`, rule); + rule = ispec_rule(`page__pre:int`, rule); return mp_rule(rule, assume_rule(`0i < page__pre`)); } @@ -951,7 +951,7 @@ PROOF static void prepare_mm_list_from_block(void) { add_facts_st(THM_LIST( conjunct1_rule(prefix_bounds), conjunct2_rule(prefix_bounds))); - split_raw_bytes(`page__pre:addr`, `mm_waste:int`); + split_raw_bytes(`page__pre:int`, `mm_waste:int`); begin_mm_free_segment( `size__pre:int`, `(page__pre + @@ -973,6 +973,25 @@ PROOF static void prepare_mm_list_from_block(void) { /* Expose the current raw chunk using the literal offset emitted by C. */ PROOF static void open_mm_list_node_for_stores(void) { add_mm_list_cursor_nonnull(); + thm size_nonzero = list_match_mp_rule(int_arith_rule(` + mm_word = 8i ==> mm_word <= s ==> ~(s = 0i) + `), THM_LIST( + MM_PROGRAM_WORD_VALUE, + assume_rule(`mm_word <= size__pre`))); + thm addresses = ispecl_rule( + TERM_LIST(`page__pre:int`, `size__pre:int`, `built_v:int`), + MM_MAPPING_LAYOUT_SMALL); + addresses = mp_rule(addresses, size_nonzero); + addresses = mp_rule(addresses, assume_rule(`0i <= built_v`)); + addresses = mp_rule( + addresses, + assume_rule(`built_v < mm_chunk_count size__pre`)); + addresses = mp_rule( + addresses, + assume_rule(` + mm_mapping_layout_ok (page__pre:int) (size__pre:int) + `)); + add_conjuncts_st(addresses); open_mm_raw_free_node(` page__pre + (mm_waste + built_v * (size__pre + mm_word)) * @@ -1043,13 +1062,13 @@ PROOF static void close_mm_list_stored_node_tail(void) { rewrite_conv(THM_LIST( MM_PROGRAM_UCHAR_SIZE_VALUE, MM_WORD_DEF, - get_sizeof_def())), + sizeof_def)), header_address_tm); thm header_address = eq_mp_rule( sym_rule(normalized_header_address), int_ring_rule(dest_eq(concl(normalized_header_address)).tm2)); thm header_cell = beta_rule(ap_term_rule( - `\p:addr. data_at p Tuint64 size__pre`, + `\p:int. data_at p Tuint64 size__pre`, header_address)); substitute_st(header_cell); } @@ -1197,9 +1216,9 @@ PROOF static void close_mm_list_final_node(void) { sizeof Tuchar) + mm_word * sizeof Tuchar`; extend_mm_free_segment( - `size__pre:int`, first, cursor, `tail__pre:addr`, cursor); + `size__pre:int`, first, cursor, `tail__pre:int`, cursor); join_mm_free_segment( - `size__pre:int`, first, `tail__pre:addr`); + `size__pre:int`, first, `tail__pre:int`); thm step_address = int_ring_rule(` (page__pre + @@ -1232,7 +1251,7 @@ PROOF static void close_mm_list_final_node(void) { (mm_waste + mm_chunk_count size__pre * (size__pre + mm_word))`); substitute_st(trans_rule(remainder_step, final_remainder)); - close_mm_page_ticket(`page__pre:addr`, `size__pre:int`); + close_mm_page_ticket(`page__pre:int`, `size__pre:int`); add_fact_st(mm_list_first_nonnull_rule()); } @@ -1261,6 +1280,7 @@ int mm_size2bin(unsigned long long bytes) PARAM(`tail_tokens:(int)list`) \ REQUIRE(`mm_mapping page mm_bigblock`, \ `raw_bytes page mm_bigblock`, \ + `fact(mm_mapping_layout_ok page size)`, \ `mm_free_chain size tail tail_tokens`, \ `fact(0i < page)`, \ `fact(mm_word <= size && size <= mm_max_small)`) \ @@ -1289,6 +1309,7 @@ static void *mm_list_from_block( */ PROOF term loop_inv = `exists prefix built_v. mm_mapping page__pre mm_bigblock ** + fact(mm_mapping_layout_ok page__pre size__pre) ** raw_bytes page__pre mm_waste ** mm_free_segment size__pre @@ -1369,15 +1390,15 @@ void mm_pre_fill(unsigned long long bytes, void *page) PROOF { open_mm_manager_as( - `mm_bin__addr:addr`, `bins_base:addr`, + `mm_bin__addr:int`, `bins_base:int`, `bins:((int)list)list`, `pages:(int)list`); add_mm_manager_bin_length_bound( `mm_size_to_bin bytes__pre`, assume_rule(` mm_size_to_bin bytes__pre < mm_bin_count`)); open_mm_bin_as( - `bins_base:addr`, `mm_size_to_bin bytes__pre`, - `old_head:addr`); + `bins_base:int`, `mm_size_to_bin bytes__pre`, + `old_head:int`); } void *tail = mm_bin[bin_index]; @@ -1386,10 +1407,10 @@ void mm_pre_fill(unsigned long long bytes, void *page) PROOF { /* The list result is the focused bin's new chain. */ - add_mm_page_ticket(`page__pre:addr`); + add_mm_page_ticket(`page__pre:int`); close_mm_bin( - `bins_base:addr`, `mm_size_to_bin bytes__pre`); - close_mm_manager(`mm_bin__addr:addr`); + `bins_base:int`, `mm_size_to_bin bytes__pre`); + close_mm_manager(`mm_bin__addr:int`); } } @@ -1440,7 +1461,7 @@ int mm_try_pre_fill(unsigned long long bytes, int requested) return fulfilled; unsigned char *page = (unsigned char *)mm_mmap0( - (void *)0, MM_BIGBLOCK_BYTES, -1); + (void *)0, MM_BIGBLOCK_BYTES, -1, size); if (page == (void *)0) { return fulfilled; } else { @@ -1472,7 +1493,7 @@ static void *mm_fill_bin(int bin_index) substitute_fact_st(`retval = mm_bin_size bin_index__pre`); } unsigned char *page = (unsigned char *)mm_mmap0( - (void *)0, MM_BIGBLOCK_BYTES, -1); + (void *)0, MM_BIGBLOCK_BYTES, -1, size); if (page == (void *)0) { PROOF close_mm_free_chain_null( @@ -1484,7 +1505,7 @@ static void *mm_fill_bin(int bin_index) close_mm_free_chain_null(`mm_bin_size bin_index__pre`); } void *head = mm_list_from_block(size, page, (void *)0); - PROOF add_mm_page_ticket(`retval:addr`); + PROOF add_mm_page_ticket(`retval:int`); return head; } } @@ -1496,12 +1517,12 @@ static void *mm_fill_bin(int bin_index) * client-owned block. The caller keeps the surrounding bin focus framed. */ #define MM_TAKE_SMALL_BLOCK_SPEC \ - PARAM(`head:addr`, `blocks:(int)list`) \ + PARAM(`head:int`, `blocks:(int)list`) \ REQUIRE(`data_at slot Tptr head`, \ `mm_free_chain (mm_bin_size (mm_size_to_bin requested)) head blocks`, \ `fact(~(head = 0i))`, \ `fact(0i <= requested && requested <= mm_max_small)`) \ - ENSURE_EX(TERM_LIST(`next_head:addr`, `tail_blocks:(int)list`), \ + ENSURE_EX(TERM_LIST(`next_head:int`, `tail_blocks:(int)list`), \ `data_at slot Tptr next_head`, \ `mm_free_chain (mm_bin_size (mm_size_to_bin requested)) next_head tail_blocks`, \ `mm_owned_block __return requested`) @@ -1519,8 +1540,8 @@ static void *mm_take_small_block( assume_rule(`requested__pre <= mm_max_small`)); open_mm_free_chain_cons_as( `mm_bin_size (mm_size_to_bin requested__pre)`, - `head:addr`, `block_token:int`, - `tail_blocks:(int)list`, `next_head:addr`); + `head:int`, `block_token:int`, + `tail_blocks:(int)list`, `next_head:int`); } void *next = *((void **)block); @@ -1542,9 +1563,9 @@ static void *mm_take_small_block( add_fact_st(tail_nonnegative); open_mm_block_tail( - `head:addr`, + `head:int`, `mm_bin_size (mm_size_to_bin requested__pre)`); - forget_and_uncarve_raw_cell(`head:addr`, `Tptr`); + forget_and_uncarve_raw_cell(`head:int`, `Tptr`); thm whole_payload = list_match_mp_rule(int_arith_rule(` sizeof Tptr = 8i ==> @@ -1561,11 +1582,11 @@ static void *mm_take_small_block( mm_bin_size (mm_size_to_bin requested__pre)`))); substitute_st(whole_payload); - split_raw_bytes(`head:addr`, `requested__pre:int`); + split_raw_bytes(`head:int`, `requested__pre:int`); close_mm_malloc_token_small( - `head:addr`, `requested__pre:int`); + `head:int`, `requested__pre:int`); close_mm_owned_block_nonnull( - `head:addr`, `requested__pre:int`); + `head:int`, `requested__pre:int`); } return block; @@ -1589,28 +1610,28 @@ static void *mm_malloc_small(unsigned long long bytes) PROOF { open_mm_manager_as( - `mm_bin__addr:addr`, `bins_base:addr`, + `mm_bin__addr:int`, `bins_base:int`, `bins:((int)list)list`, `pages:(int)list`); add_mm_manager_bin_length_bound( `mm_size_to_bin bytes__pre`, assume_rule(` mm_size_to_bin bytes__pre < mm_bin_count`)); open_mm_bin_as( - `bins_base:addr`, `mm_size_to_bin bytes__pre`, `head:addr`); + `bins_base:int`, `mm_size_to_bin bytes__pre`, `head:int`); } void *block = mm_bin[bin_index]; if (block == (void *)0) { PROOF open_mm_free_chain_null( - `mm_bin_size (mm_size_to_bin bytes__pre)`, `head:addr`); + `mm_bin_size (mm_size_to_bin bytes__pre)`, `head:int`); block = mm_fill_bin(bin_index); if (block == (void *)0) { mm_bin[bin_index] = block; PROOF { close_mm_bin( - `bins_base:addr`, `mm_size_to_bin bytes__pre`); - close_mm_manager(`mm_bin__addr:addr`); - close_mm_owned_block_null(`0i:addr`, `bytes__pre:int`); + `bins_base:int`, `mm_size_to_bin bytes__pre`); + close_mm_manager(`mm_bin__addr:int`); + close_mm_owned_block_null(`0i:int`, `bytes__pre:int`); } return (void *)0; } else { @@ -1622,8 +1643,8 @@ static void *mm_malloc_small(unsigned long long bytes) PROOF { close_mm_bin( - `bins_base:addr`, `mm_size_to_bin bytes__pre`); - close_mm_manager(`mm_bin__addr:addr`); + `bins_base:int`, `mm_size_to_bin bytes__pre`); + close_mm_manager(`mm_bin__addr:int`); } return block; @@ -1640,10 +1661,10 @@ static void *mm_malloc_large(unsigned long long bytes) bytes + MM_WASTE_BYTES + MM_WORD_BYTES; PROOF prepare_mm_malloc_large(); unsigned char *page = - (unsigned char *)mm_mmap0((void *)0, mapped_bytes, -1); + (unsigned char *)mm_mmap0((void *)0, mapped_bytes, -1, 0ULL); if (page == (void *)0) { - PROOF close_mm_owned_block_null(`0i:addr`, `bytes__pre:int`); + PROOF close_mm_owned_block_null(`0i:int`, `bytes__pre:int`); return (void *)0; } @@ -1651,7 +1672,11 @@ static void *mm_malloc_large(unsigned long long bytes) void *payload = header + MM_WORD_BYTES; PROOF { - split_raw_bytes(`retval:addr`, `mm_waste:int`); + split_raw_bytes(`retval:int`, `mm_waste:int`); + thm header_address_ok = match_mp_rule( + ispec_rule(`retval:int`, MM_MAPPING_LAYOUT_LARGE), + assume_rule(`mm_mapping_layout_ok (retval:int) 0i`)); + add_fact_st(header_address_ok); carve_raw_cell( `retval + mm_waste * sizeof Tuchar`, `Tuint64`); normalize_mm_large_payload(); @@ -1688,6 +1713,7 @@ void *mm_malloc(unsigned long long bytes) `data_at (block - sizeof Tuint64) Tuint64 size`, \ `raw_bytes block requested_bytes`, \ `raw_bytes (block + requested_bytes * sizeof Tuchar) (size - requested_bytes)`, \ + `fact(pmem_ptr_address_ok block)`, \ `fact(~(block = 0i))`, \ `fact(0i <= requested_bytes && requested_bytes <= mm_max_small)`, \ `fact(size = mm_bin_size (mm_size_to_bin requested_bytes))`) \ @@ -1702,15 +1728,15 @@ static void mm_free_small(void *block, unsigned long long size) PROOF { open_mm_manager_as( - `mm_bin__addr:addr`, `bins_base:addr`, + `mm_bin__addr:int`, `bins_base:int`, `bins:((int)list)list`, `pages:(int)list`); add_mm_manager_bin_length_bound( `mm_size_to_bin requested_bytes`, assume_rule(` mm_size_to_bin requested_bytes < mm_bin_count`)); open_mm_bin_as( - `bins_base:addr`, `mm_size_to_bin requested_bytes`, - `head:addr`); + `bins_base:int`, `mm_size_to_bin requested_bytes`, + `head:int`); } void *old_head = mm_bin[bin_index]; @@ -1721,12 +1747,12 @@ static void mm_free_small(void *block, unsigned long long size) PROOF { term rounded = `mm_bin_size (mm_size_to_bin requested_bytes)`; - close_mm_block_tail(`block__pre:addr`, rounded); + close_mm_block_tail(`block__pre:int`, rounded); close_mm_free_chain_cons( - rounded, `block__pre:addr`, `block__pre:addr`); + rounded, `block__pre:int`, `block__pre:int`); close_mm_bin( - `bins_base:addr`, `mm_size_to_bin requested_bytes`); - close_mm_manager(`mm_bin__addr:addr`); + `bins_base:int`, `mm_size_to_bin requested_bytes`); + close_mm_manager(`mm_bin__addr:int`); } } @@ -1760,14 +1786,14 @@ void mm_free(void *block) { if (block == (void *)0) { PROOF open_mm_owned_block_null( - `block__pre:addr`, `requested_bytes:int`); + `block__pre:int`, `requested_bytes:int`); return; } else { PROOF { open_mm_owned_block_nonnull( - `block__pre:addr`, `requested_bytes:int`); + `block__pre:int`, `requested_bytes:int`); open_mm_malloc_token_as( - `block__pre:addr`, `requested_bytes:int`, + `block__pre:int`, `requested_bytes:int`, `stored_size:int`); expose_mm_header_for_load(); } @@ -1778,7 +1804,7 @@ void mm_free(void *block) PROOF { abstract_mm_max_small_guard(); open_mm_token_rest_small( - `block__pre:addr`, `requested_bytes:int`, + `block__pre:int`, `requested_bytes:int`, `stored_size:int`); } mm_free_small(block, size); @@ -1786,7 +1812,7 @@ void mm_free(void *block) PROOF { abstract_mm_max_small_guard(); open_mm_token_rest_large( - `block__pre:addr`, `requested_bytes:int`, + `block__pre:int`, `requested_bytes:int`, `stored_size:int`); add_mm_free_large_base_nonnull(); } diff --git a/migrations/vst/memmgr/malloc.h b/migrations/vst/memmgr/malloc.h index b2809012370f80462786ae7411654e321d49f805..ea3ab60e76ce41dc79ef74bc5428f6454d57c779 100644 --- a/migrations/vst/memmgr/malloc.h +++ b/migrations/vst/memmgr/malloc.h @@ -50,6 +50,7 @@ int mm_size2bin(unsigned long long bytes) REQUIRE(`mm_manager mm_bin__addr`, \ `mm_mapping page mm_bigblock`, \ `raw_bytes page mm_bigblock`, \ + `fact(mm_mapping_layout_ok page (mm_bin_size (mm_size_to_bin bytes)))`, \ `fact(0i < page)`, \ `fact(0i <= bytes && bytes <= mm_max_small)`) \ ENSURE(`mm_manager mm_bin__addr`) diff --git a/migrations/vst/queue/model.c b/migrations/vst/queue/model.c index ce93e6c5ce86f2206e8b00c60f1edfd4bcd1dece..121f4adba44d73a3ed14d2fefd2c0aeeda2a5300 100644 --- a/migrations/vst/queue/model.c +++ b/migrations/vst/queue/model.c @@ -6,19 +6,19 @@ PROOF static size_t QUEUE_MODEL_AXIOMS_BEFORE = PROOF thm QUEUE_EMPTY_INT_DEF = cst_new_rec_definition( "queue_empty_int", get_theorem_by_name("list_RECURSION"), ` - (queue_empty_int ([]:(addr)list) = 1i) && + (queue_empty_int ([]:(int)list) = 1i) && (queue_empty_int (p :: ps) = 0i) `, - `:(addr)list->int`); + `:(int)list->int`); PROOF int install_queue_model_qcp_interface(void) { static bool installed = false; if (installed) return 0; ENSURE_COND( - cst_add_const_to_header(`APPEND:(addr)list->(addr)list->(addr)list`) == 0, + cst_add_const_to_header(`APPEND:(int)list->(int)list->(int)list`) == 0, "Could not export address-list APPEND"); ENSURE_COND( - cst_add_const_to_header(`queue_empty_int:(addr)list->int`) == 0, + cst_add_const_to_header(`queue_empty_int:(int)list->int`) == 0, "Could not export queue_empty_int"); installed = true; return 0; diff --git a/migrations/vst/queue/queue.c b/migrations/vst/queue/queue.c index 7bd3a532ba33d6944aedafd3e5dbc70172d582f6..3266915870e6549315d84580d5cf22dcced6f587 100644 --- a/migrations/vst/queue/queue.c +++ b/migrations/vst/queue/queue.c @@ -18,7 +18,7 @@ PROOF static void close_self_edge( struct queue_fifo *fifo_new(void) REQUIRE(`emp`) - ENSURE(`fifo_rep __return ([]:(addr)list)`) + ENSURE(`fifo_rep __return ([]:(int)list)`) { struct queue_fifo *queue; queue_alloc_fifo(&queue); @@ -26,7 +26,7 @@ struct queue_fifo *fifo_new(void) queue->tail = (void *)0; PROOF { close_fresh_empty_body(); - close_fifo_rep(`fresh:addr`); + close_fifo_rep(`fresh:int`); } return queue; } @@ -37,103 +37,102 @@ struct queue_elem *make_elem(int a, int b) `queue_elem_token __return`, `data_at (field_addr __return Tqueue_elem Fa) Tint a`, `data_at (field_addr __return Tqueue_elem Fb) Tint b`, - `undef_data_at (field_addr __return Tqueue_elem Fnext) Tptr`) + `data_at (field_addr __return Tqueue_elem Fnext) Tptr 0i`) { struct queue_elem *element; queue_alloc_elem(&element); element->a = a; element->b = b; + element->next = (void *)0; return element; } int fifo_empty(struct queue_fifo *queue) - PARAM(`contents:(addr)list`) + PARAM(`contents:(int)list`) REQUIRE(`fifo_rep queue contents`) ENSURE(`fifo_rep queue contents`, return_int(`queue_empty_int contents`)) { PROOF open_fifo_rep_as( - `queue__pre:addr`, `head:addr`, `tail:addr`); + `queue__pre:int`, `head:int`, `tail:int`); struct queue_elem *head_value = queue->head; PROOF { expose_fifo_empty_code( - `contents:(addr)list`, `head:addr`, `tail:addr`); - close_fifo_rep(`queue__pre:addr`); + `contents:(int)list`, `head:int`, `tail:int`); + close_fifo_rep(`queue__pre:int`); } return head_value == (void *)0; } void fifo_put(struct queue_fifo *queue, struct queue_elem *element) - PARAM(`contents:(addr)list`) + PARAM(`contents:(int)list`, `old_next:int`) REQUIRE(`fifo_rep queue contents`, `fact(~(element = 0i))`, - `undef_data_at - (field_addr element Tqueue_elem Fnext) Tptr`) + `data_at + (field_addr element Tqueue_elem Fnext) Tptr old_next`) ENSURE(`fifo_rep queue (APPEND contents [element])`) { element->next = (void *)0; PROOF open_fifo_rep_as( - `queue__pre:addr`, `head:addr`, `tail:addr`); + `queue__pre:int`, `head:int`, `tail:int`); struct queue_elem *head_value = queue->head; if (head_value == (void *)0) { PROOF begin_fifo_empty_put( - `contents:(addr)list`, `head:addr`, `tail:addr`); + `contents:(int)list`, `head:int`, `tail:int`); queue->head = element; queue->tail = element; PROOF { - close_queue_seg_empty(`element__pre:addr`); - close_self_edge(`element__pre:addr`, `0i`); + close_queue_seg_empty(`element__pre:int`); + close_self_edge(`element__pre:int`, `0i`); finish_fifo_empty_put( - `contents:(addr)list`, - `element__pre:addr`, `element__pre:addr`); - close_fifo_rep(`queue__pre:addr`); + `contents:(int)list`, + `element__pre:int`, `element__pre:int`); + close_fifo_rep(`queue__pre:int`); } } else { PROOF open_fifo_body_nonempty_as( - `contents:(addr)list`, `head:addr`, `tail:addr`, - `prefix:(addr)list`); + `contents:(int)list`, `head:int`, `tail:int`, + `prefix:(int)list`); struct queue_elem *old_tail = queue->tail; - PROOF open_queue_edge(`tail:addr`, `tail:addr`, `0i`); + PROOF open_queue_edge(`tail:int`, `tail:int`, `0i`); old_tail->next = element; queue->tail = element; PROOF { - close_self_edge(`tail:addr`, `element__pre:addr`); + close_self_edge(`tail:int`, `element__pre:int`); extend_fifo_tail( - `head:addr`, `tail:addr`, `element__pre:addr`); - close_self_edge(`element__pre:addr`, `0i`); + `head:int`, `tail:int`, `element__pre:int`); + close_self_edge(`element__pre:int`, `0i`); finish_fifo_nonempty_put( - `contents:(addr)list`, `prefix:(addr)list`, - `head:addr`, `tail:addr`, `element__pre:addr`); - close_fifo_rep(`queue__pre:addr`); + `contents:(int)list`, `prefix:(int)list`, + `head:int`, `tail:int`, `element__pre:int`); + close_fifo_rep(`queue__pre:int`); } } } struct queue_elem *fifo_get(struct queue_fifo *queue) - PARAM(`first:addr`, `rest:(addr)list`) + PARAM(`first:int`, `rest:(int)list`) REQUIRE(`fifo_rep queue (first :: rest)`) - ENSURE(`fifo_rep queue rest`, - `fact((__return:addr) = (first:addr))`, - `undef_data_at - (field_addr __return Tqueue_elem Fnext) Tptr`) + ENSURE_EX(TERM_LIST(`old_next:int`), + `fifo_rep queue rest`, + `fact((__return:int) = (first:int))`, + `data_at + (field_addr __return Tqueue_elem Fnext) Tptr old_next`) { PROOF { open_fifo_rep_as( - `queue__pre:addr`, `head:addr`, `tail:addr`); + `queue__pre:int`, `head:int`, `tail:int`); pop_fifo_head_as( - `first:addr`, `rest:(addr)list`, - `head:addr`, `tail:addr`, `successor:addr`); - open_queue_edge(`head:addr`, `first:addr`, `successor:addr`); + `first:int`, `rest:(int)list`, + `head:int`, `tail:int`, `successor:int`); + open_queue_edge(`head:int`, `first:int`, `successor:int`); } struct queue_elem *result = queue->head; PROOF substitute_st( - assume_rule(`(head:addr) = (first:addr)`)); + assume_rule(`(head:int) = (first:int)`)); struct queue_elem *next = result->next; queue->head = next; - PROOF { - forget_queue_elem_next(`first:addr`); - close_fifo_rep(`queue__pre:addr`); - } + PROOF close_fifo_rep(`queue__pre:int`); return result; } diff --git a/migrations/vst/queue/rep.c b/migrations/vst/queue/rep.c index aeb16c6a730b6ecba957cbfab26ccf1af558f3a0..3d5504cf91b78e6df181bd292bd6b6803bd80367 100644 --- a/migrations/vst/queue/rep.c +++ b/migrations/vst/queue/rep.c @@ -34,9 +34,9 @@ PROOF static int _Fnext = new_const_safe("Fnext", `:field`); PROOF static int _Fhead = new_const_safe("Fhead", `:field`); PROOF static int _Ftail = new_const_safe("Ftail", `:field`); PROOF static int _queue_elem_token = - new_const_safe("queue_elem_token", `:addr->hprop`); + new_const_safe("queue_elem_token", `:int->cprop`); PROOF static int _queue_fifo_token = - new_const_safe("queue_fifo_token", `:addr->hprop`); + new_const_safe("queue_fifo_token", `:int->cprop`); /* One edge packages the two pure cursor facts with its literal next cell. */ PROOF thm QUEUE_EDGE_DEF = cst_new_fun_definition( @@ -44,30 +44,30 @@ PROOF thm QUEUE_EDGE_DEF = cst_new_fun_definition( `queue_edge cursor node next -|- fact(cursor = node) ** fact(~(node = 0i)) ** data_at (field_addr node Tqueue_elem Fnext) Tptr next`, - `:addr->addr->addr->hprop`); + `:int->int->int->cprop`); /* The endpoint is excluded. The address list records the owned prefix. */ PROOF thm QUEUE_SEG_DEF = cst_new_rec_definition( "queue_seg", get_theorem_by_name("list_RECURSION"), ` - (queue_seg first stop ([]:(addr)list) -|- fact(first = stop)) && + (queue_seg first stop ([]:(int)list) -|- fact(first = stop)) && (queue_seg first stop (node :: nodes) -|- exists next. queue_edge first node next ** queue_seg next stop nodes) `, - `:addr->addr->(addr)list->hprop`); + `:int->int->(int)list->cprop`); /* Empty queues constrain only head. Tail may be stale after the last get. */ PROOF thm FIFO_BODY_DEF = cst_new_rec_definition( "fifo_body", get_theorem_by_name("list_RECURSION"), ` - (fifo_body ([]:(addr)list) head tail -|- fact(head = 0i)) && + (fifo_body ([]:(int)list) head tail -|- fact(head = 0i)) && (fifo_body (first :: rest) head tail -|- exists prefix. fact(first :: rest = APPEND prefix [tail]) ** queue_seg head tail prefix ** queue_edge tail tail 0i) `, - `:(addr)list->addr->addr->hprop`); + `:(int)list->int->int->cprop`); /* * Opaque proof-state tokens for list equations. QCP manipulates these as @@ -76,14 +76,14 @@ PROOF thm FIFO_BODY_DEF = cst_new_rec_definition( */ PROOF static thm FIFO_EMPTY_SHAPE_DEF = cst_new_fun_definition( "fifo_empty_shape", - `fifo_empty_shape contents -|- fact(contents = ([]:(addr)list))`, - `:(addr)list->hprop`); + `fifo_empty_shape contents -|- fact(contents = ([]:(int)list))`, + `:(int)list->cprop`); PROOF static thm FIFO_TAIL_SHAPE_DEF = cst_new_fun_definition( "fifo_tail_shape", - `fifo_tail_shape (contents:(addr)list) (prefix:(addr)list) (tail:addr) -|- + `fifo_tail_shape (contents:(int)list) (prefix:(int)list) (tail:int) -|- fact(contents = APPEND prefix [tail])`, - `:(addr)list->(addr)list->addr->hprop`); + `:(int)list->(int)list->int->cprop`); PROOF thm FIFO_REP_DEF = cst_new_fun_definition( "fifo_rep", @@ -93,45 +93,45 @@ PROOF thm FIFO_REP_DEF = cst_new_fun_definition( data_at (field_addr queue Tqueue_fifo Fhead) Tptr head ** data_at (field_addr queue Tqueue_fifo Ftail) Tptr tail ** fifo_body contents head tail`, - `:addr->(addr)list->hprop`); + `:int->(int)list->cprop`); /*-------------------------- closed views --------------------------*/ PROOF static thm prove_queue_seg_snoc_rule(void) { gnode root = gnode_new_with_ccl(` - forall prefix:(addr)list. forall head old_tail new_tail:addr. + forall prefix:(int)list. forall head old_tail new_tail:int. (queue_seg head old_tail prefix ** queue_edge old_tail old_tail new_tail |-- queue_seg head new_tail (APPEND prefix [old_tail])) `); gnode body = GEN_TAC(root, "prefix"); - gnode_list cases = INDUCT_TAC(body, `prefix:(addr)list`); + gnode_list cases = INDUCT_TAC(body, `prefix:(int)list`); gnode base = AUTO_INTROS_TAC(cases[0]); base = CONV_TAC(base, rewrite_conv(THM_LIST( - QUEUE_SEG_DEF, get_APPEND()))); + QUEUE_SEG_DEF, HOL_APPEND))); base = AUTO_INIT_SLTAC(base)[0]; base = AUTO_INTRO_FACT_SLTAC(base); base = CONV_WITH_ASMP_SLTAC(base, simp_conv, thm_list_n(0)); base = CLEAN_SLTAC(base); - base = EXISTS_SLTAC(base, `new_tail:addr`); + base = EXISTS_SLTAC(base, `new_tail:int`); base = AUTO_FRAME_SLTAC(base); gnode_list base_parts = PURE_SLTAC(base); - ACCEPT_TAC(base_parts[0], refl_rule(`new_tail:addr`)); + ACCEPT_TAC(base_parts[0], refl_rule(`new_tail:int`)); AUTO_FRAME_SLTAC(base_parts[1]); gnode step = AUTO_INTROS_TAC(cases[1]); thm ih = assume_rule( gnode_get_asmps(step, CONST_STRING_LIST("H"))[0]); step = CONV_TAC(step, rewrite_conv(THM_LIST( - QUEUE_SEG_DEF, get_APPEND()))); + QUEUE_SEG_DEF, HOL_APPEND))); step = SL_MODE(step, "HSEG * HTAIL")[0]; step = HANT_EXISTS_SLTAC(step, "HSEG", "next"); step = HANT_SEP_SLTAC(step, "HSEG", "HEDGE", "HREST"); - step = EXISTS_SLTAC(step, `next:addr`); + step = EXISTS_SLTAC(step, `next:int`); step = AUTO_FRAME_SLTAC(step); ih = ispecl_rule( - TERM_LIST(`next:addr`, `old_tail:addr`, `new_tail:addr`), ih); + TERM_LIST(`next:int`, `old_tail:int`, `new_tail:int`), ih); ih = rehant_slrule(ih, ` queue_edge old_tail old_tail new_tail ** queue_seg next old_tail a1`); @@ -144,26 +144,26 @@ PROOF thm QUEUE_SEG_SNOC_RULE = prove_queue_seg_snoc_rule(); /* A prefix segment followed by its final null edge is a nonempty body. */ PROOF static thm prove_fifo_body_from_seg_rule(void) { gnode root = gnode_new_with_ccl(` - forall prefix:(addr)list. forall head tail:addr. + forall prefix:(int)list. forall head tail:int. (queue_seg head tail prefix ** queue_edge tail tail 0i |-- fifo_body (APPEND prefix [tail]) head tail) `); gnode body = AUTO_INTROS_TAC(root); - gnode_list cases = CASES_TAC(body, `prefix:(addr)list`, "Eprefix"); + gnode_list cases = CASES_TAC(body, `prefix:(int)list`, "Eprefix"); gnode nil = CONV_WITH_ASMP_TAC(cases[0], simp_conv, THM_LIST( - FIFO_BODY_DEF, get_APPEND())); + FIFO_BODY_DEF, HOL_APPEND)); nil = AUTO_INIT_SLTAC(nil)[0]; - nil = EXISTS_SLTAC(nil, `[]:(addr)list`); + nil = EXISTS_SLTAC(nil, `[]:(int)list`); nil = CONV_WITH_ASMP_SLTAC(nil, simp_conv, THM_LIST( - QUEUE_SEG_DEF, get_APPEND())); + QUEUE_SEG_DEF, HOL_APPEND)); AUTO_FRAME_SLTAC(nil); gnode cons = CONV_WITH_ASMP_TAC(cases[1], simp_conv, THM_LIST( - FIFO_BODY_DEF, get_APPEND())); + FIFO_BODY_DEF, HOL_APPEND)); cons = AUTO_INIT_SLTAC(cons)[0]; - cons = EXISTS_SLTAC(cons, `a0 :: (a1:(addr)list)`); - cons = CONV_WITH_ASMP_SLTAC(cons, simp_conv, THM_LIST(get_APPEND())); + cons = EXISTS_SLTAC(cons, `a0 :: (a1:(int)list)`); + cons = CONV_WITH_ASMP_SLTAC(cons, simp_conv, THM_LIST(HOL_APPEND)); AUTO_FRAME_SLTAC(cons); return gnode_prove(root); } @@ -174,7 +174,7 @@ PROOF static thm FIFO_BODY_FROM_SEG_RULE = /* Removing the first edge leaves the same tail-focused representation. */ PROOF static thm prove_fifo_body_pop_rule(void) { gnode root = gnode_new_with_ccl(` - forall first:addr. forall rest:(addr)list. forall head tail:addr. + forall first:int. forall rest:(int)list. forall head tail:int. (fifo_body (first :: rest) head tail |-- exists next. queue_edge head first next ** fifo_body rest next tail) @@ -186,43 +186,43 @@ PROOF static thm prove_fifo_body_pop_rule(void) { g = HANT_SEP_SLTAC(g, "HBODY", "HEQ", "HCORE"); g = HANT_SEP_SLTAC(g, "HCORE", "HSEG", "HTAIL"); g = INTRO_FACT_SLTAC(g, CONST_STRING_LIST("HEQ")); - gnode_list cases = CASES_TAC(g, `prefix:(addr)list`, "Eprefix"); + gnode_list cases = CASES_TAC(g, `prefix:(int)list`, "Eprefix"); thm nil_shape = simp_rule(THM_LIST( - assume_rule(`prefix:(addr)list = []`), get_APPEND(), + assume_rule(`prefix:(int)list = []`), HOL_APPEND, get_theorem_by_name("CONS_11")), - assume_rule(`(first:addr) :: (rest:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)]`)); + assume_rule(`(first:int) :: (rest:(int)list) = + APPEND (prefix:(int)list) [(tail:int)]`)); thm nil_first = conjunct1_rule(nil_shape); thm nil_rest = conjunct2_rule(nil_shape); gnode nil = CONV_WITH_ASMP_SLTAC(cases[0], simp_conv, THM_LIST( QUEUE_SEG_DEF, FIFO_BODY_DEF, nil_first, nil_rest)); nil = AUTO_HANT_DESTRUCT_SLTAC(nil)[0]; nil = AUTO_INTRO_FACT_SLTAC(nil); - nil = EXISTS_SLTAC(nil, `0i:addr`); + nil = EXISTS_SLTAC(nil, `0i:int`); nil = CONV_WITH_ASMP_SLTAC(nil, simp_conv, thm_list_n(0)); AUTO_FRAME_SLTAC(nil); thm cons_shape = simp_rule(THM_LIST( - assume_rule(`prefix:(addr)list = a0 :: a1`), get_APPEND(), + assume_rule(`prefix:(int)list = a0 :: a1`), HOL_APPEND, get_theorem_by_name("CONS_11")), - assume_rule(`(first:addr) :: (rest:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)]`)); + assume_rule(`(first:int) :: (rest:(int)list) = + APPEND (prefix:(int)list) [(tail:int)]`)); thm cons_first = conjunct1_rule(cons_shape); thm cons_rest = conjunct2_rule(cons_shape); gnode cons = HANT_CONV_SLTAC(cases[1], simp_conv(THM_LIST( - QUEUE_SEG_DEF, assume_rule(`prefix:(addr)list = a0 :: a1`))), + QUEUE_SEG_DEF, assume_rule(`prefix:(int)list = a0 :: a1`))), CONST_STRING_LIST("HSEG")); cons = HANT_EXISTS_SLTAC(cons, "HSEG", "next"); cons = HANT_SEP_SLTAC(cons, "HSEG", "HEDGE", "HREST"); cons = CONV_WITH_ASMP_SLTAC( cons, simp_conv, THM_LIST(cons_first, cons_rest)); - cons = EXISTS_SLTAC(cons, `next:addr`); + cons = EXISTS_SLTAC(cons, `next:int`); gnode_list split = SEP_SLTAC(cons, CONST_STRING_LIST("HEDGE")); AUTO_FRAME_SLTAC(split[0]); thm rebuild = ispecl_rule( - TERM_LIST(`a1:(addr)list`, `next:addr`, `tail:addr`), + TERM_LIST(`a1:(int)list`, `next:int`, `tail:int`), FIFO_BODY_FROM_SEG_RULE); rebuild = rehant_slrule(rebuild, ` queue_edge tail tail 0i ** queue_seg next tail a1`); @@ -235,13 +235,13 @@ PROOF thm FIFO_BODY_POP_RULE = prove_fifo_body_pop_rule(); /* The first cursor of a nonempty tail-focused chain is non-null. */ PROOF static thm prove_queue_seg_last_nonnull_rule(void) { gnode root = gnode_new_with_ccl(` - forall prefix:(addr)list. forall head tail:addr. + forall prefix:(int)list. forall head tail:int. (queue_seg head tail prefix ** queue_edge tail tail 0i |-- (queue_seg head tail prefix ** queue_edge tail tail 0i) ** fact(~(head = 0i))) `); gnode body = AUTO_INTROS_TAC(root); - gnode_list cases = CASES_TAC(body, `prefix:(addr)list`, "Eprefix"); + gnode_list cases = CASES_TAC(body, `prefix:(int)list`, "Eprefix"); gnode nil = CONV_WITH_ASMP_TAC(cases[0], simp_conv, THM_LIST( QUEUE_SEG_DEF, QUEUE_EDGE_DEF)); @@ -257,7 +257,7 @@ PROOF static thm prove_queue_seg_last_nonnull_rule(void) { cons = AUTO_INIT_SLTAC(cons)[0]; cons = HCON_CONV_SLTAC( cons, rewrite_conv(THM_LIST(sl_sep_exists_left()))); - cons = EXISTS_SLTAC(cons, `next:addr`); + cons = EXISTS_SLTAC(cons, `next:int`); gnode_list cons_parts = PURE_SLTAC(cons); for (size_t i = 0; i + 1 < vector_size(cons_parts); ++i) { CONV_WITH_ASMP_TAC(cons_parts[i], simp_conv, thm_list_n(0)); @@ -271,30 +271,30 @@ PROOF static thm QUEUE_SEG_LAST_NONNULL_RULE = PROOF static thm prove_fifo_body_cons_nonnull_rule(void) { term eq_fact = `fact( - (first:addr) :: (rest:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)])`; + (first:int) :: (rest:(int)list) = + APPEND (prefix:(int)list) [(tail:int)])`; term core = ` - fact((first:addr) :: (rest:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)]) ** - queue_seg (head:addr) tail prefix ** queue_edge tail tail 0i`; + fact((first:int) :: (rest:(int)list) = + APPEND (prefix:(int)list) [(tail:int)]) ** + queue_seg (head:int) tail prefix ** queue_edge tail tail 0i`; thm body_def = conjunct2_rule(FIFO_BODY_DEF); thm opened = eq2ent(body_def); thm nonnull = ispecl_rule( - TERM_LIST(`prefix:(addr)list`, `head:addr`, `tail:addr`), + TERM_LIST(`prefix:(int)list`, `head:int`, `tail:int`), QUEUE_SEG_LAST_NONNULL_RULE); thm step = frame_left_slrule(eq_fact, nonnull); step = rehant_slrule(step, core); step = rehcon_slrule(step, ` - fact((first:addr) :: (rest:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)]) ** - queue_seg (head:addr) tail prefix ** queue_edge tail tail 0i ** + fact((first:int) :: (rest:(int)list) = + APPEND (prefix:(int)list) [(tail:int)]) ** + queue_seg (head:int) tail prefix ** queue_edge tail tail 0i ** fact(~(head = 0i))`); - step = exists_mono_slrule(`prefix:(addr)list`, step); + step = exists_mono_slrule(`prefix:(int)list`, step); - term prefix = `prefix:(addr)list`; + term prefix = `prefix:(int)list`; term core_fn = mk_abs(prefix, core); thm distribute = ispecl_rule( - TERM_LIST(core_fn, `fact(~((head:addr) = 0i))`), + TERM_LIST(core_fn, `fact(~((head:int) = 0i))`), sl_sep_exists_left()); distribute = beta_rule(distribute); thm pull_fact = eq2ent(gsym_rule(distribute)); @@ -302,7 +302,7 @@ PROOF static thm prove_fifo_body_cons_nonnull_rule(void) { step = trans_slrule(step, pull_fact); thm closed = eq2ent(gsym_rule(body_def)); - closed = frame_right_slrule(closed, `fact(~((head:addr) = 0i))`); + closed = frame_right_slrule(closed, `fact(~((head:int) = 0i))`); step = trans_slrule(step, closed); return trans_slrule(opened, step); } @@ -313,13 +313,13 @@ PROOF static thm FIFO_BODY_CONS_NONNULL_RULE = /* The exact empty view: only head determines whether the model is nil. */ PROOF static thm prove_fifo_body_empty_iff_rule(void) { gnode root = gnode_new_with_ccl(` - forall contents:(addr)list. forall head tail:addr. + forall contents:(int)list. forall head tail:int. (fifo_body contents head tail |-- fifo_body contents head tail ** fact((head = 0i) <=> (contents = []))) `); gnode body = AUTO_INTROS_TAC(root); - gnode_list cases = CASES_TAC(body, `contents:(addr)list`, "Econtents"); + gnode_list cases = CASES_TAC(body, `contents:(int)list`, "Econtents"); gnode nil = CONV_WITH_ASMP_TAC(cases[0], simp_conv, THM_LIST( FIFO_BODY_DEF)); @@ -346,13 +346,13 @@ PROOF thm FIFO_BODY_EMPTY_IFF_RULE = /* A QCP-safe scalar view used by fifo_empty. */ PROOF static thm prove_queue_empty_code_rule(void) { gnode root = gnode_new_with_ccl(` - forall contents:(addr)list. forall head:addr. + forall contents:(int)list. forall head:int. ((head = 0i) <=> (contents = [])) ==> ((head = 0i ==> queue_empty_int contents = 1i) /\ (~(head = 0i) ==> queue_empty_int contents = 0i)) `); gnode body = AUTO_INTROS_TAC(root); - gnode_list cases = CASES_TAC(body, `contents:(addr)list`, "Econtents"); + gnode_list cases = CASES_TAC(body, `contents:(int)list`, "Econtents"); CONV_WITH_ASMP_TAC(cases[0], simp_conv, THM_LIST(QUEUE_EMPTY_INT_DEF)); CONV_WITH_ASMP_TAC(cases[1], simp_conv, THM_LIST( QUEUE_EMPTY_INT_DEF, get_theorem_by_name("NOT_CONS_NIL"))); @@ -374,18 +374,18 @@ PROOF static thm prove_fifo_body_empty_code_rule(void) { code = elim_fact_slrule(relation, code); code = rehant_slrule(code, `fact(${relation:bool})`); code = rehcon_slrule(code, ` - fact((head:addr) = 0i ==> queue_empty_int contents = 1i) ** - fact(~((head:addr) = 0i) ==> queue_empty_int contents = 0i)`); + fact((head:int) = 0i ==> queue_empty_int contents = 1i) ** + fact(~((head:int) = 0i) ==> queue_empty_int contents = 0i)`); code = frame_left_slrule( - `fifo_body (contents:(addr)list) (head:addr) (tail:addr)`, code); + `fifo_body (contents:(int)list) (head:int) (tail:int)`, code); code = rehant_slrule(code, dest_sl_ent(concl(view)).tm2); code = rehcon_slrule(code, ` - fifo_body (contents:(addr)list) (head:addr) (tail:addr) ** + fifo_body (contents:(int)list) (head:int) (tail:int) ** fact(head = 0i ==> queue_empty_int contents = 1i) ** fact(~(head = 0i) ==> queue_empty_int contents = 0i)`); thm result = trans_slrule(view, code); return genl_rule( - TERM_LIST(`contents:(addr)list`, `head:addr`, `tail:addr`), result); + TERM_LIST(`contents:(int)list`, `head:int`, `tail:int`), result); } PROOF static thm FIFO_BODY_EMPTY_CODE_RULE = @@ -394,31 +394,31 @@ PROOF static thm FIFO_BODY_EMPTY_CODE_RULE = /* Empty-put phase one: consume the pure empty body into an opaque token. */ PROOF static thm prove_fifo_empty_put_begin_rule(void) { gnode root = gnode_new_with_ccl(` - forall contents:(addr)list. forall head tail:addr. + forall contents:(int)list. forall head tail:int. head = 0i ==> (fifo_body contents head tail |-- fifo_empty_shape contents) `); gnode body = AUTO_INTROS_TAC(root); - gnode_list cases = CASES_TAC(body, `contents:(addr)list`, "Econtents"); + gnode_list cases = CASES_TAC(body, `contents:(int)list`, "Econtents"); gnode nil = CONV_WITH_ASMP_TAC(cases[0], simp_conv, THM_LIST( FIFO_BODY_DEF, FIFO_EMPTY_SHAPE_DEF)); AUTO_INIT_SLTAC(nil); gnode cons = CONV_TAC(cases[1], rewrite_conv(THM_LIST( - assume_rule(`(contents:(addr)list) = - (a0:addr) :: (a1:(addr)list)`)))); + assume_rule(`(contents:(int)list) = + (a0:int) :: (a1:(int)list)`)))); term cons_body = `fifo_body - ((a0:addr) :: (a1:(addr)list)) (head:addr) (tail:addr)`; + ((a0:int) :: (a1:(int)list)) (head:int) (tail:int)`; term cons_shape = `fifo_empty_shape - ((a0:addr) :: (a1:(addr)list))`; - term nonnull_prop = `~((head:addr) = 0i)`; + ((a0:int) :: (a1:(int)list))`; + term nonnull_prop = `~((head:int) = 0i)`; thm nonnull = FIFO_BODY_CONS_NONNULL_RULE; instantiation nonnull_inst = term_match( term_list_n(0), dest_sl_ent(concl(nonnull)).tm1, cons_body); nonnull = instantiate_rule(nonnull_inst, nonnull); thm contradiction = not_elim_rule( - assume_rule(nonnull_prop), assume_rule(`(head:addr) = 0i`)); + assume_rule(nonnull_prop), assume_rule(`(head:int) = 0i`)); thm absurd = false_elim_rule( contradiction, mk_sl_ent(cons_body, cons_shape)); absurd = elim_fact_slrule(nonnull_prop, absurd); @@ -432,30 +432,30 @@ PROOF static thm FIFO_EMPTY_PUT_BEGIN_RULE = /* Empty-put phase two: rebuild the exact client model in one local step. */ PROOF static thm prove_fifo_empty_put_finish_rule(void) { - term equality = `contents:(addr)list = []`; + term equality = `contents:(int)list = []`; term core = ` - queue_seg (head:addr) (tail:addr) ([]:(addr)list) ** + queue_seg (head:int) (tail:int) ([]:(int)list) ** queue_edge tail tail 0i`; term result = `fifo_body - (APPEND (contents:(addr)list) [(tail:addr)]) head tail`; + (APPEND (contents:(int)list) [(tail:int)]) head tail`; thm rebuild = ispecl_rule( - TERM_LIST(`[]:(addr)list`, `head:addr`, `tail:addr`), + TERM_LIST(`[]:(int)list`, `head:int`, `tail:int`), FIFO_BODY_FROM_SEG_RULE); thm result_eq = apply_conversion( rewrite_conv(THM_LIST(assume_rule(equality))), result); thm close = trans_slrule(rebuild, eq2ent(gsym_rule(result_eq))); close = elim_fact_slrule(equality, close); - close = rehant_slrule(close, `fact(${equality:bool}) ** ${core:hprop}`); + close = rehant_slrule(close, `fact(${equality:bool}) ** ${core:cprop}`); thm open = frame_right_slrule( eq2ent(FIFO_EMPTY_SHAPE_DEF), core); open = rehant_slrule(open, - `fifo_empty_shape (contents:(addr)list) ** ${core:hprop}`); - open = rehcon_slrule(open, `fact(${equality:bool}) ** ${core:hprop}`); + `fifo_empty_shape (contents:(int)list) ** ${core:cprop}`); + open = rehcon_slrule(open, `fact(${equality:bool}) ** ${core:cprop}`); thm result_rule = trans_slrule(open, close); return genl_rule( - TERM_LIST(`contents:(addr)list`, `head:addr`, `tail:addr`), + TERM_LIST(`contents:(int)list`, `head:int`, `tail:int`), result_rule); } @@ -465,38 +465,38 @@ PROOF static thm FIFO_EMPTY_PUT_FINISH_RULE = /* Nonempty-put phase two consumes the tail equation token after snoc. */ PROOF static thm prove_fifo_nonempty_put_finish_rule(void) { term equality = ` - (contents:(addr)list) = - APPEND (prefix:(addr)list) [(old_tail:addr)]`; + (contents:(int)list) = + APPEND (prefix:(int)list) [(old_tail:int)]`; term core = ` - queue_seg (head:addr) (new_tail:addr) - (APPEND (prefix:(addr)list) [(old_tail:addr)]) ** + queue_seg (head:int) (new_tail:int) + (APPEND (prefix:(int)list) [(old_tail:int)]) ** queue_edge new_tail new_tail 0i`; term result = `fifo_body - (APPEND (contents:(addr)list) [(new_tail:addr)]) head new_tail`; + (APPEND (contents:(int)list) [(new_tail:int)]) head new_tail`; thm rebuild = ispecl_rule( - TERM_LIST(`APPEND (prefix:(addr)list) [(old_tail:addr)]`, - `head:addr`, `new_tail:addr`), + TERM_LIST(`APPEND (prefix:(int)list) [(old_tail:int)]`, + `head:int`, `new_tail:int`), FIFO_BODY_FROM_SEG_RULE); thm result_eq = apply_conversion( rewrite_conv(THM_LIST(assume_rule(equality))), result); thm close = trans_slrule(rebuild, eq2ent(gsym_rule(result_eq))); close = elim_fact_slrule(equality, close); - close = rehant_slrule(close, `fact(${equality:bool}) ** ${core:hprop}`); + close = rehant_slrule(close, `fact(${equality:bool}) ** ${core:cprop}`); thm tail_shape_def = inst_rule(TERM_PAIR_LIST( - (term_pair){`old_tail:addr`, `tail:addr`}), + (term_pair){`old_tail:int`, `tail:int`}), FIFO_TAIL_SHAPE_DEF); thm open = frame_right_slrule( eq2ent(tail_shape_def), core); open = rehant_slrule(open, ` - fifo_tail_shape (contents:(addr)list) prefix old_tail ** - ${core:hprop}`); - open = rehcon_slrule(open, `fact(${equality:bool}) ** ${core:hprop}`); + fifo_tail_shape (contents:(int)list) prefix old_tail ** + ${core:cprop}`); + open = rehcon_slrule(open, `fact(${equality:bool}) ** ${core:cprop}`); thm result_rule = trans_slrule(open, close); return genl_rule( - TERM_LIST(`contents:(addr)list`, `prefix:(addr)list`, - `head:addr`, `old_tail:addr`, `new_tail:addr`), + TERM_LIST(`contents:(int)list`, `prefix:(int)list`, + `head:int`, `old_tail:int`, `new_tail:int`), result_rule); } @@ -505,7 +505,7 @@ PROOF static thm FIFO_NONEMPTY_PUT_FINISH_RULE = PROOF static thm prove_fifo_body_open_nonempty_rule(void) { gnode root = gnode_new_with_ccl(` - forall contents:(addr)list. forall head tail:addr. + forall contents:(int)list. forall head tail:int. ~(head = 0i) ==> (fifo_body contents head tail |-- exists prefix. @@ -513,7 +513,7 @@ PROOF static thm prove_fifo_body_open_nonempty_rule(void) { queue_seg head tail prefix ** queue_edge tail tail 0i) `); gnode g = AUTO_INTROS_TAC(root); - gnode_list cases = CASES_TAC(g, `contents:(addr)list`, "Econtents"); + gnode_list cases = CASES_TAC(g, `contents:(int)list`, "Econtents"); gnode nil = CONV_WITH_ASMP_TAC(cases[0], simp_conv, THM_LIST( FIFO_BODY_DEF)); @@ -523,12 +523,12 @@ PROOF static thm prove_fifo_body_open_nonempty_rule(void) { gnode cons = CONV_WITH_ASMP_TAC(cases[1], simp_conv, THM_LIST( FIFO_BODY_DEF, FIFO_TAIL_SHAPE_DEF)); cons = AUTO_INIT_SLTAC(cons)[0]; - cons = EXISTS_SLTAC(cons, `prefix:(addr)list`); + cons = EXISTS_SLTAC(cons, `prefix:(int)list`); cons = AUTO_FRAME_SLTAC(cons); gnode_list cons_parts = PURE_SLTAC(cons); ACCEPT_TAC(cons_parts[0], assume_rule(` - (a0:addr) :: (a1:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)]`)); + (a0:int) :: (a1:(int)list) = + APPEND (prefix:(int)list) [(tail:int)]`)); AUTO_FRAME_SLTAC(cons_parts[1]); return gnode_prove(root); } @@ -543,7 +543,7 @@ PROOF static thm open_queue_edge_operation_proof(const term goal_tm) { } decl_operation(open_queue_edge_operation, - TERM_LIST(`cursor:addr`, `node:addr`, `next:addr`), + TERM_LIST(`cursor:int`, `node:int`, `next:int`), term_list_n(1, `queue_edge (KEY cursor) (KEY node) (KEY next)`), term_list_n(0), @@ -562,17 +562,17 @@ PROOF static thm close_queue_edge_operation_proof(const term goal_tm) { g = CONV_TAC(g, rewrite_conv(THM_LIST(QUEUE_EDGE_DEF))); g = AUTO_INIT_SLTAC(g)[0]; gnode_list parts = PURE_SLTAC(g); - ACCEPT_TAC(parts[0], assume_rule(`(cursor:addr) = node`)); - ACCEPT_TAC(parts[1], assume_rule(`~((node:addr) = 0i)`)); + ACCEPT_TAC(parts[0], assume_rule(`(cursor:int) = node`)); + ACCEPT_TAC(parts[1], assume_rule(`~((node:int) = 0i)`)); AUTO_FRAME_SLTAC(parts[vector_size(parts) - 1]); return gnode_prove(root); } decl_operation(close_queue_edge_operation, - TERM_LIST(`cursor:addr`, `node:addr`, `next:addr`), + TERM_LIST(`cursor:int`, `node:int`, `next:int`), term_list_n(1, `data_at (field_addr (KEY node) Tqueue_elem Fnext) Tptr (KEY next)`), - TERM_LIST(`(cursor:addr) = node`, `~((node:addr) = 0i)`), + TERM_LIST(`(cursor:int) = node`, `~((node:int) = 0i)`), `queue_edge cursor node next`) PROOF void close_queue_edge( @@ -590,10 +590,10 @@ PROOF static thm close_queue_seg_empty_operation_proof( } decl_operation(close_queue_seg_empty_operation, - TERM_LIST(`point:addr`), + TERM_LIST(`point:int`), term_list_n(0), term_list_n(0), - `queue_seg point point ([]:(addr)list)`) + `queue_seg point point ([]:(int)list)`) PROOF void close_queue_seg_empty(const term point) { apply_operation_st(close_queue_seg_empty_operation, TERM_LIST(point)); @@ -604,7 +604,7 @@ PROOF static thm open_fifo_rep_operation_proof(const term goal_tm) { } decl_operation(open_fifo_rep_operation, - TERM_LIST(`queue:addr`), + TERM_LIST(`queue:int`), term_list_n(1, `fifo_rep (KEY queue) (CAPTURE contents)`), term_list_n(0), `exists head tail. @@ -624,17 +624,17 @@ PROOF static thm close_fifo_rep_operation_proof(const term goal_tm) { gnode g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, rewrite_conv(THM_LIST(FIFO_REP_DEF))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `head:addr`); - g = EXISTS_SLTAC(g, `tail:addr`); + g = EXISTS_SLTAC(g, `head:int`); + g = EXISTS_SLTAC(g, `tail:int`); g = AUTO_FRAME_SLTAC(g); gnode_list parts = PURE_SLTAC(g); - ACCEPT_TAC(parts[0], assume_rule(`~((queue:addr) = 0i)`)); + ACCEPT_TAC(parts[0], assume_rule(`~((queue:int) = 0i)`)); AUTO_FRAME_SLTAC(parts[1]); return gnode_prove(root); } decl_operation(close_fifo_rep_operation, - TERM_LIST(`queue:addr`), + TERM_LIST(`queue:int`), TERM_LIST( `queue_fifo_token (KEY queue)`, `data_at (field_addr (KEY queue) Tqueue_fifo Fhead) Tptr (CAPTURE head)`, @@ -654,8 +654,8 @@ PROOF static thm open_fifo_body_empty_operation_proof( } decl_operation(open_fifo_body_empty_operation, - TERM_LIST(`head:addr`, `tail:addr`), - term_list_n(1, `fifo_body ([]:(addr)list) (KEY head) (KEY tail)`), + TERM_LIST(`head:int`, `tail:int`), + term_list_n(1, `fifo_body ([]:(int)list) (KEY head) (KEY tail)`), term_list_n(0), `fact(head = 0i)`) @@ -671,16 +671,16 @@ PROOF static thm close_fifo_body_empty_operation_proof( g = CONV_TAC(g, rewrite_conv(THM_LIST(FIFO_BODY_DEF))); g = AUTO_INIT_SLTAC(g)[0]; gnode_list parts = PURE_SLTAC(g); - ACCEPT_TAC(parts[0], assume_rule(`(head:addr) = 0i`)); + ACCEPT_TAC(parts[0], assume_rule(`(head:int) = 0i`)); AUTO_FRAME_SLTAC(parts[vector_size(parts) - 1]); return gnode_prove(root); } decl_operation(close_fifo_body_empty_operation, - TERM_LIST(`head:addr`, `tail:addr`), + TERM_LIST(`head:int`, `tail:int`), term_list_n(0), - term_list_n(1, `(head:addr) = 0i`), - `fifo_body ([]:(addr)list) head tail`) + term_list_n(1, `(head:int) = 0i`), + `fifo_body ([]:(int)list) head tail`) PROOF void close_fifo_body_empty(const term head, const term tail) { apply_operation_st( @@ -694,10 +694,10 @@ PROOF static thm begin_fifo_empty_put_operation_proof( } decl_operation(begin_fifo_empty_put_operation, - TERM_LIST(`contents:(addr)list`, `head:addr`, `tail:addr`), + TERM_LIST(`contents:(int)list`, `head:int`, `tail:int`), term_list_n(1, `fifo_body (KEY contents) (KEY head) (KEY tail)`), - term_list_n(1, `(head:addr) = 0i`), + term_list_n(1, `(head:int) = 0i`), `fifo_empty_shape contents`) PROOF void begin_fifo_empty_put( @@ -713,10 +713,10 @@ PROOF static thm finish_fifo_empty_put_operation_proof( } decl_operation(finish_fifo_empty_put_operation, - TERM_LIST(`contents:(addr)list`, `head:addr`, `tail:addr`), + TERM_LIST(`contents:(int)list`, `head:int`, `tail:int`), TERM_LIST( `fifo_empty_shape (KEY contents)`, - `queue_seg (KEY head) (KEY tail) ([]:(addr)list)`, + `queue_seg (KEY head) (KEY tail) ([]:(int)list)`, `queue_edge (KEY tail) (KEY tail) 0i`), term_list_n(0), `fifo_body (APPEND contents [tail]) head tail`) @@ -730,29 +730,29 @@ PROOF void finish_fifo_empty_put( PROOF static thm open_fifo_body_cons_operation_proof( const term goal_tm) { thm shape_law = inst_rule(TERM_PAIR_LIST( - (term_pair){`(first:addr) :: (rest:(addr)list)`, - `contents:(addr)list`}), + (term_pair){`(first:int) :: (rest:(int)list)`, + `contents:(int)list`}), FIFO_TAIL_SHAPE_DEF); term suffix = ` - queue_seg (head:addr) (tail:addr) (prefix:(addr)list) ** + queue_seg (head:int) (tail:int) (prefix:(int)list) ** queue_edge tail tail 0i`; thm fold_shape = frame_right_slrule( eq2ent(gsym_rule(shape_law)), suffix); fold_shape = rehant_slrule(fold_shape, ` - fact((first:addr) :: (rest:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)]) ** ${suffix:hprop}`); + fact((first:int) :: (rest:(int)list) = + APPEND (prefix:(int)list) [(tail:int)]) ** ${suffix:cprop}`); fold_shape = rehcon_slrule(fold_shape, ` - fifo_tail_shape ((first:addr) :: (rest:(addr)list)) prefix tail ** - ${suffix:hprop}`); - fold_shape = exists_mono_slrule(`prefix:(addr)list`, fold_shape); + fifo_tail_shape ((first:int) :: (rest:(int)list)) prefix tail ** + ${suffix:cprop}`); + fold_shape = exists_mono_slrule(`prefix:(int)list`, fold_shape); thm opened = trans_slrule( eq2ent(conjunct2_rule(FIFO_BODY_DEF)), fold_shape); return prove_operation_by_entailment(goal_tm, opened); } decl_operation(open_fifo_body_cons_operation, - TERM_LIST(`first:addr`, `rest:(addr)list`, - `head:addr`, `tail:addr`), + TERM_LIST(`first:int`, `rest:(int)list`, + `head:int`, `tail:int`), term_list_n(1, `fifo_body ((KEY first) :: (KEY rest)) (KEY head) (KEY tail)`), term_list_n(0), @@ -775,10 +775,10 @@ PROOF static thm open_fifo_body_nonempty_operation_proof( } decl_operation(open_fifo_body_nonempty_operation, - TERM_LIST(`contents:(addr)list`, `head:addr`, `tail:addr`), + TERM_LIST(`contents:(int)list`, `head:int`, `tail:int`), term_list_n(1, `fifo_body (KEY contents) (KEY head) (KEY tail)`), - term_list_n(1, `~((head:addr) = 0i)`), + term_list_n(1, `~((head:int) = 0i)`), `exists prefix. fifo_tail_shape contents prefix tail ** queue_seg head tail prefix ** queue_edge tail tail 0i`) @@ -797,19 +797,19 @@ PROOF static thm close_fifo_body_cons_operation_proof( g = CONV_TAC(g, rewrite_conv(THM_LIST( FIFO_BODY_DEF, FIFO_TAIL_SHAPE_DEF))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `prefix:(addr)list`); + g = EXISTS_SLTAC(g, `prefix:(int)list`); g = AUTO_FRAME_SLTAC(g); gnode_list parts = PURE_SLTAC(g); ACCEPT_TAC(parts[0], assume_rule(` - (first:addr) :: (rest:(addr)list) = - APPEND (prefix:(addr)list) [(tail:addr)]`)); + (first:int) :: (rest:(int)list) = + APPEND (prefix:(int)list) [(tail:int)]`)); AUTO_FRAME_SLTAC(parts[1]); return gnode_prove(root); } decl_operation(close_fifo_body_cons_operation, - TERM_LIST(`first:addr`, `rest:(addr)list`, - `head:addr`, `tail:addr`), + TERM_LIST(`first:int`, `rest:(int)list`, + `head:int`, `tail:int`), TERM_LIST( `queue_seg (KEY head) (KEY tail) (CAPTURE prefix)`, `fifo_tail_shape ((KEY first) :: (KEY rest)) @@ -831,7 +831,7 @@ PROOF static thm extend_fifo_tail_operation_proof( } decl_operation(extend_fifo_tail_operation, - TERM_LIST(`head:addr`, `old_tail:addr`, `new_tail:addr`), + TERM_LIST(`head:int`, `old_tail:int`, `new_tail:int`), TERM_LIST( `queue_seg (KEY head) (KEY old_tail) (CAPTURE prefix)`, `queue_edge (KEY old_tail) (KEY old_tail) (KEY new_tail)`), @@ -851,8 +851,8 @@ PROOF static thm finish_fifo_nonempty_put_operation_proof( } decl_operation(finish_fifo_nonempty_put_operation, - TERM_LIST(`contents:(addr)list`, `prefix:(addr)list`, - `head:addr`, `old_tail:addr`, `new_tail:addr`), + TERM_LIST(`contents:(int)list`, `prefix:(int)list`, + `head:int`, `old_tail:int`, `new_tail:int`), TERM_LIST( `fifo_tail_shape (KEY contents) (KEY prefix) (KEY old_tail)`, `queue_seg (KEY head) (KEY new_tail) @@ -875,7 +875,7 @@ PROOF static thm close_fifo_body_from_seg_operation_proof( } decl_operation(close_fifo_body_from_seg_operation, - TERM_LIST(`head:addr`, `tail:addr`), + TERM_LIST(`head:int`, `tail:int`), TERM_LIST( `queue_seg (KEY head) (KEY tail) (CAPTURE prefix)`, `queue_edge (KEY tail) (KEY tail) 0i`), @@ -892,8 +892,8 @@ PROOF static thm pop_fifo_head_operation_proof(const term goal_tm) { } decl_operation(pop_fifo_head_operation, - TERM_LIST(`first:addr`, `rest:(addr)list`, - `head:addr`, `tail:addr`), + TERM_LIST(`first:int`, `rest:(int)list`, + `head:int`, `tail:int`), term_list_n(1, `fifo_body ((KEY first) :: (KEY rest)) (KEY head) (KEY tail)`), term_list_n(0), @@ -914,7 +914,7 @@ PROOF static thm expose_fifo_empty_code_operation_proof( } decl_operation(expose_fifo_empty_code_operation, - TERM_LIST(`contents:(addr)list`, `head:addr`, `tail:addr`), + TERM_LIST(`contents:(int)list`, `head:int`, `tail:int`), term_list_n(1, `fifo_body (KEY contents) (KEY head) (KEY tail)`), term_list_n(0), @@ -928,63 +928,33 @@ PROOF void expose_fifo_empty_code( TERM_LIST(contents, head, tail)); } -PROOF static thm prove_forget_queue_elem_next_rule(void) { - thm field = specl_rule( - TERM_LIST(`field_addr element Tqueue_elem Fnext`, - `Tptr`, `next:addr`), - get_data_at_to_undef_data_at()); - return genl_rule(TERM_LIST(`element:addr`, `next:addr`), field); -} - -PROOF static thm FORGET_QUEUE_ELEM_NEXT_RULE = - prove_forget_queue_elem_next_rule(); - -PROOF static thm forget_queue_elem_next_operation_proof( - const term goal_tm) { - return prove_operation_by_closed_rule( - goal_tm, FORGET_QUEUE_ELEM_NEXT_RULE); -} - -decl_operation(forget_queue_elem_next_operation, - TERM_LIST(`element:addr`), - term_list_n(1, - `data_at (field_addr (KEY element) Tqueue_elem Fnext) - Tptr (CAPTURE next)`), - term_list_n(0), - `undef_data_at (field_addr element Tqueue_elem Fnext) Tptr`) - -PROOF void forget_queue_elem_next(const term element) { - apply_operation_st( - forget_queue_elem_next_operation, TERM_LIST(element)); -} - PROOF int install_queue_rep_qcp_interface(void) { static bool installed = false; if (installed) return 0; ENSURE_COND(cst_add_const_to_header( - `queue_elem_token:addr->hprop`) == 0, + `queue_elem_token:int->cprop`) == 0, "Could not export queue_elem_token"); ENSURE_COND(cst_add_const_to_header( - `queue_fifo_token:addr->hprop`) == 0, + `queue_fifo_token:int->cprop`) == 0, "Could not export queue_fifo_token"); ENSURE_COND(cst_add_const_to_header( - `queue_edge:addr->addr->addr->hprop`) == 0, + `queue_edge:int->int->int->cprop`) == 0, "Could not export queue_edge"); ENSURE_COND(cst_add_const_to_header( - `queue_seg:addr->addr->(addr)list->hprop`) == 0, + `queue_seg:int->int->(int)list->cprop`) == 0, "Could not export queue_seg"); ENSURE_COND(cst_add_const_to_header( - `fifo_body:(addr)list->addr->addr->hprop`) == 0, + `fifo_body:(int)list->int->int->cprop`) == 0, "Could not export fifo_body"); ENSURE_COND(cst_add_const_to_header( - `fifo_empty_shape:(addr)list->hprop`) == 0, + `fifo_empty_shape:(int)list->cprop`) == 0, "Could not export fifo_empty_shape"); ENSURE_COND(cst_add_const_to_header( `fifo_tail_shape: - (addr)list->(addr)list->addr->hprop`) == 0, + (int)list->(int)list->int->cprop`) == 0, "Could not export fifo_tail_shape"); ENSURE_COND(cst_add_const_to_header( - `fifo_rep:addr->(addr)list->hprop`) == 0, + `fifo_rep:int->(int)list->cprop`) == 0, "Could not export fifo_rep"); installed = true; return 0; @@ -1004,7 +974,6 @@ PROOF static int _QUEUE_REP_AUDIT = audit_closed_proof_unit( QUEUE_EMPTY_CODE_RULE, FIFO_BODY_EMPTY_CODE_RULE, FIFO_EMPTY_PUT_BEGIN_RULE, FIFO_EMPTY_PUT_FINISH_RULE, FIFO_NONEMPTY_PUT_FINISH_RULE, FIFO_BODY_OPEN_NONEMPTY_RULE, - FORGET_QUEUE_ELEM_NEXT_RULE, open_queue_edge_operation.lemma, close_queue_edge_operation.lemma, close_queue_seg_empty_operation.lemma, @@ -1021,8 +990,7 @@ PROOF static int _QUEUE_REP_AUDIT = audit_closed_proof_unit( finish_fifo_nonempty_put_operation.lemma, close_fifo_body_from_seg_operation.lemma, pop_fifo_head_operation.lemma, - expose_fifo_empty_code_operation.lemma, - forget_queue_elem_next_operation.lemma)); + expose_fifo_empty_code_operation.lemma)); PROOF static int _QUEUE_REP_QCP = install_queue_rep_qcp_interface(); @@ -1033,7 +1001,7 @@ PROOF static int _QUEUE_REP_QCP = install_queue_rep_qcp_interface(); */ void queue_alloc_fifo(struct queue_fifo **out) REQUIRE(`undef_data_at out Tptr`) - ENSURE_EX(TERM_LIST(`fresh:addr`), + ENSURE_EX(TERM_LIST(`fresh:int`), `data_at out Tptr fresh`, `fact(~(fresh = 0i))`, `queue_fifo_token fresh`, @@ -1043,7 +1011,7 @@ void queue_alloc_fifo(struct queue_fifo **out) void queue_alloc_elem(struct queue_elem **out) REQUIRE(`undef_data_at out Tptr`) - ENSURE_EX(TERM_LIST(`fresh:addr`), + ENSURE_EX(TERM_LIST(`fresh:int`), `data_at out Tptr fresh`, `fact(~(fresh = 0i))`, `queue_elem_token fresh`, @@ -1053,10 +1021,11 @@ void queue_alloc_elem(struct queue_elem **out) ; void queue_free_elem(struct queue_elem *element) + PARAM(`a_value:int`, `b_value:int`, `next_value:int`) REQUIRE(`fact(~(element = 0i))`, `queue_elem_token element`, - `undef_data_at (field_addr element Tqueue_elem Fa) Tint`, - `undef_data_at (field_addr element Tqueue_elem Fb) Tint`, - `undef_data_at (field_addr element Tqueue_elem Fnext) Tptr`) + `data_at (field_addr element Tqueue_elem Fa) Tint a_value`, + `data_at (field_addr element Tqueue_elem Fb) Tint b_value`, + `data_at (field_addr element Tqueue_elem Fnext) Tptr next_value`) ENSURE(`emp`) ; diff --git a/migrations/vst/queue/rep.h b/migrations/vst/queue/rep.h index 15ea01e2e2d46726e2a12635428ce7f592d444e8..69eb57d105fe11f22856c5d38c30c3bde0e85fcc 100644 --- a/migrations/vst/queue/rep.h +++ b/migrations/vst/queue/rep.h @@ -73,13 +73,10 @@ PROOF void pop_fifo_head_as( PROOF void expose_fifo_empty_code( const term contents, const term head, const term tail); -/* Forget the returned link value, matching VST's field_at_ postcondition. */ -PROOF void forget_queue_elem_next(const term element); - /* Typed foreign allocation boundaries. */ void queue_alloc_fifo(struct queue_fifo **out) REQUIRE(`undef_data_at out Tptr`) - ENSURE_EX(TERM_LIST(`fresh:addr`), + ENSURE_EX(TERM_LIST(`fresh:int`), `data_at out Tptr fresh`, `fact(~(fresh = 0i))`, `queue_fifo_token fresh`, @@ -89,7 +86,7 @@ void queue_alloc_fifo(struct queue_fifo **out) void queue_alloc_elem(struct queue_elem **out) REQUIRE(`undef_data_at out Tptr`) - ENSURE_EX(TERM_LIST(`fresh:addr`), + ENSURE_EX(TERM_LIST(`fresh:int`), `data_at out Tptr fresh`, `fact(~(fresh = 0i))`, `queue_elem_token fresh`, @@ -99,10 +96,11 @@ void queue_alloc_elem(struct queue_elem **out) ; void queue_free_elem(struct queue_elem *element) + PARAM(`a_value:int`, `b_value:int`, `next_value:int`) REQUIRE(`fact(~(element = 0i))`, `queue_elem_token element`, - `undef_data_at (field_addr element Tqueue_elem Fa) Tint`, - `undef_data_at (field_addr element Tqueue_elem Fb) Tint`, - `undef_data_at (field_addr element Tqueue_elem Fnext) Tptr`) + `data_at (field_addr element Tqueue_elem Fa) Tint a_value`, + `data_at (field_addr element Tqueue_elem Fb) Tint b_value`, + `data_at (field_addr element Tqueue_elem Fnext) Tptr next_value`) ENSURE(`emp`) ; diff --git a/migrations/vst/value_control/lib/proof.c b/migrations/vst/value_control/lib/proof.c index 98ff94bf7b582131ca4f6608a9311a86bf6d79f7..80a7079fe2d729dfc350bdaf2647a8bde152106e 100644 --- a/migrations/vst/value_control/lib/proof.c +++ b/migrations/vst/value_control/lib/proof.c @@ -6,6 +6,6 @@ PROOF void normalize_scalar_result_st( const thm value_equation) { convert_conjuncts_st( once_rewrite_conv(THM_LIST(value_equation)), - TERM_LIST(`\v. data_at ${result_addr:addr} + TERM_LIST(`\v. data_at ${result_addr:int} ${scalar_type:ctype} v`)); } diff --git a/migrations/vst/value_control/structcopy.c b/migrations/vst/value_control/structcopy.c index 6efe7fc3cd11929bec8590f4818fa9e3209f9c15..f2dcb85cf82167b52209af81fc5a2833c0b381e1 100644 --- a/migrations/vst/value_control/structcopy.c +++ b/migrations/vst/value_control/structcopy.c @@ -46,7 +46,7 @@ unsigned int f(struct foo *p) /* One semantic step: expose the result as the public sum observer. */ PROOF normalize_scalar_result_st( - `result__addr:addr`, `Tuint`, + `result__addr:int`, `Tuint`, sym_rule(VST_STRUCTCOPY_SUM_DEF)); return result; } diff --git a/migrations/vst/value_control/switch.c b/migrations/vst/value_control/switch.c index 21e7533f47dfe6aca2650b1509818b5c7d9e8fd4..ab69c84a007cce219a77f9c1c72d33e365f45ea2 100644 --- a/migrations/vst/value_control/switch.c +++ b/migrations/vst/value_control/switch.c @@ -74,23 +74,23 @@ int twice(int n) if (n == 0) { result = 0; PROOF normalize_scalar_result_st( - `result__addr:addr`, `Tint`, + `result__addr:int`, `Tint`, vst_checked_twice_case(VST_TWICE_ZERO_RULE, `n__pre:int`)); } else if (n == 1) { result = 2; PROOF normalize_scalar_result_st( - `result__addr:addr`, `Tint`, + `result__addr:int`, `Tint`, vst_checked_twice_case(VST_TWICE_ONE_RULE, `n__pre:int`)); } else if (n == -1) { result = -2; PROOF normalize_scalar_result_st( - `result__addr:addr`, `Tint`, + `result__addr:int`, `Tint`, vst_checked_twice_case( VST_TWICE_MINUS_ONE_RULE, `n__pre:int`)); } else { result = n + n; PROOF normalize_scalar_result_st( - `result__addr:addr`, `Tint`, + `result__addr:int`, `Tint`, sym_rule(VST_TWICE_RESULT_DEF)); } return result; @@ -115,7 +115,7 @@ int f(unsigned int x) } PROOF normalize_scalar_result_st( - `result__addr:addr`, `Tint`, + `result__addr:int`, `Tint`, sym_rule(VST_SWITCH_F_RESULT_DEF)); return result; } diff --git a/proof b/proof index da9dd5592fa829201a634508c832146d3fb0bb91..10aaf033230432912ce31304b0e2b31093f13ea4 160000 --- a/proof +++ b/proof @@ -1 +1 @@ -Subproject commit da9dd5592fa829201a634508c832146d3fb0bb91 +Subproject commit 10aaf033230432912ce31304b0e2b31093f13ea4 diff --git a/psi_examples/fixed_pool_roundtrip.c b/psi_examples/fixed_pool_roundtrip.c index 30e791a1b33f5a7dc0088208306313f78a7ee151..0fc308e8c41ce4053e0b13b7fcdc70df3cd84763 100644 --- a/psi_examples/fixed_pool_roundtrip.c +++ b/psi_examples/fixed_pool_roundtrip.c @@ -4,9 +4,10 @@ // verify_all: expect-vcs=0 /* - * The unit implementation is a separate verification root. This client - * consumes only its shared public contracts; the header's dependency loads the - * representation vocabulary and closed proof operations. + * Register two distinct blocks, allocate both, free them in the opposite + * order, and allocate them again. One existential `name` is introduced by + * initialization and is threaded through the invariant and every returned + * `malloc_token name block`; no sidecar or hidden independent name is used. */ int fixed_pool_roundtrip( struct fixed_pool *pool, @@ -16,34 +17,46 @@ int fixed_pool_roundtrip( PARAM(`first_value:int`, `second_value:int`) REQUIRE(`undef_data_at (field_addr pool Tfixed_pool Fhead) Tptr`, `data_at (field_addr first Tfixed_pool_block Fpayload) Tint first_value`, - `malloc_token first`, + `pool_block_seed first`, `fact(~(first = 0i))`, `data_at (field_addr second Tfixed_pool_block Fpayload) Tint second_value`, - `malloc_token second`, - `fact(~(second = 0i))`) - ENSURE_EX(TERM_LIST(`returned_top:addr`, `returned_bottom:addr`), - `pool_rep pool ([]:(int)list)`, - `data_at (field_addr returned_top Tfixed_pool_block Fpayload) Tint replacement`, - `malloc_token returned_top`, - `fact(~(returned_top = 0i))`, - `data_at (field_addr returned_bottom Tfixed_pool_block Fpayload) Tint first_value`, - `malloc_token returned_bottom`, - `fact(~(returned_bottom = 0i))`, - return_int(`second_value:int`)) + `pool_block_seed second`, + `fact(~(second = 0i))`, + `fact(~((first:int) = (second:int)))`) + ENSURE_EX( + TERM_LIST(`name:num`, `returned_top:int`, `returned_bottom:int`), + `pool_rep name pool (pool_domain_extend (pool_domain_extend (finmap_empty:(int,(1)excl)finmap) first) second) ([]:(int)list)`, + `data_at (field_addr returned_top Tfixed_pool_block Fpayload) Tint replacement`, + `malloc_token name returned_top`, + `fact(~(returned_top = 0i))`, + `data_at (field_addr returned_bottom Tfixed_pool_block Fpayload) Tint first_value`, + `malloc_token name returned_bottom`, + `fact(~(returned_bottom = 0i))`, + return_int(`second_value:int`)) { fixed_pool_init(pool); + PROOF add_fact_st( + ispec_rule(`first__pre:int`, POOL_DOMAIN_FRESH_EMPTY)); fixed_pool_supply(pool, first); + + PROOF { + thm fresh_second = ispecl_rule( + TERM_LIST(`first__pre:int`, `second__pre:int`), + POOL_DOMAIN_FRESH_PAIR); + fresh_second = mp_rule( + fresh_second, + assume_rule(`~((first__pre:int) = (second__pre:int))`)); + add_fact_st(fresh_second); + } fixed_pool_supply(pool, second); - /* The abstract list [second_value; first_value] fixes both pop results. */ struct fixed_pool_block *old_top = fixed_pool_take(pool); int observed_top = old_top->payload; struct fixed_pool_block *old_bottom = fixed_pool_take(pool); old_top->payload = replacement; - /* bottom then top rebuilds [replacement; first_value]. */ fixed_pool_put(pool, old_bottom); fixed_pool_put(pool, old_top); diff --git a/psi_examples/lib/fixed_pool.c b/psi_examples/lib/fixed_pool.c index b5f453bbdafe2009f9862487b9d71446b9cabf3c..81a0446a32210920856e3215d0a29a3eaab69a5f 100644 --- a/psi_examples/lib/fixed_pool.c +++ b/psi_examples/lib/fixed_pool.c @@ -1,13 +1,112 @@ #include "psi_examples/lib/fixed_pool.h" +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" + +#include "proof/proof_sl.h" +#require "proof/proof_sl.c" + #include "userlib/proof/probes.h" #require "userlib/proof/probes.c" -/* This proof module intentionally needs only forward C declarations. */ +#require "proof/theory/logic/unit_ra.c" +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/gmap_ra.c" +#require "proof/theory/logic/auth_ra.c" +#require "userlib/qcp/c_logic.c" PROOF static size_t FIXED_POOL_AXIOMS_BEFORE = vector_size(get_all_axioms()); +/* ------------------------------------------------------------------------- */ +/* Selected ghost algebra and QCP boundary */ +/* ------------------------------------------------------------------------- */ + +PROOF term fixed_pool_ra_term(void) { + return ` + auth_ra (gmap_ra (excl_ra:((1)excl)ra)): + ((((int,(1)excl)finmap)excl# + (int,(1)excl)finmap))ra + `; +} + +PROOF int install_fixed_pool_logic(void) { + static bool installed = false; + if (installed) return 0; + + ENSURE_COND( + cst_add_type_to_header("ra", 1) == 0, + "Could not export ra type for fixed_pool"); + ENSURE_COND( + cst_add_type_to_header("excl", 1) == 0, + "Could not export excl type for fixed_pool"); + ENSURE_COND( + cst_add_type_to_header("finmap", 2) == 0, + "Could not export finmap type for fixed_pool"); + ENSURE_COND( + cst_add_type_to_header("1", 0) == 0, + "Could not export unit type for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(`one:1`) == 0, + "Could not export unit value for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(`ExclUnit:(A)excl`) == 0, + "Could not export ExclUnit for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(`Excl:A->(A)excl`) == 0, + "Could not export Excl for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(`ExclInvalid:(A)excl`) == 0, + "Could not export ExclInvalid for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(`excl_ra:((1)excl)ra`) == 0, + "Could not export the selected excl RA for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(` + gmap_ra:((1)excl)ra->((int,(1)excl)finmap)ra`) == 0, + "Could not export the selected gmap RA for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(` + auth_auth: + ((int,(1)excl)finmap)ra-> + (int,(1)excl)finmap-> + (((int,(1)excl)finmap)excl#(int,(1)excl)finmap)`) == 0, + "Could not export auth_auth for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(` + auth_frag: + (int,(1)excl)finmap-> + (((int,(1)excl)finmap)excl#(int,(1)excl)finmap)`) == 0, + "Could not export auth_frag for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(` + auth_both: + (int,(1)excl)finmap-> + (int,(1)excl)finmap-> + (((int,(1)excl)finmap)excl#(int,(1)excl)finmap)`) == 0, + "Could not export auth_both for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header(` + finmap_singleton: + int->(1)excl->(int,(1)excl)finmap`) == 0, + "Could not export finmap_singleton for fixed_pool"); + ENSURE_COND( + cst_add_const_to_header( + `finmap_empty:(int,(1)excl)finmap`) == 0, + "Could not export the empty fixed_pool domain"); + ENSURE_COND( + c_logic_install_named(fixed_pool_ra_term()) == 0, + "Could not install fixed_pool's C resource model"); + + installed = true; + return 0; +err: + ERR_FUN_PUTS("install_fixed_pool_logic"); + return -1; +} + +PROOF static int _FIXED_POOL_LOGIC = install_fixed_pool_logic(); + PROOF static int _Tfixed_pool_block = new_const_safe("Tfixed_pool_block", `:struct_name`); PROOF static int _Tfixed_pool = @@ -16,42 +115,388 @@ PROOF static int _Fpayload = new_const_safe("Fpayload", `:field`); PROOF static int _Fnext = new_const_safe("Fnext", `:field`); PROOF static int _Fhead = new_const_safe("Fhead", `:field`); +/* ------------------------------------------------------------------------- */ +/* Logical domain and abstract public assertions */ +/* ------------------------------------------------------------------------- */ + +PROOF thm pool_domain_extend_def = cst_new_fun_definition( + "pool_domain_extend", + `pool_domain_extend + (domain:(int,(1)excl)finmap) + (block:int) = + ra_op + (gmap_ra (excl_ra:((1)excl)ra)) + domain + (finmap_singleton block (Excl one))`, + `:(int,(1)excl)finmap->int->(int,(1)excl)finmap`); + +PROOF thm pool_domain_fresh_def = cst_new_fun_definition( + "pool_domain_fresh", + `pool_domain_fresh + (domain:(int,(1)excl)finmap) + (block:int) <=> + ra_valid + (gmap_ra (excl_ra:((1)excl)ra)) + (pool_domain_extend domain block)`, + `:(int,(1)excl)finmap->int->bool`); + +/* The seed is purely physical. Registration consumes it exactly once. */ +PROOF static thm pool_block_seed_def = cst_new_fun_definition( + "pool_block_seed", + `pool_block_seed block -|- + exists old_next. + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + old_next`, + `:int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int,(1)excl)finmap)excl# + (int,(1)excl)finmap))finmap)->bool`); + +/* A client token binds both the shared name and the exact block address. */ +PROOF static thm malloc_token_def = cst_new_fun_definition( + "malloc_token", + `malloc_token name block -|- + exists old_next. + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + old_next ** + own + name + (auth_frag + (finmap_singleton block (Excl one)))`, + `:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int,(1)excl)finmap)excl# + (int,(1)excl)finmap))finmap)->bool`); + /* - * The recursive chain owns both fields of every pooled block. Its logical - * list records payloads in LIFO order. + * Every free node stores its block fragment at the same allocator name. + * The list parameter records only client-visible payload values; addresses + * remain hidden in the recursive physical representation. */ -PROOF thm pool_free_chain_def = cst_new_rec_definition( +PROOF static thm pool_free_chain_def = cst_new_rec_definition( "pool_free_chain", get_theorem_by_name("list_RECURSION"), ` - (pool_free_chain p ([]:(int)list) -|- fact(p = 0i)) && - (pool_free_chain p ((payload_value:int) :: (values:(int)list)) -|- - exists next. fact(~(p = 0i)) ** - data_at (field_addr p Tfixed_pool_block Fpayload) Tint payload_value ** - data_at (field_addr p Tfixed_pool_block Fnext) Tptr next ** - pool_free_chain next values) + (pool_free_chain name p ([]:(int)list) -|- fact(p = 0i)) && + (pool_free_chain + name + p + ((payload_value:int) :: (values:(int)list)) -|- + exists next. + fact(~(p = 0i)) ** + data_at + (field_addr p Tfixed_pool_block Fpayload) + Tint + payload_value ** + data_at + (field_addr p Tfixed_pool_block Fnext) + Tptr + next ** + own + name + (auth_frag + (finmap_singleton p (Excl one))) ** + pool_free_chain name next values) `, - `:addr->(int)list->hprop`); - -PROOF thm pool_rep_def = cst_new_fun_definition( - "pool_rep", - `pool_rep pool values -|- exists head. - data_at (field_addr pool Tfixed_pool Fhead) Tptr head ** - pool_free_chain head values`, - `:addr->(int)list->hprop`); + `:num->int->(int)list-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int,(1)excl)finmap)excl# + (int,(1)excl)finmap))finmap)->bool`); /* - * A returned block keeps its initialized next cell as a spatial token. The - * old pointer value is deliberately abstract: put overwrites it before the - * block re-enters the free chain. No data_at-to-undef weakening is needed. + * The module invariant exposes only the logical domain and payload sequence. + * Its concrete head and chain are existential; the authority is held at the + * same explicit `name` used by every malloc token. */ -PROOF thm malloc_token_def = cst_new_fun_definition( - "malloc_token", - `malloc_token block -|- exists old_next. - data_at (field_addr block Tfixed_pool_block Fnext) Tptr old_next`, - `:addr->hprop`); +PROOF static thm pool_rep_def = cst_new_fun_definition( + "pool_rep", + `pool_rep name pool domain values -|- + exists head. + data_at + (field_addr pool Tfixed_pool Fhead) + Tptr + head ** + pool_free_chain name head values ** + own + name + (auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + domain)`, + `:num->int->(int,(1)excl)finmap->(int)list-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int,(1)excl)finmap)excl# + (int,(1)excl)finmap))finmap)->bool`); + +PROOF int install_fixed_pool_qcp_interface(void) { + static bool installed = false; + if (installed) return 0; + /* Every public constant was registered by cst_new_*_definition above. */ + installed = true; + return 0; +} + +/* ------------------------------------------------------------------------- */ +/* Domain facts */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fixed_pool_gmap_unit(void) { + type_pair_list pool_types = (type_pair_list)vector_create(); + vector_add(&pool_types, ((type_pair){`:int`, `:K`})); + vector_add(&pool_types, ((type_pair){`:(1)excl`, `:V`})); + thm typed = inst_type_rule(pool_types, gmap_ra_unit); + return ispec_rule(`excl_ra:((1)excl)ra`, typed); +} + +PROOF static thm FIXED_POOL_GMAP_UNIT = + prove_fixed_pool_gmap_unit(); + +PROOF static thm prove_pool_domain_fresh_empty(void) { + term goal_tm = `forall block:int. + pool_domain_fresh + (finmap_empty:(int,(1)excl)finmap) + block`; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = GEN_TAC(root, "block"); + CONV_TAC( + body, + rewrite_conv(THM_LIST( + pool_domain_fresh_def, + pool_domain_extend_def, + gsym_rule(FIXED_POOL_GMAP_UNIT), + ra_unit_l, + gmap_ra_valid_singleton, + excl_ra_valid_owned))); + return gnode_prove(root); +} + +PROOF thm POOL_DOMAIN_FRESH_EMPTY = + prove_pool_domain_fresh_empty(); + +PROOF static thm prove_fixed_pool_option_op_none_r(void) { + gnode root = gnode_new_with_ccl(` + forall (R:(A)ra) (x:A option). + ra_op (option_ra R) x NONE == x + `); + gnode body = AUTO_INTROS_TAC(root); + thm commute = ispecl_rule( + TERM_LIST(`option_ra (R:(A)ra)`, `x:A option`, `NONE:A option`), + ra_comm); + thm left_unit = ispecl_rule( + TERM_LIST(`R:(A)ra`, `x:A option`), + option_ra_op_none_l); + ACCEPT_TAC(body, trans_rule(commute, left_unit)); + return gnode_prove(root); +} + +PROOF static thm FIXED_POOL_OPTION_OP_NONE_R = + prove_fixed_pool_option_op_none_r(); + +PROOF static thm prove_pool_domain_fresh_pair(void) { + term goal_tm = `forall first second:int. + ~(first = second) ==> + pool_domain_fresh + (pool_domain_extend + (finmap_empty:(int,(1)excl)finmap) + first) + second`; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + pool_domain_fresh_def, + pool_domain_extend_def, + gsym_rule(FIXED_POOL_GMAP_UNIT), + ra_unit_l))); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(gmap_ra_valid))); + body = GEN_TAC(body, "key"); + + gnode_list first_cases = BOOL_CASES_TAC( + body, `(key:int) = first`, "C_first"); + CONV_WITH_ASMP_TAC( + first_cases[0], + simp_conv, + THM_LIST( + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l, + FIXED_POOL_OPTION_OP_NONE_R, + option_ra_valid_none, + option_ra_valid_some, + excl_ra_valid_owned)); + + gnode_list second_cases = BOOL_CASES_TAC( + first_cases[1], `(key:int) = second`, "C_second"); + CONV_WITH_ASMP_TAC( + second_cases[0], + simp_conv, + THM_LIST( + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l, + FIXED_POOL_OPTION_OP_NONE_R, + option_ra_valid_none, + option_ra_valid_some, + excl_ra_valid_owned)); + CONV_WITH_ASMP_TAC( + second_cases[1], + simp_conv, + THM_LIST( + gmap_ra_op_lookup, + finmap_singleton_lookup, + option_ra_op_none_l, + FIXED_POOL_OPTION_OP_NONE_R, + option_ra_valid_none, + option_ra_valid_some, + excl_ra_valid_owned)); + return gnode_prove(root); +} + +PROOF thm POOL_DOMAIN_FRESH_PAIR = + prove_pool_domain_fresh_pair(); + +/* ------------------------------------------------------------------------- */ +/* Ghost allocation and registration viewshifts */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fixed_pool_init_viewshift(void) { + term base_ra = ` + gmap_ra (excl_ra:((1)excl)ra): + ((int,(1)excl)finmap)ra`; + term empty_domain = `finmap_empty:(int,(1)excl)finmap`; + term payload = ` + auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + (finmap_empty:(int,(1)excl)finmap)`; + + term valid_goal = `ra_valid ${fixed_pool_ra_term():(((int,(1)excl)finmap)excl#(int,(1)excl)finmap)ra} ${payload:((int,(1)excl)finmap)excl#(int,(1)excl)finmap}`; + gnode valid_root = gnode_new_with_ccl(valid_goal); + CONV_TAC( + valid_root, + rewrite_conv(THM_LIST( + auth_ra_valid_auth, + gsym_rule(FIXED_POOL_GMAP_UNIT), + ra_valid_unit))); + thm valid_payload = gnode_prove(valid_root); + + thm allocate = ispecl_rule( + TERM_LIST(payload, sl_emp()), + c_logic_current()->ghost_own_alloc); + (void)base_ra; + (void)empty_domain; + thm allocated = mp_rule(allocate, valid_payload); + return pure_rewrite_rule(THM_LIST(sl_sep_emp_right()), allocated); +} -/*------------------------ pool_rep boundary ------------------------*/ +PROOF static thm FIXED_POOL_INIT_VIEWSHIFT = + prove_fixed_pool_init_viewshift(); + +PROOF static thm prove_fixed_pool_own_split(void) { + term base_ra = ` + gmap_ra (excl_ra:((1)excl)ra): + ((int,(1)excl)finmap)ra`; + term extended = `pool_domain_extend + (domain:(int,(1)excl)finmap) (block:int)`; + term piece = `finmap_singleton (block:int) (Excl one)`; + term authority = `auth_auth ${base_ra:((int,(1)excl)finmap)ra} + ${extended:(int,(1)excl)finmap}`; + term fragment = `auth_frag ${piece:(int,(1)excl)finmap}`; + term combined = `auth_both + ${extended:(int,(1)excl)finmap} + ${piece:(int,(1)excl)finmap}`; + + thm composition = ispecl_rule( + TERM_LIST(base_ra, extended, piece), + auth_ra_auth_frag); + thm replace_combined = ap_term_rule( + mk_comb(c_logic_current()->own, `name:num`), + gsym_rule(composition)); + thm split = ispecl_rule( + TERM_LIST(`name:num`, authority, fragment), + c_logic_current()->ghost_own_split); + thm result = trans_slrule(eq2ent(replace_combined), split); + result = gen_rule(`block:int`, result); + result = gen_rule(`domain:(int,(1)excl)finmap`, result); + result = gen_rule(`name:num`, result); + return result; +} + +PROOF static thm FIXED_POOL_OWN_SPLIT = + prove_fixed_pool_own_split(); + +PROOF static thm prove_fixed_pool_register_viewshift(void) { + term premise = `pool_domain_fresh + (domain:(int,(1)excl)finmap) (block:int)`; + term base_ra = ` + gmap_ra (excl_ra:((1)excl)ra): + ((int,(1)excl)finmap)ra`; + term domain = `domain:(int,(1)excl)finmap`; + term block = `block:int`; + term extended = `pool_domain_extend + (domain:(int,(1)excl)finmap) (block:int)`; + term piece = `finmap_singleton (block:int) (Excl one)`; + term source = `auth_auth ${base_ra:((int,(1)excl)finmap)ra} + ${domain:(int,(1)excl)finmap}`; + term target = `auth_both + ${extended:(int,(1)excl)finmap} + ${piece:(int,(1)excl)finmap}`; + + thm fresh_law = inst_rule( + TERM_PAIR_LIST( + (term_pair){domain, `domain:(int,(1)excl)finmap`}, + (term_pair){block, `block:int`}), + pool_domain_fresh_def); + thm valid_extended = eq_mp_rule( + fresh_law, + assume_rule(premise)); + valid_extended = pure_once_rewrite_rule( + THM_LIST(pool_domain_extend_def), + valid_extended); + thm payload_update = mp_rule( + ispecl_rule( + TERM_LIST(base_ra, domain, piece), + auth_ra_alloc), + valid_extended); + payload_update = pure_once_rewrite_rule( + THM_LIST(gsym_rule(pool_domain_extend_def)), + payload_update); + thm own_update = mp_rule( + ispecl_rule( + TERM_LIST(`name:num`, source, target), + c_logic_current()->ghost_own_update), + payload_update); + + thm target_split = ispecl_rule( + TERM_LIST( + `name:num`, + `domain:(int,(1)excl)finmap`, + `block:int`), + FIXED_POOL_OWN_SPLIT); + thm result = viewshift_mono_slrule( + refl_slrule(mk_comb( + mk_comb(c_logic_current()->own, `name:num`), + source)), + own_update, + target_split); + result = disch_rule(premise, result); + result = gen_rule(`block:int`, result); + result = gen_rule(`domain:(int,(1)excl)finmap`, result); + result = gen_rule(`name:num`, result); + return result; +} + +PROOF static thm FIXED_POOL_REGISTER_VIEWSHIFT = + prove_fixed_pool_register_viewshift(); + +/* ------------------------------------------------------------------------- */ +/* pool_rep boundary */ +/* ------------------------------------------------------------------------- */ PROOF static thm unfold_pool_rep_operation_proof(const term goal_tm) { return prove_operation_by_entailment( @@ -59,17 +504,32 @@ PROOF static thm unfold_pool_rep_operation_proof(const term goal_tm) { } decl_operation(unfold_pool_rep_operation, - TERM_LIST(`pool:addr`), - term_list_n(1, `pool_rep (KEY pool) (CAPTURE values)`), + TERM_LIST(`name:num`, `pool:int`, `domain:(int,(1)excl)finmap`), + term_list_n(1, + `pool_rep + (KEY name) + (KEY pool) + (KEY domain) + (CAPTURE values)`), term_list_n(0), `exists head. data_at (field_addr pool Tfixed_pool Fhead) Tptr head ** - pool_free_chain head values` + pool_free_chain name head values ** + own name + (auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + domain)` ) -PROOF void unfold_pool_rep_as(const term pool, const term head_name) { +PROOF void unfold_pool_rep_as( + const term name, + const term pool, + const term head_name) { + term domain = `domain:(int,(1)excl)finmap`; apply_operation_named_st( - unfold_pool_rep_operation, TERM_LIST(pool), TERM_LIST(head_name)); + unfold_pool_rep_operation, + TERM_LIST(name, pool, domain), + TERM_LIST(head_name)); } PROOF static thm fold_pool_rep_operation_proof(const term goal_tm) { @@ -77,210 +537,481 @@ PROOF static thm fold_pool_rep_operation_proof(const term goal_tm) { gnode g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, rewrite_conv(THM_LIST(pool_rep_def))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `head:addr`); + g = EXISTS_SLTAC(g, `head:int`); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(fold_pool_rep_operation, - TERM_LIST(`pool:addr`), + TERM_LIST(`name:num`, `pool:int`, `domain:(int,(1)excl)finmap`), TERM_LIST( - `data_at (field_addr (KEY pool) Tfixed_pool Fhead) Tptr (CAPTURE head)`, - `pool_free_chain (KEY head) (CAPTURE values)` + `data_at + (field_addr (KEY pool) Tfixed_pool Fhead) + Tptr + (CAPTURE head)`, + `pool_free_chain + (KEY name) + (KEY head) + (CAPTURE values)`, + `own + (KEY name) + (KEY + (auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + domain))` ), term_list_n(0), - `pool_rep pool values` + `pool_rep name pool domain values` ) -PROOF void fold_pool_rep(const term pool) { - apply_operation_st(fold_pool_rep_operation, TERM_LIST(pool)); +PROOF void fold_pool_rep( + const term name, + const term pool, + const term domain) { + apply_operation_st( + fold_pool_rep_operation, + TERM_LIST(name, pool, domain)); } -/*--------------------- one recursive chain node --------------------*/ +/* ------------------------------------------------------------------------- */ +/* Recursive free-list node */ +/* ------------------------------------------------------------------------- */ -/* Select the cons equation once so unfold and fold cannot drift apart. */ -PROOF static thm pool_free_chain_cons_law(const term block) { +PROOF static thm pool_free_chain_cons_law( + const term name, + const term block) { thm expanded = spec_all_rule(conjunct2_rule(pool_free_chain_def)); - return inst_rule(TERM_PAIR_LIST( - (term_pair){block, `p:addr`}), expanded); + return inst_rule( + TERM_PAIR_LIST( + (term_pair){name, `name:num`}, + (term_pair){block, `p:int`}), + expanded); } PROOF static thm unfold_pool_chain_cons_operation_proof( const term goal_tm) { - thm expanded = pool_free_chain_cons_law(`block:addr`); + thm expanded = pool_free_chain_cons_law( + `name:num`, `block:int`); return prove_operation_by_entailment( goal_tm, eq2ent(expanded)); } decl_operation(unfold_pool_chain_cons_operation, - TERM_LIST(`block:addr`), + TERM_LIST(`name:num`, `block:int`), term_list_n(1, - `pool_free_chain (KEY block) ((CAPTURE payload_value) :: (CAPTURE values))` + `pool_free_chain + (KEY name) + (KEY block) + ((CAPTURE payload_value) :: (CAPTURE values))` ), term_list_n(0), - `exists next. fact(~(block = 0i)) ** - data_at (field_addr block Tfixed_pool_block Fpayload) Tint payload_value ** - data_at (field_addr block Tfixed_pool_block Fnext) Tptr next ** - pool_free_chain next values` + `exists next. + fact(~(block = 0i)) ** + data_at + (field_addr block Tfixed_pool_block Fpayload) + Tint + payload_value ** + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + next ** + own name + (auth_frag + (finmap_singleton block (Excl one))) ** + pool_free_chain name next values` ) PROOF void unfold_pool_chain_cons_as( - const term block, const term next_name) { - apply_operation_named_st(unfold_pool_chain_cons_operation, - TERM_LIST(block), TERM_LIST(next_name)); + const term name, + const term block, + const term next_name) { + apply_operation_named_st( + unfold_pool_chain_cons_operation, + TERM_LIST(name, block), + TERM_LIST(next_name)); } PROOF static thm fold_pool_chain_cons_operation_proof( const term goal_tm) { - term cells = ` - data_at (field_addr block Tfixed_pool_block Fpayload) Tint payload_value ** - data_at (field_addr block Tfixed_pool_block Fnext) Tptr next ** - pool_free_chain next (values:(int)list)`; - term packed_cells = `exists next. fact(~(block = 0i)) ** - data_at (field_addr block Tfixed_pool_block Fpayload) Tint payload_value ** - data_at (field_addr block Tfixed_pool_block Fnext) Tptr next ** - pool_free_chain next (values:(int)list)`; + term resources = ` + data_at + (field_addr block Tfixed_pool_block Fpayload) + Tint + payload_value ** + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + next ** + own name + (auth_frag + (finmap_singleton block (Excl one))) ** + pool_free_chain name next (values:(int)list)`; + term packed = `exists next. + fact(~(block = 0i)) ** + data_at + (field_addr block Tfixed_pool_block Fpayload) + Tint + payload_value ** + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + next ** + own name + (auth_frag + (finmap_singleton block (Excl one))) ** + pool_free_chain name next (values:(int)list)`; thm pack = intro_fact_slrule( - assume_rule(`~(block = 0i)`), refl_slrule(cells)); - pack = exists_slrule(packed_cells, `next:addr`, pack); - - thm expanded = pool_free_chain_cons_law(`block:addr`); + assume_rule(`~(block = 0i)`), + refl_slrule(resources)); + pack = exists_slrule(packed, `next:int`, pack); + thm expanded = pool_free_chain_cons_law( + `name:num`, `block:int`); return prove_operation_by_entailment( - goal_tm, trans_slrule(pack, eq2ent(sym_rule(expanded)))); + goal_tm, + trans_slrule(pack, eq2ent(sym_rule(expanded)))); } decl_operation(fold_pool_chain_cons_operation, - TERM_LIST(`block:addr`), + TERM_LIST(`name:num`, `block:int`), TERM_LIST( - `data_at (field_addr (KEY block) Tfixed_pool_block Fpayload) Tint (CAPTURE payload_value)`, - `data_at (field_addr (KEY block) Tfixed_pool_block Fnext) Tptr (CAPTURE next)`, - `pool_free_chain (KEY next) (CAPTURE values)` + `data_at + (field_addr (KEY block) Tfixed_pool_block Fpayload) + Tint + (CAPTURE payload_value)`, + `data_at + (field_addr (KEY block) Tfixed_pool_block Fnext) + Tptr + (CAPTURE next)`, + `own + (KEY name) + (KEY + (auth_frag + (finmap_singleton block (Excl one))))`, + `pool_free_chain + (KEY name) + (KEY next) + (CAPTURE values)` ), term_list_n(1, `~(block = 0i)`), - `pool_free_chain block (payload_value :: values)` + `pool_free_chain name block (payload_value :: values)` ) -PROOF void fold_pool_chain_cons(const term block) { - apply_operation_st(fold_pool_chain_cons_operation, TERM_LIST(block)); +PROOF void fold_pool_chain_cons( + const term name, + const term block) { + apply_operation_st( + fold_pool_chain_cons_operation, + TERM_LIST(name, block)); } -/*------------------------- returned token --------------------------*/ +/* ------------------------------------------------------------------------- */ +/* Client token and unregistered seed */ +/* ------------------------------------------------------------------------- */ -PROOF static thm unfold_malloc_token_operation_proof(const term goal_tm) { +PROOF static thm unfold_malloc_token_operation_proof( + const term goal_tm) { return prove_operation_by_entailment( goal_tm, eq2ent(malloc_token_def)); } decl_operation(unfold_malloc_token_operation, - TERM_LIST(`block:addr`), - term_list_n(1, `malloc_token (KEY block)`), + TERM_LIST(`name:num`, `block:int`), + term_list_n(1, `malloc_token (KEY name) (KEY block)`), term_list_n(0), `exists old_next. - data_at (field_addr block Tfixed_pool_block Fnext) Tptr old_next` + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + old_next ** + own name + (auth_frag + (finmap_singleton block (Excl one)))` ) PROOF void unfold_malloc_token_as( - const term block, const term old_next_name) { - apply_operation_named_st(unfold_malloc_token_operation, - TERM_LIST(block), TERM_LIST(old_next_name)); + const term name, + const term block, + const term old_next_name) { + apply_operation_named_st( + unfold_malloc_token_operation, + TERM_LIST(name, block), + TERM_LIST(old_next_name)); } -PROOF static thm fold_malloc_token_operation_proof(const term goal_tm) { - term cell = `data_at - (field_addr block Tfixed_pool_block Fnext) Tptr old_next`; +PROOF static thm fold_malloc_token_operation_proof( + const term goal_tm) { + term resources = ` + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + old_next ** + own name + (auth_frag + (finmap_singleton block (Excl one)))`; term packed = `exists old_next. - data_at (field_addr block Tfixed_pool_block Fnext) Tptr old_next`; - thm pack = exists_slrule(packed, `old_next:addr`, refl_slrule(cell)); + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + old_next ** + own name + (auth_frag + (finmap_singleton block (Excl one)))`; + thm pack = exists_slrule( + packed, + `old_next:int`, + refl_slrule(resources)); return prove_operation_by_entailment( - goal_tm, trans_slrule(pack, eq2ent(sym_rule(malloc_token_def)))); + goal_tm, + trans_slrule(pack, eq2ent(sym_rule(malloc_token_def)))); } decl_operation(fold_malloc_token_operation, - TERM_LIST(`block:addr`), - term_list_n(1, - `data_at (field_addr (KEY block) Tfixed_pool_block Fnext) Tptr (CAPTURE old_next)` + TERM_LIST(`name:num`, `block:int`), + TERM_LIST( + `data_at + (field_addr (KEY block) Tfixed_pool_block Fnext) + Tptr + (CAPTURE old_next)`, + `own + (KEY name) + (KEY + (auth_frag + (finmap_singleton block (Excl one))))` ), term_list_n(0), - `malloc_token block` + `malloc_token name block` +) + +PROOF void fold_malloc_token( + const term name, + const term block) { + apply_operation_st( + fold_malloc_token_operation, + TERM_LIST(name, block)); +} + +PROOF static thm unfold_pool_block_seed_operation_proof( + const term goal_tm) { + return prove_operation_by_entailment( + goal_tm, eq2ent(pool_block_seed_def)); +} + +decl_operation(unfold_pool_block_seed_operation, + TERM_LIST(`block:int`), + term_list_n(1, `pool_block_seed (KEY block)`), + term_list_n(0), + `exists old_next. + data_at + (field_addr block Tfixed_pool_block Fnext) + Tptr + old_next` ) -PROOF void fold_malloc_token(const term block) { - apply_operation_st(fold_malloc_token_operation, TERM_LIST(block)); +PROOF void unfold_pool_block_seed_as( + const term block, + const term old_next_name) { + apply_operation_named_st( + unfold_pool_block_seed_operation, + TERM_LIST(block), + TERM_LIST(old_next_name)); } -/*------------------------- empty manager ---------------------------*/ +/* ------------------------------------------------------------------------- */ +/* Empty invariant and symbolic-state update helpers */ +/* ------------------------------------------------------------------------- */ -PROOF static thm fold_empty_pool_operation_proof(const term goal_tm) { - term manager_cell = `data_at +PROOF static thm fold_empty_pool_operation_proof( + const term goal_tm) { + term manager = `data_at (field_addr pool Tfixed_pool Fhead) Tptr 0i`; - term manager_and_chain = ` - data_at (field_addr pool Tfixed_pool Fhead) Tptr 0i ** - pool_free_chain 0i ([]:(int)list)`; - term packed_rep = `exists head. - data_at (field_addr pool Tfixed_pool Fhead) Tptr head ** - pool_free_chain head ([]:(int)list)`; + term authority = `own name + (auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + (finmap_empty:(int,(1)excl)finmap))`; + term chain = `pool_free_chain + name 0i ([]:(int)list)`; + term resources = `${manager:cprop} ** ${chain:cprop} ** ${authority:cprop}`; + term packed = `exists head. + data_at + (field_addr pool Tfixed_pool Fhead) Tptr head ** + pool_free_chain name head ([]:(int)list) ** + own name + (auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + (finmap_empty:(int,(1)excl)finmap))`; thm make_true = intro_fact_slrule( - refl_rule(`0i:addr`), refl_slrule(sl_emp())); + refl_rule(`0i:int`), + refl_slrule(sl_emp())); make_true = rehcon_slrule(make_true, `fact(0i = 0i)`); - thm nil_expanded = spec_all_rule(conjunct1_rule(pool_free_chain_def)); - nil_expanded = inst_rule(TERM_PAIR_LIST( - (term_pair){`0i:addr`, `p:addr`}), nil_expanded); - thm make_empty_chain = trans_slrule( - make_true, eq2ent(sym_rule(nil_expanded))); - thm add_manager = frame_left_slrule(manager_cell, make_empty_chain); - add_manager = rehant_slrule(add_manager, manager_cell); - add_manager = rehcon_slrule(add_manager, manager_and_chain); + thm nil_law = spec_all_rule(conjunct1_rule(pool_free_chain_def)); + nil_law = inst_rule( + TERM_PAIR_LIST( + (term_pair){`name:num`, `name:num`}, + (term_pair){`0i:int`, `p:int`}), + nil_law); + thm make_chain = trans_slrule( + make_true, + eq2ent(sym_rule(nil_law))); + thm add_manager = frame_left_slrule(manager, make_chain); + thm add_authority = frame_right_slrule(add_manager, authority); + add_authority = rehcon_slrule(add_authority, resources); thm pack = exists_slrule( - packed_rep, `0i:addr`, refl_slrule(manager_and_chain)); - thm close_rep = inst_rule(TERM_PAIR_LIST( - (term_pair){`[]:(int)list`, `values:(int)list`}), pool_rep_def); - close_rep = eq2ent(sym_rule(close_rep)); + packed, + `0i:int`, + refl_slrule(resources)); + thm close = inst_rule( + TERM_PAIR_LIST( + (term_pair){`name:num`, `name:num`}, + (term_pair){`pool:int`, `pool:int`}, + (term_pair){`finmap_empty:(int,(1)excl)finmap`, + `domain:(int,(1)excl)finmap`}, + (term_pair){`[]:(int)list`, `values:(int)list`}), + pool_rep_def); + thm fold = trans_slrule(pack, eq2ent(sym_rule(close))); + thm closed = trans_slrule(add_authority, fold); + term compact_resources = `${manager:cprop} ** ${authority:cprop}`; + closed = rehant_slrule(closed, compact_resources); return prove_operation_by_entailment( - goal_tm, trans_slrule(trans_slrule(add_manager, pack), close_rep)); + goal_tm, + closed); } decl_operation(fold_empty_pool_operation, - TERM_LIST(`pool:addr`), - term_list_n(1, - `data_at (field_addr (KEY pool) Tfixed_pool Fhead) Tptr (KEY 0i)` + TERM_LIST(`name:num`, `pool:int`), + TERM_LIST( + `data_at + (field_addr (KEY pool) Tfixed_pool Fhead) + Tptr + (KEY 0i)`, + `own + (KEY name) + (KEY + (auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + (finmap_empty:(int,(1)excl)finmap)))` ), term_list_n(0), - `pool_rep pool ([]:(int)list)` + `pool_rep + name + pool + (finmap_empty:(int,(1)excl)finmap) + ([]:(int)list)` ) -PROOF void fold_empty_pool(const term pool) { - apply_operation_st(fold_empty_pool_operation, TERM_LIST(pool)); +PROOF void fixed_pool_init_ghost_and_fold(const term pool) { + term symst = get_symbolic_state(); + term_list branches = strip_binop(sl_or(), symst); + ENSURE_COND( + branches != NULL && vector_size(branches) == 1, + "fixed_pool initialization requires one symbolic-state branch"); + term frame = branches[0]; + + thm framed = viewshift_frame_slrule( + FIXED_POOL_INIT_VIEWSHIFT, + frame); + term body_fn = `\allocated_name:num. + own allocated_name + (auth_auth + (gmap_ra (excl_ra:((1)excl)ra)) + (finmap_empty:(int,(1)excl)finmap))`; + thm pull = beta_rule(ispecl_rule( + TERM_LIST(body_fn, frame), + sl_sep_exists_left())); + thm pull_entailment = eq2ent(pull); + + dest_binop_results pulled = dest_sl_ent(concl(pull_entailment)); + term named_target = pulled.tm2; + dest_binder_results opened = dest_sl_exists(named_target); + term fresh_name = `fixed_pool_name:num`; + term opened_body = subst_one(fresh_name, opened.v, opened.tm); + + thm local_fold = operation_hconv( + fold_empty_pool_operation, + opened_body, + TERM_LIST(fresh_name, pool)); + thm opened_fold = local_apply(opened_body, local_fold); + thm sealed = exists_mono_slrule(fresh_name, opened_fold); + thm target_entailment = trans_slrule( + pull_entailment, + sealed); + + dest_binop_results framed_endpoints = + dest_sl_viewshift(concl(framed)); + thm complete = viewshift_mono_slrule( + refl_slrule(framed_endpoints.tm1), + framed, + target_entailment); + set_symbolic_state(complete); + return; +err: + ERR_FUN_PUTS( + "fixed_pool_init_ghost_and_fold", + cstr_term(pool)); } -/*---------------------- export and trust audit ---------------------*/ - -PROOF int install_fixed_pool_qcp_interface(void) { - static bool installed = false; - if (installed) return 0; - - ENSURE_COND(cst_add_const_to_header( - `pool_free_chain:addr->(int)list->hprop`) == 0, - "Could not export pool_free_chain"); - ENSURE_COND(cst_add_const_to_header( - `pool_rep:addr->(int)list->hprop`) == 0, - "Could not export pool_rep"); - ENSURE_COND(cst_add_const_to_header(`malloc_token:addr->hprop`) == 0, - "Could not export malloc_token"); - installed = true; - return 0; +PROOF void fixed_pool_register_ghost( + const term name, + const term domain, + const term block) { + term premise = mk_comb( + mk_comb(`pool_domain_fresh: + (int,(1)excl)finmap->int->bool`, domain), + block); + thm conditional = ispecl_rule( + TERM_LIST(name, domain, block), + FIXED_POOL_REGISTER_VIEWSHIFT); + thm update = viewshift_elim_fact_slrule( + premise, + undisch_rule(conditional)); + + term symst = get_symbolic_state(); + term_list branches = strip_binop(sl_or(), symst); + ENSURE_COND( + branches != NULL && vector_size(branches) == 1, + "fixed_pool registration requires one symbolic-state branch"); + strip_sl_exists_results opened = strip_sl_exists(branches[0]); + thm complete = viewshift_frame_at_slrule(update, opened.hp); + for (int i = (int)vector_size(opened.vs) - 1; i >= 0; --i) { + complete = gen_rule(opened.vs[i], complete); + complete = viewshift_exists_slrule(complete); + } + set_symbolic_state(complete); + return; err: - ERR_FUN_PUTS("install_fixed_pool_qcp_interface"); - return -1; + ERR_FUN_PUTS( + "fixed_pool_register_ghost", + cstr_term(name), + cstr_term(domain), + cstr_term(block)); } +/* ------------------------------------------------------------------------- */ +/* Trust audit */ +/* ------------------------------------------------------------------------- */ + PROOF static int _FIXED_POOL_AUDIT = audit_closed_proof_unit( - "fixed_pool", FIXED_POOL_AXIOMS_BEFORE, THM_LIST( - pool_free_chain_def, pool_rep_def, malloc_token_def, - unfold_pool_rep_operation.lemma, fold_pool_rep_operation.lemma, - unfold_pool_chain_cons_operation.lemma, - fold_pool_chain_cons_operation.lemma, - unfold_malloc_token_operation.lemma, - fold_malloc_token_operation.lemma, - fold_empty_pool_operation.lemma)); + "fixed_pool_ghost_model", + FIXED_POOL_AXIOMS_BEFORE, + THM_LIST( + pool_domain_extend_def, + pool_domain_fresh_def, + pool_block_seed_def, + malloc_token_def, + pool_free_chain_def, + pool_rep_def, + POOL_DOMAIN_FRESH_EMPTY, + FIXED_POOL_OPTION_OP_NONE_R, + POOL_DOMAIN_FRESH_PAIR, + FIXED_POOL_INIT_VIEWSHIFT, + FIXED_POOL_OWN_SPLIT, + FIXED_POOL_REGISTER_VIEWSHIFT, + unfold_pool_rep_operation.lemma, + fold_pool_rep_operation.lemma, + unfold_pool_chain_cons_operation.lemma, + fold_pool_chain_cons_operation.lemma, + unfold_malloc_token_operation.lemma, + fold_malloc_token_operation.lemma, + unfold_pool_block_seed_operation.lemma, + fold_empty_pool_operation.lemma)); diff --git a/psi_examples/lib/fixed_pool.h b/psi_examples/lib/fixed_pool.h index aaf3dfc20cea75a324cc03509d63de37b208c0b6..7ea383339a85351c1d2ae137456f3f7f4d9291fd 100644 --- a/psi_examples/lib/fixed_pool.h +++ b/psi_examples/lib/fixed_pool.h @@ -1,13 +1,32 @@ #pragma once /* - * A fixed-size, one-bin memory pool inspired by the verified allocator - * architecture in Appel--Naumann. Allocation itself stays with the caller: - * the pool merely transfers ownership of caller-supplied blocks. + * Ghost-aware model for the intrusive fixed-size free-list allocator. + * + * The selected cell algebra is + * + * auth_ra (gmap_ra excl_ra) + * + * where the finite-map key is a block address and the exclusive payload is + * `Excl one`. `pool_rep name pool domain values` owns the physical free-list, + * the unique authority at `name`, and one fragment for every free block. + * `malloc_token name block` transfers exactly the fragment for `block` to the + * client. Consequently `fixed_pool_put` can consume a token only together + * with the invariant carrying the same ordinary logical ghost name. + * + * The concrete head pointer and recursive chain remain private to + * fixed_pool.c. `domain` is logical protocol state: it records every block + * registered with this allocator, not the current free-list contents. */ +#define CSTAR_DEFER_C_LOGIC_INSTALL + +#include "proof/theory/logic/auth_ra.h" +#include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/gmap_ra.h" +#include "proof/theory/logic/unit_ra.h" +#include "userlib/qcp/c_logic.h" #include "userlib/qcp/veriftime.h" -#require "userlib/qcp/veriftime.c" #include "userlib/operational/operational.h" #require "userlib/operational/operational.c" @@ -15,32 +34,75 @@ #include "userlib/operational/proof_patterns.h" #require "userlib/operational/proof_patterns.c" -/* Executable layouts are declared by the PSI-unit header. */ struct fixed_pool_block; struct fixed_pool; -/* Public representation vocabulary. */ -PROOF extern thm pool_free_chain_def; -PROOF extern thm pool_rep_def; -PROOF extern thm malloc_token_def; +/* Closed named payload RA and one-time assertion-model installation. */ +PROOF term fixed_pool_ra_term(void); +PROOF int install_fixed_pool_logic(void); -/* Export the three predicates to a QCP verification root. */ -PROOF int install_fixed_pool_qcp_interface(void); +/* Public logical state constructors. */ +PROOF extern thm pool_domain_extend_def; +PROOF extern thm pool_domain_fresh_def; + +/* `pool_domain_fresh finmap_empty block`. */ +PROOF extern thm POOL_DOMAIN_FRESH_EMPTY; /* - * Meaningful representation steps. The `_as` functions choose stable names - * for the single existential exposed by the corresponding unfold. + * A second distinct address is fresh after registering the first: + * + * ~(first = second) ==> + * pool_domain_fresh + * (pool_domain_extend finmap_empty first) + * second. */ -PROOF void unfold_pool_rep_as(const term pool, const term head_name); -PROOF void fold_pool_rep(const term pool); +PROOF extern thm POOL_DOMAIN_FRESH_PAIR; + +/* Export opaque public predicates and logical-domain operators to QCP. */ +PROOF int install_fixed_pool_qcp_interface(void); + +/* Physical representation operations used by the implementation. */ +PROOF void unfold_pool_rep_as( + const term name, + const term pool, + const term head_name); +PROOF void fold_pool_rep( + const term name, + const term pool, + const term domain); PROOF void unfold_pool_chain_cons_as( - const term block, const term next_name); -PROOF void fold_pool_chain_cons(const term block); + const term name, + const term block, + const term next_name); +PROOF void fold_pool_chain_cons( + const term name, + const term block); PROOF void unfold_malloc_token_as( - const term block, const term old_next_name); -PROOF void fold_malloc_token(const term block); + const term name, + const term block, + const term old_next_name); +PROOF void fold_malloc_token( + const term name, + const term block); -/* Fold a freshly initialized null manager directly to the empty pool. */ -PROOF void fold_empty_pool(const term pool); +PROOF void unfold_pool_block_seed_as( + const term block, + const term old_next_name); + +/* + * Initialize the empty physical list and allocate its authoritative ghost + * cell. The fresh name remains existentially bound around `pool_rep`. + */ +PROOF void fixed_pool_init_ghost_and_fold(const term pool); + +/* + * Register one fresh block. This consumes the `pool_domain_fresh` fact in + * the current symbolic state and preserves every physical resource while + * changing only the ghost projection. + */ +PROOF void fixed_pool_register_ghost( + const term name, + const term domain, + const term block); diff --git a/psi_examples/lib/wand_context.c b/psi_examples/lib/wand_context.c index b9192b7d4a26e6e60de992217e0e290343cf14ec..313088641d157693c922462dcc8dd12fd0120fa7 100644 --- a/psi_examples/lib/wand_context.c +++ b/psi_examples/lib/wand_context.c @@ -9,11 +9,11 @@ PROOF thm append_context_def = cst_new_fun_definition( (ys:(int)list) -|- (wand_listbox box (APPEND rest ys) -* wand_listbox root (APPEND whole ys))`, - `:addr->addr->(int)list->(int)list->(int)list->hprop`); + `:int->int->(int)list->(int)list->(int)list->cprop`); PROOF static thm prove_append_context_open_close(void) { return prove_definitional_law(` - forall box root:addr. forall rest whole ys:(int)list. + forall box root:int. forall rest whole ys:(int)list. append_context box root rest whole ys -|- (wand_listbox box (APPEND rest ys) -* wand_listbox root (APPEND whole ys)) @@ -25,7 +25,7 @@ PROOF thm APPEND_CONTEXT_OPEN_CLOSE = PROOF static thm prove_append_context_finish(void) { gnode root = gnode_new_with_ccl(` - forall box root:addr. forall rest whole ys:(int)list. + forall box root:int. forall rest whole ys:(int)list. rest = [] ==> (wand_listbox box ys ** (wand_listbox box (APPEND rest ys) -* @@ -58,7 +58,7 @@ PROOF void begin_append_context_as( const term root, const term xs, const term ys, const term head_name) { open_wand_listbox_as(root, head_name); - term target = `wand_listbox ${root:addr} + term target = `wand_listbox ${root:int} (APPEND ${xs:(int)list} ${ys:(int)list})`; apply_hconv_st(wand_frame_refl(target)); close_append_context(root, root, xs, xs, ys); @@ -91,7 +91,7 @@ PROOF void finish_append_context( PROOF void normalize_terminal_cursor(const term node) { /* The loop-exit equality is temporary evidence: substitute it exactly and consume the fact instead of leaving it in the reconstructed state. */ - substitute_fact_st(`${node:addr} = 0i`); + substitute_fact_st(`${node:int} = 0i`); } PROOF int install_append_context_qcp_interface(void) { @@ -99,7 +99,7 @@ PROOF int install_append_context_qcp_interface(void) { if (installed) return 0; ENSURE_COND(cst_add_const_to_header( `append_context: - addr->addr->(int)list->(int)list->(int)list->hprop`) == 0, + int->int->(int)list->(int)list->(int)list->cprop`) == 0, "Failed to export append_context"); installed = true; return 0; diff --git a/psi_examples/lib/wand_frame.c b/psi_examples/lib/wand_frame.c index 8bbb591cbc1e890ba607119c7254c2d07e92d084..9170acd8f1c39c5c1032de628435882bca00cffc 100644 --- a/psi_examples/lib/wand_frame.c +++ b/psi_examples/lib/wand_frame.c @@ -184,7 +184,7 @@ PROOF static thm ramify_sltac_valid(thm *children, gnode gn) { } PROOF gnode RAMIFY_SLTAC(const gnode gn, const thm rebuild) { - ENSURE_COND(gn->g.type == SL_GOAL, "Goal is not an SL goal"); + ENSURE_COND(goal_is_sl(gn->g), "Goal is not an SL goal"); ENSURE_COND(is_entailment_between_hprops(rebuild), "Rebuild theorem(`%s`) is not an SL entailment", string_of_thm(rebuild)); @@ -214,6 +214,12 @@ PROOF static bool has_expected_closed_conclusion(const thm rule, } PROOF static int audit_wand_frame_rules(void) { + /* This proof module is generic in the assertion carrier. As a standalone + * verify target it has no selected model, so there is no monomorphic + * instance to audit. Every C-program consumer installs its chosen theory + * before this module is required and exercises the complete audit below. */ + if (!sl_theory_is_installed()) return 0; + term p = mk_sl_prop("P"); term q = mk_sl_prop("Q"); term r = mk_sl_prop("R"); diff --git a/psi_examples/lib/wand_list.c b/psi_examples/lib/wand_list.c index 9bc2abd13ed867861fbe5debdb76c8e5be95ef6d..f16501713757b7ddb6abdda6b615f7069e7ad21a 100644 --- a/psi_examples/lib/wand_list.c +++ b/psi_examples/lib/wand_list.c @@ -65,25 +65,26 @@ PROOF thm wand_list_def = define_fresh_recursive_constant( "wand_list", get_theorem_by_name("list_RECURSION"), ` - ((wand_list:addr->(int)list->hprop) p [] -|- + ((wand_list:int->(int)list->cprop) p [] -|- fact(p = 0i)) && - ((wand_list:addr->(int)list->hprop) p (h :: t) -|- - fact(~(p = 0i)) ** exists q:addr. + ((wand_list:int->(int)list->cprop) p (h :: t) -|- + fact(~(p = 0i)) ** exists q:int. data_at (field_addr p Twand_node Fvalue) Tint h ** data_at (field_addr p Twand_node Fnext) Tptr q ** - wand_list q t) + (wand_list:int->(int)list->cprop) q t) `); PROOF thm wand_listbox_def = define_fresh_function_constant( "wand_listbox", - `wand_listbox box (xs:(int)list) -|- - exists p:addr. data_at box Tptr p ** wand_list p xs`); + `(wand_listbox:int->(int)list->cprop) box (xs:(int)list) -|- + exists p:int. data_at box Tptr p ** + (wand_list:int->(int)list->cprop) p xs`); /*-------------------------- Closed laws ---------------------------*/ PROOF static thm prove_wand_list_nil(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. + forall p:int. wand_list p ([]:(int)list) -|- fact(p = 0i) `); CONV_TAC(root, rewrite_conv(THM_LIST(wand_list_def))); @@ -94,9 +95,9 @@ PROOF thm WAND_LIST_NIL = prove_wand_list_nil(); PROOF static thm prove_wand_list_cons(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall h:int. forall t:(int)list. + forall p:int. forall h:int. forall t:(int)list. wand_list p (h :: t) -|- - fact(~(p = 0i)) ** exists q:addr. + fact(~(p = 0i)) ** exists q:int. data_at (field_addr p Twand_node Fvalue) Tint h ** data_at (field_addr p Twand_node Fnext) Tptr q ** wand_list q t @@ -109,9 +110,9 @@ PROOF thm WAND_LIST_CONS = prove_wand_list_cons(); PROOF static thm prove_wand_listbox_open_close(void) { gnode root = gnode_new_with_ccl(` - forall box:addr. forall xs:(int)list. + forall box:int. forall xs:(int)list. wand_listbox box xs -|- - exists p:addr. data_at box Tptr p ** wand_list p xs + exists p:int. data_at box Tptr p ** wand_list p xs `); CONV_TAC(root, rewrite_conv(THM_LIST(wand_listbox_def))); return gnode_prove(root); @@ -123,7 +124,7 @@ PROOF thm WAND_LISTBOX_OPEN_CLOSE = /* At a null address only the empty constructor is consistent. */ PROOF static thm prove_wand_list_null_shape(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall xs:(int)list. + forall p:int. forall xs:(int)list. p = 0i ==> (wand_list p xs |-- fact(xs = [])) `); gnode g = AUTO_INTROS_TAC(root); @@ -131,7 +132,7 @@ PROOF static thm prove_wand_list_null_shape(void) { g = CONV_WITH_ASMP_TAC( cases[0], simp_conv, THM_LIST(wand_list_def)); CONV_TAC(g, rewrite_conv(THM_LIST( - sl_fact_true_emp(), get_hentail_refl()))); + sl_fact_true_emp(), sl_ent_refl()))); g = CONV_WITH_ASMP_TAC( cases[1], simp_conv, THM_LIST(wand_list_def)); g = AUTO_INIT_SLTAC(g)[0]; @@ -145,10 +146,10 @@ PROOF thm WAND_LIST_NULL_SHAPE = /* At a non-null address expose the unique list constructor and node fields. */ PROOF static thm prove_wand_list_nonnull_shape(void) { gnode root = gnode_new_with_ccl(` - forall p:addr. forall xs:(int)list. + forall p:int. forall xs:(int)list. ~(p = 0i) ==> (wand_list p xs |-- - exists h:int. exists t:(int)list. exists q:addr. + exists h:int. exists t:(int)list. exists q:int. fact(xs = h :: t) ** data_at (field_addr p Twand_node Fvalue) Tint h ** data_at (field_addr p Twand_node Fnext) Tptr q ** @@ -165,7 +166,7 @@ PROOF static thm prove_wand_list_nonnull_shape(void) { cases[1], simp_conv, THM_LIST(wand_list_def)); g = AUTO_INIT_SLTAC(g)[0]; g = LIST_EXISTS_SLTAC( - g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:addr`)); + g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:int`)); gnode_list pure_and_spatial = PURE_SLTAC(g); CONV_TAC(pure_and_spatial[0], rewrite_conv(THM_LIST( refl_rule(`a0 :: (a1:(int)list)`)))); @@ -179,7 +180,7 @@ PROOF thm WAND_LIST_NONNULL_SHAPE = /* Concrete-witness form used by the fold operation. */ PROOF static thm prove_wand_list_fold_cons_at(void) { gnode root = gnode_new_with_ccl(` - forall p q:addr. forall h:int. forall t:(int)list. + forall p q:int. forall h:int. forall t:(int)list. ~(p = 0i) ==> (data_at (field_addr p Twand_node Fvalue) Tint h ** data_at (field_addr p Twand_node Fnext) Tptr q ** @@ -191,7 +192,7 @@ PROOF static thm prove_wand_list_fold_cons_at(void) { g = CONV_SLTAC(g, rewrite_conv(THM_LIST( assume_rule(`~(p = 0i)`), sl_fact_true_emp()))); g = CLEAN_SLTAC(g); - g = EXISTS_SLTAC(g, `q:addr`); + g = EXISTS_SLTAC(g, `q:int`); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } @@ -201,14 +202,14 @@ PROOF thm WAND_LIST_FOLD_CONS_AT = PROOF static thm prove_wand_listbox_close_at(void) { gnode root = gnode_new_with_ccl(` - forall box p:addr. forall xs:(int)list. + forall box p:int. forall xs:(int)list. (data_at box Tptr p ** wand_list p xs |-- wand_listbox box xs) `); gnode g = AUTO_INTROS_TAC(root); g = CONV_TAC(g, once_rewrite_conv(THM_LIST(wand_listbox_def))); g = AUTO_INIT_SLTAC(g)[0]; - g = EXISTS_SLTAC(g, `p:addr`); + g = EXISTS_SLTAC(g, `p:int`); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } @@ -225,7 +226,7 @@ PROOF static thm open_wand_list_null_operation_proof( } decl_operation(open_wand_list_null_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `wand_list (KEY p) (CAPTURE xs)`), term_list_n(1, `p = 0i`), `fact((xs:(int)list) = [])` @@ -242,10 +243,10 @@ PROOF static thm open_wand_list_nonnull_operation_proof( } decl_operation(open_wand_list_nonnull_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `wand_list (KEY p) (CAPTURE xs)`), term_list_n(1, `~(p = 0i)`), - `exists h:int. exists t:(int)list. exists q:addr. + `exists h:int. exists t:(int)list. exists q:int. fact(xs = h :: t) ** data_at (field_addr p Twand_node Fvalue) Tint h ** data_at (field_addr p Twand_node Fnext) Tptr q ** @@ -271,7 +272,7 @@ PROOF static thm close_wand_list_nil_operation_proof( } decl_operation(close_wand_list_nil_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), term_list_n(1, `fact(KEY (p = 0i))`), term_list_n(0), `wand_list p []` @@ -288,7 +289,7 @@ PROOF static thm close_wand_list_cons_operation_proof( } decl_operation(close_wand_list_cons_operation, - TERM_LIST(`p:addr`), + TERM_LIST(`p:int`), TERM_LIST( `data_at (field_addr (KEY p) Twand_node Fvalue) Tint (CAPTURE h)`, `data_at (field_addr (KEY p) Twand_node Fnext) Tptr (CAPTURE q)`, @@ -309,10 +310,10 @@ PROOF static thm open_wand_listbox_operation_proof( } decl_operation(open_wand_listbox_operation, - TERM_LIST(`box:addr`), + TERM_LIST(`box:int`), term_list_n(1, `wand_listbox (KEY box) (CAPTURE xs)`), term_list_n(0), - `exists p:addr. data_at box Tptr p ** wand_list p xs` + `exists p:int. data_at box Tptr p ** wand_list p xs` ) PROOF void open_wand_listbox(const term box) { @@ -334,7 +335,7 @@ PROOF static thm close_wand_listbox_operation_proof( } decl_operation(close_wand_listbox_operation, - TERM_LIST(`box:addr`), + TERM_LIST(`box:int`), TERM_LIST( `data_at (KEY box) Tptr (CAPTURE p)`, `wand_list (KEY p) (CAPTURE xs)` @@ -371,8 +372,8 @@ PROOF int install_wand_list_qcp_interface(void) { ENSURE_COND( export_wand_list_qcp_constants(TERM_LIST( `APPEND:(int)list->(int)list->(int)list`, - `wand_list:addr->(int)list->hprop`, - `wand_listbox:addr->(int)list->hprop`)) == 0, + `wand_list:int->(int)list->cprop`, + `wand_listbox:int->(int)list->cprop`)) == 0, "Failed to install the wand-list QCP interface"); installed = true; diff --git a/psi_examples/lib/wand_list.h b/psi_examples/lib/wand_list.h index f7822400db528a63f5cf44fce616689a1ce4f658..839e8b2f7e5df15d4db06b3b61e0c686a43ddc39 100644 --- a/psi_examples/lib/wand_list.h +++ b/psi_examples/lib/wand_list.h @@ -9,6 +9,9 @@ * CAPTURE. */ +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + #include "userlib/operational/operational.h" #require "userlib/operational/operational.c" diff --git a/psi_examples/logical_resources/allocator/allocator.c b/psi_examples/logical_resources/allocator/allocator.c new file mode 100644 index 0000000000000000000000000000000000000000..fbbac00f560589d8d98c62a74abf90fe5e316db5 --- /dev/null +++ b/psi_examples/logical_resources/allocator/allocator.c @@ -0,0 +1,88 @@ +/* + * cstarc verifies a same-stem implementation as an independent root. Keep + * the executable layout here; clients obtain the identical declarations from + * allocator.h. + */ +struct lr_block { + int payload; + int private_token; +}; + +struct lr_allocator { + struct lr_block *slot; +}; + +#define LR_ALLOCATOR_LAYOUT_DEFINED +#include "psi_examples/logical_resources/allocator/allocator.h" + +#include "psi_examples/logical_resources/allocator/allocator_internal.h" +#require "psi_examples/logical_resources/allocator/allocator_internal.c" + +// verify_all: expect-vcs=0 + +void lr_allocator_init( + struct lr_allocator *allocator, struct lr_block *block) + LR_ALLOCATOR_INIT_SPEC +{ + /* Materialize the private linear token, then seal the complete block. */ + PROOF lr_unfold_allocator_seed( + `allocator__pre:int`, + `block__pre:int`); + block->private_token = 0; + allocator->slot = block; + + /* Allocate a fresh ghost cell and seal physical and logical ownership in + * one complete-state view shift. */ + PROOF lr_allocator_init_ghost_and_fold( + `allocator__pre:int`, + `block__pre:int`); +} + +struct lr_block *lr_allocator_malloc(struct lr_allocator *allocator) + LR_ALLOCATOR_MALLOC_SPEC +{ + /* The private opening operation exposes exactly the available phase. */ + PROOF lr_unfold_allocator_ready_as( + `allocator__pre:int`, + `free_block:int`, + `payload_value:int`, + `ghost_name:num`, + `private_stamp:int`); + + struct lr_block *block = allocator->slot; + allocator->slot = (void *)0; + + /* The ghost cell changes phase without changing physical memory. Seal the + * phase-F cell and private stamp into the abstract client token. */ + PROOF { + lr_allocator_malloc_ghost_update( + `allocator__pre:int`, `free_block:int`, `ghost_name:num`); + lr_fold_malloc_token( + `allocator__pre:int`, `free_block:int`); + lr_fold_allocator_busy(`allocator__pre:int`); + lr_allocator_prune_private_witnesses(); + } + return block; +} + +void lr_allocator_free( + struct lr_allocator *allocator, struct lr_block *block) + LR_ALLOCATOR_FREE_SPEC +{ + /* Busy owns only the null slot; the call supplies block and token. */ + PROOF { + lr_unfold_allocator_busy(`allocator__pre:int`); + lr_unfold_malloc_token_as( + `allocator__pre:int`, + `block__pre:int`, + `ghost_name:num`, + `private_stamp:int`); + } + allocator->slot = block; + PROOF { + lr_allocator_free_ghost_update( + `allocator__pre:int`, `block__pre:int`, `ghost_name:num`); + lr_fold_allocator_ready(`allocator__pre:int`); + lr_allocator_prune_private_witnesses(); + } +} diff --git a/psi_examples/logical_resources/allocator/allocator.h b/psi_examples/logical_resources/allocator/allocator.h new file mode 100644 index 0000000000000000000000000000000000000000..ae91cb0e9e616e1a37bc9be98315537785b84b0f --- /dev/null +++ b/psi_examples/logical_resources/allocator/allocator.h @@ -0,0 +1,53 @@ +#pragma once + +/* Modular public C interface for the one-slot allocator example. */ + +#include "psi_examples/logical_resources/allocator/allocator_model.h" +#require "psi_examples/logical_resources/allocator/allocator_model.c" + +/* The module client sees no executable representation fields. */ +struct lr_block; +struct lr_allocator; + +/* + * Bootstrap ownership is opaque. Initialization allocates a fresh ghost cell + * and seals it, together with the physical block, into the available + * invariant. + */ +#define LR_ALLOCATOR_INIT_SPEC \ + PARAM(`payload_value:int`) \ + REQUIRE(`lr_allocator_seed allocator block payload_value`) \ + ENSURE(`lr_allocator_inv allocator T`) + +void lr_allocator_init( + struct lr_allocator *allocator, struct lr_block *block) + LR_ALLOCATOR_INIT_SPEC; + +/* The invariant is threaded linearly from available to checked-out. The + * returned token is a combined physical/ghost assertion. */ +#define LR_ALLOCATOR_MALLOC_SPEC \ + REQUIRE(`lr_allocator_inv allocator T`) \ + ENSURE_EX(TERM_LIST(`payload_value:int`), \ + `lr_allocator_inv allocator F`, \ + `lr_block_payload __return payload_value`, \ + `lr_malloc_token allocator __return`, \ + `fact(~(__return = 0i))`) + +struct lr_block *lr_allocator_malloc(struct lr_allocator *allocator) + LR_ALLOCATOR_MALLOC_SPEC; + +/* Both block ownership and the combined linear token are required for + * deallocation. The token is consumed when its ghost cell returns to the + * invariant's ready phase. */ +#define LR_ALLOCATOR_FREE_SPEC \ + PARAM(`payload_value:int`) \ + REQUIRE( \ + `lr_allocator_inv allocator F`, \ + `lr_block_payload block payload_value`, \ + `lr_malloc_token allocator block`, \ + `fact(~(block = 0i))`) \ + ENSURE(`lr_allocator_inv allocator T`) + +void lr_allocator_free( + struct lr_allocator *allocator, struct lr_block *block) + LR_ALLOCATOR_FREE_SPEC; diff --git a/psi_examples/logical_resources/allocator/allocator_internal.c b/psi_examples/logical_resources/allocator/allocator_internal.c new file mode 100644 index 0000000000000000000000000000000000000000..64e905350eedba0aedf76f4f4ad9493235ffb59f --- /dev/null +++ b/psi_examples/logical_resources/allocator/allocator_internal.c @@ -0,0 +1,541 @@ +#include "psi_examples/logical_resources/allocator/allocator_internal.h" + +#include "userlib/operational/operational.h" +#require "userlib/operational/operational.c" + +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" + +#include "userlib/proof/probes.h" +#require "userlib/proof/probes.c" + +#require "psi_examples/logical_resources/allocator/allocator_model.c" + +PROOF static size_t LR_ALLOCATOR_INTERNAL_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +/* Initialization composes allocation with this later private fold schema. */ +PROOF extern operation lr_fold_allocator_ready_operation; + +/* Specialize and reduce the phase-indexed invariant once. */ +PROOF static thm lr_allocator_inv_phase_law( + const term allocator, + const term phase) { + thm law = inst_rule( + TERM_PAIR_LIST( + (term_pair){allocator, `allocator:int`}, + (term_pair){phase, `available:bool`}), + lr_allocator_inv_def); + thm cond_clauses = get_theorem_by_name("COND_CLAUSES"); + thm result = rewrite_rule(THM_LIST(cond_clauses), law); + return result; +} + +/*------------------------- bootstrap seed -------------------------*/ + +PROOF static thm lr_unfold_allocator_seed_operation_proof( + const term goal_tm) { + thm unfolding = eq2ent(lr_allocator_seed_def); + thm result = prove_operation_by_entailment(goal_tm, unfolding); + return result; +} + +decl_operation(lr_unfold_allocator_seed_operation, + TERM_LIST(`allocator:int`, `block:int`), + term_list_n(1, + `lr_allocator_seed + (KEY allocator) + (KEY block) + (CAPTURE payload_value)`), + term_list_n(0), + `undef_data_at + (field_addr allocator Tlr_allocator Fslot) Tptr ** + lr_block_payload block payload_value ** + undef_data_at + (field_addr block Tlr_block Fprivate_token) Tint ** + fact(~(block = 0i))` +) + +PROOF void lr_unfold_allocator_seed( + const term allocator, + const term block) { + apply_operation_st( + lr_unfold_allocator_seed_operation, + TERM_LIST(allocator, block)); +} + +/* Allocate a cell from emp, frame the exact current physical state, pull the + * fresh name across SEP, and immediately seal the opened resources into the + * abstract ready invariant. The final target contains neither a sidecar nor + * a free/private ghost name. */ +PROOF void lr_allocator_init_ghost_and_fold( + const term allocator, + const term block) { + term symst = get_symbolic_state(); + term disjunction = sl_or(); + term_list branches = strip_binop(disjunction, symst); + ENSURE_COND( + branches != NULL, + "Allocator initialization produced no branch vector"); + ENSURE_COND( + vector_size(branches) == 1, + "Allocator initialization requires one symbolic-state branch"); + term frame = branches[0]; + + thm allocate = ispecl_rule( + TERM_LIST(allocator, block), + LR_ALLOCATOR_LOGICAL_INIT); + thm framed = viewshift_frame_slrule(allocate, frame); + + term body_fn = ` + \allocated_name:num. + own allocated_name + (Excl ((${allocator:int},${block:int}),T))`; + thm sep_exists_left = sl_sep_exists_left(); + thm specialized_pull = ispecl_rule( + TERM_LIST(body_fn, frame), + sep_exists_left); + thm pull = beta_rule(specialized_pull); + thm pull_ent = eq2ent(pull); + + term pull_conclusion = concl(pull_ent); + dest_binop_results pulled_endpoints = dest_sl_ent(pull_conclusion); + term named_target = pulled_endpoints.tm2; + dest_binder_results opened = dest_sl_exists(named_target); + term fresh_name = `lr_allocated_name:num`; + term opened_body = subst_one(fresh_name, opened.v, opened.tm); + + thm local_fold = operation_hconv( + lr_fold_allocator_ready_operation, + opened_body, + TERM_LIST(allocator)); + thm opened_fold = local_apply(opened_body, local_fold); + thm sealed = choose_slrule(fresh_name, named_target, opened_fold); + thm post = trans_slrule(pull_ent, sealed); + + term framed_conclusion = concl(framed); + dest_binop_results framed_endpoints = dest_sl_viewshift(framed_conclusion); + thm source_refl = refl_slrule(framed_endpoints.tm1); + thm complete = viewshift_mono_slrule( + source_refl, + framed, + post); + set_symbolic_state(complete); + return; +err: + ERR_FUN_PUTS( + "lr_allocator_init_ghost_and_fold", + cstr_term(allocator), + cstr_term(block)); + return; +} + +/*------------------------- malloc token ---------------------------*/ + +PROOF static thm lr_fold_malloc_token_operation_proof( + const term goal_tm) { + term resources = ` + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),F))`; + term packed_stamp = ` + exists stamp. + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),F))`; + term packed = ` + exists name. + exists stamp. + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),F))`; + + thm resources_refl = refl_slrule(resources); + thm pack = exists_slrule( + packed_stamp, + `stamp:int`, + resources_refl); + pack = exists_slrule(packed, `name:num`, pack); + thm token_def_backwards = sym_rule(lr_malloc_token_def); + thm fold_token = eq2ent(token_def_backwards); + thm packing = trans_slrule(pack, fold_token); + thm result = prove_operation_by_entailment(goal_tm, packing); + return result; +} + +decl_operation(lr_fold_malloc_token_operation, + TERM_LIST(`allocator:int`, `block:int`), + TERM_LIST( + `data_at + (field_addr (KEY block) Tlr_block Fprivate_token) + Tint + (CAPTURE stamp)`, + `own + (CAPTURE name) + (KEY (Excl ((allocator,block),F)))` + ), + term_list_n(0), + `lr_malloc_token allocator block` +) + +PROOF void lr_fold_malloc_token( + const term allocator, + const term block) { + apply_operation_st( + lr_fold_malloc_token_operation, + TERM_LIST(allocator, block)); +} + +PROOF static thm lr_unfold_malloc_token_operation_proof( + const term goal_tm) { + thm unfolding = eq2ent(lr_malloc_token_def); + thm result = prove_operation_by_entailment(goal_tm, unfolding); + return result; +} + +decl_operation(lr_unfold_malloc_token_operation, + TERM_LIST(`allocator:int`, `block:int`), + term_list_n(1, `lr_malloc_token (KEY allocator) (KEY block)`), + term_list_n(0), + `exists name. + exists stamp. + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),F))` +) + +PROOF void lr_unfold_malloc_token_as( + const term allocator, + const term block, + const term name_name, + const term stamp_name) { + apply_operation_named_st( + lr_unfold_malloc_token_operation, + TERM_LIST(allocator, block), + TERM_LIST(name_name, stamp_name)); +} + +/*---------------------- available invariant ----------------------*/ + +PROOF static thm lr_unfold_allocator_ready_operation_proof( + const term goal_tm) { + thm expanded = lr_allocator_inv_phase_law( + `allocator:int`, `(T:bool)`); + thm unfolding = eq2ent(expanded); + thm result = prove_operation_by_entailment(goal_tm, unfolding); + return result; +} + +decl_operation(lr_unfold_allocator_ready_operation, + TERM_LIST(`allocator:int`), + term_list_n(1, `lr_allocator_inv (KEY allocator) T`), + term_list_n(0), + `exists block. + exists payload_value. + exists name. + exists stamp. + fact(~(block = 0i)) ** + data_at + (field_addr allocator Tlr_allocator Fslot) Tptr block ** + lr_block_payload block payload_value ** + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),T))` +) + +PROOF void lr_unfold_allocator_ready_as( + const term allocator, + const term block_name, + const term payload_name, + const term name_name, + const term stamp_name) { + apply_operation_named_st( + lr_unfold_allocator_ready_operation, + TERM_LIST(allocator), + TERM_LIST(block_name, payload_name, name_name, stamp_name)); +} + +PROOF static thm lr_fold_allocator_ready_operation_proof( + const term goal_tm) { + term resources = ` + data_at + (field_addr allocator Tlr_allocator Fslot) Tptr block ** + lr_block_payload block payload_value ** + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),T))`; + term packed_stamp = ` + exists stamp. + fact(~(block = 0i)) ** + data_at + (field_addr allocator Tlr_allocator Fslot) Tptr block ** + lr_block_payload block payload_value ** + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),T))`; + term packed_name = ` + exists name. + exists stamp. + fact(~(block = 0i)) ** + data_at + (field_addr allocator Tlr_allocator Fslot) Tptr block ** + lr_block_payload block payload_value ** + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),T))`; + term packed_payload = ` + exists payload_value. + exists name. + exists stamp. + fact(~(block = 0i)) ** + data_at + (field_addr allocator Tlr_allocator Fslot) Tptr block ** + lr_block_payload block payload_value ** + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),T))`; + term packed = ` + exists block. + exists payload_value. + exists name. + exists stamp. + fact(~(block = 0i)) ** + data_at + (field_addr allocator Tlr_allocator Fslot) Tptr block ** + lr_block_payload block payload_value ** + data_at + (field_addr block Tlr_block Fprivate_token) Tint stamp ** + own name (Excl ((allocator,block),T))`; + + thm block_nonnull = assume_rule(`~(block = 0i)`); + thm resources_refl = refl_slrule(resources); + thm pack = intro_fact_slrule(block_nonnull, resources_refl); + pack = exists_slrule(packed_stamp, `stamp:int`, pack); + pack = exists_slrule(packed_name, `name:num`, pack); + pack = exists_slrule( + packed_payload, + `payload_value:int`, + pack); + pack = exists_slrule(packed, `block:int`, pack); + + thm expanded = lr_allocator_inv_phase_law( + `allocator:int`, `(T:bool)`); + thm expanded_backwards = sym_rule(expanded); + thm folding = eq2ent(expanded_backwards); + thm packing = trans_slrule(pack, folding); + thm result = prove_operation_by_entailment(goal_tm, packing); + return result; +} + +decl_operation(lr_fold_allocator_ready_operation, + TERM_LIST(`allocator:int`), + TERM_LIST( + `data_at + (field_addr (KEY allocator) Tlr_allocator Fslot) + Tptr + (CAPTURE block)`, + `lr_block_payload + (KEY block) + (CAPTURE payload_value)`, + `data_at + (field_addr (KEY block) Tlr_block Fprivate_token) + Tint + (CAPTURE stamp)`, + `own + (CAPTURE name) + (KEY (Excl ((allocator,block),T)))` + ), + term_list_n(1, `~(block = 0i)`), + `lr_allocator_inv allocator T` +) + +PROOF void lr_fold_allocator_ready(const term allocator) { + apply_operation_st( + lr_fold_allocator_ready_operation, + TERM_LIST(allocator)); +} + +/*------------------------ busy invariant --------------------------*/ + +PROOF static thm lr_unfold_allocator_busy_operation_proof( + const term goal_tm) { + thm expanded = lr_allocator_inv_phase_law( + `allocator:int`, `(F:bool)`); + thm unfolding = eq2ent(expanded); + thm result = prove_operation_by_entailment(goal_tm, unfolding); + return result; +} + +decl_operation(lr_unfold_allocator_busy_operation, + TERM_LIST(`allocator:int`), + term_list_n(1, `lr_allocator_inv (KEY allocator) F`), + term_list_n(0), + `data_at + (field_addr allocator Tlr_allocator Fslot) Tptr 0i` +) + +PROOF void lr_unfold_allocator_busy(const term allocator) { + apply_operation_st( + lr_unfold_allocator_busy_operation, + TERM_LIST(allocator)); +} + +PROOF static thm lr_fold_allocator_busy_operation_proof( + const term goal_tm) { + thm expanded = lr_allocator_inv_phase_law( + `allocator:int`, `(F:bool)`); + thm expanded_backwards = sym_rule(expanded); + thm folding = eq2ent(expanded_backwards); + thm result = prove_operation_by_entailment(goal_tm, folding); + return result; +} + +decl_operation(lr_fold_allocator_busy_operation, + TERM_LIST(`allocator:int`), + term_list_n(1, + `data_at + (field_addr (KEY allocator) Tlr_allocator Fslot) + Tptr + (KEY 0i)`), + term_list_n(0), + `lr_allocator_inv allocator F` +) + +PROOF void lr_fold_allocator_busy(const term allocator) { + apply_operation_st( + lr_fold_allocator_busy_operation, + TERM_LIST(allocator)); +} + +/*------------------------- ghost phase update ---------------------*/ + +PROOF static void lr_allocator_apply_ghost_update( + const term allocator, + const term block, + const term name, + const thm protocol) { + term symst = get_symbolic_state(); + term disjunction = sl_or(); + term_list branches = strip_binop(disjunction, symst); + ENSURE_COND( + branches != NULL, + "Allocator ghost update produced no branch vector"); + ENSURE_COND( + vector_size(branches) == 1, + "Allocator ghost update requires one symbolic-state branch"); + + strip_sl_exists_results opened = strip_sl_exists(branches[0]); + thm cell_update = ispecl_rule( + TERM_LIST(allocator, block, name), + protocol); + + /* Extract exactly the selected own atom from the opened branch and preserve + * every other occurrence as its certified linear frame. */ + thm complete = viewshift_frame_at_slrule(cell_update, opened.hp); + + /* Reconstruct the original outer-to-inner existential prefix. GEN makes + * each currently free witness pointwise; the derived rule then lifts that + * pointwise view shift through the matching SL existential. */ + for (int i = (int)vector_size(opened.vs) - 1; i >= 0; --i) { + complete = gen_rule(opened.vs[i], complete); + complete = viewshift_exists_slrule(complete); + } + + set_symbolic_state(complete); + return; +err: + ERR_FUN_PUTS( + "lr_allocator_apply_ghost_update", + cstr_term(allocator), + cstr_term(block), + cstr_term(name), + cstr_thm(protocol)); + return; +} + +PROOF void lr_allocator_malloc_ghost_update( + const term allocator, + const term block, + const term name) { + lr_allocator_apply_ghost_update( + allocator, + block, + name, + LR_ALLOCATOR_LOGICAL_MALLOC); +} + +PROOF void lr_allocator_free_ghost_update( + const term allocator, + const term block, + const term name) { + lr_allocator_apply_ghost_update( + allocator, + block, + name, + LR_ALLOCATOR_LOGICAL_FREE); +} + +/*------------------ private-witness normalization -----------------*/ + +PROOF static thm lr_prune_unused_exists_hconv(const term symhp) { + bool active_sl_prop = is_sl_prop(symhp); + ENSURE_COND( + active_sl_prop, + "Allocator state is not an active separation-logic proposition"); + bool has_outer_exists = is_sl_exists(symhp); + if (!has_outer_exists) { + thm identity = refl_slrule(symhp); + return identity; + } + + dest_binder_results outer = dest_sl_exists(symhp); + thm inner = lr_prune_unused_exists_hconv(outer.tm); + term inner_conclusion = concl(inner); + dest_binop_results inner_endpoints = dest_sl_ent(inner_conclusion); + term consequent = inner_endpoints.tm2; + bool binder_used = var_free_in(outer.v, consequent); + if (binder_used) { + thm preserved = exists_mono_slrule(outer.v, inner); + return preserved; + } + thm removed = choose_slrule(outer.v, symhp, inner); + return removed; +err: + ERR_FUN_PUTS("lr_prune_unused_exists_hconv", cstr_term(symhp)); + return empty_theorem; +} + +PROOF void lr_allocator_prune_private_witnesses(void) { + term symst = get_symbolic_state(); + term disjunction = sl_or(); + term_list branches = strip_binop(disjunction, symst); + ENSURE_COND( + branches != NULL, + "Allocator witness pruning produced no branch vector"); + thm_list normalized = (thm_list)vector_create(); + ENSURE_COND( + normalized != NULL, + "Could not allocate allocator witness-normalization results"); + for (size_t i = 0; i < vector_size(branches); ++i) { + thm branch = lr_prune_unused_exists_hconv(branches[i]); + vector_add(&normalized, branch); + } + thm transition = list_disj_mono_slrule(normalized); + set_symbolic_state(transition); + return; +err: + ERR_FUN_PUTS("lr_allocator_prune_private_witnesses"); + return; +} + +PROOF static int _LR_ALLOCATOR_INTERNAL_AUDIT = audit_closed_proof_unit( + "logical_resource_allocator_internal", + LR_ALLOCATOR_INTERNAL_AXIOMS_BEFORE, + THM_LIST( + lr_unfold_allocator_seed_operation.lemma, + lr_fold_malloc_token_operation.lemma, + lr_unfold_malloc_token_operation.lemma, + lr_unfold_allocator_ready_operation.lemma, + lr_fold_allocator_ready_operation.lemma, + lr_unfold_allocator_busy_operation.lemma, + lr_fold_allocator_busy_operation.lemma)); diff --git a/psi_examples/logical_resources/allocator/allocator_internal.h b/psi_examples/logical_resources/allocator/allocator_internal.h new file mode 100644 index 0000000000000000000000000000000000000000..4de4621b4b1cd421cf0ad9b8a702d8e323d871ec --- /dev/null +++ b/psi_examples/logical_resources/allocator/allocator_internal.h @@ -0,0 +1,58 @@ +#pragma once + +/* Private representation API used only by allocator.c. */ + +#include "psi_examples/logical_resources/allocator/allocator_model.h" + +/* These representation equations are deliberately absent from the public + * model header. */ +PROOF extern thm lr_block_payload_def; +PROOF extern thm lr_allocator_seed_def; +PROOF extern thm lr_malloc_token_def; +PROOF extern thm lr_allocator_inv_def; + +PROOF void lr_unfold_allocator_seed( + const term allocator, + const term block); + +/* Allocate the fresh phase-T cell, frame the current physical resources, and + * seal the result directly into the ready invariant. */ +PROOF void lr_allocator_init_ghost_and_fold( + const term allocator, + const term block); + +PROOF void lr_fold_malloc_token( + const term allocator, + const term block); +PROOF void lr_unfold_malloc_token_as( + const term allocator, + const term block, + const term name_name, + const term stamp_name); + +PROOF void lr_unfold_allocator_ready_as( + const term allocator, + const term block_name, + const term payload_name, + const term name_name, + const term stamp_name); +PROOF void lr_fold_allocator_ready(const term allocator); + +PROOF void lr_unfold_allocator_busy(const term allocator); +PROOF void lr_fold_allocator_busy(const term allocator); + +/* Apply the phase transition to the installed `own` atom in the complete + * current symbolic state, preserving every physical resource and existential + * binder. */ +PROOF void lr_allocator_malloc_ghost_update( + const term allocator, + const term block, + const term name); +PROOF void lr_allocator_free_ghost_update( + const term allocator, + const term block, + const term name); + +/* Remove existential binders made vacuous by sealing private witnesses into + * an abstract predicate. */ +PROOF void lr_allocator_prune_private_witnesses(void); diff --git a/psi_examples/logical_resources/allocator/allocator_model.c b/psi_examples/logical_resources/allocator/allocator_model.c new file mode 100644 index 0000000000000000000000000000000000000000..b5b88f507e12dbb199881409f8cbf1f247f01083 --- /dev/null +++ b/psi_examples/logical_resources/allocator/allocator_model.c @@ -0,0 +1,212 @@ +#include "psi_examples/logical_resources/allocator/allocator_model.h" + +#include "userlib/proof/probes.h" +#require "userlib/proof/probes.c" + +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" + +#require "userlib/qcp/veriftime.c" +#require "proof/theory/logic/excl_ra.c" +#require "userlib/qcp/c_logic.c" + +PROOF static size_t LR_ALLOCATOR_MODEL_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF term lr_allocator_ra_term(void) { + return `excl_ra:((((int#int)#bool)excl))ra`; +} + +PROOF int install_lr_allocator_logic(void) { + static bool installed = false; + if (installed) return 0; + + /* `c_logic_install_named` queues the closed `own` constant for QCP. Its + * payload carrier + * codec must therefore precede that call in the deferred replay order. */ + ENSURE_COND( + cst_add_type_to_header("excl", 1) == 0, + "Could not export the allocator excl payload type"); + ENSURE_COND( + cst_add_const_to_header(`ExclUnit:(A)excl`) == 0, + "Could not export ExclUnit"); + ENSURE_COND( + cst_add_const_to_header(`Excl:A->(A)excl`) == 0, + "Could not export Excl"); + ENSURE_COND( + cst_add_const_to_header(`ExclInvalid:(A)excl`) == 0, + "Could not export ExclInvalid"); + ENSURE_COND( + c_logic_install_named(lr_allocator_ra_term()) == 0, + "Could not install the allocator C logic"); + + installed = true; + return 0; +err: + ERR_FUN_PUTS("install_lr_allocator_logic"); + return -1; +} + +/* The carrier codec and selected assertion operators must exist before any + * abstract predicate is defined or queued for QCP. */ +PROOF static int _LR_ALLOCATOR_LOGIC = install_lr_allocator_logic(); + +/* Layout constants occur only in the private representation equations. */ +PROOF static int _Tlr_block = + new_const_safe("Tlr_block", `:struct_name`); +PROOF static int _Tlr_allocator = + new_const_safe("Tlr_allocator", `:struct_name`); +PROOF static int _Fpayload = + new_const_safe("Fpayload", `:field`); +PROOF static int _Fprivate_token = + new_const_safe("Fprivate_token", `:field`); +PROOF static int _Fslot = + new_const_safe("Fslot", `:field`); + +/* All four constants below return the selected complete resource assertion + * + * (((int,(pmem_byte_state)excl)finmap) # + * (num,(((int#int)#bool)excl))finmap) -> bool. + * + * `cst_new_fun_definition` exports exactly these monomorphic Prop_G types to + * QCP, where each abstract application is preserved as an opaque atom. */ +PROOF thm lr_block_payload_def = cst_new_fun_definition( + "lr_block_payload", + `lr_block_payload block payload_value -|- + data_at + (field_addr block Tlr_block Fpayload) + Tint + payload_value`, + `:int->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int#int)#bool)excl))finmap)->bool`); + +PROOF thm lr_allocator_seed_def = cst_new_fun_definition( + "lr_allocator_seed", + `lr_allocator_seed allocator block payload_value -|- + undef_data_at + (field_addr allocator Tlr_allocator Fslot) Tptr ** + lr_block_payload block payload_value ** + undef_data_at + (field_addr block Tlr_block Fprivate_token) Tint ** + fact(~(block = 0i))`, + `:int->int->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int#int)#bool)excl))finmap)->bool`); + +/* A checked-out token combines a real private C cell with ownership of the + * same private ghost cell in phase F. Both the name and stamp remain hidden. */ +PROOF thm lr_malloc_token_def = cst_new_fun_definition( + "lr_malloc_token", + `lr_malloc_token allocator block -|- + exists name. + exists stamp. + data_at + (field_addr block Tlr_block Fprivate_token) + Tint + stamp ** + own name (Excl ((allocator,block),F))`, + `:int->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int#int)#bool)excl))finmap)->bool`); + +/* + * Ready owns the complete block and its phase-T ghost cell. Busy owns only + * the null slot: payload, private stamp, and the phase-F ghost cell have moved + * linearly to the client's block/token resources. + */ +PROOF thm lr_allocator_inv_def = cst_new_fun_definition( + "lr_allocator_inv", + `lr_allocator_inv allocator available -|- + if available then + exists block. + exists payload_value. + exists name. + exists stamp. + fact(~(block = 0i)) ** + data_at + (field_addr allocator Tlr_allocator Fslot) + Tptr + block ** + lr_block_payload block payload_value ** + data_at + (field_addr block Tlr_block Fprivate_token) + Tint + stamp ** + own name (Excl ((allocator,block),T)) + else + data_at + (field_addr allocator Tlr_allocator Fslot) + Tptr + 0i`, + `:int->bool-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int#int)#bool)excl))finmap)->bool`); + +/* ------------------------------------------------------------------------- */ +/* Selected complete-assertion protocol */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_lr_allocator_logical_init(void) { + term payload = ` + Excl (((allocator:int),(block:int)),(T:bool)): + (((int#int)#bool)excl)`; + thm valid = ispec_rule( + `(((allocator:int),(block:int)),(T:bool))`, + excl_ra_valid_owned); + thm allocated = mp_rule( + ispecl_rule( + TERM_LIST(payload, sl_emp()), + c_logic_current()->ghost_own_alloc), + valid); + allocated = pure_rewrite_rule(THM_LIST(sl_sep_emp_right()), allocated); + allocated = gen_rule(`block:int`, allocated); + return gen_rule(`allocator:int`, allocated); +} + +PROOF thm LR_ALLOCATOR_LOGICAL_INIT = + prove_lr_allocator_logical_init(); + +PROOF static thm lr_allocator_phase_update( + const term before, + const term after) { + term before_pair = ` + (((allocator:int),(block:int)),${before:bool})`; + term after_pair = ` + (((allocator:int),(block:int)),${after:bool})`; + term before_payload = ` + Excl ${before_pair:((int#int)#bool)}:(((int#int)#bool)excl)`; + term after_payload = ` + Excl ${after_pair:((int#int)#bool)}:(((int#int)#bool)excl)`; + thm payload_update = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(before_pair, after_payload), + excl_ra_update_owned_iff)), + ispec_rule(after_pair, excl_ra_valid_owned)); + thm selected_update = mp_rule( + ispecl_rule( + TERM_LIST(`name:num`, before_payload, after_payload), + c_logic_current()->ghost_own_update), + payload_update); + selected_update = gen_rule(`name:num`, selected_update); + selected_update = gen_rule(`block:int`, selected_update); + return gen_rule(`allocator:int`, selected_update); +} + +PROOF thm LR_ALLOCATOR_LOGICAL_MALLOC = + lr_allocator_phase_update(`(T:bool)`, `(F:bool)`); + +PROOF thm LR_ALLOCATOR_LOGICAL_FREE = + lr_allocator_phase_update(`(F:bool)`, `(T:bool)`); + +PROOF static int _LR_ALLOCATOR_MODEL_AUDIT = audit_closed_proof_unit( + "logical_resource_allocator_model", + LR_ALLOCATOR_MODEL_AXIOMS_BEFORE, + THM_LIST( + lr_block_payload_def, + lr_allocator_seed_def, + lr_malloc_token_def, + lr_allocator_inv_def, + LR_ALLOCATOR_LOGICAL_INIT, + LR_ALLOCATOR_LOGICAL_MALLOC, + LR_ALLOCATOR_LOGICAL_FREE)); diff --git a/psi_examples/logical_resources/allocator/allocator_model.h b/psi_examples/logical_resources/allocator/allocator_model.h new file mode 100644 index 0000000000000000000000000000000000000000..04101fa9c7686e8ced08771688e0b2709f3f7244 --- /dev/null +++ b/psi_examples/logical_resources/allocator/allocator_model.h @@ -0,0 +1,72 @@ +#pragma once + +/* This verification root installs the allocator's exclusive ghost RA. */ +#define CSTAR_DEFER_C_LOGIC_INSTALL + +/* + * Public proof model for the one-slot allocator. + * + * Every predicate below has the complete assertion type selected by + * `c_logic_install_named`; none is a legacy physical-only `hprop`. The + * concrete + * representation stays private to allocator_internal.c: + * + * lr_allocator_seed allocator block payload + * bootstrap physical ownership consumed by initialization; + * + * lr_block_payload block payload + * ownership of the client-visible payload cell; + * + * lr_allocator_inv allocator available + * the module invariant, including its private ghost ownership when + * `available = T`; + * + * lr_malloc_token allocator block + * the linear physical-and-ghost capability required by free. + * + * The client can thread these predicates but cannot unfold the allocator + * slot, private stamp, ghost name, or protocol phase. + */ + +#include "proof/theory/logic/excl_ra.h" +#include "userlib/qcp/c_logic.h" +#include "userlib/qcp/veriftime.h" + +/* The closed payload RA selected under `named_ra` for every allocator root. + * Its owned payload is `(allocator, block, phase)`. */ +PROOF term lr_allocator_ra_term(void); + +/* + * Install, in this exact order: + * + * 1. QCP codecs for `(A)excl` and its constructors; + * 2. G = excl_ra : (((int # int) # bool)excl)ra as the selected C ghost RA; + * 3. the complete `Prop_G` assertion descriptor and `own` atom. + * + * Repeated calls in the same verification root are benign. + */ +PROOF int install_lr_allocator_logic(void); + +/* + * Closed selected-logic protocol theorems. + * + * INIT: + * forall allocator block. + * emp ==*> exists name. own name (Excl ((allocator,block),T)) + * + * MALLOC: + * forall allocator block name. + * own name (Excl ((allocator,block),T)) ==*> + * own name (Excl ((allocator,block),F)) + * + * FREE: + * forall allocator block name. + * own name (Excl ((allocator,block),F)) ==*> + * own name (Excl ((allocator,block),T)) + * + * Each theorem is derived from the exclusive RA laws and the selected + * `c_logic` allocation/update API; none uses an axiom or runtime sidecar. + */ +PROOF extern thm LR_ALLOCATOR_LOGICAL_INIT; +PROOF extern thm LR_ALLOCATOR_LOGICAL_MALLOC; +PROOF extern thm LR_ALLOCATOR_LOGICAL_FREE; diff --git a/psi_examples/logical_resources/allocator/client.c b/psi_examples/logical_resources/allocator/client.c new file mode 100644 index 0000000000000000000000000000000000000000..eea90f661483b592861212ca1935ea7b630c6bb0 --- /dev/null +++ b/psi_examples/logical_resources/allocator/client.c @@ -0,0 +1,31 @@ +#include "psi_examples/logical_resources/allocator/allocator.h" +#require "psi_examples/logical_resources/allocator/allocator.c" + +// verify_all: expect-vcs=0 + +/* + * A complete modular round trip. + * + * Each public predicate is already an assertion over the selected physical × + * ghost resource. The implementation performs and frames its ghost + * transitions before returning, so the client threads one complete symbolic + * state and never opens the allocator invariant or maintains a sidecar. + */ +void lr_allocator_client_roundtrip( + struct lr_allocator *allocator, + struct lr_block *initial_block) + PARAM(`initial_payload:int`) + REQUIRE(`lr_allocator_seed + allocator + initial_block + initial_payload`) + ENSURE(`lr_allocator_inv allocator T`) +{ + lr_allocator_init(allocator, initial_block); + + struct lr_block *checked_out = lr_allocator_malloc(allocator); + + /* `lr_malloc_token allocator checked_out` contains the unique phase-F own + * atom for this allocator and is consumed together with the block payload. */ + lr_allocator_free(allocator, checked_out); +} diff --git a/psi_examples/logical_resources/context_smoke.c b/psi_examples/logical_resources/context_smoke.c new file mode 100644 index 0000000000000000000000000000000000000000..4a4d82316039186ab3b882cc2a91f530587b3aee --- /dev/null +++ b/psi_examples/logical_resources/context_smoke.c @@ -0,0 +1,56 @@ +#define CSTAR_DEFER_C_LOGIC_INSTALL + +#include "userlib/qcp/c_logic.h" +#require "userlib/qcp/c_logic.c" + +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + +#include "proof/theory/logic/max_nat_ra.h" +#require "proof/theory/logic/max_nat_ra.c" + +// verify_all: expect-vcs=0 + +/* Select one concrete, closed, monomorphic named payload algebra before QCP + * initializes its symbolic engine for the function below. */ +PROOF static int CONTEXT_SMOKE_C_LOGIC = + c_logic_install_named(`max_nat_ra:(num)ra`); + +void logical_context_smoke(void) + REQUIRE(`own 0 1 ** data_at 4096i Tint 7i`) + ENSURE(`own 0 2 ** data_at 4096i Tint 7i`) +{ + /* Lift the concrete payload update to installed `own`, then frame the + * physical cell. `set_symbolic_state` checks this complete source against + * QCP's current state modulo the installed SEP ACU laws before committing + * the complete target in one theorem. */ + PROOF thm payload_update = ispecl_rule( + TERM_LIST(`1`, `2`), + max_nat_ra_update); + PROOF thm own_update_rule = c_logic_current()->ghost_own_update; + PROOF thm specialized_own_update = ispecl_rule( + TERM_LIST(`0`, `1`, `2`), + own_update_rule); + PROOF thm own_update = mp_rule( + specialized_own_update, + payload_update); + PROOF thm complete_update = viewshift_frame_slrule( + own_update, + `data_at 4096i Tint 7i`); + + PROOF set_symbolic_state(complete_update); +} + +/* Both branches change the physical stack cell differently. The common + * opaque `own` atom must remain in the complete QCP state at the join; there + * is deliberately no out-of-band logical-state operation here. */ +void logical_context_branch_smoke(int selector) + REQUIRE(`own 0 1`) + ENSURE(`own 0 1`) +{ + if (selector == 0) { + selector = 1; + } else { + selector = 2; + } +} diff --git a/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.c b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.c new file mode 100644 index 0000000000000000000000000000000000000000..c8ce703c4932064a1fca292865b7d6ddf002fc8a --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.c @@ -0,0 +1,168 @@ +/* Independent implementation root: keep the public layout identical. */ +struct fsl_bit_pair { + int bits; +}; + +#include "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.h" + +#include "proof/proof_sl.h" +#require "proof/proof_sl.c" + +// verify_all: expect-vcs=0 + +/* Apply a closed fixed-name viewshift below the symbolic state's maximal + * existential prefix, then restore every binder. The hidden invariant bits + * therefore remain existential at the public boundary. */ +PROOF static void fsl_bp_apply_hidden_viewshift(const thm update) { + term symbolic_state = get_symbolic_state(); + term_list branches = strip_binop(sl_or(), symbolic_state); + ENSURE_COND( + branches != NULL && vector_size(branches) == 1, + "bit-pair viewshift requires one symbolic-state branch"); + strip_sl_exists_results opened = strip_sl_exists(branches[0]); + thm complete = viewshift_frame_at_slrule(update, opened.hp); + for (int i = (int)vector_size(opened.vs) - 1; i >= 0; --i) { + complete = gen_rule(opened.vs[i], complete); + complete = viewshift_exists_slrule(complete); + } + set_symbolic_state(complete); + return; +err: + ERR_FUN_PUTS("fsl_bp_apply_hidden_viewshift", cstr_thm(update)); + return; +} + +PROOF static void fsl_bp_assert_encoding_laws( + const term bit1, const term bit2) { + term_pair_list substitutions = TERM_PAIR_LIST( + (term_pair){bit1, `bit1:int`}, + (term_pair){bit2, `bit2:int`}); + term proposition = subst(substitutions, ` + (bit1 + 2i * bit2) / 2i == bit2 && + (bit1 + 2i * bit2) - + ((bit1 + 2i * bit2) / 2i) * 2i == bit1`); + thm law = ispecl_rule(TERM_LIST(bit1, bit2), FSL_BP_ENCODING_LAWS); + assert_fact_st(proposition, simp_conv, THM_LIST(law)); +} + +PROOF static void fsl_bp_assert_bit_range(const term value) { + term proposition = subst_one(value, `value:int`, ` + 0i <= (value:int) && value <= 1i`); + thm law = ispec_rule(value, FSL_BP_BIT_RANGE); + assert_fact_st(proposition, simp_conv, THM_LIST(law)); +} + +void fsl_bp_init(struct fsl_bit_pair *pair) + FSL_BP_INIT_SPEC +{ + pair->bits = 0; + PROOF fsl_bp_init_ghost_and_fold(`pair__pre:int`); +} + +int fsl_bp_get1(struct fsl_bit_pair *pair) + FSL_BP_GET1_SPEC +{ + PROOF fsl_bp_unfold_inv_as( + `name:num`, `pair__pre:int`, `stored1:int`, `stored2:int`); + PROOF fsl_bp_agree1( + `name:num`, `stored1:int`, `stored2:int`, `bit1:int`); + PROOF fsl_bp_assert_bit_range(`stored1:int`); + PROOF fsl_bp_assert_bit_range(`stored2:int`); + PROOF fsl_bp_assert_encoding_laws(`stored1:int`, `stored2:int`); + int encoded = pair->bits; + PROOF fsl_bp_fold_inv( + `name:num`, `pair__pre:int`, `stored1:int`, `stored2:int`); + PROOF substitute_fact_st(`(stored1:int) == (bit1:int)`); + return encoded - (encoded / 2) * 2; +} + +int fsl_bp_get2(struct fsl_bit_pair *pair) + FSL_BP_GET2_SPEC +{ + PROOF fsl_bp_unfold_inv_as( + `name:num`, `pair__pre:int`, `stored1:int`, `stored2:int`); + PROOF fsl_bp_agree2( + `name:num`, `stored1:int`, `stored2:int`, `bit2:int`); + PROOF fsl_bp_assert_bit_range(`stored1:int`); + PROOF fsl_bp_assert_bit_range(`stored2:int`); + PROOF fsl_bp_assert_encoding_laws(`stored1:int`, `stored2:int`); + int encoded = pair->bits; + PROOF fsl_bp_fold_inv( + `name:num`, `pair__pre:int`, `stored1:int`, `stored2:int`); + PROOF substitute_fact_st(`(stored2:int) == (bit2:int)`); + return encoded / 2; +} + +void fsl_bp_set1(struct fsl_bit_pair *pair, int new_value) + FSL_BP_SET1_SPEC +{ + PROOF fsl_bp_unfold_inv_as( + `name:num`, `pair__pre:int`, `stored1:int`, `stored2:int`); + PROOF fsl_bp_agree1( + `name:num`, `stored1:int`, `stored2:int`, `old1:int`); + PROOF substitute_fact_st(`(stored1:int) == (old1:int)`); + PROOF fsl_bp_assert_bit_range(`old1:int`); + PROOF fsl_bp_assert_bit_range(`stored2:int`); + PROOF fsl_bp_assert_bit_range(`new_value__pre:int`); + PROOF fsl_bp_assert_encoding_laws(`old1:int`, `stored2:int`); + int encoded = pair->bits; + pair->bits = new_value + (encoded / 2) * 2; + PROOF substitute_fact_st(` + ((old1:int) + 2i * (stored2:int)) / 2i == stored2`); + PROOF substitute_st(int_arith_rule(` + (new_value__pre:int) + (stored2:int) * 2i == + new_value__pre + 2i * stored2`)); + PROOF { + thm update = ispecl_rule( + TERM_LIST(`name:num`, `old1:int`, `new_value__pre:int`, `stored2:int`), + FSL_BP_SET1_VIEWSHIFT); + fsl_bp_apply_hidden_viewshift(update); + } + PROOF fsl_bp_fold_inv( + `name:num`, `pair__pre:int`, `new_value__pre:int`, `stored2:int`); +} + +void fsl_bp_set2(struct fsl_bit_pair *pair, int new_value) + FSL_BP_SET2_SPEC +{ + PROOF fsl_bp_unfold_inv_as( + `name:num`, `pair__pre:int`, `stored1:int`, `stored2:int`); + PROOF fsl_bp_agree2( + `name:num`, `stored1:int`, `stored2:int`, `old2:int`); + PROOF substitute_fact_st(`(stored2:int) == (old2:int)`); + PROOF fsl_bp_assert_bit_range(`stored1:int`); + PROOF fsl_bp_assert_bit_range(`old2:int`); + PROOF fsl_bp_assert_bit_range(`new_value__pre:int`); + PROOF fsl_bp_assert_encoding_laws(`stored1:int`, `old2:int`); + int encoded = pair->bits; + pair->bits = 2 * new_value + encoded - (encoded / 2) * 2; + PROOF substitute_fact_st(` + ((stored1:int) + 2i * (old2:int)) / 2i == old2`); + PROOF substitute_st(int_arith_rule(` + 2i * (new_value__pre:int) + + ((stored1:int) + 2i * (old2:int)) - old2 * 2i == + stored1 + 2i * new_value__pre`)); + PROOF { + thm update = ispecl_rule( + TERM_LIST(`name:num`, `old2:int`, `new_value__pre:int`, `stored1:int`), + FSL_BP_SET2_VIEWSHIFT); + fsl_bp_apply_hidden_viewshift(update); + } + PROOF fsl_bp_fold_inv( + `name:num`, `pair__pre:int`, `stored1:int`, `new_value__pre:int`); +} + +void fsl_bp_free(struct fsl_bit_pair *pair) + FSL_BP_FREE_SPEC +{ + PROOF fsl_bp_unfold_inv_as( + `name:num`, `pair__pre:int`, `stored1:int`, `stored2:int`); + PROOF { + thm release = ispecl_rule( + TERM_LIST( + `name:num`, `stored1:int`, `stored2:int`, + `token1_value:int`, `token2_value:int`), + FSL_BP_CLOSE_VIEWSHIFT); + fsl_bp_apply_hidden_viewshift(release); + } +} diff --git a/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.h b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.h new file mode 100644 index 0000000000000000000000000000000000000000..a3a4c731330d356f6d9fa81bb797195c83661469 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.h @@ -0,0 +1,88 @@ +#pragma once + +/* + * Public fictional Bit Pair API. + * + * The implementation stores both bits in one `int`. Clients nevertheless + * receive two linearly separable abstract tokens. The implementation + * invariant and both tokens share the same logical `name:num`; no ghost name + * is stored at runtime. + */ + +#include "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.h" +#require "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.c" + +struct fsl_bit_pair { + int bits; +}; + +PROOF static int _FSL_BP_QCP = install_fsl_bit_pair_qcp_interface(); + +#define FSL_BP_INIT_SPEC \ + REQUIRE(`undef_data_at (field_addr pair Tfsl_bit_pair Fbits) Tint`) \ + ENSURE_EX(TERM_LIST(`name:num`), \ + `fsl_bp_inv name pair`, \ + `fsl_bp_token1 name 0i`, \ + `fsl_bp_token2 name 0i`) + +void fsl_bp_init(struct fsl_bit_pair *pair) + FSL_BP_INIT_SPEC; + +#define FSL_BP_GET1_SPEC \ + PARAM(`name:num`, `bit1:int`) \ + REQUIRE(`fsl_bp_inv name pair`, \ + `fsl_bp_token1 name bit1`) \ + ENSURE(`fsl_bp_inv name pair`, \ + `fsl_bp_token1 name bit1`, \ + `fact((__return:int) == (bit1:int))`) + +int fsl_bp_get1(struct fsl_bit_pair *pair) + FSL_BP_GET1_SPEC; + +#define FSL_BP_GET2_SPEC \ + PARAM(`name:num`, `bit2:int`) \ + REQUIRE(`fsl_bp_inv name pair`, \ + `fsl_bp_token2 name bit2`) \ + ENSURE(`fsl_bp_inv name pair`, \ + `fsl_bp_token2 name bit2`, \ + `fact((__return:int) == (bit2:int))`) + +int fsl_bp_get2(struct fsl_bit_pair *pair) + FSL_BP_GET2_SPEC; + +#define FSL_BP_SET1_SPEC \ + PARAM(`name:num`, `old1:int`) \ + REQUIRE(`fsl_bp_inv name pair`, \ + `fsl_bp_token1 name old1`, \ + `fact(fsl_bp_bit (new_value:int))`) \ + ENSURE(`fsl_bp_inv name pair`, \ + `fsl_bp_token1 name new_value`) + +void fsl_bp_set1(struct fsl_bit_pair *pair, int new_value) + FSL_BP_SET1_SPEC; + +#define FSL_BP_SET2_SPEC \ + PARAM(`name:num`, `old2:int`) \ + REQUIRE(`fsl_bp_inv name pair`, \ + `fsl_bp_token2 name old2`, \ + `fact(fsl_bp_bit (new_value:int))`) \ + ENSURE(`fsl_bp_inv name pair`, \ + `fsl_bp_token2 name new_value`) + +void fsl_bp_set2(struct fsl_bit_pair *pair, int new_value) + FSL_BP_SET2_SPEC; + +/* + * Logical destructor. Token indices may be hidden independently; sharing + * the one explicit `name` with the invariant is sufficient to consume the + * complete fictional object and return its physical cell to the caller. + */ +#define FSL_BP_FREE_SPEC \ + PARAM(`name:num`, `token1_value:int`, `token2_value:int`) \ + REQUIRE(`fsl_bp_inv name pair`, \ + `fsl_bp_token1 name token1_value`, \ + `fsl_bp_token2 name token2_value`) \ + ENSURE(`undef_data_at (field_addr pair Tfsl_bit_pair Fbits) Tint`) + +void fsl_bp_free(struct fsl_bit_pair *pair) + FSL_BP_FREE_SPEC; diff --git a/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.c b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.c new file mode 100644 index 0000000000000000000000000000000000000000..a7896f5f728b17c2c7dd3df45a475ff620d241a4 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.c @@ -0,0 +1,42 @@ +#include "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.h" + +#require "proof/theory/logic/auth_ra.c" +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/prod_ra.c" +#require "userlib/qcp/c_logic.c" + +PROOF term fsl_bit_pair_ra_term(void) { + return ` + auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)): + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))ra + `; +} + +PROOF int install_fsl_bit_pair_logic(void) { + static bool installed = false; + if (installed) return 0; + + ENSURE_COND(cst_add_type_to_header("ra", 1) == 0, + "Could not export ra for the bit-pair model"); + ENSURE_COND(cst_add_type_to_header("excl", 1) == 0, + "Could not export excl for the bit-pair model"); + ENSURE_COND(cst_add_const_to_header(`ExclUnit:(A)excl`) == 0, + "Could not export ExclUnit for the bit-pair model"); + ENSURE_COND(cst_add_const_to_header(`Excl:A->(A)excl`) == 0, + "Could not export Excl for the bit-pair model"); + ENSURE_COND(cst_add_const_to_header(`ExclInvalid:(A)excl`) == 0, + "Could not export ExclInvalid for the bit-pair model"); + ENSURE_COND( + c_logic_install_named(fsl_bit_pair_ra_term()) == 0, + "Could not install the fictional bit-pair C logic"); + + installed = true; + return 0; +err: + ERR_FUN_PUTS("install_fsl_bit_pair_logic"); + return -1; +} diff --git a/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.h b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.h new file mode 100644 index 0000000000000000000000000000000000000000..ed90e1d979cc5f5e811294da5815e00c8bf30670 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.h @@ -0,0 +1,16 @@ +#pragma once + +/* One selected complete C-resource model for the fictional bit-pair module. */ +#define CSTAR_DEFER_C_LOGIC_INSTALL + +#include "proof/theory/logic/auth_ra.h" +#include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/prod_ra.h" +#include "userlib/qcp/c_logic.h" + +/* + * Base fragments form two exclusive fields; authority couples both fictional + * fields to the one physical integer cell. + */ +PROOF term fsl_bit_pair_ra_term(void); +PROOF int install_fsl_bit_pair_logic(void); diff --git a/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.c b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.c new file mode 100644 index 0000000000000000000000000000000000000000..dcf0bced3e3f9a2b4e59ad51f3ddd083fdeb0ecd --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.c @@ -0,0 +1,1394 @@ +#include "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#include "proof/proof_sl.h" +#require "proof/proof_sl.c" +#include "userlib/proof/probes.h" +#require "userlib/proof/probes.c" + +PROOF static int _FSL_BP_LOGIC = install_fsl_bit_pair_logic(); +PROOF static size_t FSL_BP_AXIOMS_BEFORE = vector_size(get_all_axioms()); + +PROOF static int _Tfsl_bit_pair = + new_const_safe("Tfsl_bit_pair", `:struct_name`); +PROOF static int _Fbits = new_const_safe("Fbits", `:field`); + +/* ------------------------------------------------------------------------- */ +/* Opaque payload constructors and assertions */ +/* ------------------------------------------------------------------------- */ + +PROOF thm fsl_bp_bit_def = cst_new_fun_definition( + "fsl_bp_bit", + `fsl_bp_bit (value:int) <=> value == 0i || value == 1i`, + `:int->bool`); + +PROOF thm fsl_bp_base_def = cst_new_fun_definition( + "fsl_bp_base", + `fsl_bp_base (bit1:int) (bit2:int) = + ((Excl bit1):(int)excl,(Excl bit2):(int)excl)`, + `:int->int->((int)excl#(int)excl)`); + +PROOF thm fsl_bp_left_def = cst_new_fun_definition( + "fsl_bp_left", + `fsl_bp_left (value:int) = + ((Excl value):(int)excl,(ExclUnit:(int)excl))`, + `:int->((int)excl#(int)excl)`); + +PROOF thm fsl_bp_right_def = cst_new_fun_definition( + "fsl_bp_right", + `fsl_bp_right (value:int) = + ((ExclUnit:(int)excl),(Excl value):(int)excl)`, + `:int->((int)excl#(int)excl)`); + +PROOF thm fsl_bp_auth_def = cst_new_fun_definition( + "fsl_bp_auth", + `fsl_bp_auth (bit1:int) (bit2:int) = + auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_bp_base bit1 bit2)`, + `:int->int-> + (((int)excl#(int)excl)excl#((int)excl#(int)excl))`); + +PROOF thm fsl_bp_frag1_def = cst_new_fun_definition( + "fsl_bp_frag1", + `fsl_bp_frag1 (value:int) = auth_frag (fsl_bp_left value)`, + `:int-> + (((int)excl#(int)excl)excl#((int)excl#(int)excl))`); + +PROOF thm fsl_bp_frag2_def = cst_new_fun_definition( + "fsl_bp_frag2", + `fsl_bp_frag2 (value:int) = auth_frag (fsl_bp_right value)`, + `:int-> + (((int)excl#(int)excl)excl#((int)excl#(int)excl))`); + +PROOF thm fsl_bp_bundle_def = cst_new_fun_definition( + "fsl_bp_bundle", + `fsl_bp_bundle (bit1:int) (bit2:int) = + auth_both + (fsl_bp_base bit1 bit2) + (fsl_bp_base bit1 bit2)`, + `:int->int-> + (((int)excl#(int)excl)excl#((int)excl#(int)excl))`); + +PROOF thm fsl_bp_token1_def = cst_new_fun_definition( + "fsl_bp_token1", + `fsl_bp_token1 name value -|- + own (name:num) (fsl_bp_frag1 (value:int))`, + `:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))finmap)->bool`); + +PROOF thm fsl_bp_token2_def = cst_new_fun_definition( + "fsl_bp_token2", + `fsl_bp_token2 name value -|- + own (name:num) (fsl_bp_frag2 (value:int))`, + `:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))finmap)->bool`); + +PROOF thm fsl_bp_inv_def = cst_new_fun_definition( + "fsl_bp_inv", + `fsl_bp_inv name pair -|- + exists (bit1:int) (bit2:int). + fact(fsl_bp_bit bit1) ** + fact(fsl_bp_bit bit2) ** + data_at + (field_addr (pair:int) Tfsl_bit_pair Fbits) + Tint + (bit1 + 2i * bit2) ** + own (name:num) (fsl_bp_auth bit1 bit2)`, + `:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))finmap)->bool`); + +PROOF thm FSL_BP_ZERO_CASE = + int_arith_rule(`0i == 0i || 0i == 1i`); + +PROOF static thm prove_fsl_bp_bit_zero(void) { + thm definition = inst_rule( + TERM_PAIR_LIST((term_pair){`0i`, `value:int`}), + fsl_bp_bit_def); + thm proved = eq_mp_rule(gsym_rule(definition), FSL_BP_ZERO_CASE); + return proved; +} + +PROOF thm FSL_BP_BIT_ZERO = prove_fsl_bp_bit_zero(); + +PROOF static thm prove_fsl_bp_bit_one(void) { + thm one_case = int_arith_rule(`1i == 0i || 1i == 1i`); + thm definition = inst_rule( + TERM_PAIR_LIST((term_pair){`1i`, `value:int`}), + fsl_bp_bit_def); + return eq_mp_rule(gsym_rule(definition), one_case); +} + +PROOF thm FSL_BP_BIT_ONE = prove_fsl_bp_bit_one(); + +PROOF static thm prove_fsl_bp_bit_range(void) { + term goal_tm = ` + forall value:int. + fsl_bp_bit value ==> + 0i <= value && value <= 1i + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm definition = fsl_bp_bit_def; + thm cases = eq_mp_rule( + definition, + assume_rule(`fsl_bp_bit (value:int)`)); + gnode_list branches = DISJ_CASES_TAC(body, cases, "Hvalue"); + CONV_TAC( + branches[0], + then_conv( + rewrite_conv(THM_LIST(assume_rule(`(value:int) == 0i`))), + get_conversion_by_name("INT_REDUCE_CONV"))); + CONV_TAC( + branches[1], + then_conv( + rewrite_conv(THM_LIST(assume_rule(`(value:int) == 1i`))), + get_conversion_by_name("INT_REDUCE_CONV"))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_BP_BIT_RANGE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_bp_bit_range"); + return empty_theorem; +} + +PROOF thm FSL_BP_BIT_RANGE = prove_fsl_bp_bit_range(); + +PROOF static thm prove_fsl_bp_encoding_laws(void) { + term goal_tm = ` + forall (bit1:int) (bit2:int). + fsl_bp_bit bit1 ==> + fsl_bp_bit bit2 ==> + (bit1 + 2i * bit2) / 2i == bit2 && + (bit1 + 2i * bit2) - + ((bit1 + 2i * bit2) / 2i) * 2i == bit1 + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm bit1_definition = inst_rule( + TERM_PAIR_LIST((term_pair){`bit1:int`, `value:int`}), + fsl_bp_bit_def); + thm bit2_definition = inst_rule( + TERM_PAIR_LIST((term_pair){`bit2:int`, `value:int`}), + fsl_bp_bit_def); + thm bit1_cases = eq_mp_rule( + bit1_definition, + assume_rule(`fsl_bp_bit (bit1:int)`)); + thm bit2_cases = eq_mp_rule( + bit2_definition, + assume_rule(`fsl_bp_bit (bit2:int)`)); + gnode_list first_cases = DISJ_CASES_TAC(body, bit1_cases, "Hbit1"); + conv int_reduce = get_conversion_by_name("INT_REDUCE_CONV"); + for (size_t i = 0; i < 2; ++i) { + gnode_list second_cases = DISJ_CASES_TAC( + first_cases[i], bit2_cases, "Hbit2"); + for (size_t j = 0; j < 2; ++j) { + term bit1_value = i == 0 ? `0i` : `1i`; + term bit2_value = j == 0 ? `0i` : `1i`; + thm bit1_eq = assume_rule( + mk_eq(`bit1:int`, bit1_value)); + thm bit2_eq = assume_rule( + mk_eq(`bit2:int`, bit2_value)); + conv substitute = rewrite_conv(THM_LIST(bit1_eq, bit2_eq)); + CONV_TAC(second_cases[j], then_conv(substitute, int_reduce)); + } + } + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_BP_ENCODING_LAWS has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_bp_encoding_laws"); + return empty_theorem; +} + +PROOF thm FSL_BP_ENCODING_LAWS = + prove_fsl_bp_encoding_laws(); + +/* ------------------------------------------------------------------------- */ +/* Base algebra */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fsl_bp_left_right(void) { + term goal_tm = ` + forall (bit1:int) (bit2:int). + ra_op + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_bp_left bit1) + (fsl_bp_right bit2) == + fsl_bp_base bit1 bit2 + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + fsl_bp_left_def, + fsl_bp_right_def, + fsl_bp_base_def, + prod_ra_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + gsym_rule(excl_ra_unit), + ra_unit_l, + ra_unit_r))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_BP_LEFT_RIGHT has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_bp_left_right"); + return empty_theorem; +} + +PROOF static thm FSL_BP_LEFT_RIGHT = prove_fsl_bp_left_right(); + +PROOF static thm prove_fsl_bp_base_valid(void) { + term goal_tm = ` + forall (bit1:int) (bit2:int). + ra_valid + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_bp_base bit1 bit2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST( + fsl_bp_base_def, + prod_ra_valid, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + excl_ra_valid_owned, + get_theorem_by_name("AND_CLAUSES")))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_BP_BASE_VALID has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_bp_base_valid"); + return empty_theorem; +} + +PROOF static thm FSL_BP_BASE_VALID = prove_fsl_bp_base_valid(); + +PROOF static thm prove_fsl_bp_base_cancellative(void) { + term goal_tm = ` + ra_cancellative + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + `; + thm characterization = ispecl_rule( + TERM_LIST( + `excl_ra:((int)excl)ra`, + `excl_ra:((int)excl)ra`), + prod_ra_cancellative_iff); + type_pair_list int_excl_types = (type_pair_list)vector_create(); + vector_add(&int_excl_types, ((type_pair){`:int`, `:A`})); + thm typed_excl_cancellative = inst_type_rule( + int_excl_types, excl_ra_cancellative); + thm proved = eq_mp_rule( + gsym_rule(characterization), + conj_rule(typed_excl_cancellative, typed_excl_cancellative)); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_BP_BASE_CANCELLATIVE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_bp_base_cancellative"); + return empty_theorem; +} + +PROOF thm FSL_BP_BASE_CANCELLATIVE = + prove_fsl_bp_base_cancellative(); + +/* Authority/fragment validity is the abstraction bridge: after opening the + * invariant, the hidden physical bit must equal the public token index. */ +PROOF static thm prove_fsl_bp_auth_frag1_agree(void) { + term goal_tm = ` + forall (stored1:int) (stored2:int) (token:int). + ra_valid + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (ra_op + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (fsl_bp_auth stored1 stored2) + (fsl_bp_frag1 token)) ==> + stored1 == token + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm valid = assume_rule(` + ra_valid + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (ra_op + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (fsl_bp_auth (stored1:int) (stored2:int)) + (fsl_bp_frag1 (token:int)))`); + valid = pure_rewrite_rule( + THM_LIST( + fsl_bp_auth_def, + fsl_bp_frag1_def, + auth_ra_auth_frag, + auth_ra_valid_both, + fsl_bp_base_def, + fsl_bp_left_def, + prod_ra_included, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + excl_ra_included_owned), + valid); + thm agreement = conjunct1_rule(conjunct2_rule(valid)); + ACCEPT_TAC(body, gsym_rule(agreement)); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_BP_AUTH_FRAG1_AGREE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_bp_auth_frag1_agree"); + return empty_theorem; +} + +PROOF static thm FSL_BP_AUTH_FRAG1_AGREE = + prove_fsl_bp_auth_frag1_agree(); + +PROOF static thm prove_fsl_bp_auth_frag2_agree(void) { + term goal_tm = ` + forall (stored1:int) (stored2:int) (token:int). + ra_valid + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (ra_op + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (fsl_bp_auth stored1 stored2) + (fsl_bp_frag2 token)) ==> + stored2 == token + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm valid = assume_rule(` + ra_valid + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (ra_op + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (fsl_bp_auth (stored1:int) (stored2:int)) + (fsl_bp_frag2 (token:int)))`); + valid = pure_rewrite_rule( + THM_LIST( + fsl_bp_auth_def, + fsl_bp_frag2_def, + auth_ra_auth_frag, + auth_ra_valid_both, + fsl_bp_base_def, + fsl_bp_right_def, + prod_ra_included, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + excl_ra_included_owned), + valid); + thm agreement = conjunct2_rule(conjunct2_rule(valid)); + ACCEPT_TAC(body, gsym_rule(agreement)); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_BP_AUTH_FRAG2_AGREE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_bp_auth_frag2_agree"); + return empty_theorem; +} + +PROOF static thm FSL_BP_AUTH_FRAG2_AGREE = + prove_fsl_bp_auth_frag2_agree(); + +/* ------------------------------------------------------------------------- */ +/* Ownership equalities and payload updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm fsl_bp_token1_definition( + const term name, const term value) { + return inst_rule( + TERM_PAIR_LIST( + (term_pair){name, `name:num`}, + (term_pair){value, `value:int`}), + fsl_bp_token1_def); +} + +PROOF static thm fsl_bp_token2_definition( + const term name, const term value) { + return inst_rule( + TERM_PAIR_LIST( + (term_pair){name, `name:num`}, + (term_pair){value, `value:int`}), + fsl_bp_token2_def); +} + +PROOF static thm fsl_bp_auth_definition( + const term bit1, const term bit2) { + return inst_rule( + TERM_PAIR_LIST( + (term_pair){bit1, `bit1:int`}, + (term_pair){bit2, `bit2:int`}), + fsl_bp_auth_def); +} + +PROOF static thm fsl_bp_bundle_definition( + const term bit1, const term bit2) { + return inst_rule( + TERM_PAIR_LIST( + (term_pair){bit1, `bit1:int`}, + (term_pair){bit2, `bit2:int`}), + fsl_bp_bundle_def); +} + +PROOF static thm prove_fsl_bp_own_auth_frag1_direction(const bool forward) { + term name = `name:num`; + term bit1 = `bit1:int`; + term bit2 = `bit2:int`; + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + term raw_authority = ` + auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_bp_base (bit1:int) (bit2:int))`; + term raw_fragment = `auth_frag (fsl_bp_left (bit1:int))`; + term combined = ` + auth_both + (fsl_bp_base (bit1:int) (bit2:int)) + (fsl_bp_left bit1)`; + term own = c_logic_current()->own; + term own_at_name = mk_comb(own, name); + + thm composition = ispecl_rule( + TERM_LIST(base_ra, + `fsl_bp_base (bit1:int) (bit2:int)`, + `fsl_bp_left (bit1:int)`), + auth_ra_auth_frag); + thm replace = ap_term_rule(own_at_name, gsym_rule(composition)); + thm split = ispecl_rule( + TERM_LIST(name, raw_authority, raw_fragment), + forward ? c_logic_current()->ghost_own_split + : c_logic_current()->ghost_own_join); + thm auth_definition = fsl_bp_auth_definition(bit1, bit2); + thm fold_authority = ap_term_rule( + own_at_name, gsym_rule(auth_definition)); + thm token_definition = fsl_bp_token1_definition(name, bit1); + token_definition = pure_rewrite_rule( + THM_LIST(fsl_bp_frag1_def), token_definition); + thm token = gsym_rule(token_definition); + thm fold = mk_binop_rule( + sl_sep(), + fold_authority, + token); + thm result; + if (forward) { + result = trans_slrule(eq2ent(replace), split); + result = trans_slrule(result, eq2ent(fold)); + } else { + result = trans_slrule(eq2ent(gsym_rule(fold)), split); + result = trans_slrule(result, eq2ent(gsym_rule(replace))); + } + result = gen_rule(bit2, result); + result = gen_rule(bit1, result); + result = gen_rule(name, result); + return result; +} + +PROOF static thm FSL_BP_OWN_AUTH_FRAG1 = + prove_fsl_bp_own_auth_frag1_direction(true); + +PROOF static thm FSL_BP_JOIN_AUTH_FRAG1 = + prove_fsl_bp_own_auth_frag1_direction(false); + +PROOF static thm prove_fsl_bp_own_auth_frag2_direction(const bool forward) { + term name = `name:num`; + term bit1 = `bit1:int`; + term bit2 = `bit2:int`; + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + term raw_authority = ` + auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_bp_base (bit1:int) (bit2:int))`; + term raw_fragment = `auth_frag (fsl_bp_right (bit2:int))`; + term own = c_logic_current()->own; + term own_at_name = mk_comb(own, name); + + thm composition = ispecl_rule( + TERM_LIST(base_ra, + `fsl_bp_base (bit1:int) (bit2:int)`, + `fsl_bp_right (bit2:int)`), + auth_ra_auth_frag); + thm replace = ap_term_rule(own_at_name, gsym_rule(composition)); + thm split = ispecl_rule( + TERM_LIST(name, raw_authority, raw_fragment), + forward ? c_logic_current()->ghost_own_split + : c_logic_current()->ghost_own_join); + thm auth_definition = fsl_bp_auth_definition(bit1, bit2); + thm fold_authority = ap_term_rule( + own_at_name, gsym_rule(auth_definition)); + thm token_definition = fsl_bp_token2_definition(name, bit2); + token_definition = pure_rewrite_rule( + THM_LIST(fsl_bp_frag2_def), token_definition); + thm token = gsym_rule(token_definition); + thm fold = mk_binop_rule( + sl_sep(), + fold_authority, + token); + thm result; + if (forward) { + result = trans_slrule(eq2ent(replace), split); + result = trans_slrule(result, eq2ent(fold)); + } else { + result = trans_slrule(eq2ent(gsym_rule(fold)), split); + result = trans_slrule(result, eq2ent(gsym_rule(replace))); + } + result = gen_rule(bit2, result); + result = gen_rule(bit1, result); + result = gen_rule(name, result); + return result; +} + +PROOF static thm FSL_BP_OWN_AUTH_FRAG2 = + prove_fsl_bp_own_auth_frag2_direction(true); + +PROOF static thm FSL_BP_JOIN_AUTH_FRAG2 = + prove_fsl_bp_own_auth_frag2_direction(false); + +PROOF static thm prove_fsl_bp_fragment_split_direction(const bool forward) { + term name = `name:num`; + term bit1 = `bit1:int`; + term bit2 = `bit2:int`; + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + term own = c_logic_current()->own; + term own_at_name = mk_comb(own, name); + + thm frag_op = ispecl_rule( + TERM_LIST(base_ra, + `fsl_bp_left (bit1:int)`, + `fsl_bp_right (bit2:int)`), + auth_ra_frag_frag); + frag_op = pure_rewrite_rule( + THM_LIST(FSL_BP_LEFT_RIGHT), + frag_op); + thm replace = ap_term_rule(own_at_name, gsym_rule(frag_op)); + thm split = ispecl_rule( + TERM_LIST(name, + `auth_frag (fsl_bp_left (bit1:int))`, + `auth_frag (fsl_bp_right (bit2:int))`), + forward ? c_logic_current()->ghost_own_split + : c_logic_current()->ghost_own_join); + thm token1_definition = fsl_bp_token1_definition(name, bit1); + token1_definition = pure_rewrite_rule( + THM_LIST(fsl_bp_frag1_def), token1_definition); + thm token2_definition = fsl_bp_token2_definition(name, bit2); + token2_definition = pure_rewrite_rule( + THM_LIST(fsl_bp_frag2_def), token2_definition); + thm fold = mk_binop_rule( + sl_sep(), + gsym_rule(token1_definition), + gsym_rule(token2_definition)); + thm result; + if (forward) { + result = trans_slrule(eq2ent(replace), split); + result = trans_slrule(result, eq2ent(fold)); + } else { + result = trans_slrule(eq2ent(gsym_rule(fold)), split); + result = trans_slrule(result, eq2ent(gsym_rule(replace))); + } + result = gen_rule(bit2, result); + result = gen_rule(bit1, result); + result = gen_rule(name, result); + return result; +} + +PROOF static thm FSL_BP_FRAGMENT_SPLIT = + prove_fsl_bp_fragment_split_direction(true); + +PROOF static thm FSL_BP_FRAGMENT_JOIN = + prove_fsl_bp_fragment_split_direction(false); + +PROOF static thm prove_fsl_bp_own_split_direction(const bool forward) { + term name = `name:num`; + term bit1 = `bit1:int`; + term bit2 = `bit2:int`; + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + term own = c_logic_current()->own; + term own_at_name = mk_comb(own, name); + term raw_authority = ` + auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_bp_base (bit1:int) (bit2:int))`; + + thm auth_frag = ispecl_rule( + TERM_LIST(base_ra, + `fsl_bp_base (bit1:int) (bit2:int)`, + `fsl_bp_base (bit1:int) (bit2:int)`), + auth_ra_auth_frag); + auth_frag = pure_rewrite_rule( + THM_LIST(fsl_bp_bundle_def, fsl_bp_auth_def), + auth_frag); + thm replace = ap_term_rule(own_at_name, gsym_rule(auth_frag)); + thm split = ispecl_rule( + TERM_LIST(name, + raw_authority, + `auth_frag (fsl_bp_base (bit1:int) (bit2:int))`), + forward ? c_logic_current()->ghost_own_split + : c_logic_current()->ghost_own_join); + thm bundle_fold = ap_term_rule( + own_at_name, + fsl_bp_bundle_definition(bit1, bit2)); + thm fragments = ispecl_rule( + TERM_LIST(name, bit1, bit2), + forward ? FSL_BP_FRAGMENT_SPLIT : FSL_BP_FRAGMENT_JOIN); + thm authority_fold = ap_term_rule( + own_at_name, + gsym_rule(fsl_bp_auth_definition(bit1, bit2))); + thm result; + if (forward) { + thm lift = frame_mono_slrule(eq2ent(authority_fold), fragments); + result = trans_slrule(eq2ent(bundle_fold), eq2ent(replace)); + result = trans_slrule(result, split); + result = trans_slrule(result, lift); + } else { + thm lift = frame_mono_slrule( + eq2ent(gsym_rule(authority_fold)), fragments); + result = trans_slrule(lift, split); + result = trans_slrule(result, eq2ent(gsym_rule(replace))); + result = trans_slrule(result, eq2ent(gsym_rule(bundle_fold))); + } + result = gen_rule(bit2, result); + result = gen_rule(bit1, result); + result = gen_rule(name, result); + return result; +} + +PROOF static thm FSL_BP_OWN_SPLIT = + prove_fsl_bp_own_split_direction(true); + +PROOF static thm FSL_BP_OWN_JOIN = + prove_fsl_bp_own_split_direction(false); + +PROOF static thm prove_fsl_bp_update1(void) { + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + thm target_valid = ispecl_rule( + TERM_LIST(`next:int`, `other:int`), + FSL_BP_BASE_VALID); + thm valid_op = pure_once_rewrite_rule( + THM_LIST(gsym_rule(ispecl_rule( + TERM_LIST(`next:int`, `other:int`), FSL_BP_LEFT_RIGHT))), + target_valid); + thm local = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + base_ra, + `fsl_bp_left (old:int)`, + `fsl_bp_left (next:int)`, + `fsl_bp_right (other:int)`), + ra_local_update_cancellative), + FSL_BP_BASE_CANCELLATIVE), + valid_op); + thm update = mp_rule( + ispecl_rule( + TERM_LIST( + base_ra, + `ra_op ${base_ra:(((int)excl#(int)excl)ra)} + (fsl_bp_left (old:int)) (fsl_bp_right (other:int))`, + `fsl_bp_left (old:int)`, + `ra_op ${base_ra:(((int)excl#(int)excl)ra)} + (fsl_bp_left (next:int)) (fsl_bp_right (other:int))`, + `fsl_bp_left (next:int)`), + auth_ra_update_local), + local); + update = pure_rewrite_rule(THM_LIST(FSL_BP_LEFT_RIGHT), update); + update = gen_rule(`other:int`, update); + update = gen_rule(`next:int`, update); + update = gen_rule(`old:int`, update); + return update; +} + +PROOF static thm FSL_BP_UPDATE1 = prove_fsl_bp_update1(); + +PROOF static thm prove_fsl_bp_update2(void) { + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + thm target_valid = ispecl_rule( + TERM_LIST(`other:int`, `next:int`), + FSL_BP_BASE_VALID); + thm right_left = ispecl_rule( + TERM_LIST(base_ra, + `fsl_bp_right (next:int)`, + `fsl_bp_left (other:int)`), + ra_comm); + right_left = trans_rule( + right_left, + ispecl_rule(TERM_LIST(`other:int`, `next:int`), FSL_BP_LEFT_RIGHT)); + thm valid_op = pure_once_rewrite_rule( + THM_LIST(gsym_rule(right_left)), + target_valid); + thm local = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + base_ra, + `fsl_bp_right (old:int)`, + `fsl_bp_right (next:int)`, + `fsl_bp_left (other:int)`), + ra_local_update_cancellative), + FSL_BP_BASE_CANCELLATIVE), + valid_op); + thm update = mp_rule( + ispecl_rule( + TERM_LIST( + base_ra, + `ra_op ${base_ra:(((int)excl#(int)excl)ra)} + (fsl_bp_right (old:int)) (fsl_bp_left (other:int))`, + `fsl_bp_right (old:int)`, + `ra_op ${base_ra:(((int)excl#(int)excl)ra)} + (fsl_bp_right (next:int)) (fsl_bp_left (other:int))`, + `fsl_bp_right (next:int)`), + auth_ra_update_local), + local); + update = pure_rewrite_rule(THM_LIST(right_left), update); + update = gen_rule(`other:int`, update); + update = gen_rule(`next:int`, update); + update = gen_rule(`old:int`, update); + return update; +} + +PROOF static thm FSL_BP_UPDATE2 = prove_fsl_bp_update2(); + +/* ------------------------------------------------------------------------- */ +/* Complete-assertion viewshifts */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fsl_bp_init_viewshift(void) { + thm valid = ispecl_rule(TERM_LIST(`0i`, `0i`), FSL_BP_BASE_VALID); + thm included = ispecl_rule( + TERM_LIST( + `prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`, + `fsl_bp_base 0i 0i`), + ra_included_refl); + thm both_valid = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`, + `fsl_bp_base 0i 0i`, + `fsl_bp_base 0i 0i`), + auth_ra_valid_both)), + conj_rule(valid, included)); + thm allocate = mp_rule( + ispecl_rule( + TERM_LIST(`fsl_bp_bundle 0i 0i`, sl_emp()), + c_logic_current()->ghost_own_alloc), + pure_once_rewrite_rule( + THM_LIST(gsym_rule(fsl_bp_bundle_definition(`0i`, `0i`))), + both_valid)); + allocate = pure_rewrite_rule(THM_LIST(sl_sep_emp_right()), allocate); + thm split = ispecl_rule( + TERM_LIST(`name:num`, `0i`, `0i`), + FSL_BP_OWN_SPLIT); + thm split_exists = exists_mono_slrule(`name:num`, split); + dest_binop_results endpoints = dest_sl_viewshift(concl(allocate)); + return viewshift_mono_slrule( + refl_slrule(endpoints.tm1), + allocate, + split_exists); +} + +PROOF thm FSL_BP_INIT_VIEWSHIFT = + prove_fsl_bp_init_viewshift(); + +PROOF static thm prove_fsl_bp_set1_viewshift(void) { + thm update = ispecl_rule( + TERM_LIST(`old:int`, `next:int`, `other:int`), + FSL_BP_UPDATE1); + thm own_update = mp_rule( + ispecl_rule( + TERM_LIST( + `name:num`, + `auth_both + (fsl_bp_base (old:int) (other:int)) + (fsl_bp_left old)`, + `auth_both + (fsl_bp_base (next:int) (other:int)) + (fsl_bp_left next)`), + c_logic_current()->ghost_own_update), + update); + thm source = ispecl_rule( + TERM_LIST(`name:num`, `old:int`, `other:int`), + FSL_BP_JOIN_AUTH_FRAG1); + thm target = ispecl_rule( + TERM_LIST(`name:num`, `next:int`, `other:int`), + FSL_BP_OWN_AUTH_FRAG1); + thm result = viewshift_mono_slrule(source, own_update, target); + result = gen_rule(`other:int`, result); + result = gen_rule(`next:int`, result); + result = gen_rule(`old:int`, result); + result = gen_rule(`name:num`, result); + return result; +} + +PROOF thm FSL_BP_SET1_VIEWSHIFT = + prove_fsl_bp_set1_viewshift(); + +PROOF static thm prove_fsl_bp_set2_viewshift(void) { + thm update = ispecl_rule( + TERM_LIST(`old:int`, `next:int`, `other:int`), + FSL_BP_UPDATE2); + thm own_update = mp_rule( + ispecl_rule( + TERM_LIST( + `name:num`, + `auth_both + (fsl_bp_base (other:int) (old:int)) + (fsl_bp_right old)`, + `auth_both + (fsl_bp_base (other:int) (next:int)) + (fsl_bp_right next)`), + c_logic_current()->ghost_own_update), + update); + thm source = ispecl_rule( + TERM_LIST(`name:num`, `other:int`, `old:int`), + FSL_BP_JOIN_AUTH_FRAG2); + thm target = ispecl_rule( + TERM_LIST(`name:num`, `other:int`, `next:int`), + FSL_BP_OWN_AUTH_FRAG2); + thm result = viewshift_mono_slrule(source, own_update, target); + result = gen_rule(`other:int`, result); + result = gen_rule(`next:int`, result); + result = gen_rule(`old:int`, result); + result = gen_rule(`name:num`, result); + return result; +} + +PROOF thm FSL_BP_SET2_VIEWSHIFT = + prove_fsl_bp_set2_viewshift(); + +PROOF static thm prove_fsl_bp_close_viewshift(void) { + thm drop = c_logic_current()->ghost_own_drop; + thm authority = ispecl_rule( + TERM_LIST(`name:num`, `fsl_bp_auth (bit1:int) (bit2:int)`), + drop); + thm left = ispecl_rule( + TERM_LIST(`name:num`, `fsl_bp_frag1 (token1:int)`), + drop); + thm right = ispecl_rule( + TERM_LIST(`name:num`, `fsl_bp_frag2 (token2:int)`), + drop); + thm tokens = viewshift_sep_slrule(left, right); + thm all = viewshift_sep_slrule(authority, tokens); + all = pure_rewrite_rule( + THM_LIST(sl_sep_emp_left(), sl_sep_emp_right()), all); + + thm fold1 = gsym_rule(fsl_bp_token1_definition( + `name:num`, `token1:int`)); + thm fold2 = gsym_rule(fsl_bp_token2_definition( + `name:num`, `token2:int`)); + term own = c_logic_current()->own; + term owned_authority = list_mk_comb( + own, + TERM_LIST(`name:num`, `fsl_bp_auth (bit1:int) (bit2:int)`)); + thm source_eq = mk_binop_rule( + sl_sep(), + refl_rule(owned_authority), + mk_binop_rule(sl_sep(), fold1, fold2)); + thm source_ent = eq2ent(gsym_rule(source_eq)); + dest_binop_results endpoints = dest_sl_viewshift(concl(all)); + thm result = viewshift_mono_slrule( + source_ent, + all, + refl_slrule(endpoints.tm2)); + result = gen_rule(`token2:int`, result); + result = gen_rule(`token1:int`, result); + result = gen_rule(`bit2:int`, result); + result = gen_rule(`bit1:int`, result); + result = gen_rule(`name:num`, result); + return result; +} + +PROOF thm FSL_BP_CLOSE_VIEWSHIFT = + prove_fsl_bp_close_viewshift(); + +/* ------------------------------------------------------------------------- */ +/* Representation operations */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm fsl_bp_unfold_inv_operation_proof(const term goal_tm) { + return prove_operation_by_entailment(goal_tm, eq2ent(fsl_bp_inv_def)); +} + +decl_operation(fsl_bp_unfold_inv_operation, + TERM_LIST(`name:num`, `pair:int`), + term_list_n(1, + `fsl_bp_inv (KEY name) (KEY pair)`), + term_list_n(0), + `exists (bit1:int) (bit2:int). + fact(fsl_bp_bit bit1) ** + fact(fsl_bp_bit bit2) ** + data_at + (field_addr pair Tfsl_bit_pair Fbits) + Tint + (bit1 + 2i * bit2) ** + own name (fsl_bp_auth bit1 bit2)` +) + +PROOF void fsl_bp_unfold_inv_as( + const term name, const term pair, + const term bit1_name, const term bit2_name) { + apply_operation_named_st( + fsl_bp_unfold_inv_operation, + TERM_LIST(name, pair), + TERM_LIST(bit1_name, bit2_name)); +} + +PROOF static thm fsl_bp_fold_inv_operation_proof(const term goal_tm) { + term resources = ` + fact(fsl_bp_bit (bit1:int)) ** + fact(fsl_bp_bit (bit2:int)) ** + data_at + (field_addr (pair:int) Tfsl_bit_pair Fbits) + Tint + (bit1 + 2i * bit2) ** + own (name:num) (fsl_bp_auth bit1 bit2)`; + term inner_exists = ` + exists hidden2:int. + fact(fsl_bp_bit (bit1:int)) ** + fact(fsl_bp_bit hidden2) ** + data_at + (field_addr (pair:int) Tfsl_bit_pair Fbits) + Tint + (bit1 + 2i * hidden2) ** + own (name:num) (fsl_bp_auth bit1 hidden2)`; + term both_exists = ` + exists (hidden1:int) (hidden2:int). + fact(fsl_bp_bit hidden1) ** + fact(fsl_bp_bit hidden2) ** + data_at + (field_addr (pair:int) Tfsl_bit_pair Fbits) + Tint + (hidden1 + 2i * hidden2) ** + own (name:num) (fsl_bp_auth hidden1 hidden2)`; + thm pack_inner = exists_slrule( + inner_exists, `bit2:int`, refl_slrule(resources)); + thm pack_both = exists_slrule( + both_exists, `bit1:int`, pack_inner); + thm definition = inst_rule( + TERM_PAIR_LIST( + (term_pair){`name:num`, `name:num`}, + (term_pair){`pair:int`, `pair:int`}), + fsl_bp_inv_def); + thm fold = trans_slrule( + pack_both, eq2ent(sym_rule(definition))); + return prove_operation_by_entailment(goal_tm, fold); +} + +decl_operation(fsl_bp_fold_inv_operation, + TERM_LIST(`name:num`, `pair:int`, `bit1:int`, `bit2:int`), + TERM_LIST( + `fact(KEY (fsl_bp_bit (bit1:int)))`, + `fact(KEY (fsl_bp_bit (bit2:int)))`, + `data_at + (field_addr (KEY pair) Tfsl_bit_pair Fbits) + Tint + (KEY (bit1 + 2i * bit2))`, + `own (KEY name) (KEY (fsl_bp_auth bit1 bit2))` + ), + term_list_n(0), + `fsl_bp_inv name pair` +) + +PROOF void fsl_bp_fold_inv( + const term name, const term pair, + const term bit1, const term bit2) { + apply_operation_st( + fsl_bp_fold_inv_operation, + TERM_LIST(name, pair, bit1, bit2)); +} + +PROOF static thm fsl_bp_unfold_token1_operation_proof(const term goal_tm) { + return prove_operation_by_entailment(goal_tm, eq2ent(fsl_bp_token1_def)); +} + +decl_operation(fsl_bp_unfold_token1_operation, + TERM_LIST(`name:num`, `value:int`), + term_list_n(1, `fsl_bp_token1 (KEY name) (KEY value)`), + term_list_n(0), + `own name (fsl_bp_frag1 value)` +) + +PROOF void fsl_bp_unfold_token1(const term name, const term value) { + apply_operation_st( + fsl_bp_unfold_token1_operation, + TERM_LIST(name, value)); +} + +PROOF static thm fsl_bp_fold_token1_operation_proof(const term goal_tm) { + return prove_operation_by_entailment( + goal_tm, eq2ent(sym_rule(fsl_bp_token1_def))); +} + +decl_operation(fsl_bp_fold_token1_operation, + TERM_LIST(`name:num`, `value:int`), + term_list_n(1, `own (KEY name) (KEY (fsl_bp_frag1 value))`), + term_list_n(0), + `fsl_bp_token1 name value` +) + +PROOF void fsl_bp_fold_token1(const term name, const term value) { + apply_operation_st( + fsl_bp_fold_token1_operation, + TERM_LIST(name, value)); +} + +PROOF static thm fsl_bp_unfold_token2_operation_proof(const term goal_tm) { + return prove_operation_by_entailment(goal_tm, eq2ent(fsl_bp_token2_def)); +} + +decl_operation(fsl_bp_unfold_token2_operation, + TERM_LIST(`name:num`, `value:int`), + term_list_n(1, `fsl_bp_token2 (KEY name) (KEY value)`), + term_list_n(0), + `own name (fsl_bp_frag2 value)` +) + +PROOF void fsl_bp_unfold_token2(const term name, const term value) { + apply_operation_st( + fsl_bp_unfold_token2_operation, + TERM_LIST(name, value)); +} + +PROOF static thm fsl_bp_fold_token2_operation_proof(const term goal_tm) { + return prove_operation_by_entailment( + goal_tm, eq2ent(sym_rule(fsl_bp_token2_def))); +} + +decl_operation(fsl_bp_fold_token2_operation, + TERM_LIST(`name:num`, `value:int`), + term_list_n(1, `own (KEY name) (KEY (fsl_bp_frag2 value))`), + term_list_n(0), + `fsl_bp_token2 name value` +) + +PROOF void fsl_bp_fold_token2(const term name, const term value) { + apply_operation_st( + fsl_bp_fold_token2_operation, + TERM_LIST(name, value)); +} + +PROOF static thm fsl_bp_agreement_entailment( + const bool first, + const term name, + const term stored1, + const term stored2, + const term token) { + term selected_ra = ` + auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))`; + term authority = list_mk_comb( + `fsl_bp_auth:int->int-> + (((int)excl#(int)excl)excl# + ((int)excl#(int)excl))`, + TERM_LIST(stored1, stored2)); + term fragment = mk_comb( + first + ? `fsl_bp_frag1:int-> + (((int)excl#(int)excl)excl# + ((int)excl#(int)excl))` + : `fsl_bp_frag2:int-> + (((int)excl#(int)excl)excl# + ((int)excl#(int)excl))`, + token); + term combined = list_mk_comb( + `ra_op: + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))ra-> + (((int)excl#(int)excl)excl# + ((int)excl#(int)excl))-> + (((int)excl#(int)excl)excl# + ((int)excl#(int)excl))-> + (((int)excl#(int)excl)excl# + ((int)excl#(int)excl))`, + TERM_LIST(selected_ra, authority, fragment)); + term own_at_name = mk_comb(c_logic_current()->own, name); + term owned_authority = mk_comb(own_at_name, authority); + term owned_fragment = mk_comb(own_at_name, fragment); + term owned_combined = mk_comb(own_at_name, combined); + term token_assertion = list_mk_comb( + first + ? `fsl_bp_token1:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))finmap)->bool` + : `fsl_bp_token2:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))finmap)->bool`, + TERM_LIST(name, token)); + term source = mk_sl_sep(owned_authority, token_assertion); + term equality = mk_eq(first ? stored1 : stored2, token); + + thm token_definition = first + ? fsl_bp_token1_definition(name, token) + : fsl_bp_token2_definition(name, token); + thm source_to_raw = mk_binop_rule( + sl_sep(), refl_rule(owned_authority), token_definition); + thm own_join = ispecl_rule( + TERM_LIST(name, authority, fragment), + c_logic_current()->ghost_own_join); + thm source_to_combined = trans_slrule( + eq2ent(source_to_raw), own_join); + + thm validity = ispecl_rule( + TERM_LIST(name, combined), + c_logic_current()->ghost_own_valid); + thm agreement = ispecl_rule( + TERM_LIST(stored1, stored2, token), + first ? FSL_BP_AUTH_FRAG1_AGREE : FSL_BP_AUTH_FRAG2_AGREE); + thm fact_change = fact_transition_slrule(agreement); + thm fact_with_ownership = frame_right_slrule( + fact_change, owned_combined); + thm own_split = ispecl_rule( + TERM_LIST(name, authority, fragment), + c_logic_current()->ghost_own_split); + thm combined_to_source = trans_slrule( + own_split, eq2ent(gsym_rule(source_to_raw))); + thm restore_source = frame_left_slrule( + mk_sl_fact(equality), combined_to_source); + + thm result = trans_slrule(source_to_combined, validity); + result = trans_slrule(result, fact_with_ownership); + result = trans_slrule(result, restore_source); + ENSURE_COND(equals_term(dest_sl_ent(concl(result)).tm1, source), + "bit-pair agreement entailment changed its source"); + return result; +err: + ERR_FUN_PUTS("fsl_bp_agreement_entailment"); + return empty_theorem; +} + +PROOF static thm fsl_bp_agree1_operation_proof(const term goal_tm) { + thm agreement = fsl_bp_agreement_entailment( + true, `name:num`, `stored1:int`, `stored2:int`, `token:int`); + return prove_operation_by_entailment(goal_tm, agreement); +} + +decl_operation(fsl_bp_agree1_operation, + TERM_LIST(`name:num`, `stored1:int`, `stored2:int`, `token:int`), + TERM_LIST( + `own + (KEY name) + (KEY (fsl_bp_auth stored1 stored2))`, + `fsl_bp_token1 (KEY name) (KEY token)` + ), + term_list_n(0), + `fact(stored1 == token) ** + (own name (fsl_bp_auth stored1 stored2) ** + fsl_bp_token1 name token)` +) + +PROOF void fsl_bp_agree1( + const term name, const term stored1, + const term stored2, const term token_value) { + apply_operation_st( + fsl_bp_agree1_operation, + TERM_LIST(name, stored1, stored2, token_value)); +} + +PROOF static thm fsl_bp_agree2_operation_proof(const term goal_tm) { + thm agreement = fsl_bp_agreement_entailment( + false, `name:num`, `stored1:int`, `stored2:int`, `token:int`); + return prove_operation_by_entailment(goal_tm, agreement); +} + +decl_operation(fsl_bp_agree2_operation, + TERM_LIST(`name:num`, `stored1:int`, `stored2:int`, `token:int`), + TERM_LIST( + `own + (KEY name) + (KEY (fsl_bp_auth stored1 stored2))`, + `fsl_bp_token2 (KEY name) (KEY token)` + ), + term_list_n(0), + `fact(stored2 == token) ** + (own name (fsl_bp_auth stored1 stored2) ** + fsl_bp_token2 name token)` +) + +PROOF void fsl_bp_agree2( + const term name, const term stored1, + const term stored2, const term token_value) { + apply_operation_st( + fsl_bp_agree2_operation, + TERM_LIST(name, stored1, stored2, token_value)); +} + +PROOF void fsl_bp_init_ghost_and_fold(const term pair) { + term symbolic_state = get_symbolic_state(); + term_list branches = strip_binop(sl_or(), symbolic_state); + term frame = symbolic_state; + if (branches != NULL) { + ENSURE_COND(vector_size(branches) == 1, + "bit-pair initialization requires one symbolic-state branch"); + frame = branches[0]; + } + thm framed = viewshift_frame_slrule(FSL_BP_INIT_VIEWSHIFT, frame); + + term body_fn = ` + \allocated_name:num. + own allocated_name (fsl_bp_auth 0i 0i) ** + (fsl_bp_token1 allocated_name 0i ** + fsl_bp_token2 allocated_name 0i)`; + thm pull = beta_rule(ispecl_rule( + TERM_LIST(body_fn, frame), + sl_sep_exists_left())); + thm pull_ent = eq2ent(pull); + dest_binder_results opened = dest_sl_exists( + dest_sl_ent(concl(pull_ent)).tm2); + term fresh_name = `fsl_bp_allocated_name:num`; + term opened_body = subst_one(fresh_name, opened.v, opened.tm); + + thm add_bits = add_facts_hconv(THM_LIST( + FSL_BP_BIT_ZERO, + FSL_BP_BIT_ZERO)); + thm add_bits_at_target = local_apply(opened_body, add_bits); + term opened_with_bits = dest_sl_ent(concl(add_bits_at_target)).tm2; + thm fold_inv = operation_hconv( + fsl_bp_fold_inv_operation, + opened_with_bits, + TERM_LIST(fresh_name, pair, `0i`, `0i`)); + thm fold_after_bits = trans_slrule( + add_bits_at_target, + local_apply(opened_with_bits, fold_inv)); + thm sealed = exists_mono_slrule( + fresh_name, + fold_after_bits); + thm target = trans_slrule(pull_ent, sealed); + dest_binop_results endpoints = dest_sl_viewshift(concl(framed)); + thm complete = viewshift_mono_slrule( + refl_slrule(endpoints.tm1), + framed, + target); + set_symbolic_state(complete); + return; +err: + ERR_FUN_PUTS("fsl_bp_init_ghost_and_fold", cstr_term(pair)); + return; +} + +PROOF int install_fsl_bit_pair_qcp_interface(void) { + static bool installed = false; + if (installed) return 0; + /* `cst_new_fun_definition` registered every opaque constant above. */ + installed = true; + return 0; +} + +PROOF static int _FSL_BP_AUDIT = audit_closed_proof_unit( + "fictional_sl_bit_pair", + FSL_BP_AXIOMS_BEFORE, + THM_LIST( + fsl_bp_bit_def, + fsl_bp_base_def, + fsl_bp_left_def, + fsl_bp_right_def, + fsl_bp_auth_def, + fsl_bp_frag1_def, + fsl_bp_frag2_def, + fsl_bp_bundle_def, + fsl_bp_token1_def, + fsl_bp_token2_def, + fsl_bp_inv_def, + FSL_BP_ZERO_CASE, + FSL_BP_BIT_ZERO, + FSL_BP_BIT_ONE, + FSL_BP_BIT_RANGE, + FSL_BP_ENCODING_LAWS, + FSL_BP_LEFT_RIGHT, + FSL_BP_BASE_VALID, + FSL_BP_BASE_CANCELLATIVE, + FSL_BP_AUTH_FRAG1_AGREE, + FSL_BP_AUTH_FRAG2_AGREE, + FSL_BP_OWN_AUTH_FRAG1, + FSL_BP_JOIN_AUTH_FRAG1, + FSL_BP_OWN_AUTH_FRAG2, + FSL_BP_JOIN_AUTH_FRAG2, + FSL_BP_FRAGMENT_SPLIT, + FSL_BP_FRAGMENT_JOIN, + FSL_BP_OWN_SPLIT, + FSL_BP_OWN_JOIN, + FSL_BP_UPDATE1, + FSL_BP_UPDATE2, + FSL_BP_INIT_VIEWSHIFT, + FSL_BP_SET1_VIEWSHIFT, + FSL_BP_SET2_VIEWSHIFT, + FSL_BP_CLOSE_VIEWSHIFT, + fsl_bp_unfold_inv_operation.lemma, + fsl_bp_fold_inv_operation.lemma, + fsl_bp_unfold_token1_operation.lemma, + fsl_bp_fold_token1_operation.lemma, + fsl_bp_unfold_token2_operation.lemma, + fsl_bp_fold_token2_operation.lemma, + fsl_bp_agree1_operation.lemma, + fsl_bp_agree2_operation.lemma)); diff --git a/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.h b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.h new file mode 100644 index 0000000000000000000000000000000000000000..21bbf6c541b5a32837666ecf1cbf26ef45e7b049 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_model.h @@ -0,0 +1,80 @@ +#pragma once + +/* + * Fictional two-field ownership over one physical integer cell. + * + * `fsl_bp_inv name pair` is the implementation invariant. Its two bit values + * are existentially hidden together with the physical encoding and authority. + * The two client token predicates own disjoint left/right fragments at the + * same ordinary logical name. Thus clients can observe a bit only through + * the corresponding token and module operation; the representation state is + * not part of the invariant's public index. + */ + +#include "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.h" +#require "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair_logic.c" + +#include "userlib/operational/operational.h" +#require "userlib/operational/operational.c" + +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" + +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + +/* Export the opaque invariant and token constants to QCP. */ +PROOF int install_fsl_bit_pair_qcp_interface(void); + +/* Algebraic and selected-viewshift protocol. */ +PROOF extern thm FSL_BP_BASE_CANCELLATIVE; +PROOF extern thm FSL_BP_ZERO_CASE; +PROOF extern thm FSL_BP_BIT_ZERO; +PROOF extern thm FSL_BP_BIT_ONE; +PROOF extern thm FSL_BP_BIT_RANGE; +PROOF extern thm FSL_BP_ENCODING_LAWS; +PROOF extern thm FSL_BP_SET1_VIEWSHIFT; +PROOF extern thm FSL_BP_SET2_VIEWSHIFT; +PROOF extern thm FSL_BP_INIT_VIEWSHIFT; +PROOF extern thm FSL_BP_CLOSE_VIEWSHIFT; + +/* Private representation operations used only by the implementation. */ +PROOF void fsl_bp_unfold_inv_as( + const term name, + const term pair, + const term bit1_name, + const term bit2_name); +PROOF void fsl_bp_fold_inv( + const term name, + const term pair, + const term bit1, + const term bit2); +PROOF void fsl_bp_unfold_token1( + const term name, + const term bit); +PROOF void fsl_bp_fold_token1( + const term name, + const term bit); +PROOF void fsl_bp_unfold_token2( + const term name, + const term bit); +PROOF void fsl_bp_fold_token2( + const term name, + const term bit); + +/* Preserve ownership and derive agreement between the hidden authority and + * the selected client fragment as a pure fact. */ +PROOF void fsl_bp_agree1( + const term name, + const term stored1, + const term stored2, + const term token_value); +PROOF void fsl_bp_agree2( + const term name, + const term stored1, + const term stored2, + const term token_value); + +/* Allocate one shared ghost name, frame the initialized word, and seal the + * authority into the invariant while leaving both client tokens outside. */ +PROOF void fsl_bp_init_ghost_and_fold(const term pair); diff --git a/psi_examples/logical_resources/fictional_sl/bit_pair/client.c b/psi_examples/logical_resources/fictional_sl/bit_pair/client.c new file mode 100644 index 0000000000000000000000000000000000000000..5d8e28e7fff2513c327e4012c5a709f4098c2138 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/bit_pair/client.c @@ -0,0 +1,31 @@ +#include "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.h" +#require "psi_examples/logical_resources/fictional_sl/bit_pair/bit_pair.c" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" + +// verify_all: expect-vcs=0 + +/* + * The two tokens can be used independently although both accessors share one + * physical `int`. The final call consumes the invariant and both same-name + * tokens and returns the physical cell as ordinary allocated storage. + */ +int fsl_bit_pair_client(struct fsl_bit_pair *pair) + REQUIRE(`undef_data_at (field_addr pair Tfsl_bit_pair Fbits) Tint`) + ENSURE(`undef_data_at (field_addr pair Tfsl_bit_pair Fbits) Tint`, + `fact((__return:int) == 3i)`) +{ + fsl_bp_init(pair); + + PROOF add_fact_st(FSL_BP_BIT_ONE); + fsl_bp_set1(pair, 1); + int first = fsl_bp_get1(pair); + + PROOF add_fact_st(FSL_BP_BIT_ONE); + fsl_bp_set2(pair, 1); + int second = fsl_bp_get2(pair); + + fsl_bp_free(pair); + return first + 2 * second; +} diff --git a/psi_examples/logical_resources/fictional_sl/fractional_permissions/fractional_permissions.c b/psi_examples/logical_resources/fictional_sl/fractional_permissions/fractional_permissions.c new file mode 100644 index 0000000000000000000000000000000000000000..63cebf282549a5899e7818e0ccbdf05ebe8322e9 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/fractional_permissions/fractional_permissions.c @@ -0,0 +1,199 @@ +#include "psi_examples/logical_resources/fictional_sl/fractional_permissions/fractional_permissions.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" +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" + +// verify_all: expect-vcs=0 + +PROOF static size_t FSL_FRAC_AXIOMS_BEFORE = vector_size(get_all_axioms()); + +PROOF static thm prove_fsl_frac_split_join(void) { + term goal_tm = ` + forall (p:real) (q:real) (value:A). + &0 < p ==> + &0 < q ==> + p + q == &1 ==> + ra_op + (frac_ra (agree_ra:((A)agree)ra)) + (frac_own p (Agree value)) + (frac_own q (Agree value)) == + frac_full (Agree value) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm composed = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `p:real`, `q:real`, + `Agree (value:A)`, `Agree (value:A)`), + frac_ra_own_op); + composed = mp_rule(composed, assume_rule(`&0 < (p:real)`)); + composed = mp_rule(composed, assume_rule(`&0 < (q:real)`)); + composed = pure_rewrite_rule( + THM_LIST( + agree_ra_idempotent, + assume_rule(`(p:real) + q == &1`)), + composed); + body = CONV_TAC(body, once_rewrite_conv(THM_LIST(frac_ra_full))); + ACCEPT_TAC(body, composed); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_FRAC_SPLIT_JOIN has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_frac_split_join"); + return empty_theorem; +} + +PROOF thm FSL_FRAC_SPLIT_JOIN = prove_fsl_frac_split_join(); + +PROOF static thm prove_fsl_frac_valid_combine(void) { + term goal_tm = ` + forall (p:real) (q:real) (left:A) (right:A). + &0 < p ==> + &0 < q ==> + (ra_valid + (frac_ra (agree_ra:((A)agree)ra)) + (ra_op + (frac_ra agree_ra) + (frac_own p (Agree left)) + (frac_own q (Agree right))) <=> + (p + q <= &1 && left == right)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm p_positive = assume_rule(`&0 < (p:real)`); + thm q_positive = assume_rule(`&0 < (q:real)`); + thm sum_positive = mp_rule( + mp_rule( + real_arith_rule(` + &0 < (p:real) ==> &0 < (q:real) ==> &0 < p + q`), + p_positive), + q_positive); + thm composed = ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `p:real`, `q:real`, + `Agree (left:A)`, `Agree (right:A)`), + frac_ra_own_op); + composed = mp_rule(mp_rule(composed, p_positive), q_positive); + thm valid_owned = mp_rule( + ispecl_rule( + TERM_LIST( + `agree_ra:((A)agree)ra`, + `(p:real) + q`, + `ra_op agree_ra (Agree (left:A)) (Agree (right:A))`), + frac_ra_valid_own), + sum_positive); + body = CONV_TAC( + body, + rewrite_conv(THM_LIST( + composed, + valid_owned, + agree_ra_valid_combine_iff))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_FRAC_VALID_COMBINE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_frac_valid_combine"); + return empty_theorem; +} + +PROOF thm FSL_FRAC_VALID_COMBINE = + prove_fsl_frac_valid_combine(); + +PROOF static thm prove_fsl_frac_full_update(void) { + term goal_tm = ` + forall (old:A) (next:A). + ra_update + (frac_ra (agree_ra:((A)agree)ra)) + (frac_full (Agree old)) + (frac_full (Agree next)) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + body = CONV_TAC( + body, + once_rewrite_conv(THM_LIST(frac_ra_update_full_iff))); + body = DISCH_TAC(body, "Hsource_valid"); + ACCEPT_TAC( + body, + ispec_rule(`next:A`, agree_ra_valid_owned)); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_FRAC_FULL_UPDATE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_frac_full_update"); + return empty_theorem; +} + +PROOF thm FSL_FRAC_FULL_UPDATE = prove_fsl_frac_full_update(); + +PROOF thm fsl_frac_scale_def = new_fun_definition(` + fsl_frac_scale + (z:real) + (p:real) + (payload:A) : (A)frac = + frac_own (z * p) payload +`); + +PROOF static thm prove_fsl_frac_scale_op(void) { + term goal_tm = ` + forall + (R:(A)ra) + (z:real) (p:real) (q:real) + (left:A) (right:A). + &0 < z * p ==> + &0 < z * q ==> + ra_op + (frac_ra R) + (fsl_frac_scale z p left) + (fsl_frac_scale z q right) == + fsl_frac_scale z (p + q) (ra_op R left right) + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm zp_positive = assume_rule(`&0 < (z:real) * (p:real)`); + thm zq_positive = assume_rule(`&0 < (z:real) * (q:real)`); + thm composed = ispecl_rule( + TERM_LIST( + `R:(A)ra`, + `(z:real) * p`, `(z:real) * q`, + `left:A`, `right:A`), + frac_ra_own_op); + composed = mp_rule(mp_rule(composed, zp_positive), zq_positive); + composed = pure_rewrite_rule( + THM_LIST( + real_arith_rule(` + (z:real) * (p:real) + z * (q:real) == z * (p + q)`)), + composed); + body = CONV_TAC( + body, + pure_rewrite_conv(THM_LIST(fsl_frac_scale_def))); + ACCEPT_TAC(body, composed); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_FRAC_SCALE_OP has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_frac_scale_op"); + return empty_theorem; +} + +PROOF thm FSL_FRAC_SCALE_OP = prove_fsl_frac_scale_op(); + +PROOF static int _FSL_FRAC_AUDIT = audit_closed_proof_unit( + "fictional_sl_fractional_permissions", + FSL_FRAC_AXIOMS_BEFORE, + THM_LIST( + FSL_FRAC_SPLIT_JOIN, + FSL_FRAC_VALID_COMBINE, + FSL_FRAC_FULL_UPDATE, + fsl_frac_scale_def, + FSL_FRAC_SCALE_OP)); diff --git a/psi_examples/logical_resources/fictional_sl/fractional_permissions/fractional_permissions.h b/psi_examples/logical_resources/fictional_sl/fractional_permissions/fractional_permissions.h new file mode 100644 index 0000000000000000000000000000000000000000..410c6750b343a53655b31fe7efef2ff0e332a338 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/fractional_permissions/fractional_permissions.h @@ -0,0 +1,22 @@ +#pragma once + +/* + * Algebraic core of FSL Sections 5.1, 6, and Appendix A-4.4. + * A value share is `frac_own p (Agree value)`: weights compose additively, + * while agreement makes two readable shares compatible only at one value. + */ + +#include "proof/theory/logic/agree_ra.h" +#include "proof/theory/logic/frac_ra.h" + +/* Positive shares of one value join to a full share when p + q = 1. */ +PROOF extern thm FSL_FRAC_SPLIT_JOIN; + +/* Compatibility is exactly bounded total weight plus value agreement. */ +PROOF extern thm FSL_FRAC_VALID_COMBINE; + +/* Full permission may change the protected value frame-preservingly. */ +PROOF extern thm FSL_FRAC_FULL_UPDATE; + +/* Scaling distributes when both resulting scaled weights are positive. */ +PROOF extern thm FSL_FRAC_SCALE_OP; diff --git a/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.c b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.c new file mode 100644 index 0000000000000000000000000000000000000000..12ab3ed3773d13f423f076101dd53755171dd4a7 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.c @@ -0,0 +1,901 @@ +#include "psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.h" + +#require "proof/theory/logic/auth_ra.c" +#require "proof/theory/logic/excl_ra.c" +#require "proof/theory/logic/max_nat_ra.c" +#require "proof/theory/logic/prod_ra.c" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" + +PROOF static size_t FSL_TWO_AXIOMS_BEFORE = vector_size(get_all_axioms()); + +PROOF term fsl_two_bp_ra_term(void) { + return ` + auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)): + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl)))ra + `; +} + +PROOF term fsl_two_mc_ra_term(void) { + return `auth_ra max_nat_ra:(((num)excl#num))ra`; +} + +PROOF term fsl_two_modules_ra_term(void) { + return ` + prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra): + (((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num)))ra + `; +} + +/* ------------------------------------------------------------------------- */ +/* Constructors */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm fsl_two_bp_base_def = new_fun_definition(` + fsl_two_bp_base (bit1:int) (bit2:int) = + ((Excl bit1):(int)excl,(Excl bit2):(int)excl) +`); + +PROOF static thm fsl_two_bp_left_fragment_def = new_fun_definition(` + fsl_two_bp_left_fragment (value:int) = + ((Excl value):(int)excl,(ExclUnit:(int)excl)) +`); + +PROOF static thm fsl_two_bp_right_fragment_def = new_fun_definition(` + fsl_two_bp_right_fragment (value:int) = + ((ExclUnit:(int)excl),(Excl value):(int)excl) +`); + +PROOF static thm fsl_two_left_def = new_fun_definition(` + fsl_two_left + (b:(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))) = + (b, ra_unit (auth_ra max_nat_ra)) +`); + +PROOF static thm fsl_two_right_def = new_fun_definition(` + fsl_two_right (m:((num)excl#num)) = + (ra_unit + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))), + m) +`); + +/* ------------------------------------------------------------------------- */ +/* Embedding laws */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fsl_two_embed_op(void) { + term goal_tm = ` + forall + (b:(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))) + (m:((num)excl#num)). + ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_left b) + (fsl_two_right m) == + (b,m) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST( + fsl_two_left_def, + fsl_two_right_def, + prod_ra_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + ra_unit_l, + ra_unit_r))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_EMBED_OP has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_embed_op"); + return empty_theorem; +} + +PROOF thm FSL_TWO_EMBED_OP = prove_fsl_two_embed_op(); + +PROOF static thm prove_fsl_two_left_op(void) { + term goal_tm = ` + forall + (x:(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))) y. + ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_left x) + (fsl_two_left y) == + fsl_two_left + (ra_op + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + x y) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST( + fsl_two_left_def, + prod_ra_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + ra_unit_l))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_LEFT_OP has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_left_op"); + return empty_theorem; +} + +PROOF thm FSL_TWO_LEFT_OP = prove_fsl_two_left_op(); + +PROOF static thm prove_fsl_two_right_op(void) { + term goal_tm = ` + forall (x:((num)excl#num)) y. + ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_right x) + (fsl_two_right y) == + fsl_two_right (ra_op (auth_ra max_nat_ra) x y) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST( + fsl_two_right_def, + prod_ra_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + ra_unit_l))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_RIGHT_OP has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_right_op"); + return empty_theorem; +} + +PROOF thm FSL_TWO_RIGHT_OP = prove_fsl_two_right_op(); + +PROOF static thm prove_fsl_two_left_valid(void) { + term goal_tm = ` + forall b:(((int)excl#(int)excl)excl# + ((int)excl#(int)excl)). + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_left b) <=> + ra_valid + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + b + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST( + fsl_two_left_def, + prod_ra_valid, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + ra_valid_unit, + get_theorem_by_name("AND_CLAUSES")))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_LEFT_VALID has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_left_valid"); + return empty_theorem; +} + +PROOF thm FSL_TWO_LEFT_VALID = prove_fsl_two_left_valid(); + +PROOF static thm prove_fsl_two_right_valid(void) { + term goal_tm = ` + forall m:((num)excl#num). + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_right m) <=> + ra_valid (auth_ra max_nat_ra) m + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST( + fsl_two_right_def, + prod_ra_valid, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + ra_valid_unit, + get_theorem_by_name("AND_CLAUSES")))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_RIGHT_VALID has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_right_valid"); + return empty_theorem; +} + +PROOF thm FSL_TWO_RIGHT_VALID = prove_fsl_two_right_valid(); + +/* ------------------------------------------------------------------------- */ +/* Generic lifted updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fsl_two_update_left(void) { + term goal_tm = ` + forall + (b:(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))) b'. + ra_update + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + b b' ==> + ra_update + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_left b) + (fsl_two_left b') + `; + thm lift = ispecl_rule( + TERM_LIST( + fsl_two_bp_ra_term(), + fsl_two_mc_ra_term(), + `b:(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))`, + `ra_unit (auth_ra max_nat_ra)`, + `b':(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))`), + prod_ra_update_left); + thm proved = pure_rewrite_rule( + THM_LIST(gsym_rule(fsl_two_left_def)), lift); + proved = gen_rule( + `b':(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))`, + proved); + proved = gen_rule( + `b:(((int)excl#(int)excl)excl# + ((int)excl#(int)excl))`, + proved); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_UPDATE_LEFT has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_update_left"); + return empty_theorem; +} + +PROOF thm FSL_TWO_UPDATE_LEFT = prove_fsl_two_update_left(); + +PROOF static thm prove_fsl_two_update_right(void) { + term goal_tm = ` + forall (m:((num)excl#num)) m'. + ra_update (auth_ra max_nat_ra) m m' ==> + ra_update + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_right m) + (fsl_two_right m') + `; + thm lift = ispecl_rule( + TERM_LIST( + fsl_two_bp_ra_term(), + fsl_two_mc_ra_term(), + `ra_unit + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)))`, + `m:((num)excl#num)`, + `m':((num)excl#num)`), + prod_ra_update_right); + thm proved = pure_rewrite_rule( + THM_LIST(gsym_rule(fsl_two_right_def)), lift); + proved = gen_rule(`m':((num)excl#num)`, proved); + proved = gen_rule(`m:((num)excl#num)`, proved); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_UPDATE_RIGHT has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_update_right"); + return empty_theorem; +} + +PROOF thm FSL_TWO_UPDATE_RIGHT = prove_fsl_two_update_right(); + +/* ------------------------------------------------------------------------- */ +/* Module-specific updates */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fsl_two_bp_left_right(void) { + term goal_tm = ` + forall (bit1:int) (bit2:int). + ra_op + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_two_bp_left_fragment bit1) + (fsl_two_bp_right_fragment bit2) == + fsl_two_bp_base bit1 bit2 + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST( + fsl_two_bp_left_fragment_def, + fsl_two_bp_right_fragment_def, + fsl_two_bp_base_def, + prod_ra_op, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + gsym_rule(excl_ra_unit), + ra_unit_l, + ra_unit_r))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_BP_LEFT_RIGHT has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_left_right"); + return empty_theorem; +} + +PROOF static thm FSL_TWO_BP_LEFT_RIGHT = + prove_fsl_two_bp_left_right(); + +PROOF static thm prove_fsl_two_bp_base_valid(void) { + term goal_tm = ` + forall (bit1:int) (bit2:int). + ra_valid + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_two_bp_base bit1 bit2) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, rewrite_conv(THM_LIST( + fsl_two_bp_base_def, + prod_ra_valid, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + excl_ra_valid_owned, + get_theorem_by_name("AND_CLAUSES")))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_BP_BASE_VALID has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_base_valid"); + return empty_theorem; +} + +PROOF static thm FSL_TWO_BP_BASE_VALID = + prove_fsl_two_bp_base_valid(); + +PROOF static thm prove_fsl_two_bp_base_cancellative(void) { + term goal_tm = ` + ra_cancellative + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + `; + thm characterization = ispecl_rule( + TERM_LIST( + `excl_ra:((int)excl)ra`, + `excl_ra:((int)excl)ra`), + prod_ra_cancellative_iff); + type_pair_list types = (type_pair_list)vector_create(); + vector_add(&types, ((type_pair){`:int`, `:A`})); + thm excl_cancellative = inst_type_rule(types, excl_ra_cancellative); + thm proved = eq_mp_rule( + gsym_rule(characterization), + conj_rule(excl_cancellative, excl_cancellative)); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_BP_BASE_CANCELLATIVE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_base_cancellative"); + return empty_theorem; +} + +PROOF static thm FSL_TWO_BP_BASE_CANCELLATIVE = + prove_fsl_two_bp_base_cancellative(); + +PROOF static thm prove_fsl_two_bp_init_valid(void) { + term goal_tm = ` + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_left + (auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_two_bp_base 0i 0i))) + (fsl_two_left + (auth_frag (fsl_two_bp_left_fragment 0i)))) + `; + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + term base = `fsl_two_bp_base 0i 0i`; + term fragment = `fsl_two_bp_left_fragment 0i`; + term other = `fsl_two_bp_right_fragment 0i`; + term authority = ` + auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_two_bp_base 0i 0i)`; + term auth_fragment = `auth_frag (fsl_two_bp_left_fragment 0i)`; + term combined = ` + auth_both + (fsl_two_bp_base 0i 0i) + (fsl_two_bp_left_fragment 0i)`; + + thm included = ispecl_rule( + TERM_LIST(base_ra, fragment, other), + ra_included_op_l); + thm fragment_composition = ispecl_rule( + TERM_LIST(`0i`, `0i`), + FSL_TWO_BP_LEFT_RIGHT); + included = conv_rule( + once_rewrite_conv(THM_LIST(fragment_composition)), + included); + thm base_valid = ispecl_rule( + TERM_LIST(`0i`, `0i`), + FSL_TWO_BP_BASE_VALID); + thm valid_both = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST(base_ra, base, fragment), + auth_ra_valid_both)), + conj_rule(base_valid, included)); + + thm left_valid = eq_mp_rule( + gsym_rule(ispec_rule(combined, FSL_TWO_LEFT_VALID)), + valid_both); + thm embedded_composition = ispecl_rule( + TERM_LIST(authority, auth_fragment), + FSL_TWO_LEFT_OP); + thm authority_composition = ispecl_rule( + TERM_LIST(base_ra, base, fragment), + auth_ra_auth_frag); + embedded_composition = conv_rule( + once_rewrite_conv(THM_LIST(authority_composition)), + embedded_composition); + thm proved = conv_rule( + once_rewrite_conv(THM_LIST(gsym_rule(embedded_composition))), + left_valid); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_BP_INIT_VALID has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_init_valid"); + return empty_theorem; +} + +PROOF thm FSL_TWO_BP_INIT_VALID = + prove_fsl_two_bp_init_valid(); + +PROOF static thm prove_fsl_two_bp_auth_frag1_agree(void) { + term goal_tm = ` + forall (stored1:int) (stored2:int) (token:int). + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_left + (auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_two_bp_base stored1 stored2))) + (fsl_two_left + (auth_frag (fsl_two_bp_left_fragment token)))) ==> + stored1 == token + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm valid = assume_rule(` + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_left + (auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_two_bp_base (stored1:int) (stored2:int)))) + (fsl_two_left + (auth_frag (fsl_two_bp_left_fragment (token:int)))))`); + valid = pure_rewrite_rule( + THM_LIST( + FSL_TWO_LEFT_OP, + FSL_TWO_LEFT_VALID, + auth_ra_auth_frag, + auth_ra_valid_both, + fsl_two_bp_base_def, + fsl_two_bp_left_fragment_def, + prod_ra_included, + get_theorem_by_name("FST"), + get_theorem_by_name("SND"), + excl_ra_included_owned), + valid); + thm agreement = conjunct1_rule(conjunct2_rule(valid)); + ACCEPT_TAC(body, gsym_rule(agreement)); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_BP_AUTH_FRAG1_AGREE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_auth_frag1_agree"); + return empty_theorem; +} + +PROOF thm FSL_TWO_BP_AUTH_FRAG1_AGREE = + prove_fsl_two_bp_auth_frag1_agree(); + +PROOF static thm prove_fsl_two_bp_set1_payload_update(void) { + term bp_base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + thm target_valid = ispecl_rule( + TERM_LIST(`next:int`, `other:int`), + FSL_TWO_BP_BASE_VALID); + thm valid_composed = pure_once_rewrite_rule( + THM_LIST(gsym_rule(ispecl_rule( + TERM_LIST(`next:int`, `other:int`), + FSL_TWO_BP_LEFT_RIGHT))), + target_valid); + thm local = mp_rule( + mp_rule( + ispecl_rule( + TERM_LIST( + bp_base_ra, + `fsl_two_bp_left_fragment (old:int)`, + `fsl_two_bp_left_fragment (next:int)`, + `fsl_two_bp_right_fragment (other:int)`), + ra_local_update_cancellative), + FSL_TWO_BP_BASE_CANCELLATIVE), + valid_composed); + thm update = mp_rule( + ispecl_rule( + TERM_LIST( + bp_base_ra, + `ra_op ${bp_base_ra:(((int)excl#(int)excl)ra)} + (fsl_two_bp_left_fragment (old:int)) + (fsl_two_bp_right_fragment (other:int))`, + `fsl_two_bp_left_fragment (old:int)`, + `ra_op ${bp_base_ra:(((int)excl#(int)excl)ra)} + (fsl_two_bp_left_fragment (next:int)) + (fsl_two_bp_right_fragment (other:int))`, + `fsl_two_bp_left_fragment (next:int)`), + auth_ra_update_local), + local); + update = pure_rewrite_rule(THM_LIST(FSL_TWO_BP_LEFT_RIGHT), update); + update = gen_rule(`other:int`, update); + update = gen_rule(`next:int`, update); + update = gen_rule(`old:int`, update); + return update; +} + +PROOF static thm FSL_TWO_BP_SET1_PAYLOAD_UPDATE = + prove_fsl_two_bp_set1_payload_update(); + +PROOF static thm prove_fsl_two_bp_set1_update(void) { + thm lift = ispecl_rule( + TERM_LIST( + `auth_both + (fsl_two_bp_base (old:int) (other:int)) + (fsl_two_bp_left_fragment old)`, + `auth_both + (fsl_two_bp_base (next:int) (other:int)) + (fsl_two_bp_left_fragment next)`), + FSL_TWO_UPDATE_LEFT); + thm proved = mp_rule(lift, ispecl_rule( + TERM_LIST(`old:int`, `next:int`, `other:int`), + FSL_TWO_BP_SET1_PAYLOAD_UPDATE)); + proved = gen_rule(`other:int`, proved); + proved = gen_rule(`next:int`, proved); + proved = gen_rule(`old:int`, proved); + return proved; +} + +PROOF thm FSL_TWO_BP_SET1_UPDATE = + prove_fsl_two_bp_set1_update(); + +PROOF static thm prove_fsl_two_mc_raise_payload_update(void) { + term goal_tm = ` + forall (current:num) (next:num) (known:num). + current <= next ==> + ra_update + (auth_ra max_nat_ra) + (auth_both current known) + (auth_both next known) + `; + 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(`current:num`, `next:num`), + max_nat_ra_included)), + assume_rule(`(current:num) <= (next:num)`)); + thm condition = disch_rule( + `ra_valid max_nat_ra (current:num)`, + conj_rule(ispec_rule(`next:num`, max_nat_ra_valid), included)); + thm authority_update = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `max_nat_ra:(num)ra`, + `current:num`, + `next:num`), + auth_ra_update_auth_iff)), + condition); + thm updated = mp_rule( + ispecl_rule( + TERM_LIST( + `auth_ra max_nat_ra`, + `auth_auth max_nat_ra (current:num)`, + `auth_auth max_nat_ra (next:num)`, + `auth_frag (known:num)`), + ra_update_frame), + authority_update); + updated = rewrite_rule(THM_LIST(auth_ra_auth_frag), updated); + ACCEPT_TAC(body, updated); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_MC_RAISE_PAYLOAD_UPDATE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_mc_raise_payload_update"); + return empty_theorem; +} + +PROOF static thm FSL_TWO_MC_RAISE_PAYLOAD_UPDATE = + prove_fsl_two_mc_raise_payload_update(); + +PROOF static thm prove_fsl_two_mc_raise_update(void) { + term premise = `(current:num) <= (next:num)`; + thm payload = mp_rule( + ispecl_rule( + TERM_LIST(`current:num`, `next:num`, `known:num`), + FSL_TWO_MC_RAISE_PAYLOAD_UPDATE), + assume_rule(premise)); + thm lift = ispecl_rule( + TERM_LIST( + `auth_both (current:num) (known:num)`, + `auth_both (next:num) (known:num)`), + FSL_TWO_UPDATE_RIGHT); + thm proved = mp_rule(lift, payload); + proved = disch_rule(premise, proved); + proved = gen_rule(`known:num`, proved); + proved = gen_rule(`next:num`, proved); + proved = gen_rule(`current:num`, proved); + return proved; +} + +PROOF thm FSL_TWO_MC_RAISE_UPDATE = + prove_fsl_two_mc_raise_update(); + +PROOF static thm prove_fsl_two_mc_init_valid(void) { + term goal_tm = ` + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_right (auth_auth max_nat_ra 0)) + (fsl_two_right (auth_frag 0))) + `; + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC(root, then_conv( + rewrite_conv(THM_LIST( + FSL_TWO_RIGHT_OP, + FSL_TWO_RIGHT_VALID, + auth_ra_auth_frag, + auth_ra_valid_both, + max_nat_ra_valid, + max_nat_ra_included, + get_theorem_by_name("AND_CLAUSES"))), + get_conversion_by_name("NUM_REDUCE_CONV"))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_MC_INIT_VALID has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_mc_init_valid"); + return empty_theorem; +} + +PROOF thm FSL_TWO_MC_INIT_VALID = + prove_fsl_two_mc_init_valid(); + +PROOF static thm prove_fsl_two_mc_auth_frag_bound(void) { + term goal_tm = ` + forall (current:num) (known:num). + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_right (auth_auth max_nat_ra current)) + (fsl_two_right (auth_frag known))) ==> + known <= current + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + thm valid = assume_rule(` + ra_valid + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_right + (auth_auth max_nat_ra (current:num))) + (fsl_two_right (auth_frag (known:num))))`); + valid = pure_rewrite_rule( + THM_LIST( + FSL_TWO_RIGHT_OP, + FSL_TWO_RIGHT_VALID, + auth_ra_auth_frag, + auth_ra_valid_both, + max_nat_ra_valid, + max_nat_ra_included, + get_theorem_by_name("AND_CLAUSES")), + valid); + ACCEPT_TAC(body, valid); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "FSL_TWO_MC_AUTH_FRAG_BOUND has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_fsl_two_mc_auth_frag_bound"); + return empty_theorem; +} + +PROOF thm FSL_TWO_MC_AUTH_FRAG_BOUND = + prove_fsl_two_mc_auth_frag_bound(); + +/* ------------------------------------------------------------------------- */ +/* Source-local audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_fsl_two_algebra(void) { + thm_list public_theorems = THM_LIST( + FSL_TWO_EMBED_OP, + FSL_TWO_LEFT_OP, + FSL_TWO_RIGHT_OP, + FSL_TWO_LEFT_VALID, + FSL_TWO_RIGHT_VALID, + FSL_TWO_UPDATE_LEFT, + FSL_TWO_UPDATE_RIGHT, + FSL_TWO_BP_SET1_UPDATE, + FSL_TWO_BP_INIT_VALID, + FSL_TWO_BP_AUTH_FRAG1_AGREE, + FSL_TWO_MC_RAISE_UPDATE, + FSL_TWO_MC_INIT_VALID, + FSL_TWO_MC_AUTH_FRAG_BOUND); + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND(!IS_NULL(public_theorems[i]), + "two-module theorem %zu is null", i); + ENSURE_COND(vector_size(hyp(public_theorems[i])) == 0, + "two-module theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == FSL_TWO_AXIOMS_BEFORE, + "two-module algebra introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_fsl_two_algebra"); + return -1; +} + +PROOF static int _FSL_TWO_ALGEBRA_AUDIT = audit_fsl_two_algebra(); diff --git a/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.h b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.h new file mode 100644 index 0000000000000000000000000000000000000000..29e5779fdcea00967baf3ebb97d0d13f03b1935c --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.h @@ -0,0 +1,85 @@ +#pragma once + +/* + * Separating product for the FSL "Client of Two Modules" example. + * + * Let + * + * B = auth_ra (prod_ra (excl_ra:int) (excl_ra:int)) + * M = auth_ra max_nat_ra + * T = prod_ra B M. + * + * `fsl_two_left b = (b, unit M)` and + * `fsl_two_right m = (unit B, m)` are the canonical embeddings. The public + * rules below state the semantic facts used by the combined client: embedded + * resources compose without loss, validity is inherited from the selected + * component, and a frame-preserving update in one module is an update of `T` + * that leaves the other module unchanged. + * + * This file is pure RA theory. It deliberately does not install a C/QCP + * assertion model; the selected assertion layer is introduced separately. + */ + +#include "proof/theory/logic/auth_ra.h" +#include "proof/theory/logic/excl_ra.h" +#include "proof/theory/logic/max_nat_ra.h" +#include "proof/theory/logic/prod_ra.h" + +/* Raw RA terms, exposed for constructing the selected product logic. */ +PROOF term fsl_two_bp_ra_term(void); +PROOF term fsl_two_mc_ra_term(void); +PROOF term fsl_two_modules_ra_term(void); + +/* + * Canonical embeddings compose to the original pair: + * + * op T (fsl_two_left b) (fsl_two_right m) = (b,m). + */ +PROOF extern thm FSL_TWO_EMBED_OP; + +/* Each embedding is an RA homomorphism: + * + * op T (left x) (left y) = left (op B x y) + * op T (right x) (right y) = right (op M x y). + */ +PROOF extern thm FSL_TWO_LEFT_OP; +PROOF extern thm FSL_TWO_RIGHT_OP; + +/* + * Embedded validity is exact: + * + * valid T (fsl_two_left b) <=> valid B b + * valid T (fsl_two_right m) <=> valid M m. + */ +PROOF extern thm FSL_TWO_LEFT_VALID; +PROOF extern thm FSL_TWO_RIGHT_VALID; + +/* + * Any update of B lifts through the left embedding while preserving unit M: + * + * update B b b' ==> update T (fsl_two_left b) (fsl_two_left b'). + */ +PROOF extern thm FSL_TWO_UPDATE_LEFT; + +/* + * Any update of M lifts through the right embedding while preserving unit B: + * + * update M m m' ==> update T (fsl_two_right m) (fsl_two_right m'). + */ +PROOF extern thm FSL_TWO_UPDATE_RIGHT; + +/* The bit-pair first-field update, lifted into T. */ +PROOF extern thm FSL_TWO_BP_SET1_UPDATE; + +/* Initial ownership is valid, and validity of an authority/fragment pair + * identifies the hidden first bit with its public token. */ +PROOF extern thm FSL_TWO_BP_INIT_VALID; +PROOF extern thm FSL_TWO_BP_AUTH_FRAG1_AGREE; + +/* The monotonic-counter authority increase, lifted into T. */ +PROOF extern thm FSL_TWO_MC_RAISE_UPDATE; + +/* Initial counter ownership is valid; same-name validity exposes its lower + * bound without revealing the authoritative current value. */ +PROOF extern thm FSL_TWO_MC_INIT_VALID; +PROOF extern thm FSL_TWO_MC_AUTH_FRAG_BOUND; diff --git a/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.c b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.c new file mode 100644 index 0000000000000000000000000000000000000000..a7b57f0fb8e25f67008ba87b023bf6fee688f249 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.c @@ -0,0 +1,30 @@ +#include "psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.h" + +#require "psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.c" +#require "userlib/qcp/c_logic.c" + +PROOF int install_fsl_two_modules_logic(void) { + static bool installed = false; + if (installed) return 0; + + ENSURE_COND(cst_add_type_to_header("ra", 1) == 0, + "Could not export ra for the two-module model"); + ENSURE_COND(cst_add_type_to_header("excl", 1) == 0, + "Could not export excl for the two-module model"); + ENSURE_COND(cst_add_const_to_header(`ExclUnit:(A)excl`) == 0, + "Could not export ExclUnit for the two-module model"); + ENSURE_COND(cst_add_const_to_header(`Excl:A->(A)excl`) == 0, + "Could not export Excl for the two-module model"); + ENSURE_COND(cst_add_const_to_header(`ExclInvalid:(A)excl`) == 0, + "Could not export ExclInvalid for the two-module model"); + ENSURE_COND(cst_add_const_to_header(`max_nat_ra:(num)ra`) == 0, + "Could not export max_nat_ra for the two-module model"); + ENSURE_COND(c_logic_install_named(fsl_two_modules_ra_term()) == 0, + "Could not install the two-module C logic"); + + installed = true; + return 0; +err: + ERR_FUN_PUTS("install_fsl_two_modules_logic"); + return -1; +} diff --git a/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.h b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.h new file mode 100644 index 0000000000000000000000000000000000000000..1e35aaa4a99496c7d90416dc3bded8af53d9dd1e --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.h @@ -0,0 +1,10 @@ +#pragma once + +/* One complete assertion language shared by the bit-pair and counter views. */ +#define CSTAR_DEFER_C_LOGIC_INSTALL + +#include "psi_examples/logical_resources/fictional_sl/two_modules/two_modules_algebra.h" +#include "userlib/qcp/c_logic.h" + +/* Install G_two = G_bp x G_mc exactly once in this verification root. */ +PROOF int install_fsl_two_modules_logic(void); diff --git a/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_protocol.c b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_protocol.c new file mode 100644 index 0000000000000000000000000000000000000000..b4553083ae04e3810cf6e6aa62a97e539274c588 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_protocol.c @@ -0,0 +1,544 @@ +#include "psi_examples/logical_resources/fictional_sl/two_modules/two_modules_protocol.h" + +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + +PROOF static int _FSL_TWO_PROTOCOL_LOGIC = + install_fsl_two_modules_logic(); + +PROOF static size_t FSL_TWO_PROTOCOL_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +/* ------------------------------------------------------------------------- */ +/* Embedded payloads and public tokens */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm fsl_two_bp_authority_def = new_fun_definition(` + fsl_two_bp_authority (bit1:int) (bit2:int) = + fsl_two_left + (auth_auth + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)) + (fsl_two_bp_base bit1 bit2)) +`); + +PROOF static thm fsl_two_bp_fragment_def = new_fun_definition(` + fsl_two_bp_fragment (value:int) = + fsl_two_left + (auth_frag (fsl_two_bp_left_fragment value)) +`); + +PROOF static thm fsl_two_mc_authority_def = new_fun_definition(` + fsl_two_mc_authority (current:num) = + fsl_two_right (auth_auth max_nat_ra current) +`); + +PROOF static thm fsl_two_mc_fragment_def = new_fun_definition(` + fsl_two_mc_fragment (known:num) = + fsl_two_right (auth_frag known) +`); + +PROOF static thm fsl_two_bp_token_def = cst_new_fun_definition( + "fsl_two_bp_token", + `fsl_two_bp_token name value -|- + own (name:num) (fsl_two_bp_fragment (value:int))`, + `:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))))finmap)->bool`); + +PROOF static thm fsl_two_mc_token_def = cst_new_fun_definition( + "fsl_two_mc_token", + `fsl_two_mc_token name known -|- + own (name:num) (fsl_two_mc_fragment (known:num))`, + `:num->num-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))))finmap)->bool`); + +PROOF static thm fsl_two_bp_token_definition( + const term name, const term value) { + return inst_rule( + TERM_PAIR_LIST( + (term_pair){name, `name:num`}, + (term_pair){value, `value:int`}), + fsl_two_bp_token_def); +} + +PROOF static thm fsl_two_mc_token_definition( + const term name, const term known) { + return inst_rule( + TERM_PAIR_LIST( + (term_pair){name, `name:num`}, + (term_pair){known, `known:num`}), + fsl_two_mc_token_def); +} + +/* ------------------------------------------------------------------------- */ +/* Same-name ownership splitting */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_fsl_two_bp_own_split_direction(const bool forward) { + term name = `name:num`; + term bit1 = `bit1:int`; + term bit2 = `bit2:int`; + term token_value = `token:int`; + term authority = `fsl_two_bp_authority (bit1:int) (bit2:int)`; + term fragment = `fsl_two_bp_fragment (token:int)`; + term own_at_name = mk_comb(c_logic_current()->own, name); + thm split = ispecl_rule( + TERM_LIST(name, authority, fragment), + forward ? c_logic_current()->ghost_own_split + : c_logic_current()->ghost_own_join); + thm token = gsym_rule( + fsl_two_bp_token_definition(name, token_value)); + thm fold = mk_binop_rule( + sl_sep(), + refl_rule(mk_comb(own_at_name, authority)), + token); + thm result = forward + ? trans_slrule(split, eq2ent(fold)) + : trans_slrule(eq2ent(gsym_rule(fold)), split); + result = gen_rule(token_value, result); + result = gen_rule(bit2, result); + result = gen_rule(bit1, result); + result = gen_rule(name, result); + return result; +} + +PROOF static thm FSL_TWO_BP_OWN_SPLIT = + prove_fsl_two_bp_own_split_direction(true); + +PROOF static thm FSL_TWO_BP_OWN_JOIN = + prove_fsl_two_bp_own_split_direction(false); + +PROOF static thm prove_fsl_two_mc_own_split_direction(const bool forward) { + term name = `name:num`; + term current = `current:num`; + term known = `known:num`; + term authority = `fsl_two_mc_authority (current:num)`; + term fragment = `fsl_two_mc_fragment (known:num)`; + term own_at_name = mk_comb(c_logic_current()->own, name); + thm split = ispecl_rule( + TERM_LIST(name, authority, fragment), + forward ? c_logic_current()->ghost_own_split + : c_logic_current()->ghost_own_join); + thm token = gsym_rule(fsl_two_mc_token_definition(name, known)); + thm fold = mk_binop_rule( + sl_sep(), + refl_rule(mk_comb(own_at_name, authority)), + token); + thm result = forward + ? trans_slrule(split, eq2ent(fold)) + : trans_slrule(eq2ent(gsym_rule(fold)), split); + result = gen_rule(known, result); + result = gen_rule(current, result); + result = gen_rule(name, result); + return result; +} + +PROOF static thm FSL_TWO_MC_OWN_SPLIT = + prove_fsl_two_mc_own_split_direction(true); + +PROOF static thm FSL_TWO_MC_OWN_JOIN = + prove_fsl_two_mc_own_split_direction(false); + +/* ------------------------------------------------------------------------- */ +/* Allocation and update viewshifts */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm fsl_two_alloc_split( + const term payload, + const thm valid, + const term name, + const thm split) { + thm allocated = mp_rule( + ispecl_rule( + TERM_LIST(payload, sl_emp()), + c_logic_current()->ghost_own_alloc), + valid); + allocated = pure_rewrite_rule(THM_LIST(sl_sep_emp_right()), allocated); + thm existential_split = exists_mono_slrule(name, split); + dest_binop_results endpoints = dest_sl_viewshift(concl(allocated)); + return viewshift_mono_slrule( + refl_slrule(endpoints.tm1), + allocated, + existential_split); +} + +PROOF static thm prove_fsl_two_bp_init_viewshift(void) { + term payload = ` + ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_bp_authority 0i 0i) + (fsl_two_bp_fragment 0i)`; + thm valid = pure_rewrite_rule( + THM_LIST( + gsym_rule(fsl_two_bp_authority_def), + gsym_rule(fsl_two_bp_fragment_def)), + FSL_TWO_BP_INIT_VALID); + thm split = ispecl_rule( + TERM_LIST(`name:num`, `0i`, `0i`, `0i`), + FSL_TWO_BP_OWN_SPLIT); + thm result = fsl_two_alloc_split(payload, valid, `name:num`, split); + term expected = ` + emp ==*=> + exists name:num. + own name (fsl_two_bp_authority 0i 0i) ** + fsl_two_bp_token name 0i`; + ENSURE_COND(equals_term(concl(result), expected), + "FSL_TWO_BP_INIT_VIEWSHIFT has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_init_viewshift"); + return empty_theorem; +} + +PROOF thm FSL_TWO_BP_INIT_VIEWSHIFT = + prove_fsl_two_bp_init_viewshift(); + +PROOF static thm prove_fsl_two_mc_init_viewshift(void) { + term payload = ` + ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_mc_authority 0) + (fsl_two_mc_fragment 0)`; + thm valid = pure_rewrite_rule( + THM_LIST( + gsym_rule(fsl_two_mc_authority_def), + gsym_rule(fsl_two_mc_fragment_def)), + FSL_TWO_MC_INIT_VALID); + thm split = ispecl_rule( + TERM_LIST(`name:num`, `0`, `0`), + FSL_TWO_MC_OWN_SPLIT); + thm result = fsl_two_alloc_split(payload, valid, `name:num`, split); + term expected = ` + emp ==*=> + exists name:num. + own name (fsl_two_mc_authority 0) ** + fsl_two_mc_token name 0`; + ENSURE_COND(equals_term(concl(result), expected), + "FSL_TWO_MC_INIT_VIEWSHIFT has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_fsl_two_mc_init_viewshift"); + return empty_theorem; +} + +PROOF thm FSL_TWO_MC_INIT_VIEWSHIFT = + prove_fsl_two_mc_init_viewshift(); + +PROOF static thm prove_fsl_two_bp_set1_viewshift(void) { + thm payload_update = ispecl_rule( + TERM_LIST(`old:int`, `next:int`, `other:int`), + FSL_TWO_BP_SET1_UPDATE); + term base_ra = ` + prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra)`; + thm source_composition = ispecl_rule( + TERM_LIST( + base_ra, + `fsl_two_bp_base (old:int) (other:int)`, + `fsl_two_bp_left_fragment (old:int)`), + auth_ra_auth_frag); + thm target_composition = ispecl_rule( + TERM_LIST( + base_ra, + `fsl_two_bp_base (next:int) (other:int)`, + `fsl_two_bp_left_fragment (next:int)`), + auth_ra_auth_frag); + payload_update = pure_rewrite_rule( + THM_LIST( + gsym_rule(source_composition), + gsym_rule(target_composition), + gsym_rule(FSL_TWO_LEFT_OP), + gsym_rule(fsl_two_bp_authority_def), + gsym_rule(fsl_two_bp_fragment_def)), + payload_update); + term source_payload = ` + ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_bp_authority (old:int) (other:int)) + (fsl_two_bp_fragment old)`; + term target_payload = ` + ra_op + (prod_ra + (auth_ra + (prod_ra + (excl_ra:((int)excl)ra) + (excl_ra:((int)excl)ra))) + (auth_ra max_nat_ra)) + (fsl_two_bp_authority (next:int) (other:int)) + (fsl_two_bp_fragment next)`; + thm own_update = mp_rule( + ispecl_rule( + TERM_LIST(`name:num`, source_payload, target_payload), + c_logic_current()->ghost_own_update), + payload_update); + thm source = ispecl_rule( + TERM_LIST(`name:num`, `old:int`, `other:int`, `old:int`), + FSL_TWO_BP_OWN_JOIN); + thm target = ispecl_rule( + TERM_LIST(`name:num`, `next:int`, `other:int`, `next:int`), + FSL_TWO_BP_OWN_SPLIT); + thm result = viewshift_mono_slrule(source, own_update, target); + result = gen_rule(`other:int`, result); + result = gen_rule(`next:int`, result); + result = gen_rule(`old:int`, result); + result = gen_rule(`name:num`, result); + term expected = ` + forall (name:num) (old:int) (next:int) (other:int). + own name (fsl_two_bp_authority old other) ** + fsl_two_bp_token name old + ==*=> + own name (fsl_two_bp_authority next other) ** + fsl_two_bp_token name next`; + ENSURE_COND(equals_term(concl(result), expected), + "FSL_TWO_BP_SET1_VIEWSHIFT has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_set1_viewshift"); + return empty_theorem; +} + +PROOF thm FSL_TWO_BP_SET1_VIEWSHIFT = + prove_fsl_two_bp_set1_viewshift(); + +/* ------------------------------------------------------------------------- */ +/* Observation entailments */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm fsl_two_observation_entailment( + const bool bit_pair, + const term name, + const term current1, + const term current2, + const term token_value) { + term authority = bit_pair + ? list_mk_comb( + `fsl_two_bp_authority:int->int-> + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))`, + TERM_LIST(current1, current2)) + : mk_comb( + `fsl_two_mc_authority:num-> + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))`, + current1); + term fragment = bit_pair + ? mk_comb( + `fsl_two_bp_fragment:int-> + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))`, + token_value) + : mk_comb( + `fsl_two_mc_fragment:num-> + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))`, + token_value); + term combined = list_mk_comb( + `ra_op: + (((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num)))ra-> + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))-> + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))-> + ((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))`, + TERM_LIST(fsl_two_modules_ra_term(), authority, fragment)); + term own_at_name = mk_comb(c_logic_current()->own, name); + term owned_combined = mk_comb(own_at_name, combined); + term observation = bit_pair + ? mk_eq(current1, token_value) + : subst( + TERM_PAIR_LIST( + (term_pair){token_value, `known:num`}, + (term_pair){current1, `current:num`}), + `(known:num) <= (current:num)`); + thm split = bit_pair + ? ispecl_rule( + TERM_LIST(name, current1, current2, token_value), + FSL_TWO_BP_OWN_SPLIT) + : ispecl_rule( + TERM_LIST(name, current1, token_value), + FSL_TWO_MC_OWN_SPLIT); + thm source_to_combined = bit_pair + ? ispecl_rule( + TERM_LIST(name, current1, current2, token_value), + FSL_TWO_BP_OWN_JOIN) + : ispecl_rule( + TERM_LIST(name, current1, token_value), + FSL_TWO_MC_OWN_JOIN); + thm validity = ispecl_rule( + TERM_LIST(name, combined), + c_logic_current()->ghost_own_valid); + thm pure_rule = bit_pair + ? ispecl_rule( + TERM_LIST(current1, current2, token_value), + FSL_TWO_BP_AUTH_FRAG1_AGREE) + : ispecl_rule( + TERM_LIST(current1, token_value), + FSL_TWO_MC_AUTH_FRAG_BOUND); + pure_rule = pure_rewrite_rule( + bit_pair + ? THM_LIST( + gsym_rule(fsl_two_bp_authority_def), + gsym_rule(fsl_two_bp_fragment_def)) + : THM_LIST( + gsym_rule(fsl_two_mc_authority_def), + gsym_rule(fsl_two_mc_fragment_def)), + pure_rule); + thm expose = frame_right_slrule( + fact_transition_slrule(pure_rule), + owned_combined); + thm restore = frame_left_slrule( + mk_sl_fact(observation), + split); + thm result = trans_slrule(source_to_combined, validity); + result = trans_slrule(result, expose); + return trans_slrule(result, restore); +} + +PROOF static thm prove_fsl_two_bp_own_agree(void) { + thm result = fsl_two_observation_entailment( + true, `name:num`, `stored1:int`, `stored2:int`, `token:int`); + result = gen_rule(`token:int`, result); + result = gen_rule(`stored2:int`, result); + result = gen_rule(`stored1:int`, result); + result = gen_rule(`name:num`, result); + term expected = ` + forall (name:num) (stored1:int) (stored2:int) (token:int). + own name (fsl_two_bp_authority stored1 stored2) ** + fsl_two_bp_token name token |-- + fact(stored1 == token) ** + (own name (fsl_two_bp_authority stored1 stored2) ** + fsl_two_bp_token name token)`; + ENSURE_COND(equals_term(concl(result), expected), + "FSL_TWO_BP_OWN_AGREE has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_fsl_two_bp_own_agree"); + return empty_theorem; +} + +PROOF thm FSL_TWO_BP_OWN_AGREE = + prove_fsl_two_bp_own_agree(); + +PROOF static thm prove_fsl_two_mc_own_bound(void) { + thm result = fsl_two_observation_entailment( + false, `name:num`, `current:num`, `current:num`, `known:num`); + result = gen_rule(`known:num`, result); + result = gen_rule(`current:num`, result); + result = gen_rule(`name:num`, result); + term expected = ` + forall (name:num) (current:num) (known:num). + own name (fsl_two_mc_authority current) ** + fsl_two_mc_token name known |-- + fact(known <= current) ** + (own name (fsl_two_mc_authority current) ** + fsl_two_mc_token name known)`; + ENSURE_COND(equals_term(concl(result), expected), + "FSL_TWO_MC_OWN_BOUND has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_fsl_two_mc_own_bound"); + return empty_theorem; +} + +PROOF thm FSL_TWO_MC_OWN_BOUND = + prove_fsl_two_mc_own_bound(); + +/* ------------------------------------------------------------------------- */ +/* QCP installation and trust audit */ +/* ------------------------------------------------------------------------- */ + +PROOF int install_fsl_two_modules_protocol_qcp(void) { + static bool installed = false; + if (installed) return 0; + ENSURE_COND(cst_add_const_to_header(` + fsl_two_bp_token: + num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))))finmap)->bool`) == 0, + "Could not export the two-module bit token"); + ENSURE_COND(cst_add_const_to_header(` + fsl_two_mc_token: + num->num-> + (((int,(pmem_byte_state)excl)finmap)# + (num,(((((int)excl#(int)excl)excl# + ((int)excl#(int)excl))# + ((num)excl#num))))finmap)->bool`) == 0, + "Could not export the two-module counter token"); + installed = true; + return 0; +err: + ERR_FUN_PUTS("install_fsl_two_modules_protocol_qcp"); + return -1; +} + +PROOF static int audit_fsl_two_protocol(void) { + thm_list theorems = THM_LIST( + fsl_two_bp_authority_def, + fsl_two_bp_fragment_def, + fsl_two_mc_authority_def, + fsl_two_mc_fragment_def, + fsl_two_bp_token_def, + fsl_two_mc_token_def, + FSL_TWO_BP_OWN_SPLIT, + FSL_TWO_BP_OWN_JOIN, + FSL_TWO_MC_OWN_SPLIT, + FSL_TWO_MC_OWN_JOIN, + FSL_TWO_BP_INIT_VIEWSHIFT, + FSL_TWO_MC_INIT_VIEWSHIFT, + FSL_TWO_BP_SET1_VIEWSHIFT, + FSL_TWO_BP_OWN_AGREE, + FSL_TWO_MC_OWN_BOUND); + for (size_t i = 0; i < vector_size(theorems); ++i) { + ENSURE_COND(!IS_NULL(theorems[i]), + "two-module protocol theorem %zu is null", i); + ENSURE_COND(vector_size(hyp(theorems[i])) == 0, + "two-module protocol theorem %zu has hypotheses", i); + } + ENSURE_COND(vector_size(get_all_axioms()) == + FSL_TWO_PROTOCOL_AXIOMS_BEFORE, + "two-module protocol introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_fsl_two_protocol"); + return -1; +} + +PROOF static int _FSL_TWO_PROTOCOL_AUDIT = + audit_fsl_two_protocol(); diff --git a/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_protocol.h b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_protocol.h new file mode 100644 index 0000000000000000000000000000000000000000..790b9d91db4e81203ae1593fc018096d62db0894 --- /dev/null +++ b/psi_examples/logical_resources/fictional_sl/two_modules/two_modules_protocol.h @@ -0,0 +1,72 @@ +#pragma once + +/* + * Assertion-level protocol over the combined bit-pair/counter ghost RA. + * + * The combined payload is a product. `fsl_two_bp_token` owns only its left + * bit-pair fragment; `fsl_two_mc_token` owns only its right max-natural + * fragment. Both predicates retain the ordinary logical ghost name that + * connects a client token to the module authority at that same cell. + */ + +#include "psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.h" +#require "psi_examples/logical_resources/fictional_sl/two_modules/two_modules_logic.c" + +/* + * Allocate an initial bit-pair cell and expose its shared name: + * + * emp ==*=> + * exists name. + * own name (fsl_two_bp_authority 0i 0i) ** + * fsl_two_bp_token name 0i. + * + * Allocate an independent initial counter cell: + * + * emp ==*=> + * exists name. + * own name (fsl_two_mc_authority 0) ** + * fsl_two_mc_token name 0. + */ +PROOF extern thm FSL_TWO_BP_INIT_VIEWSHIFT; +PROOF extern thm FSL_TWO_MC_INIT_VIEWSHIFT; + +/* + * Update the first fictional bit while preserving the second bit, the + * product's counter component, and every unrelated ghost cell: + * + * forall name old next other. + * own name (fsl_two_bp_authority old other) ** + * fsl_two_bp_token name old + * ==*=> + * own name (fsl_two_bp_authority next other) ** + * fsl_two_bp_token name next. + */ +PROOF extern thm FSL_TWO_BP_SET1_VIEWSHIFT; + +/* + * Same-name ownership exposes only the abstract client observations while + * preserving both linear resources. For the bit-pair component: + * + * forall name stored1 stored2 token. + * own name (fsl_two_bp_authority stored1 stored2) ** + * fsl_two_bp_token name token + * |-- + * fact(stored1 == token) ** + * (own name (fsl_two_bp_authority stored1 stored2) ** + * fsl_two_bp_token name token). + * + * For the monotonic-counter component: + * + * forall name current known. + * own name (fsl_two_mc_authority current) ** + * fsl_two_mc_token name known + * |-- + * fact(known <= current) ** + * (own name (fsl_two_mc_authority current) ** + * fsl_two_mc_token name known). + */ +PROOF extern thm FSL_TWO_BP_OWN_AGREE; +PROOF extern thm FSL_TWO_MC_OWN_BOUND; + +/* Export the two token predicates to QCP for the selected Prop_G. */ +PROOF int install_fsl_two_modules_protocol_qcp(void); diff --git a/psi_examples/logical_resources/monotonic_counter/client.c b/psi_examples/logical_resources/monotonic_counter/client.c new file mode 100644 index 0000000000000000000000000000000000000000..4fc76bd9086ea7e97d4d10e0ac0d2cf6eaeea2be --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/client.c @@ -0,0 +1,95 @@ +#include "psi_examples/logical_resources/monotonic_counter/counter.h" +#require "psi_examples/logical_resources/monotonic_counter/counter.c" + +#include "userlib/operational/operational.h" +#require "userlib/operational/operational.c" + +// verify_all: expect-vcs=0 + +PROOF static thm prove_mc_num_of_int_zero(void) { + term goal_tm = `num_of_int 0i == 0`; + thm result = ispec_rule( + `0`, get_theorem_by_name("NUM_OF_INT_OF_NUM")); + ENSURE_COND(equals_term(concl(result), goal_tm), + "MC_NUM_OF_INT_ZERO has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_num_of_int_zero"); + return empty_theorem; +} + +PROOF static thm MC_NUM_OF_INT_ZERO = + prove_mc_num_of_int_zero(); + +PROOF static thm prove_mc_step_zero(void) { + term goal_tm = `mc_counter_step 0 == 1`; + thm result = mp_rule( + ispec_rule(`0`, MC_COUNTER_STEP_LT), + arith_rule(`(0:num) < 2147483647`)); + result = trans_rule(result, arith_rule(`SUC 0 == 1`)); + ENSURE_COND(equals_term(concl(result), goal_tm), + "MC_STEP_ZERO has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_step_zero"); + return empty_theorem; +} + +PROOF static thm MC_STEP_ZERO = + prove_mc_step_zero(); + +PROOF static thm prove_mc_step_one(void) { + term goal_tm = `mc_counter_step 1 == 2`; + thm result = mp_rule( + ispec_rule(`1`, MC_COUNTER_STEP_LT), + arith_rule(`(1:num) < 2147483647`)); + result = trans_rule(result, arith_rule(`SUC 1 == 2`)); + ENSURE_COND(equals_term(concl(result), goal_tm), + "MC_STEP_ONE has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_step_one"); + return empty_theorem; +} + +PROOF static thm MC_STEP_ONE = + prove_mc_step_one(); + +PROOF static thm prove_mc_int_num_two(void) { + term goal_tm = `(&(num_of_int 2i):int) == 2i`; + thm num_two = ispec_rule( + `2`, get_theorem_by_name("NUM_OF_INT_OF_NUM")); + thm result = ap_term_rule(`int_of_num:num->int`, num_two); + ENSURE_COND(equals_term(concl(result), goal_tm), + "MC_INT_NUM_TWO has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_int_num_two"); + return empty_theorem; +} + +PROOF static thm MC_INT_NUM_TWO = + prove_mc_int_num_two(); + +/* The module invariant keeps its authoritative value existential. The + * client carries only the same ghost name and a monotone lower-bound token. */ +int mc_counter_module_client(struct mc_counter *counter) + REQUIRE(`undef_data_at (field_addr counter Tmc_counter Fvalue) Tint`) + ENSURE_EX(TERM_LIST(`name:num`), + `mc_counter_inv name counter`, + `mc_counter_token name (2:num)`, + `fact((&(2:num):int) <= (__return:int))`) +{ + mc_counter_init(counter); + PROOF rewrite_st(THM_LIST(MC_NUM_OF_INT_ZERO)); + + mc_counter_increment(counter); + PROOF rewrite_st(THM_LIST(MC_STEP_ZERO)); + + mc_counter_increment(counter); + PROOF rewrite_st(THM_LIST(MC_STEP_ONE)); + + int result = mc_counter_read(counter); + PROOF rewrite_st(THM_LIST(MC_INT_NUM_TWO)); + return result; +} diff --git a/psi_examples/logical_resources/monotonic_counter/counter.c b/psi_examples/logical_resources/monotonic_counter/counter.c new file mode 100644 index 0000000000000000000000000000000000000000..3afcb5b1b81a13546231a1b9d1f9f3832bc6bda2 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter.c @@ -0,0 +1,356 @@ +/* Independent implementation root: keep the same layout as `counter.h`. */ +struct mc_counter { + int value; +}; + +#include "psi_examples/logical_resources/monotonic_counter/counter.h" +#include "psi_examples/logical_resources/monotonic_counter/counter_model_private.h" + +#include "proof/proof_sl.h" +#require "proof/proof_sl.c" +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" + +// verify_all: expect-vcs=0 + +PROOF static thm MC_INT_MAX_CAST = int_arith_rule(` + (&(2147483647:num):int) == 2147483647i +`); + +PROOF static thm prove_mc_int_max_lt(void) { + term goal_tm = ` + forall n:num. + (&n:int) < 2147483647i <=> n < 2147483647 + `; + thm comparison = ispecl_rule( + TERM_LIST(`n:num`, `2147483647:num`), + get_theorem_by_name("INT_OF_NUM_LT")); + thm result = conv_rule( + once_rewrite_conv(THM_LIST(MC_INT_MAX_CAST)), + comparison); + result = gen_rule(`n:num`, result); + ENSURE_COND(equals_term(concl(result), goal_tm), + "MC_INT_MAX_LT has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_int_max_lt"); + return empty_theorem; +} + +PROOF static thm MC_INT_MAX_LT = + prove_mc_int_max_lt(); + +PROOF static thm prove_mc_int_max_le(void) { + term goal_tm = ` + forall n:num. + 2147483647i <= (&n:int) <=> 2147483647 <= n + `; + thm comparison = ispecl_rule( + TERM_LIST(`2147483647:num`, `n:num`), + get_theorem_by_name("INT_OF_NUM_LE")); + thm result = conv_rule( + once_rewrite_conv(THM_LIST(MC_INT_MAX_CAST)), + comparison); + result = gen_rule(`n:num`, result); + ENSURE_COND(equals_term(concl(result), goal_tm), + "MC_INT_MAX_LE has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_int_max_le"); + return empty_theorem; +} + +PROOF static thm MC_INT_MAX_LE = + prove_mc_int_max_le(); + +PROOF static thm MC_INT_GE_LE = int_arith_rule(` + forall (x:int) (y:int). x >= y <=> y <= x +`); + +PROOF static thm prove_mc_int_max_ge(void) { + term goal_tm = ` + forall n:num. + (&n:int) >= 2147483647i <=> 2147483647 <= n + `; + thm ge_to_le = ispecl_rule( + TERM_LIST(`&(n:num):int`, `2147483647i`), + MC_INT_GE_LE); + thm result = trans_rule( + ge_to_le, + ispec_rule(`n:num`, MC_INT_MAX_LE)); + result = gen_rule(`n:num`, result); + ENSURE_COND(equals_term(concl(result), goal_tm), + "MC_INT_MAX_GE has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_int_max_ge"); + return empty_theorem; +} + +PROOF static thm MC_INT_MAX_GE = + prove_mc_int_max_ge(); + +PROOF static thm MC_MAX_LE_NOT_LT = arith_rule(` + forall n:num. + 2147483647 <= n ==> ~(n < 2147483647) +`); + +PROOF static thm MC_INCREMENT_SAFE = int_arith_rule(` + forall n:num. + (&n:int) < 2147483647i ==> + (&n:int) + 1i <= 2147483647i && + --2147483648i <= (&n:int) + 1i +`); + +PROOF static void mc_add_natural_limit_branch(const bool below_limit) { + term current = `current:num`; + term int_comparison = `(¤t:int) < 2147483647i`; + thm bridge = ispec_rule(current, MC_INT_MAX_LT); + thm result; + if (below_limit) { + result = eq_mp_rule( + bridge, + assume_rule(int_comparison)); + } else { + thm max_le_current = eq_mp_rule( + ispec_rule(current, MC_INT_MAX_GE), + assume_rule(`(&(current:num):int) >= 2147483647i`)); + result = mp_rule( + ispec_rule(current, MC_MAX_LE_NOT_LT), + max_le_current); + } + add_fact_st(result); +} + +PROOF static void mc_add_increment_safety(void) { + thm safety = mp_rule( + ispec_rule(`current:num`, MC_INCREMENT_SAFE), + assume_rule(`(&(current:num):int) < 2147483647i`)); + add_conjuncts_st(safety); +} + +PROOF static void mc_add_step_equation(const bool below_limit) { + term current = `current:num`; + term premise = below_limit + ? `(current:num) < 2147483647` + : `~((current:num) < 2147483647)`; + thm rule = ispec_rule( + current, + below_limit ? MC_COUNTER_STEP_LT : MC_COUNTER_STEP_NOT_LT); + add_fact_st(mp_rule(rule, assume_rule(premise))); +} + +PROOF static void mc_add_stepped_limit(void) { + thm rule = ispec_rule( + `current:num`, + MC_COUNTER_STEP_LIMIT); + add_fact_st(mp_rule( + rule, + assume_rule(`(current:num) <= 2147483647`))); +} + +PROOF static void mc_add_integer_lower_bound(void) { + thm bridge = ispecl_rule( + TERM_LIST(`known:num`, `current:num`), + get_theorem_by_name("INT_OF_NUM_LE")); + thm result = eq_mp_rule( + gsym_rule(bridge), + assume_rule(`(known:num) <= (current:num)`)); + add_fact_st(result); +} + +/* Apply a fixed-name ghost update below the invariant witness and restore the + * existential prefix explicitly. The public symbolic state therefore never + * exposes the module's authoritative counter value. */ +PROOF static void mc_apply_hidden_viewshift(const thm update) { + term symbolic_state = get_symbolic_state(); + term_list branches = strip_binop(sl_or(), symbolic_state); + ENSURE_COND( + branches != NULL && vector_size(branches) == 1, + "counter viewshift requires one symbolic-state branch"); + strip_sl_exists_results opened = strip_sl_exists(branches[0]); + thm complete = viewshift_frame_at_slrule(update, opened.hp); + for (int i = (int)vector_size(opened.vs) - 1; i >= 0; --i) { + complete = gen_rule(opened.vs[i], complete); + complete = viewshift_exists_slrule(complete); + } + set_symbolic_state(complete); + return; +err: + ERR_FUN_PUTS("mc_apply_hidden_viewshift", cstr_thm(update)); + return; +} + +/* Preserve both ownership components while exposing only the lower-bound + * consequence needed by a read. */ +PROOF static thm mc_expose_bound_operation_proof(const term goal_tm) { + thm bound = ispecl_rule( + TERM_LIST(`name:num`, `current:num`, `known:num`), + MC_COUNTER_OWN_BOUND); + return prove_operation_by_entailment(goal_tm, bound); +} + +decl_operation(mc_expose_bound_operation, + TERM_LIST(`name:num`, `current:num`, `known:num`), + TERM_LIST( + `own + (KEY name) + (KEY (auth_auth max_nat_ra current))`, + `mc_counter_token (KEY name) (KEY known)` + ), + term_list_n(0), + `fact(known <= current) ** + (own name (auth_auth max_nat_ra current) ** + mc_counter_token name known)` +) + +PROOF static void mc_expose_bound( + const term name, const term current, const term known) { + apply_operation_st( + mc_expose_bound_operation, + TERM_LIST(name, current, known)); +} + +/* Frame the freshly allocated same-name ghost pair with the initialized C + * field, move the fresh-name existential over that frame, and seal only the + * authority plus physical field into the abstract module invariant. */ +PROOF static void mc_counter_init_ghost_and_fold(const term counter) { + term symst = get_symbolic_state(); + term disjunction = sl_or(); + term_list branches = strip_binop(disjunction, symst); + ENSURE_COND( + branches != NULL, + "Counter initialization produced no branch vector"); + ENSURE_COND( + vector_size(branches) == 1, + "Counter initialization requires one symbolic-state branch"); + term frame = branches[0]; + + thm allocate = MC_COUNTER_INIT_VIEWSHIFT; + thm framed = viewshift_frame_slrule(allocate, frame); + + term body_fn = ` + \allocated_name:num. + own allocated_name (auth_auth max_nat_ra 0) ** + mc_counter_token allocated_name 0`; + thm sep_exists_left = sl_sep_exists_left(); + term_list pull_arguments = TERM_LIST(body_fn, frame); + thm specialized_pull = ispecl_rule( + pull_arguments, + sep_exists_left); + thm pull = beta_rule(specialized_pull); + thm pull_entailment = eq2ent(pull); + + term pull_statement = concl(pull_entailment); + dest_binop_results pull_endpoints = dest_sl_ent(pull_statement); + term named_target = pull_endpoints.tm2; + dest_binder_results opened = dest_sl_exists(named_target); + term fresh_name = `mc_allocated_name:num`; + term opened_body = subst_one(fresh_name, opened.v, opened.tm); + + thm add_limit = add_facts_hconv(THM_LIST( + arith_rule(`(0:num) <= 2147483647`))); + thm opened_limit = local_apply(opened_body, add_limit); + term body_with_limit = dest_sl_ent(concl(opened_limit)).tm2; + + term_list fold_arguments = TERM_LIST( + fresh_name, + counter, + `0`); + thm local_fold = operation_hconv( + mc_fold_counter_inv_operation, + body_with_limit, + fold_arguments); + thm opened_fold = trans_slrule( + opened_limit, + local_apply(body_with_limit, local_fold)); + thm sealed = exists_mono_slrule( + fresh_name, + opened_fold); + thm target_entailment = trans_slrule( + pull_entailment, + sealed); + + term framed_statement = concl(framed); + dest_binop_results framed_endpoints = + dest_sl_viewshift(framed_statement); + thm source_refl = refl_slrule(framed_endpoints.tm1); + thm complete = viewshift_mono_slrule( + source_refl, + framed, + target_entailment); + set_symbolic_state(complete); + return; +err: + ERR_FUN_PUTS("mc_counter_init_ghost_and_fold", cstr_term(counter)); + return; +} + +void mc_counter_init(struct mc_counter *counter) + MC_COUNTER_INIT_SPEC +{ + counter->value = 0; + PROOF mc_counter_init_ghost_and_fold(`counter__pre:int`); +} + +void mc_counter_increment(struct mc_counter *counter) + MC_COUNTER_INCREMENT_SPEC +{ + PROOF mc_unfold_counter_inv_as( + `name:num`, `counter__pre:int`, `current:num`); + if (counter->value < 2147483647) { + PROOF mc_add_increment_safety(); + counter->value = counter->value + 1; + PROOF mc_add_natural_limit_branch(true); + PROOF mc_add_step_equation(true); + PROOF rewrite_st(THM_LIST( + ispec_rule( + `current:num`, + get_theorem_by_name("INT_OF_NUM_SUC")))); + PROOF { + thm update = ispecl_rule( + TERM_LIST(`name:num`, `current:num`, `known:num`), + MC_COUNTER_STEP_VIEWSHIFT); + mc_apply_hidden_viewshift(update); + } + PROOF mc_add_stepped_limit(); + PROOF substitute_fact_st(` + mc_counter_step (current:num) == SUC current`); + PROOF mc_fold_counter_inv( + `name:num`, + `counter__pre:int`, + `SUC (current:num)`); + } else { + PROOF mc_add_natural_limit_branch(false); + PROOF mc_add_step_equation(false); + PROOF { + thm update = ispecl_rule( + TERM_LIST(`name:num`, `current:num`, `known:num`), + MC_COUNTER_STEP_VIEWSHIFT); + mc_apply_hidden_viewshift(update); + } + PROOF mc_add_stepped_limit(); + PROOF substitute_fact_st(` + mc_counter_step (current:num) == current`); + PROOF mc_fold_counter_inv( + `name:num`, + `counter__pre:int`, + `current:num`); + } +} + +int mc_counter_read(const struct mc_counter *counter) + MC_COUNTER_READ_SPEC +{ + PROOF mc_unfold_counter_inv_as( + `name:num`, `counter__pre:int`, `current:num`); + PROOF mc_expose_bound( + `name:num`, `current:num`, `known:num`); + PROOF mc_add_integer_lower_bound(); + int result = counter->value; + PROOF mc_fold_counter_inv( + `name:num`, + `counter__pre:int`, + `current:num`); + return result; +} diff --git a/psi_examples/logical_resources/monotonic_counter/counter.h b/psi_examples/logical_resources/monotonic_counter/counter.h new file mode 100644 index 0000000000000000000000000000000000000000..9ef4c5f4577b694b95c8775de10b6b0b8547e8b4 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter.h @@ -0,0 +1,50 @@ +#pragma once + +/* + * Public module interface over one shared ghost name. The module invariant + * owns the authority and physical field; the client token owns the fragment. + * Their common `name:num` is logical only and never enters generated C. + */ + +#include "psi_examples/logical_resources/monotonic_counter/counter_model.h" +#require "psi_examples/logical_resources/monotonic_counter/counter_model.c" + +#include "psi_examples/logical_resources/monotonic_counter/counter_protocol.h" +#require "psi_examples/logical_resources/monotonic_counter/counter_protocol.c" + +struct mc_counter { + int value; +}; + +PROOF static int _MC_COUNTER_QCP = + install_mc_counter_qcp_interface(); + +#define MC_COUNTER_INIT_SPEC \ + REQUIRE(`undef_data_at (field_addr counter Tmc_counter Fvalue) Tint`) \ + ENSURE_EX(TERM_LIST(`name:num`), \ + `mc_counter_inv name counter`, \ + `mc_counter_token name (0:num)`) + +void mc_counter_init(struct mc_counter *counter) + MC_COUNTER_INIT_SPEC; + +#define MC_COUNTER_INCREMENT_SPEC \ + PARAM(`name:num`, `known:num`) \ + REQUIRE(`mc_counter_inv name counter`, \ + `mc_counter_token name known`) \ + ENSURE(`mc_counter_inv name counter`, \ + `mc_counter_token name (mc_counter_step known)`) + +void mc_counter_increment(struct mc_counter *counter) + MC_COUNTER_INCREMENT_SPEC; + +#define MC_COUNTER_READ_SPEC \ + PARAM(`name:num`, `known:num`) \ + REQUIRE(`mc_counter_inv name counter`, \ + `mc_counter_token name known`) \ + ENSURE(`mc_counter_inv name counter`, \ + `mc_counter_token name known`, \ + `fact((&(known:num):int) <= (__return:int))`) + +int mc_counter_read(const struct mc_counter *counter) + MC_COUNTER_READ_SPEC; diff --git a/psi_examples/logical_resources/monotonic_counter/counter_logic.c b/psi_examples/logical_resources/monotonic_counter/counter_logic.c new file mode 100644 index 0000000000000000000000000000000000000000..e27f1d092f0f673c44c2e9e6ae28a96c7dc7bf59 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter_logic.c @@ -0,0 +1,58 @@ +#include "psi_examples/logical_resources/monotonic_counter/counter_logic.h" + +#require "userlib/qcp/c_logic.c" +#require "proof/theory/logic/auth_ra.c" +#require "proof/theory/logic/max_nat_ra.c" + +PROOF term mc_counter_ra_term(void) { + return `auth_ra max_nat_ra:(((num)excl#num))ra`; +} + +PROOF int install_mc_counter_logic(void) { + static bool installed = false; + if (installed) return 0; + + /* The selected `own` constant exposes the authoritative payload type to + * QCP. Register the inductive type and every constructor before + * `c_logic_install_named` publishes that constant. */ + int export_excl_type = cst_add_type_to_header("excl", 1); + ENSURE_COND(export_excl_type == 0, + "Could not export the excl payload type"); + int export_ra_type = cst_add_type_to_header("ra", 1); + ENSURE_COND(export_ra_type == 0, + "Could not export the RA payload type"); + int export_excl_unit = + cst_add_const_to_header(`ExclUnit:(A)excl`); + ENSURE_COND(export_excl_unit == 0, "Could not export ExclUnit"); + int export_excl = + cst_add_const_to_header(`Excl:A->(A)excl`); + ENSURE_COND(export_excl == 0, "Could not export Excl"); + int export_excl_invalid = + cst_add_const_to_header(`ExclInvalid:(A)excl`); + ENSURE_COND(export_excl_invalid == 0, "Could not export ExclInvalid"); + int export_max_nat_ra = + cst_add_const_to_header(`max_nat_ra:(num)ra`); + ENSURE_COND(export_max_nat_ra == 0, "Could not export max_nat_ra"); + int export_auth_auth = cst_add_const_to_header( + `auth_auth:(num)ra->num->((num)excl#num)`); + ENSURE_COND(export_auth_auth == 0, "Could not export auth_auth"); + int export_auth_frag = cst_add_const_to_header( + `auth_frag:num->((num)excl#num)`); + ENSURE_COND(export_auth_frag == 0, "Could not export auth_frag"); + int export_auth_both = cst_add_const_to_header( + `auth_both:num->num->((num)excl#num)`); + ENSURE_COND( + export_auth_both == 0, + "Could not export the monotonic-counter ghost payload constructor"); + + term selected_ra = mc_counter_ra_term(); + int install_result = c_logic_install_named(selected_ra); + ENSURE_COND( + install_result == 0, + "Could not install the monotonic-counter C logic"); + installed = true; + return 0; +err: + ERR_FUN_PUTS("install_mc_counter_logic"); + return -1; +} diff --git a/psi_examples/logical_resources/monotonic_counter/counter_logic.h b/psi_examples/logical_resources/monotonic_counter/counter_logic.h new file mode 100644 index 0000000000000000000000000000000000000000..a0e751082970615503ddffcad6d82723193dd741 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter_logic.h @@ -0,0 +1,23 @@ +#pragma once + +/* This verification root installs the counter's authoritative ghost RA. */ +#define CSTAR_DEFER_C_LOGIC_INSTALL + +/* One selected complete C-resource model for every counter proof root. */ + +#include "userlib/qcp/c_logic.h" +#include "proof/theory/logic/auth_ra.h" +#include "proof/theory/logic/max_nat_ra.h" + +/* + * Install + * + * G = auth_ra max_nat_ra : ((num)excl # num) ra + * + * exactly once in the current verification session. Repeated calls through + * the model, protocol, implementation, and client interfaces are benign. + */ +PROOF int install_mc_counter_logic(void); + +/* The closed payload algebra installed under the global `named_ra` layer. */ +PROOF term mc_counter_ra_term(void); diff --git a/psi_examples/logical_resources/monotonic_counter/counter_model.c b/psi_examples/logical_resources/monotonic_counter/counter_model.c new file mode 100644 index 0000000000000000000000000000000000000000..92162c2687352a87f4968fa10d1a2a5417b24365 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter_model.c @@ -0,0 +1,151 @@ +#include "psi_examples/logical_resources/monotonic_counter/counter_model_private.h" + +#include "userlib/operational/operational.h" +#require "userlib/operational/operational.c" + +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" + +#include "userlib/proof/probes.h" +#require "userlib/proof/probes.c" + +/* Install the selected monomorphic assertion language before parsing the + * complete-resource representation predicate below. */ +PROOF static int _MC_COUNTER_MODEL_LOGIC = + install_mc_counter_logic(); + +PROOF static size_t MC_COUNTER_MODEL_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +PROOF static int _Tmc_counter = + new_const_safe("Tmc_counter", `:struct_name`); +PROOF static int _Fvalue = + new_const_safe("Fvalue", `:field`); + +/* Deliberately private: clients receive the abstract invariant, not this law. */ +PROOF static thm mc_counter_inv_def = cst_new_fun_definition( + "mc_counter_inv", + `mc_counter_inv name counter -|- + exists current:num. + fact(current <= 2147483647) ** + data_at + (field_addr counter Tmc_counter Fvalue) + Tint + (¤t:int) ** + own (name:num) (auth_auth max_nat_ra current)`, + `:num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,((num)excl#num))finmap)->bool`); + +/*------------------------- private invariant -----------------------------*/ + +PROOF static thm mc_unfold_counter_inv_operation_proof( + const term goal_tm) { + thm unfolding = eq2ent(mc_counter_inv_def); + thm result = prove_operation_by_entailment(goal_tm, unfolding); + return result; +} + +decl_operation(mc_unfold_counter_inv_operation, + TERM_LIST(`name:num`, `counter:int`), + term_list_n(1, + `mc_counter_inv + (KEY name) + (KEY counter)`), + term_list_n(0), + `exists current:num. + fact(current <= 2147483647) ** + data_at + (field_addr counter Tmc_counter Fvalue) + Tint + (¤t:int) ** + own name (auth_auth max_nat_ra current)` +) + +PROOF void mc_unfold_counter_inv_as( + const term name, const term counter, const term current_name) { + apply_operation_named_st( + mc_unfold_counter_inv_operation, + TERM_LIST(name, counter), + TERM_LIST(current_name)); +} + +PROOF static thm mc_fold_counter_inv_operation_proof( + const term goal_tm) { + term resources = ` + fact((current:num) <= 2147483647) ** + data_at + (field_addr (counter:int) Tmc_counter Fvalue) + Tint + (¤t:int) ** + own (name:num) (auth_auth max_nat_ra current)`; + term packed = ` + exists hidden:num. + fact(hidden <= 2147483647) ** + data_at + (field_addr (counter:int) Tmc_counter Fvalue) + Tint + (&hidden:int) ** + own (name:num) (auth_auth max_nat_ra hidden)`; + thm pack = exists_slrule( + packed, `current:num`, refl_slrule(resources)); + thm definition = inst_rule( + TERM_PAIR_LIST( + (term_pair){`name:num`, `name:num`}, + (term_pair){`counter:int`, `counter:int`}), + mc_counter_inv_def); + thm folding = trans_slrule( + pack, eq2ent(sym_rule(definition))); + return prove_operation_by_entailment(goal_tm, folding); +} + +decl_operation(mc_fold_counter_inv_operation, + TERM_LIST(`name:num`, `counter:int`, `current:num`), + TERM_LIST( + `fact(KEY ((current:num) <= 2147483647))`, + `data_at + (field_addr (KEY counter) Tmc_counter Fvalue) + Tint + (KEY (&(current:num):int))`, + `own + (KEY name) + (KEY (auth_auth max_nat_ra current))` + ), + term_list_n(0), + `mc_counter_inv name counter` +) + +PROOF void mc_fold_counter_inv( + const term name, const term counter, const term current) { + apply_operation_st( + mc_fold_counter_inv_operation, + TERM_LIST(name, counter, current)); +} + +/*-------------------------- public installation --------------------------*/ + +PROOF int install_mc_counter_qcp_interface(void) { + static bool installed = false; + if (installed) return 0; + + ENSURE_COND( + cst_add_const_to_header(` + mc_counter_inv: + num->int-> + (((int,(pmem_byte_state)excl)finmap)# + (num,((num)excl#num))finmap)->bool`) == 0, + "Could not export mc_counter_inv"); + installed = true; + return 0; +err: + ERR_FUN_PUTS("install_mc_counter_qcp_interface"); + return -1; +} + +PROOF static int _MC_COUNTER_MODEL_AUDIT = audit_closed_proof_unit( + "monotonic_counter_model", + MC_COUNTER_MODEL_AXIOMS_BEFORE, + THM_LIST( + mc_counter_inv_def, + mc_unfold_counter_inv_operation.lemma, + mc_fold_counter_inv_operation.lemma)); diff --git a/psi_examples/logical_resources/monotonic_counter/counter_model.h b/psi_examples/logical_resources/monotonic_counter/counter_model.h new file mode 100644 index 0000000000000000000000000000000000000000..504a01ce93ec8732a1cb7c72187f02828c2fee9b --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter_model.h @@ -0,0 +1,21 @@ +#pragma once + +/* + * Public proof boundary for the monotonic-counter module invariant. + * + * This interface intentionally exports only the predicate constant to QCP. + * Its physical field, hidden current value, and authoritative ghost-cell + * representation, together with all unfold/fold operations, live in the + * private module interface and are unavailable to clients. Its explicit + * `name` argument is the logical link to client fragments; it is not a C + * runtime value. + */ + +#include "psi_examples/logical_resources/monotonic_counter/counter_logic.h" +#require "psi_examples/logical_resources/monotonic_counter/counter_logic.c" + +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + +/* Export the selected `Prop_G` invariant to one verification root. */ +PROOF int install_mc_counter_qcp_interface(void); diff --git a/psi_examples/logical_resources/monotonic_counter/counter_model_private.h b/psi_examples/logical_resources/monotonic_counter/counter_model_private.h new file mode 100644 index 0000000000000000000000000000000000000000..0c282567d17ff2b7dc59bf2022671eca34e6a9b2 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter_model_private.h @@ -0,0 +1,15 @@ +#pragma once + +/* Private invariant operations used only by `counter.c`. */ + +#include "psi_examples/logical_resources/monotonic_counter/counter_model.h" + +#include "userlib/operational/operational.h" +#require "userlib/operational/operational.c" + +PROOF extern operation mc_fold_counter_inv_operation; + +PROOF void mc_unfold_counter_inv_as( + const term name, const term counter, const term current_name); +PROOF void mc_fold_counter_inv( + const term name, const term counter, const term current); diff --git a/psi_examples/logical_resources/monotonic_counter/counter_protocol.c b/psi_examples/logical_resources/monotonic_counter/counter_protocol.c new file mode 100644 index 0000000000000000000000000000000000000000..6635db739257759d353b638be30cfcc159b810c9 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter_protocol.c @@ -0,0 +1,538 @@ +#include "psi_examples/logical_resources/monotonic_counter/counter_protocol.h" + +#include "proof/proof_backward.h" +#require "proof/proof_backward.c" +#include "userlib/operational/proof_patterns.h" +#require "userlib/operational/proof_patterns.c" +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + +/* Install the selected monomorphic assertion language before parsing any + * definition that mentions its session-local `own` constant. */ +PROOF static int _MC_COUNTER_PROTOCOL_LOGIC = + install_mc_counter_logic(); + +PROOF static size_t MC_COUNTER_PROTOCOL_AXIOMS_BEFORE = + vector_size(get_all_axioms()); + +/* The client token keeps the shared ghost name explicit while hiding the + * concrete authoritative-fragment representation from C contracts. */ +PROOF static thm mc_counter_token_def = cst_new_fun_definition( + "mc_counter_token", + `mc_counter_token name known -|- + own (name:num) (auth_frag (known:num))`, + `:num->num-> + (((int,(pmem_byte_state)excl)finmap)# + (num,((num)excl#num))finmap)->bool`); + +PROOF static thm mc_counter_step_def = cst_new_fun_definition( + "mc_counter_step", + `mc_counter_step (n:num) = + if n < 2147483647 then SUC n else n`, + `:num->num`); + +PROOF static thm mc_counter_token_definition( + const term name, + const term known) { + term_pair_list substitutions = TERM_PAIR_LIST( + (term_pair){name, `name:num`}, + (term_pair){known, `known:num`}); + thm result = inst_rule(substitutions, mc_counter_token_def); + return result; +} + +PROOF static thm prove_mc_counter_own_split_direction(const bool forward) { + term name = `name:num`; + term current = `current:num`; + term known = `known:num`; + term authority = `auth_auth max_nat_ra (current:num)`; + term fragment = `auth_frag (known:num)`; + term combined = `auth_both (current:num) (known:num)`; + + term_list composition_arguments = TERM_LIST( + `max_nat_ra:(num)ra`, + current, + known); + thm composition = ispecl_rule( + composition_arguments, + auth_ra_auth_frag); + thm composition_backwards = gsym_rule(composition); + + term own = c_logic_current()->own; + term own_at_name = mk_comb(own, name); + thm replace_combined = ap_term_rule( + own_at_name, + composition_backwards); + + thm selected_own_op = forward + ? c_logic_current()->ghost_own_split + : c_logic_current()->ghost_own_join; + term_list own_op_arguments = TERM_LIST( + name, + authority, + fragment); + thm split_composition = ispecl_rule( + own_op_arguments, + selected_own_op); + + thm token_definition = mc_counter_token_definition(name, known); + thm fold_token = gsym_rule(token_definition); + term owned_authority = mk_comb(own_at_name, authority); + thm authority_refl = refl_rule(owned_authority); + term sep = sl_sep(); + thm fold_token_under_sep = mk_binop_rule( + sep, + authority_refl, + fold_token); + thm result; + if (forward) { + result = trans_slrule(eq2ent(replace_combined), split_composition); + result = trans_slrule(result, eq2ent(fold_token_under_sep)); + } else { + result = trans_slrule( + eq2ent(gsym_rule(fold_token_under_sep)), split_composition); + result = trans_slrule(result, eq2ent(gsym_rule(replace_combined))); + } + result = gen_rule(known, result); + result = gen_rule(current, result); + result = gen_rule(name, result); + return result; +} + +PROOF static thm MC_COUNTER_OWN_SPLIT = + prove_mc_counter_own_split_direction(true); + +PROOF static thm MC_COUNTER_OWN_JOIN = + prove_mc_counter_own_split_direction(false); + +/* ------------------------------------------------------------------------- */ +/* Specialized authoritative max-natural algebra */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_mc_auth_valid_both(void) { + term goal_tm = ` + forall (current:num) (known:num). + ra_valid + (auth_ra max_nat_ra) + (auth_both current known) <=> + known <= current + `; + gnode root = gnode_new_with_ccl(goal_tm); + conv normalization = rewrite_conv(THM_LIST( + auth_ra_valid_both, + max_nat_ra_valid, + max_nat_ra_included)); + CONV_TAC( + root, + normalization); + thm result = gnode_prove(root); + return result; +} + +PROOF thm MC_AUTH_VALID_BOTH = + prove_mc_auth_valid_both(); + +PROOF static thm prove_mc_counter_own_bound(void) { + term name = `name:num`; + term current = `current:num`; + term known = `known:num`; + term authority = `auth_auth max_nat_ra (current:num)`; + term combined = `auth_both (current:num) (known:num)`; + term own_at_name = mk_comb(c_logic_current()->own, name); + term owned_authority = mk_comb(own_at_name, authority); + term owned_combined = mk_comb(own_at_name, combined); + term token = list_mk_comb( + `mc_counter_token:num->num-> + (((int,(pmem_byte_state)excl)finmap)# + (num,((num)excl#num))finmap)->bool`, + TERM_LIST(name, known)); + term source = mk_sl_sep(owned_authority, token); + term bound = `(known:num) <= (current:num)`; + term valid = ` + ra_valid + (auth_ra max_nat_ra) + (auth_both (current:num) (known:num))`; + + thm source_to_combined = ispecl_rule( + TERM_LIST(name, current, known), MC_COUNTER_OWN_JOIN); + thm validity = ispecl_rule( + TERM_LIST(name, combined), + c_logic_current()->ghost_own_valid); + + thm valid_iff_bound = ispecl_rule( + TERM_LIST(current, known), + MC_AUTH_VALID_BOTH); + thm valid_implies_bound = disch_rule( + valid, + eq_mp_rule(valid_iff_bound, assume_rule(valid))); + thm expose_bound = frame_right_slrule( + fact_transition_slrule(valid_implies_bound), + owned_combined); + thm restore_source = frame_left_slrule( + mk_sl_fact(bound), + ispecl_rule(TERM_LIST(name, current, known), MC_COUNTER_OWN_SPLIT)); + + thm result = trans_slrule(source_to_combined, validity); + result = trans_slrule(result, expose_bound); + result = trans_slrule(result, restore_source); + result = gen_rule(known, result); + result = gen_rule(current, result); + result = gen_rule(name, result); + term expected = ` + forall (name:num) (current:num) (known:num). + own name (auth_auth max_nat_ra current) ** + mc_counter_token name known |-- + fact(known <= current) ** + (own name (auth_auth max_nat_ra current) ** + mc_counter_token name known)`; + ENSURE_COND(equals_term(concl(result), expected), + "MC_COUNTER_OWN_BOUND has the wrong conclusion"); + return result; +err: + ERR_FUN_PUTS("prove_mc_counter_own_bound"); + return empty_theorem; +} + +PROOF thm MC_COUNTER_OWN_BOUND = + prove_mc_counter_own_bound(); + +PROOF static thm prove_mc_counter_step_mono(void) { + term goal_tm = ` + forall x y:num. + x <= y ==> + mc_counter_step x <= mc_counter_step y + `; + thm expanded = apply_conversion( + rewrite_conv(THM_LIST(mc_counter_step_def)), goal_tm); + thm arithmetic = arith_rule(dest_eq(concl(expanded)).tm2); + thm proved = eq_mp_rule(gsym_rule(expanded), arithmetic); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "MC_COUNTER_STEP_MONO has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_mc_counter_step_mono"); + return empty_theorem; +} + +PROOF thm MC_COUNTER_STEP_MONO = + prove_mc_counter_step_mono(); + +PROOF static thm prove_mc_counter_step_extensive(void) { + term goal_tm = ` + forall n:num. + n <= mc_counter_step n + `; + thm expanded = apply_conversion( + rewrite_conv(THM_LIST(mc_counter_step_def)), goal_tm); + thm arithmetic = arith_rule(dest_eq(concl(expanded)).tm2); + thm proved = eq_mp_rule(gsym_rule(expanded), arithmetic); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "MC_COUNTER_STEP_EXTENSIVE has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_mc_counter_step_extensive"); + return empty_theorem; +} + +PROOF thm MC_COUNTER_STEP_EXTENSIVE = + prove_mc_counter_step_extensive(); + +PROOF static thm prove_mc_counter_step_limit(void) { + term goal_tm = ` + forall n:num. + n <= 2147483647 ==> + mc_counter_step n <= 2147483647 + `; + thm expanded = apply_conversion( + rewrite_conv(THM_LIST(mc_counter_step_def)), goal_tm); + thm arithmetic = arith_rule(dest_eq(concl(expanded)).tm2); + thm proved = eq_mp_rule(gsym_rule(expanded), arithmetic); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "MC_COUNTER_STEP_LIMIT has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_mc_counter_step_limit"); + return empty_theorem; +} + +PROOF thm MC_COUNTER_STEP_LIMIT = + prove_mc_counter_step_limit(); + +PROOF static thm prove_mc_counter_step_lt(void) { + term goal_tm = ` + forall n:num. + n < 2147483647 ==> + mc_counter_step n == SUC n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_WITH_ASMP_TAC( + body, + rewrite_conv, + THM_LIST(mc_counter_step_def, get_theorem_by_name("COND_CLAUSES"))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "MC_COUNTER_STEP_LT has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_mc_counter_step_lt"); + return empty_theorem; +} + +PROOF thm MC_COUNTER_STEP_LT = + prove_mc_counter_step_lt(); + +PROOF static thm prove_mc_counter_step_not_lt(void) { + term goal_tm = ` + forall n:num. + ~(n < 2147483647) ==> + mc_counter_step n == n + `; + gnode root = gnode_new_with_ccl(goal_tm); + gnode body = AUTO_INTROS_TAC(root); + CONV_WITH_ASMP_TAC( + body, + rewrite_conv, + THM_LIST(mc_counter_step_def, get_theorem_by_name("COND_CLAUSES"))); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "MC_COUNTER_STEP_NOT_LT has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_mc_counter_step_not_lt"); + return empty_theorem; +} + +PROOF thm MC_COUNTER_STEP_NOT_LT = + prove_mc_counter_step_not_lt(); + +PROOF static thm prove_mc_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 + `; + thm max_le = ispecl_rule( + TERM_LIST(`&(a:num):int`, `&(b:num):int`, `&(bound:num):int`), + get_theorem_by_name("INT_MAX_LE")); + max_le = rewrite_rule( + THM_LIST( + get_theorem_by_name("INT_OF_NUM_MAX"), + get_theorem_by_name("INT_OF_NUM_LE")), + max_le); + gnode root = gnode_new_with_ccl(goal_tm); + CONV_TAC( + root, + rewrite_conv(THM_LIST(max_nat_ra_included, max_nat_ra_op, max_le))); + return gnode_prove(root); +} + +PROOF static thm MC_MAX_NAT_RA_INCLUDED_OP = + prove_mc_max_nat_ra_included_op(); + +PROOF static thm prove_mc_auth_step(void) { + term goal_tm = ` + forall (current:num) (known:num). + ra_update + (auth_ra max_nat_ra) + (auth_both current known) + (auth_both + (mc_counter_step current) + (mc_counter_step known)) + `; + 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( + `max_nat_ra:(num)ra`, + `current:num`, + `known:num`, + `mc_counter_step (current:num)`, + `mc_counter_step (known:num)`), + auth_ra_update_framewise_iff)))); + body = GEN_TAC(body, "external"); + body = DISCH_TAC(body, "Hsource"); + body = ASMP_CONJ_TAC( + body, "Hsource", "Hvalid_current", "Hincluded_source"); + gnode_list goals = CONJ_TAC(body); + ACCEPT_TAC( + goals[0], + ispec_rule(`mc_counter_step (current:num)`, max_nat_ra_valid)); + + thm source_bounds = eq_mp_rule( + ispecl_rule( + TERM_LIST( + `known:num`, + `external:num`, + `current:num`), + MC_MAX_NAT_RA_INCLUDED_OP), + assume_rule(` + ra_included + max_nat_ra + (ra_op max_nat_ra (known:num) (external:num)) + (current:num)`)); + thm known_le_current = conjunct1_rule(source_bounds); + thm external_le_current = conjunct2_rule(source_bounds); + thm stepped_known_le_current = mp_rule( + ispecl_rule( + TERM_LIST(`known:num`, `current:num`), + MC_COUNTER_STEP_MONO), + known_le_current); + thm current_extensive = ispec_rule( + `current:num`, MC_COUNTER_STEP_EXTENSIVE); + thm external_le_step = mp_rule( + ispecl_rule( + TERM_LIST( + `external:num`, + `current:num`, + `mc_counter_step (current:num)`), + get_theorem_by_name("LE_TRANS")), + conj_rule(external_le_current, current_extensive)); + thm target_bounds = conj_rule( + stepped_known_le_current, + external_le_step); + thm target_included = eq_mp_rule( + gsym_rule(ispecl_rule( + TERM_LIST( + `mc_counter_step (known:num)`, + `external:num`, + `mc_counter_step (current:num)`), + MC_MAX_NAT_RA_INCLUDED_OP)), + target_bounds); + ACCEPT_TAC(goals[1], target_included); + thm proved = gnode_prove(root); + ENSURE_COND(equals_term(concl(proved), goal_tm), + "MC_AUTH_STEP has the wrong conclusion"); + return proved; +err: + ERR_FUN_PUTS("prove_mc_auth_step"); + return empty_theorem; +} + +PROOF thm MC_AUTH_STEP = prove_mc_auth_step(); + +/* ------------------------------------------------------------------------- */ +/* Selected complete-assertion viewshifts */ +/* ------------------------------------------------------------------------- */ + +PROOF static thm prove_mc_counter_init_viewshift(void) { + term_list zero_arguments = TERM_LIST(`0`, `0`); + thm valid_both_zero = ispecl_rule( + zero_arguments, + MC_AUTH_VALID_BOTH); + thm valid_both_zero_backwards = gsym_rule(valid_both_zero); + thm le_refl = get_theorem_by_name("LE_REFL"); + thm zero_refl = ispec_rule(`0`, le_refl); + thm valid_zero = eq_mp_rule(valid_both_zero_backwards, zero_refl); + thm own_alloc = c_logic_current()->ghost_own_alloc; + term zero_payload = `auth_both (0:num) (0:num)`; + thm alloc_zero = ispecl_rule( + TERM_LIST(zero_payload, sl_emp()), + own_alloc); + thm allocated = mp_rule(alloc_zero, valid_zero); + allocated = pure_rewrite_rule(THM_LIST(sl_sep_emp_right()), allocated); + term_list split_arguments = TERM_LIST(`name:num`, `0`, `0`); + thm split_zero = ispecl_rule( + split_arguments, + MC_COUNTER_OWN_SPLIT); + thm split_zero_entailment = split_zero; + thm existential_split = exists_mono_slrule( + `name:num`, + split_zero_entailment); + term allocated_statement = concl(allocated); + dest_binop_results allocated_endpoints = + dest_sl_viewshift(allocated_statement); + thm source_refl = refl_slrule(allocated_endpoints.tm1); + thm result = viewshift_mono_slrule( + source_refl, + allocated, + existential_split); + return result; +} + +PROOF thm MC_COUNTER_INIT_VIEWSHIFT = + prove_mc_counter_init_viewshift(); + +PROOF static thm prove_mc_counter_step_viewshift(void) { + thm payload_update = ispecl_rule( + TERM_LIST(`current:num`, `known:num`), + MC_AUTH_STEP); + thm own_update = mp_rule( + ispecl_rule( + TERM_LIST( + `name:num`, + `auth_both (current:num) (known:num)`, + `auth_both + (mc_counter_step (current:num)) + (mc_counter_step (known:num))`), + c_logic_current()->ghost_own_update), + payload_update); + thm source = ispecl_rule( + TERM_LIST(`name:num`, `current:num`, `known:num`), + MC_COUNTER_OWN_JOIN); + thm target = ispecl_rule( + TERM_LIST( + `name:num`, + `mc_counter_step (current:num)`, + `mc_counter_step (known:num)`), + MC_COUNTER_OWN_SPLIT); + thm result = viewshift_mono_slrule(source, own_update, target); + result = gen_rule(`known:num`, result); + result = gen_rule(`current:num`, result); + result = gen_rule(`name:num`, result); + return result; +} + +PROOF thm MC_COUNTER_STEP_VIEWSHIFT = + prove_mc_counter_step_viewshift(); + +/* ------------------------------------------------------------------------- */ +/* Source-local trust audit */ +/* ------------------------------------------------------------------------- */ + +PROOF static int audit_mc_counter_protocol(void) { + thm_list public_theorems = THM_LIST( + mc_counter_token_def, + mc_counter_step_def, + MC_COUNTER_OWN_SPLIT, + MC_COUNTER_OWN_JOIN, + MC_AUTH_VALID_BOTH, + MC_COUNTER_OWN_BOUND, + MC_COUNTER_STEP_MONO, + MC_COUNTER_STEP_EXTENSIVE, + MC_COUNTER_STEP_LIMIT, + MC_COUNTER_STEP_LT, + MC_COUNTER_STEP_NOT_LT, + MC_MAX_NAT_RA_INCLUDED_OP, + MC_AUTH_STEP, + MC_COUNTER_INIT_VIEWSHIFT, + MC_COUNTER_STEP_VIEWSHIFT); + for (size_t i = 0; i < vector_size(public_theorems); ++i) { + ENSURE_COND( + !IS_NULL(public_theorems[i]), + "monotonic-counter protocol theorem %zu is null", + i); + term_list theorem_hypotheses = hyp(public_theorems[i]); + ENSURE_COND( + vector_size(theorem_hypotheses) == 0, + "monotonic-counter protocol theorem %zu has hypotheses", + i); + } + thm_list current_axioms = get_all_axioms(); + ENSURE_COND( + vector_size(current_axioms) == + MC_COUNTER_PROTOCOL_AXIOMS_BEFORE, + "monotonic-counter protocol introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_mc_counter_protocol"); + return -1; +} + +PROOF static int _MC_COUNTER_PROTOCOL_AUDIT = + audit_mc_counter_protocol(); diff --git a/psi_examples/logical_resources/monotonic_counter/counter_protocol.h b/psi_examples/logical_resources/monotonic_counter/counter_protocol.h new file mode 100644 index 0000000000000000000000000000000000000000..9d853aee1818af3a440e584b92907de0fd4e1d17 --- /dev/null +++ b/psi_examples/logical_resources/monotonic_counter/counter_protocol.h @@ -0,0 +1,68 @@ +#pragma once + +/* + * Linear ghost protocol for the monotonic counter. + * + * The selected cell algebra is `auth_ra max_nat_ra`. A live protocol cell + * carries `auth_both current known`: `current` is the module's authoritative + * value and `known` is the client's linearly owned lower bound. Validity is + * exactly `known <= current`. + * + * `mc_counter_token name known` is the client's abstract fragment at the + * module's shared ghost name. The name is an ordinary logical `num`: it is + * existentially introduced once by initialization and then threaded through + * both the module invariant and every client token. The fragment's concrete + * RA representation remains private to this proof layer. + * + * Every assertion below is the installed complete `Prop_G`. Ghost ownership + * has empty physical projection; a C implementation frames each exported + * viewshift with its current physical `mc_counter_rep` before committing it as + * a complete symbolic state. + */ + +#include "psi_examples/logical_resources/monotonic_counter/counter_logic.h" +#require "psi_examples/logical_resources/monotonic_counter/counter_logic.c" + +/* `valid(auth_both current known) <=> known <= current`. */ +PROOF extern thm MC_AUTH_VALID_BOTH; + +/* Same-name authority/fragment validity exposes only the public lower bound: + * + * own name (auth_auth max_nat_ra current) ** + * mc_counter_token name known + * |-- + * fact(known <= current) ** + * (own name (auth_auth max_nat_ra current) ** + * mc_counter_token name known). + */ +PROOF extern thm MC_COUNTER_OWN_BOUND; + +/* Saturating successor used by the concrete C `int` implementation: + * `mc_counter_step n = if n < 2147483647 then SUC n else n`. */ +PROOF extern thm MC_COUNTER_STEP_MONO; +PROOF extern thm MC_COUNTER_STEP_EXTENSIVE; +PROOF extern thm MC_COUNTER_STEP_LIMIT; +PROOF extern thm MC_COUNTER_STEP_LT; +PROOF extern thm MC_COUNTER_STEP_NOT_LT; + +/* Synchronously step authority and client lower bound. */ +PROOF extern thm MC_AUTH_STEP; + +/* + * Allocate a shared name and split its initial authoritative cell: + * + * emp ==*=> + * exists name. + * own name (auth_auth max_nat_ra 0) ** + * mc_counter_token name 0. + */ +PROOF extern thm MC_COUNTER_INIT_VIEWSHIFT; + +/* + * own name (auth_auth max_nat_ra current) ** + * mc_counter_token name known + * ==*=> + * own name (auth_auth max_nat_ra (mc_counter_step current)) ** + * mc_counter_token name (mc_counter_step known). + */ +PROOF extern thm MC_COUNTER_STEP_VIEWSHIFT; diff --git a/psi_examples/units/fixed_pool.c b/psi_examples/units/fixed_pool.c index 7254c293a8bcb6ca72cc7adada840fddecd16399..a44bed19f1bd1f01aeaf42719d741fbe517399d6 100644 --- a/psi_examples/units/fixed_pool.c +++ b/psi_examples/units/fixed_pool.c @@ -1,8 +1,4 @@ -/* - * cstarc treats every same-stem header as this source's own interface and does - * not feed its struct declarations to QCP. Keep the identical C layout here - * for this independent implementation root; clients obtain it from the header. - */ +/* Independent implementation root: keep the public executable layout here. */ struct fixed_pool_block { int payload; struct fixed_pool_block *next; @@ -15,63 +11,91 @@ struct fixed_pool { #define FIXED_POOL_LAYOUT_DEFINED #include "psi_examples/units/fixed_pool.h" -/* Header/layout changes must rebuild this same-stem implementation root. */ - // verify_all: expect-vcs=0 void fixed_pool_init(struct fixed_pool *pool) FIXED_POOL_INIT_SPEC { pool->head = (void *)0; - PROOF fold_empty_pool(`pool__pre:addr`); + PROOF fixed_pool_init_ghost_and_fold(`pool__pre:int`); } -void fixed_pool_put( +void fixed_pool_supply( struct fixed_pool *pool, struct fixed_pool_block *block) - FIXED_POOL_PUT_SPEC + FIXED_POOL_SUPPLY_SPEC { - /* Unfold the two abstract resources needed by the executable push. */ PROOF { - unfold_pool_rep_as(`pool__pre:addr`, `old_head:addr`); - unfold_malloc_token_as(`block__pre:addr`, `discarded_next:addr`); + unfold_pool_rep_as( + `name:num`, `pool__pre:int`, `old_head:int`); + unfold_pool_block_seed_as( + `block__pre:int`, `discarded_next:int`); + fixed_pool_register_ghost( + `name:num`, + `domain:(int,(1)excl)finmap`, + `block__pre:int`); } struct fixed_pool_block *head = pool->head; block->next = head; pool->head = block; - /* Fold the new chain node first, then close the manager representation. */ PROOF { - fold_pool_chain_cons(`block__pre:addr`); - fold_pool_rep(`pool__pre:addr`); + fold_pool_chain_cons(`name:num`, `block__pre:int`); + fold_pool_rep( + `name:num`, + `pool__pre:int`, + `pool_domain_extend + (domain:(int,(1)excl)finmap) + (block__pre:int)`); } } -void fixed_pool_supply( +void fixed_pool_put( struct fixed_pool *pool, struct fixed_pool_block *block) - FIXED_POOL_SUPPLY_SPEC + FIXED_POOL_PUT_SPEC { - /* PSI composition: supply reuses the verified push code and proof. */ - fixed_pool_put(pool, block); + PROOF { + unfold_pool_rep_as( + `name:num`, `pool__pre:int`, `old_head:int`); + unfold_malloc_token_as( + `name:num`, + `block__pre:int`, + `discarded_next:int`); + } + + struct fixed_pool_block *head = pool->head; + block->next = head; + pool->head = block; + + PROOF { + fold_pool_chain_cons(`name:num`, `block__pre:int`); + fold_pool_rep( + `name:num`, + `pool__pre:int`, + `domain:(int,(1)excl)finmap`); + } } struct fixed_pool_block *fixed_pool_take(struct fixed_pool *pool) FIXED_POOL_TAKE_SPEC { - /* Expose exactly the manager head and first recursive chain cell. */ PROOF { - unfold_pool_rep_as(`pool__pre:addr`, `free_head:addr`); - unfold_pool_chain_cons_as(`free_head:addr`, `next_head:addr`); + unfold_pool_rep_as( + `name:num`, `pool__pre:int`, `free_head:int`); + unfold_pool_chain_cons_as( + `name:num`, `free_head:int`, `next_head:int`); } struct fixed_pool_block *block = pool->head; struct fixed_pool_block *next = block->next; pool->head = next; - /* The remainder becomes the pool; the detached next cell becomes a token. */ PROOF { - fold_pool_rep(`pool__pre:addr`); - fold_malloc_token(`free_head:addr`); + fold_pool_rep( + `name:num`, + `pool__pre:int`, + `domain:(int,(1)excl)finmap`); + fold_malloc_token(`name:num`, `free_head:int`); } return block; diff --git a/psi_examples/units/fixed_pool.h b/psi_examples/units/fixed_pool.h index 5dc2cadbd293195f4c23290ed288787bbe04d4ca..82584f6d23f0a402a46aaf2ba33bc385a85dcb48 100644 --- a/psi_examples/units/fixed_pool.h +++ b/psi_examples/units/fixed_pool.h @@ -1,6 +1,6 @@ #pragma once -/* Proof-spec-implementation units for the fixed one-bin pool. */ +/* Public module interface for the ghost-aware one-bin free-list allocator. */ #include "psi_examples/lib/fixed_pool.h" #require "psi_examples/lib/fixed_pool.c" @@ -17,43 +17,65 @@ struct fixed_pool { }; #endif -/* Contracts below mention user-defined predicates, so export them first. */ PROOF static int _FIXED_POOL_UNIT_QCP = install_fixed_pool_qcp_interface(); +/* Initialization chooses one fresh ghost name and an empty logical domain. */ #define FIXED_POOL_INIT_SPEC \ REQUIRE(`undef_data_at (field_addr pool Tfixed_pool Fhead) Tptr`) \ - ENSURE(`pool_rep pool ([]:(int)list)`) + ENSURE_EX(TERM_LIST(`name:num`), \ + `pool_rep name pool (finmap_empty:(int,(1)excl)finmap) ([]:(int)list)`) void fixed_pool_init(struct fixed_pool *pool) FIXED_POOL_INIT_SPEC; -#define FIXED_POOL_PUT_SPEC \ - PARAM(`values:(int)list`, `payload_value:int`) \ - REQUIRE(`pool_rep pool values`, \ +/* + * Register caller-owned storage once and insert it into the free-list. + * `pool_domain_fresh` is the protocol-side proof that no token for `block` + * already exists at this allocator name. + */ +#define FIXED_POOL_SUPPLY_SPEC \ + PARAM(`name:num`, \ + `domain:(int,(1)excl)finmap`, \ + `values:(int)list`, \ + `payload_value:int`) \ + REQUIRE(`pool_rep name pool domain values`, \ `data_at (field_addr block Tfixed_pool_block Fpayload) Tint payload_value`, \ - `malloc_token block`, \ - `fact(~(block = 0i))`) \ - ENSURE(`pool_rep pool (payload_value :: values)`) + `pool_block_seed block`, \ + `fact(~(block = 0i))`, \ + `fact(pool_domain_fresh domain block)`) \ + ENSURE(`pool_rep name pool (pool_domain_extend domain block) (payload_value :: values)`) -void fixed_pool_put( +void fixed_pool_supply( struct fixed_pool *pool, struct fixed_pool_block *block) - FIXED_POOL_PUT_SPEC; + FIXED_POOL_SUPPLY_SPEC; -/* Initial supply has the same ownership transfer as a later put. */ -#define FIXED_POOL_SUPPLY_SPEC FIXED_POOL_PUT_SPEC +/* Free consumes a client token tied to both this name and this block. */ +#define FIXED_POOL_PUT_SPEC \ + PARAM(`name:num`, \ + `domain:(int,(1)excl)finmap`, \ + `values:(int)list`, \ + `payload_value:int`) \ + REQUIRE(`pool_rep name pool domain values`, \ + `data_at (field_addr block Tfixed_pool_block Fpayload) Tint payload_value`, \ + `malloc_token name block`, \ + `fact(~(block = 0i))`) \ + ENSURE(`pool_rep name pool domain (payload_value :: values)`) -void fixed_pool_supply( +void fixed_pool_put( struct fixed_pool *pool, struct fixed_pool_block *block) - FIXED_POOL_SUPPLY_SPEC; + FIXED_POOL_PUT_SPEC; -/* A nonempty logical list makes take total: no failure branch is exposed. */ -#define FIXED_POOL_TAKE_SPEC \ - PARAM(`payload_value:int`, `values:(int)list`) \ - REQUIRE(`pool_rep pool (payload_value :: values)`) \ - ENSURE(`pool_rep pool values`, \ +/* Malloc removes one physical node and returns its same-name client token. */ +#define FIXED_POOL_TAKE_SPEC \ + PARAM(`name:num`, \ + `domain:(int,(1)excl)finmap`, \ + `payload_value:int`, \ + `values:(int)list`) \ + REQUIRE(`pool_rep name pool domain (payload_value :: values)`) \ + ENSURE(`pool_rep name pool domain values`, \ `data_at (field_addr __return Tfixed_pool_block Fpayload) Tint payload_value`, \ - `malloc_token __return`, \ + `malloc_token name __return`, \ `fact(~(__return = 0i))`) struct fixed_pool_block *fixed_pool_take(struct fixed_pool *pool) diff --git a/psi_examples/units/wand_cursor.c b/psi_examples/units/wand_cursor.c index 11a639939b9146f0bbf14b9aaca21dbf5b9331e2..f2607a2f1e18c36523e4901d511765eb2edb4199 100644 --- a/psi_examples/units/wand_cursor.c +++ b/psi_examples/units/wand_cursor.c @@ -8,12 +8,12 @@ PROOF static size_t WAND_CURSOR_AXIOMS_BEFORE = * independent of any global client invariant. */ PROOF static thm prove_append_node_rebuild(void) { - term cursor = `cursor:addr`; - term node = `p:addr`; + term cursor = `cursor:int`; + term node = `p:int`; term value = `h:int`; term tail = `tail:(int)list`; term suffix = `ys:(int)list`; - term next = `q:addr`; + term next = `q:int`; term nonnull = `~(p = 0i)`; term next_box = `field_addr p Twand_node Fnext`; @@ -22,7 +22,7 @@ PROOF static thm prove_append_node_rebuild(void) { `APPEND ((h:int) :: (tail:(int)list)) (ys:(int)list)`; term layer = `data_at cursor Tptr p ** data_at (field_addr p Twand_node Fvalue) Tint h`; - term opened_next = `exists q:addr. + term opened_next = `exists q:int. data_at (field_addr p Twand_node Fnext) Tptr q ** wand_list q (APPEND (tail:(int)list) (ys:(int)list))`; @@ -79,7 +79,7 @@ PROOF static thm prove_append_cursor_advance(void) { (APPEND (whole:(int)list) (ys:(int)list))`; thm rebuild = specl_rule( - TERM_LIST(`cursor:addr`, `p:addr`, `h:int`, + TERM_LIST(`cursor:int`, `p:int`, `h:int`, `tail:(int)list`, `ys:(int)list`), APPEND_NODE_REBUILD); rebuild = mp_rule(rebuild, assume_rule(nonnull)); @@ -93,8 +93,8 @@ PROOF static thm prove_append_cursor_advance(void) { advanced = disch_rule(nonnull, advanced); advanced = disch_rule(shape, advanced); return genl_rule( - TERM_LIST(`cursor:addr`, `root:addr`, `rest:(int)list`, - `whole:(int)list`, `ys:(int)list`, `p:addr`, + TERM_LIST(`cursor:int`, `root:int`, `rest:(int)list`, + `whole:(int)list`, `ys:(int)list`, `p:int`, `h:int`, `tail:(int)list`), advanced); } @@ -111,7 +111,7 @@ PROOF void advance_append_context( APPEND_CURSOR_ADVANCE); apply_hconv_st(undisch_all_rule(step)); close_append_context( - `field_addr ${node:addr} Twand_node Fnext`, + `field_addr ${node:int} Twand_node Fnext`, root, tail, whole, ys); } @@ -124,15 +124,15 @@ void advance_append_cursor(struct wand_node **cursor, void **out) ADVANCE_APPEND_CURSOR_SPEC { PROOF open_wand_list_nonnull_as( - `p:addr`, `h:int`, `tail:(int)list`, `q:addr`); + `p:int`, `h:int`, `tail:(int)list`, `q:int`); struct wand_node *node = *cursor; struct wand_node **next = &(node->next); *out = (void *)next; PROOF advance_append_context( - `cursor__pre:addr`, `root:addr`, `rest:(int)list`, - `whole:(int)list`, `ys:(int)list`, `p:addr`, + `cursor__pre:int`, `root:int`, `rest:(int)list`, + `whole:(int)list`, `ys:(int)list`, `p:int`, `h:int`, `tail:(int)list`); } @@ -141,14 +141,14 @@ void splice_append_suffix( struct wand_node **cursor, struct wand_node *suffix) SPLICE_APPEND_SUFFIX_SPEC { - PROOF open_wand_list_null(`p:addr`); + PROOF open_wand_list_null(`p:int`); *cursor = suffix; PROOF { - close_wand_listbox(`cursor__pre:addr`); + close_wand_listbox(`cursor__pre:int`); finish_append_context( - `cursor__pre:addr`, `root:addr`, `rest:(int)list`, + `cursor__pre:int`, `root:int`, `rest:(int)list`, `whole:(int)list`, `ys:(int)list`); } } diff --git a/psi_examples/units/wand_cursor.h b/psi_examples/units/wand_cursor.h index a783f419d24a23eaa7cd1c1f231f386fcf209641..f6386ae61ee4d7c0ee77e8e106330bc530d1e79e 100644 --- a/psi_examples/units/wand_cursor.h +++ b/psi_examples/units/wand_cursor.h @@ -24,15 +24,15 @@ PROOF void advance_append_context( const term node, const term value, const term tail); #define ADVANCE_APPEND_CURSOR_SPEC \ - PARAM(`root:addr`, `rest:(int)list`, `whole:(int)list`, \ - `ys:(int)list`, `p:addr`) \ + PARAM(`root:int`, `rest:(int)list`, `whole:(int)list`, \ + `ys:(int)list`, `p:int`) \ REQUIRE( \ `data_at cursor Tptr p`, \ `wand_list p rest`, \ `append_context cursor root rest whole ys`, \ `fact(~(p = 0i))`, \ `undef_data_at out Tptr`) \ - ENSURE_EX(TERM_LIST(`tail:(int)list`, `q:addr`), \ + ENSURE_EX(TERM_LIST(`tail:(int)list`, `q:int`), \ `data_at out Tptr (field_addr p Twand_node Fnext)`, \ `data_at (field_addr p Twand_node Fnext) Tptr q`, \ `wand_list q tail`, \ @@ -42,8 +42,8 @@ void advance_append_cursor(struct wand_node **cursor, void **out) ADVANCE_APPEND_CURSOR_SPEC; #define SPLICE_APPEND_SUFFIX_SPEC \ - PARAM(`root:addr`, `rest:(int)list`, `whole:(int)list`, \ - `ys:(int)list`, `p:addr`) \ + PARAM(`root:int`, `rest:(int)list`, `whole:(int)list`, \ + `ys:(int)list`, `p:int`) \ REQUIRE( \ `data_at cursor Tptr p`, \ `wand_list p rest`, \ diff --git a/psi_examples/wand_append.c b/psi_examples/wand_append.c index e85d71ac11aa0a3e26653f6bd9820e4a837fd578..e91cbf63095ac29f3ed4475abed3adb8eacd6baa 100644 --- a/psi_examples/wand_append.c +++ b/psi_examples/wand_append.c @@ -11,12 +11,12 @@ void append_wand(struct wand_node **root, struct wand_node *suffix) struct wand_node **cursor = root; PROOF begin_append_context_as( - `root__pre:addr`, `xs:(int)list`, `ys:(int)list`, - `head_v:addr`); + `root__pre:int`, `xs:(int)list`, `ys:(int)list`, + `head_v:int`); struct wand_node *current = *cursor; - PROOF term loop_inv = `exists box_v:addr. exists node_v:addr. + PROOF term loop_inv = `exists box_v:int. exists node_v:int. exists rest_v:(int)list. data_at root__addr Tptr root__pre ** data_at suffix__addr Tptr suffix__pre ** @@ -37,6 +37,6 @@ void append_wand(struct wand_node **root, struct wand_node *suffix) current = *cursor; } - PROOF normalize_terminal_cursor(`node_v:addr`); + PROOF normalize_terminal_cursor(`node_v:int`); splice_append_suffix(cursor, suffix); } diff --git a/strategy_demo/array/array.h b/strategy_demo/array/array.h index 5f24b8875be46a3149859d44ed5d175627ec2792..f3255c48a24284868936e20f8cf67739b6e307e6 100644 --- a/strategy_demo/array/array.h +++ b/strategy_demo/array/array.h @@ -1,6 +1,8 @@ #pragma once #include "proof/proof_symexec.h" +#include "proof/theory/data/int_list.h" +#require "proof/theory/data/int_list.c" #include "userlib/smt/smt_seq.h" PROOF extern thm int_array_def; diff --git a/strategy_demo/array/lemmas.c b/strategy_demo/array/lemmas.c index c719a63bbc832efd9e8cec5e69d5ad1c3e4b5a02..40f60a3f946a8b3eee7ae53d7b59fc917bd01b30 100644 --- a/strategy_demo/array/lemmas.c +++ b/strategy_demo/array/lemmas.c @@ -1,6 +1,8 @@ #include "strategy_demo/array/lemmas.h" #require "proof/proof_backward.c" +#include "proof/theory/data/int_list.h" +#require "proof/theory/data/int_list.c" PROOF static thm strategy_num_of_int_zero(void) { return ispec_rule(`0`, get_theorem_by_name("NUM_OF_INT_OF_NUM")); @@ -30,14 +32,14 @@ PROOF static thm strategy_num_of_int_ilength(void) { gnode_list cases = INDUCT_TAC(g, `xs:(int)list`); CONV_TAC(cases[0], rewrite_conv(THM_LIST( - get_ILENGTH_DEF(), get_theorem_by_name("LENGTH"), + ILENGTH_DEF, get_theorem_by_name("LENGTH"), strategy_num_of_int_zero()))); thm length_suc = mp_rule( strategy_num_of_int_suc_at(`ilength (a1:(int)list)`), - ispec_rule(`a1:(int)list`, get_ILENGTH_NONNEG())); + ispec_rule(`a1:(int)list`, ILENGTH_NONNEG)); CONV_TAC(cases[1], rewrite_conv(THM_LIST( - get_ILENGTH_DEF(), get_theorem_by_name("LENGTH"), + ILENGTH_DEF, get_theorem_by_name("LENGTH"), int_arith_rule(`1i + ilength (a1:(int)list) = ilength a1 + 1i`), length_suc, get_theorem_by_name("ADD1"), assume_rule(gnode_get_asmps( @@ -59,7 +61,7 @@ PROOF static thm strategy_int_index_lt_length(void) { assume_rule(`0i <= i`))))); g = CONV_TAC(g, rewrite_conv(THM_LIST(match_mp_rule( get_theorem_by_name("INT_OF_NUM_OF_INT"), - ispec_rule(`xs:(int)list`, get_ILENGTH_NONNEG()))))); + ispec_rule(`xs:(int)list`, ILENGTH_NONNEG))))); ACCEPT_TAC(g, assume_rule(`i < ilength (xs:(int)list)`)); return gnode_prove(root); } @@ -91,7 +93,7 @@ PROOF static thm replace_nth_at(void) { CONV_WITH_ASMP_TAC(n_cases[0], rewrite_conv, THM_LIST( get_theorem_by_name("LENGTH"), get_theorem_by_name("LT_0"), - get_REPLACE_NTH_DEF(), get_NTH_DEF())); + REPLACE_NTH_DEF, NTH_DEF)); g = DISCH_TAC(n_cases[1], "B"); thm n_case = assume_rule( @@ -106,7 +108,7 @@ PROOF static thm replace_nth_at(void) { assume_rule(gnode_get_asmps(g, CONST_STRING_LIST("H"))[0])); ih = mp_rule(ih, tail_bound); CONV_TAC(g, rewrite_conv(THM_LIST( - n_case, get_REPLACE_NTH_DEF(), get_NTH_DEF(), ih))); + n_case, REPLACE_NTH_DEF, NTH_DEF, ih))); return gnode_prove(root); } @@ -147,7 +149,7 @@ PROOF static thm replace_nth_other(void) { CONV_WITH_ASMP_TAC(zero_suc, simp_conv, THM_LIST( get_theorem_by_name("LENGTH"), get_theorem_by_name("LT_0"), get_theorem_by_name("LT_SUC"), - get_REPLACE_NTH_DEF(), get_NTH_DEF())); + REPLACE_NTH_DEF, NTH_DEF)); gnode n_suc = GEN_TAC(n_cases[1], "m"); gnode_list m_cases_at_n_suc = CASES_TAC(n_suc, `m:num`, "C_m"); @@ -155,7 +157,7 @@ PROOF static thm replace_nth_other(void) { CONV_WITH_ASMP_TAC(suc_zero, simp_conv, THM_LIST( get_theorem_by_name("LENGTH"), get_theorem_by_name("LT_0"), get_theorem_by_name("LT_SUC"), - get_REPLACE_NTH_DEF(), get_NTH_DEF())); + REPLACE_NTH_DEF, NTH_DEF)); gnode both_suc = AUTO_INTROS_TAC(m_cases_at_n_suc[1]); thm n_suc_eq = assume_rule( @@ -193,14 +195,14 @@ PROOF static thm replace_nth_other(void) { ih = mp_rule(ih, m_bound); ih = mp_rule(ih, tail_neq); CONV_TAC(both_suc, rewrite_conv(THM_LIST( - n_suc_eq, m_suc_eq, get_REPLACE_NTH_DEF(), get_NTH_DEF(), ih))); + n_suc_eq, m_suc_eq, REPLACE_NTH_DEF, NTH_DEF, ih))); return gnode_prove(root); } PROOF static thm strategy_num_of_int_neq(term i, term j) { term num_eq = `num_of_int ${j:int} = num_of_int ${i:int}`; - thm as_int = ap_term_rule(`int_of_num`, assume_rule(num_eq)); + thm as_int = ap_term_rule(`int_of_num:num->int`, assume_rule(num_eq)); thm j_back = match_mp_rule( get_theorem_by_name("INT_OF_NUM_OF_INT"), assume_rule(`0i <= ${j:int}`)); @@ -224,14 +226,14 @@ PROOF static thm replace_nth_length(void) { g = AUTO_INTROS_TAC(list_cases[0]); CONV_TAC(g, rewrite_conv(THM_LIST( - get_REPLACE_NTH_DEF(), get_ILENGTH_DEF()))); + REPLACE_NTH_DEF, ILENGTH_DEF))); g = GEN_TAC(list_cases[1], "n"); gnode_list n_cases = CASES_TAC(g, `n:num`, "C_n"); for (size_t k = 0; k < vector_size(n_cases); ++k) { gnode branch = AUTO_INTROS_TAC(n_cases[k]); CONV_WITH_ASMP_TAC(branch, rewrite_conv, THM_LIST( - get_REPLACE_NTH_DEF(), get_ILENGTH_DEF(), + REPLACE_NTH_DEF, ILENGTH_DEF, assume_rule(gnode_get_asmps( list_cases[1], CONST_STRING_LIST("H"))[0]))); } @@ -246,14 +248,14 @@ PROOF static thm replace_nth_self(void) { gnode_list list_cases = INDUCT_TAC(g, `l:(int)list`); g = GEN_TAC(list_cases[0], "n"); - CONV_TAC(g, rewrite_conv(THM_LIST(get_REPLACE_NTH_DEF()))); + CONV_TAC(g, rewrite_conv(THM_LIST(REPLACE_NTH_DEF))); g = GEN_TAC(list_cases[1], "n"); gnode_list n_cases = CASES_TAC(g, `n:num`, "C_n"); CONV_WITH_ASMP_TAC(n_cases[0], rewrite_conv, THM_LIST( - get_REPLACE_NTH_DEF(), get_NTH_DEF())); + REPLACE_NTH_DEF, NTH_DEF)); CONV_WITH_ASMP_TAC(n_cases[1], rewrite_conv, THM_LIST( - get_REPLACE_NTH_DEF(), get_NTH_DEF(), + REPLACE_NTH_DEF, NTH_DEF, assume_rule(gnode_get_asmps( list_cases[1], CONST_STRING_LIST("H"))[0]))); @@ -272,7 +274,7 @@ PROOF thm replace_inth_at(void) { replace_nth_at()); result = mp_rule(result, bound); CONV_TAC(g, rewrite_conv(THM_LIST( - get_REPLACE_INTH_DEF(), get_INTH_DEF(), result))); + REPLACE_INTH_DEF, INTH_DEF, result))); return gnode_prove(root); } @@ -292,7 +294,7 @@ PROOF thm replace_inth_other(void) { result = mp_rule(result, j_bound); result = mp_rule(result, strategy_num_of_int_neq(`i:int`, `j:int`)); CONV_TAC(g, rewrite_conv(THM_LIST( - get_REPLACE_INTH_DEF(), get_INTH_DEF(), result))); + REPLACE_INTH_DEF, INTH_DEF, result))); return gnode_prove(root); } @@ -302,7 +304,7 @@ PROOF thm replace_inth_length(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); CONV_TAC(g, rewrite_conv(THM_LIST( - get_REPLACE_INTH_DEF(), replace_nth_length()))); + REPLACE_INTH_DEF, replace_nth_length()))); return gnode_prove(root); } @@ -313,6 +315,6 @@ PROOF thm replace_inth_self(void) { gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); CONV_TAC(g, rewrite_conv(THM_LIST( - get_REPLACE_INTH_DEF(), get_INTH_DEF(), replace_nth_self()))); + REPLACE_INTH_DEF, INTH_DEF, replace_nth_self()))); return gnode_prove(root); } diff --git a/strategy_demo/array/strategy_proof.c b/strategy_demo/array/strategy_proof.c index 826e11cd95f90250ca3ae1bec4704885bdf4a3f4..08cec04a01cfa9be2c666c8e1f29b3a8aec6a3d5 100644 --- a/strategy_demo/array/strategy_proof.c +++ b/strategy_demo/array/strategy_proof.c @@ -1,31 +1,45 @@ #include "strategy_demo/array/strategy_proof.h" #require "strategy_demo/array/array.c" -PROOF static thm strategy_hforall_intro(const term v, const thm ent) { +PROOF static thm strategy_contract_forall_intro(const thm instance) { + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise = land_conv(binder_conv(rand_conv(beta))); + conv result = rand_conv(rand_conv(binder_conv(beta))); + return conv_rule(then_conv(premise, result), instance); +} + +PROOF static thm strategy_contract_forall_elim(const thm instance) { + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise = land_conv(land_conv(beta)); + conv result = rand_conv(land_conv(rand_conv(binder_conv(beta)))); + return conv_rule(then_conv(premise, result), instance); +} + +PROOF static thm strategy_forall_intro(const term v, const thm ent) { dest_binop_results sides = dest_sl_ent(concl(ent)); term body = mk_abs(v, sides.tm2); thm intro = ispecl_rule( - TERM_LIST(sides.tm1, body), get_hforall_intro()); - intro = beta_rule(intro); + TERM_LIST(sides.tm1, body), sl_forall_intro()); + intro = strategy_contract_forall_intro(intro); return match_mp_rule(intro, gen_rule(v, ent)); } -PROOF static thm strategy_hforall_elim( +PROOF static thm strategy_forall_elim( const term universal, const term witness, const thm ent) { term quantified = universal; thm unfold = empty_theorem; - if (!is_binder("hforall", quantified)) { + if (!is_sl_forall(quantified)) { thm equation = apply_conversion( rewrite_conv(THM_LIST(int_array_with_hole_def)), quantified); quantified = dest_sl_eq(concl(equation)).tm2; unfold = eq2ent(equation); } - dest_binder_results binder = dest_binder("hforall", quantified); + dest_binder_results binder = dest_sl_forall(quantified); term body = mk_abs(binder.v, binder.tm); term target = dest_sl_ent(concl(ent)).tm2; thm elim = ispecl_rule( - TERM_LIST(target, body, witness), get_hforall_elim()); - elim = beta_rule(elim); + TERM_LIST(body, target, witness), sl_forall_elim()); + elim = strategy_contract_forall_elim(elim); thm result = match_mp_rule(elim, ent); if (!IS_NULL(unfold)) { result = trans_slrule(unfold, result); @@ -57,7 +71,7 @@ PROOF static thm strategy_num_of_int_suc( } PROOF static thm strategy_cell_value_wand(void) { - term p = `p:addr`; + term p = `p:int`; term i = `i:int`; term h = `h:int`; term v = `v:int`; @@ -73,7 +87,7 @@ PROOF static thm strategy_cell_value_wand(void) { /* Open a bounded cell while retaining a universally quantified rebuild wand. */ PROOF static thm strategy_int_array_open(void) { - term goal_tm = `forall l:(int)list. forall p:addr. forall x y i:int. + term goal_tm = `forall l:(int)list. forall p:int. forall x y i:int. x <= i ==> i < y ==> (int_array p x y l |-- data_at (p + i * sizeof Tint) Tint (inth (i - x) l) ** @@ -102,11 +116,11 @@ PROOF static thm strategy_int_array_open(void) { int_array_def, int_array_with_hole_def, offset_zero, - get_INTH_DEF(), - get_REPLACE_INTH_DEF(), + INTH_DEF, + REPLACE_INTH_DEF, get_theorem_by_name("NUM_OF_INT_OF_NUM"), - get_NTH_DEF(), - get_REPLACE_NTH_DEF())); + NTH_DEF, + REPLACE_NTH_DEF)); if (IS_NULL(at_head->solved)) { term cell = `data_at (p + x * sizeof Tint) Tint a0`; term tail = `int_array p (x + 1i) y (a1:(int)list)`; @@ -114,7 +128,7 @@ PROOF static thm strategy_int_array_open(void) { term varying_cell = `data_at (p + x * sizeof Tint) Tint w`; thm rebuild = intro_wand_slrule( varying_cell, refl_slrule(mk_sl_sep(varying_cell, tail))); - rebuild = strategy_hforall_intro(w, rebuild); + rebuild = strategy_forall_intro(w, rebuild); ACCEPT_TAC(at_head, frame_mono_slrule( refl_slrule(cell), rebuild)); } @@ -125,7 +139,7 @@ PROOF static thm strategy_int_array_open(void) { next_bound = mp_rule(next_bound, assume_rule(`x <= i`)); next_bound = mp_rule(next_bound, assume_rule(`~(i:int = x:int)`)); thm ih = specl_rule( - TERM_LIST(`p:addr`, `x + 1i`, `y:int`, `i:int`), + TERM_LIST(`p:int`, `x + 1i`, `y:int`, `i:int`), assume_rule(gnode_get_asmps( after_head, CONST_STRING_LIST("H"))[0])); ih = mp_rule(ih, next_bound); @@ -141,7 +155,7 @@ PROOF static thm strategy_int_array_open(void) { term tail_updated = `int_array p (x + 1i) y (replace_inth (i - (x + 1i)) w (a1:(int)list))`; - thm selected = strategy_hforall_elim( + thm selected = strategy_forall_elim( tail_hole, w, refl_slrule(mk_sl_wand(cell_w, tail_updated))); thm rebuilt_tail = elim_wand_slrule(selected); rebuilt_tail = frame_left_slrule(head, rebuilt_tail); @@ -174,12 +188,12 @@ PROOF static thm strategy_int_array_open(void) { fold = DISCH_TAC(fold, "O"); fold = CONV_WITH_ASMP_TAC(fold, rewrite_conv, THM_LIST( int_array_def, - get_REPLACE_INTH_DEF(), + REPLACE_INTH_DEF, offset_suc, - get_REPLACE_NTH_DEF())); + REPLACE_NTH_DEF)); if (IS_NULL(fold->solved)) { thm expanded_tail = conv_rule( - rewrite_conv(THM_LIST(get_REPLACE_INTH_DEF())), rebuilt_tail); + rewrite_conv(THM_LIST(REPLACE_INTH_DEF)), rebuilt_tail); ACCEPT_TAC(fold, expanded_tail); } thm rebuilt_whole = gnode_prove(fold_root); @@ -187,7 +201,7 @@ PROOF static thm strategy_int_array_open(void) { rebuilt_whole = mp_rule(rebuilt_whole, assume_rule(not_at_head)); rebuilt_whole = mp_rule(rebuilt_whole, offset_step); rebuilt_whole = intro_wand_slrule(cell_w, rebuilt_whole); - rebuilt_whole = strategy_hforall_intro(w, rebuilt_whole); + rebuilt_whole = strategy_forall_intro(w, rebuilt_whole); term current_cell = `data_at (p + i * sizeof Tint) Tint (inth (i - (x + 1i)) (a1:(int)list))`; @@ -197,15 +211,15 @@ PROOF static thm strategy_int_array_open(void) { lift_hole, dest_sl_ent(concl(opened_tail)).tm2); thm composed = trans_slrule(opened_tail, lift_hole); composed = conv_rule(rewrite_conv(THM_LIST( - offset_step, get_INTH_DEF())), composed); + offset_step, INTH_DEF)), composed); after_head = CONV_WITH_ASMP_TAC(after_head, rewrite_conv, THM_LIST( int_array_def, int_array_with_hole_def, offset_step, - get_INTH_DEF(), + INTH_DEF, offset_suc, - get_NTH_DEF())); + NTH_DEF)); if (IS_NULL(after_head->solved)) { ACCEPT_TAC(after_head, composed); } @@ -214,7 +228,7 @@ PROOF static thm strategy_int_array_open(void) { } PROOF thm strategy0_proof(void) { - term goal_tm = `forall p:addr. forall x y i:int. forall l:(int)list. + term goal_tm = `forall p:int. forall x y i:int. forall l:(int)list. (fact(x <= i) ** fact(i < y) ** int_array p x y l |-- int_array_with_hole p x y i l ** (forall v. @@ -225,7 +239,7 @@ PROOF thm strategy0_proof(void) { g = SL_MODE(g, "[LX] * [LY] * HA")[0]; thm opened = ispecl_rule( - TERM_LIST(`l:(int)list`, `p:addr`, `x:int`, `y:int`, `i:int`), + TERM_LIST(`l:(int)list`, `p:int`, `x:int`, `y:int`, `i:int`), strategy_int_array_open()); opened = mp_rule(opened, assume_rule(`x <= i`)); opened = mp_rule(opened, assume_rule(`i < y`)); @@ -234,10 +248,10 @@ PROOF thm strategy0_proof(void) { data_at (p + i * sizeof Tint) Tint (inth (i - x) l)`); thm value_wand = ispecl_rule( - TERM_LIST(`p:addr`, `i:int`, + TERM_LIST(`p:int`, `i:int`, `inth (i - x) (l:(int)list)`, `v:int`), strategy_cell_value_wand()); - value_wand = strategy_hforall_intro(`v:int`, value_wand); + value_wand = strategy_forall_intro(`v:int`, value_wand); thm changed = frame_mono_slrule( refl_slrule(`int_array_with_hole p x y i (l:(int)list)`), value_wand); @@ -246,7 +260,7 @@ PROOF thm strategy0_proof(void) { } PROOF thm strategy1_proof(void) { - term p = `p:addr`; + term p = `p:int`; term x = `x:int`; term y = `y:int`; term i = `i:int`; @@ -260,7 +274,7 @@ PROOF thm strategy1_proof(void) { term equality = `l2:(int)list = replace_inth (i - x) v l1`; - thm selected = strategy_hforall_elim( + thm selected = strategy_forall_elim( hole, v, refl_slrule(mk_sl_wand(cell, updated_array))); thm filled = elim_wand_slrule(selected); term desired = mk_sl_ent( @@ -271,13 +285,13 @@ PROOF thm strategy1_proof(void) { term argument = mk_sl_sep(`fact(${equality:bool})`, cell); renamed = rehant_slrule(renamed, mk_sl_sep(hole, argument)); renamed = intro_wand_slrule(argument, renamed); - renamed = strategy_hforall_intro(v, renamed); - renamed = strategy_hforall_intro(l2, renamed); + renamed = strategy_forall_intro(v, renamed); + renamed = strategy_forall_intro(l2, renamed); return genl_rule(TERM_LIST(p, x, y, i, l1), renamed); } PROOF thm strategy2_proof(void) { - term p = `p:addr`; + term p = `p:int`; term x = `x:int`; term y = `y:int`; term l1 = `l1:(int)list`; @@ -290,7 +304,7 @@ PROOF thm strategy2_proof(void) { equality, desired, refl_slrule(source)); renamed = elim_fact_slrule(equality, renamed); renamed = intro_wand_slrule(`fact(${equality:bool})`, renamed); - renamed = strategy_hforall_intro(l2, renamed); + renamed = strategy_forall_intro(l2, renamed); return genl_rule(TERM_LIST(p, x, y, l1), renamed); } diff --git a/strategy_demo/array/strategy_proof.h b/strategy_demo/array/strategy_proof.h index 3ab78ef0d9009247496a7da9c308dd3d637c6cc6..970a9ccf13f4ff9a53b06d999924bffcddf9ea3f 100644 --- a/strategy_demo/array/strategy_proof.h +++ b/strategy_demo/array/strategy_proof.h @@ -5,7 +5,7 @@ /** * Open a valid array cell and retain both its rebuild hole and value: * - * |- forall p:addr. forall x y i:int. forall l:(int)list. + * |- forall p:int. forall x y i:int. forall l:(int)list. * fact(x <= i) ** fact(i < y) ** int_array p x y l |-- * int_array_with_hole p x y i l ** * (forall v. @@ -17,7 +17,7 @@ PROOF thm strategy0_proof(void); /** * Fill an array hole and rename the resulting logical list: * - * |- forall p:addr. forall x y i:int. forall l1:(int)list. + * |- forall p:int. forall x y i:int. forall l1:(int)list. * int_array_with_hole p x y i l1 |-- * forall l2 v. * (fact(l2 = replace_inth (i - x) v l1) ** @@ -29,7 +29,7 @@ PROOF thm strategy1_proof(void); /** * Transport int_array through equality of its logical list: * - * |- forall p:addr. forall x y:int. forall l1:(int)list. + * |- forall p:int. forall x y:int. forall l1:(int)list. * int_array p x y l1 |-- * forall l2. fact(l2 = l1) -* int_array p x y l2 */ diff --git a/strategy_demo/examples/clear.c b/strategy_demo/examples/clear.c index e7bc28497c55079d1b141df83bf8a95eaa27115a..1acc9c4183558f89e4afe5d5ae680f0bf3e25817 100644 --- a/strategy_demo/examples/clear.c +++ b/strategy_demo/examples/clear.c @@ -43,7 +43,7 @@ void clear(int *to, int len) PROOF { term st = cst_get_symbolic_state(); - term vc = `${st:hprop} |-- ${loop_inv:hprop}`; + term vc = `${st:cprop} |-- ${loop_inv:cprop}`; cst_set_symbolic_state(solve_vc_auto(vc)); } } @@ -57,7 +57,7 @@ void clear(int *to, int len) data_at i__addr Tint i_v ** int_array to__pre 0i len__pre l `; - term vc = `${st:hprop} |-- ${post_ready:hprop}`; + term vc = `${st:cprop} |-- ${post_ready:cprop}`; cst_set_symbolic_state(solve_vc_auto(vc)); } } diff --git a/strategy_demo/examples/reverse.c b/strategy_demo/examples/reverse.c index 5c7f9394483111629c8b739b95dc121ff44fd403..1ce44de4dc92d87d5cff752e0f7a70283d07255b 100644 --- a/strategy_demo/examples/reverse.c +++ b/strategy_demo/examples/reverse.c @@ -20,7 +20,7 @@ PROOF static int install_smt(void) { vector_add(&int_inst, ((type_pair){`:int`, `:A`})); thm reverse_def_int = gen_all_rule( - inst_type_rule(int_inst, get_REVERSE())); + inst_type_rule(int_inst, HOL_REVERSE)); thm reverse_reverse_int = gen_all_rule(inst_type_rule( int_inst, get_theorem_by_name("REVERSE_REVERSE"))); @@ -60,7 +60,7 @@ struct list *reverse(struct list *p) PROOF { term st = cst_get_symbolic_state(); - term vc = `${st:hprop} |-- ${loop_inv:hprop}`; + term vc = `${st:cprop} |-- ${loop_inv:cprop}`; cst_set_symbolic_state(solve_vc_auto(vc)); } @@ -74,7 +74,7 @@ struct list *reverse(struct list *p) PROOF { term st = cst_get_symbolic_state(); - term vc = `${st:hprop} |-- ${loop_inv:hprop}`; + term vc = `${st:cprop} |-- ${loop_inv:cprop}`; cst_set_symbolic_state(solve_vc_auto(vc)); } } @@ -88,7 +88,7 @@ struct list *reverse(struct list *p) data_at t__addr Tptr t_v ** sll w_v (REVERSE l) `; - term vc = `${st:hprop} |-- ${return_ready:hprop}`; + term vc = `${st:cprop} |-- ${return_ready:cprop}`; cst_set_symbolic_state(solve_vc_auto(vc)); } diff --git a/strategy_demo/sll/strategy_proof.c b/strategy_demo/sll/strategy_proof.c index 0e300bd939677db3527324a9e5b46258eb0263ac..85551ef824393dc7d58cffd71052bcbe77bff4ad 100644 --- a/strategy_demo/sll/strategy_proof.c +++ b/strategy_demo/sll/strategy_proof.c @@ -1,13 +1,20 @@ #include "strategy_demo/sll/strategy_proof.h" #require "strategy_demo/sll/sll.c" -PROOF static thm sll_strategy_hforall_intro( +PROOF static thm sll_strategy_contract_forall_intro(const thm instance) { + conv beta = get_conversion_by_name("BETA_CONV"); + conv premise = land_conv(binder_conv(rand_conv(beta))); + conv result = rand_conv(rand_conv(binder_conv(beta))); + return conv_rule(then_conv(premise, result), instance); +} + +PROOF static thm sll_strategy_forall_intro( const term variable, const thm entailment) { dest_binop_results sides = dest_sl_ent(concl(entailment)); term body = mk_abs(variable, sides.tm2); thm intro = ispecl_rule( - TERM_LIST(sides.tm1, body), get_hforall_intro()); - intro = beta_rule(intro); + TERM_LIST(sides.tm1, body), sl_forall_intro()); + intro = sll_strategy_contract_forall_intro(intro); return match_mp_rule(intro, gen_rule(variable, entailment)); } @@ -43,7 +50,7 @@ PROOF static thm sll_null_fold(void) { * sll q xs ** fact(l = x :: xs) */ PROOF static thm sll_open_nonnull(void) { - term goal_tm = `forall p:addr. forall l:(int)list. + term goal_tm = `forall p:int. forall l:(int)list. fact(~(p = 0i)) ** sll p l |-- exists x xs q. fact(~(p = 0i)) ** @@ -63,7 +70,7 @@ PROOF static thm sll_open_nonnull(void) { cases[1], rewrite_conv, THM_LIST(sll_def)); cons_case = AUTO_HANT_DESTRUCT_SLTAC(cons_case)[0]; cons_case = LIST_EXISTS_SLTAC( - cons_case, TERM_LIST(`a0:int`, `a1:(int)list`, `q:addr`)); + cons_case, TERM_LIST(`a0:int`, `a1:(int)list`, `q:int`)); cons_case = CONV_SLTAC(cons_case, simp_conv(THM_LIST())); AUTO_FRAME_SLTAC(cons_case); return gnode_prove(root); @@ -73,7 +80,7 @@ PROOF static thm sll_open_nonnull(void) { * A concrete nonnull node entails its folded sll at the corresponding cons. */ PROOF static thm sll_fold_nonnull(void) { - term goal_tm = `forall p q:addr. forall x:int. forall xs:(int)list. + term goal_tm = `forall p q:int. forall x:int. forall xs:(int)list. fact(~(p = 0i)) ** data_at (field_addr p Tlist Fhead) Tint x ** data_at (field_addr p Tlist Ftail) Tptr q ** @@ -83,7 +90,7 @@ PROOF static thm sll_fold_nonnull(void) { g = AUTO_INIT_SLTAC(g)[0]; g = CONV_WITH_ASMP_SLTAC(g, rewrite_conv, THM_LIST(sll_def)); g = CLEAN_SLTAC(g); - g = EXISTS_SLTAC(g, `q:addr`); + g = EXISTS_SLTAC(g, `q:int`); AUTO_FRAME_SLTAC(g); return gnode_prove(root); } @@ -96,29 +103,29 @@ PROOF thm sll_strategy0_proof(void) { equality, desired, sll_null_fold()); folded = elim_fact_slrule(equality, folded); folded = intro_wand_slrule(`fact(${equality:bool})`, folded); - return sll_strategy_hforall_intro(l, folded); + return sll_strategy_forall_intro(l, folded); } PROOF thm sll_strategy1_proof(void) { - term p = `p:addr`; + term p = `p:int`; term l = `l:(int)list`; term x = `x:int`; term xs = `xs:(int)list`; - term q = `q:addr`; - term v = `v:addr`; + term q = `q:int`; + term v = `v:int`; term nonnull = `fact(~(p = 0i))`; term head = `data_at (field_addr p Tlist Fhead) Tint x`; term tail = `data_at (field_addr p Tlist Ftail) Tptr q`; term recursive = `sll q xs`; term shape = `fact((l:(int)list) = (x:int) :: (xs:(int)list))`; - term body = `${nonnull:hprop} ** ${head:hprop} ** ${tail:hprop} ** - ${recursive:hprop} ** ${shape:hprop}`; + term body = `${nonnull:cprop} ** ${head:cprop} ** ${tail:cprop} ** + ${recursive:cprop} ** ${shape:cprop}`; term varying_tail = `data_at (field_addr p Tlist Ftail) Tptr v`; thm tail_wand = intro_wand_slrule( varying_tail, refl_slrule(varying_tail)); - tail_wand = sll_strategy_hforall_intro(v, tail_wand); + tail_wand = sll_strategy_forall_intro(v, tail_wand); thm retain = frame_mono_slrule(refl_slrule(body), tail_wand); retain = rehant_slrule(retain, body); retain = exists_mono_slrule(q, retain); @@ -131,19 +138,19 @@ PROOF thm sll_strategy1_proof(void) { } PROOF thm sll_strategy2_proof(void) { - term p = `p:addr`; + term p = `p:int`; term x = `x:int`; term l = `l:(int)list`; term xs = `xs:(int)list`; - term q = `q:addr`; + term q = `q:int`; term nonnull = `fact(~(p = 0i))`; term head = `data_at (field_addr p Tlist Fhead) Tint x`; term tail = `data_at (field_addr p Tlist Ftail) Tptr q`; term recursive = `sll q xs`; term equality = `l:(int)list = x :: xs`; - term preserved = `${nonnull:hprop} ** ${head:hprop}`; - term argument = `${nonnull:hprop} ** ${head:hprop} ** ${tail:hprop} ** - ${recursive:hprop} ** fact(${equality:bool})`; + term preserved = `${nonnull:cprop} ** ${head:cprop}`; + term argument = `${nonnull:cprop} ** ${head:cprop} ** ${tail:cprop} ** + ${recursive:cprop} ** fact(${equality:bool})`; thm folded = specl_rule( TERM_LIST(p, q, x, xs), sll_fold_nonnull()); @@ -153,9 +160,9 @@ PROOF thm sll_strategy2_proof(void) { folded = elim_fact_slrule(equality, folded); folded = rehant_slrule(folded, argument); folded = intro_wand_slrule(argument, folded); - folded = sll_strategy_hforall_intro(q, folded); - folded = sll_strategy_hforall_intro(xs, folded); - folded = sll_strategy_hforall_intro(l, folded); + folded = sll_strategy_forall_intro(q, folded); + folded = sll_strategy_forall_intro(xs, folded); + folded = sll_strategy_forall_intro(l, folded); thm result = frame_mono_slrule(refl_slrule(preserved), folded); result = rehant_slrule(result, preserved); @@ -163,7 +170,7 @@ PROOF thm sll_strategy2_proof(void) { } PROOF thm sll_strategy3_proof(void) { - term p = `p:addr`; + term p = `p:int`; term l1 = `l1:(int)list`; term l2 = `l2:(int)list`; term source = `sll p l1`; @@ -173,17 +180,17 @@ PROOF thm sll_strategy3_proof(void) { equality, desired, refl_slrule(source)); renamed = elim_fact_slrule(equality, renamed); renamed = intro_wand_slrule(`fact(${equality:bool})`, renamed); - renamed = sll_strategy_hforall_intro(l2, renamed); + renamed = sll_strategy_forall_intro(l2, renamed); return genl_rule(TERM_LIST(p, l1), renamed); } PROOF thm sll_strategy4_proof(void) { - term p = `p:addr`; + term p = `p:int`; term l = `l:(int)list`; term source = `fact(p = 0i) ** sll p l`; term facts = `fact(p = 0i) ** fact(l = ([]:(int)list))`; - term goal_tm = `forall p:addr. forall l:(int)list. - ${source:hprop} |-- ${facts:hprop}`; + term goal_tm = `forall p:int. forall l:(int)list. + ${source:cprop} |-- ${facts:cprop}`; gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); g = SL_MODE(g, "[EQ] * HS")[0]; diff --git a/strategy_demo/sll/strategy_proof.h b/strategy_demo/sll/strategy_proof.h index 4e69bd3ced4e9cc671b5ea5f9aacf64ab6912784..6fbdc62a8cfe0d677991d53bcb370f1ec52c4b24 100644 --- a/strategy_demo/sll/strategy_proof.h +++ b/strategy_demo/sll/strategy_proof.h @@ -9,7 +9,7 @@ PROOF thm sll_strategy0_proof(void); /** - * |- forall p:addr. forall l:(int)list. + * |- forall p:int. forall l:(int)list. * fact(~(p = 0i)) ** sll p l |-- * exists x xs q. * fact(~(p = 0i)) ** @@ -23,7 +23,7 @@ PROOF thm sll_strategy0_proof(void); PROOF thm sll_strategy1_proof(void); /** - * |- forall p:addr. forall x:int. + * |- forall p:int. forall x:int. * fact(~(p = 0i)) ** * data_at (field_addr p Tlist Fhead) Tint x |-- * fact(~(p = 0i)) ** @@ -38,14 +38,14 @@ PROOF thm sll_strategy1_proof(void); PROOF thm sll_strategy2_proof(void); /** - * |- forall p:addr. forall l1:(int)list. + * |- forall p:int. forall l1:(int)list. * sll p l1 |-- forall l2. * fact(l2 = l1) -* sll p l2 */ PROOF thm sll_strategy3_proof(void); /** - * |- forall p:addr. forall l:(int)list. + * |- forall p:int. forall l:(int)list. * fact(p = 0i) ** sll p l |-- * fact(p = 0i) ** fact(l = []) ** (emp -* emp) */ diff --git a/tests/c_program_logic/c_logic.c b/tests/c_program_logic/c_logic.c new file mode 100644 index 0000000000000000000000000000000000000000..87f3c65905f2e16427cfb62b493c9f51ff01bb74 --- /dev/null +++ b/tests/c_program_logic/c_logic.c @@ -0,0 +1,145 @@ +#define CSTAR_DEFER_C_LOGIC_INSTALL + +#include "userlib/qcp/c_logic.h" +#include "userlib/operational/proof_patterns.h" +#include "userlib/qcp/veriftime.h" +#include "proof/theory/logic/max_nat_ra.h" + +PROOF static size_t capture_c_logic_axiom_baseline(void) { + thm_list axioms = get_all_axioms(); + size_t count = vector_size(axioms); + return count; +} + +PROOF static size_t C_LOGIC_CLIENT_AXIOMS_BEFORE = + capture_c_logic_axiom_baseline(); + +#require "userlib/qcp/c_logic.c" +#require "userlib/operational/proof_patterns.c" +#require "userlib/qcp/veriftime.c" +#require "proof/theory/logic/max_nat_ra.c" + +// verify_all: expect-vcs=0 + +PROOF static int C_LOGIC_CLIENT_INSTALL = + c_logic_install_named(`max_nat_ra:(num)ra`); + +PROOF static int run_c_logic_qcp_smoke(void) { + ENSURE_COND(C_LOGIC_CLIENT_INSTALL == 0, + "cannot test QCP before installing the C assertion model"); + int proof_patterns_result = proof_patterns_smoke_test(); + ENSURE_COND(proof_patterns_result == 0, + "generic proof-pattern smoke test failed"); + int result = veriftime_bool_call_adapter_smoke_test(); + return result; +err: + ERR_FUN_PUTS("run_c_logic_qcp_smoke"); + return -1; +} + +PROOF static int C_LOGIC_QCP_SMOKE = run_c_logic_qcp_smoke(); + +PROOF static int audit_c_logic_client(void) { + ENSURE_COND(C_LOGIC_CLIENT_INSTALL == 0, + "cannot install the selected C assertion model"); + ENSURE_COND(C_LOGIC_QCP_SMOKE == 0, + "QCP assertion-boundary smoke test failed"); + const c_logic_scope* scope = c_logic_current(); + ENSURE_COND( + equals_term(scope->payload_ra, `max_nat_ra:(num)ra`), + "installed payload RA changed unexpectedly"); + ENSURE_COND( + equals_term( + scope->ghost_ra, + `named_ra (max_nat_ra:(num)ra):((num,num)finmap)ra`), + "installed global ghost RA is not the explicit named RA"); + ENSURE_COND( + equals_term( + scope->resource_ra, + `c_resource_ra + (named_ra (max_nat_ra:(num)ra)): + (((int,(pmem_byte_state)excl)finmap)#(num,num)finmap)ra`), + "installed C resource does not use the complete global ghost RA"); + type assertion_type = sl_prop(); + type own_type = type_of(`own 0 0`); + bool own_has_assertion_type = equals_type(assertion_type, own_type); + ENSURE_COND(own_has_assertion_type, + "installed own does not return the active assertion type"); + type data_at_type = type_of(`data_at 0i Tint 0i`); + bool data_at_has_assertion_type = + equals_type(assertion_type, data_at_type); + ENSURE_COND(data_at_has_assertion_type, + "installed data_at does not return the active assertion type"); + + thm own_update = scope->ghost_own_update; + thm own_updateP = scope->ghost_own_updateP; + thm own_drop = scope->ghost_own_drop; + thm own_alloc = scope->ghost_own_alloc; + thm_list selected_rules = + THM_LIST(own_update, own_updateP, own_drop, own_alloc); + for (size_t i = 0; i < vector_size(selected_rules); ++i) { + ENSURE_COND(!IS_NULL(selected_rules[i]), + "selected C ghost rule %zu is null", i); + term_list assumptions = hyp(selected_rules[i]); + size_t assumption_count = vector_size(assumptions); + ENSURE_COND(assumption_count == 0, + "selected C ghost rule %zu has hypotheses", i); + } + + term redex_z = `__viewshift_redex_z:num`; + term redex_assertion = mk_comb(mk_abs(redex_z, sl_emp()), `0`); + term existential_x = `__viewshift_exists_x:num`; + thm pointwise_refl = gen_rule( + existential_x, viewshift_refl_slrule(redex_assertion)); + thm existential_refl = viewshift_exists_slrule(pointwise_refl); + dest_binop_results existential_endpoints = + dest_sl_viewshift(concl(existential_refl)); + term expected_existential = + mk_sl_exists(existential_x, redex_assertion); + ENSURE_COND( + equals_term(existential_endpoints.tm1, expected_existential) && + equals_term(existential_endpoints.tm2, expected_existential), + "existential view shift reduced a caller-owned beta-redex"); + + thm_list current_axioms = get_all_axioms(); + size_t current_axiom_count = vector_size(current_axioms); + ENSURE_COND(current_axiom_count == C_LOGIC_CLIENT_AXIOMS_BEFORE, + "the selected C assertion model introduced an axiom"); + return 0; +err: + ERR_FUN_PUTS("audit_c_logic_client"); + return -1; +} + +PROOF static int C_LOGIC_CLIENT_AUDIT = audit_c_logic_client(); + +void c_logic_complete_update_smoke(void) + REQUIRE(`own 0 1 ** data_at 4096i Tint 7i`) + ENSURE(`own 0 2 ** data_at 4096i Tint 7i`) +{ + PROOF term_list payload_update_args = TERM_LIST(`1`, `2`); + PROOF thm payload_update = + ispecl_rule(payload_update_args, max_nat_ra_update); + PROOF term_list own_update_args = TERM_LIST(`0`, `1`, `2`); + PROOF thm own_update_rule = c_logic_current()->ghost_own_update; + PROOF thm own_update_implication = + ispecl_rule(own_update_args, own_update_rule); + PROOF thm own_update = mp_rule(own_update_implication, payload_update); + PROOF term symbolic_state = get_symbolic_state(); + PROOF thm complete_update = + viewshift_frame_at_slrule(own_update, symbolic_state); + PROOF set_symbolic_state(complete_update); +} + +/* QCP must retain the opaque own atom while joining two different physical + * stack states. No logical state exists outside the complete assertion. */ +void c_logic_branch_join_smoke(int selector) + REQUIRE(`own 0 1`) + ENSURE(`own 0 1`) +{ + if (selector == 0) { + selector = 1; + } else { + selector = 2; + } +} diff --git a/tests/operational/abbrev_occurrences_obligation_smoke.c.axiom b/tests/operational/abbrev_occurrences_obligation_smoke.c.axiom index 5839f2889d14efb79b53a30739513232c5b121dc..3da9fa865d0c41d1b1e0c614b1d512bd0b2d642e 100644 --- a/tests/operational/abbrev_occurrences_obligation_smoke.c.axiom +++ b/tests/operational/abbrev_occurrences_obligation_smoke.c.axiom @@ -11,9 +11,9 @@ // The selected candidate cannot be proved equal to the requested RHS. PROOF int _abbrev_obligation_pair = new_const_safe( - "abbrev_obligation_pair", `:int->int->hprop`); + "abbrev_obligation_pair", `:int->int->cprop`); PROOF int _abbrev_obligation_pair_header = cst_add_const_to_header( - `abbrev_obligation_pair:int->int->hprop`); + `abbrev_obligation_pair:int->int->cprop`); PROOF static int abbrev_occurrences_obligation_smoke(void) { int axioms_before = cst_get_axiom_count(); diff --git a/tests/operational/existential_capture.c.fail b/tests/operational/existential_capture.c.fail index 47973bb21dcb0313430403291573b719371190e4..66a400796f80c37e6b4ee8001318eba01556f826 100644 --- a/tests/operational/existential_capture.c.fail +++ b/tests/operational/existential_capture.c.fail @@ -5,9 +5,9 @@ #require "userlib/proof/probes.c" PROOF int _pattern_chunk = new_const_safe( - "pattern_chunk", `:int->int->hprop`); + "pattern_chunk", `:int->int->cprop`); PROOF int _pattern_chunk_header = - cst_add_const_to_header(`pattern_chunk:int->int->hprop`); + cst_add_const_to_header(`pattern_chunk:int->int->cprop`); PROOF int existential_capture_must_fail() { thm ent = new_axiom(`emp |-- exists x. pattern_chunk x z`); diff --git a/tests/operational/operational_alignment.c b/tests/operational/operational_alignment.c index 0d8900c78e70c6b4b938523ddc062d1b4e4ee306..1faa9167848ad1f2d206e8ff75dc10892ae016c4 100644 --- a/tests/operational/operational_alignment.c +++ b/tests/operational/operational_alignment.c @@ -8,13 +8,13 @@ #require "userlib/operational/operational.c" PROOF int _alignment_chunk = new_const_safe( - "alignment_chunk", `:int->int->hprop`); + "alignment_chunk", `:int->int->cprop`); PROOF int _alignment_chunk_header = - cst_add_const_to_header(`alignment_chunk:int->int->hprop`); + cst_add_const_to_header(`alignment_chunk:int->int->cprop`); PROOF int _alignment_quad = new_const_safe( - "alignment_quad", `:int->int->int->int->hprop`); + "alignment_quad", `:int->int->int->int->cprop`); PROOF int _alignment_quad_header = - cst_add_const_to_header(`alignment_quad:int->int->int->int->hprop`); + cst_add_const_to_header(`alignment_quad:int->int->int->int->cprop`); PROOF static thm prove_reflexive_operation(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); diff --git a/tests/operational/operational_regression.c b/tests/operational/operational_regression.c index 3de2a4be8066b23b24e9f1ab69363860b975d619..12753f822145a5da452f1edaec90f6d7156abeb4 100644 --- a/tests/operational/operational_regression.c +++ b/tests/operational/operational_regression.c @@ -19,13 +19,13 @@ PROOF int _pattern_pair = new_const_safe( PROOF int _pattern_pair_header = cst_add_const_to_header(`pattern_pair:int->int->bool`); PROOF int _pattern_chunk = new_const_safe( - "pattern_chunk", `:int->int->hprop`); + "pattern_chunk", `:int->int->cprop`); PROOF int _pattern_chunk_header = - cst_add_const_to_header(`pattern_chunk:int->int->hprop`); + cst_add_const_to_header(`pattern_chunk:int->int->cprop`); PROOF int _pattern_hof = new_const_safe( - "pattern_hof", `:(int->int)->int->hprop`); + "pattern_hof", `:(int->int)->int->cprop`); PROOF int _pattern_hof_header = - cst_add_const_to_header(`pattern_hof:(int->int)->int->hprop`); + cst_add_const_to_header(`pattern_hof:(int->int)->int->cprop`); PROOF static thm reflexive_operation_proof(const term goal_tm) { gnode root = gnode_new_with_ccl(goal_tm); @@ -75,7 +75,7 @@ PROOF thm expose_data_at_value_proof(const term goal_tm) { } decl_operation(expose_data_at_value, - TERM_LIST(`key:addr`), + TERM_LIST(`key:int`), TERM_LIST(`data_at (KEY key) Tint (CAPTURE (captured_value:int))`), term_list_n(0), `exists witness. fact(witness == captured_value) ** data_at key Tint witness` @@ -93,7 +93,7 @@ decl_operation(preserve_chunk_with_fact, ) void apply_operation_preserves_branch_frames() - PARAM(`key:addr`, `p:addr`, `q:addr`, `a:int`, `b:int`) + PARAM(`key:int`, `p:int`, `q:int`, `a:int`, `b:int`) REQUIRE(`(data_at (key + 0i) Tint a ** data_at p Tint b) || (data_at key Tint b ** data_at q Tint a)`) ENSURE(`(exists witness. fact(witness == a) ** @@ -102,21 +102,8 @@ void apply_operation_preserves_branch_frames() data_at key Tint witness ** data_at q Tint a)`) { PROOF { - operation printer_operation = expose_data_at_value; - char *operation_rendered = - strip_ansi_color(cst_string_of_operation(printer_operation)); - check_regression( - strstr(operation_rendered, "operation{name=\"expose_data_at_value\"") != - NULL && - strstr(operation_rendered, "inputs=") != NULL && - strstr(operation_rendered, "consumes=") != NULL && - strstr(operation_rendered, "facts=") != NULL && - strstr(operation_rendered, "produce=") != NULL && - strstr(operation_rendered, "lemma=") != NULL, - "The operation IDE printer omitted a schema field"); - match_env printer_env = { - TERM_PAIR_LIST((term_pair){`key:addr`, `key0:addr`}), + TERM_PAIR_LIST((term_pair){`key:int`, `key0:int`}), THM_LIST(refl_rule(`a:int`)), TERM_PAIR_LIST((term_pair){`(a:int) + 1i`, `b:int`})}; char *match_env_rendered = @@ -128,7 +115,7 @@ void apply_operation_preserves_branch_frames() "The match_env IDE printer omitted matching evidence"); int axioms_before = cst_get_axiom_count(); - apply_operation_st(expose_data_at_value, TERM_LIST(`key:addr`)); + apply_operation_st(expose_data_at_value, TERM_LIST(`key:int`)); check_regression( cst_get_axiom_count() == axioms_before, "A provable operation application emitted an obligation"); @@ -136,7 +123,7 @@ void apply_operation_preserves_branch_frames() } void apply_operation_named_renames_each_branch_witness() - PARAM(`key:addr`, `p:addr`, `q:addr`, `a:int`, `b:int`) + PARAM(`key:int`, `p:int`, `q:int`, `a:int`, `b:int`) REQUIRE(`(data_at (key + 0i) Tint a ** data_at p Tint b) || (data_at key Tint b ** data_at q Tint a)`) ENSURE(`(exists observed. fact(observed == a) ** @@ -147,7 +134,7 @@ void apply_operation_named_renames_each_branch_witness() PROOF { int axioms_before = cst_get_axiom_count(); apply_operation_named_st( - expose_data_at_value, TERM_LIST(`key:addr`), TERM_LIST(`observed:int`)); + expose_data_at_value, TERM_LIST(`key:int`), TERM_LIST(`observed:int`)); check_regression(cst_get_axiom_count() == axioms_before, "Existential renaming emitted an obligation"); } @@ -170,7 +157,7 @@ void apply_operation_proves_facts_per_branch() } void apply_hentail_rewrites_a_subheap_in_each_branch() - PARAM(`p:addr`, `q:addr`, `r:addr`, `a:int`, `b:int`) + PARAM(`p:int`, `q:int`, `r:int`, `a:int`, `b:int`) REQUIRE(`(data_at p Tint a ** data_at q Tint b) || (data_at p Tint a ** data_at r Tint b)`) ENSURE(`(fact(a == a) ** data_at p Tint a ** data_at q Tint b) || @@ -193,11 +180,11 @@ void data_at_range_preserves_cell_and_exposes_bounds(int *p) ENSURE(`data_at p Tint x ** fact(--2147483648i <= x && x <= 2147483647i)`) { - PROOF add_data_at_range_st(`p__pre:addr`, `Tint`, `x:int`); + PROOF add_data_at_range_st(`p__pre:int`, `Tint`, `x:int`); } void add_fact_uses_each_branch_premise() - PARAM(`n:int`, `a:int`, `b:int`, `p:addr`, `q:addr`) + PARAM(`n:int`, `a:int`, `b:int`, `p:int`, `q:int`) REQUIRE(`(fact(0i <= n) ** data_at p Tint a) || (fact(0i <= n) ** data_at q Tint b)`) ENSURE(`(fact(0i <= n) ** fact(0i < n + 1i) ** data_at p Tint a) || @@ -212,7 +199,7 @@ void add_fact_uses_each_branch_premise() } void add_conjuncts_splits_once_and_checks_each_branch_premise() - PARAM(`n:int`, `a:int`, `b:int`, `p:addr`, `q:addr`) + PARAM(`n:int`, `a:int`, `b:int`, `p:int`, `q:int`) REQUIRE(`(fact(0i <= n) ** data_at p Tint a) || (fact(0i <= n) ** data_at q Tint b)`) ENSURE(`(fact(0i <= n) ** @@ -247,7 +234,7 @@ void add_conjuncts_splits_once_and_checks_each_branch_premise() } void add_fact_assume_keeps_branch_obligations_separate() - PARAM(`a:int`, `b:int`, `p:addr`, `q:addr`) + PARAM(`a:int`, `b:int`, `p:int`, `q:int`) REQUIRE(`(fact(a == b) ** data_at p Tint a) || (fact(a <= b) ** data_at q Tint b)`) ENSURE(`(fact(a == b) ** fact(a == b || a <= b) ** data_at p Tint a) || @@ -274,7 +261,7 @@ void add_fact_assume_keeps_branch_obligations_separate() void schema_rewrite_uses_each_branch_fact() PARAM(`u:int`, `v:int`, `a:int`, `b:int`, - `p:addr`, `q:addr`, `r:addr`) + `p:int`, `q:int`, `r:int`) REQUIRE(`(fact(u == v) ** data_at p Tint u ** data_at q Tint a) || (fact(u == v) ** data_at p Tint u ** data_at r Tint b)`) ENSURE(`(fact(u == v) ** data_at p Tint v ** data_at q Tint a) || @@ -362,7 +349,7 @@ void selective_conversion_matches_repeated_binder() } void selective_conversion_matches_multiple_patterns() - PARAM(`p:addr`, `x:int`, `y:int`, `z:int`) + PARAM(`p:int`, `x:int`, `y:int`, `z:int`) REQUIRE(`data_at p Tint (x + 0i) ** pattern_chunk (y + 0i) 3i ** pattern_chunk (z + 0i) 4i`) @@ -375,7 +362,7 @@ void selective_conversion_matches_multiple_patterns() pure_rewrite_conv( THM_LIST(int_arith_rule(`(n:int) + 0i == n`))), TERM_LIST( - `\(sel_p:addr) (sel_v:int). data_at sel_p Tint sel_v`, + `\(sel_p:int) (sel_v:int). data_at sel_p Tint sel_v`, `\(sel_v:int). pattern_chunk sel_v 3i`)); check_regression( symst_branch_resources_equal( @@ -659,7 +646,7 @@ PROOF int operational_pattern_regression() { `pattern_chunk (x + 0i) 2i`, pure_rewrite_conv( THM_LIST(int_arith_rule(`(n:int) + 0i == n`))), - TERM_LIST(`\(f:int->hprop). f 1i`)); + TERM_LIST(`\(f:int->cprop). f 1i`)); ENSURE_COND( alpha_compare(dest_sl_ent(concl(no_spillover)).tm2, `pattern_chunk (x + 0i) 2i`) == 0, @@ -669,7 +656,7 @@ PROOF int operational_pattern_regression() { `pattern_chunk (x + 0i) 1i`, pure_rewrite_conv( THM_LIST(int_arith_rule(`(n:int) + 0i == n`))), - TERM_LIST(`\(f:int->hprop). f 1i`)); + TERM_LIST(`\(f:int->cprop). f 1i`)); ENSURE_COND( alpha_compare(dest_sl_ent(concl(function_head_selected)).tm2, `pattern_chunk x 1i`) == 0, @@ -705,12 +692,12 @@ PROOF int operational_pattern_regression() { "Rigid state-pattern subterms did not match by alpha-equivalence"); thm expanded_selected = convert_symhp( - `(\(h:hprop). h) + `(\(h:cprop). h) (pattern_chunk x 0i ** pattern_chunk x 1i) ** pattern_chunk y 2i`, get_conversion_by_name("BETA_CONV"), TERM_LIST( - `\(selected:int). (\(h:hprop). h) + `\(selected:int). (\(h:cprop). h) (pattern_chunk selected 0i ** pattern_chunk selected 1i)`)); term expanded_result = dest_sl_ent(concl(expanded_selected)).tm2; @@ -773,7 +760,7 @@ PROOF int operational_pattern_regression() { term_list consumes = TERM_LIST( `data_at p0 Tint (CAPTURE (x:int))`, `data_at q0 Tint x`); - term_list matching_inputs = TERM_LIST(`p0:addr`, `q0:addr`); + term_list matching_inputs = TERM_LIST(`p0:int`, `q0:int`); term produce = `data_at p0 Tint x ** data_at q0 Tint x`; operation matching_op = operation_new( "matching", matching_inputs, consumes, term_list_n(0), produce, @@ -783,12 +770,12 @@ PROOF int operational_pattern_regression() { "Operation construction retained a caller-owned vector alias"); for (int i = 0; i < 64; ++i) { vector_add(&consumes, sl_emp()); - vector_add(&matching_inputs, `extra:addr`); + vector_add(&matching_inputs, `extra:int`); } ENSURE_COND(vector_size(matching_op.inputs) == 2 && vector_size(matching_op.consumes) == 2, "Growing an aliased schema vector invalidated an operation"); - term_list supplied_arguments = TERM_LIST(`p:addr`, `q:addr`); + term_list supplied_arguments = TERM_LIST(`p:int`, `q:int`); thm matched = operation_hconv( matching_op, `data_at p Tint x ** data_at q Tint x`, supplied_arguments); @@ -881,20 +868,20 @@ PROOF int operational_pattern_regression() { term key_produce = `data_at p0 Tint x0`; operation key_op = operation_new( - "key", TERM_LIST(`p0:addr`), + "key", TERM_LIST(`p0:int`), TERM_LIST(`data_at (KEY p0) Tint (CAPTURE x0)`), term_list_n(0), key_produce, reflexive_operation_proof); ENSURE_COND(!operation_patterns_match( - key_op, `data_at q Tint 7i`, TERM_LIST(`p:addr`)), + key_op, `data_at q Tint 7i`, TERM_LIST(`p:int`)), "An unprovable key equality matched a candidate"); ENSURE_COND(operation_patterns_match( key_op, `data_at q Tint 7i ** data_at (p + 0i) Tint 9i`, - TERM_LIST(`p:addr`)), + TERM_LIST(`p:int`)), "A key did not skip an unequal resource and select a provably equal one"); int key_axioms_before = cst_get_axiom_count(); thm keyed = operation_hconv( - key_op, `data_at (p + 0i) Tint 9i`, TERM_LIST(`p:addr`)); + key_op, `data_at (p + 0i) Tint 9i`, TERM_LIST(`p:int`)); ENSURE_COND(cst_get_axiom_count() == key_axioms_before, "A key equality emitted an obligation"); ENSURE_COND(alpha_compare( @@ -903,7 +890,7 @@ PROOF int operational_pattern_regression() { "A proved key equality was not used to instantiate the operation"); operation combined_markers = operation_new( - "combined_markers", TERM_LIST(`p0:addr`, `q0:addr`), + "combined_markers", TERM_LIST(`p0:int`, `q0:int`), TERM_LIST( `data_at (KEY p0) Tint (CAPTURE x0)`, `data_at (KEY q0) Tint (DEFER x0)`), @@ -914,7 +901,7 @@ PROOF int operational_pattern_regression() { thm combined = operation_hconv( combined_markers, `data_at (p + 0i) Tint x ** data_at q Tint (x + 0i)`, - TERM_LIST(`p:addr`, `q:addr`)); + TERM_LIST(`p:int`, `q:int`)); ENSURE_COND(cst_get_axiom_count() == combined_axioms_before, "Provable equalities in a multi-marker operation emitted an obligation"); ENSURE_COND(alpha_compare( @@ -960,11 +947,11 @@ PROOF int operational_pattern_regression() { term_list duplicate_consumes = TERM_LIST( `data_at p0 Tint x0`, `data_at p0 Tint x0`); operation duplicate_op = operation_for_pattern_test( - "linear", TERM_LIST(`p0:addr`, `x0:int`), duplicate_consumes, + "linear", TERM_LIST(`p0:int`, `x0:int`), duplicate_consumes, term_list_n(0), `emp`); ENSURE_COND(!operation_patterns_match( duplicate_op, `data_at p Tint x`, - TERM_LIST(`p:addr`, `x:int`)), + TERM_LIST(`p:int`, `x:int`)), "One heap resource satisfied two consume patterns"); term_list rollback_consumes = TERM_LIST( @@ -982,34 +969,34 @@ PROOF int operational_pattern_regression() { `pattern_chunk (CAPTURE value0) value0`, `data_at q0 Tint value0`); operation greedy_op = operation_for_pattern_test( - "greedy", TERM_LIST(`q0:addr`), greedy_consumes, + "greedy", TERM_LIST(`q0:int`), greedy_consumes, term_list_n(0), `emp`); ENSURE_COND(!operation_patterns_match( greedy_op, `pattern_chunk 1i 1i ** pattern_chunk 2i 2i ** data_at q Tint 2i`, - TERM_LIST(`q:addr`)), + TERM_LIST(`q:int`)), "Greedy matching unexpectedly reconsidered a committed consume"); term_list defer_consumes = TERM_LIST( `data_at p0 Tint (DEFER (expected0 + 1i))`); term defer_produce = `data_at p0 Tint (expected0 + 1i)`; operation defer_op = operation_new( - "defer", TERM_LIST(`p0:addr`, `expected0:int`), + "defer", TERM_LIST(`p0:int`, `expected0:int`), defer_consumes, term_list_n(0), defer_produce, reflexive_operation_proof); - term_list defer_arguments = TERM_LIST(`p:addr`, `x:int`); + term_list defer_arguments = TERM_LIST(`p:int`, `x:int`); int axioms_before = cst_get_axiom_count(); operation incomplete_defer = operation_for_pattern_test( - "incomplete_defer", TERM_LIST(`p0:addr`, `q0:addr`, `expected0:int`), + "incomplete_defer", TERM_LIST(`p0:int`, `q0:int`, `expected0:int`), TERM_LIST( `data_at p0 Tint (DEFER expected0)`, `data_at q0 Tint expected0`), term_list_n(0), `emp`); ENSURE_COND(!operation_patterns_match( incomplete_defer, `data_at p Tint y`, - TERM_LIST(`p:addr`, `q:addr`, `x:int`)), + TERM_LIST(`p:int`, `q:int`, `x:int`)), "An operation with a missing later consume unexpectedly matched"); ENSURE_COND(cst_get_axiom_count() == axioms_before, "A DEFER from an incomplete operation leaked an obligation"); diff --git a/tests/operational/qcp_bool_call_adapter.c b/tests/operational/qcp_bool_call_adapter.c index 21d6624ddace16852147f4c68b4b543c5da7cb34..07214fc9787763b45ef9ca2be5bde17884452e21 100644 --- a/tests/operational/qcp_bool_call_adapter.c +++ b/tests/operational/qcp_bool_call_adapter.c @@ -37,9 +37,11 @@ void qcp_bool_call_adapter_round_trip() term raw_fact = `fact(qcp_adapter_pred x)`; term qcp_fact = `fact(qcp_adapter_pred x <=> T)`; + check_adapter(equals_term(bool_calls_for_qcp(raw_fact), qcp_fact), + "The explicit QCP boundary encoder produced the wrong fact"); check_adapter( - singleton_symst_resource(cst_get_symbolic_state(), qcp_fact), - "QCP did not receive the encoded boolean-call fact"); + singleton_symst_resource(cst_get_symbolic_state(), raw_fact), + "The native symbolic-state accessor did not decode the QCP boundary"); check_adapter( singleton_symst_resource(get_symbolic_state(), raw_fact), "The proof-facing symbolic state did not decode the boolean-call fact"); @@ -47,8 +49,9 @@ void qcp_bool_call_adapter_round_trip() int axioms_before = cst_get_axiom_count(); apply_hconv_st(refl_slrule(raw_fact)); check_adapter( - singleton_symst_resource(cst_get_symbolic_state(), qcp_fact), - "The default state transformer did not re-encode its result"); + singleton_symst_resource(cst_get_symbolic_state(), raw_fact), + "The default state transformer did not preserve its proof-facing " + "result"); check_adapter(cst_get_axiom_count() == axioms_before, "The adapter round trip emitted an obligation"); } diff --git a/tests/operational/state_transformer_regression.c b/tests/operational/state_transformer_regression.c index 69dd002363a76bbd15f733932343dbdbfb5222e0..48f0fb5b4fc353ef4216e2110c06a3faa1b44d30 100644 --- a/tests/operational/state_transformer_regression.c +++ b/tests/operational/state_transformer_regression.c @@ -12,14 +12,14 @@ /* Focused regression root for fact and existential state transformers. */ PROOF int _abbrev_pattern_pair = - new_const_safe("abbrev_pattern_pair", `:int->int->hprop`); + new_const_safe("abbrev_pattern_pair", `:int->int->cprop`); PROOF int _abbrev_pattern_pair_header = - cst_add_const_to_header(`abbrev_pattern_pair:int->int->hprop`); + cst_add_const_to_header(`abbrev_pattern_pair:int->int->cprop`); PROOF int _abbrev_pattern_hof = new_const_safe( - "abbrev_pattern_hof", `:(int->int)->int->hprop`); + "abbrev_pattern_hof", `:(int->int)->int->cprop`); PROOF int _abbrev_pattern_hof_header = cst_add_const_to_header( - `abbrev_pattern_hof:(int->int)->int->hprop`); + `abbrev_pattern_hof:(int->int)->int->cprop`); PROOF static void check_state_transformer(const bool condition, const char *message) { @@ -53,7 +53,7 @@ PROOF static bool symhp_has_existential_resources( } void forget_fact_consumes_all_and_allows_missing_branches() - PARAM(`n:int`, `a:int`, `b:int`, `p:addr`, `q:addr`) + PARAM(`n:int`, `a:int`, `b:int`, `p:int`, `q:int`) REQUIRE(`(fact(0i <= n) ** fact(0i <= n) ** data_at p Tint a) || data_at q Tint b`) ENSURE(`data_at p Tint a || data_at q Tint b`) @@ -81,7 +81,7 @@ void forget_fact_consumes_all_and_allows_missing_branches() } } -void forget_fact_prunes_only_vacuous_existentials() PARAM(`p:addr`) +void forget_fact_prunes_only_vacuous_existentials() PARAM(`p:int`) REQUIRE(`exists discarded retained. fact(discarded == 7i) ** data_at p Tint retained`) ENSURE(`exists retained. data_at p Tint retained`) { @@ -101,7 +101,7 @@ void forget_fact_prunes_only_vacuous_existentials() PARAM(`p:addr`) } void abbreviate_selected_occurrences() - PARAM(`v:int`, `p:addr`, `q:addr`, `r:addr`) + PARAM(`v:int`, `p:int`, `q:int`, `r:int`) REQUIRE(`data_at p Tint (v + 0i) ** data_at q Tint (v + 0i) ** data_at r Tint (v + 0i)`) @@ -132,7 +132,7 @@ void abbreviate_selected_occurrences() } void selected_abbreviation_allows_unmatched_branches() - PARAM(`x:int`, `y:int`, `p:addr`, `q:addr`) + PARAM(`x:int`, `y:int`, `p:int`, `q:int`) REQUIRE(`data_at p Tint x || data_at q Tint y`) ENSURE(`(exists named. fact(named == x) ** data_at p Tint named) || data_at q Tint y`) @@ -168,7 +168,7 @@ void selected_abbreviation_allows_unmatched_branches() } void abbreviate_all_state_occurrences() - PARAM(`x:int`, `p:addr`, `q:addr`) + PARAM(`x:int`, `p:int`, `q:int`) REQUIRE(`data_at p Tint x ** data_at q Tint x`) ENSURE(`exists named. fact(named == x) ** data_at p Tint named ** data_at q Tint named`) @@ -190,7 +190,7 @@ void abbreviate_all_state_occurrences() } } -void abbreviation_elimination_round_trip() PARAM(`z:int`, `p:addr`) +void abbreviation_elimination_round_trip() PARAM(`z:int`, `p:int`) REQUIRE(`data_at p Tint (z + 0i)`) ENSURE(`data_at p Tint (z + 0i)`) { PROOF { int axioms_before = cst_get_axiom_count(); @@ -209,7 +209,7 @@ void abbreviation_elimination_round_trip() PARAM(`z:int`, `p:addr`) } } -void rename_branch_existentials() PARAM(`p:addr`, `q:addr`) +void rename_branch_existentials() PARAM(`p:int`, `q:int`) REQUIRE(`(exists old. data_at p Tint old) || (exists old. data_at q Tint old)`) ENSURE(`(exists old. data_at p Tint old) || @@ -242,7 +242,7 @@ void rename_branch_existentials() PARAM(`p:addr`, `q:addr`) } } -void rename_outer_existentials_by_pattern() PARAM(`p:addr`, `q:addr`, `r:addr`) +void rename_outer_existentials_by_pattern() PARAM(`p:int`, `q:int`, `r:int`) REQUIRE(`(exists x y. data_at p Tint x ** data_at q Tint y) || (exists x. data_at r Tint x)`) ENSURE(`(exists x y. data_at p Tint x ** data_at q Tint y) || @@ -297,18 +297,17 @@ void canonicalize_local_variable_values(int source, int *p) strip_sl_exists_results opened = strip_sl_exists(symhp); check_state_transformer( !has_outer_binder_named(symhp, `source_v:int`) && - !has_outer_binder_named(symhp, `p_v:addr`) && + !has_outer_binder_named(symhp, `p_v:int`) && has_outer_binder_named(symhp, `x_v:int`) && - has_outer_binder_named(symhp, `x_v':int`), - "rename_locals_st renamed function-entry values or failed to name a " - "derived local value"); + !has_outer_binder_named(symhp, `x_v':int`), + "rename_locals_st renamed function-entry values or rebound an " + "already canonical precondition witness"); check_state_transformer( - vector_size(opened.vs) == 2, - "rename_locals_st did not freshen exactly one old x_v binder"); + vector_size(opened.vs) == 1, + "rename_locals_st changed the number of precondition witnesses"); term_list canonical_resources = TERM_LIST( - `fact((x_v:int) == source__pre)`, `data_at source__addr Tint source__pre`, `data_at p__addr Tptr p__pre`, - `data_at x__addr Tint x_v`, `data_at p__pre Tint x_v'`); + `data_at x__addr Tint source__pre`, `data_at p__pre Tint x_v`); check_state_transformer( symhp_has_exact_resources(symhp, canonical_resources), "rename_locals_st produced the wrong canonical resources or was " @@ -379,7 +378,7 @@ void leave_unseeded_local_value_unnamed(int x) REQUIRE(`emp`) ENSURE(`emp`) { } } -void retain_successive_local_value_names(int x) +void keep_successive_literal_values_unnamed(int x) REQUIRE(`exists (x_v:int). fact(x_v == x)`) ENSURE(`emp`) { PROOF rename_locals_st(); x = 1; @@ -391,26 +390,26 @@ void retain_successive_local_value_names(int x) term symhp = get_symbolic_state(); check_state_transformer( - vector_size(strip_sl_exists(symhp).vs) == 3 && + vector_size(strip_sl_exists(symhp).vs) == 1 && has_outer_binder_named(symhp, `x_v:int`) && - has_outer_binder_named(symhp, `x_v':int`) && - has_outer_binder_named(symhp, `x_v'':int`), - "rename_locals_st did not retain predictable local value names"); + !has_outer_binder_named(symhp, `x_v':int`) && + !has_outer_binder_named(symhp, `x_v'':int`), + "rename_locals_st named closed literal local values or discarded " + "the function-entry witness"); check_state_transformer( symhp_has_exact_resources( - symhp, TERM_LIST(`fact((x_v':int) == x__pre)`, - `fact((x_v'':int) == 1i)`, `fact((x_v:int) == 2i)`, - `data_at x__addr Tint (x_v:int)`)), - "rename_locals_st produced the wrong successive local value " - "history"); + symhp, TERM_LIST(`fact((x_v:int) == x__pre)`, + `data_at x__addr Tint 2i`)), + "rename_locals_st changed the final literal value or the original " + "entry witness"); check_state_transformer(cst_get_axiom_count() == axioms_before, "rename_locals_st emitted an obligation while " - "retaining local value history"); + "preserving literal local values"); } } void add_multiple_facts_per_branch() - PARAM(`n:int`, `a:int`, `b:int`, `p:addr`, `q:addr`) + PARAM(`n:int`, `a:int`, `b:int`, `p:int`, `q:int`) REQUIRE(`(fact(0i <= n) ** data_at p Tint a) || (fact(0i <= n) ** data_at q Tint b)`) ENSURE(`(fact(0i <= n) ** fact(0i < n + 1i) ** @@ -446,7 +445,7 @@ void add_multiple_facts_per_branch() } void substitute_equality_fact_once_per_branch() - PARAM(`u:int`, `v:int`, `a:int`, `p:addr`, `q:addr`) + PARAM(`u:int`, `v:int`, `a:int`, `p:int`, `q:int`) REQUIRE(`(fact(u == v) ** data_at p Tint u) || (fact(u == v) ** data_at q Tint v ** data_at p Tint a)`) ENSURE(`data_at p Tint v || @@ -510,7 +509,7 @@ PROOF int _equality_hconvs_avoid_redundant_assumptions = equality_hconvs_avoid_redundant_assumptions(); void eliminate_defining_eq_facts_per_branch() - PARAM(`a:int`, `b:int`, `p:addr`, `q:addr`) + PARAM(`a:int`, `b:int`, `p:int`, `q:int`) REQUIRE(`(exists x. fact(x == a) ** data_at p Tint x) || data_at q Tint b`) ENSURE(`data_at p Tint a || data_at q Tint b`) { PROOF { @@ -538,7 +537,7 @@ void eliminate_defining_eq_facts_per_branch() } } -void preserve_protected_defining_eq_fact() PARAM(`p:addr`) REQUIRE(`exists x y. +void preserve_protected_defining_eq_fact() PARAM(`p:int`) REQUIRE(`exists x y. fact(x == y) ** fact(y == 7i) ** data_at p Tint x`) ENSURE(`exists x. fact(x == 7i) ** data_at p Tint x`) { PROOF { diff --git a/tests/operational/val_of.c b/tests/operational/val_of.c index e52692197f1aca41d4389540a423ed07035e9884..bdb1508d9bc44ca8839121592563a44ca8ac7011 100644 --- a/tests/operational/val_of.c +++ b/tests/operational/val_of.c @@ -44,7 +44,7 @@ void val_of_pointer_field(struct val_of_node *x) { PROOF { term before = get_symbolic_state(); - expect_val(val_of("x"), `x__pre:addr`, "pointer lookup failed"); + expect_val(val_of("x"), `x__pre:int`, "pointer lookup failed"); expect_val(val_of("x->field"), `field_value:int`, "field lookup failed"); expect_val(val_of("&(x->field)"), diff --git a/tutorial/10_reverse_decl.c b/tutorial/10_reverse_decl.c index f3dd1ee02586e258dc1929f26d8d2f2efeb0e3f6..7ada3c9e476504399410aaabc7d6562c2f9dd8de 100644 --- a/tutorial/10_reverse_decl.c +++ b/tutorial/10_reverse_decl.c @@ -33,10 +33,10 @@ PROOF thm sll_def = cst_new_rec_definition( data_at (field_addr pt Tlist Ftail) Tptr q ** sll q t) `, - `:addr->(int)list->hprop`); + `:int->(int)list->cprop`); -PROOF thm REVERSE_def = get_REVERSE(); -PROOF thm APPEND_def = get_APPEND(); +PROOF thm REVERSE_def = HOL_REVERSE; +PROOF thm APPEND_def = HOL_APPEND; PROOF thm APPEND_ASSOC = get_theorem_by_name("APPEND_ASSOC"); PROOF thm APPEND_NIL = get_theorem_by_name("APPEND_NIL"); PROOF thm REVERSE_REVERSE = get_theorem_by_name("REVERSE_REVERSE"); @@ -65,10 +65,13 @@ struct list *reverse_declarative(struct list *pt) { gnode g = AUTO_INIT_SLTAC(root)[0]; g = LIST_EXISTS_SLTAC( - g, TERM_LIST(`[]:(int)list`, `l:(int)list`, `0i:addr`, - `pt__pre:addr`)); + g, TERM_LIST(`[]:(int)list`, `l:(int)list`, `0i:int`, + `pt__pre:int`)); + g = AUTO_FRAME_SLTAC(g); + g = CONV_WITH_ASMP_SLTAC( + g, simp_conv, THM_LIST(REVERSE_def, APPEND_def)); g = CONV_WITH_ASMP_SLTAC( - g, simp_conv, THM_LIST(sll_def, REVERSE_def, APPEND_def)); + g, simp_conv, THM_LIST(sll_def)); g = AUTO_FRAME_SLTAC(g); } set_symbolic_state(gnode_prove(root)); @@ -96,19 +99,29 @@ struct list *reverse_declarative(struct list *pt) gnode g = AUTO_INIT_SLTAC(root)[0]; gnode_list cases = CASES_TAC(g, `l2:(int)list`, "P_l2"); - g = cases[0]; - g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); - g = AUTO_INTRO_FACT_SLTAC(g); - CONTR_TAC(g, assume_rule(`F`)); - - g = cases[1]; - g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); - g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; - g = LIST_EXISTS_SLTAC( - g, TERM_LIST(`l1:(int)list`, `a0:int`, `a1:(int)list`, - `w_v:addr`, `v_v:addr`, `q:addr`)); - g = CONV_WITH_ASMP_SLTAC(g, simp_conv, thm_list_n(0)); - g = AUTO_FRAME_SLTAC(g); + { + g = cases[0]; + g = CONV_WITH_ASMP_SLTAC(cases[0], pure_rewrite_conv, THM_LIST(sll_def)); + g = INTRO_FACT_SLTAC(g, CONST_STRING_LIST("H_2")); + CONTR_TAC(g, assume_rule(`F`)); + } + + // g = cases[0]; + // g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); + // g = AUTO_INTRO_FACT_SLTAC(g); + // CONTR_TAC(g, assume_rule(`F`)); + + { + g = cases[1]; + g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); + g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; + g = LIST_EXISTS_SLTAC( + g, TERM_LIST(`l1:(int)list`, `a0:int`, `a1:(int)list`, + `w_v:int`, `v_v:int`, `q:int`)); + g = AUTO_FRAME_SLTAC(g); + g = CONV_WITH_ASMP_SLTAC(g, simp_conv, thm_list_n(0)); + g = AUTO_FRAME_SLTAC(g); + } } set_symbolic_state(gnode_prove(root)); } @@ -120,24 +133,22 @@ struct list *reverse_declarative(struct list *pt) /* Fold the updated node and re-establish the complete loop state. */ PROOF { - term target_symst = `${loop_inv:hprop} ** undef_data_at t__addr Tptr`; + term target_symst = `exists t_v. + ${loop_inv:cprop} ** data_at t__addr Tptr t_v`; gnode root = gnode_new_with_ccl(mk_sl_ent(get_symbolic_state(), target_symst)); { gnode g = AUTO_INIT_SLTAC(root)[0]; g = EXISTS_PULL_SLTAC(g); g = LIST_EXISTS_SLTAC( - g, TERM_LIST(`hd :: l1:(int)list`, `tl:(int)list`, `v_v:addr`, - `q:addr`)); + g, TERM_LIST(`q:int`, `hd :: l1:(int)list`, `tl:(int)list`, + `v_v:int`, `q:int`)); g = CONV_WITH_ASMP_SLTAC( g, simp_conv, THM_LIST(sll_def, REVERSE_def, APPEND_def, gsym_rule(APPEND_ASSOC))); g = EXISTS_PULL_SLTAC(g); - g = EXISTS_SLTAC(g, `w_v:addr`); - g = HANT_APPLY_SLTAC(g, CONST_STRING_LIST("H_1"), NULL, - get_data_at_to_undef_data_at() - ); + g = EXISTS_SLTAC(g, `w_v:int`); g = AUTO_FRAME_SLTAC(g); } set_symbolic_state(gnode_prove(root)); @@ -146,11 +157,11 @@ struct list *reverse_declarative(struct list *pt) /* Turn the empty suffix and model equation into the complete exit state. */ PROOF { - term target_symst = `exists result. + term target_symst = `exists result v_final. sll result (REVERSE l) ** data_at w__addr Tptr result ** - undef_data_at v__addr Tptr ** - undef_data_at pt__addr Tptr + data_at v__addr Tptr v_final ** + data_at pt__addr Tptr pt__pre `; gnode root = gnode_new_with_ccl(mk_sl_ent(get_symbolic_state(), target_symst)); @@ -159,14 +170,11 @@ struct list *reverse_declarative(struct list *pt) gnode_list cases = CASES_TAC(g, `l2:(int)list`, "P_l2"); g = cases[0]; - g = LIST_EXISTS_SLTAC(g, TERM_LIST(`w_v:addr`)); + g = LIST_EXISTS_SLTAC(g, TERM_LIST(`w_v:int`, `v_v:int`)); g = CONV_WITH_ASMP_SLTAC( g, simp_conv, THM_LIST(sll_def, APPEND_NIL, REVERSE_REVERSE)); g = AUTO_FRAME_SLTAC(g); - g = AUTO_HANT_APPLY_SLTAC(g, NULL, get_data_at_to_undef_data_at()); - g = AUTO_HANT_APPLY_SLTAC(g, NULL, get_data_at_to_undef_data_at()); - g = AUTO_FRAME_SLTAC(g); g = cases[1]; g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); diff --git a/tutorial/10_reverse_decl_mod.c b/tutorial/10_reverse_decl_mod.c new file mode 100644 index 0000000000000000000000000000000000000000..7a32d4332b7d86b7c6b9b72f0a5d4fdb42a7db56 --- /dev/null +++ b/tutorial/10_reverse_decl_mod.c @@ -0,0 +1,257 @@ +#include "userlib/qcp/veriftime.h" +#require "userlib/qcp/veriftime.c" + +PROOF static int _APPEND = + cst_add_const_to_header(`APPEND:(int)list->(int)list->(int)list`); +PROOF static int _REVERSE = + cst_add_const_to_header(`REVERSE:(int)list->(int)list`); + +struct list { + int head; + struct list *tail; +}; + +PROOF static int _list = (new_const("Tlist", `:struct_name`), 0); +PROOF static int _head = (new_const("Fhead", `:field`), 0); +PROOF static int _tail = (new_const("Ftail", `:field`), 0); + +PROOF thm sll_def = cst_new_rec_definition( + "sll", get_theorem_by_name("list_RECURSION"), + ` + (sll pt [] -|- fact(pt == 0i)) && + (sll pt (h :: t) -|- fact(~(pt == 0i)) ** exists q. + data_at (field_addr pt Tlist Fhead) Tint h ** + data_at (field_addr pt Tlist Ftail) Tptr q ** + sll q t) + `, + `:int->(int)list->cprop`); + +PROOF thm prove_sll_def_alt() { + gnode root = gnode_new_with_ccl(` + sll pt l -||- + if (pt == 0i) then fact(l == []) + else exists q h t. fact(l == h :: t) ** + data_at (field_addr pt Tlist Fhead) Tint h ** + data_at (field_addr pt Tlist Ftail) Tptr q ** + sll q t + `); + gnode_list cases_l = CASES_TAC(root, `l:(int)list`, "P_l"); + { + gnode l_nil = cases_l[0]; + l_nil = CONV_WITH_ASMP_TAC(l_nil, rewrite_conv, THM_LIST(sll_def)); + gnode_list cases_pt = BOOL_CASES_TAC(l_nil, `pt == 0i`, "P_pt"); + { + gnode l_nil_pt_0 = cases_pt[0]; + l_nil_pt_0 = CONV_WITH_ASMP_TAC(l_nil_pt_0, rewrite_conv, THM_LIST(sll_def, sl_fact_true_emp())); + gnode_list gns = EQUIV_SLTAC(l_nil_pt_0, "HL", "HR"); + AUTO_INIT_SLTAC(gns[0]); + AUTO_INIT_SLTAC(gns[1]); + } + { + gnode l_nil_pt_n0 = cases_pt[1]; + l_nil_pt_n0 = CONV_WITH_ASMP_TAC(l_nil_pt_n0, rewrite_conv, THM_LIST(sll_def)); + gnode_list gns = EQUIV_SLTAC(l_nil_pt_n0, "HFALSE", "HLIST"); + { + CONTR_SLTAC(gns[0], "HFALSE"); + } + { + gnode g = AUTO_INIT_SLTAC(gns[1])[0]; + thm distinctness = get_datatype_distinctness("list"); + thm contr = meson_solver(THM_LIST(distinctness), `[]:(int)list == h :: t ==> F`); + CONTR_TAC(g, undisch_all_rule(contr)); + } + } + } + { + gnode l_cons = cases_l[1]; + l_cons = CONV_WITH_ASMP_TAC(l_cons, rewrite_conv, THM_LIST(sll_def)); + gnode_list cases_pt = BOOL_CASES_TAC(l_cons, `pt == 0i`, "P_pt"); + { + gnode l_cons_pt_0 = cases_pt[0]; + l_cons_pt_0 = CONV_WITH_ASMP_TAC(l_cons_pt_0, rewrite_conv, THM_LIST(sll_def)); + gnode_list gns = EQUIV_SLTAC(l_cons_pt_0, "HFALSE", "HLIST"); + { + gnode g = AUTO_HANT_DESTRUCT_SLTAC(gns[0])[0]; + CONTR_SLTAC(g, "HFALSE"); + } + { + gnode g = AUTO_INIT_SLTAC(gns[1])[0]; + thm distinctness = get_datatype_distinctness("list"); + thm contr = meson_solver(THM_LIST(distinctness), `l:(int)list == a0 :: a1 ==> a0 :: a1 == [] ==> F`); + CONTR_TAC(g, undisch_all_rule(contr)); + } + } + { + gnode l_cons_pt_n0 = cases_pt[1]; + l_cons_pt_n0 = CONV_WITH_ASMP_TAC(l_cons_pt_n0, rewrite_conv, THM_LIST(sll_def)); + gnode_list gns = EQUIV_SLTAC(l_cons_pt_n0, "HFALSE", "HLIST"); + { + gnode g = AUTO_HANT_DESTRUCT_SLTAC(gns[0])[0]; + g = LIST_EXISTS_SLTAC(g, TERM_LIST(`q:int`, `a0:int`, `a1:(int)list`)); + g = CONV_SLTAC(g, simp_conv(vector_create())); + g = AUTO_FRAME_SLTAC(g); + } + { + gnode g = AUTO_INIT_SLTAC(gns[1])[0]; + g = EXISTS_SLTAC(g, `q:int`); + thm inj = get_datatype_injectivity("list"); + g = ASMP_CONV_TAC(g, rewrite_conv(THM_LIST(inj)), CONST_STRING_LIST("H")); + g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST()); + g = AUTO_FRAME_SLTAC(g); + } + } + } + return gnode_prove(root); +} + +PROOF thm sll_def_alt = prove_sll_def_alt(); + +PROOF thm REVERSE_def = HOL_REVERSE; +PROOF thm APPEND_def = HOL_APPEND; +PROOF thm APPEND_ASSOC = get_theorem_by_name("APPEND_ASSOC"); +PROOF thm APPEND_NIL = get_theorem_by_name("APPEND_NIL"); +PROOF thm REVERSE_REVERSE = get_theorem_by_name("REVERSE_REVERSE"); + +struct list *reverse_declarative(struct list *pt) + PARAM(`l:(int)list`) + REQUIRE(`sll pt l`) + ENSURE(`sll __return (REVERSE l)`) +{ + struct list *w, *v; + w = (void *)0; + v = pt; + + PROOF term loop_inv = `exists l1 l2 w_v v_v. + fact(l == (REVERSE l1) ++ l2) ** + sll w_v l1 ** sll v_v l2 ** + data_at v__addr Tptr v_v ** + data_at w__addr Tptr w_v ** + data_at pt__addr Tptr pt__pre + `; + + /* Establish the complete loop-entry state. */ + PROOF { + gnode root = + gnode_new_with_ccl(mk_sl_ent(get_symbolic_state(), loop_inv)); + { + gnode g = AUTO_INIT_SLTAC(root)[0]; + g = LIST_EXISTS_SLTAC( + g, TERM_LIST(`[]:(int)list`, `l:(int)list`, `0i:int`, + `pt__pre:int`)); + g = CONV_WITH_ASMP_SLTAC( + g, simp_conv, THM_LIST(sll_def, REVERSE_def, APPEND_def)); + g = AUTO_FRAME_SLTAC(g); + } + set_symbolic_state(gnode_prove(root)); + } + + while (v) + INV(loop_inv) + { + /* Expose the current node in a new complete symbolic state. */ + PROOF { + term target_symst = `exists l1 hd tl w_v v_v q. + fact(l == (REVERSE l1) ++ (hd :: tl)) ** + fact(~(v_v == 0i)) ** + sll w_v l1 ** + data_at (field_addr v_v Tlist Fhead) Tint hd ** + data_at (field_addr v_v Tlist Ftail) Tptr q ** + sll q tl ** + data_at v__addr Tptr v_v ** + data_at w__addr Tptr w_v ** + data_at pt__addr Tptr pt__pre + `; + gnode root = + gnode_new_with_ccl(mk_sl_ent(get_symbolic_state(), target_symst)); + { + gnode g = AUTO_INIT_SLTAC(root)[0]; + gnode_list cases = CASES_TAC(g, `l2:(int)list`, "P_l2"); + + { + g = cases[0]; + g = CONV_WITH_ASMP_SLTAC(cases[0], pure_rewrite_conv, THM_LIST(sll_def)); + g = INTRO_FACT_SLTAC(g, CONST_STRING_LIST("H_2")); + CONTR_TAC(g, assume_rule(`F`)); + } + + // g = cases[0]; + // g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); + // g = AUTO_INTRO_FACT_SLTAC(g); + // CONTR_TAC(g, assume_rule(`F`)); + + { + g = cases[1]; + g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); + g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; + g = LIST_EXISTS_SLTAC( + g, TERM_LIST(`l1:(int)list`, `a0:int`, `a1:(int)list`, + `w_v:int`, `v_v:int`, `q:int`)); + g = AUTO_FRAME_SLTAC(g); + g = CONV_WITH_ASMP_SLTAC(g, simp_conv, thm_list_n(0)); + g = AUTO_FRAME_SLTAC(g); + } + } + set_symbolic_state(gnode_prove(root)); + } + + struct list *t = v->tail; + v->tail = w; + w = v; + v = t; + + /* Fold the updated node and re-establish the complete loop state. */ + PROOF { + term target_symst = `exists t_v. + ${loop_inv:cprop} ** data_at t__addr Tptr t_v`; + gnode root = + gnode_new_with_ccl(mk_sl_ent(get_symbolic_state(), target_symst)); + { + gnode g = AUTO_INIT_SLTAC(root)[0]; + g = EXISTS_PULL_SLTAC(g); + g = LIST_EXISTS_SLTAC( + g, TERM_LIST(`q:int`, `hd :: l1:(int)list`, `tl:(int)list`, + `v_v:int`, `q:int`)); + g = CONV_WITH_ASMP_SLTAC( + g, simp_conv, + THM_LIST(sll_def, REVERSE_def, APPEND_def, + gsym_rule(APPEND_ASSOC))); + g = EXISTS_PULL_SLTAC(g); + g = EXISTS_SLTAC(g, `w_v:int`); + g = AUTO_FRAME_SLTAC(g); + } + set_symbolic_state(gnode_prove(root)); + } + } + + /* Turn the empty suffix and model equation into the complete exit state. */ + PROOF { + term target_symst = `exists result v_final. + sll result (REVERSE l) ** + data_at w__addr Tptr result ** + data_at v__addr Tptr v_final ** + data_at pt__addr Tptr pt__pre + `; + gnode root = + gnode_new_with_ccl(mk_sl_ent(get_symbolic_state(), target_symst)); + { + gnode g = AUTO_INIT_SLTAC(root)[0]; + gnode_list cases = CASES_TAC(g, `l2:(int)list`, "P_l2"); + + g = cases[0]; + g = LIST_EXISTS_SLTAC(g, TERM_LIST(`w_v:int`, `v_v:int`)); + g = CONV_WITH_ASMP_SLTAC( + g, simp_conv, + THM_LIST(sll_def, APPEND_NIL, REVERSE_REVERSE)); + g = AUTO_FRAME_SLTAC(g); + + g = cases[1]; + g = CONV_WITH_ASMP_SLTAC(g, simp_conv, THM_LIST(sll_def)); + g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; + g = AUTO_INTRO_FACT_SLTAC(g); + CONTR_TAC(g, assume_rule(`F`)); + } + set_symbolic_state(gnode_prove(root)); + } + + return w; +} diff --git a/tutorial/10_reverse_op.c b/tutorial/10_reverse_op.c index 6b060b2f2a2a0e24fc9fc480486dc6118af6e83e..b35379129c35e4629b942269cdc114731163c2fe 100644 --- a/tutorial/10_reverse_op.c +++ b/tutorial/10_reverse_op.c @@ -32,11 +32,11 @@ PROOF thm sll_def = cst_new_rec_definition( data_at (field_addr pt Tlist Ftail) Tptr q ** sll q t )) `, - `:addr->(int)list->hprop` + `:int->(int)list->cprop` ); -PROOF thm REVERSE_def = get_REVERSE(); -PROOF thm APPEND_def = get_APPEND(); +PROOF thm REVERSE_def = HOL_REVERSE; +PROOF thm APPEND_def = HOL_APPEND; PROOF thm APPEND_ASSOC = get_theorem_by_name("APPEND_ASSOC"); PROOF thm APPEND_NIL = get_theorem_by_name("APPEND_NIL"); PROOF thm REVERSE_REVERSE = get_theorem_by_name("REVERSE_REVERSE"); @@ -57,7 +57,7 @@ PROOF thm unfold_sll_null_proof(const term goal_tm) { } decl_operation(unfold_sll_null, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), TERM_LIST(`sll (KEY pt) (CAPTURE l)`), TERM_LIST(`pt == 0i`), `fact(l == []:(int)list)` @@ -87,14 +87,14 @@ PROOF thm unfold_sll_not_null_proof(const term goal_tm) { g = gns[1]; g = CONV_WITH_ASMP_SLTAC(g, rewrite_conv, THM_LIST(sll_def)); g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; - g = LIST_EXISTS_SLTAC(g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:addr`)); + g = LIST_EXISTS_SLTAC(g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:int`)); g = CONV_SLTAC(g, simp_conv(thm_list_n(0))); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(unfold_sll_not_null, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), term_list_n(1, `sll (KEY pt) (CAPTURE l)`), term_list_n(1, `~(pt == 0i)`), `exists h t q. @@ -109,13 +109,13 @@ PROOF thm fold_sll_not_null_proof(const term goal_tm) { gnode g = AUTO_INIT_SLTAC(root)[0]; g = CONV_WITH_ASMP_SLTAC(g, rewrite_conv, THM_LIST(sll_def)); g = CLEAN_SLTAC(g); - g = EXISTS_SLTAC(g, `q:addr`); + g = EXISTS_SLTAC(g, `q:int`); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(fold_sll_not_null, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), term_list_n(3, `data_at (field_addr (KEY pt) Tlist Fhead) Tint (CAPTURE h)`, `data_at (field_addr (KEY pt) Tlist Ftail) Tptr (CAPTURE q)`, @@ -131,100 +131,70 @@ PROOF void forget_facts_st(term_list facts) { } } +PROOF int __0 = (set_default_types(TERM_LIST( + `l:(int)list`, `l1:(int)list`, `l2:(int)list`, + `rev_prefix:(int)list`, `rem_suffix:(int)list`, + `pt__pre:int` +)), 0); + struct list *reverse(struct list *pt) PARAM(`l:(int)list`) REQUIRE(`sll pt l`) ENSURE(`sll __return (REVERSE l)`) { - PROOF set_default_types(TERM_LIST( - `l:(int)list`, `l1:(int)list`, `l2:(int)list`, - `w_v:int`, `v_v:int`, `pt__pre:int` - )); - - struct list *w, *v; - - w = (void *)0; + struct list *ret = (void *)0; PROOF { - // create the reversed prefix list `l1` (initially `[]`), - // pointed by `w_v` (initially `NULL`) apply_operation_st(fold_sll_null, NULL); - abbrev_st(`w_v = 0i`); - abbrev_st(`l1 = []`); + abbrev_st(`rev_prefix = []`); } - v = pt; PROOF { - // mark the unprocessed suffix list `l2` (initially `l`), - // pointed by `v_v` (initially `pt__pre`) - abbrev_occurrences_st( - `v_v == pt__pre`, - TERM_LIST( - `data_at v__addr Tptr v_v`, - `sll v_v l` - )); - abbrev_st(`l2 = l`); + abbrev_st(`rem_suffix = l`); assert_fact_st( - `l == (REVERSE l1) ++ l2`, - simp_conv, THM_LIST(REVERSE_def, APPEND_def)); + `(REVERSE l) == (REVERSE rem_suffix) ++ rev_prefix`, + simp_conv, THM_LIST(REVERSE_def, APPEND_NIL)); } + PROOF abbrev_st(`ret_v = 0i`); + PROOF abbrev_st(`pt_v = pt__pre`); + PROOF forget_facts_st(TERM_LIST( - `l2 == l`, `v_v == pt__pre`, `l1 == []`, `w_v == 0i` + `ret_v == 0i`, `pt_v == pt__pre`, `rem_suffix == l`, `rev_prefix == []` )); PROOF term loop_inv = get_symbolic_state(); - while (v) + while (pt) INV(loop_inv) { PROOF apply_operation_named_st( unfold_sll_not_null, - TERM_LIST(`v_v:addr`), - TERM_LIST(`hd:int`, `tl:(int)list`, `nxt:addr`)); - struct list *t = v->tail; - - v->tail = w; + TERM_LIST(`pt_v:int`), + TERM_LIST(`head:int`, `tail:(int)list`, `nxt:int`)); + + struct list *t = pt->tail; + pt->tail = ret; + PROOF apply_operation_st( fold_sll_not_null, - TERM_LIST(`v_v:addr`) + TERM_LIST(`pt_v:int`) ); - PROOF forget_fact_st(`~(v_v == 0i)`); + ret = pt; + pt = t; PROOF { assert_fact_st( - `l == (REVERSE (hd :: l1)) ++ tl:(int)list`, simp_conv, + `(REVERSE l) == (REVERSE tail) ++ (head :: rev_prefix)`, simp_conv, THM_LIST(REVERSE_def, APPEND_def, gsym_rule(APPEND_ASSOC))); - rename_hexists_st("[l1'/l1] [l2'/l2]"); - abbrev_st(`l1 = hd :: l1':(int)list`); - abbrev_st(`l2 = tl:(int)list`); - } - - PROOF forget_facts_st(TERM_LIST( - `l2 == tl`, - `l1 == hd :: l1'`, - `l == REVERSE l1' ++ l2'`, - `l2' == hd :: l2` - )); - - w = v; - PROOF rename_locals_st(); - - v = t; - PROOF rename_locals_st(); - - PROOF { - substitute_st(sym_rule(assume_rule(`w_v == v_v'`))); - substitute_st(sym_rule(assume_rule(`v_v == nxt`))); - forget_facts_st(TERM_LIST(`w_v == v_v'`, `v_v == nxt`)); } - } - PROOF apply_operation_st(unfold_sll_null, TERM_LIST(`v_v:addr`)); - PROOF assert_fact_st(`l1 == (REVERSE l):(int)list`, simp_conv, - THM_LIST(APPEND_NIL, REVERSE_REVERSE) - ); - PROOF substitute_st(assume_rule(`l1 == (REVERSE l):(int)list`)); - - return w; + PROOF { + apply_operation_st(unfold_sll_null, TERM_LIST(`pt_v:int`)); + assert_fact_st(`rev_prefix == (REVERSE l)`, simp_conv, + THM_LIST(REVERSE_def, APPEND_def) + ); + substitute_fact_st(`rev_prefix == (REVERSE l)`); + } + return ret; } diff --git a/tutorial/11_memset_op.c b/tutorial/11_memset_op.c new file mode 100644 index 0000000000000000000000000000000000000000..90cbf2526c7f364309d408e95cadd95fe2189a41 --- /dev/null +++ b/tutorial/11_memset_op.c @@ -0,0 +1,237 @@ +#include "array/lib/array.h" +#require "array/lib/array.c" + +#include "userlib/proof/debug.h" +#require "userlib/proof/debug.c" + +#include "userlib/proof/tactics.h" +#require "userlib/proof/tactics.c" + +#define PG(g) print_open_goals(gc_sprintf("LINE:%d", __LINE__), g) + +// verify_all: expect-vcs=0 + +/* The array after overwriting exactly the first k cells. Naming this model + * keeps the symbolic state at loop heads independent of its list algebra. */ +PROOF static thm memset_contents_def = new_fun_definition(` + memset_contents (k:num) (v:int) (xs:(int)list) = + REPLICATE k v ++ list_drop k xs +`); + +PROOF static int _MEMSET_CONTENTS = + cst_add_const_to_header(`memset_contents:num->int->(int)list->(int)list`); + +PROOF static thm prove_memset_contents_length(void) { + gnode root = gnode_new_with_ccl(` + forall k v xs. + k <= LENGTH (xs:(int)list) ==> + LENGTH (memset_contents k v xs) = LENGTH xs + `); + gnode g = CONV_TAC(root, rewrite_conv(THM_LIST(memset_contents_def))); + PG(g); + MATCH_ACCEPT_TAC(g, LENGTH_FILL_CURSOR); + return gnode_prove(root); +} + +PROOF static thm MEMSET_CONTENTS_LENGTH = prove_memset_contents_length(); + +PROOF static thm prove_memset_contents_step(void) { + gnode root = gnode_new_with_ccl(` + forall k v xs. + k < LENGTH (xs:(int)list) ==> + list_update k v (memset_contents k v xs) = + memset_contents (SUC k) v xs + `); + gnode g = AUTO_INTROS_TAC(root); + thm step = mp_rule(ispecl_rule(TERM_LIST(`k:num`, `v:int`, `xs:(int)list`), + LIST_UPDATE_REPLICATE_DROP_STEP), + assume_rule(`k < LENGTH (xs:(int)list)`)); + g = CONV_TAC(g, rewrite_conv(THM_LIST(memset_contents_def))); + ACCEPT_TAC(g, step); + return gnode_prove(root); +} + +PROOF static thm MEMSET_CONTENTS_STEP = prove_memset_contents_step(); + +PROOF static thm prove_memset_contents_done(void) { + gnode root = gnode_new_with_ccl(` + forall v xs. + memset_contents (LENGTH (xs:(int)list)) v xs = + REPLICATE (LENGTH xs) v + `); + gnode g = AUTO_INTROS_TAC(root); + CONV_TAC(g, simp_conv(THM_LIST(memset_contents_def, LIST_DROP_LENGTH, + get_theorem_by_name("APPEND_NIL")))); + return gnode_prove(root); +} + +PROOF static thm MEMSET_CONTENTS_DONE = prove_memset_contents_done(); + +/* Lift a list equality through char_array, then frame the rest of every + * symbolic heap. Unlike substitute_st, this changes only the array model. */ +PROOF static void replace_char_array_contents_st(const term p, + const thm contents_equality) { + thm array_equality = beta_rule(ap_term_rule( + `\contents:(int)list. char_array ${p:int} contents`, contents_equality)); + apply_hconv_st(eq2ent(array_equality)); +} + +/* close_char_array_write exposes one list_update. This transformer proves + * that it is exactly one step of the functional cursor and changes only the + * char_array conjunct. */ +PROOF static void advance_memset_array_st(void) { + thm original_int_bound = + rewrite_rule(THM_LIST(assume_rule(`n__pre = &(LENGTH (xs:(int)list))`)), + assume_rule(`i_v < n__pre`)); + thm original_num_bound = num_of_int_lt_length_rule( + `i_v:int`, `xs:(int)list`, assume_rule(`0i <= i_v`), original_int_bound); + thm step = mp_rule( + ispecl_rule(TERM_LIST(`num_of_int i_v`, `byte__pre:int`, `xs:(int)list`), + MEMSET_CONTENTS_STEP), + original_num_bound); + thm successor = num_of_int_suc_rule(`i_v:int`, assume_rule(`0i <= i_v`)); + step = conv_rule(once_rewrite_conv(THM_LIST(sym_rule(successor))), step); + replace_char_array_contents_st(`p__pre:int`, step); +} + +/* After i++, rename_locals_st gives the new value the stable name i_v and + * calls the old one i_v'. Substitute the defining equality in the useful + * direction, then discard all old-index facts so the state is again exactly + * the loop-head view. */ +PROOF static void synchronize_incremented_index_st(void) { + rename_locals_st(); + substitute_st(sym_rule(assume_rule(`i_v = i_v' + 1i`))); + forget_fact_st(`i_v = i_v' + 1i`); + forget_fact_st(`0i <= i_v'`); + forget_fact_st(`i_v' <= n__pre`); + forget_fact_st(`i_v' < n__pre`); +} + +/* Install the first-order array and list vocabulary only after constructing + * the proof-side functional model and its closed laws. */ +PROOF static int _MEMSET_ARRAY_QCP = install_array_qcp_interface(); + +void memset_char(char *p, int n, char byte) + PARAM(`xs:(int)list`) + REQUIRE(` + char_array p xs ** + fact(n = &(LENGTH xs)) + `) + ENSURE(` + char_array p (REPLICATE (LENGTH (xs:(int)list)) byte) + `) +{ + PROOF set_default_types(TERM_LIST(`xs:(int)list`, `i_v:int`, `n__pre:int`, + `byte__pre:int`, `p__pre:int`)); + + int i = 0; + PROOF { + /* Give the program cursor a stable logical name, but abstract only the + * value slot of i's data_at; unrelated zeroes are left untouched. */ + abbrev_occurrences_st(`i_v = 0i`, TERM_LIST(`data_at i__addr Tint i_v`)); + + /* Preserve the one machine bound needed to justify i++, and derive the + * semantic cursor bounds from n = LENGTH xs and i_v = 0. */ + add_data_at_range_st(`n__addr:int`, `Tint`, `n__pre:int`); + forget_fact_st(`--2147483648i <= n__pre`); + thm n_nonnegative = int_eq_length_nonnegative_rule( + `n__pre:int`, `xs:(int)list`, + assume_rule(`n__pre = &(LENGTH (xs:(int)list))`)); + thm initial_bounds = int_arith_rule(` + 0i <= n__pre ==> + i_v = 0i ==> + 0i <= i_v /\ i_v <= n__pre + `); + initial_bounds = match_mp_rule(initial_bounds, n_nonnegative); + initial_bounds = match_mp_rule(initial_bounds, assume_rule(`i_v = 0i`)); + add_conjuncts_st(initial_bounds); + + /* Change only the abstract array conjunct from xs to cursor(0). */ + thm initial_contents = apply_conversion( + simp_conv(THM_LIST(assume_rule(`i_v = 0i`), memset_contents_def, + get_theorem_by_name("NUM_OF_INT_OF_NUM"), + get_theorem_by_name("REPLICATE"), LIST_DROP_DEF, + get_theorem_by_name("APPEND"))), + `memset_contents (num_of_int i_v) byte__pre (xs:(int)list)`); + replace_char_array_contents_st(`p__pre:int`, sym_rule(initial_contents)); + forget_fact_st(`i_v = 0i`); + } + + /* The state itself is the invariant: one high-level array model, one live + * program cursor, and only the bounds needed by the next instruction. */ + PROOF term loop_inv = get_symbolic_state(); + while (i < n) + INV(loop_inv) { + PROOF { + /* open_char_array is applied to the current model, not to xs. + * Transport the guard through length preservation. */ + thm original_int_bound = rewrite_rule( + THM_LIST(assume_rule(`n__pre = &(LENGTH (xs:(int)list))`)), + assume_rule(`i_v < n__pre`)); + thm natural_bound = num_of_int_lt_length_rule(`i_v:int`, `xs:(int)list`, + assume_rule(`0i <= i_v`), + original_int_bound); + thm current_length = mp_rule( + ispecl_rule( + TERM_LIST(`num_of_int i_v`, `byte__pre:int`, `xs:(int)list`), + MEMSET_CONTENTS_LENGTH), + match_mp_rule(get_theorem_by_name("LT_IMP_LE"), natural_bound)); + thm current_int_length = ap_term_rule(`int_of_num:num->int`, current_length); + thm access_bound = + conv_rule(once_rewrite_conv(THM_LIST(sym_rule(current_int_length))), + original_int_bound); + add_fact_st(access_bound); + } + + /* Ownership transition: abstract array -> literal current cell + focus. + */ + PROOF open_char_array(`p__pre:int`, `i_v:int`); + + /* Executable transition: QCP updates only that literal data_at cell. */ + p[i] = byte; + + /* Ownership transition: cell + focus -> array with one list_update. */ + PROOF close_char_array_write(`p__pre:int`, `i_v:int`); + + PROOF { + forget_fact_st(` + i_v < &(LENGTH + (memset_contents (num_of_int i_v) byte__pre xs)) + `); + advance_memset_array_st(); + thm next_bounds = int_arith_rule(` + 0i <= i_v ==> + i_v < n__pre ==> + 0i <= i_v + 1i /\ i_v + 1i <= n__pre + `); + next_bounds = match_mp_rule(next_bounds, assume_rule(`0i <= i_v`)); + next_bounds = match_mp_rule(next_bounds, assume_rule(`i_v < n__pre`)); + add_conjuncts_st(next_bounds); + } + + /* Executable cursor move, followed immediately by logical re-synchrony. + */ + i++; + PROOF synchronize_incremented_index_st(); + } + + PROOF { + thm index_equal = int_arith_rule(` + i_v <= n__pre ==> i_v >= n__pre ==> i_v = n__pre + `); + index_equal = match_mp_rule(index_equal, assume_rule(`i_v <= n__pre`)); + index_equal = match_mp_rule(index_equal, assume_rule(`i_v >= n__pre`)); + thm index_is_length = trans_rule( + index_equal, assume_rule(`n__pre = &(LENGTH (xs:(int)list))`)); + thm natural_index_is_length = + num_of_int_eq_length_rule(`i_v:int`, `xs:(int)list`, index_is_length); + thm done = ispecl_rule(TERM_LIST(`byte__pre:int`, `xs:(int)list`), + MEMSET_CONTENTS_DONE); + thm cursor_at_length = beta_rule(ap_term_rule(` + \k:num. memset_contents k byte__pre (xs:(int)list) + `, + natural_index_is_length)); + replace_char_array_contents_st(`p__pre:int`, + trans_rule(cursor_at_length, done)); + } +} diff --git a/tutorial/11_qcp.c b/tutorial/11_qcp.c index aecbe82d77c79bcfd8743f0a77285e21db2d3778..0fce090be94cb54a54ba21e2f67c5abe2a58a005 100644 --- a/tutorial/11_qcp.c +++ b/tutorial/11_qcp.c @@ -1,5 +1,7 @@ #include "userlib/qcp/veriftime.h" #require "userlib/qcp/veriftime.c" +#include "proof/theory/c_program_logic/c_integer.h" +#require "proof/theory/c_program_logic/c_integer.c" #include "userlib/operational/operational.h" #require "userlib/operational/operational.c" diff --git a/tutorial/12_fnspec.c b/tutorial/12_fnspec.c index 038f96e601339a3a9b76d82f96075bd3085f6a59..0d1b153df7e6a923699a38741a66884b35d950cd 100644 --- a/tutorial/12_fnspec.c +++ b/tutorial/12_fnspec.c @@ -3,11 +3,11 @@ /* Function-pointer specifications as logic-level constants. * - * A function pointer's spec is an ordinary hprop conjunct built from the - * HOL constants + * A function pointer's spec is an ordinary `cprop` conjunct built from the + * aliases selected by `c_logic_install`: * - * fnspec : addr -> ctype -> hprop -> hprop -> hprop - * fnspec_w : addr -> ctype -> (A -> hprop) -> (A -> hprop) -> hprop + * fnspec : int -> ctype -> cprop -> cprop -> cprop + * fnspec_w : int -> ctype -> (A -> cprop) -> (A -> cprop) -> cprop * * where the ctype argument is a `Tfun` (argument names, argument types, * return type). `fnspec f ty pre post` renders to QCP's diff --git a/tutorial/5_smt.c b/tutorial/5_smt.c index 6c46ab3ca1d855eb4048589b393b2891a5ddbd60..21a94928dc63a05aa520e3700a60e286b58638cb 100644 --- a/tutorial/5_smt.c +++ b/tutorial/5_smt.c @@ -11,7 +11,7 @@ int area(int w, int h) PROOF { term st = get_symbolic_state(); term vc = ` - ${st:hprop} |-- + ${st:cprop} |-- fact(0i <= w__pre * h__pre && w__pre * h__pre <= 10000i) ** data_at w__addr Tint w__pre ** data_at h__addr Tint h__pre `; diff --git a/tutorial/6_operation.c b/tutorial/6_operation.c index b51c458af4f9aabc06c097a88eee121ca1e4f2c6..299d9fd9c7c8a262b403bb1c505fe2c9313213d5 100644 --- a/tutorial/6_operation.c +++ b/tutorial/6_operation.c @@ -7,6 +7,9 @@ #include "tutorial/array.h" #require "tutorial/array.c" +PROOF static int _TUTORIAL_ARRAY_QCP = + install_array_qcp_interface(); + struct mem_t { int len; char *buffer; @@ -19,12 +22,12 @@ PROOF static int _buffer = new_const_safe("Fbuffer", `:field`); PROOF thm mem_repr_def = cst_new_fun_definition( "mem_repr", ` - mem_repr pt a -|- fact(0i <= a) ** exists (b:addr). + mem_repr pt a -|- fact(0i <= a) ** exists (b:int). data_at (field_addr pt Tmem_t Flen) Tint a ** data_at (field_addr pt Tmem_t Fbuffer) Tptr b ** - store_undef_char_array b a + undef_char_array b a `, - `:addr->int->hprop` + `:int->int->cprop` ); PROOF thm unfold_mem_repr_proof(const term goal_tm) { @@ -37,13 +40,13 @@ PROOF thm unfold_mem_repr_proof(const term goal_tm) { } decl_operation(unfold_mem_repr, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), term_list_n(1, `mem_repr (KEY pt) (CAPTURE a)`), term_list_n(0), - `fact(0i <= a) ** exists (b:addr). + `fact(0i <= a) ** exists (b:int). data_at (field_addr pt Tmem_t Flen) Tint a ** data_at (field_addr pt Tmem_t Fbuffer) Tptr b ** - store_undef_char_array b a` + undef_char_array b a` ) PROOF thm fold_mem_repr_proof(const term goal_tm) { @@ -57,17 +60,17 @@ PROOF thm fold_mem_repr_proof(const term goal_tm) { term premise = gnode_get_asmps(pure_goal, CONST_STRING_LIST("P"))[0]; ACCEPT_TAC(pure_goal, assume_rule(premise)); - gnode spatial_goal = EXISTS_SLTAC(goals[1], `b:addr`); + gnode spatial_goal = EXISTS_SLTAC(goals[1], `b:int`); spatial_goal = AUTO_FRAME_SLTAC(spatial_goal); return gnode_prove(root); } decl_operation(fold_mem_repr, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), term_list_n(3, `data_at (field_addr (KEY pt) Tmem_t Flen) Tint (CAPTURE a)`, `data_at (field_addr (KEY pt) Tmem_t Fbuffer) Tptr (CAPTURE b)`, - `store_undef_char_array (DEFER b) (DEFER a)` + `undef_char_array (DEFER b) (DEFER a)` ), term_list_n(1, `0i <= a`), `mem_repr pt a` @@ -77,12 +80,12 @@ void *alloc(struct mem_t *d, int sz) PARAM(`a:int`) REQUIRE(`fact(0i <= sz && a <= 100i) ** mem_repr d a`) ENSURE(`( fact(__return == 0i && sz > a) ** mem_repr d a ) || - ( fact(sz <= a) ** store_undef_char_array __return sz ** + ( fact(sz <= a) ** undef_char_array __return sz ** mem_repr d (a - sz) )`) { - PROOF apply_operation_st(unfold_mem_repr, TERM_LIST(`d__pre:addr`)); + PROOF apply_operation_st(unfold_mem_repr, TERM_LIST(`d__pre:int`)); if (sz > d->len) { - PROOF apply_operation_st(fold_mem_repr, TERM_LIST(`d__pre:addr`)); + PROOF apply_operation_st(fold_mem_repr, TERM_LIST(`d__pre:int`)); return (void *)0; }; d->len -= sz; @@ -91,8 +94,8 @@ void *alloc(struct mem_t *d, int sz) add_fact_st(int_arith_rule(` 0i <= sz__pre ==> sz__pre <= a ==> 0i <= a - sz__pre && a - sz__pre <= a `)); - divide_store_undef_char_array(`b:addr`, `a - sz__pre`, `a:int`); - apply_operation_st(fold_mem_repr, TERM_LIST(`d__pre:addr`)); + split_undef_char_array(`b:int`, `a - sz__pre`); + apply_operation_st(fold_mem_repr, TERM_LIST(`d__pre:int`)); rewrite_st(THM_LIST(int_arith_rule(`a - (a - sz__pre) == sz__pre`))); } return ret; diff --git a/tutorial/7_strategy.c b/tutorial/7_strategy.c index 37d1889de922aad53d6885ebf0b4be62ae12163c..b96fdb3a6580f52d520a1318271191a2e76cdbce 100644 --- a/tutorial/7_strategy.c +++ b/tutorial/7_strategy.c @@ -1,89 +1,134 @@ -#include "userlib/qcp/veriftime.h" -#require "userlib/qcp/veriftime.c" +#include "array/units/array_access.h" +#require "array/units/array_access.c" -#include "tutorial/array.h" -#require "tutorial/array.c" +/* + * Migration note: the former tutorial strategy mentioned the legacy + * `store_*_array`/`undef_array_at` atoms, whose result type was fixed to + * `hprop`. This version performs the same concrete left-to-right clearing + * loop over the selected `cprop` model. The one-cell C store is packaged by + * the verified array-access module; the loop proof retains the functional + * list update explicitly. + */ -PROOF static int _array_strategies = load_array_strategies(); -PROOF static int _ireplicate = cst_add_const_to_header(`ireplicate:int->int->(int)list`); - -PROOF thm APPEND_def = get_APPEND(); -PROOF thm REPLICATE_def = get_theorem_by_name("REPLICATE"); -PROOF thm IREPLICATE_def = get_IREPLICATE_DEF(); -PROOF thm NUM_OF_INT_ADD = get_theorem_by_name("NUM_OF_INT_ADD"); -PROOF thm NUM_OF_INT_OF_NUM = get_theorem_by_name("NUM_OF_INT_OF_NUM"); -PROOF thm ADD1 = get_theorem_by_name("ADD1"); - -PROOF thm replicate_tail(term n, term x) { - term goal_tm = `!(x:A) n. REPLICATE n x ++ [x] == REPLICATE (SUC n) x`; - gnode root = gnode_new_with_ccl(goal_tm), g; - g = AUTO_INTROS_TAC(root); - gnode_list gs = INDUCT_TAC(g, `n:num`); - g = gs[0]; - g = CONV_TAC(g, rewrite_conv(THM_LIST(REPLICATE_def, APPEND_def))); - g = gs[1]; - g = CONV_TAC(g, rewrite_conv(THM_LIST(REPLICATE_def, APPEND_def, assume_rule(gnode_get_asmps(g, CONST_STRING_LIST("H"))[0])))); - thm solved_goal = gnode_prove(root); - thm res = ispecl_rule(TERM_LIST(x, n), solved_goal); - return res; -} - -PROOF thm ireplicate_tail(term n, term x) { - term goal_tm = `!(x:A) n. 0i <= n ==> (ireplicate n x) ++ [x] == ireplicate (n + 1i) x`; - gnode root = gnode_new_with_ccl(goal_tm), g; - g = AUTO_INTROS_TAC(root); - thm num_of_int_add = match_mp_rule( - NUM_OF_INT_ADD, - conj_rule(assume_rule(`0i <= n`), int_arith_rule(`0i <= 1i`)) - ); - g = CONV_TAC(g, rewrite_conv(THM_LIST( - IREPLICATE_def, - num_of_int_add, - NUM_OF_INT_OF_NUM, gsym_rule(ADD1), - replicate_tail(`num_of_int(n)`, `x:A`) - ))); - thm solved_goal = gnode_prove(root); - thm res = ispecl_rule(TERM_LIST(x, n), solved_goal); - return res; +PROOF static thm clear_current_int_index_bound(void) { + return rewrite_rule( + THM_LIST(assume_rule( + `len__pre = &(LENGTH (xs:(int)list))`)), + assume_rule(`i_v < len__pre`)); } -PROOF thm ireplicate_zero_nil(term x) { - term goal_tm = `!(x:A). ireplicate 0i x == []`; - gnode root = gnode_new_with_ccl(goal_tm), g; - g = GEN_TAC(root, "x"); - g = CONV_TAC(g, rewrite_conv(THM_LIST(IREPLICATE_def, NUM_OF_INT_OF_NUM, REPLICATE_def))); - thm solved_goal = gnode_prove(root); - thm res = ispec_rule(x, solved_goal); - return res; +PROOF static thm clear_current_num_index_bound(void) { + return num_of_int_lt_length_rule( + `i_v:int`, `xs:(int)list`, + assume_rule(`0i <= i_v`), + clear_current_int_index_bound()); } - -void clear(void *to, int len) - REQUIRE(`fact(0i <= len && len <= 100i) ** - store_undef_char_array to len`) - ENSURE(`store_char_array to len (ireplicate len 0i)`) +void clear(char *to, int len) + PARAM(`xs:(int)list`) + REQUIRE(` + char_array to xs ** + fact(len = &(LENGTH xs)) + `) + ENSURE(` + char_array to (REPLICATE (LENGTH (xs:(int)list)) 0i) + `) { int i = 0; + PROOF { + add_data_at_range_st(`len__addr:int`, `Tint`, `len__pre:int`); + thm len_nonnegative = int_eq_length_nonnegative_rule( + `len__pre:int`, `xs:(int)list`, + assume_rule(`len__pre = &(LENGTH (xs:(int)list))`)); + add_fact_st(conj_rule(int_arith_rule(`0i <= 0i`), len_nonnegative)); + + thm initial_shape = apply_conversion(rewrite_conv(THM_LIST( + get_theorem_by_name("REPLICATE"), + LIST_DROP_DEF, + get_theorem_by_name("APPEND"))), + `APPEND (REPLICATE (0:num) 0i) + (list_drop (0:num) (xs:(int)list))`); + thm initial_array = ap_term_rule( + `char_array to__pre`, initial_shape); + apply_hconv_st(eq2ent(sym_rule(initial_array))); + } + PROOF term loop_inv = `exists i_v. - fact(0i <= i_v && i_v <= len__pre) ** - fact(0i <= len__pre && len__pre <= 100i) ** - store_char_array to__pre i_v (ireplicate i_v 0i) ** - store_undef_char_array_rec to__pre i_v len__pre ** - data_at i__addr Tint i_v + char_array to__pre + (APPEND (REPLICATE (num_of_int i_v) 0i) + (list_drop (num_of_int i_v) xs)) ** + data_at to__addr Tptr to__pre ** + data_at len__addr Tint len__pre ** + data_at i__addr Tint i_v ** + fact(len__pre = &(LENGTH xs)) ** + fact(len__pre <= 2147483647i) ** + fact(0i <= i_v && i_v <= len__pre) `; - PROOF add_fact_st(ireplicate_zero_nil(`0i`)); - while (i < len) PART_INV(loop_inv) { - *((char *)to + i) = (char)0; - i = i + 1; + PROOF { + thm int_bound = clear_current_int_index_bound(); + thm natural_bound = clear_current_num_index_bound(); + thm current_length = mp_rule( + specl_rule(TERM_LIST(`num_of_int i_v`, `0i:int`, + `xs:(int)list`), + LENGTH_FILL_CURSOR), + match_mp_rule( + get_theorem_by_name("LT_IMP_LE"), natural_bound)); + thm integer_length = ap_term_rule(`int_of_num:num->int`, current_length); + add_fact_st(conv_rule( + rewrite_conv(THM_LIST(sym_rule(integer_length))), + int_bound)); + } - PROOF thm th = ireplicate_tail(`i_v:int`, `0i`); - PROOF rewrite_st(THM_LIST(ireplicate_tail(`i_v:int`, `0i`))); + store_char_array_cell(to, i, 0); + + PROOF { + thm step = mp_rule( + specl_rule(TERM_LIST(`num_of_int i_v`, `0i:int`, + `xs:(int)list`), + LIST_UPDATE_REPLICATE_DROP_STEP), + clear_current_num_index_bound()); + thm successor = num_of_int_suc_rule( + `i_v:int`, assume_rule(`0i <= i_v`)); + step = conv_rule( + rewrite_conv(THM_LIST(sym_rule(successor))), step); + substitute_st(step); + add_fact_st(int_arith_rule(` + 0i <= i_v ==> + i_v <= len__pre ==> + i_v < len__pre ==> + 0i <= i_v + 1i && i_v + 1i <= len__pre + `)); + } + + i++; } - PROOF rewrite_st(THM_LIST(int_arith_rule(`i_v:int <= len__pre ==> i_v >= len__pre ==> i_v == len__pre`))); + PROOF { + thm index_end = match_mp_rule( + int_arith_rule(` + i_v <= len__pre ==> + i_v >= len__pre ==> + i_v = len__pre + `), + assume_rule(`i_v <= len__pre`)); + index_end = match_mp_rule( + index_end, assume_rule(`i_v >= len__pre`)); + thm index_length = trans_rule( + index_end, + assume_rule(`len__pre = &(LENGTH (xs:(int)list))`)); + thm natural_length = num_of_int_eq_length_rule( + `i_v:int`, `xs:(int)list`, index_length); + thm finished_shape = apply_conversion(rewrite_conv(THM_LIST( + natural_length, + LIST_DROP_LENGTH, + get_theorem_by_name("APPEND_NIL"))), + `APPEND (REPLICATE (num_of_int i_v) 0i) + (list_drop (num_of_int i_v) (xs:(int)list))`); + substitute_st(finished_shape); + } } diff --git a/tutorial/8_reverse.c b/tutorial/8_reverse.c index 7da0cc5e8394816fd80f0ee4dd5b6b0cf9982789..97fc72231429c68266936c957467d5dbbd35a886 100644 --- a/tutorial/8_reverse.c +++ b/tutorial/8_reverse.c @@ -29,11 +29,11 @@ PROOF thm sll_def = cst_new_rec_definition( data_at (field_addr pt Tlist Ftail) Tptr q ** sll q t ) `, - `:addr->(int)list->hprop` + `:int->(int)list->cprop` ); -PROOF thm REVERSE_def = get_REVERSE(); -PROOF thm APPEND_def = get_APPEND(); +PROOF thm REVERSE_def = HOL_REVERSE; +PROOF thm APPEND_def = HOL_APPEND; PROOF thm APPEND_ASSOC = get_theorem_by_name("APPEND_ASSOC"); PROOF thm APPEND_NIL = get_theorem_by_name("APPEND_NIL"); PROOF thm REVERSE_REVERSE = get_theorem_by_name("REVERSE_REVERSE"); @@ -53,7 +53,7 @@ PROOF thm unfold_sll_null_proof(const term goal_tm) { } decl_operation(unfold_sll_null, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), term_list_n(1, `sll (KEY pt) (CAPTURE l)`), term_list_n(1, `pt == 0i`), `fact(l == []:(int)list)` @@ -83,14 +83,14 @@ PROOF thm unfold_sll_not_null_proof(const term goal_tm) { g = gns[1]; g = CONV_WITH_ASMP_SLTAC(g, rewrite_conv, THM_LIST(sll_def)); g = AUTO_HANT_DESTRUCT_SLTAC(g)[0]; - g = LIST_EXISTS_SLTAC(g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:addr`)); + g = LIST_EXISTS_SLTAC(g, TERM_LIST(`a0:int`, `a1:(int)list`, `q:int`)); g = CONV_SLTAC(g, simp_conv(thm_list_n(0))); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(unfold_sll_not_null, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), term_list_n(1, `sll (KEY pt) (CAPTURE l)`), term_list_n(1, `~(pt == 0i)`), `exists h t q. @@ -105,13 +105,13 @@ PROOF thm fold_sll_not_null_proof(const term goal_tm) { gnode g = AUTO_INIT_SLTAC(root)[0]; g = CONV_WITH_ASMP_SLTAC(g, rewrite_conv, THM_LIST(sll_def)); g = CLEAN_SLTAC(g); - g = EXISTS_SLTAC(g, `q:addr`); + g = EXISTS_SLTAC(g, `q:int`); g = AUTO_FRAME_SLTAC(g); return gnode_prove(root); } decl_operation(fold_sll_not_null, - TERM_LIST(`pt:addr`), + TERM_LIST(`pt:int`), term_list_n(3, `data_at (field_addr (KEY pt) Tlist Fhead) Tint (CAPTURE h)`, `data_at (field_addr (KEY pt) Tlist Ftail) Tptr (CAPTURE q)`, @@ -147,21 +147,21 @@ struct list *reverse(struct list *pt) { PROOF apply_operation_named_st( unfold_sll_not_null, - TERM_LIST(`v_v:addr`), - TERM_LIST(`hd:int`, `tl:(int)list`, `q:addr`)); + TERM_LIST(`v_v:int`), + TERM_LIST(`hd:int`, `tl:(int)list`, `q:int`)); struct list *t = v->tail; v->tail = w; w = v; v = t; - PROOF apply_operation_st(fold_sll_not_null, TERM_LIST(`v_v:addr`)); + PROOF apply_operation_st(fold_sll_not_null, TERM_LIST(`v_v:int`)); PROOF assert_fact_st(`l == (REVERSE (hd :: l1)) ++ tl:(int)list`, simp_conv, THM_LIST(REVERSE_def, APPEND_def, gsym_rule(APPEND_ASSOC)) ); } - PROOF apply_operation_st(unfold_sll_null, TERM_LIST(`v_v:addr`)); + PROOF apply_operation_st(unfold_sll_null, TERM_LIST(`v_v:int`)); PROOF assert_fact_st(`l1 == (REVERSE l):(int)list`, simp_conv, THM_LIST(APPEND_NIL, REVERSE_REVERSE) ); diff --git a/tutorial/9_loop.c b/tutorial/9_loop.c index 0c8c1ef8f8d1d3c2b5fcf94f0969baf48e7386f9..39ff93822179511b5c49473ad82c80185778b2aa 100644 --- a/tutorial/9_loop.c +++ b/tutorial/9_loop.c @@ -127,8 +127,8 @@ int mul2(int x, int y) ans_w == ((i_v + 1i) - 1i) * y__pre`)); /* `j` is dead at the outer loop head; hand it back uninitialized. */ apply_hconv_st(ispecl_rule( - TERM_LIST(`j__addr:addr`, `Tint`, `j_v:int`), - get_theorem_by_name("data_at_to_undef_data_at"))); + TERM_LIST(`j__addr:int`, `Tint`, `j_v:int`), + get_theorem_by_name("c_logic_data_at_to_undef_data_at"))); } } diff --git a/tutorial/array.c b/tutorial/array.c index 4fd2d56f7c246e26d64f0479a7fbbd0c640ee89a..ef6bec22db947b2b41d04258013d1213703cf807 100644 --- a/tutorial/array.c +++ b/tutorial/array.c @@ -1,31 +1 @@ #include "tutorial/array.h" - -#include "userlib/qcp/veriftime.h" -#require "userlib/qcp/veriftime.c" - -[[cst::proof]] -thm store_char_array_def = spec_all_rule(get_theorem_by_name("store_char_array_def")); - -[[cst::proof]] -thm store_undef_char_array_def = spec_all_rule(get_theorem_by_name("store_undef_char_array_def")); - -[[cst::proof]] -thm store_undef_char_array_rec_def = cst_new_fun_definition( - "store_undef_char_array_rec", `store_undef_char_array_rec (x:addr) (lo:int) (hi:int) : hprop = undef_array_at_rec x Tchar lo hi (hi - lo)`, - `:addr->int->int->hprop` -); - -[[cst::proof]] -void divide_store_undef_char_array(term pt, term i, term n) { - thm undef_array_at_divide = specl_rule(TERM_LIST(pt, `Tchar`, n, i), get_undef_array_at_divide()); - thm store_undef_char_array_divide = rewrite_rule(THM_LIST(sym_rule(store_undef_char_array_def)), undef_array_at_divide); - apply_hconv_st(eq2ent(undisch_all_rule(store_undef_char_array_divide))); -} - -[[cst::proof]] -int load_array_strategies() { - cst_add_const_to_header(`APPEND:(int)list->(int)list->(int)list`); - cst_add_strategy_folder_path(dirname(strdup(__FILE__))); - cst_add_strategy_to_header("array.strategies"); - return 0; -} diff --git a/tutorial/array.h b/tutorial/array.h index b7d93458a7b4b5072581a1bf41bd593bb992d028..d7de84bc9c060ae66f901e6df37a6dce825ec852 100644 --- a/tutorial/array.h +++ b/tutorial/array.h @@ -1,19 +1,4 @@ #pragma once -#include "userlib/operational/operational.h" -#require "userlib/operational/operational.c" - -PROOF -extern thm store_char_array_def; - -PROOF -extern thm store_undef_char_array_def; - -PROOF -extern thm store_undef_char_array_rec_def; - -PROOF -void divide_store_undef_char_array(term pt, term i, term n); - -PROOF -int load_array_strategies(void); +#include "array/lib/array.h" +#require "array/lib/array.c" diff --git a/tutorial/common.c b/tutorial/common.c index fb7597acf7362c26ffc999863f5c2f5d843de42c..15f39077fac1f48c645342b9e418a23002040cc6 100644 --- a/tutorial/common.c +++ b/tutorial/common.c @@ -1,7 +1,8 @@ #include "tutorial/common.h" PROOF thm typeof_def = new_fun_definition( - `typeof (v:int, ty:ctype) : bool = (min_of(ty) <= v && v <= max_of(ty))` + `typeof (v:int, ty:ctype) : bool = + (pmem_c_min ty <= v && v <= pmem_c_max ty)` ); PROOF term mk_simple_invariant(term inv) { @@ -32,14 +33,14 @@ PROOF term mk_simple_invariant(term inv) { term var_frame = list_mk_comb(`data_at`, TERM_LIST( - mk_var(name_addr, `:addr`), + mk_var(name_addr, `:int`), ty, var_v )); // should not fail if (IS_NULL(frame)) { frame = var_frame; } else { - frame = mk_binop(get_hconj(), var_frame, frame); // should not fail + frame = mk_binop(sl_sep(), var_frame, frame); // should not fail } } else { return empty_term; @@ -53,10 +54,10 @@ PROOF term mk_simple_invariant(term inv) { } } if (IS_NULL(pure)) { - pure = get_true_term(); + pure = mk_true(); } pure = subst(substs, pure); // should not fail - term ret = mk_binop(get_hconj(), mk_comb(get_hfact(), pure), + term ret = mk_binop(sl_sep(), mk_comb(sl_fact(), pure), frame); // should not fail term_list vs = (term_list)vector_create(); for (int i = 0; i < len; ++i) { diff --git a/tutorial/common.h b/tutorial/common.h index 0db86964bc486e7fc5922d3679f9911fe2c8dc4e..cfb53aeeb2e60355df695ce6af8f4243759ffe55 100644 --- a/tutorial/common.h +++ b/tutorial/common.h @@ -26,8 +26,9 @@ PROOF term mk_simple_invariant(term inv); // PROOF // void add_data_at_range_fact(term x, term ty, term v) { -// thm ent = ispecl_rule(TERM_LIST(x, ty, v), get_data_at_range()); -// ent = rewrite_rule(THM_LIST(get_min_of_def(), get_max_of_def()), ent); +// thm ent = ispecl_rule( +// TERM_LIST(x, ty, v), c_logic_current()->data_at_value_range); +// ent = rewrite_rule(THM_LIST(pmem_c_min_def, pmem_c_max_def), ent); // apply_hconv_st(ent); // } @@ -36,9 +37,9 @@ PROOF term mk_simple_invariant(term inv); // term goal_tm = `forall hp. emp |-- (hp -* hp)`; // GN root = GOAL_INIT(goal), g; // g = GEN_TACS(root); -// g = REWRITE_TAC(g, gsym_rule(get_hwand_hsep_adjoint())); +// g = REWRITE_TAC(g, gsym_rule(sl_wand_sep_adjoint())); // g = AUTO_FRAME_TAC(g); -// g = REWRITE_TAC(g, get_hentail_refl()); +// g = REWRITE_TAC(g, sl_ent_refl()); // thm solved_goal = GOAL_SOLVE(root); // return solved_goal; // } @@ -48,8 +49,8 @@ PROOF term mk_simple_invariant(term inv); // term goal_tm = `forall hp hq. (hp -* hq) ** hp |-- hq`; // GN root = GOAL_INIT(goal), g; // g = GEN_TACS(root); -// g = REWRITE_TAC(g, get_hwand_hsep_adjoint()); -// g = REWRITE_TAC(g, get_hentail_refl()); +// g = REWRITE_TAC(g, sl_wand_sep_adjoint()); +// g = REWRITE_TAC(g, sl_ent_refl()); // thm solved_goal = GOAL_SOLVE(root); // return solved_goal; // } diff --git a/userlib/README.md b/userlib/README.md index 0946e781020fdf2a8b547509ee20e4c0fe47270a..f7286d814f16bdfe91c866ed7e6f3812e1d05cab 100644 --- a/userlib/README.md +++ b/userlib/README.md @@ -3,6 +3,13 @@ `userlib/` contains reusable proof infrastructure above `cstar_stdlib` and below domain models and programs. +- `qcp/c_logic.{h,c}` is the session adapter between the proof stdlib and QCP. + Given one closed monomorphic ghost-cell RA, it installs the corresponding + physical-memory x ghost-heap assertion operators, publishes their derived + rules, and registers the exact assertion descriptor consumed by QCP. It is + an installer, not a second definition of the resource theory. +- `qcp/c_logic_default.{h,c}` is the default policy selecting `unit_ra` for C + files that do not request a custom ghost algebra. - `qcp/veriftime.{h,c}` owns the default QCP assertion boundary. It provides annotation macros plus the proof-facing symbolic-state getter and setter, including boolean-call normalization. @@ -28,3 +35,9 @@ toolchain and proof-engineering pitfalls are kept separately in Public headers may require lower-level implementation roots, but no file in this directory may require an example, migration, or domain implementation. Domain-specific list, array, tree, or allocator facts belong with that domain. + +General RA constructions, ghost heaps, and resource assertions are defined +only in `proof/theory/logic/`. C physical memory and the ghost-preserving C +update relation are defined only in `proof/theory/c_program_logic/`. Historical +user-side copies have been moved to `experimental/legacy_logic/`; active code +must not depend on them. diff --git a/userlib/operational/operational.c b/userlib/operational/operational.c index 0bf7c2d0c102ca350f3e2921a3d56c86470444f8..f9ea7e6c6c9d257f6f89512bd148f69bcb73c374 100644 --- a/userlib/operational/operational.c +++ b/userlib/operational/operational.c @@ -1,5 +1,10 @@ +#define CSTAR_DEFER_C_LOGIC_INSTALL + #include "userlib/operational/operational.h" +#include "userlib/qcp/c_logic.h" +#require "userlib/qcp/c_logic.c" + #include "userlib/qcp/veriftime.h" #require "userlib/qcp/veriftime.c" @@ -203,9 +208,11 @@ PROOF term_list symhp_facts(const term symhp) { } PROOF static term mk_imp_chain(const term_list premises, const term conclusion) { - term_list chain = (term_list)vector_copy(premises); - vector_add(&chain, conclusion); - return list_mk_binop(get_imp_op(), chain); + term result = conclusion; + for (size_t i = vector_size(premises); i > 0; --i) { + result = mk_imp(premises[i - 1], result); + } + return result; } /* Open only the branch-fact prefix of a closed implication chain, preserving @@ -993,12 +1000,38 @@ err: return empty_theorem; } +/* QCP gives the built-in C scalar constructors a target-side notation. A + * predicate that reaches a symbolic assertion must therefore already be + * specialized to one constructor, rather than retain a free `ctype` + * parameter. Keep this check next to the only public rule that manufactures + * a new `data_at`-derived fact from a caller-supplied type term. */ +PROOF static bool is_concrete_scalar_ctype(const term ty) { + if (!is_const(ty)) return false; + const char* name = dest_const(ty).s; + return strcmp(name, "Tchar") == 0 || strcmp(name, "Tuchar") == 0 || + strcmp(name, "Tshort") == 0 || + strcmp(name, "Tushort") == 0 || + strcmp(name, "Tint") == 0 || strcmp(name, "Tuint") == 0 || + strcmp(name, "Tint64") == 0 || strcmp(name, "Tuint64") == 0 || + strcmp(name, "Tptr") == 0; +} + PROOF thm add_data_at_range_hconv(const term address, const term ty, const term value) { + ENSURE_COND(is_concrete_scalar_ctype(ty), + "data_at range type `%s` must be specialized to a concrete " + "scalar ctype before entering a QCP assertion", + string_of_term(ty)); thm range_ent = ispecl_rule( - TERM_LIST(address, ty, value), get_data_at_range()); + TERM_LIST(address, ty, value), + c_logic_current()->data_at_value_range); return rewrite_rule( - THM_LIST(get_min_of_def(), get_max_of_def()), range_ent); + THM_LIST(pmem_c_min_def, pmem_c_max_def, pmem_ctype_distinct), + range_ent); +err: + ERR_FUN_PUTS("add_data_at_range_hconv", cstr_term(address), + cstr_term(ty), cstr_term(value)); + return empty_theorem; } /* Removes a vacuous outer SL-existential prefix while preserving every binder @@ -1016,9 +1049,11 @@ PROOF static thm prune_unused_exists_hconv(const term symhp) { string_of_term(symhp)); term inner_consequent = dest_sl_ent(concl(inner)).tm2; if (var_free_in(outer.v, inner_consequent)) { - return exists_mono_slrule(outer.v, inner); + thm retained = exists_mono_slrule(outer.v, inner); + return retained; } - return choose_slrule(outer.v, symhp, inner); + thm removed = choose_slrule(outer.v, symhp, inner); + return removed; err: ERR_FUN_PUTS("prune_unused_exists_hconv", cstr_term(symhp)); return empty_theorem; diff --git a/userlib/operational/operational.h b/userlib/operational/operational.h index 70fc6df72d93095de31229b49e7676f07f9274aa..d182f770b88b34840726e3ad6d54a0c6e706712d 100644 --- a/userlib/operational/operational.h +++ b/userlib/operational/operational.h @@ -1,17 +1,17 @@ -/* - * Operational reasoning: proof-producing, targeted transformations of - * symbolic states. +/** + * @file operational.h + * @brief Proof-producing, targeted transformations of symbolic states. * * The library keeps the proof state at a useful abstraction level by replacing * selected resources with an entailed local result and framing everything * else. The relevant theorem scopes are: * * ```text - * symhp = exists V. C1 ** ... ** Cm + * symhp = ∃SL V. C1 ** ... ** Cm * symst = symhp1 || ... || symhpn - * local_ent : A |- p1 ==> ... ==> pn ==> (L |-- R) - * symhp_ent : |- symhp |-- symhp' - * symst_ent : |- symst |-- symst' + * local_ent : 𝒜 ⊢ p1 ⇒ ... ⇒ pn ⇒ (L ⊢SL R) + * symhp_ent : ∅ ⊢ symhp ⊢SL symhp' + * symst_ent : ∅ ⊢ symst ⊢SL symst' * * local_ent --local_apply--> symhp_ent * --branch merge--> symst_ent @@ -37,6 +37,11 @@ * `operation_new` retains shallow vector copies plus the borrowed `name`. * See `userlib/operational/README.md` for the full model and examples. * + * Notation is uniform with the proof stdlib: `𝒜 ⊢ φ` is a HOL theorem + * judgment and `L ⊢SL R` is an object-level SL entailment. The hypotheses + * `𝒜` are reusable checked facts; the spatial antecedent `L` is the linear + * footprint consumed by the local rule. Raw HOL equality is written `=`. + * * Authors: Jinkai Fan, Yiyuan Cao * Last updated: 2026-07-20 */ @@ -70,28 +75,6 @@ PROOF typedef struct match_env { term_pair_list deferred; /* `(expected, candidate)` `DEFER` pairs. */ } match_env; -/*------------------------ IDE value printers ------------------------*/ - -/** - * Compact `cstarc --lsp` rendering of an operation schema. - * - * The closed lemma is represented by its availability rather than expanded: - * its conclusion repeats the consume/fact/produce fields, while printing every - * global operation theorem would make scope dumps unnecessarily large. - */ -PROOF static inline char *cst_string_of_operation(const operation op) { - char *name = op.name == NULL ? "" : cstr_string(op.name); - char *inputs = op.inputs == NULL ? "" : cstr_term_list(op.inputs); - char *consumes = op.consumes == NULL ? "" : cstr_term_list(op.consumes); - char *facts = op.facts == NULL ? "" : cstr_term_list(op.facts); - char *produce = IS_NULL(op.produce) ? "" : cstr_term(op.produce); - char *lemma = IS_NULL(op.lemma) ? "" : ""; - return gc_sprintf( - "operation{name=%s, inputs=%s, consumes=%s, facts=%s, produce=%s, " - "lemma=%s}", - name, inputs, consumes, facts, produce, lemma); -} - /** Complete `cstarc --lsp` rendering of accumulated matching evidence. */ PROOF static inline char *cst_string_of_match_env(const match_env env) { char *bindings = @@ -152,8 +135,8 @@ PROOF bool match_pattern(match_env *env, const term pattern, * supplied term rather than reconstructing it. * * ```text - * !FV. fact1 ==> ... ==> factN ==> - * (erase(consume1) ** ... ** erase(consumeM) |-- produce) + * ∀FV. fact1 ⇒ ... ⇒ factN ⇒ + * (erase(consume1) ** ... ** erase(consumeM) ⊢SL produce) * ``` * * The callback must return a closed theorem with an alpha-equivalent @@ -161,6 +144,10 @@ PROOF bool match_pattern(match_env *env, const term pattern, * The three input vectors are shallow-copied; later mutation of their * containers cannot change the operation. `name` is retained by pointer and * must outlive it. + * + * On failure the returned shallow record is an unusable sentinel whose + * `lemma` is `empty_theorem`; proof error status is set. Callers must propagate + * that error immediately and must not register, match, or apply the sentinel. */ PROOF operation operation_new(const char *name, const term_list inputs, const term_list consumes, const term_list facts, @@ -212,11 +199,11 @@ PROOF bool operation_patterns_match(const operation op, const term symhp, * Marker equalities are consumed occurrence by occurrence in one left-to-right * structural traversal; equal marker terms may align with different resources. * For every required premise `r`, the implementation forms the single VC - * `f1 ==> ... ==> fn ==> r` from all top-level branch facts. It speculatively + * `f1 ⇒ ... ⇒ fn ⇒ r` from all top-level branch facts. It speculatively * tries propositional and integer-arithmetic proof rules; only an unsolved VC * becomes a tracked obligation. * - * The result has the shape `A |- selected |-- produced`, where `A` retains the + * The result has the shape `𝒜 ⊢ selected ⊢SL produced`, where `𝒜` retains the * branch-fact context supplied to required-premise proofs and need not be * minimal. Untouched resources are absent from this `local_ent`; * `branches_hconv` frames them later. This function never commits state. @@ -249,7 +236,7 @@ PROOF term_list symhp_facts(const term symhp); /** * Constructs one local entailment that adds all proved facts. * - * Every theorem is undischarged from `A_i |- p_i` and contributes + * Every theorem is undischarged from `𝒜_i ⊢ p_i` and contributes * `fact(p_i)` to the consequent. The result has an empty local footprint and * the union of the `A_i` as checked facts. An empty list is the identity on * `emp`. @@ -268,8 +255,11 @@ PROOF thm add_conjuncts_hconv(const thm conjunctive_theorem); /** * Builds the preserving local entailment that exposes the representable range - * of one exact `data_at(address, type, value)` resource. `min_of` and `max_of` - * are unfolded so concrete C types yield arithmetic bounds. + * of one exact `data_at(address, type, value)` resource. `type` must be one + * closed scalar constructor (`Tchar`, ..., `Tptr`): predicates that enter a + * QCP assertion are deliberately rejected until their `ctype` argument has + * been specialized. `min_of` and `max_of` are then unfolded to arithmetic + * bounds. */ PROOF thm add_data_at_range_hconv(const term address, const term ty, const term value); @@ -277,7 +267,7 @@ PROOF thm add_data_at_range_hconv(const term address, const term ty, /** * Constructs a `local_ent` that forgets every top-level occurrence * alpha-equivalent to `fact(proposition)` in the opened branch body. If none is - * present, it returns `emp |-- emp`; the caller may frame the whole branch with + * present, it returns `emp ⊢SL emp`; the caller may frame the whole branch with * `local_apply`. No rewriting, theorem instantiation, or inference participates * in occurrence selection. The state-changing form additionally prunes * vacuous outer existentials after applying this local entailment. @@ -285,7 +275,7 @@ PROOF thm add_data_at_range_hconv(const term address, const term ty, PROOF thm forget_fact_hconv(const term symhp, const term proposition); /** - * Records `Facts(branch) ==> proposition` as one tracked obligation and returns + * Records `Facts(branch) ⇒ proposition` as one tracked obligation and returns * the corresponding local fact-introduction entailment. It does not commit * state, but obligation registration is an immediate external side effect. */ @@ -302,7 +292,7 @@ PROOF thm assume_fact_hconv(const term symhp, const term proposition); * converted at most once. * * The conversion receives the complete conjunct and must prove - * `A |- selected = replacement`, with an alpha-equivalent left side and an SL + * `𝒜 ⊢ selected = replacement`, with an alpha-equivalent left side and an SL * assertion on the right. All selected conversions are computed from the * original branch and combined simultaneously. The library adds no obligation * fallback; conversion hypotheses remain checked facts. @@ -325,11 +315,11 @@ PROOF thm convert_conjuncts_hconv(const term symhp, const conv conversion, * form: * * ```text - * body |-- exists variable. + * body ⊢SL exists variable. * fact(variable = term) ** abbreviated_body * ``` * - * If no occurrence is found, the result is `emp |-- emp` and introduces no + * If no occurrence is found, the result is `emp ⊢SL emp` and introduces no * existential; `local_apply` later frames the complete branch. This builder * creates no obligation and commits no state. Explicit `emp` and `fact(T)` * units need not be retained. @@ -351,7 +341,7 @@ PROOF thm abbrev_hconv(const term symhp, const term equation); * Candidate-equality branch-fact hypotheses remain for `local_apply` to check. * Multiple patterns selecting the same target are harmless; conflicting * targets for one conjunct are a contract error. An empty pattern list or no - * match returns `emp |-- emp` and introduces no existential; `local_apply` + * match returns `emp ⊢SL emp` and introduces no existential; `local_apply` * later frames the complete branch. */ PROOF thm abbrev_occurrences_hconv(const term symhp, const term equation, @@ -404,7 +394,10 @@ PROOF thm substitute_fact_hconv(const term symhp, const term equation); * `local_ent`, because the transformation may remove now-vacuous outer SL * existentials. It still prunes such binders when no defining fact exists. * Nonmatching conjuncts and necessary binders are preserved modulo SL units. - * No obligation is created and no state is committed. + * Existential monotonicity/elimination rules return endpoints exact modulo + * alpha-equivalence, so this transformation performs no generic beta + * normalization. Caller-owned redexes in the antecedent or consequent are + * retained. No obligation is created and no state is committed. */ PROOF thm eliminate_eq_facts_hconv(const term symhp, const term_list protected_variables); @@ -511,8 +504,8 @@ PROOF void apply_hconv_st(const thm theorem); /** * Adds the conclusion of every supplied theorem as a fact in every branch. * - * Each theorem is fully undischarged to `A |- p`; `p` must be Boolean and is - * added as `fact(p)` without splitting conjunctions. Every proposition in `A` + * Each theorem is fully undischarged to `𝒜 ⊢ p`; `p` must be Boolean and is + * added as `fact(p)` without splitting conjunctions. Every proposition in `𝒜` * must already occur as an alpha-equivalent top-level fact in each branch; the * checked occurrences and all spatial resources are preserved. Existing * copies of `fact(p)` do not suppress a new copy. An empty theorem list is an @@ -524,8 +517,8 @@ PROOF void add_facts_st(const thm_list fact_theorems); /** * Adds one proved proposition as a fact in every branch. * - * The theorem is fully undischarged to `A |- p`. Each branch must contain an - * alpha-equivalent top-level `fact(a)` for every `a` in `A`; those facts and + * The theorem is fully undischarged to `𝒜 ⊢ p`. Each branch must contain an + * alpha-equivalent top-level `fact(a)` for every `a` in `𝒜`; those facts and * all spatial resources are preserved, then `fact(p)` is added. A conjunctive * `p` remains one fact. No obligation is created, and the update is committed * only if the theorem is valid and every branch supplies its checked facts. @@ -549,10 +542,12 @@ PROOF void add_conjuncts_st(const thm conjunctive_theorem); * * Each branch must contain an exact top-level * `data_at(address,ty,value)`. That cell is preserved and accompanied by - * `fact(min_of ty <= value && value <= max_of ty)`; `min_of` and `max_of` are - * unfolded so concrete C types produce arithmetic bounds. Other resources and - * outer existentials are framed. No obligation is created, and a missing cell - * in any branch prevents the commit. + * `fact(min_of ty <= value && value <= max_of ty)`. `ty` must be one closed + * scalar constructor (`Tchar`, ..., `Tptr`); a free or computed `ctype` is + * rejected before the assertion reaches QCP. `min_of` and `max_of` are then + * unfolded to arithmetic bounds. Other resources and outer existentials are + * framed. No obligation is created, and a missing cell in any branch prevents + * the commit. */ PROOF void add_data_at_range_st(const term address, const term ty, const term value); @@ -572,7 +567,7 @@ PROOF void forget_fact_st(const term proposition); * Assumes one proposition separately in every branch. * * For a branch with top-level fact propositions `f1,...,fn`, the function - * records `f1 ==> ... ==> fn ==> proposition` as one tracked obligation and + * records `f1 ⇒ ... ⇒ fn ⇒ proposition` as one tracked obligation and * adds `fact(proposition)` while preserving the branch. Thus an n-branch state * creates n obligations, even when some formulas coincide. The obligations * are registered before the single state commit and are not rolled back if a @@ -587,9 +582,9 @@ PROOF void assume_fact_st(const term proposition); * all remaining syntax is rigid modulo alpha-equivalence, and a non-lambda * pattern is exact. Each matching conjunct is converted at most once. The * conversion receives the complete original conjunct and must prove - * `A |- selected = replacement`, with an alpha-equivalent left side and an SL + * `𝒜 ⊢ selected = replacement`, with an alpha-equivalent left side and an SL * assertion on the right. All replacements in a branch are computed from its - * original body and installed simultaneously. Every proposition in `A` must + * original body and installed simultaneously. Every proposition in `𝒜` must * occur as a top-level branch fact; unmatched resources and outer existentials * are preserved. An empty pattern list or no match is a successful no-op. No * obligation fallback is provided. Use `simp_conv(rules)` when conditional or @@ -620,7 +615,7 @@ PROOF void abbrev_st(const term equation); * replace, while all other syntax is rigid modulo alpha-equivalence. For every * selected candidate `a`, the transformer tries alpha-equivalence, `solve_eq`, * then that branch's facts to prove `a = t`; failure records - * `f1 ==> ... ==> fn ==> a = t` using all top-level facts of that branch. + * `f1 ⇒ ... ⇒ fn ⇒ a = t` using all top-level facts of that branch. * Alpha-equivalent candidates share one proof or obligation within a branch. * Only selected paths are replaced, and a changed branch gains * `exists v. fact(v = t) ** abbreviated_body`. Duplicate selectors with the @@ -661,7 +656,7 @@ PROOF void rename_hexists_raw_st(const term_list existential_names); * [y/x] [x/y] * * (exists x y. B x y) || (exists x. C x) - * |-- + * ⊢SL * (exists y x. B y x) || (exists y. C y) * ``` */ @@ -678,7 +673,7 @@ PROOF void rename_hexists_st(const char *renaming_pattern); * `x__pre`, the transformer produces: * * ```text - * exists x_v. fact(x_v == value) ** data_at(x__addr,ctype,x_v) + * ∃x_v. fact(x_v = value) ** data_at(x__addr,ctype,x_v) * ``` * * Other resources and existing outer existentials are framed. The old `x_v` @@ -770,7 +765,7 @@ PROOF void rewrite_st(const thm_list rules); * Proves and adds the same fact independently in every branch. * * For branch facts `f1,...,fn`, the proof goal is - * `f1 ==> ... ==> fn ==> goal_tm`. After introducing those facts and any + * `f1 ⇒ ... ⇒ fn ⇒ goal_tm`. After introducing those facts and any * leading binders or implications belonging to `goal_tm`, `builder` receives * `additional_theorems` followed by assumption theorems for the current proof * context. Its conversion must close the residual goal, normally by proving it diff --git a/userlib/operational/proof_patterns.c b/userlib/operational/proof_patterns.c index dc69fec42de7416a13914fefd3c96418af51a20c..33c005c46dcd05b395d887df695089bd26865460 100644 --- a/userlib/operational/proof_patterns.c +++ b/userlib/operational/proof_patterns.c @@ -5,15 +5,21 @@ PROOF thm prove_operation_by_entailment( gnode root = gnode_new_with_ccl(goal_tm); gnode g = AUTO_INTROS_TAC(root); ACCEPT_TAC(g, local_ent); - return gnode_prove(root); + thm result = gnode_prove(root); + return result; } PROOF static thm open_closed_rule(const thm closed_rule) { ENSURE_COND(!IS_NULL(closed_rule), "Closed rule is empty"); - ENSURE_COND(vector_size(hyp(closed_rule)) == 0, + term_list assumptions = hyp(closed_rule); + size_t assumption_count = vector_size(assumptions); + char *closed_rule_text = string_of_thm(closed_rule); + ENSURE_COND(assumption_count == 0, "Rule(`%s`) has hypotheses", - string_of_thm(closed_rule)); - return undisch_all_rule(spec_all_rule(closed_rule)); + closed_rule_text); + thm specialized = spec_all_rule(closed_rule); + thm opened = undisch_all_rule(specialized); + return opened; err: ERR_FUN_PUTS("open_closed_rule", cstr_thm(closed_rule)); return empty_theorem; @@ -21,22 +27,26 @@ err: PROOF thm prove_operation_by_closed_rule( const term goal_tm, const thm closed_rule) { - return prove_operation_by_entailment( - goal_tm, open_closed_rule(closed_rule)); + thm opened = open_closed_rule(closed_rule); + thm result = prove_operation_by_entailment(goal_tm, opened); + return result; } PROOF thm prove_open_view_operation( - const term goal_tm, const thm closed_view_law) { + const term goal_tm, const thm closed_view_law) { thm view = open_closed_rule(closed_view_law); - return prove_operation_by_entailment( - goal_tm, eq2ent(view)); + thm entailment = eq2ent(view); + thm result = prove_operation_by_entailment(goal_tm, entailment); + return result; } PROOF thm prove_close_view_operation( - const term goal_tm, const thm closed_view_law) { + const term goal_tm, const thm closed_view_law) { thm view = open_closed_rule(closed_view_law); - return prove_operation_by_entailment( - goal_tm, eq2ent(sym_rule(view))); + thm reverse_view = sym_rule(view); + thm entailment = eq2ent(reverse_view); + thm result = prove_operation_by_entailment(goal_tm, entailment); + return result; } PROOF thm list_conj_rule(const thm_list conjuncts) { @@ -55,14 +65,16 @@ err: PROOF static void collect_matching_conjuncts( const thm node, const term expected, thm *found, size_t *match_count) { - if (is_conj(concl(node))) { - collect_matching_conjuncts( - conjunct1_rule(node), expected, found, match_count); - collect_matching_conjuncts( - conjunct2_rule(node), expected, found, match_count); + term node_conclusion = concl(node); + if (is_conj(node_conclusion)) { + thm left = conjunct1_rule(node); + collect_matching_conjuncts(left, expected, found, match_count); + thm right = conjunct2_rule(node); + collect_matching_conjuncts(right, expected, found, match_count); return; } - if (alpha_compare(concl(node), expected) == 0) { + int comparison = alpha_compare(node_conclusion, expected); + if (comparison == 0) { *found = node; *match_count = *match_count + 1; } @@ -75,10 +87,11 @@ PROOF thm find_conjunct_rule( size_t match_count = 0; collect_matching_conjuncts( conjunction, expected_conclusion, &found, &match_count); + char *expected_text = string_of_term(expected_conclusion); + char *conjunction_text = string_of_thm(conjunction); ENSURE_COND(match_count == 1, "Expected exactly one `%s` conjunct, found %zu in `%s`", - string_of_term(expected_conclusion), match_count, - string_of_thm(conjunction)); + expected_text, match_count, conjunction_text); return found; err: ERR_FUN_PUTS("find_conjunct_rule", cstr_thm(conjunction), @@ -89,26 +102,36 @@ err: PROOF thm fact_transition_slrule(const thm closed_rule) { thm opened = open_closed_rule(closed_rule); term result_fact = concl(opened); - ENSURE_COND(is_bool_type(type_of(result_fact)), + type result_type = type_of(result_fact); + bool result_is_bool = is_bool_type(result_type); + char *closed_rule_text = string_of_thm(closed_rule); + ENSURE_COND(result_is_bool, "Rule(`%s`) does not conclude a boolean proposition", - string_of_thm(closed_rule)); + closed_rule_text); - term_list premises = (term_list)vector_copy(hyp(opened)); + term_list opened_hypotheses = hyp(opened); + term_list premises = (term_list)vector_copy(opened_hypotheses); term_list spatial_premises = (term_list)vector_create(); - thm transition = intro_fact_slrule( - opened, refl_slrule(sl_emp())); - for (size_t i = 0; i < vector_size(premises); ++i) { - ENSURE_COND(is_bool_type(type_of(premises[i])), + term emp = sl_emp(); + thm emp_refl = refl_slrule(emp); + thm transition = intro_fact_slrule(opened, emp_refl); + size_t premise_count = vector_size(premises); + for (size_t i = 0; i < premise_count; ++i) { + type premise_type = type_of(premises[i]); + bool premise_is_bool = is_bool_type(premise_type); + char *premise_text = string_of_term(premises[i]); + ENSURE_COND(premise_is_bool, "Rule premise(`%s`) is not boolean", - string_of_term(premises[i])); - vector_add(&spatial_premises, mk_sl_fact(premises[i])); + premise_text); + term spatial_premise = mk_sl_fact(premises[i]); + vector_add(&spatial_premises, spatial_premise); transition = elim_fact_slrule(premises[i], transition); } - transition = rehant_slrule( - transition, list_mk_sl_sep(spatial_premises)); - transition = rehcon_slrule( - transition, mk_sl_fact(result_fact)); + term spatial_antecedent = list_mk_sl_sep(spatial_premises); + transition = rehant_slrule(transition, spatial_antecedent); + term spatial_result = mk_sl_fact(result_fact); + transition = rehcon_slrule(transition, spatial_result); return transition; err: ERR_FUN_PUTS("fact_transition_slrule", cstr_thm(closed_rule)); @@ -117,15 +140,19 @@ err: PROOF thm prove_fact_transition_operation( const term goal_tm, const thm closed_rule) { - return prove_operation_by_entailment( - goal_tm, fact_transition_slrule(closed_rule)); + thm transition = fact_transition_slrule(closed_rule); + thm result = prove_operation_by_entailment(goal_tm, transition); + return result; } PROOF thm prove_definitional_law( const term goal_tm, const thm definition) { gnode root = gnode_new_with_ccl(goal_tm); - CONV_TAC(root, rewrite_conv(THM_LIST(definition))); - return gnode_prove(root); + thm_list definitions = THM_LIST(definition); + conv unfold = rewrite_conv(definitions); + CONV_TAC(root, unfold); + thm result = gnode_prove(root); + return result; } PROOF int audit_closed_proof_unit( @@ -134,10 +161,14 @@ PROOF int audit_closed_proof_unit( for (size_t i = 0; i < vector_size(published); ++i) { ENSURE_COND(!IS_NULL(published[i]), "%s theorem %zu is empty", unit_name, i); - ENSURE_COND(vector_size(hyp(published[i])) == 0, + term_list assumptions = hyp(published[i]); + size_t assumption_count = vector_size(assumptions); + ENSURE_COND(assumption_count == 0, "%s theorem %zu has hypotheses", unit_name, i); } - ENSURE_COND(vector_size(get_all_axioms()) == axioms_before, + thm_list current_axioms = get_all_axioms(); + size_t current_axiom_count = vector_size(current_axioms); + ENSURE_COND(current_axiom_count == axioms_before, "%s introduced an axiom", unit_name); return 0; err: @@ -145,29 +176,43 @@ err: return -1; } -PROOF static int audit_proof_patterns(void) { - size_t axioms_before = vector_size(get_all_axioms()); - - thm conjunction = list_conj_rule(THM_LIST( - refl_rule(`0i:int`), refl_rule(`1i:int`), refl_rule(`2i:int`))); - thm selected = find_conjunct_rule( - conjunction, concl(refl_rule(`1i:int`))); - ENSURE_COND(equals_term(concl(selected), concl(refl_rule(`1i:int`))), +PROOF int proof_patterns_smoke_test(void) { + thm_list initial_axioms = get_all_axioms(); + size_t axioms_before = vector_size(initial_axioms); + + thm zero_refl = refl_rule(`0i:int`); + thm one_refl = refl_rule(`1i:int`); + thm two_refl = refl_rule(`2i:int`); + thm_list conjuncts = THM_LIST(zero_refl, one_refl, two_refl); + thm conjunction = list_conj_rule(conjuncts); + term expected_conclusion = concl(one_refl); + thm selected = find_conjunct_rule(conjunction, expected_conclusion); + term selected_conclusion = concl(selected); + bool selected_expected = equals_term(selected_conclusion, expected_conclusion); + ENSURE_COND(selected_expected, "Conjunction lookup selected the wrong theorem"); - thm transition = fact_transition_slrule(int_arith_rule(` + thm arithmetic = int_arith_rule(` forall n:int. 0i <= n ==> 0i < n + 1i - `)); - ENSURE_COND(!IS_NULL(transition) && - vector_size(hyp(transition)) == 0 && - is_sl_ent(concl(transition)), + `); + thm transition = fact_transition_slrule(arithmetic); + ENSURE_COND(!IS_NULL(transition), + "Fact transition is empty"); + term_list transition_assumptions = hyp(transition); + size_t transition_assumption_count = vector_size(transition_assumptions); + term transition_conclusion = concl(transition); + bool transition_is_entailment = is_sl_ent(transition_conclusion); + bool transition_is_closed_entailment = + transition_assumption_count == 0 && + transition_is_entailment; + ENSURE_COND(transition_is_closed_entailment, "Fact transition is not a closed SL entailment"); - ENSURE_COND(vector_size(get_all_axioms()) == axioms_before, + thm_list current_axioms = get_all_axioms(); + size_t current_axiom_count = vector_size(current_axioms); + ENSURE_COND(current_axiom_count == axioms_before, "Proof-pattern audit introduced an axiom"); return 0; err: - ERR_FUN_PUTS("audit_proof_patterns"); + ERR_FUN_PUTS("proof_patterns_smoke_test"); return -1; } - -PROOF static int _PROOF_PATTERNS_AUDIT = audit_proof_patterns(); diff --git a/userlib/operational/proof_patterns.h b/userlib/operational/proof_patterns.h index 95df0a46e029ffc2ed458c3960bb962b535efbcb..c1ecace328514f872d172da1dedd6a8b6c026f95 100644 --- a/userlib/operational/proof_patterns.h +++ b/userlib/operational/proof_patterns.h @@ -1,14 +1,15 @@ -/* - * Reusable proof-driver patterns for proof-specification-implementation units. +/** + * @file proof_patterns.h + * @brief Reusable proof drivers for proof-specification-implementation units. * * These helpers package recurring theorem plumbing without choosing a domain * model, a footprint, or an invariant. Callers still supply the local theorem * that justifies each transformation. The relevant theorem scopes are: * * ```text - * local_ent : A |- p1 ==> ... ==> pn ==> (L |-- R) - * symhp_ent : |- symhp |-- symhp' - * symst_ent : |- symst |-- symst' + * local_ent : 𝒜 ⊢ p1 ⇒ ... ⇒ pn ⇒ (L ⊢SL R) + * symhp_ent : ∅ ⊢ symhp ⊢SL symhp' + * symst_ent : ∅ ⊢ symst ⊢SL symst' * ``` * * Operation-proof helpers construct the closed theorem required by an @@ -32,9 +33,9 @@ * For the usual operation goal, the proof step is: * * ```text - * local_ent : A |- L |-- R A is available after introducing p1,...,pn + * local_ent : 𝒜 ⊢ L ⊢SL R 𝒜 is available after introducing p1,...,pn * ----------------------------------------------------------------------- - * |- !xs. p1 ==> ... ==> pn ==> (L |-- R) + * ∅ ⊢ ∀xs. p1 ⇒ ... ⇒ pn ⇒ (L ⊢SL R) * ``` * * The theorem hypotheses must occur modulo alpha-equivalence among the @@ -54,9 +55,9 @@ PROOF thm prove_operation_by_entailment(const term goal_tm, * `prove_operation_by_entailment`. * * ```text - * closed_rule : |- !xs. p1 ==> ... ==> pn ==> (L |-- R) + * closed_rule : ∅ ⊢ ∀xs. p1 ⇒ ... ⇒ pn ⇒ (L ⊢SL R) * ---------------------------------------------------------------- - * |- callback goal supplied by operation_new + * ∅ ⊢ callback goal supplied by operation_new * ``` * * The opened rule must already agree with the callback goal modulo @@ -70,7 +71,7 @@ PROOF thm prove_operation_by_closed_rule(const term goal_tm, * * After specializing outer quantifiers and undischarging leading implications, * `closed_view_law` must conclude `P = body` for SL assertions. The equation is - * converted to the local entailment `P |-- body` and used to close `goal_tm`. + * converted to the local entailment `P ⊢SL body` and used to close `goal_tm`. */ PROOF thm prove_open_view_operation(const term goal_tm, const thm closed_view_law); @@ -79,7 +80,7 @@ PROOF thm prove_open_view_operation(const term goal_tm, * Prove a closing operation from a closed representation equation. * * This is the reverse-direction counterpart of `prove_open_view_operation`: - * an opened equation `P = body` is converted to `body |-- P` before it is used + * an opened equation `P = body` is converted to `body ⊢SL P` before it is used * to close `goal_tm`. */ PROOF thm prove_close_view_operation(const term goal_tm, @@ -89,9 +90,9 @@ PROOF thm prove_close_view_operation(const term goal_tm, * Combine a nonempty theorem list into a right-associated conjunction. * * ```text - * A1 |- p1 A2 |- p2 ... An |- pn + * 𝒜1 ⊢ p1 𝒜2 ⊢ p2 ... 𝒜n ⊢ pn * ------------------------------------------------ - * A1 union ... union An |- p1 /\ (p2 /\ ... /\ pn) + * 𝒜1 ∪ ... ∪ 𝒜n ⊢ p1 ∧ (p2 ∧ ... ∧ pn) * ``` * * Input order is preserved. A singleton list returns its sole theorem; an @@ -119,9 +120,9 @@ PROOF thm find_conjunct_rule(const thm conjunction, * result is the closed spatial transition: * * ```text - * closed_rule : |- !xs. p1 ==> ... ==> pn ==> q + * closed_rule : ∅ ⊢ ∀xs. p1 ⇒ ... ⇒ pn ⇒ q * ------------------------------------------------------------- - * |- fact(p1) ** ... ** fact(pn) |-- fact(q) + * ∅ ⊢ fact(p1) ** ... ** fact(pn) ⊢SL fact(q) * ``` * * The antecedent order follows the opened theorem's hypothesis order. With no @@ -166,3 +167,14 @@ PROOF thm prove_definitional_law(const term goal_tm, const thm definition); PROOF int audit_closed_proof_unit(const char *unit_name, const size_t axioms_before, const thm_list published); + +/** + * Exercise the generic proof-pattern helpers without changing global theory. + * + * The smoke test checks conjunction construction/selection, conversion of a + * closed arithmetic implication into an SL fact transition, closure of the + * resulting theorem, and preservation of the HOL axiom baseline. It must be + * called explicitly after the client has installed its selected SL assertion + * theory. The function returns `0` on success and `-1` after a proof error. + */ +PROOF int proof_patterns_smoke_test(void); diff --git a/userlib/proof/tactics.h b/userlib/proof/tactics.h index 2968f29dff9f0ac855e80397199b4cbe1b67bde6..3ed7967719c6f2f851ae1d7278e65848c6483357 100644 --- a/userlib/proof/tactics.h +++ b/userlib/proof/tactics.h @@ -1,6 +1,8 @@ -/* - * Small user-side convenience tactics built from validated cstar_stdlib - * tactics and HOL inference rules. They add controlled theorem search, not a +/** + * @file tactics.h + * @brief Small user-side tactics built from validated proof-stdlib rules. + * + * These tactics and HOL inference rules add controlled theorem search, not a * new trust boundary: every successful call closes its goal with a theorem * accepted by ACCEPT_TAC. */ @@ -19,10 +21,10 @@ * goal's ordinary assumption context. * * ```text - * A |- forall x1 ... xn. p pθ ≡α q - * A is available in Γ + * 𝒜 ⊢ ∀x1 ... xn. p pθ ≡α q + * 𝒜 is available in Γ * ------------------------------------------------ MATCH_ACCEPT_TAC - * [Γ ?|- forall y1 ... ym. q] -> [] + * [Γ ?⊢ ∀y1 ... ym. q] → [] * ``` * * Matching specializes outer theorem quantifiers and schematic variables, diff --git a/userlib/qcp/c_logic.c b/userlib/qcp/c_logic.c new file mode 100644 index 0000000000000000000000000000000000000000..2fd3255846f4ce3f809c3bb1437e91f5ee0922dd --- /dev/null +++ b/userlib/qcp/c_logic.c @@ -0,0 +1,818 @@ +#define CST_C_LOGIC_DESCRIPTOR_INPUT_DECLARED +#define CST_C_LOGIC_DESCRIPTOR_NO_INSTALL_DECL + +#include "userlib/qcp/c_logic.h" + +#include "proof/adapter/ra_sl_scope_internal.h" +#require "proof/adapter/ra_sl_scope.c" +#require "proof/theory/c_program_logic/c_basic_update.c" +#require "proof/theory/c_program_logic/c_fnspec.c" +#require "proof/theory/c_program_logic/c_ghost.c" +#require "proof/theory/c_program_logic/c_memory.c" + +/* C* parser shadow of the structured native ABI from c_logic_descriptor.h. The + * preprocessor guards above make this the sole definition in generated C. */ +PROOF typedef struct cst_certified_alias { + term alias; + thm definition; +} cst_certified_alias; + +PROOF typedef struct cst_c_logic_descriptor_input { + size_t struct_size; + unsigned int abi_version; + + term ghost_ra; + term resource_ra; + type prop_type; + + cst_certified_alias emp; + cst_certified_alias sep; + cst_certified_alias wand; + cst_certified_alias and_op; + cst_certified_alias or_op; + cst_certified_alias exists_op; + cst_certified_alias entails; + cst_certified_alias equiv; + cst_certified_alias fact; + cst_certified_alias pure; + cst_certified_alias bupd; + cst_certified_alias viewshift; + cst_certified_alias fnspec; + cst_certified_alias fnspec_w; + + cst_certified_alias data_at; + cst_certified_alias undef_data_at; + + thm sep_emp_left; + thm sep_emp_right; + thm fact_true_emp; + thm sep_assoc; + thm sep_comm; +} cst_c_logic_descriptor_input; +PROOF extern int cst_install_c_logic_descriptor( + const cst_c_logic_descriptor_input* input); +PROOF extern int cst_add_const_to_header(term tm); + +/* A verification session contains exactly one installed C logic. HOL + * checkpoint/restore removes this fixed namespace before the next session. */ +PROOF static const char* C_LOGIC_ALIAS_SCOPE = "c_logic"; + +/* Published only after the complete installer succeeds. */ +PROOF static c_logic_scope active_c_logic; +PROOF static bool active_c_logic_installed = false; + +PROOF const c_logic_scope* c_logic_current(void) { + ENSURE_COND(active_c_logic_installed, + "C logic has not been installed in this verification session"); + return &active_c_logic; +err: + ERR_FUN_PUTS("c_logic_current"); + return &active_c_logic; +} + +/** Specialize the unary polymorphic constant `name` to argument `arg`. */ +PROOF static term c_logic_specialize(const char* name, const term arg) { + ENSURE_COND(name != NULL, "constant name must not be null"); + ENSURE_COND(!IS_NULL(arg), "specialization argument must not be empty"); + type generic_type = get_const_type(name); + term generic_head = mk_const(name, generic_type); + term result = mk_icomb(generic_head, arg); + return result; +err: + ERR_FUN_PUTS("c_logic_specialize", cstr_string(name), cstr_term(arg)); + return empty_term; +} + +/** Instantiate the single free RA parameter of a function definition. */ +PROOF static thm c_logic_select_ra_definition( + const thm definition, const term G) { + ENSURE_COND(!IS_NULL(definition), "definition must not be empty"); + ENSURE_COND(!IS_NULL(G), "selected RA must not be empty"); + term_list parameters = free_vars(concl(definition)); + ENSURE_COND(vector_size(parameters) == 1, + "selected definition must have one free RA parameter"); + instantiation selection = term_match( + empty_list(term), parameters[0], G); + return instantiate_rule(selection, definition); +err: + ERR_FUN_PUTS( + "c_logic_select_ra_definition", + IS_NULL(definition) ? cstr_string("") : cstr_thm(definition), + IS_NULL(G) ? cstr_string("") : cstr_term(G)); + return empty_theorem; +} + +/** Fold one selected C update law to the resource and modality aliases. */ +PROOF static thm c_logic_fold_update( + const ra_sl_scope* scope, + const thm bupd_def, + const thm viewshift_def, + const thm direct_rule) { + ENSURE_COND(scope != NULL, "resource scope must not be null"); + ENSURE_COND(!IS_NULL(bupd_def) && !IS_NULL(viewshift_def), + "C update alias definitions must not be empty"); + ENSURE_COND(!IS_NULL(direct_rule), "direct C update rule must not be empty"); + + thm resource_rule = ra_sl_scope_fold(scope, direct_rule); + thm bupd_fold = gsym_rule(bupd_def); + thm viewshift_fold = gsym_rule(viewshift_def); + thm_list modality_folds = THM_LIST(bupd_fold, viewshift_fold); + thm result = pure_rewrite_rule(modality_folds, resource_rule); + return result; +err: + ERR_FUN_PUTS("c_logic_fold_update", cstr_thm(direct_rule)); + return empty_theorem; +} + +/** Specialize one generic C update law and fold it to installed aliases. */ +PROOF static thm c_logic_fold_selected_update( + const ra_sl_scope* scope, + const thm bupd_def, + const thm viewshift_def, + const term G, + const thm generic_rule) { + ENSURE_COND(scope != NULL, "resource scope must not be null"); + ENSURE_COND(!IS_NULL(bupd_def) && !IS_NULL(viewshift_def), + "C update alias definitions must not be empty"); + ENSURE_COND(!IS_NULL(G), "selected global ghost RA must not be empty"); + ENSURE_COND(!IS_NULL(generic_rule), + "generic C update rule must not be empty"); + + thm selected = ispecl_rule(TERM_LIST(`mem_ra`, G), generic_rule); + selected = pure_rewrite_rule( + THM_LIST( + gsym_rule(c_logic_select_ra_definition(c_resource_ra_def, G)), + gsym_rule(c_logic_select_ra_definition(c_bupd_def, G)), + gsym_rule(c_logic_select_ra_definition(c_viewshift_def, G))), + selected); + thm result = c_logic_fold_update( + scope, bupd_def, viewshift_def, selected); + return result; +err: + ERR_FUN_PUTS( + "c_logic_fold_selected_update", + IS_NULL(G) ? cstr_string("") : cstr_term(G), + IS_NULL(generic_rule) ? cstr_string("") + : cstr_thm(generic_rule)); + return empty_theorem; +} + +/** Select and fold one generic C ghost protocol rule to installed aliases. */ +PROOF static thm c_logic_fold_ghost_protocol( + const ra_sl_scope* scope, + const thm bupd_def, + const thm viewshift_def, + const thm own_def, + const term G, + const thm generic_rule) { + ENSURE_COND(scope != NULL, "resource scope must not be null"); + ENSURE_COND(!IS_NULL(bupd_def) && !IS_NULL(viewshift_def) && + !IS_NULL(own_def), + "C ghost protocol alias definitions must not be empty"); + ENSURE_COND(!IS_NULL(G), "selected payload RA must not be empty"); + ENSURE_COND(!IS_NULL(generic_rule), + "generic C ghost protocol rule must not be empty"); + + thm selected = ispec_rule(G, generic_rule); + thm result = c_logic_fold_update( + scope, bupd_def, viewshift_def, selected); + thm own_fold = gsym_rule(own_def); + thm_list ownership_folds = THM_LIST(own_fold); + result = pure_rewrite_rule(ownership_folds, result); + return result; +err: + ERR_FUN_PUTS( + "c_logic_fold_ghost_protocol", + IS_NULL(G) ? cstr_string("") : cstr_term(G), + IS_NULL(generic_rule) ? cstr_string("") + : cstr_thm(generic_rule)); + return empty_theorem; +} + +/** Extract and fold the forward entailment of named ownership composition. */ +PROOF static thm c_logic_fold_named_own_direction( + const ra_sl_scope* scope, + const thm bupd_def, + const thm viewshift_def, + const thm own_def, + const term R, + const bool forward) { + dest_app_type_results payload_ra_shape = dest_app_type(type_of(R)); + type payload_type = payload_ra_shape.tys[0]; + term name = mk_var("__c_logic_named_own_name", parse_type("num")); + term a = mk_var("__c_logic_named_own_a", payload_type); + term b = mk_var("__c_logic_named_own_b", payload_type); + thm selected = ispec_rule(R, c_named_own_op); + selected = ispecl_rule(TERM_LIST(name, a, b), selected); + selected = rewrite_rule(THM_LIST(r_equiv_def), selected); + selected = forward ? conjunct1_rule(selected) : conjunct2_rule(selected); + selected = gen_rule(b, selected); + selected = gen_rule(a, selected); + selected = gen_rule(name, selected); + thm result = c_logic_fold_update( + scope, bupd_def, viewshift_def, selected); + result = pure_rewrite_rule(THM_LIST(gsym_rule(own_def)), result); + return result; +err: + ERR_FUN_PUTS( + "c_logic_fold_named_own_direction", + IS_NULL(R) ? cstr_string("") : cstr_term(R)); + return empty_theorem; +} + +/** Check the session-selected protocol theorem boundary. */ +PROOF static int c_logic_validate_selected_rule( + const char* name, const thm rule) { + ENSURE_COND(name != NULL, "selected theorem name must not be null"); + ENSURE_COND(!IS_NULL(rule), "selected theorem `%s` must not be empty", name); + term_list assumptions = hyp(rule); + ENSURE_COND(vector_size(assumptions) == 0, + "selected theorem `%s` must have no hypotheses", name); + term statement = concl(rule); + term_list statement_vars = free_vars(statement); + ENSURE_COND(vector_size(statement_vars) == 0, + "selected theorem `%s` must be closed", name); + type_list statement_tyvars = term_tyvars(statement); + ENSURE_COND(vector_size(statement_tyvars) == 0, + "selected theorem `%s` must be monomorphic", name); + return 0; +err: + ERR_FUN_PUTS( + "c_logic_validate_selected_rule", + name == NULL ? cstr_string("") : cstr_string(name), + IS_NULL(rule) ? cstr_string("") : cstr_thm(rule)); + return -1; +} + +/** Return the complete fixed-name runtime theorem protocol. */ +PROOF static const_cstr_list c_logic_selected_rule_names(void) { + const_cstr_list names = CONST_STRING_LIST( + "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"); + return names; +} + +/** Reject every theorem-name conflict before defining or installing anything. */ +PROOF static int c_logic_preflight_selected_rule_names(void) { + const_cstr_list names = c_logic_selected_rule_names(); + cstr_list existing = list_theorems(); + for (size_t i = 0; i < vector_size(names); ++i) { + for (size_t j = 0; j < vector_size(existing); ++j) { + ENSURE_COND(strcmp(names[i], existing[j]) != 0, + "runtime theorem name `%s` is already registered", names[i]); + } + } + return 0; +err: + ERR_FUN_PUTS("c_logic_preflight_selected_rule_names"); + return -1; +} + +/** Publish the already-preflighted fixed runtime theorem names. */ +PROOF static int c_logic_register_selected_rules( + const thm data_at_value_range, + const thm allocated_at_zero, + const thm allocated_at_append, + const thm data_at_allocated_at, + const thm undef_data_at_allocated_at, + const thm allocated_at_to_undef_data_at, + const thm data_at_to_undef_data_at, + const thm ghost_own_op, + const thm ghost_own_split, + const thm ghost_own_join, + const thm ghost_own_valid, + const thm ghost_own_update, + const thm ghost_own_updateP, + const thm ghost_own_drop, + const thm ghost_own_alloc) { + const_cstr_list names = c_logic_selected_rule_names(); + thm_list rules = THM_LIST( + 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, + ghost_own_op, + ghost_own_split, + ghost_own_join, + ghost_own_valid, + ghost_own_update, + ghost_own_updateP, + ghost_own_drop, + ghost_own_alloc); + ENSURE_COND(vector_size(names) == vector_size(rules), + "selected theorem name/rule table is inconsistent"); + + /* `add_theorem` never fails and there is no concurrent theorem producer in + * one HOL session. After the earlier complete conflict preflight, additions + * therefore cannot leave a prefix-only registration. */ + for (size_t i = 0; i < vector_size(names); ++i) { + ENSURE_COND(add_theorem(names[i], rules[i]), + "runtime theorem name `%s` became unavailable", names[i]); + } + return 0; +err: + ERR_FUN_PUTS("c_logic_register_selected_rules"); + return -1; +} + +PROOF int c_logic_install_named(const term R) { + bool native_descriptor_published = false; + ENSURE_COND(!active_c_logic_installed, + "C logic is already installed in this verification session"); + ENSURE_COND(!IS_NULL(R), "payload RA must not be empty"); + term_list payload_ra_vars = free_vars(R); + ENSURE_COND(vector_size(payload_ra_vars) == 0, + "payload RA must be closed"); + type_list payload_ra_term_tyvars = term_tyvars(R); + ENSURE_COND(vector_size(payload_ra_term_tyvars) == 0, + "payload RA term must be monomorphic"); + + type payload_ra_type = type_of(R); + type_list payload_ra_type_tyvars = type_tyvars(payload_ra_type); + ENSURE_COND(vector_size(payload_ra_type_tyvars) == 0, + "payload RA type must be monomorphic"); + ENSURE_COND(is_app_type(payload_ra_type), + "payload RA must have type `(A)ra`"); + dest_app_type_results ra_shape = dest_app_type(payload_ra_type); + ENSURE_COND(strcmp(ra_shape.s, "ra") == 0 && + vector_size(ra_shape.tys) == 1, + "payload RA must have unary type `(A)ra`"); + c_logic_preflight_selected_rule_names(); + + /* Naming is an explicit global-RA choice at the adapter boundary. */ + term G = c_logic_specialize("named_ra", R); + term combined_ra = c_logic_specialize("c_resource_ra", G); + + ra_sl_scope resource_scope; + ra_sl_scope_prepare(C_LOGIC_ALIAS_SCOPE, combined_ra, &resource_scope); + + /* Give QCP's two operational memory atoms fixed, closed HOL constant heads. + * Their direct definitions remain specialized partial applications of the + * selected C-memory theory and therefore cannot be codec identities + * themselves. */ + type int_type = mk_int_type(); + type ctype_type = parse_type("ctype"); + type data_at_value_type = + mk_fun_type(int_type, resource_scope.theory.prop_type); + type data_at_ctype_type = mk_fun_type(ctype_type, data_at_value_type); + type expected_data_at_type = mk_fun_type(int_type, data_at_ctype_type); + type undef_data_at_ctype_type = + mk_fun_type(ctype_type, resource_scope.theory.prop_type); + type expected_undef_data_at_type = + mk_fun_type(int_type, undef_data_at_ctype_type); + + /* Function specifications are opaque QCP boundary markers. Specializing + * them here binds their assertion carrier to the same physical-by-ghost + * product resource model as every other selected connective. */ + type fnspec_post_type = + mk_fun_type(resource_scope.theory.prop_type, + resource_scope.theory.prop_type); + type fnspec_pre_type = + mk_fun_type(resource_scope.theory.prop_type, fnspec_post_type); + type fnspec_ctype_type = mk_fun_type(ctype_type, fnspec_pre_type); + type expected_fnspec_type = mk_fun_type(int_type, fnspec_ctype_type); + + term direct_fnspec = c_logic_specialize("c_fnspec", G); + term_list direct_fnspec_vars = free_vars(direct_fnspec); + type_list direct_fnspec_tyvars = term_tyvars(direct_fnspec); + ENSURE_COND(vector_size(direct_fnspec_vars) == 0 && + vector_size(direct_fnspec_tyvars) == 0, + "specialized function-specification marker must be closed and " + "monomorphic"); + type direct_fnspec_type = type_of(direct_fnspec); + ENSURE_COND(equals_type(direct_fnspec_type, expected_fnspec_type), + "specialized function-specification marker must have type " + "`int -> ctype -> Prop_G -> Prop_G -> Prop_G`"); + term fnspec_alias; + thm fnspec_alias_def; + sl_define_scope_alias(C_LOGIC_ALIAS_SCOPE, "fnspec", direct_fnspec, + &fnspec_alias, &fnspec_alias_def); + ENSURE_COND(is_const(fnspec_alias), + "function-specification alias must be a HOL constant"); + term_list fnspec_alias_vars = free_vars(fnspec_alias); + type_list fnspec_alias_tyvars = term_tyvars(fnspec_alias); + ENSURE_COND(vector_size(fnspec_alias_vars) == 0 && + vector_size(fnspec_alias_tyvars) == 0, + "function-specification alias must be closed and monomorphic"); + type fnspec_alias_type = type_of(fnspec_alias); + ENSURE_COND(equals_type(fnspec_alias_type, expected_fnspec_type), + "function-specification alias has an unexpected type"); + + term direct_fnspec_w = c_logic_specialize("c_fnspec_w", G); + term_list direct_fnspec_w_vars = free_vars(direct_fnspec_w); + type_list direct_fnspec_w_tyvars = term_tyvars(direct_fnspec_w); + ENSURE_COND(vector_size(direct_fnspec_w_vars) == 0 && + vector_size(direct_fnspec_w_tyvars) == 1, + "specialized ghost-binding function-specification marker must " + "be closed and retain exactly one parameter type variable"); + type fnspec_w_family_type = + mk_fun_type(direct_fnspec_w_tyvars[0], + resource_scope.theory.prop_type); + type fnspec_w_post_type = + mk_fun_type(fnspec_w_family_type, resource_scope.theory.prop_type); + type fnspec_w_pre_type = + mk_fun_type(fnspec_w_family_type, fnspec_w_post_type); + type fnspec_w_ctype_type = mk_fun_type(ctype_type, fnspec_w_pre_type); + type expected_fnspec_w_type = mk_fun_type(int_type, fnspec_w_ctype_type); + type direct_fnspec_w_type = type_of(direct_fnspec_w); + ENSURE_COND(equals_type(direct_fnspec_w_type, expected_fnspec_w_type), + "specialized ghost-binding function-specification marker has " + "an unexpected polymorphic type"); + term fnspec_w_alias; + thm fnspec_w_alias_def; + sl_define_scope_alias(C_LOGIC_ALIAS_SCOPE, "fnspec_w", direct_fnspec_w, + &fnspec_w_alias, &fnspec_w_alias_def); + ENSURE_COND(is_const(fnspec_w_alias), + "ghost-binding function-specification alias must be a HOL " + "constant"); + term_list fnspec_w_alias_vars = free_vars(fnspec_w_alias); + type_list fnspec_w_alias_tyvars = term_tyvars(fnspec_w_alias); + ENSURE_COND(vector_size(fnspec_w_alias_vars) == 0 && + vector_size(fnspec_w_alias_tyvars) == 1, + "ghost-binding function-specification alias must be closed and " + "retain exactly one parameter type variable"); + type fnspec_w_alias_type = type_of(fnspec_w_alias); + ENSURE_COND(equals_type(fnspec_w_alias_type, expected_fnspec_w_type), + "ghost-binding function-specification alias has an unexpected " + "type"); + + term direct_data_at = c_logic_specialize("c_data_at", G); + term_list direct_data_at_vars = free_vars(direct_data_at); + type_list direct_data_at_tyvars = term_tyvars(direct_data_at); + ENSURE_COND(vector_size(direct_data_at_vars) == 0 && + vector_size(direct_data_at_tyvars) == 0, + "specialized initialized C memory ownership must be closed and " + "monomorphic"); + type direct_data_at_type = type_of(direct_data_at); + ENSURE_COND(equals_type(direct_data_at_type, expected_data_at_type), + "specialized initialized C memory ownership must have type " + "`int -> ctype -> int -> Prop_G`"); + term data_at_alias; + thm data_at_alias_def; + sl_define_scope_alias(C_LOGIC_ALIAS_SCOPE, "data_at", direct_data_at, + &data_at_alias, &data_at_alias_def); + ENSURE_COND(is_const(data_at_alias), + "initialized C memory alias must be a HOL constant"); + term_list data_at_alias_vars = free_vars(data_at_alias); + type_list data_at_alias_tyvars = term_tyvars(data_at_alias); + ENSURE_COND(vector_size(data_at_alias_vars) == 0 && + vector_size(data_at_alias_tyvars) == 0, + "initialized C memory alias must be closed and monomorphic"); + type data_at_alias_type = type_of(data_at_alias); + ENSURE_COND(equals_type(data_at_alias_type, expected_data_at_type), + "initialized C memory alias has an unexpected type"); + + term direct_undef_data_at = c_logic_specialize("c_undef_data_at", G); + term_list direct_undef_data_at_vars = free_vars(direct_undef_data_at); + type_list direct_undef_data_at_tyvars = term_tyvars(direct_undef_data_at); + ENSURE_COND(vector_size(direct_undef_data_at_vars) == 0 && + vector_size(direct_undef_data_at_tyvars) == 0, + "specialized unknown C memory ownership must be closed and " + "monomorphic"); + type direct_undef_data_at_type = type_of(direct_undef_data_at); + ENSURE_COND(equals_type(direct_undef_data_at_type, + expected_undef_data_at_type), + "specialized unknown C memory ownership must have type " + "`int -> ctype -> Prop_G`"); + term undef_data_at_alias; + thm undef_data_at_alias_def; + sl_define_scope_alias(C_LOGIC_ALIAS_SCOPE, "undef_data_at", + direct_undef_data_at, &undef_data_at_alias, + &undef_data_at_alias_def); + ENSURE_COND(is_const(undef_data_at_alias), + "unknown C memory alias must be a HOL constant"); + term_list undef_data_at_alias_vars = free_vars(undef_data_at_alias); + type_list undef_data_at_alias_tyvars = term_tyvars(undef_data_at_alias); + ENSURE_COND(vector_size(undef_data_at_alias_vars) == 0 && + vector_size(undef_data_at_alias_tyvars) == 0, + "unknown C memory alias must be closed and monomorphic"); + type undef_data_at_alias_type = type_of(undef_data_at_alias); + ENSURE_COND(equals_type(undef_data_at_alias_type, + expected_undef_data_at_type), + "unknown C memory alias has an unexpected type"); + + thm selected_data_at_value_range = + ispec_rule(G, c_data_at_value_range); + thm data_at_value_range = ra_sl_scope_fold( + &resource_scope, selected_data_at_value_range); + data_at_value_range = pure_rewrite_rule( + THM_LIST(gsym_rule(data_at_alias_def)), data_at_value_range); + c_logic_validate_selected_rule( + "c_logic_data_at_value_range", data_at_value_range); + + thm selected_allocated_at_zero = + ispec_rule(G, c_allocated_at_zero); + thm allocated_at_zero = ra_sl_scope_fold( + &resource_scope, selected_allocated_at_zero); + c_logic_validate_selected_rule( + "c_logic_allocated_at_zero", allocated_at_zero); + + thm selected_allocated_at_append = + ispec_rule(G, c_allocated_at_append); + thm allocated_at_append = ra_sl_scope_fold( + &resource_scope, selected_allocated_at_append); + c_logic_validate_selected_rule( + "c_logic_allocated_at_append", allocated_at_append); + + thm selected_data_at_allocated_at = + ispec_rule(G, c_data_at_allocated_at); + thm data_at_allocated_at = ra_sl_scope_fold( + &resource_scope, selected_data_at_allocated_at); + data_at_allocated_at = pure_rewrite_rule( + THM_LIST(gsym_rule(data_at_alias_def)), data_at_allocated_at); + c_logic_validate_selected_rule( + "c_logic_data_at_allocated_at", data_at_allocated_at); + + thm selected_undef_data_at_allocated_at = + ispec_rule(G, c_undef_data_at_allocated_at); + thm undef_data_at_allocated_at = ra_sl_scope_fold( + &resource_scope, selected_undef_data_at_allocated_at); + undef_data_at_allocated_at = pure_rewrite_rule( + THM_LIST(gsym_rule(undef_data_at_alias_def)), + undef_data_at_allocated_at); + c_logic_validate_selected_rule( + "c_logic_undef_data_at_allocated_at", + undef_data_at_allocated_at); + + thm selected_allocated_at_to_undef_data_at = + ispec_rule(G, c_allocated_at_to_undef_data_at); + thm allocated_at_to_undef_data_at = ra_sl_scope_fold( + &resource_scope, selected_allocated_at_to_undef_data_at); + allocated_at_to_undef_data_at = pure_rewrite_rule( + THM_LIST(gsym_rule(undef_data_at_alias_def)), + allocated_at_to_undef_data_at); + c_logic_validate_selected_rule( + "c_logic_allocated_at_to_undef_data_at", + allocated_at_to_undef_data_at); + + thm selected_data_at_to_undef_data_at = + ispec_rule(G, c_data_at_to_undef_data_at); + thm data_at_to_undef_data_at = ra_sl_scope_fold( + &resource_scope, selected_data_at_to_undef_data_at); + data_at_to_undef_data_at = pure_rewrite_rule( + THM_LIST( + gsym_rule(data_at_alias_def), + gsym_rule(undef_data_at_alias_def)), + data_at_to_undef_data_at); + c_logic_validate_selected_rule( + "c_logic_data_at_to_undef_data_at", + data_at_to_undef_data_at); + + /* QCP can export constants but cannot name the partial application + * `c_named_own R`. Give that closed term one fixed session-local HOL name. + * The payload type remains monomorphic and is intentionally not registered + * here. */ + term direct_own = c_logic_specialize("c_named_own", R); + type num_type = parse_type("num"); + type own_payload_type = + mk_fun_type(ra_shape.tys[0], resource_scope.theory.prop_type); + type expected_own_type = mk_fun_type(num_type, own_payload_type); + type direct_own_type = type_of(direct_own); + ENSURE_COND(equals_type(direct_own_type, expected_own_type), + "specialized C ghost ownership must have type " + "`num -> A -> Prop_G`"); + term own_alias; + thm own_alias_def; + sl_define_scope_alias(C_LOGIC_ALIAS_SCOPE, "own", direct_own, + &own_alias, &own_alias_def); + term_list own_alias_vars = free_vars(own_alias); + type_list own_alias_tyvars = term_tyvars(own_alias); + ENSURE_COND(vector_size(own_alias_vars) == 0 && + vector_size(own_alias_tyvars) == 0, + "C ghost-ownership alias must be closed and monomorphic"); + type own_alias_type = type_of(own_alias); + ENSURE_COND(equals_type(own_alias_type, expected_own_type), + "C ghost-ownership alias has an unexpected type"); + + term direct_bupd = c_logic_specialize("c_bupd", G); + term direct_viewshift = c_logic_specialize("c_viewshift", G); + + thm bupd_alias_def; + thm viewshift_alias_def; + sl_update_theory update = (sl_update_theory){0}; + sl_define_scope_alias(C_LOGIC_ALIAS_SCOPE, "bupd", direct_bupd, + &update.bupd, &bupd_alias_def); + sl_define_scope_alias(C_LOGIC_ALIAS_SCOPE, "viewshift", direct_viewshift, + &update.viewshift, &viewshift_alias_def); + +#define FOLD_C_UPDATE_RULE(field, primitive) \ + update.field = c_logic_fold_selected_update( \ + &resource_scope, bupd_alias_def, viewshift_alias_def, \ + G, primitive) + + FOLD_C_UPDATE_RULE(bupd_intro, r_bupd_right_intro); + FOLD_C_UPDATE_RULE(bupd_mono, r_bupd_right_mono); + FOLD_C_UPDATE_RULE(bupd_idem, r_bupd_right_idem); + FOLD_C_UPDATE_RULE(bupd_frame, r_bupd_right_frame); + FOLD_C_UPDATE_RULE(viewshift_refl, r_viewshift_right_refl); + FOLD_C_UPDATE_RULE(viewshift_entails, r_viewshift_right_entails); + FOLD_C_UPDATE_RULE(viewshift_trans, r_viewshift_right_trans); + FOLD_C_UPDATE_RULE(viewshift_mono, r_viewshift_right_mono); + FOLD_C_UPDATE_RULE(viewshift_frame, r_viewshift_right_frame); + FOLD_C_UPDATE_RULE(viewshift_sep, r_viewshift_right_sep); + FOLD_C_UPDATE_RULE(viewshift_fact, r_viewshift_right_fact); + FOLD_C_UPDATE_RULE(viewshift_exists, r_viewshift_right_exists); +#undef FOLD_C_UPDATE_RULE + + thm ghost_own_op = c_logic_fold_ghost_protocol( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + c_named_own_op); + c_logic_validate_selected_rule( + "c_logic_ghost_own_op", ghost_own_op); + thm ghost_own_split = c_logic_fold_named_own_direction( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + true); + c_logic_validate_selected_rule( + "c_logic_ghost_own_split", ghost_own_split); + thm ghost_own_join = c_logic_fold_named_own_direction( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + false); + c_logic_validate_selected_rule( + "c_logic_ghost_own_join", ghost_own_join); + + thm ghost_own_valid = c_logic_fold_ghost_protocol( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + c_named_own_valid); + c_logic_validate_selected_rule( + "c_logic_ghost_own_valid", ghost_own_valid); + + thm ghost_own_update = c_logic_fold_ghost_protocol( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + c_named_own_update); + c_logic_validate_selected_rule( + "c_logic_ghost_own_update", ghost_own_update); + + thm ghost_own_updateP = c_logic_fold_ghost_protocol( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + c_named_own_updateP); + c_logic_validate_selected_rule( + "c_logic_ghost_own_updateP", ghost_own_updateP); + + thm ghost_own_drop = c_logic_fold_ghost_protocol( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + c_named_own_drop); + c_logic_validate_selected_rule( + "c_logic_ghost_own_drop", ghost_own_drop); + + thm ghost_own_alloc = c_logic_fold_ghost_protocol( + &resource_scope, bupd_alias_def, viewshift_alias_def, own_alias_def, R, + c_named_own_alloc); + c_logic_validate_selected_rule( + "c_logic_ghost_own_alloc", ghost_own_alloc); + + /* Install one complete native descriptor. The runtime validates this local + * candidate, including both physical-memory atoms, before publishing any + * global state; there is no separately installable QCP codec. */ + cst_c_logic_descriptor_input descriptor = { + .struct_size = sizeof(cst_c_logic_descriptor_input), + .abi_version = 2u, + .ghost_ra = G, + .resource_ra = combined_ra, + .prop_type = resource_scope.theory.prop_type, + .emp = (cst_certified_alias){resource_scope.theory.emp, + resource_scope.emp_def}, + .sep = (cst_certified_alias){resource_scope.theory.sep, + resource_scope.sep_def}, + .wand = (cst_certified_alias){resource_scope.theory.wand, + resource_scope.wand_def}, + .and_op = (cst_certified_alias){resource_scope.theory.and_op, + resource_scope.and_def}, + .or_op = (cst_certified_alias){resource_scope.theory.or_op, + resource_scope.or_def}, + .exists_op = (cst_certified_alias){resource_scope.theory.exists_op, + resource_scope.exists_def}, + .entails = (cst_certified_alias){resource_scope.theory.entails, + resource_scope.entails_def}, + .equiv = (cst_certified_alias){resource_scope.theory.equiv, + resource_scope.equiv_def}, + .fact = (cst_certified_alias){resource_scope.theory.fact, + resource_scope.fact_def}, + .pure = + (cst_certified_alias){resource_scope.pure, resource_scope.pure_def}, + .bupd = (cst_certified_alias){update.bupd, bupd_alias_def}, + .viewshift = + (cst_certified_alias){update.viewshift, viewshift_alias_def}, + .fnspec = (cst_certified_alias){fnspec_alias, fnspec_alias_def}, + .fnspec_w = (cst_certified_alias){fnspec_w_alias, + fnspec_w_alias_def}, + .data_at = (cst_certified_alias){data_at_alias, data_at_alias_def}, + .undef_data_at = (cst_certified_alias){undef_data_at_alias, + undef_data_at_alias_def}, + .sep_emp_left = resource_scope.theory.sep_emp_left, + .sep_emp_right = resource_scope.theory.sep_emp_right, + .fact_true_emp = resource_scope.theory.fact_true_emp, + .sep_assoc = resource_scope.theory.sep_assoc, + .sep_comm = resource_scope.theory.sep_comm, + }; + ENSURE_COND(cst_install_c_logic_descriptor(&descriptor) == 0, + "cannot install the verification-time C-logic descriptor"); + native_descriptor_published = true; + + ra_sl_scope_install(&resource_scope); + sl_install_update_theory(&update); + ra_sl_scope_activate(&resource_scope); + + /* Stable source spelling for the selected monomorphic assertion type. + * This is parser metadata only: `cprop` expands to the exact carrier + * predicate type installed above and introduces no new HOL type. */ + new_tyabbrev("cprop", resource_scope.theory.prop_type); + + parse_as_infix("==*=>", 2, "right"); + override_interface("data_at", data_at_alias); + override_interface("undef_data_at", undef_data_at_alias); + override_interface("fnspec", fnspec_alias); + override_interface("fnspec_w", fnspec_w_alias); + override_interface("bupd", update.bupd); + override_interface("==*=>", update.viewshift); + override_interface("own", own_alias); + + /* These calls are deferred during proof initialization and replayed only + * after QCP has frozen the installed assertion descriptor. Subsequent + * theorem-database publication is preflighted as a complete fixed-name + * group. */ + ENSURE_COND(cst_add_const_to_header(own_alias) == 0, + "cannot defer the C ghost-ownership QCP registration"); + ENSURE_COND( + cst_add_const_to_header(`pmem_uint64_address_ok:int->bool`) == 0, + "cannot export the uint64 address-validity predicate"); + ENSURE_COND( + cst_add_const_to_header(`pmem_ptr_address_ok:int->bool`) == 0, + "cannot export the pointer address-validity predicate"); + c_logic_register_selected_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, + ghost_own_op, + ghost_own_split, + ghost_own_join, + ghost_own_valid, + ghost_own_update, + ghost_own_updateP, + ghost_own_drop, + ghost_own_alloc); + + /* Publish one immutable structured view only after every runtime, + * parser, QCP, and theorem-database operation succeeds. */ + active_c_logic = (c_logic_scope){ + .payload_ra = R, + .ghost_ra = G, + .resource_ra = combined_ra, + .update = update, + .data_at = data_at_alias, + .data_at_def = data_at_alias_def, + .undef_data_at = undef_data_at_alias, + .undef_data_at_def = undef_data_at_alias_def, + .fnspec = fnspec_alias, + .fnspec_def = fnspec_alias_def, + .fnspec_w = fnspec_w_alias, + .fnspec_w_def = fnspec_w_alias_def, + .own = own_alias, + .own_def = own_alias_def, + .data_at_value_range = data_at_value_range, + .allocated_at_zero = allocated_at_zero, + .allocated_at_append = allocated_at_append, + .data_at_allocated_at = data_at_allocated_at, + .undef_data_at_allocated_at = undef_data_at_allocated_at, + .allocated_at_to_undef_data_at = allocated_at_to_undef_data_at, + .data_at_to_undef_data_at = data_at_to_undef_data_at, + .ghost_own_op = ghost_own_op, + .ghost_own_split = ghost_own_split, + .ghost_own_join = ghost_own_join, + .ghost_own_valid = ghost_own_valid, + .ghost_own_update = ghost_own_update, + .ghost_own_updateP = ghost_own_updateP, + .ghost_own_drop = ghost_own_drop, + .ghost_own_alloc = ghost_own_alloc, + }; + active_c_logic_installed = true; + return 0; +err: + ERR_FUN_PUTS( + "c_logic_install_named", + IS_NULL(R) ? cstr_string("") : cstr_term(R)); + /* Native publication freezes the process-wide trust decision. A later + * parser, QCP-registration, or theorem-database failure cannot be recovered + * by TRY: continuing would expose two disagreeing views of the active logic. */ + if (native_descriptor_published) cst_exit_on_error(); + return -1; +} diff --git a/userlib/qcp/c_logic.h b/userlib/qcp/c_logic.h new file mode 100644 index 0000000000000000000000000000000000000000..ea455be130e84aad5fb52d5f9e3f7a4dff658a02 --- /dev/null +++ b/userlib/qcp/c_logic.h @@ -0,0 +1,162 @@ +/** + * @file c_logic.h + * @brief Install one ghost-aware C assertion model for a verification session. + * + * For a closed monomorphic payload algebra `R:(A)ra`, this named-protocol + * installer selects the complete global ghost algebra and C resource + * + * ```text + * G = named_ra R + * CRes_G = c_resource_ra G = prod_ra mem_ra G + * Prop_G = carrier(CRes_G) -> bool. + * ``` + * + * Physical ownership and logical ownership therefore inhabit one linear + * separation logic. The installed `c_bupd G` is deliberately narrower than + * `r_bupd (c_resource_ra G)`: it preserves the physical `FST` projection and + * performs a frame-preserving update only on the complete global ghost `SND` + * projection. + * + * The assertion language keeps resource-independent `pure(phi)` distinct from + * exact-unit `fact(phi)`. The latter is the spatial form used by validity and + * predicate-update rules; it cannot retain or discard unrelated ownership. + * + * The source abbreviation `cprop` denotes `Prop_G`. It is parser metadata, not + * a new HOL type and not the former `hprop` abbreviation. QCP interprets the + * installed `data_at`, `undef_data_at`, `fnspec`, and `fnspec_w` aliases at + * its language boundary; `own` remains an opaque spatial atom in symbolic + * assertions. + */ + +#pragma once + +#include "proof/proof_sl.h" +#include "proof/theory/c_program_logic/c_basic_update.h" +#include "proof/theory/c_program_logic/c_fnspec.h" +#include "proof/theory/c_program_logic/c_ghost.h" +#include "proof/theory/c_program_logic/c_memory.h" + +/** + * Immutable proof-side view of the installed C logic. + * + * `update` contains the closed `bupd` and `viewshift` aliases plus their laws. + * Every remaining theorem is term-closed and hypothesis-free and uses those + * selected aliases. All are monomorphic except `fnspec_w_def`, whose single + * type variable is the function specification's `With`-parameter carrier. + * The protocol rules are also registered under the fixed names listed below + * so `get_theorem_by_name` and theorem search remain available. + */ +PROOF typedef struct { + /* Selected algebras: payload R, complete ghost G, and mem_ra × G. */ + term payload_ra; + term ghost_ra; + term resource_ra; + + /** Closed right-only update/view-shift aliases and their laws. */ + sl_update_theory update; + + /* Closed source-facing spatial atom aliases and their definitions. */ + term data_at; + thm data_at_def; + term undef_data_at; + thm undef_data_at_def; + term fnspec; + thm fnspec_def; + term fnspec_w; + thm fnspec_w_def; + term own; + thm own_def; + + /* Selected physical-memory rules. */ + thm data_at_value_range; + thm allocated_at_zero; + thm allocated_at_append; + thm data_at_allocated_at; + thm undef_data_at_allocated_at; + thm allocated_at_to_undef_data_at; + thm data_at_to_undef_data_at; + + /* Selected named ghost protocol. `split` and `join` are entailments. */ + thm ghost_own_op; + thm ghost_own_split; + thm ghost_own_join; + thm ghost_own_valid; + thm ghost_own_update; + thm ghost_own_updateP; + thm ghost_own_drop; + thm ghost_own_alloc; +} c_logic_scope; + +/** + * Select and install the named C assertion model for the current session. + * + * `R` must be a closed monomorphic term of type `(A)ra`. The installed global + * ghost algebra is exactly `G = named_ra R`; `c_resource_ra` does not insert + * the named layer. This is the only installer contract: the previous API that + * accepted an already-complete global ghost algebra is intentionally not + * supported. Before this call, clients must export every non-built-in payload + * type and constructor that can occur under `own`; product is a QCP built-in, + * user datatypes are not. + * + * A successful call performs one fail-stop installation transaction: + * + * 1. build `c_resource_ra (named_ra R)` and term-closed + * `cstar_sl__c_logic__*` aliases + * (`fnspec_w` retains one parameter type variable); + * 2. prove the selected SL, C-memory, and ghost-only update rules; + * 3. validate and install the verification-time assertion descriptor; + * 4. install proof registries and parser interfaces; + * 5. defer the opaque `own` and address-validity declarations for QCP; + * 6. publish the fixed theorem database entries and `c_logic_scope`. + * + * The source interfaces are `emp`, `**`, `-*`, `&&`, `||`, `exists`, `|--`, + * `-||-`, `fact`, `pure`, `data_at`, `undef_data_at`, `fnspec`, `fnspec_w`, + * `own`, `bupd`, and `==*=>`. Raw HOL equality is written `-|-` in assertion + * syntax. + * + * Ownership composition is exposed in three forms. `ghost_own_op` is logical + * equivalence; `ghost_own_split` is the entailment from `own(name,a op b)` to + * `own(name,a) ** own(name,b)`; and `ghost_own_join` is its reverse + * entailment. Neither direction is raw assertion equality or a view shift. + * Updates, drops, and allocation use the installed right-only view shift, so + * none can modify physical memory. + * + * The selected rules are registered as: + * + * ```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 + * ``` + * + * The database names follow lower-case theorem style. The capital `P` in + * `updateP` is retained because it is part of the underlying constant name. + * + * Alias definitions and parser changes cannot be transactionally removed. + * Consequently, any error is proof-initialization fail-stop: callers must + * propagate it and must not retry a different model in the same session. + * + * @return Zero on success, or `-1` after reporting a prover error. + */ +PROOF int c_logic_install_named(const term R); + +/** + * Return the installed immutable scope. + * + * Before successful installation this reports a prover error and returns a + * pointer to the zero-initialized inactive storage. The pointer remains valid + * for the rest of the verification process. + */ +PROOF const c_logic_scope* c_logic_current(void); diff --git a/userlib/qcp/c_logic_default.c b/userlib/qcp/c_logic_default.c new file mode 100644 index 0000000000000000000000000000000000000000..6fe49d08f8db6d226f76e80101d37350e55fa09c --- /dev/null +++ b/userlib/qcp/c_logic_default.c @@ -0,0 +1,29 @@ +#include "userlib/qcp/c_logic_default.h" + +#require "proof/theory/logic/unit_ra.c" +#require "userlib/qcp/c_logic.c" + +PROOF extern int cst_add_type_to_header(const char *name, int arity); +PROOF extern int cst_add_const_to_header(term tm); + +PROOF int c_logic_install_default(void) { + static bool installed = false; + if (installed) return 0; + /* QCP spells HOL's numeral-named singleton type `1` as `cstar_unit`. + * Declare the carrier and its sole value before `c_logic_install_named` + * queues the + * selected `own : num -> 1 -> cprop` constant. */ + ENSURE_COND(cst_add_type_to_header("1", 0) == 0, + "cannot export the singleton ghost carrier to QCP"); + ENSURE_COND(cst_add_const_to_header(`one:1`) == 0, + "cannot export the singleton ghost value to QCP"); + ENSURE_COND(c_logic_install_named(`unit_ra:(1)ra`) == 0, + "cannot install the default unit-ghost C logic"); + installed = true; + return 0; +err: + ERR_FUN_PUTS("c_logic_install_default"); + return -1; +} + +PROOF static int _CSTAR_DEFAULT_C_LOGIC = c_logic_install_default(); diff --git a/userlib/qcp/c_logic_default.h b/userlib/qcp/c_logic_default.h new file mode 100644 index 0000000000000000000000000000000000000000..9c9747a3a9fbfc96111da0bb7c2db3e4636b8617 --- /dev/null +++ b/userlib/qcp/c_logic_default.h @@ -0,0 +1,31 @@ +/** + * @file c_logic_default.h + * @brief Default complete C assertion model with singleton ghost cells. + * + * The selected model is: + * + * ```text + * R = unit_ra + * G = named_ra R + * CRes = c_resource_ra G = mem_ra × named_ra unit_ra. + * ``` + * + * This header is normally loaded by `veriftime.h`. Files that need a different + * payload algebra must define `CSTAR_DEFER_C_LOGIC_INSTALL` before including + * `veriftime.h`, export their payload vocabulary to QCP, and call + * `c_logic_install_named(R)` before parsing C assertions. Pass the payload RA + * `R`, not `named_ra R`; the installer constructs the complete global algebra. + */ +#pragma once + +#include "userlib/qcp/c_logic.h" +#include "proof/theory/logic/unit_ra.h" + +/** + * Install the default model once in this verification session. + * + * @return Zero on success, or `-1` after reporting initialization failure. + * Installation mutates global HOL, parser, and QCP state and is not + * retryable with another model. + */ +PROOF int c_logic_install_default(void); diff --git a/userlib/qcp/veriftime.c b/userlib/qcp/veriftime.c index e39fc803fd20db16addb675667cbbfdd890ab918..064aa1bf412d133e62b11e1cba002544f4482e59 100644 --- a/userlib/qcp/veriftime.c +++ b/userlib/qcp/veriftime.c @@ -1,3 +1,5 @@ +#define CSTAR_DEFER_C_LOGIC_INSTALL + #include "userlib/qcp/veriftime.h" /*------------------------- parsing defaults -------------------------*/ @@ -28,95 +30,34 @@ PROOF void extend_default_types(const term_list variables) { /*------------------ QCP assertion representation ------------------*/ -/* These heads already have native assertion syntax in QCP. Everything else - * with a constant head, at least one argument, and boolean result is a logical - * function call and needs an explicit `... <=> T` parser boundary. */ -PROOF static bool builtin_bool_head(const char *name) { - return strcmp(name, "=") == 0 || - strcmp(name, "~") == 0 || - strcmp(name, "/\\") == 0 || - strcmp(name, "\\/") == 0 || - strcmp(name, "==>") == 0 || - strcmp(name, "!") == 0 || - strcmp(name, "?") == 0 || - strcmp(name, "<") == 0 || - strcmp(name, "<=") == 0 || - strcmp(name, ">") == 0 || - strcmp(name, ">=") == 0 || - strcmp(name, "int_lt") == 0 || - strcmp(name, "int_le") == 0 || - strcmp(name, "int_gt") == 0 || - strcmp(name, "int_ge") == 0; -} - -PROOF static bool is_bool_call(const term predicate) { - if (!is_bool_type(type_of(predicate)) || !is_comb(predicate)) return false; - struct strip_comb_results call = strip_comb(predicate); - if (!is_const(call.tm) || vector_size(call.tms) == 0) return false; - return !builtin_bool_head(dest_const(call.tm).s); -} - -PROOF static bool is_encoded_bool_call(const term predicate, - term *raw_predicate) { - if (!is_iff(predicate)) return false; - dest_iff_results sides = dest_iff(predicate); - if (!is_true(sides.tm2) || !is_bool_call(sides.tm1)) return false; - if (raw_predicate != NULL) *raw_predicate = sides.tm1; - return true; -} - -/* `|- ((p <=> T) <=> p)`, the second conjunct of `EQ_CLAUSES`. */ -PROOF static thm eq_true_right(const term predicate) { - thm clauses = ispec_rule(predicate, get_theorem_by_name("EQ_CLAUSES")); - return conjunct1_rule(conjunct2_rule(clauses)); -} - -PROOF static thm bool_calls_eq(const term tm, const bool encode) { - if (is_sl_fact(tm)) { - term predicate = dest_sl_fact(tm); - if (encode && is_bool_call(predicate)) { - thm predicate_eq = sym_rule(eq_true_right(predicate)); - return mk_comb_rule(refl_rule(sl_fact()), predicate_eq); - } - if (!encode) { - term raw_predicate = empty_term; - if (is_encoded_bool_call(predicate, &raw_predicate)) { - thm predicate_eq = eq_true_right(raw_predicate); - return mk_comb_rule(refl_rule(sl_fact()), predicate_eq); - } - } - return refl_rule(tm); - } - - if (is_comb(tm)) { - dest_comb_results parts = dest_comb(tm); - return mk_comb_rule(bool_calls_eq(parts.tm1, encode), - bool_calls_eq(parts.tm2, encode)); - } - - if (is_abs(tm)) { - dest_abs_results abstraction = dest_abs(tm); - return abs_rule(abstraction.v, bool_calls_eq(abstraction.tm, encode)); - } - - return refl_rule(tm); +/* Proves an equality between the proof-facing assertion representation and + * the QCP-facing one. The server performs the complete recursive traversal in + * one request and constructs the result exclusively from HOL kernel rules. + * This keeps the conversion exact without one RPC per syntax-tree node. */ +PROOF static thm qcp_boundary_eq(const term tm, const bool encode) { + const sl_theory *theory = sl_current_theory(); + return qcp_boundary_rule(theory->fact, tm, encode); } PROOF thm encode_bool_calls_eq(const term raw_assertion) { - ENSURE_COND(is_sl_prop(raw_assertion), + bool valid_assertion = is_sl_prop(raw_assertion); + ENSURE_COND(valid_assertion, "Term(`%s`) is not a separation-logic assertion", string_of_term(raw_assertion)); - return bool_calls_eq(raw_assertion, true); + thm result = qcp_boundary_eq(raw_assertion, true); + return result; err: ERR_FUN_PUTS("encode_bool_calls_eq", cstr_term(raw_assertion)); return empty_theorem; } PROOF thm decode_bool_calls_eq(const term qcp_assertion) { - ENSURE_COND(is_sl_prop(qcp_assertion), + bool valid_assertion = is_sl_prop(qcp_assertion); + ENSURE_COND(valid_assertion, "Term(`%s`) is not a separation-logic assertion", string_of_term(qcp_assertion)); - return bool_calls_eq(qcp_assertion, false); + thm result = qcp_boundary_eq(qcp_assertion, false); + return result; err: ERR_FUN_PUTS("decode_bool_calls_eq", cstr_term(qcp_assertion)); return empty_theorem; @@ -125,17 +66,16 @@ err: PROOF term bool_calls_for_qcp(const term raw_assertion) { thm encoded = encode_bool_calls_eq(raw_assertion); ENSURE_COND(!IS_NULL(encoded), "Could not encode the QCP assertion boundary"); - return dest_eq(concl(encoded)).tm2; + term encoded_ccl = concl(encoded); + dest_eq_results encoding = dest_eq(encoded_ccl); + term result = encoding.tm2; + return result; err: ERR_FUN_PUTS("bool_calls_for_qcp", cstr_term(raw_assertion)); return empty_term; } -PROOF term get_symbolic_state(void) { - term qcp_symst = cst_get_symbolic_state(); - thm decode_symst_eq = decode_bool_calls_eq(qcp_symst); - return dest_eq(concl(decode_symst_eq)).tm2; -} +PROOF term get_symbolic_state(void) { return cst_get_symbolic_state(); } /*--------------------- Symbolic value queries ---------------------*/ @@ -152,18 +92,23 @@ PROOF static bool val_space(const char c) { } PROOF static char *val_compact_expression(const char *expression) { + ENSURE_COND(expression != NULL, "C expression must not be null"); size_t length = strlen(expression); char *compact = GC_MALLOC(length + 1); + ENSURE_COND(compact != NULL, "cannot allocate compact C expression"); size_t used = 0; for (size_t i = 0; i < length; ++i) { if (!val_space(expression[i])) compact[used++] = expression[i]; } compact[used] = '\0'; return compact; +err: + ERR_FUN_PUTS("val_compact_expression"); + return NULL; } PROOF static bool val_identifier(const char *text) { - if (text[0] == '\0' || + if (text == NULL || text[0] == '\0' || !((text[0] >= 'a' && text[0] <= 'z') || (text[0] >= 'A' && text[0] <= 'Z') || text[0] == '_')) { return false; @@ -179,30 +124,47 @@ PROOF static bool val_identifier(const char *text) { } PROOF static bool val_const_named(const term tm, const char *name) { - return is_const(tm) && strcmp(dest_const(tm).s, name) == 0; + if (name == NULL || !is_const(tm)) return false; + const char* actual_name = dest_const(tm).s; + bool result = strcmp(actual_name, name) == 0; + return result; } PROOF static bool val_call_named(const term tm, const char *name, const int arity, struct strip_comb_results *call) { struct strip_comb_results parts = strip_comb(tm); - if (!val_const_named(parts.tm, name) || vector_size(parts.tms) != arity) { - return false; - } + bool named_head = val_const_named(parts.tm, name); + if (!named_head) return false; + if (vector_size(parts.tms) != arity) return false; + if (call != NULL) *call = parts; + return true; +} + +PROOF static bool val_call_head(const term tm, const term expected_head, + const int arity, + struct strip_comb_results *call) { + struct strip_comb_results parts = strip_comb(tm); + bool expected = equals_term(parts.tm, expected_head); + if (!expected) return false; + if (vector_size(parts.tms) != arity) return false; if (call != NULL) *call = parts; return true; } -PROOF static val_cell val_find_cell(const term symhp, const term address) { +PROOF static val_cell val_find_cell(const term symhp, const term address, + const term data_at_head) { val_cell result = {empty_term, empty_term, empty_term, 0}; - term body = strip_sl_exists(symhp).hp; + strip_sl_exists_results stripped = strip_sl_exists(symhp); + term body = stripped.hp; term_list resources = strip_sl_sep(body); for (int i = 0; i < vector_size(resources); ++i) { struct strip_comb_results data_at_call; - if (!val_call_named(resources[i], "data_at", 3, &data_at_call) || - alpha_compare(data_at_call.tms[0], address) != 0) { - continue; - } + bool data_at_resource = + val_call_head(resources[i], data_at_head, 3, &data_at_call); + if (!data_at_resource) continue; + int address_order = alpha_compare(data_at_call.tms[0], address); + if (address_order != 0) continue; result.address = data_at_call.tms[0]; result.ctype = data_at_call.tms[1]; result.value = data_at_call.tms[2]; @@ -212,10 +174,19 @@ PROOF static val_cell val_find_cell(const term symhp, const term address) { } PROOF static val_cell val_read_variable(const term symhp, - const char *variable) { - term address = mk_var(gc_sprintf("%s__addr", variable), - parse_type("addr")); - val_cell cell = val_find_cell(symhp, address); + const char *variable, + const term data_at_head) { + ENSURE_COND(variable != NULL, "C variable name must not be null"); + type data_at_type = type_of(data_at_head); + ENSURE_COND(is_fun_type(data_at_type), + "the active `data_at` interface has no address argument"); + struct dest_fun_type_results data_at_function = dest_fun_type(data_at_type); + type address_type = data_at_function.ty1; + char* address_name = gc_sprintf("%s__addr", variable); + ENSURE_COND(address_name != NULL, + "cannot allocate the C variable address name"); + term address = mk_var(address_name, address_type); + val_cell cell = val_find_cell(symhp, address, data_at_head); ENSURE_COND( cell.matches > 0, "insufficient memory permission to evaluate C expression: no " @@ -231,30 +202,43 @@ err: PROOF static bool val_field_address(const term address, const term base, const char *field) { + ENSURE_COND(field != NULL, "C field name must not be null"); struct strip_comb_results field_call; - if (!val_call_named(address, "field_addr", 3, &field_call) || - alpha_compare(field_call.tms[0], base) != 0) { - return false; - } + bool field_address = + val_call_named(address, "field_addr", 3, &field_call); + if (!field_address) return false; + int base_order = alpha_compare(field_call.tms[0], base); + if (base_order != 0) return false; char *field_constant = gc_sprintf("F%s", field); - return val_const_named(field_call.tms[2], field_constant); + ENSURE_COND(field_constant != NULL, + "cannot allocate the C field constant name"); + bool result = val_const_named(field_call.tms[2], field_constant); + return result; +err: + ERR_FUN_PUTS("val_field_address", cstr_term(address), cstr_term(base)); + return false; } PROOF static val_cell val_read_field(const term symhp, const char *variable, - const char *field) { - val_cell pointer = val_read_variable(symhp, variable); - ENSURE_COND(val_const_named(pointer.ctype, "Tptr"), + const char *field, + const term data_at_head) { + val_cell pointer = val_read_variable(symhp, variable, data_at_head); + bool pointer_type = val_const_named(pointer.ctype, "Tptr"); + ENSURE_COND(pointer_type, "C variable `%s` is not a pointer", variable); val_cell result = {empty_term, empty_term, empty_term, 0}; - term body = strip_sl_exists(symhp).hp; + strip_sl_exists_results stripped = strip_sl_exists(symhp); + term body = stripped.hp; term_list resources = strip_sl_sep(body); for (int i = 0; i < vector_size(resources); ++i) { struct strip_comb_results data_at_call; - if (!val_call_named(resources[i], "data_at", 3, &data_at_call) || - !val_field_address(data_at_call.tms[0], pointer.value, field)) { - continue; - } + bool data_at_resource = + val_call_head(resources[i], data_at_head, 3, &data_at_call); + if (!data_at_resource) continue; + bool requested_field = + val_field_address(data_at_call.tms[0], pointer.value, field); + if (!requested_field) continue; result.address = data_at_call.tms[0]; result.ctype = data_at_call.tms[1]; result.value = data_at_call.tms[2]; @@ -275,6 +259,7 @@ err: } PROOF static term val_decimal_int(const char *text) { + ENSURE_COND(text != NULL, "decimal integer text must not be null"); ENSURE_COND(text[0] != '\0', "missing decimal integer constant"); int value = 0; for (size_t i = 0; text[i] != '\0'; ++i) { @@ -286,7 +271,10 @@ PROOF static term val_decimal_int(const char *text) { text); value = value * 10 + digit; } - return parse_term(gc_sprintf("%di", value)); + char* literal = gc_sprintf("%di", value); + ENSURE_COND(literal != NULL, "cannot allocate decimal integer literal"); + term result = parse_term(literal); + return result; err: ERR_FUN_PUTS("val_decimal_int", text); return empty_term; @@ -295,10 +283,20 @@ err: PROOF term val_of(const char *expression) { ENSURE_COND(expression != NULL, "C expression is null"); char *compact = val_compact_expression(expression); + ENSURE_COND(compact != NULL, "cannot compact the C expression"); ENSURE_COND(compact[0] != '\0', "C expression is empty"); + /* `data_at` is a parser interface, not necessarily the HOL constant's real + * name. In the selected C logic it resolves to the fixed monomorphic + * `cstar_sl__c_logic__data_at` alias installed for the current Prop_G. */ + term data_at_head = parse_term("data_at"); + ENSURE_COND(is_const(data_at_head), + "the active `data_at` interface is not a HOL constant"); + term symst = get_symbolic_state(); - term_list symhps = strip_binop(sl_or(), symst); + const sl_theory* theory = sl_current_theory(); + term or_head = theory->or_op; + term_list symhps = strip_binop(or_head, symst); ENSURE_COND( vector_size(symhps) == 1, "val_of currently requires a single symbolic-heap branch"); @@ -311,16 +309,21 @@ PROOF term val_of(const char *expression) { char *field_expression = address_of_field ? gc_sprintf("%.*s", (int)length - 3, compact + 2) : compact; + ENSURE_COND(field_expression != NULL, + "cannot allocate the C field expression"); char *arrow = strstr(field_expression, "->"); if (arrow != NULL) { *arrow = '\0'; char *variable = field_expression; char *field = arrow + 2; - ENSURE_COND(val_identifier(variable) && val_identifier(field), + bool variable_is_identifier = val_identifier(variable); + bool field_is_identifier = val_identifier(field); + ENSURE_COND(variable_is_identifier && field_is_identifier, "unsupported field expression `%s`", expression); ENSURE_COND(strstr(field, "->") == NULL, "nested field expressions are not supported"); - val_cell cell = val_read_field(symhp, variable, field); + val_cell cell = + val_read_field(symhp, variable, field, data_at_head); return address_of_field ? cell.address : cell.value; } ENSURE_COND(!address_of_field, @@ -331,56 +334,64 @@ PROOF term val_of(const char *expression) { *plus = '\0'; char *variable = compact; char *constant = plus + 1; - ENSURE_COND(val_identifier(variable) && strchr(constant, '+') == NULL, + bool variable_is_identifier = val_identifier(variable); + ENSURE_COND(variable_is_identifier && strchr(constant, '+') == NULL, "unsupported addition expression `%s`", expression); - val_cell cell = val_read_variable(symhp, variable); - ENSURE_COND(val_const_named(cell.ctype, "Tint"), + val_cell cell = val_read_variable(symhp, variable, data_at_head); + bool integer_type = val_const_named(cell.ctype, "Tint"); + ENSURE_COND(integer_type, "integer addition currently requires a `Tint` variable"); term offset = val_decimal_int(constant); - return mk_binop(`(+):int->int->int`, cell.value, offset); + term int_add = `(+):int->int->int`; + term result = mk_binop(int_add, cell.value, offset); + return result; } + bool compact_is_identifier = val_identifier(compact); ENSURE_COND( - val_identifier(compact), + compact_is_identifier, "unsupported pure C expression `%s`; supported forms are `x`, `x + n`, " "`x->field`, and `&(x->field)`", expression); - return val_read_variable(symhp, compact).value; + val_cell cell = val_read_variable(symhp, compact, data_at_head); + term result = cell.value; + return result; err: ERR_FUN_PUTS("val_of", cstr_string(expression)); return empty_term; } -PROOF void set_symbolic_state(const thm raw_symst_ent) { - term qcp_symst = cst_get_symbolic_state(); - thm decode_symst_eq = decode_bool_calls_eq(qcp_symst); - term raw_symst = dest_eq(concl(decode_symst_eq)).tm2; +PROOF void set_symbolic_state_transition(const thm raw_transition) { + ENSURE_COND(!IS_NULL(raw_transition), + "symbolic-state transition theorem is empty"); - thm aligned_raw_symst_ent = raw_symst_ent; - term raw_before = dest_sl_ent(concl(aligned_raw_symst_ent)).tm1; - if (!equals_term(raw_before, raw_symst)) { - aligned_raw_symst_ent = rehant_slrule(aligned_raw_symst_ent, raw_symst); - } - - term raw_after = dest_sl_ent(concl(aligned_raw_symst_ent)).tm2; - thm encode_symst_eq = encode_bool_calls_eq(raw_after); - thm qcp_symst_ent = trans_slrule(eq2ent(decode_symst_eq), - aligned_raw_symst_ent); - qcp_symst_ent = trans_slrule(qcp_symst_ent, - eq2ent(encode_symst_eq)); - cst_set_symbolic_state(qcp_symst_ent); + cst_set_symbolic_state(raw_transition); + return; +err: + ERR_FUN_PUTS( + "set_symbolic_state_transition", + IS_NULL(raw_transition) ? cstr_string("") + : cstr_thm(raw_transition)); + return; } -PROOF term Hconj(const term_list hconjs) { return list_mk_sl_sep(hconjs); } +PROOF term Hconj(const term_list hconjs) { + term result = list_mk_sl_sep(hconjs); + return result; +} PROOF term ExHconj(const term_list exs, const term_list hconjs) { - return list_mk_sl_exists(exs, Hconj(hconjs)); + term body = Hconj(hconjs); + term result = list_mk_sl_exists(exs, body); + return result; } PROOF term Hdisj(const term_list hdisjs1, const term_list hdisjs2) { term hdisj1 = list_mk_sl_sep(hdisjs1); term hdisj2 = list_mk_sl_sep(hdisjs2); - term ret_tm = mk_binop(sl_or(), hdisj1, hdisj2); + const sl_theory* theory = sl_current_theory(); + term or_head = theory->or_op; + term ret_tm = mk_binop(or_head, hdisj1, hdisj2); return ret_tm; } @@ -389,99 +400,217 @@ PROOF term ExHdisj(const term_list exs1, const term_list hdisjs1, const term_lis hdisj1 = list_mk_sl_exists(exs1, hdisj1); term hdisj2 = list_mk_sl_sep(hdisjs2); hdisj2 = list_mk_sl_exists(exs2, hdisj2); - term ret_tm = mk_binop(sl_or(), hdisj1, hdisj2); + const sl_theory* theory = sl_current_theory(); + term or_head = theory->or_op; + term ret_tm = mk_binop(or_head, hdisj1, hdisj2); return ret_tm; } -PROOF term fact(const term b) { return mk_sl_fact(b); } +PROOF term fact(const term b) { + term result = mk_sl_fact(b); + return result; +} -PROOF term return_int(const term v) { return `fact(__return == ${v:int}:int)`; } +PROOF term return_int(const term v) { + term result = `fact(__return == ${v:int}:int)`; + return result; +} PROOF term return_bool(const term b) { - term res = Hdisj( - TERM_LIST(fact(`${b:bool} <=> T`), return_int(`1i`)), - TERM_LIST(fact(`~(${b:bool} <=> T)`), return_int(`0i`)) - ); + term true_condition = `${b:bool} <=> T`; + term true_fact = fact(true_condition); + term one = `1i`; + term true_return = return_int(one); + term_list true_branch = TERM_LIST(true_fact, true_return); + term false_condition = `~(${b:bool} <=> T)`; + term false_fact = fact(false_condition); + term zero = `0i`; + term false_return = return_int(zero); + term_list false_branch = TERM_LIST(false_fact, false_return); + term res = Hdisj(true_branch, false_branch); return res; } PROOF term return_bool_rel(const term b) { - term res = Hdisj( - TERM_LIST(fact(`${b:bool}:bool`), return_int(`1i`)), - TERM_LIST(fact(`~(${b:bool})`), return_int(`0i`)) - ); + term true_condition = `${b:bool}:bool`; + term true_fact = fact(true_condition); + term one = `1i`; + term true_return = return_int(one); + term_list true_branch = TERM_LIST(true_fact, true_return); + term false_condition = `~(${b:bool})`; + term false_fact = fact(false_condition); + term zero = `0i`; + term false_return = return_int(zero); + term_list false_branch = TERM_LIST(false_fact, false_return); + term res = Hdisj(true_branch, false_branch); return res; } PROOF term return_eq(term v1, term v2) { - term res = Hdisj( - TERM_LIST(fact(`${v1:int} == ${v2:int}:int`), return_int(`1i`)), - TERM_LIST(fact(`~(${v1:int} == ${v2:int}:int)`), return_int(`0i`)) - ); + term equal = `${v1:int} == ${v2:int}:int`; + term equal_fact = fact(equal); + term one = `1i`; + term equal_return = return_int(one); + term_list equal_branch = TERM_LIST(equal_fact, equal_return); + term unequal = `~(${v1:int} == ${v2:int}:int)`; + term unequal_fact = fact(unequal); + term zero = `0i`; + term unequal_return = return_int(zero); + term_list unequal_branch = TERM_LIST(unequal_fact, unequal_return); + term res = Hdisj(equal_branch, unequal_branch); return res; } PROOF term return_neq(term v1, term v2) { - term res = Hdisj( - TERM_LIST(fact(`${v1:int} == ${v2:int}:int`), return_int(`0i`)), - TERM_LIST(fact(`~(${v1:int} == ${v2:int}:int)`), return_int(`1i`)) - ); + term equal = `${v1:int} == ${v2:int}:int`; + term equal_fact = fact(equal); + term zero = `0i`; + term equal_return = return_int(zero); + term_list equal_branch = TERM_LIST(equal_fact, equal_return); + term unequal = `~(${v1:int} == ${v2:int}:int)`; + term unequal_fact = fact(unequal); + term one = `1i`; + term unequal_return = return_int(one); + term_list unequal_branch = TERM_LIST(unequal_fact, unequal_return); + term res = Hdisj(equal_branch, unequal_branch); return res; } PROOF thm cst_new_fun_definition(const char *name, const term tm, const type export_type) { + ENSURE_COND(name != NULL, "exported function name must not be null"); + ENSURE_COND(!IS_NULL(tm) && !IS_NULL(export_type), + "exported function definition must not be empty"); thm th = new_fun_definition(tm); term fun_tm = mk_const(name, export_type); - cst_add_const_to_header(fun_tm); + ENSURE_COND(cst_add_const_to_header(fun_tm) == 0, + "cannot register the exported function with QCP"); return th; +err: + ERR_FUN_PUTS("cst_new_fun_definition", + name == NULL ? cstr_string("") : cstr_string(name)); + return empty_theorem; } PROOF thm cst_new_rec_definition(const char *name, const thm rec, const term tm, const type export_type) { + ENSURE_COND(name != NULL, "exported recursive function name must not be null"); + ENSURE_COND(!IS_NULL(rec) && !IS_NULL(tm) && !IS_NULL(export_type), + "exported recursive function definition must not be empty"); thm th = new_rec_definition(rec, tm); term fun_tm = mk_const(name, export_type); - cst_add_const_to_header(fun_tm); + ENSURE_COND(cst_add_const_to_header(fun_tm) == 0, + "cannot register the exported recursive function with QCP"); return th; +err: + ERR_FUN_PUTS( + "cst_new_rec_definition", + name == NULL ? cstr_string("") : cstr_string(name)); + return empty_theorem; } -/* This runs when the default verification-time library is loaded. It checks +/* Run only after the client has installed its selected SL theory. This checks * the structural boundary without trusting any new theorem or QCP behavior. */ -PROOF static int bool_call_adapter_smoke_test(void) { - size_t axioms_before = vector_size(get_all_axioms()); +PROOF int veriftime_bool_call_adapter_smoke_test(void) { + thm_list initial_axioms = get_all_axioms(); + size_t axioms_before = vector_size(initial_axioms); term raw_call = `EVEN 0`; - term encoded_call = mk_iff(raw_call, mk_true()); + term truth = mk_true(); + term qcp_raw_call = `EVEN (num_of_int (&0))`; + term encoded_call = mk_iff(qcp_raw_call, truth); term native_comparison = `0i <= 1i`; - term raw_assertion = mk_sl_sep(mk_sl_fact(raw_call), - mk_sl_fact(native_comparison)); - term qcp_assertion = mk_sl_sep(mk_sl_fact(encoded_call), - mk_sl_fact(native_comparison)); + term raw_call_fact = mk_sl_fact(raw_call); + term native_comparison_fact = mk_sl_fact(native_comparison); + term raw_assertion = mk_sl_sep(raw_call_fact, native_comparison_fact); + term encoded_call_fact = mk_sl_fact(encoded_call); + term qcp_assertion = mk_sl_sep(encoded_call_fact, native_comparison_fact); thm encode_eq = encode_bool_calls_eq(raw_assertion); - ENSURE_COND(vector_size(hyp(encode_eq)) == 0, + term_list encode_assumptions = hyp(encode_eq); + ENSURE_COND(vector_size(encode_assumptions) == 0, "Boolean-call encoding theorem is not closed"); - ENSURE_COND(equals_term(concl(encode_eq), - mk_eq(raw_assertion, qcp_assertion)), + term encode_ccl = concl(encode_eq); + term expected_encode_ccl = mk_eq(raw_assertion, qcp_assertion); + bool correct_encoding = equals_term(encode_ccl, expected_encode_ccl); + ENSURE_COND(correct_encoding, "Boolean-call encoding theorem has the wrong conclusion"); thm decode_eq = decode_bool_calls_eq(qcp_assertion); - ENSURE_COND(vector_size(hyp(decode_eq)) == 0, + term_list decode_assumptions = hyp(decode_eq); + ENSURE_COND(vector_size(decode_assumptions) == 0, "Boolean-call decoding theorem is not closed"); - ENSURE_COND(equals_term(concl(decode_eq), - mk_eq(qcp_assertion, raw_assertion)), + term decode_ccl = concl(decode_eq); + term expected_decode_ccl = mk_eq(qcp_assertion, raw_assertion); + bool correct_decoding = equals_term(decode_ccl, expected_decode_ccl); + ENSURE_COND(correct_decoding, "Boolean-call decoding theorem has the wrong conclusion"); thm encode_again = encode_bool_calls_eq(qcp_assertion); thm decode_again = decode_bool_calls_eq(raw_assertion); - ENSURE_COND(equals_term(concl(encode_again), - mk_eq(qcp_assertion, qcp_assertion)) && - equals_term(concl(decode_again), - mk_eq(raw_assertion, raw_assertion)), + term encode_again_ccl = concl(encode_again); + term expected_encode_again_ccl = mk_eq(qcp_assertion, qcp_assertion); + bool encode_idempotent = + equals_term(encode_again_ccl, expected_encode_again_ccl); + term decode_again_ccl = concl(decode_again); + term expected_decode_again_ccl = mk_eq(raw_assertion, raw_assertion); + bool decode_idempotent = + equals_term(decode_again_ccl, expected_decode_again_ccl); + ENSURE_COND(encode_idempotent && decode_idempotent, "Boolean-call assertion conversion is not idempotent"); - ENSURE_COND(vector_size(get_all_axioms()) == axioms_before, + + term bound = `__qcp_bound:num`; + term bound_raw_call = `EVEN (__qcp_bound:num)`; + term bound_qcp_call = bound_raw_call; + term bound_raw_body = + mk_sl_sep(mk_sl_fact(bound_raw_call), sl_emp()); + term bound_qcp_body = mk_sl_sep( + mk_sl_fact(mk_iff(bound_qcp_call, truth)), sl_emp()); + term bound_raw_assertion = mk_sl_exists(bound, bound_raw_body); + term bound_qcp_assertion = mk_sl_exists(bound, bound_qcp_body); + + thm bound_encode_eq = encode_bool_calls_eq(bound_raw_assertion); + dest_eq_results bound_encoding = dest_eq(concl(bound_encode_eq)); + ENSURE_COND(is_sl_exists(bound_encoding.tm2), + "Boolean-call encoding erased an existential binder"); + dest_binder_results encoded_binder = dest_sl_exists(bound_encoding.tm2); + ENSURE_COND(equals_term(encoded_binder.v, bound), + "Boolean-call encoding renamed the existential binder from `%s` " + "to `%s`", + string_of_term(bound), string_of_term(encoded_binder.v)); + ENSURE_COND(equals_term(encoded_binder.tm, bound_qcp_body), + "Boolean-call encoding produced body `%s`, expected `%s`", + string_of_term(encoded_binder.tm), + string_of_term(bound_qcp_body)); + ENSURE_COND(equals_term(bound_encoding.tm1, bound_raw_assertion), + "Boolean-call encoding changed its source endpoint"); + ENSURE_COND(equals_term(bound_encoding.tm2, bound_qcp_assertion), + "Boolean-call encoding produced endpoint `%s`, expected `%s`", + string_of_term(bound_encoding.tm2), + string_of_term(bound_qcp_assertion)); + + thm bound_decode_eq = decode_bool_calls_eq(bound_qcp_assertion); + dest_eq_results bound_decoding = dest_eq(concl(bound_decode_eq)); + ENSURE_COND(is_sl_exists(bound_decoding.tm2), + "Boolean-call decoding erased an existential binder"); + dest_binder_results decoded_binder = dest_sl_exists(bound_decoding.tm2); + ENSURE_COND(equals_term(decoded_binder.v, bound), + "Boolean-call decoding renamed the existential binder from `%s` " + "to `%s`", + string_of_term(bound), string_of_term(decoded_binder.v)); + ENSURE_COND(equals_term(decoded_binder.tm, bound_raw_body), + "Boolean-call decoding produced body `%s`, expected `%s`", + string_of_term(decoded_binder.tm), + string_of_term(bound_raw_body)); + ENSURE_COND(equals_term(bound_decoding.tm1, bound_qcp_assertion), + "Boolean-call decoding changed its source endpoint"); + ENSURE_COND(equals_term(bound_decoding.tm2, bound_raw_assertion), + "Boolean-call decoding produced endpoint `%s`, expected `%s`", + string_of_term(bound_decoding.tm2), + string_of_term(bound_raw_assertion)); + + thm_list final_axioms = get_all_axioms(); + ENSURE_COND(vector_size(final_axioms) == axioms_before, "Boolean-call assertion conversion changed the axiom set"); return 0; err: - ERR_FUN_PUTS("bool_call_adapter_smoke_test"); + ERR_FUN_PUTS("veriftime_bool_call_adapter_smoke_test"); return -1; } - -PROOF static int BOOL_CALL_ADAPTER_SMOKE = bool_call_adapter_smoke_test(); diff --git a/userlib/qcp/veriftime.h b/userlib/qcp/veriftime.h index 95e9ad58160420f8311e076d40ce40bb166e4a23..d66cc1dfc9ab696a17fff3ae0d519f25577d02df 100644 --- a/userlib/qcp/veriftime.h +++ b/userlib/qcp/veriftime.h @@ -5,25 +5,76 @@ * The annotation macros assemble source-language attributes and adapt their * assertions to QCP's parser. A direct user-facing `fact(P args)`, where * `P args` is a non-built-in boolean call, is printed as - * `fact(P args <=> T)`. The proof API exposes the inverse view, so ordinary - * proof code and operational transformations continue to use `fact(P args)`. + * `fact(P args <=> T)`, where `<=>` is the C* source spelling used by the QCP + * boundary for Boolean equivalence. The proof API exposes the inverse view, so + * ordinary proof code and operational transformations continue to use + * `fact(P args)`. + * + * The installed linear assertion model distinguishes `pure(phi)` from + * `fact(phi)`: `pure(phi)` is resource-independent, whereas `fact(phi)` is + * true only at the exact resource unit. Validity and update witnesses use + * `fact`; the two constructors are not interchangeable. + * + * Notation in this header follows the proof stdlib: `𝒜 ⊢ φ` is a HOL + * theorem judgment, `P ⊢SL Q` is the active SL entailment, and `P ⇛ Q` + * is the installed view shift. Raw HOL equality is written `=` in + * mathematical contracts; C* term snippets spell the same equality `==` and + * Boolean equivalence `<=>`. */ #pragma once #include "proof/proof.h" +#include "proof/printers.h" + +/* C verification roots select the complete physical × ghost assertion model + * before parsing their declarations. A custom-resource root delays this + * default and invokes `c_logic_install_named(R)` after defining and exporting + * its payload RA `R`. The installer itself selects the complete ghost algebra + * `named_ra R`; callers must not wrap `R` first. */ +#ifndef CSTAR_DEFER_C_LOGIC_INSTALL +#include "userlib/qcp/c_logic_default.h" +#require "userlib/qcp/c_logic_default.c" +#endif /********************************************************** * C* Annotation Syntax * **********************************************************/ +/** Attach raw parameter metadata to the following C* declaration. */ #define PARAM(...) [[cst::param(__VA_ARGS__)]] + +/** + * Attach a function precondition equal to the ordered separating conjunction + * `Hconj(TERM_LIST(__VA_ARGS__))`, encoded for the QCP assertion boundary. + */ #define REQUIRE(...) [[cst::require(bool_calls_for_qcp(Hconj(TERM_LIST(__VA_ARGS__))))]] + +/** + * Attach a function postcondition equal to the ordered separating conjunction + * `Hconj(TERM_LIST(__VA_ARGS__))`, encoded for the QCP assertion boundary. + */ #define ENSURE(...) [[cst::ensure(bool_calls_for_qcp(Hconj(TERM_LIST(__VA_ARGS__))))]] + +/** + * Attach the existential postcondition + * `ExHconj(exs, TERM_LIST(__VA_ARGS__))`, then encode it for QCP. + * `exs` is an ordered `term_list` of HOL variables. + */ #define ENSURE_EX(exs, ...) [[cst::ensure(bool_calls_for_qcp(ExHconj(exs, TERM_LIST(__VA_ARGS__))))]] + +/** Mark the following declaration for C* proof-time execution. */ #define PROOF [[cst::proof]] + +/** Attach an encoded full loop invariant built with `Hconj`. */ #define INV(...) [[cst::invariant(bool_calls_for_qcp(Hconj(TERM_LIST(__VA_ARGS__))))]] + +/** Attach an encoded existential full loop invariant built with `ExHconj`. */ #define INV_EX(exs, ...) [[cst::invariant(bool_calls_for_qcp(ExHconj(exs, TERM_LIST(__VA_ARGS__))))]] + +/** Attach an encoded partial loop invariant built with `Hconj`. */ #define PART_INV(...) [[cst::partial_invariant(bool_calls_for_qcp(Hconj(TERM_LIST(__VA_ARGS__))))]] + +/** Attach an encoded existential partial loop invariant built with `ExHconj`. */ #define PART_INV_EX(exs, ...) [[cst::partial_invariant(bool_calls_for_qcp(ExHconj(exs, TERM_LIST(__VA_ARGS__))))]] /********************************************************** @@ -82,16 +133,21 @@ PROOF term return_neq(term lhs, term rhs); **********************************************************/ /** - * Proves `|- raw_assertion = qcp_assertion` by encoding every complete - * `fact(P args)` whose predicate is a non-built-in, constant-headed boolean - * application as `fact(P args <=> T)`. The conversion is shallow at each fact, - * idempotent, and does not inspect or change symbolic state. + * Proves `∅ ⊢ raw_assertion = qcp_assertion`. One HOL-server request traverses + * the complete assertion and constructs this equality from kernel rules. It + * encodes every complete `fact(P args)` whose predicate is a non-built-in, + * constant-headed boolean + * application as `fact(P args <=> T)`, and recursively encodes each HOL + * natural numeral `n` as QCP's parser-stable `num_of_int (&n)` form. Integer + * literals are left intact. The conversion is kernel-certified, idempotent, + * and does not inspect or change symbolic state. */ PROOF thm encode_bool_calls_eq(const term raw_assertion); /** - * Proves `|- qcp_assertion = raw_assertion` for the representation introduced - * by `encode_bool_calls_eq`. The conversion is idempotent. + * Proves `∅ ⊢ qcp_assertion = raw_assertion` for the representation introduced + * by `encode_bool_calls_eq`, using `NUM_OF_INT_OF_NUM` for natural literals. + * The conversion is kernel-certified and idempotent. */ PROOF thm decode_bool_calls_eq(const term qcp_assertion); @@ -101,6 +157,16 @@ PROOF term bool_calls_for_qcp(const term raw_assertion); /** Returns the current symbolic state in its proof-facing representation. */ PROOF term get_symbolic_state(void); +/** + * Check the QCP assertion-boundary encoder for the currently installed SL + * theory. Call only after `sl_install_theory` (normally via + * `c_logic_install_named`). + * Returns zero after checking encode/decode shape, exact preservation of an + * existential binder, idempotence, closedness, and preservation of the HOL + * axiom set. + */ +PROOF int veriftime_bool_call_adapter_smoke_test(void); + /** * (Experimental) * Computes the symbolic value of a small, side-effect-free C-expression @@ -129,11 +195,45 @@ PROOF term get_symbolic_state(void); PROOF term val_of(const char *expression); /** - * Commits a closed proof-facing `symst_ent` through the QCP representation - * boundary. Its antecedent must match the decoded current symbolic state modulo - * separation-logic ACU; its consequent is encoded before installation. + * Commit one complete symbolic-state transition theorem. + * + * With an installed assertion descriptor, `transition` must conclude either + * the active SL entailment + * + * source ⊢SL target + * + * or the installed SL viewshift + * + * source ⇛ target. + * + * `transition` must be hypothesis-free and monomorphic: `hyp(transition)` is + * empty and its conclusion has no free type variables. Free term variables + * are allowed because program symbolic states contain them. The conclusion + * relation must have exactly two arguments, be the active entailment or + * installed view shift, and both endpoints must have the installed + * descriptor's assertion type. + * + * In the descriptor-backed path, one theorem-producing HOL request decodes the + * exact QCP-facing current state, checks that its proof-facing form agrees with + * `source` modulo the active certified SEP ACU laws, rebases `transition` onto + * that exact native source, and encodes only `target`. This is necessary because + * decoding intentionally forgets QCP parser aliases and therefore cannot always + * be inverted by re-encoding the proof-facing source. The native single-theorem + * setter reads the current state again and requires exact raw-text equality + * with the state proved above. Thus any intervening mutation is rejected, + * including an ACU-equivalent reassociation, reordering, or unit change. + * + * Use `set_symbolic_state(transition)` at call sites. The explicitly named + * function below is the addressable implementation; its distinct C symbol + * keeps the public proof API separate from the native runtime entry point. + * A contract violation sets proof error status and does not submit a target to + * the symbolic engine. */ -PROOF void set_symbolic_state(const thm symst_ent); +PROOF void set_symbolic_state_transition(const thm transition); + +/** Commit one active entailment or installed viewshift theorem. */ +#define set_symbolic_state(transition) \ + set_symbolic_state_transition((transition)) /********************************************************** * IDE Value Printers * @@ -146,46 +246,6 @@ PROOF void set_symbolic_state(const thm symst_ent); * library. Projects may define the same convention for their own types. */ -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); -} - PROOF static inline char *cst_string_of_gnode(const gnode gn) { if (gn == NULL) return ""; return cstr_gnode(gn); @@ -201,14 +261,26 @@ PROOF static inline char *cst_string_of_gnode_list(const gnode_list gns) { /** * Creates an LCF function definition and exports the named constant to QCP. - * `name` and `export_type` must identify the constant defined by `equation`. + * `name` and `export_type` must identify the constant defined by `equation`; + * this association is a caller precondition and is not independently derived + * from the equation. Definition precedes export, so a later export failure + * leaves the HOL constant permanently defined. Such a failure is + * nontransactional and proof-initialization fail-stop, not safely retryable. + * Returns the definition theorem on success and `empty_theorem` after setting + * proof error status on failure. */ PROOF thm cst_new_fun_definition(const char *name, const term equation, const type export_type); /** * Creates an LCF recursive definition and exports its constant to QCP. - * `name` and `export_type` must identify the constant defined by `equation`. + * `name` and `export_type` must identify the constant defined by `equation`; + * this association is a caller precondition and is not independently derived + * from the equation. The recursive HOL definition is created before QCP + * export, so an export failure leaves permanent global definition state and is + * proof-initialization fail-stop. + * Returns the recursive definition theorem on success and `empty_theorem` + * after setting proof error status on failure. */ PROOF thm cst_new_rec_definition(const char *name, const thm recursion, const term equation, diff --git a/userlib/smt/smt.c b/userlib/smt/smt.c index 0cee712bcf19af2d4f56180604fe37946127ac9c..40307aca670c7224e275da2419374cd49a5e8fb8 100644 --- a/userlib/smt/smt.c +++ b/userlib/smt/smt.c @@ -1,6 +1,8 @@ #cst_include "cstar.h" #cst_include "z3.h" +#define CSTAR_DEFER_C_LOGIC_INSTALL + #include "userlib/smt/smt.h" #require "userlib/qcp/veriftime.c"