From 161ed89c63713832a639e53cd3e7b22c5d994a56 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Wed, 22 Apr 2026 13:24:09 -0400 Subject: [PATCH 01/11] Added poject layout, md files for verification of cstring. Proved initial set of functions using ctring.R and a lower-level alternative cstringz.R --- rocq-brick-libstdcpp/proof/cstring/DESIGN.md | 84 ++++++ .../proof/cstring/inc_cstring.cpp | 1 + rocq-brick-libstdcpp/proof/cstring/model.v | 52 ++++ .../proof/cstring/model_old.v | 76 ++++++ .../proof/cstring/planning.md | 102 ++++++++ rocq-brick-libstdcpp/proof/cstring/pred.v | 9 + rocq-brick-libstdcpp/proof/cstring/pred_old.v | 188 ++++++++++++++ rocq-brick-libstdcpp/proof/cstring/spec.v | 36 +++ rocq-brick-libstdcpp/proof/cstring/spec_old.v | 36 +++ rocq-brick-libstdcpp/proof/dune.inc | 9 + rocq-brick-libstdcpp/test/cstring/proof.v | 218 ++++++++++++++++ rocq-brick-libstdcpp/test/cstring/proof_old.v | 239 ++++++++++++++++++ rocq-brick-libstdcpp/test/cstring/test.cpp | 61 +++++ rocq-brick-libstdcpp/test/dune.inc | 9 + 14 files changed, 1120 insertions(+) create mode 100644 rocq-brick-libstdcpp/proof/cstring/DESIGN.md create mode 100644 rocq-brick-libstdcpp/proof/cstring/inc_cstring.cpp create mode 100644 rocq-brick-libstdcpp/proof/cstring/model.v create mode 100644 rocq-brick-libstdcpp/proof/cstring/model_old.v create mode 100644 rocq-brick-libstdcpp/proof/cstring/planning.md create mode 100644 rocq-brick-libstdcpp/proof/cstring/pred.v create mode 100644 rocq-brick-libstdcpp/proof/cstring/pred_old.v create mode 100644 rocq-brick-libstdcpp/proof/cstring/spec.v create mode 100644 rocq-brick-libstdcpp/proof/cstring/spec_old.v create mode 100644 rocq-brick-libstdcpp/test/cstring/proof.v create mode 100644 rocq-brick-libstdcpp/test/cstring/proof_old.v create mode 100644 rocq-brick-libstdcpp/test/cstring/test.cpp diff --git a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md new file mode 100644 index 0000000..3a749dd --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md @@ -0,0 +1,84 @@ +# `` Design Notes + +## Current Slice + +The first supported API slice covers the read-only byte-string functions +`strlen`, `strcmp`, and `strncmp`. + +The reusable specs use the existing `cstring.R` abstraction. This keeps the +library-facing contract aligned with existing clients such as `cstdlib::atoi` +and `iostream`: callers provide a pointer to a valid null-terminated C string +whose logical payload is a `cstring.t`. + +The ordinary litmus tests for this slice are proven in both +`test/cstring/proof.v` and `test/cstring/proof_old.v`. Embedded-null literal +tests are split into separate functions; they are specified but left admitted +in the active `cstring.R` development, and proven in `proof_old.v` using the +archived lower-level bridge. + +## Representation Choice + +`cstring.R` remains the active representation for this slice. It describes the +null-terminated string payload itself, not arbitrary storage that may continue +after the first null byte. + +This means embedded-null or larger-buffer cases are handled on the client side: +a proof that starts from a larger literal or array resource must split off the +prefix that forms the `cstring.R` argument and frame or later recombine the +remaining bytes. That makes these cases visibly about buffer decomposition +rather than about the semantic contract of read-only cstring functions. + +### `arrayR` and `arrayLR` + +For hand-written byte-buffer specs and reusable buffer predicates, prefer +`arrayLR` over one-sided `arrayR` or `arrayL` when the surrounding interface +leaves us that choice. The two-sided predicate usually preserves more useful +ownership information for clients that both read and later restore or mutate a +buffer. + +The current explicit `char[]` litmus tests are slightly different: cpp2v +generates stack-array initializer resources as concrete `arrayR` predicates. +Their proofs therefore use local `arrayR` splitting/recombination lemmas to +match the generated proof state directly. This should not be read as a general +preference for `arrayR` in library specs; it is a proof-local accommodation for +the shape of generated stack-buffer resources. + +## Archived Alternative + +The earlier experiment introduced a lower-level `cstringz.R q s tail` predicate +for concrete character arrays shaped like: + +```text +cstring.to_zstring s ++ tail +``` + +That variant is preserved in: + +- `model_old.v` +- `pred_old.v` +- `spec_old.v` +- `test/cstring/proof_old.v` + +Those files are kept for comparison or rollback while we proceed with the +`cstring.R`-based active design. + +## Leftover Tasks + +- Transfer the string-literal embedded-null proof bridge from + `test/cstring/proof_old.v` to the active `test/cstring/proof.v` when we want + to discharge the currently admitted literal tests without depending on + `pred_old.v`. The active array-buffer proofs already cover the analogous + `char[]` client-side splitting pattern. +- Optionally extend `test/cstring/proof_old.v` with the explicit `char[]` + array-buffer litmus proofs if we later want side-by-side regression coverage + for the archived `cstringz.R` design. For now the active and archived proof + files are intentionally not kept in lockstep. +- Consider whether cpp2v should generate `arrayLR` rather than `arrayR` for + stack-allocated array initializers, or provide a standard bridge for this + case. The active `char[]` proofs use local `arrayR` helpers only because the + generated proof state has that shape. +- Keep undefined behavior out of green specs and tests: no null pointers, + invalid pointers, or arrays without a reachable null terminator. +- Use the existing mutable cstring buffer support, especially `cstring.bufR`, + when specifying functions such as `strcpy`, `strncpy`, `strcat`, and + `strncat`; revisit only if these predicates are not expressive enough. diff --git a/rocq-brick-libstdcpp/proof/cstring/inc_cstring.cpp b/rocq-brick-libstdcpp/proof/cstring/inc_cstring.cpp new file mode 100644 index 0000000..819890a --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/inc_cstring.cpp @@ -0,0 +1 @@ +#include diff --git a/rocq-brick-libstdcpp/proof/cstring/model.v b/rocq-brick-libstdcpp/proof/cstring/model.v new file mode 100644 index 0000000..a0b2d0a --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/model.v @@ -0,0 +1,52 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.prelude.numbers. +Require Import skylabs.prelude.bytestring. + +#[local] Set Primitive Projections. +#[local] Open Scope Z_scope. + +Definition byte_ord (c : Byte.byte) : Z := + Z.of_N (Byte.to_N c). + +Fixpoint strcmp (s1 s2 : bs) : Z := + match s1, s2 with + | BS.EmptyString, BS.EmptyString => 0 + | BS.EmptyString, BS.String c2 _ => - byte_ord c2 + | BS.String c1 _, BS.EmptyString => byte_ord c1 + | BS.String c1 rest1, BS.String c2 rest2 => + if bool_decide (c1 = c2) then strcmp rest1 rest2 + else byte_ord c1 - byte_ord c2 + end. + +Fixpoint strncmp_nat (n : nat) (s1 s2 : bs) : Z := + match n with + | O => 0 + | S n' => + match s1, s2 with + | BS.EmptyString, BS.EmptyString => 0 + | BS.EmptyString, BS.String c2 _ => - byte_ord c2 + | BS.String c1 _, BS.EmptyString => byte_ord c1 + | BS.String c1 rest1, BS.String c2 rest2 => + if bool_decide (c1 = c2) then strncmp_nat n' rest1 rest2 + else byte_ord c1 - byte_ord c2 + end + end. + +Definition strncmp (s1 s2 : bs) (n : N) : Z := + strncmp_nat (N.to_nat n) s1 s2. + +#[local] Open Scope bs_scope. + +Succeed Example strcmp_equal : strcmp "abc" "abc" = 0 := eq_refl. +Succeed Example strcmp_less : strcmp "abc" "abd" = -1 := eq_refl. +Succeed Example strcmp_greater : strcmp "abd" "abc" = 1 := eq_refl. +Succeed Example strcmp_prefix_less : strcmp "ab" "abc" = -99 := eq_refl. +Succeed Example strcmp_prefix_greater : strcmp "abc" "ab" = 99 := eq_refl. + +Succeed Example strncmp_zero : strncmp "abc" "abd" 0 = 0 := eq_refl. +Succeed Example strncmp_equal_prefix : strncmp "abc" "abd" 2 = 0 := eq_refl. +Succeed Example strncmp_diff_at_bound : strncmp "abc" "abd" 3 = -1 := eq_refl. diff --git a/rocq-brick-libstdcpp/proof/cstring/model_old.v b/rocq-brick-libstdcpp/proof/cstring/model_old.v new file mode 100644 index 0000000..456cd58 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/model_old.v @@ -0,0 +1,76 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.prelude.numbers. +Require Import skylabs.prelude.bytestring. + +#[local] Set Primitive Projections. +#[local] Open Scope Z_scope. + +Definition byte_ord (c : Byte.byte) : Z := + Z.of_N (Byte.to_N c). + +Fixpoint strlen (s : bs) : N := + match s with + | BS.EmptyString => 0%N + | BS.String _ rest => (1 + strlen rest)%N + end. + +Fixpoint strlen_bytes (bytes : list N) : N := + match bytes with + | nil => 0%N + | cons c rest => + if bool_decide (c = 0%N) then 0%N + else (1 + strlen_bytes rest)%N + end. + +Fixpoint strcmp (s1 s2 : bs) : Z := + match s1, s2 with + | BS.EmptyString, BS.EmptyString => 0 + | BS.EmptyString, BS.String c2 _ => - byte_ord c2 + | BS.String c1 _, BS.EmptyString => byte_ord c1 + | BS.String c1 rest1, BS.String c2 rest2 => + if bool_decide (c1 = c2) then strcmp rest1 rest2 + else byte_ord c1 - byte_ord c2 + end. + +Fixpoint strncmp_nat (n : nat) (s1 s2 : bs) : Z := + match n with + | O => 0 + | S n' => + match s1, s2 with + | BS.EmptyString, BS.EmptyString => 0 + | BS.EmptyString, BS.String c2 _ => - byte_ord c2 + | BS.String c1 _, BS.EmptyString => byte_ord c1 + | BS.String c1 rest1, BS.String c2 rest2 => + if bool_decide (c1 = c2) then strncmp_nat n' rest1 rest2 + else byte_ord c1 - byte_ord c2 + end + end. + +Definition strncmp (s1 s2 : bs) (n : N) : Z := + strncmp_nat (N.to_nat n) s1 s2. + +#[local] Open Scope bs_scope. + +Succeed Example strlen_empty : strlen "" = 0%N := eq_refl. +Succeed Example strlen_three : strlen "abc" = 3%N := eq_refl. + +Succeed Example strlen_bytes_empty : strlen_bytes nil = 0%N := eq_refl. +Succeed Example strlen_bytes_three : + strlen_bytes (97%N :: 98%N :: 99%N :: nil) = 3%N := eq_refl. +Succeed Example strlen_bytes_embedded_null : + strlen_bytes (97%N :: 98%N :: 0%N :: 99%N :: 100%N :: nil) = 2%N := + eq_refl. + +Succeed Example strcmp_equal : strcmp "abc" "abc" = 0 := eq_refl. +Succeed Example strcmp_less : strcmp "abc" "abd" = -1 := eq_refl. +Succeed Example strcmp_greater : strcmp "abd" "abc" = 1 := eq_refl. +Succeed Example strcmp_prefix_less : strcmp "ab" "abc" = -99 := eq_refl. +Succeed Example strcmp_prefix_greater : strcmp "abc" "ab" = 99 := eq_refl. + +Succeed Example strncmp_zero : strncmp "abc" "abd" 0 = 0 := eq_refl. +Succeed Example strncmp_equal_prefix : strncmp "abc" "abd" 2 = 0 := eq_refl. +Succeed Example strncmp_diff_at_bound : strncmp "abc" "abd" 3 = -1 := eq_refl. diff --git a/rocq-brick-libstdcpp/proof/cstring/planning.md b/rocq-brick-libstdcpp/proof/cstring/planning.md new file mode 100644 index 0000000..93beeb2 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/planning.md @@ -0,0 +1,102 @@ +# `` Specification Planning + +## Session Context + +The goal is to develop BRiCk specifications and litmus tests, with specs and +proofs, for the functions exposed by the C++ `` API described by +cppreference. + +The intended workflow is iterative: + +- familiarize ourselves with the API and textual specification; +- stay consistent with the `brick-libcpp` directory structure; +- propose and revise a plan before carrying out each slice; +- keep litmus tests as `void` functions using suitable `assert` statements + when possible; +- validate Rocq files through `dune`. + +## Current Mental Model + +The current workspace contains a partial but coherent first slice for the +read-only null-terminated byte-string operations: + +- `model.v` defines pure byte-string models for `strcmp` and `strncmp`; the + active `strlen` spec uses the existing `cstring.strlen`. +- `pred.v` is intentionally minimal and reuses the existing `cstring.R` + abstraction. +- `spec.v` specifies `strlen`, `strcmp`, and `strncmp` against `cstring.R`. +- `test/cstring/test.cpp` contains `void` litmus functions using `assert`. + The embedded-null literal cases are isolated into separate functions from the + ordinary `strlen`, `strcmp`, and `strncmp` tests. +- `test/cstring/proof.v` proves the ordinary `strlen`, `strcmp`, `strncmp`, and + slice-wrapper tests. The embedded-null tests are specified there but left + admitted because active clients must first split larger literal resources + before invoking the `cstring.R` specs. +- `test/cstring/proof_old.v` proves the same ordinary tests and also proves the + embedded-null tests using the archived lower-level bridge. +- `DESIGN.md` records the representation choice and remaining design notes. + +The main abstraction boundary is that `cstring.R` remains the convenient +client-facing null-terminated string predicate. The older `cstringz.R` predicate +is preserved only in `pred_old.v` and used by `proof_old.v` to demonstrate how +embedded-null literal resources can be split and recombined around calls to the +active specs. + +## `` API Surface + +cppreference groups the header into: + +- string manipulation: `strcpy`, `strncpy`, `strcat`, `strncat`, `strxfrm`; +- string examination: `strlen`, `strcmp`, `strncmp`, `strcoll`, `strchr`, + `strrchr`, `strspn`, `strcspn`, `strpbrk`, `strstr`, `strtok`; +- character-array manipulation: `memchr`, `memcmp`, `memset`, `memcpy`, + `memmove`; +- miscellaneous: `strerror`. + +The first implemented slice covers `strlen`, `strcmp`, and `strncmp`. + +## Proposed Plan + +1. Done: keep the existing v1 slice stable. + The active and archived files currently validate with `dune`; keep checking + them when touching this area: + `proof/cstring/model.vo`, `proof/cstring/pred.vo`, + `proof/cstring/spec.vo`, `proof/cstring/model_old.vo`, + `proof/cstring/pred_old.vo`, `proof/cstring/spec_old.vo`, + `test/cstring/proof.vo`, and `test/cstring/proof_old.vo`. + +2. Done: add explicit array-buffer litmus tests for the v1 slice. + Use `char[]` examples with bytes after the first `'\0'`. In the active + development, prove these by explicitly splitting off the `cstring.R` prefix + and recombining the remaining buffer resource after the call. Keep tests as + `void` functions with `assert`. The active `test/cstring/proof.v` now has + these proofs; extending `test/cstring/proof_old.v` with matching archived + proofs is an optional leftover task, not part of this completed step. + +3. Add read-only search and segment APIs next. + Suggested next slice: `strchr`, `strrchr`, `strspn`, `strcspn`, `strpbrk`, + and `strstr`. These mostly preserve input ownership and return either null + or a pointer into an existing string, so they extend the current read-only + story before mutable APIs complicate the model. + +4. Add byte-array APIs as a separate slice. + Suggested order: `memcmp`, `memchr`, then `memset`, then `memcpy`, then + `memmove`. These operate over counted arrays and do not require null + termination, so they likely need a distinct byte-buffer predicate/model. + +5. Add string-copy and concatenation APIs after mutable byte-array support. + Suggested order: `strcpy`, `strncpy`, `strcat`, and `strncat`. These require + destination capacity, mutation, null termination, and non-overlap + preconditions. + +6. Defer locale, global-state, and implementation-storage APIs. + `strcoll`, `strxfrm`, `strerror`, and especially `strtok` involve locale, + static/internal storage, or global tokenization state. Handle them last with + explicit abstraction choices or narrow axiomatization. + +7. Keep each slice approval-gated. + For each slice, update `model.v` if pure semantics are needed, update + `pred.v` only for ownership/resource predicates, add specs in `spec.v`, add + `void` assert litmus tests in `test/cstring/test.cpp`, prove representative + wrappers in `test/cstring/proof.v`, validate with `dune`, and then pause for + review. diff --git a/rocq-brick-libstdcpp/proof/cstring/pred.v b/rocq-brick-libstdcpp/proof/cstring/pred.v new file mode 100644 index 0000000..1ba26e6 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/pred.v @@ -0,0 +1,9 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Export skylabs.cpp.string. +Require Export skylabs.brick.libstdcpp.cstring.model. + +#[local] Set Primitive Projections. diff --git a/rocq-brick-libstdcpp/proof/cstring/pred_old.v b/rocq-brick-libstdcpp/proof/cstring/pred_old.v new file mode 100644 index 0000000..8fe3cb6 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/pred_old.v @@ -0,0 +1,188 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.auto.cpp.prelude.proof. +Require Import skylabs.auto.cpp.elpi.derive. +Require Export skylabs.cpp.string. +Require Export skylabs.brick.libstdcpp.cstring.model_old. + +#[local] Set Primitive Projections. + +Module cstringz. + Definition ab_0_cd_lit : literal_string.t := + {| + literal_string.bytes := + PrimStringAxioms.of_list + [Uint63Axioms.of_Z 97; Uint63Axioms.of_Z 98; Uint63Axioms.of_Z 0; + Uint63Axioms.of_Z 99; Uint63Axioms.of_Z 100]; + literal_string.bytes_per_char := 1; + |}. + + (** [R q s tail] owns a concrete C character array whose initial + null-terminated byte string is [s], followed by arbitrary [tail] bytes. *) + Definition R `{Σ : cpp_logic, σ : genv} (q : cQp.t) (s : cstring.t) + (tail : list N) : Rep := + let bytes := List.app (cstring.to_zstring s) tail in + arrayR (Tchar_ char_type.Cchar) + (fun c : N => charR q c) bytes. + + Lemma R_cstringR `{Σ : cpp_logic, σ : genv} q s : + R q s [] ** [| cstring.WF s |] ⊣⊢ cstring.R q s. + Proof. + rewrite /R /cstring.R /zstring.R. + rewrite app_nil_r. + iSplit; iIntros "[$ $]". + Qed. + + Lemma cstringR_R `{Σ : cpp_logic, σ : genv} q s : + cstring.R q s ⊢ R q s []. + Proof. + rewrite -R_cstringR. iIntros "[$ _]". + Qed. + + Lemma at_cstringR_R `{Σ : cpp_logic, σ : genv} (p : ptr) q s : + p |-> cstring.R q s ⊢ p |-> R q s []. + Proof. + apply heap_pred._at_cancel. + apply cstringR_R. + Qed. + + Lemma R_cstringR_entails `{Σ : cpp_logic, σ : genv} q s : + cstring.WF s -> R q s [] ⊢ cstring.R q s. + Proof. + intros Hwf. rewrite -R_cstringR. iIntros "HR". iFrame. done. + Qed. + + Lemma at_R_cstringR `{Σ : cpp_logic, σ : genv} (p : ptr) q s : + cstring.WF s -> p |-> R q s [] ⊢ p |-> cstring.R q s. + Proof. + intros Hwf. apply heap_pred._at_cancel. by apply R_cstringR_entails. + Qed. + + Lemma offset_entails `{Σ : cpp_logic, σ : genv} (o : offset) (P Q : Rep) : + (P ⊢ Q) -> o |-> P ⊢ o |-> Q. + Proof. + intros HPQ. apply _offsetR_mono. exact HPQ. + Qed. + + Lemma arrayR_N_to_char_R `{Σ : cpp_logic, σ : genv} q xs : + List.Forall (fun c => (c < 2 ^ 8)%N) xs -> + arrayR (Tchar_ char_type.Cchar) + (fun c : N => primR (Tchar_ char_type.Cchar) q + (N_to_char char_type.Cchar c)) xs ⊢ + arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs. + Proof. + induction 1 as [| x xs Hx Hxs IH]. + - rewrite !arrayR_nil. iIntros "[$ $]". + - rewrite !arrayR_cons. + rewrite (N_to_char_Cchar_eq _ Hx). + iIntros "[$ [$ Hxs]]". + iApply (offset_entails with "Hxs"). + exact IH. + Qed. + + Lemma arrayR_R_N_to_char `{Σ : cpp_logic, σ : genv} q xs : + List.Forall (fun c => (c < 2 ^ 8)%N) xs -> + arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ + arrayR (Tchar_ char_type.Cchar) + (fun c : N => primR (Tchar_ char_type.Cchar) q + (N_to_char char_type.Cchar c)) xs. + Proof. + induction 1 as [| x xs Hx Hxs IH]. + - rewrite !arrayR_nil. iIntros "[$ $]". + - rewrite !arrayR_cons. + rewrite (N_to_char_Cchar_eq _ Hx). + iIntros "[$ [$ Hxs]]". + iApply (offset_entails with "Hxs"). + exact IH. + Qed. + + Lemma string_bytesR_R `{Σ : cpp_logic, σ : genv} q lit s tail : + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun c => (c < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + string_bytesR char_type.Cchar q lit ⊢ R q s tail. + Proof. + intros Hbytes Hrange. + rewrite string_bytesR.unlock /R Hbytes. + iIntros "Ha". + iApply (arrayR_N_to_char_R with "Ha"). exact Hrange. + Qed. + + Lemma at_string_bytesR_R `{Σ : cpp_logic, σ : genv} (p : ptr) q lit s tail : + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun c => (c < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + p |-> string_bytesR char_type.Cchar q lit ⊢ p |-> R q s tail. + Proof. + intros Hbytes Hrange. + apply heap_pred._at_cancel. + apply string_bytesR_R; assumption. + Qed. + + Lemma R_string_bytesR `{Σ : cpp_logic, σ : genv} q lit s tail : + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun c => (c < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + R q s tail ⊢ string_bytesR char_type.Cchar q lit. + Proof. + intros Hbytes Hrange. + rewrite string_bytesR.unlock /R Hbytes. + iIntros "Ha". + iApply (arrayR_R_N_to_char with "Ha"). exact Hrange. + Qed. + + Lemma at_R_string_bytesR `{Σ : cpp_logic, σ : genv} (p : ptr) q lit s tail : + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun c => (c < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + p |-> R q s tail ⊢ p |-> string_bytesR char_type.Cchar q lit. + Proof. + intros Hbytes Hrange. + apply heap_pred._at_cancel. + apply R_string_bytesR; assumption. + Qed. + + Lemma at_string_bytesR_ab_0_cd_R `{Σ : cpp_logic, σ : genv} (p : ptr) q : + p |-> string_bytesR char_type.Cchar q ab_0_cd_lit ⊢ + p |-> R q "ab"%bs [99%N; 100%N; 0%N]. + Proof. + iIntros "Hlit". + iApply (at_string_bytesR_R with "Hlit"). + - rewrite cstring.to_zstring_unfold. vm_compute. + do 6 (constructor; [reflexivity|]); constructor. + Qed. + + Lemma at_R_ab_0_cd_string_bytesR `{Σ : cpp_logic, σ : genv} (p : ptr) q : + p |-> R q "ab"%bs [99%N; 100%N; 0%N] ⊢ + p |-> string_bytesR char_type.Cchar q ab_0_cd_lit. + Proof. + iIntros "HR". + iApply (at_R_string_bytesR with "HR"). + - rewrite cstring.to_zstring_unfold. vm_compute. + do 6 (constructor; [reflexivity|]); constructor. + Qed. + + Lemma at_R_string_bytesR_free `{Σ : cpp_logic, σ : genv} + (p : ptr) (q : Qp) lit s tail : + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun c => (c < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + □ (∀ t : Qp, p |-> string_bytesR char_type.Cchar t$c lit ={⊤}=∗ emp) -∗ + p |-> R q$c s tail ={⊤}=∗ emp. + Proof. + intros Hbytes Hrange. + iIntros "#Hfree HR". + iPoseProof (at_R_string_bytesR with "HR") as "Hlit"; [exact Hbytes|exact Hrange|]. + iApply ("Hfree" with "Hlit"). + Qed. + + Lemma at_R_ab_0_cd_free `{Σ : cpp_logic, σ : genv} (p : ptr) (q : Qp) : + □ (∀ t : Qp, + p |-> string_bytesR char_type.Cchar t$c ab_0_cd_lit ={⊤}=∗ emp) -∗ + p |-> R q$c "ab"%bs [99%N; 100%N; 0%N] ={⊤}=∗ emp. + Proof. + iIntros "#Hfree HR". + iPoseProof (at_R_ab_0_cd_string_bytesR with "HR") as "Hlit". + iApply ("Hfree" with "Hlit"). + Qed. + + #[only(lazy_unfold)] derive R. +End cstringz. diff --git a/rocq-brick-libstdcpp/proof/cstring/spec.v b/rocq-brick-libstdcpp/proof/cstring/spec.v new file mode 100644 index 0000000..7410e0c --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/spec.v @@ -0,0 +1,36 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.auto.cpp.specs. + +Require Export skylabs.brick.libstdcpp.cstring.pred. +Require Import skylabs.brick.libstdcpp.cstring.inc_cstring_cpp. + +#[local] Set Primitive Projections. + +Section with_cpp. + Context `{Σ : cpp_logic, module ⊧ σ}. + + cpp.spec "strlen" with + (\arg{s_p} "__s" (Vptr s_p) + \prepost{q s} s_p |-> cstring.R q s + \require valid<"unsigned long"> (cstring.strlen s) + \post[Vn (Z.to_N (cstring.strlen s))] emp). + + cpp.spec "strcmp" with + (\arg{s1_p} "__s1" (Vptr s1_p) + \arg{s2_p} "__s2" (Vptr s2_p) + \prepost{q1 s1} s1_p |-> cstring.R q1 s1 + \prepost{q2 s2} s2_p |-> cstring.R q2 s2 + \post[Vint (strcmp s1 s2)] emp). + + cpp.spec "strncmp" with + (\arg{s1_p} "__s1" (Vptr s1_p) + \arg{s2_p} "__s2" (Vptr s2_p) + \arg{n} "__n" (Vn n) + \prepost{q1 s1} s1_p |-> cstring.R q1 s1 + \prepost{q2 s2} s2_p |-> cstring.R q2 s2 + \post[Vint (strncmp s1 s2 n)] emp). +End with_cpp. diff --git a/rocq-brick-libstdcpp/proof/cstring/spec_old.v b/rocq-brick-libstdcpp/proof/cstring/spec_old.v new file mode 100644 index 0000000..26dfade --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/spec_old.v @@ -0,0 +1,36 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.auto.cpp.specs. + +Require Export skylabs.brick.libstdcpp.cstring.pred_old. +Require Import skylabs.brick.libstdcpp.cstring.inc_cstring_cpp. + +#[local] Set Primitive Projections. + +Section with_cpp. + Context `{Σ : cpp_logic, module ⊧ σ}. + + cpp.spec "strlen" with + (\arg{s_p} "__s" (Vptr s_p) + \prepost{q s tail} s_p |-> cstringz.R q s tail + \require valid<"unsigned long"> (Z.of_N (strlen s)) + \post[Vn (strlen s)] emp). + + cpp.spec "strcmp" with + (\arg{s1_p} "__s1" (Vptr s1_p) + \arg{s2_p} "__s2" (Vptr s2_p) + \prepost{q1 s1 tail1} s1_p |-> cstringz.R q1 s1 tail1 + \prepost{q2 s2 tail2} s2_p |-> cstringz.R q2 s2 tail2 + \post[Vint (strcmp s1 s2)] emp). + + cpp.spec "strncmp" with + (\arg{s1_p} "__s1" (Vptr s1_p) + \arg{s2_p} "__s2" (Vptr s2_p) + \arg{n} "__n" (Vn n) + \prepost{q1 s1 tail1} s1_p |-> cstringz.R q1 s1 tail1 + \prepost{q2 s2 tail2} s2_p |-> cstringz.R q2 s2 tail2 + \post[Vint (strncmp s1 s2 n)] emp). +End with_cpp. diff --git a/rocq-brick-libstdcpp/proof/dune.inc b/rocq-brick-libstdcpp/proof/dune.inc index e5f2d43..730937c 100644 --- a/rocq-brick-libstdcpp/proof/dune.inc +++ b/rocq-brick-libstdcpp/proof/dune.inc @@ -26,6 +26,15 @@ (with-stderr-to inc_cstdlib_cpp.v.stderr (run cpp2v -v %{input} -o inc_cstdlib_cpp.v --no-elaborate -- -std=c++20 -stdlib=libstdc++ )))) (alias (name srcs) (deps inc_cstdlib.cpp)) ) +(subdir cstring + (rule + (targets inc_cstring_cpp.v.stderr inc_cstring_cpp.v) + (alias test_ast) + (deps (:input inc_cstring.cpp) (glob_files_rec ../*.hpp) (universe)) + (action + (with-stderr-to inc_cstring_cpp.v.stderr (run cpp2v -v %{input} -o inc_cstring_cpp.v --no-elaborate -- -std=c++20 -stdlib=libstdc++ )))) + (alias (name srcs) (deps inc_cstring.cpp)) +) (subdir iostream (rule (targets inc_iostream_cpp.v.stderr inc_iostream_cpp.v) diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v new file mode 100644 index 0000000..7cb59bd --- /dev/null +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -0,0 +1,218 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.auto.cpp.hints.anyR. +Require Import skylabs.brick.libstdcpp.cassert.spec. +Require Import skylabs.brick.libstdcpp.cstring.spec. +Require Import skylabs.brick.libstdcpp.test.cstring.test_cpp. + +#[local] Lemma borrow_arrayR_cstringR `{Σ : cpp_logic, σ : genv} + (p : ptr) q bytes s tail : + bytes = cstring.to_zstring s ++ tail -> + cstring.WF s -> + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) + bytes ⊢ + p |-> cstring.R q s ∗ + (p |-> cstring.R q s -∗ + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) + bytes). +Proof. + intros Hbytes Hwf. + subst bytes. + rewrite (arrayR_app (fun c : N => charR q c) (Tchar_ char_type.Cchar)). + iIntros "[Hs Htail]". + iSplitL "Hs". + - rewrite /cstring.R /zstring.R. iFrame. done. + - iIntros "Hs". + rewrite /cstring.R /zstring.R. + iDestruct "Hs" as "[Hs _]". + iFrame. +Qed. + +#[local] Lemma offset_entails `{Σ : cpp_logic, σ : genv} + (o : offset) (P Q : Rep) : + (P ⊢ Q) -> o |-> P ⊢ o |-> Q. +Proof. + intros HPQ. apply _offsetR_mono. exact HPQ. +Qed. + +#[local] Lemma arrayR_charR_Vchar `{Σ : cpp_logic, σ : genv} q xs : + arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ + arrayR (Tchar_ char_type.Cchar) + (fun c : N => primR (Tchar_ char_type.Cchar) q (Vchar c)) xs. +Proof. + induction xs as [| x xs IH]. + - rewrite !arrayR_nil. iIntros "[$ $]". + - rewrite !arrayR_cons. + iIntros "[$ [$ Hxs]]". + iApply (offset_entails with "Hxs"). + exact IH. +Qed. + +#[local] Lemma at_arrayR_charR_Vchar `{Σ : cpp_logic, σ : genv} + (p : ptr) q xs : + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ + p |-> arrayR (Tchar_ char_type.Cchar) + (fun c : N => primR (Tchar_ char_type.Cchar) q (Vchar c)) xs. +Proof. + apply heap_pred._at_cancel. + by apply arrayR_charR_Vchar. +Qed. + +#[local] Lemma arrayR_charR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR 1$m c) xs ⊢ + p |-> anyR (Tarray (Tchar_ char_type.Cchar) n) 1$m. +Proof. + intros Hlen. + iIntros "Harr". + iPoseProof (at_arrayR_charR_Vchar with "Harr") as "Harr". + rewrite anyR_array. + iApply (arrayR_anyR_f (fun c : N => Vchar c) with "Harr"). + exact Hlen. +Qed. + +Section with_cpp. + Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. + + cpp.spec "test_strlen()" default. + Lemma test_strlen_ok : verify[module] "test_strlen()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strlen_embedded_null()" default. + Lemma test_strlen_embedded_null_ok : + verify[module] "test_strlen_embedded_null()". + Admitted. + + cpp.spec "test_strcmp()" default. + Lemma test_strcmp_ok : verify[module] "test_strcmp()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strcmp_embedded_null()" default. + Lemma test_strcmp_embedded_null_ok : + verify[module] "test_strcmp_embedded_null()". + Admitted. + + cpp.spec "test_strncmp()" default. + Lemma test_strncmp_ok : verify[module] "test_strncmp()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strncmp_embedded_null()" default. + Lemma test_strncmp_embedded_null_ok : + verify[module] "test_strncmp_embedded_null()". + Admitted. + + cpp.spec "test_strlen_array_buffer()" default. + Lemma test_strlen_array_buffer_ok : + verify[module] "test_strlen_array_buffer()". + Proof. + verify_spec; go. + iPoseProof (borrow_arrayR_cstringR _ _ + (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) "ab"%bs + [99%N; 100%N; 0%N] eq_refl + ltac:(apply cstring.WF_cons; + [change (Byte.x61 <> Byte.x00); congruence|]; + apply cstring.WF_cons; + [change (Byte.x62 <> Byte.x00); congruence|]; + apply cstring.WF_nil) with "[$]") + as "[Hs Hclose]". + iExists _, "ab"%bs. iFrame "Hs". + iSplit; [go|]. + iIntros "Hs". + iPoseProof ("Hclose" with "Hs") as "Harr". + iPoseProof (arrayR_charR_anyR _ 6%N + (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) + ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") + as "Harr". + go. + iSplitL "Harr"; [iExact "Harr"|]. + go. + Qed. + + cpp.spec "test_strcmp_array_buffer()" default. + Lemma test_strcmp_array_buffer_ok : + verify[module] "test_strcmp_array_buffer()". + Proof. + verify_spec; go. + iPoseProof (borrow_arrayR_cstringR _ _ + (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) "ab"%bs + [120%N; 0%N] eq_refl + ltac:(apply cstring.WF_cons; + [change (Byte.x61 <> Byte.x00); congruence|]; + apply cstring.WF_cons; + [change (Byte.x62 <> Byte.x00); congruence|]; + apply cstring.WF_nil) with "[$]") + as "[Hx Hclosex]". + iPoseProof (borrow_arrayR_cstringR _ _ + (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) "ab"%bs + [121%N; 0%N] eq_refl + ltac:(apply cstring.WF_cons; + [change (Byte.x61 <> Byte.x00); congruence|]; + apply cstring.WF_cons; + [change (Byte.x62 <> Byte.x00); congruence|]; + apply cstring.WF_nil) with "[$]") + as "[Hy Hclosey]". + iExists _, "ab"%bs, _, "ab"%bs. iFrame "Hx Hy". + iIntros "[Hx Hy]". + iPoseProof ("Hclosex" with "Hx") as "Harrx". + iPoseProof ("Hclosey" with "Hy") as "Harry". + iPoseProof (arrayR_charR_anyR _ 5%N + (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) + ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harrx") + as "Harrx". + iPoseProof (arrayR_charR_anyR _ 5%N + (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) + ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harry") + as "Harry". + go. + iFrame "Harrx Harry". + go. + Qed. + + cpp.spec "test_strncmp_array_buffer()" default. + Lemma test_strncmp_array_buffer_ok : + verify[module] "test_strncmp_array_buffer()". + Proof. + verify_spec; go. + iPoseProof (borrow_arrayR_cstringR _ _ + (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) "ab"%bs + [120%N; 0%N] eq_refl + ltac:(apply cstring.WF_cons; + [change (Byte.x61 <> Byte.x00); congruence|]; + apply cstring.WF_cons; + [change (Byte.x62 <> Byte.x00); congruence|]; + apply cstring.WF_nil) with "[$]") + as "[Hx Hclosex]". + iPoseProof (borrow_arrayR_cstringR _ _ + (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) "ab"%bs + [121%N; 0%N] eq_refl + ltac:(apply cstring.WF_cons; + [change (Byte.x61 <> Byte.x00); congruence|]; + apply cstring.WF_cons; + [change (Byte.x62 <> Byte.x00); congruence|]; + apply cstring.WF_nil) with "[$]") + as "[Hy Hclosey]". + iExists _, "ab"%bs, _, "ab"%bs. iFrame "Hx Hy". + iIntros "[Hx Hy]". + iPoseProof ("Hclosex" with "Hx") as "Harrx". + iPoseProof ("Hclosey" with "Hy") as "Harry". + iPoseProof (arrayR_charR_anyR _ 5%N + (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) + ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harrx") + as "Harrx". + iPoseProof (arrayR_charR_anyR _ 5%N + (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) + ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harry") + as "Harry". + go. + iFrame "Harrx Harry". + go. + Qed. + + cpp.spec "test_cstring_slice1()" default. + Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". + Proof. verify_spec; go. Qed. +End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proof_old.v b/rocq-brick-libstdcpp/test/cstring/proof_old.v new file mode 100644 index 0000000..064c81c --- /dev/null +++ b/rocq-brick-libstdcpp/test/cstring/proof_old.v @@ -0,0 +1,239 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.brick.libstdcpp.cassert.spec. +Require Import skylabs.brick.libstdcpp.cstring.spec. +Require Import skylabs.brick.libstdcpp.cstring.pred_old. +Require Import skylabs.brick.libstdcpp.test.cstring.test_cpp. + +#[local] Definition embedded_null_lit (c : N) : literal_string.t := + literal_string.of_list_N [97%N; 98%N; 0%N; c]. + +#[local] Lemma embedded_null_lit_to_list c : + (c < 2 ^ 8)%N -> + literal_string.to_list_N (embedded_null_lit c) = [97%N; 98%N; 0%N; c]. +Proof. + intros Hc. + rewrite /embedded_null_lit literal_string.to_of_list_N. + reflexivity. + assert (Hbpc : + (literal_string.bpc_of_list_N [97%N; 98%N; 0%N; c] <= 263)%N). + { unfold literal_string.bpc_of_list_N; cbn. + apply (N.Div0.div_le_upper_bound _ _ 263%N). + eapply N.le_trans. + - apply N.add_le_mono_r. apply N.log2_up_le_lin. lia. + - lia. } + cbn. lia. +Qed. + +#[local] Lemma embedded_null_prefix_WF `{σ : genv} : + cstring.WF "ab"%bs. +Proof. + apply cstring.WF_cons; [change (Byte.x61 <> Byte.x00); congruence|]. + apply cstring.WF_cons; [change (Byte.x62 <> Byte.x00); congruence|]. + apply cstring.WF_nil. +Qed. + +#[local] Lemma existing_embedded_null_lit_bytes : + literal_string.to_list_N cstringz.ab_0_cd_lit ++ [0%N] = + cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]. +Proof. + rewrite cstring.to_zstring_unfold. vm_compute. reflexivity. +Qed. + +#[local] Lemma existing_embedded_null_lit_range : + List.Forall (fun x => (x < 2 ^ 8)%N) + (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]). +Proof. + rewrite cstring.to_zstring_unfold. + do 6 (constructor; [reflexivity|]); constructor. +Qed. + +#[local] Lemma embedded_null_lit_bytes c : + (c < 2 ^ 8)%N -> + literal_string.to_list_N (embedded_null_lit c) ++ [0%N] = + cstring.to_zstring "ab"%bs ++ [c; 0%N]. +Proof. + intros Hc. + rewrite cstring.to_zstring_unfold. + rewrite embedded_null_lit_to_list; [reflexivity|exact Hc]. +Qed. + +#[local] Lemma embedded_null_lit_range c : + (c < 2 ^ 8)%N -> + List.Forall (fun x => (x < 2 ^ 8)%N) + (cstring.to_zstring "ab"%bs ++ [c; 0%N]). +Proof. + intros Hc. + rewrite cstring.to_zstring_unfold. + repeat constructor; try assumption; + change (97 < 256)%N || change (98 < 256)%N || change (0 < 256)%N; + reflexivity. +Qed. + +#[local] Lemma borrow_cstringz_cstringR `{Σ : cpp_logic, σ : genv} + (p : ptr) q s tail : + cstring.WF s -> + p |-> cstringz.R q s tail ⊢ + p |-> cstring.R q s ∗ + (p |-> cstring.R q s -∗ p |-> cstringz.R q s tail). +Proof. + intros Hwf. + rewrite /cstringz.R. + rewrite (arrayR_app (fun c : N => charR q c) (Tchar_ char_type.Cchar)). + iIntros "[Hs Htail]". + iSplitL "Hs". + - iApply cstringz.at_R_cstringR. + { exact Hwf. } + rewrite /cstringz.R app_nil_r. + iFrame. + - iIntros "Hs". + iPoseProof (cstringz.at_cstringR_R with "Hs") as "Hs". + rewrite /cstringz.R app_nil_r. + iFrame. +Qed. + +#[local] Lemma at_string_bytesR_cstringz_R `{Σ : cpp_logic, σ : genv} + (p : ptr) q lit s tail : + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun x => (x < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + p |-> string_bytesR char_type.Cchar q lit ⊢ + p |-> cstringz.R q s tail. +Proof. + intros Hbytes Hrange. + iIntros "Hlit". + iApply (cstringz.at_string_bytesR_R with "Hlit"). + - exact Hbytes. + - exact Hrange. +Qed. + +#[local] Lemma at_cstringz_R_string_bytesR `{Σ : cpp_logic, σ : genv} + (p : ptr) q lit s tail : + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun x => (x < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + p |-> cstringz.R q s tail ⊢ + p |-> string_bytesR char_type.Cchar q lit. +Proof. + intros Hbytes Hrange. + iIntros "HR". + iApply (cstringz.at_R_string_bytesR with "HR"). + - exact Hbytes. + - exact Hrange. +Qed. + +#[local] Lemma borrow_literal_cstringR `{Σ : cpp_logic, σ : genv} + (p : ptr) q lit s tail : + cstring.WF s -> + literal_string.to_list_N lit ++ [0%N] = cstring.to_zstring s ++ tail -> + List.Forall (fun x => (x < 2 ^ 8)%N) (cstring.to_zstring s ++ tail) -> + p |-> string_bytesR char_type.Cchar q lit ⊢ + p |-> cstring.R q s ∗ + (p |-> cstring.R q s -∗ + p |-> string_bytesR char_type.Cchar q lit). +Proof. + intros Hwf Hbytes Hrange. + iIntros "Hlit". + iPoseProof (at_string_bytesR_cstringz_R with "Hlit") as "HR". + { exact Hbytes. } + { exact Hrange. } + iPoseProof (borrow_cstringz_cstringR with "HR") as "[Hab Hclose]". + { exact Hwf. } + iFrame "Hab". + iIntros "Hab". + iPoseProof ("Hclose" with "Hab") as "HR". + iApply (at_cstringz_R_string_bytesR with "HR"). + - exact Hbytes. + - exact Hrange. +Qed. + +Section with_cpp. + Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. + + cpp.spec "test_strlen()" default. + Lemma test_strlen_ok : verify[module] "test_strlen()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strlen_embedded_null()" default. + Lemma test_strlen_embedded_null_ok : + verify[module] "test_strlen_embedded_null()". + Proof. + verify_spec; go. + iPoseProof (borrow_literal_cstringR _ _ cstringz.ab_0_cd_lit "ab"%bs + [99%N; 100%N; 0%N] embedded_null_prefix_WF + existing_embedded_null_lit_bytes existing_embedded_null_lit_range + with "[$]") + as "[Hab Hclose]". + iExists _, "ab"%bs. iFrame "Hab". + iSplit; [go|]. + iIntros "Hab". + iPoseProof ("Hclose" with "Hab") as "Hlit". + go. + Qed. + + cpp.spec "test_strcmp()" default. + Lemma test_strcmp_ok : verify[module] "test_strcmp()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strcmp_embedded_null()" default. + Lemma test_strcmp_embedded_null_ok : + verify[module] "test_strcmp_embedded_null()". + Proof. + verify_spec; go. + pose proof (embedded_null_lit_bytes 120%N + ltac:(change (120 < 256)%N; reflexivity)) as Hxbytes. + pose proof (embedded_null_lit_range 120%N + ltac:(change (120 < 256)%N; reflexivity)) as Hxrange. + pose proof (embedded_null_lit_bytes 121%N + ltac:(change (121 < 256)%N; reflexivity)) as Hybytes. + pose proof (embedded_null_lit_range 121%N + ltac:(change (121 < 256)%N; reflexivity)) as Hyrange. + iPoseProof (borrow_literal_cstringR _ _ (embedded_null_lit 120%N) "ab"%bs + [120%N; 0%N] embedded_null_prefix_WF Hxbytes Hxrange with "[$]") + as "[Hx Hclosex]". + iPoseProof (borrow_literal_cstringR _ _ (embedded_null_lit 121%N) "ab"%bs + [121%N; 0%N] embedded_null_prefix_WF Hybytes Hyrange with "[$]") + as "[Hy Hclosey]". + iExists _, "ab"%bs, _, "ab"%bs. iFrame "Hx Hy". + iIntros "[Hx Hy]". + iPoseProof ("Hclosex" with "Hx") as "Hlitx". + iPoseProof ("Hclosey" with "Hy") as "Hlity". + go. + Qed. + + cpp.spec "test_strncmp()" default. + Lemma test_strncmp_ok : verify[module] "test_strncmp()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strncmp_embedded_null()" default. + Lemma test_strncmp_embedded_null_ok : + verify[module] "test_strncmp_embedded_null()". + Proof. + verify_spec; go. + pose proof (embedded_null_lit_bytes 120%N + ltac:(change (120 < 256)%N; reflexivity)) as Hxbytes. + pose proof (embedded_null_lit_range 120%N + ltac:(change (120 < 256)%N; reflexivity)) as Hxrange. + pose proof (embedded_null_lit_bytes 121%N + ltac:(change (121 < 256)%N; reflexivity)) as Hybytes. + pose proof (embedded_null_lit_range 121%N + ltac:(change (121 < 256)%N; reflexivity)) as Hyrange. + iPoseProof (borrow_literal_cstringR _ _ (embedded_null_lit 120%N) "ab"%bs + [120%N; 0%N] embedded_null_prefix_WF Hxbytes Hxrange with "[$]") + as "[Hx Hclosex]". + iPoseProof (borrow_literal_cstringR _ _ (embedded_null_lit 121%N) "ab"%bs + [121%N; 0%N] embedded_null_prefix_WF Hybytes Hyrange with "[$]") + as "[Hy Hclosey]". + iExists _, "ab"%bs, _, "ab"%bs. iFrame "Hx Hy". + iIntros "[Hx Hy]". + iPoseProof ("Hclosex" with "Hx") as "Hlitx". + iPoseProof ("Hclosey" with "Hy") as "Hlity". + go. + Qed. + + cpp.spec "test_cstring_slice1()" default. + Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". + Proof. verify_spec; go. Qed. +End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/test.cpp b/rocq-brick-libstdcpp/test/cstring/test.cpp new file mode 100644 index 0000000..e04dd29 --- /dev/null +++ b/rocq-brick-libstdcpp/test/cstring/test.cpp @@ -0,0 +1,61 @@ +#include +#include + +void test_strlen() { + assert(std::strlen("") == 0); + assert(std::strlen("a") == 1); + assert(std::strlen("abc") == 3); +} + +void test_strlen_embedded_null() { + assert(std::strlen("ab\0cd") == 2); +} + +void test_strcmp() { + assert(std::strcmp("", "") == 0); + assert(std::strcmp("abc", "abc") == 0); + assert(std::strcmp("abc", "abd") < 0); + assert(std::strcmp("abd", "abc") > 0); + assert(std::strcmp("ab", "abc") < 0); + assert(std::strcmp("abc", "ab") > 0); +} + +void test_strcmp_embedded_null() { + assert(std::strcmp("ab\0x", "ab\0y") == 0); +} + +void test_strncmp() { + assert(std::strncmp("abc", "abd", 0) == 0); + assert(std::strncmp("abc", "abd", 2) == 0); + assert(std::strncmp("abc", "abd", 3) < 0); + assert(std::strncmp("abd", "abc", 3) > 0); + assert(std::strncmp("ab", "abc", 2) == 0); + assert(std::strncmp("ab", "abc", 3) < 0); +} + +void test_strncmp_embedded_null() { + assert(std::strncmp("ab\0x", "ab\0y", 4) == 0); +} + +void test_strlen_array_buffer() { + char s[] = {'a', 'b', '\0', 'c', 'd', '\0'}; + assert(std::strlen(s) == 2); +} + +void test_strcmp_array_buffer() { + char x[] = {'a', 'b', '\0', 'x', '\0'}; + char y[] = {'a', 'b', '\0', 'y', '\0'}; + assert(std::strcmp(x, y) == 0); +} + +void test_strncmp_array_buffer() { + char x[] = {'a', 'b', '\0', 'x', '\0'}; + char y[] = {'a', 'b', '\0', 'y', '\0'}; + assert(std::strncmp(x, y, 4) == 0); +} + +void test_cstring_slice1() { + test_strlen(); + test_strcmp(); + test_strncmp(); +} diff --git a/rocq-brick-libstdcpp/test/dune.inc b/rocq-brick-libstdcpp/test/dune.inc index 7e1c50a..881f615 100644 --- a/rocq-brick-libstdcpp/test/dune.inc +++ b/rocq-brick-libstdcpp/test/dune.inc @@ -17,6 +17,15 @@ (with-stderr-to test_cpp.v.stderr (run cpp2v -v %{input} -o test_cpp.v --no-elaborate -- -std=c++20 -stdlib=libstdc++ )))) (alias (name srcs) (deps test.cpp)) ) +(subdir cstring + (rule + (targets test_cpp.v.stderr test_cpp.v) + (alias test_ast) + (deps (:input test.cpp) (glob_files_rec ../*.hpp) (universe)) + (action + (with-stderr-to test_cpp.v.stderr (run cpp2v -v %{input} -o test_cpp.v --no-elaborate -- -std=c++20 -stdlib=libstdc++ )))) + (alias (name srcs) (deps test.cpp)) +) (subdir geeks_for_geeks_examples (rule (targets N12_area_cpp.v.stderr N12_area_cpp.v) From 3ec2018393081d75017d7c916fc18a96fa0a2d90 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Wed, 22 Apr 2026 15:35:10 -0400 Subject: [PATCH 02/11] First cut at step 3 of planning.md, ie functions strchr, strrchr, strspn, strcspn, strpbrk, and strstr --- rocq-brick-libstdcpp/proof/cstring/DESIGN.md | 27 +++-- .../proof/cstring/lessons_learned.md | 36 ++++++ rocq-brick-libstdcpp/proof/cstring/model.v | 86 ++++++++++++++ rocq-brick-libstdcpp/proof/cstring/spec.v | 81 +++++++++++++ rocq-brick-libstdcpp/test/cstring/proof.v | 110 +++++++++++++++++- rocq-brick-libstdcpp/test/cstring/test.cpp | 76 ++++++++++++ 6 files changed, 408 insertions(+), 8 deletions(-) create mode 100644 rocq-brick-libstdcpp/proof/cstring/lessons_learned.md diff --git a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md index 3a749dd..00ca06b 100644 --- a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md +++ b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md @@ -2,19 +2,22 @@ ## Current Slice -The first supported API slice covers the read-only byte-string functions -`strlen`, `strcmp`, and `strncmp`. +The supported read-only API slices cover the null-terminated byte-string +functions `strlen`, `strcmp`, `strncmp`, `strchr`, `strrchr`, `strspn`, +`strcspn`, `strpbrk`, and `strstr`. The reusable specs use the existing `cstring.R` abstraction. This keeps the library-facing contract aligned with existing clients such as `cstdlib::atoi` and `iostream`: callers provide a pointer to a valid null-terminated C string whose logical payload is a `cstring.t`. -The ordinary litmus tests for this slice are proven in both -`test/cstring/proof.v` and `test/cstring/proof_old.v`. Embedded-null literal -tests are split into separate functions; they are specified but left admitted -in the active `cstring.R` development, and proven in `proof_old.v` using the -archived lower-level bridge. +The ordinary v1 litmus tests for `strlen`, `strcmp`, and `strncmp` are proven +in both `test/cstring/proof.v` and `test/cstring/proof_old.v`. The newer +search/segment litmus tests are proven in the active development. Embedded-null +literal tests are split into separate functions; the v1 literal tests are +specified but left admitted in the active `cstring.R` development, and proven +in `proof_old.v` using the archived lower-level bridge. Active `char[]` +array-buffer tests cover the corresponding client-side splitting pattern. ## Representation Choice @@ -43,6 +46,16 @@ match the generated proof state directly. This should not be read as a general preference for `arrayR` in library specs; it is a proof-local accommodation for the shape of generated stack-buffer resources. +### Character Arguments + +Functions such as `strchr` and `strrchr` take an `int` argument but the textual +specification searches for `static_cast(ch)`. The active specs currently +model only byte-range arguments with `valid<"unsigned char"> ch`. This is a +deliberately conservative slice: it avoids claiming behavior for +out-of-byte-range `int` arguments, whose result depends on the C++ conversion +to `char` and therefore on implementation choices such as signedness and +representable values. + ## Archived Alternative The earlier experiment introduced a lower-level `cstringz.R q s tail` predicate diff --git a/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md new file mode 100644 index 0000000..6ddb134 --- /dev/null +++ b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md @@ -0,0 +1,36 @@ +# Lessons Learned + +These notes collect reusable lessons from the `` specification work. +They are meant to be broader than the current litmus tests and suitable for +later promotion into shared docs. + +## Models + +- Prefer model expressions that normalize under standard arithmetic cleanup. + For pointer offsets and numeric return values, expressions such as + `(1 + off)%Z` are easier for `Arith.arith_simpl` and downstream symbolic + execution than structurally equivalent constructors such as `Z.succ off`. + This keeps proofs portable across callers instead of requiring literal- + specific normalization steps. +- Add small `Succeed Example` checks for model functions. They are cheap + regression tests for corner cases such as empty needles, terminating null + characters, missing characters, and first-versus-last occurrence behavior. + +## Specifications + +- Use small notations or helper definitions in `spec.v` to translate model + results into return values when this preserves the abstraction boundary. The + `search_result` pattern keeps null-versus-offset pointer results local to the + specs rather than leaking pointer arithmetic into the pure model. + +## Proofs + +- Prefer general arithmetic cleanup over test-specific proof hacks. If a proof + needs to reconcile different representations of the same number, first ask + whether the model can produce an arithmetic expression that `Arith.arith_simpl` + can normalize. Avoid local tactics that know about one test's concrete + offsets or string literals. +- `ego` is not always redundant after `go`. In these litmus proofs it often + discharges pure obligations from `assert` statements and pointer comparisons. + It is worth testing removals with `dune`, but keep `ego` where the generated + assertion proof obligations remain. diff --git a/rocq-brick-libstdcpp/proof/cstring/model.v b/rocq-brick-libstdcpp/proof/cstring/model.v index a0b2d0a..566b1bc 100644 --- a/rocq-brick-libstdcpp/proof/cstring/model.v +++ b/rocq-brick-libstdcpp/proof/cstring/model.v @@ -39,6 +39,79 @@ Fixpoint strncmp_nat (n : nat) (s1 s2 : bs) : Z := Definition strncmp (s1 s2 : bs) (n : N) : Z := strncmp_nat (N.to_nat n) s1 s2. +Fixpoint strchr (s : bs) (c : Z) : option Z := + match s with + | BS.EmptyString => + if bool_decide (c = 0) then Some 0 else None + | BS.String ch rest => + if bool_decide (c = byte_ord ch) then Some 0 + else option_map (fun off => (1 + off)%Z) (strchr rest c) + end. + +Fixpoint strrchr (s : bs) (c : Z) : option Z := + match s with + | BS.EmptyString => + if bool_decide (c = 0) then Some 0 else None + | BS.String ch rest => + match strrchr rest c with + | Some off => Some (1 + off)%Z + | None => + if bool_decide (c = byte_ord ch) then Some 0 else None + end + end. + +Fixpoint contains (needle : Byte.byte) (haystack : bs) : bool := + match haystack with + | BS.EmptyString => false + | BS.String ch rest => + bool_decide (needle = ch) || contains needle rest + end. + +Fixpoint strspn (s accept : bs) : N := + match s with + | BS.EmptyString => 0%N + | BS.String ch rest => + if contains ch accept then N.succ (strspn rest accept) else 0%N + end. + +Fixpoint strcspn (s reject : bs) : N := + match s with + | BS.EmptyString => 0%N + | BS.String ch rest => + if contains ch reject then 0%N else N.succ (strcspn rest reject) + end. + +Fixpoint strpbrk (s accept : bs) : option Z := + match s with + | BS.EmptyString => None + | BS.String ch rest => + if contains ch accept then Some 0 + else option_map (fun off => (1 + off)%Z) (strpbrk rest accept) + end. + +Fixpoint prefix (needle haystack : bs) : bool := + match needle with + | BS.EmptyString => true + | BS.String n_ch n_rest => + match haystack with + | BS.EmptyString => false + | BS.String h_ch h_rest => + bool_decide (n_ch = h_ch) && prefix n_rest h_rest + end + end. + +Fixpoint strstr (haystack needle : bs) : option Z := + match needle with + | BS.EmptyString => Some 0 + | BS.String _ _ => + match haystack with + | BS.EmptyString => None + | BS.String _ rest => + if prefix needle haystack then Some 0 + else option_map (fun off => (1 + off)%Z) (strstr rest needle) + end + end. + #[local] Open Scope bs_scope. Succeed Example strcmp_equal : strcmp "abc" "abc" = 0 := eq_refl. @@ -50,3 +123,16 @@ Succeed Example strcmp_prefix_greater : strcmp "abc" "ab" = 99 := eq_refl. Succeed Example strncmp_zero : strncmp "abc" "abd" 0 = 0 := eq_refl. Succeed Example strncmp_equal_prefix : strncmp "abc" "abd" 2 = 0 := eq_refl. Succeed Example strncmp_diff_at_bound : strncmp "abc" "abd" 3 = -1 := eq_refl. + +Succeed Example strchr_found : strchr "banana" 98 = Some 0 := eq_refl. +Succeed Example strchr_null : strchr "banana" 0 = Some 6 := eq_refl. +Succeed Example strchr_missing : strchr "banana" 122 = None := eq_refl. + +Succeed Example strrchr_found : strrchr "banana" 97 = Some 5 := eq_refl. +Succeed Example strrchr_null : strrchr "banana" 0 = Some 6 := eq_refl. + +Succeed Example strspn_prefix : strspn "abcde" "abc" = 3%N := eq_refl. +Succeed Example strcspn_prefix : strcspn "abcde" "dx" = 3%N := eq_refl. +Succeed Example strpbrk_found : strpbrk "abcdef" "xyc" = Some 2 := eq_refl. +Succeed Example strstr_found : strstr "abracadabra" "cad" = Some 4 := eq_refl. +Succeed Example strstr_empty : strstr "abracadabra" "" = Some 0 := eq_refl. diff --git a/rocq-brick-libstdcpp/proof/cstring/spec.v b/rocq-brick-libstdcpp/proof/cstring/spec.v index 7410e0c..44ee7bb 100644 --- a/rocq-brick-libstdcpp/proof/cstring/spec.v +++ b/rocq-brick-libstdcpp/proof/cstring/spec.v @@ -10,6 +10,15 @@ Require Import skylabs.brick.libstdcpp.cstring.inc_cstring_cpp. #[local] Set Primitive Projections. +#[local] Open Scope Z_scope. + +Notation search_result p found := + match found with + | Some 0 => Vptr p + | Some off => Vptr (p .[ Tchar ! off ]) + | None => Vptr nullptr + end (only parsing). + Section with_cpp. Context `{Σ : cpp_logic, module ⊧ σ}. @@ -33,4 +42,76 @@ Section with_cpp. \prepost{q1 s1} s1_p |-> cstring.R q1 s1 \prepost{q2 s2} s2_p |-> cstring.R q2 s2 \post[Vint (strncmp s1 s2 n)] emp). + + cpp.spec "strchr(char*, int)" as strchr_mut_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \prepost{q s} s_p |-> cstring.R q s + \require valid<"unsigned char"> c + \post[search_result s_p (strchr s c)] emp). + + cpp.spec "strchr(const char*, int)" as strchr_const_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \prepost{q s} s_p |-> cstring.R q s + \require valid<"unsigned char"> c + \post[search_result s_p (strchr s c)] emp). + + cpp.spec "strrchr(char*, int)" as strrchr_mut_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \prepost{q s} s_p |-> cstring.R q s + \require valid<"unsigned char"> c + \post[search_result s_p (strrchr s c)] emp). + + cpp.spec "strrchr(const char*, int)" as strrchr_const_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \prepost{q s} s_p |-> cstring.R q s + \require valid<"unsigned char"> c + \post[search_result s_p (strrchr s c)] emp). + + cpp.spec "strspn" with + (\arg{s_p} "__s" (Vptr s_p) + \arg{accept_p} "__accept" (Vptr accept_p) + \prepost{q s} s_p |-> cstring.R q s + \prepost{accept_q accept} accept_p |-> cstring.R accept_q accept + \require valid<"unsigned long"> (strspn s accept) + \post[Vn (strspn s accept)] emp). + + cpp.spec "strcspn" with + (\arg{s_p} "__s" (Vptr s_p) + \arg{reject_p} "__reject" (Vptr reject_p) + \prepost{q s} s_p |-> cstring.R q s + \prepost{reject_q reject} reject_p |-> cstring.R reject_q reject + \require valid<"unsigned long"> (strcspn s reject) + \post[Vn (strcspn s reject)] emp). + + cpp.spec "strpbrk(char*, const char*)" as strpbrk_mut_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{accept_p} "__accept" (Vptr accept_p) + \prepost{q s} s_p |-> cstring.R q s + \prepost{accept_q accept} accept_p |-> cstring.R accept_q accept + \post[search_result s_p (strpbrk s accept)] emp). + + cpp.spec "strpbrk(const char*, const char*)" as strpbrk_const_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{accept_p} "__accept" (Vptr accept_p) + \prepost{q s} s_p |-> cstring.R q s + \prepost{accept_q accept} accept_p |-> cstring.R accept_q accept + \post[search_result s_p (strpbrk s accept)] emp). + + cpp.spec "strstr(char*, const char*)" as strstr_mut_spec with + (\arg{haystack_p} "__haystack" (Vptr haystack_p) + \arg{needle_p} "__needle" (Vptr needle_p) + \prepost{haystack_q haystack} haystack_p |-> cstring.R haystack_q haystack + \prepost{needle_q needle} needle_p |-> cstring.R needle_q needle + \post[search_result haystack_p (strstr haystack needle)] emp). + + cpp.spec "strstr(const char*, const char*)" as strstr_const_spec with + (\arg{haystack_p} "__haystack" (Vptr haystack_p) + \arg{needle_p} "__needle" (Vptr needle_p) + \prepost{haystack_q haystack} haystack_p |-> cstring.R haystack_q haystack + \prepost{needle_q needle} needle_p |-> cstring.R needle_q needle + \post[search_result haystack_p (strstr haystack needle)] emp). End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index 7cb59bd..363d7ba 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -128,7 +128,7 @@ Section with_cpp. ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") as "Harr". go. - iSplitL "Harr"; [iExact "Harr"|]. + iFrame "Harr". go. Qed. @@ -212,6 +212,114 @@ Section with_cpp. go. Qed. + cpp.spec "test_strchr()" default. + Lemma test_strchr_ok : verify[module] "test_strchr()". + Proof using MOD. + verify_spec; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Qed. + + cpp.spec "test_strrchr()" default. + Lemma test_strrchr_ok : verify[module] "test_strrchr()". + Proof using MOD. + verify_spec; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Qed. + + cpp.spec "test_strspn()" default. + Lemma test_strspn_ok : verify[module] "test_strspn()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strcspn()" default. + Lemma test_strcspn_ok : verify[module] "test_strcspn()". + Proof. verify_spec; go; ego. Qed. + + cpp.spec "test_strpbrk()" default. + Lemma test_strpbrk_ok : verify[module] "test_strpbrk()". + Proof using MOD. + verify_spec; go; ego. + Arith.arith_simpl; go; ego. + Qed. + + cpp.spec "test_strstr()" default. + Lemma test_strstr_ok : verify[module] "test_strstr()". + Proof using MOD. + verify_spec; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Qed. + + cpp.spec "test_search_embedded_null_array_buffer()" default. + Lemma test_search_embedded_null_array_buffer_ok : + verify[module] "test_search_embedded_null_array_buffer()". + Proof using MOD. + verify_spec; go. + iPoseProof (borrow_arrayR_cstringR _ _ + (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) "ab"%bs + [98%N; 99%N; 0%N] eq_refl + ltac:(apply cstring.WF_cons; + [change (Byte.x61 <> Byte.x00); congruence|]; + apply cstring.WF_cons; + [change (Byte.x62 <> Byte.x00); congruence|]; + apply cstring.WF_nil) with "[$]") + as "[Hs Hclose]". + iExists _, "ab"%bs. iFrame "Hs". + iIntros "Hs". + go. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go. + go. + Arith.arith_simpl; go. + go. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Haccept]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hreject]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle_b]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle_bc]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle_b2]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hempty]". + Arith.arith_simpl; go; ego. + iPoseProof ("Hclose" with "Hs") as "Harr". + iPoseProof (arrayR_charR_anyR _ 6%N + (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) + ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") + as "Harr". + go. + iFrame "Harr". + go. + Qed. + cpp.spec "test_cstring_slice1()" default. Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". Proof. verify_spec; go. Qed. diff --git a/rocq-brick-libstdcpp/test/cstring/test.cpp b/rocq-brick-libstdcpp/test/cstring/test.cpp index e04dd29..54e2246 100644 --- a/rocq-brick-libstdcpp/test/cstring/test.cpp +++ b/rocq-brick-libstdcpp/test/cstring/test.cpp @@ -54,6 +54,82 @@ void test_strncmp_array_buffer() { assert(std::strncmp(x, y, 4) == 0); } +void test_strchr() { + const char *s = "banana"; + const char *empty = ""; + assert(std::strchr(s, 'b') == s); + assert(std::strchr(s, 'n') == s + 2); + assert(std::strchr(s, 'z') == nullptr); + assert(std::strchr(s, '\0') == s + 6); + assert(std::strchr(empty, 'a') == nullptr); + assert(std::strchr(empty, '\0') == empty); +} + +void test_strrchr() { + const char *s = "banana"; + const char *empty = ""; + assert(std::strrchr(s, 'a') == s + 5); + assert(std::strrchr(s, 'b') == s); + assert(std::strrchr(s, 'z') == nullptr); + assert(std::strrchr(s, '\0') == s + 6); + assert(std::strrchr(empty, 'a') == nullptr); + assert(std::strrchr(empty, '\0') == empty); +} + +void test_strspn() { + assert(std::strspn("abcde", "abc") == 3); + assert(std::strspn("abcde", "ba") == 2); + assert(std::strspn("abc", "") == 0); + assert(std::strspn("", "abc") == 0); + assert(std::strspn("aaaa", "a") == 4); + assert(std::strspn("abc", "xyz") == 0); +} + +void test_strcspn() { + assert(std::strcspn("abcde", "dx") == 3); + assert(std::strcspn("abcde", "a") == 0); + assert(std::strcspn("abc", "") == 3); + assert(std::strcspn("", "abc") == 0); + assert(std::strcspn("abc", "xyz") == 3); +} + +void test_strpbrk() { + const char *s = "abcdef"; + assert(std::strpbrk(s, "xyc") == s + 2); + assert(std::strpbrk(s, "fa") == s); + assert(std::strpbrk(s, "xyz") == nullptr); + assert(std::strpbrk(s, "") == nullptr); + assert(std::strpbrk("", "abc") == nullptr); +} + +void test_strstr() { + const char *s = "abracadabra"; + const char *empty = ""; + assert(std::strstr(s, "abra") == s); + assert(std::strstr(s, "cad") == s + 4); + assert(std::strstr(s, "dab") == s + 6); + assert(std::strstr(s, "xyz") == nullptr); + assert(std::strstr(s, "") == s); + assert(std::strstr(empty, "") == empty); + assert(std::strstr(empty, "a") == nullptr); +} + +void test_search_embedded_null_array_buffer() { + char s[] = {'a', 'b', '\0', 'b', 'c', '\0'}; + assert(std::strchr(s, 'b') == s + 1); + assert(std::strchr(s, 'c') == nullptr); + assert(std::strchr(s, '\0') == s + 2); + assert(std::strrchr(s, 'b') == s + 1); + assert(std::strrchr(s, '\0') == s + 2); + assert(std::strspn(s, "abc") == 2); + assert(std::strcspn(s, "c") == 2); + assert(std::strpbrk(s, "c") == nullptr); + assert(std::strpbrk(s, "b") == s + 1); + assert(std::strstr(s, "bc") == nullptr); + assert(std::strstr(s, "b") == s + 1); + assert(std::strstr(s, "") == s); +} + void test_cstring_slice1() { test_strlen(); test_strcmp(); From 6b0a8bd1c95e3e99fb1d6bf92a073575ac1f97e9 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Wed, 22 Apr 2026 17:41:01 -0400 Subject: [PATCH 03/11] Updated current state --- .../proof/cstring/planning.md | 38 +++++++++++-------- 1 file changed, 22 insertions(+), 16 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/cstring/planning.md b/rocq-brick-libstdcpp/proof/cstring/planning.md index 93beeb2..3ce0cb0 100644 --- a/rocq-brick-libstdcpp/proof/cstring/planning.md +++ b/rocq-brick-libstdcpp/proof/cstring/planning.md @@ -17,21 +17,25 @@ The intended workflow is iterative: ## Current Mental Model -The current workspace contains a partial but coherent first slice for the -read-only null-terminated byte-string operations: +The current workspace contains coherent first and second slices for read-only +null-terminated byte-string operations: -- `model.v` defines pure byte-string models for `strcmp` and `strncmp`; the - active `strlen` spec uses the existing `cstring.strlen`. +- `model.v` defines pure byte-string models for `strcmp`, `strncmp`, `strchr`, + `strrchr`, `strspn`, `strcspn`, `strpbrk`, and `strstr`; the active `strlen` + spec uses the existing `cstring.strlen`. - `pred.v` is intentionally minimal and reuses the existing `cstring.R` abstraction. -- `spec.v` specifies `strlen`, `strcmp`, and `strncmp` against `cstring.R`. +- `spec.v` specifies `strlen`, `strcmp`, `strncmp`, `strchr`, `strrchr`, + `strspn`, `strcspn`, `strpbrk`, and `strstr` against `cstring.R`. - `test/cstring/test.cpp` contains `void` litmus functions using `assert`. The embedded-null literal cases are isolated into separate functions from the - ordinary `strlen`, `strcmp`, and `strncmp` tests. -- `test/cstring/proof.v` proves the ordinary `strlen`, `strcmp`, `strncmp`, and - slice-wrapper tests. The embedded-null tests are specified there but left - admitted because active clients must first split larger literal resources - before invoking the `cstring.R` specs. + ordinary `strlen`, `strcmp`, and `strncmp` tests; the search/segment slice + includes ordinary tests and an embedded-null `char[]` array-buffer client. +- `test/cstring/proof.v` proves the ordinary `strlen`, `strcmp`, `strncmp`, + search/segment tests, array-buffer client tests, and slice-wrapper tests. + The embedded-null literal tests are specified there but left admitted because + active clients must first split larger literal resources before invoking the + `cstring.R` specs. - `test/cstring/proof_old.v` proves the same ordinary tests and also proves the embedded-null tests using the archived lower-level bridge. - `DESIGN.md` records the representation choice and remaining design notes. @@ -53,7 +57,8 @@ cppreference groups the header into: `memmove`; - miscellaneous: `strerror`. -The first implemented slice covers `strlen`, `strcmp`, and `strncmp`. +The implemented read-only slices cover `strlen`, `strcmp`, `strncmp`, `strchr`, +`strrchr`, `strspn`, `strcspn`, `strpbrk`, and `strstr`. ## Proposed Plan @@ -73,11 +78,12 @@ The first implemented slice covers `strlen`, `strcmp`, and `strncmp`. these proofs; extending `test/cstring/proof_old.v` with matching archived proofs is an optional leftover task, not part of this completed step. -3. Add read-only search and segment APIs next. - Suggested next slice: `strchr`, `strrchr`, `strspn`, `strcspn`, `strpbrk`, - and `strstr`. These mostly preserve input ownership and return either null - or a pointer into an existing string, so they extend the current read-only - story before mutable APIs complicate the model. +3. Done: add read-only search and segment APIs. + This slice covers `strchr`, `strrchr`, `strspn`, `strcspn`, `strpbrk`, and + `strstr`. The active development has pure models, `cstring.R`-based specs, + ordinary litmus tests, and an embedded-null `char[]` array-buffer client + proof. Character-search specs intentionally cover byte-range arguments only, + matching the conservative policy in `DESIGN.md`. 4. Add byte-array APIs as a separate slice. Suggested order: `memcmp`, `memchr`, then `memset`, then `memcpy`, then From bf375c197c45433497f658263e45163e018e188b Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Thu, 23 Apr 2026 12:33:24 -0400 Subject: [PATCH 04/11] Specs for several more functions and their litmus tests (with first, non-ergonomic proofs) --- rocq-brick-libstdcpp/proof/cstring/DESIGN.md | 170 ++- .../proof/cstring/lessons_learned.md | 39 +- rocq-brick-libstdcpp/proof/cstring/model.v | 36 + .../proof/cstring/planning.md | 106 +- rocq-brick-libstdcpp/proof/cstring/pred.v | 42 + rocq-brick-libstdcpp/proof/cstring/spec.v | 137 ++ rocq-brick-libstdcpp/test/cstring/proof.v | 1246 ++++++++++++++++- rocq-brick-libstdcpp/test/cstring/test.cpp | 145 ++ 8 files changed, 1804 insertions(+), 117 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md index 00ca06b..254f4c8 100644 --- a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md +++ b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md @@ -1,29 +1,43 @@ # `` Design Notes -## Current Slice +## Current State -The supported read-only API slices cover the null-terminated byte-string -functions `strlen`, `strcmp`, `strncmp`, `strchr`, `strrchr`, `strspn`, -`strcspn`, `strpbrk`, and `strstr`. +The active development now has two substantial slices: -The reusable specs use the existing `cstring.R` abstraction. This keeps the -library-facing contract aligned with existing clients such as `cstdlib::atoi` -and `iostream`: callers provide a pointer to a valid null-terminated C string -whose logical payload is a `cstring.t`. +- null-terminated byte-string operations specified against `cstring.R`: + `strlen`, `strcmp`, `strncmp`, `strchr`, `strrchr`, `strspn`, `strcspn`, + `strpbrk`, and `strstr`; +- counted byte-array operations specified against abstract object-byte + predicates: `memchr`, `memcmp`, `memset`, `memcpy`, and `memmove`. -The ordinary v1 litmus tests for `strlen`, `strcmp`, and `strncmp` are proven -in both `test/cstring/proof.v` and `test/cstring/proof_old.v`. The newer -search/segment litmus tests are proven in the active development. Embedded-null -literal tests are split into separate functions; the v1 literal tests are -specified but left admitted in the active `cstring.R` development, and proven -in `proof_old.v` using the archived lower-level bridge. Active `char[]` -array-buffer tests cover the corresponding client-side splitting pattern. +The string slice keeps the reusable library-facing contract aligned with the +existing `cstring.R` abstraction: callers provide a pointer to a valid +null-terminated C string whose logical payload is a `cstring.t`. + +The counted byte slice uses abstract byte predicates rather than `cstring.R`. +These operations are not about null-terminated strings, and embedded zero +bytes are ordinary data. + +On the client side, the active `test/cstring/proof.v` currently proves: + +- the ordinary `strlen` / `strcmp` / `strncmp` litmus tests; +- the active read-only search and segment litmus tests; +- explicit `char[]` array-buffer clients for the string slice; +- `test_memchr`, `test_memchr_embedded_null`, `test_memset`, `test_memcpy`, + `test_memmove`, and `test_memcmp`. + +The archived files `model_old.v`, `pred_old.v`, `spec_old.v`, and +`test/cstring/proof_old.v` are still present for comparison and rollback. They +continue to document the earlier lower-level bridge for literal embedded-null +cases in the string slice. ## Representation Choice -`cstring.R` remains the active representation for this slice. It describes the -null-terminated string payload itself, not arbitrary storage that may continue -after the first null byte. +### Null-Terminated Strings + +`cstring.R` remains the active representation for the string slice. It +describes the null-terminated payload itself, not arbitrary storage that may +continue after the first null byte. This means embedded-null or larger-buffer cases are handled on the client side: a proof that starts from a larger literal or array resource must split off the @@ -33,33 +47,79 @@ rather than about the semantic contract of read-only cstring functions. ### `arrayR` and `arrayLR` -For hand-written byte-buffer specs and reusable buffer predicates, prefer -`arrayLR` over one-sided `arrayR` or `arrayL` when the surrounding interface -leaves us that choice. The two-sided predicate usually preserves more useful -ownership information for clients that both read and later restore or mutate a +For hand-written buffer specs and reusable buffer predicates, prefer `arrayLR` +over one-sided `arrayR` or `arrayL` when the surrounding interface leaves us +that choice. The two-sided predicate tends to preserve the right amount of +information for clients that both inspect and later rebuild or mutate a buffer. -The current explicit `char[]` litmus tests are slightly different: cpp2v -generates stack-array initializer resources as concrete `arrayR` predicates. -Their proofs therefore use local `arrayR` splitting/recombination lemmas to -match the generated proof state directly. This should not be read as a general -preference for `arrayR` in library specs; it is a proof-local accommodation for -the shape of generated stack-buffer resources. +In proofs, however, we must follow the proof state we actually get. With the +current proof imports, `verify_spec; go` often exposes stack arrays as +`arrayLR`, but some local helper steps still interact with `arrayR` after +unlocking or after bridge lemmas. The practical rule is: + +- prefer `arrayLR` in specs and reusable bridge lemmas; +- tolerate local `arrayR` reasoning inside proofs when it is simply the + unlocked form we need to rebuild. + +### Counted Byte Arrays + +The byte-array slice covers `memchr`, `memcmp`, `memset`, `memcpy`, and +`memmove`. These functions are not null-terminated string functions: embedded +null bytes are ordinary bytes, and the `n` argument determines the whole +relevant range. + +For this slice, use counted object-byte views rather than `cstring.R`. The +public specs use abstract predicates `object_bytesR byte_ty q bytes` and +`object_bytes_anyR byte_ty n`, where `bytes` is the list of unsigned-byte +values observed by the memory operation and `byte_ty` records the one-byte +pointer-stepping type used for returned interior pointers. This is closer to +the textual C++ specification than requiring an actual `unsigned char[]` +object: the standard memory APIs take `void*`/`const void*` and operate on the +object representation as bytes. + +The previous exact-length `arrayLR Tuchar` specs are preserved in a commented +region in `spec.v`. They were useful for bootstrapping the first byte-array +proofs but are too narrow as reusable library specs. + +`object_bytesR` and `object_bytes_anyR` are parameters rather than definitions. +The concrete meaning of object representation bytes is a framework-level +concept, not just an `unsigned char[]` array. Existing unsigned-char litmus +proofs therefore rely on explicit bridge laws between concrete arrays and the +abstract object-byte predicates. Future work should replace these local bridge +axioms with framework-provided object-representation facts for concrete +`char[]`, `unsigned char[]`, and other trivially copyable objects as needed. + +Embedded-null and embedded-zero litmus tests remain useful regression cases. At +present: + +- `test_memchr_embedded_null_ok` is proved in the active development; +- `test_memcmp_embedded_null`, `test_memset_embedded_null`, + `test_memcpy_embedded_null`, and `test_memmove_embedded_null` are still only + declared via `cpp.spec` stubs in `test/cstring/proof.v`. + +As with the earlier `cstring.R` pivot, reusable specs should describe ranges of +exactly the length passed to the function. Clients that start from larger +buffers are responsible for partitioning those buffers into the active prefix +and the remaining tail, then recombining the tail after the call. This avoids +putting `take`/`drop` bookkeeping into the library specs themselves. + +Use the framework-provided `lengthZ` and `replicateZ` notations from +`skylabs.prelude.list_numbers`; do not define local aliases in `model.v`. ### Character Arguments -Functions such as `strchr` and `strrchr` take an `int` argument but the textual -specification searches for `static_cast(ch)`. The active specs currently -model only byte-range arguments with `valid<"unsigned char"> ch`. This is a -deliberately conservative slice: it avoids claiming behavior for -out-of-byte-range `int` arguments, whose result depends on the C++ conversion -to `char` and therefore on implementation choices such as signedness and -representable values. +Functions such as `strchr`, `strrchr`, and the memory byte-search routines take +an `int` argument but the textual specifications speak in terms of conversion +to a byte-sized character value. The current specs model only byte-range +arguments via `valid<"unsigned char"> ch`. This is intentionally conservative: +it avoids claiming defined behavior for arguments whose result depends on +implementation choices such as signedness or representable values. ## Archived Alternative -The earlier experiment introduced a lower-level `cstringz.R q s tail` predicate -for concrete character arrays shaped like: +The earlier experiment introduced a lower-level `cstringz.R q s tail` +predicate for concrete character arrays shaped like: ```text cstring.to_zstring s ++ tail @@ -73,25 +133,31 @@ That variant is preserved in: - `test/cstring/proof_old.v` Those files are kept for comparison or rollback while we proceed with the -`cstring.R`-based active design. +active designs based on `cstring.R` and `object_bytesR`. ## Leftover Tasks -- Transfer the string-literal embedded-null proof bridge from - `test/cstring/proof_old.v` to the active `test/cstring/proof.v` when we want - to discharge the currently admitted literal tests without depending on - `pred_old.v`. The active array-buffer proofs already cover the analogous - `char[]` client-side splitting pattern. -- Optionally extend `test/cstring/proof_old.v` with the explicit `char[]` - array-buffer litmus proofs if we later want side-by-side regression coverage - for the archived `cstringz.R` design. For now the active and archived proof - files are intentionally not kept in lockstep. -- Consider whether cpp2v should generate `arrayLR` rather than `arrayR` for - stack-allocated array initializers, or provide a standard bridge for this - case. The active `char[]` proofs use local `arrayR` helpers only because the - generated proof state has that shape. +- Discharge the remaining embedded-null literal tests in the active + `cstring.R` development, or leave them intentionally archived-only with a + clear reason. The archived lower-level bridge in `proof_old.v` remains the + reference point. +- Decide whether to keep the archived files as a long-lived comparison surface + or retire them once the active development fully subsumes their distinctive + coverage. +- Investigate whether fractional automation should be derivable automatically + for abstract object-byte predicates. The current parameterized predicates + expose fractional behavior axiomatically; the manual split/recombine pattern + should not spread unchecked. +- Extend the byte-array proofs to the remaining embedded-null regression tests: + `memcmp`, `memset`, `memcpy`, and `memmove`. +- Extend the byte-array specs beyond non-overlapping cases. The active + `memcpy` and `memmove` proofs stay in the disjoint-source/destination lane. + Overlapping `memmove` needs a separate single-buffer or otherwise aliased + specification that snapshots the source range before updating the + destination range. - Keep undefined behavior out of green specs and tests: no null pointers, - invalid pointers, or arrays without a reachable null terminator. + invalid pointers, arrays without a reachable null terminator for string + functions, or out-of-bounds byte counts for memory functions. - Use the existing mutable cstring buffer support, especially `cstring.bufR`, when specifying functions such as `strcpy`, `strncpy`, `strcat`, and `strncat`; revisit only if these predicates are not expressive enough. diff --git a/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md index 6ddb134..926e8a9 100644 --- a/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md +++ b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md @@ -22,15 +22,48 @@ later promotion into shared docs. results into return values when this preserves the abstraction boundary. The `search_result` pattern keeps null-versus-offset pointer results local to the specs rather than leaking pointer arithmetic into the pure model. +- Match the abstraction to the API surface. Null-terminated string functions + want a string predicate such as `cstring.R`; counted byte APIs want a counted + byte predicate such as `object_bytesR`, not a string predicate with an + accidental terminator interpretation. +- Keep undefined behavior out of the contract. The precondition should rule out + malformed inputs rather than silently assigning them behavior. For strings, + that means a reachable terminator. For byte APIs, that means a valid + byte-counted range and any extra side conditions the textual spec requires. +- When a standard API is phrased in terms of object representation bytes, avoid + overspecifying the storage type. An abstract byte predicate is closer to the + text than a spec that insists on a concrete `unsigned char[]` object. +- Prefer exact active-range specs over built-in `take`/`drop` bookkeeping in + the library contract. Let clients partition larger buffers into “active + prefix” and “rest” themselves. ## Proofs - Prefer general arithmetic cleanup over test-specific proof hacks. If a proof needs to reconcile different representations of the same number, first ask - whether the model can produce an arithmetic expression that `Arith.arith_simpl` - can normalize. Avoid local tactics that know about one test's concrete - offsets or string literals. + whether the model can produce an arithmetic expression that + `Arith.arith_simpl` can normalize. Avoid local tactics that know about one + test's concrete offsets or string literals. - `ego` is not always redundant after `go`. In these litmus proofs it often discharges pure obligations from `assert` statements and pointer comparisons. It is worth testing removals with `dune`, but keep `ego` where the generated assertion proof obligations remain. +- Prefer `rewrite /foo` over `cbn [foo]` / `cbv [foo]` when peeling a small + wrapper. It keeps the proof script closer to the intended abstraction level + and avoids collateral simplification. +- Default proof imports can materially change the shape of generated array + resources. When imports change, re-check whether stack arrays arrive as + `arrayLR`, unlocked `arrayR`, or borrowed-cell continuations before trying to + reuse an older proof literally. +- Small bridge lemmas pay for themselves. Conversions such as + `arrayLR`-to-`cstring.R`, `object_bytesR`-to-`arrayLR`, prefix/tail split + lemmas, and byte-array-to-`anyR` lemmas remove duplicated Iris bookkeeping + and make later litmus proofs much easier to repair. +- When automation stops just short of a goal, first check whether the proof is + missing a resource-shape bridge rather than a stronger tactic. Several recent + repairs were really about rebuilding the exact array or byte-view predicate + that `go` expected. +- For `memmove`, non-overlap and overlap are not merely proof variants. If the + spec itself presents disjoint source and destination ownership, overlapping + clients are blocked at the specification level and need a different contract, + not just a more clever proof. diff --git a/rocq-brick-libstdcpp/proof/cstring/model.v b/rocq-brick-libstdcpp/proof/cstring/model.v index 566b1bc..cb7c011 100644 --- a/rocq-brick-libstdcpp/proof/cstring/model.v +++ b/rocq-brick-libstdcpp/proof/cstring/model.v @@ -4,6 +4,7 @@ * See the LICENSE-BedRock file in the repository root for details. *) Require Import skylabs.prelude.numbers. +Require Import skylabs.prelude.list_numbers. Require Import skylabs.prelude.bytestring. #[local] Set Primitive Projections. @@ -39,6 +40,9 @@ Fixpoint strncmp_nat (n : nat) (s1 s2 : bs) : Z := Definition strncmp (s1 s2 : bs) (n : N) : Z := strncmp_nat (N.to_nat n) s1 s2. +Definition byte_of_int (c : Z) : Z := + (c mod 256)%Z. + Fixpoint strchr (s : bs) (c : Z) : option Z := match s with | BS.EmptyString => @@ -112,6 +116,32 @@ Fixpoint strstr (haystack needle : bs) : option Z := end end. +Fixpoint memchr (bytes : list Z) (c : Z) : option Z := + match bytes with + | nil => None + | b :: rest => + if bool_decide (b = byte_of_int c) then Some 0 + else option_map (fun off => (1 + off)%Z) (memchr rest c) + end. + +Fixpoint memcmp (bytes1 bytes2 : list Z) : Z := + match bytes1, bytes2 with + | nil, nil => 0 + | nil, b2 :: _ => - b2 + | b1 :: _, nil => b1 + | b1 :: rest1, b2 :: rest2 => + if bool_decide (b1 = b2) then memcmp rest1 rest2 else b1 - b2 + end. + +Definition memset (c n : Z) : list Z := + replicateZ n (byte_of_int c). + +Definition memcpy (bytes : list Z) : list Z := + bytes. + +Definition memmove (bytes : list Z) : list Z := + bytes. + #[local] Open Scope bs_scope. Succeed Example strcmp_equal : strcmp "abc" "abc" = 0 := eq_refl. @@ -136,3 +166,9 @@ Succeed Example strcspn_prefix : strcspn "abcde" "dx" = 3%N := eq_refl. Succeed Example strpbrk_found : strpbrk "abcdef" "xyc" = Some 2 := eq_refl. Succeed Example strstr_found : strstr "abracadabra" "cad" = Some 4 := eq_refl. Succeed Example strstr_empty : strstr "abracadabra" "" = Some 0 := eq_refl. + +Succeed Example memchr_found : memchr [97; 0; 98]%Z 98 = Some 2 := eq_refl. +Succeed Example memchr_missing : memchr [97; 0; 98]%Z 122 = None := eq_refl. +Succeed Example memcmp_equal : memcmp [97; 0]%Z [97; 0]%Z = 0 := eq_refl. +Succeed Example memcmp_less : memcmp [97; 0; 120]%Z [97; 0; 121]%Z = -1 := eq_refl. +Succeed Example memset_wrap : memset 291 2 = [35; 35]%Z := eq_refl. diff --git a/rocq-brick-libstdcpp/proof/cstring/planning.md b/rocq-brick-libstdcpp/proof/cstring/planning.md index 3ce0cb0..7020dd3 100644 --- a/rocq-brick-libstdcpp/proof/cstring/planning.md +++ b/rocq-brick-libstdcpp/proof/cstring/planning.md @@ -17,34 +17,40 @@ The intended workflow is iterative: ## Current Mental Model -The current workspace contains coherent first and second slices for read-only -null-terminated byte-string operations: - -- `model.v` defines pure byte-string models for `strcmp`, `strncmp`, `strchr`, - `strrchr`, `strspn`, `strcspn`, `strpbrk`, and `strstr`; the active `strlen` - spec uses the existing `cstring.strlen`. -- `pred.v` is intentionally minimal and reuses the existing `cstring.R` - abstraction. -- `spec.v` specifies `strlen`, `strcmp`, `strncmp`, `strchr`, `strrchr`, - `strspn`, `strcspn`, `strpbrk`, and `strstr` against `cstring.R`. -- `test/cstring/test.cpp` contains `void` litmus functions using `assert`. - The embedded-null literal cases are isolated into separate functions from the - ordinary `strlen`, `strcmp`, and `strncmp` tests; the search/segment slice - includes ordinary tests and an embedded-null `char[]` array-buffer client. -- `test/cstring/proof.v` proves the ordinary `strlen`, `strcmp`, `strncmp`, - search/segment tests, array-buffer client tests, and slice-wrapper tests. - The embedded-null literal tests are specified there but left admitted because - active clients must first split larger literal resources before invoking the - `cstring.R` specs. -- `test/cstring/proof_old.v` proves the same ordinary tests and also proves the - embedded-null tests using the archived lower-level bridge. -- `DESIGN.md` records the representation choice and remaining design notes. - -The main abstraction boundary is that `cstring.R` remains the convenient -client-facing null-terminated string predicate. The older `cstringz.R` predicate -is preserved only in `pred_old.v` and used by `proof_old.v` to demonstrate how -embedded-null literal resources can be split and recombined around calls to the -active specs. +The current workspace contains two active slices and one archived comparison +track. + +The active null-terminated byte-string slice covers: + +- `model.v` pure models for `strcmp`, `strncmp`, `strchr`, `strrchr`, + `strspn`, `strcspn`, `strpbrk`, and `strstr`; the active `strlen` spec uses + the existing `cstring.strlen`; +- `pred.v` reuse of the existing `cstring.R` abstraction for the string slice; +- `spec.v` specs for `strlen`, `strcmp`, `strncmp`, `strchr`, `strrchr`, + `strspn`, `strcspn`, `strpbrk`, and `strstr` against `cstring.R`; +- `test/cstring/test.cpp` `void` litmus functions using `assert`, including + separated embedded-null cases and explicit `char[]` array-buffer clients; +- `test/cstring/proof.v` proofs for the ordinary `strlen`, `strcmp`, + `strncmp`, search/segment tests, array-buffer client tests, and slice-wrapper + tests; +- `test/cstring/proof_old.v` archived proofs for the earlier lower-level bridge + design, including literal embedded-null cases. + +The active counted byte-array slice covers: + +- `pred.v` abstract `object_bytesR` / `object_bytes_anyR` predicates together + with bridge axioms to and from concrete `arrayLR` byte arrays; +- `spec.v` active specs for `memchr`, `memcmp`, `memset`, `memcpy`, and + `memmove`, plus a commented archived region containing the earlier + exact-length `arrayLR Tuchar` versions; +- `test/cstring/test.cpp` ordinary and embedded-null litmus tests for + `memchr`, `memcmp`, `memset`, `memcpy`, and `memmove_overlap`; +- `test/cstring/proof.v` proofs for `test_memchr`, + `test_memchr_embedded_null`, `test_memset`, `test_memcpy`, `test_memmove`, + and `test_memcmp`. + +The remaining byte-array embedded-null clients and the overlapping `memmove` +client are not yet proved. ## `` API Surface @@ -57,45 +63,45 @@ cppreference groups the header into: `memmove`; - miscellaneous: `strerror`. -The implemented read-only slices cover `strlen`, `strcmp`, `strncmp`, `strchr`, -`strrchr`, `strspn`, `strcspn`, `strpbrk`, and `strstr`. +The implemented active slices now cover: + +- `strlen`, `strcmp`, `strncmp`, `strchr`, `strrchr`, `strspn`, `strcspn`, + `strpbrk`, `strstr`; +- `memchr`, `memcmp`, `memset`, `memcpy`, `memmove`. ## Proposed Plan -1. Done: keep the existing v1 slice stable. - The active and archived files currently validate with `dune`; keep checking - them when touching this area: +1. Done: keep the original read-only string slice stable. + The active and archived files are meant to keep building together: `proof/cstring/model.vo`, `proof/cstring/pred.vo`, `proof/cstring/spec.vo`, `proof/cstring/model_old.vo`, `proof/cstring/pred_old.vo`, `proof/cstring/spec_old.vo`, `test/cstring/proof.vo`, and `test/cstring/proof_old.vo`. -2. Done: add explicit array-buffer litmus tests for the v1 slice. +2. Done: add explicit array-buffer litmus tests for the string slice. Use `char[]` examples with bytes after the first `'\0'`. In the active development, prove these by explicitly splitting off the `cstring.R` prefix - and recombining the remaining buffer resource after the call. Keep tests as - `void` functions with `assert`. The active `test/cstring/proof.v` now has - these proofs; extending `test/cstring/proof_old.v` with matching archived - proofs is an optional leftover task, not part of this completed step. + and recombining the remaining buffer resource after the call. 3. Done: add read-only search and segment APIs. This slice covers `strchr`, `strrchr`, `strspn`, `strcspn`, `strpbrk`, and - `strstr`. The active development has pure models, `cstring.R`-based specs, - ordinary litmus tests, and an embedded-null `char[]` array-buffer client - proof. Character-search specs intentionally cover byte-range arguments only, - matching the conservative policy in `DESIGN.md`. - -4. Add byte-array APIs as a separate slice. - Suggested order: `memcmp`, `memchr`, then `memset`, then `memcpy`, then - `memmove`. These operate over counted arrays and do not require null - termination, so they likely need a distinct byte-buffer predicate/model. - -5. Add string-copy and concatenation APIs after mutable byte-array support. + `strstr`. Character-search specs intentionally cover byte-range arguments + only, matching the conservative policy in `DESIGN.md`. + +4. In progress: counted byte-array APIs. + The active specs and ordinary litmus proofs now cover `memchr`, `memcmp`, + `memset`, `memcpy`, and non-overlapping `memmove` using abstract + object-byte predicates. Remaining work in this slice is: + - embedded-null regression proofs for the remaining byte-array tests; + - overlapping `memmove`, which needs a stronger aliased or single-buffer + spec. + +5. Next: string-copy and concatenation APIs after mutable byte-array support. Suggested order: `strcpy`, `strncpy`, `strcat`, and `strncat`. These require destination capacity, mutation, null termination, and non-overlap preconditions. -6. Defer locale, global-state, and implementation-storage APIs. +6. Later: locale, global-state, and implementation-storage APIs. `strcoll`, `strxfrm`, `strerror`, and especially `strtok` involve locale, static/internal storage, or global tokenization state. Handle them last with explicit abstraction choices or narrow axiomatization. diff --git a/rocq-brick-libstdcpp/proof/cstring/pred.v b/rocq-brick-libstdcpp/proof/cstring/pred.v index 1ba26e6..5c84c71 100644 --- a/rocq-brick-libstdcpp/proof/cstring/pred.v +++ b/rocq-brick-libstdcpp/proof/cstring/pred.v @@ -3,7 +3,49 @@ * This software is distributed under the terms of the BedRock Open-Source License. * See the LICENSE-BedRock file in the repository root for details. *) +Require Import skylabs.auto.cpp.prelude.proof. Require Export skylabs.cpp.string. Require Export skylabs.brick.libstdcpp.cstring.model. #[local] Set Primitive Projections. + +#[local] Open Scope Z_scope. + +(** [object_bytesR byte_ty q bytes] is an abstract counted byte view of an + object range. The payload is the unsigned-byte values observed by the + memory functions; [byte_ty] records the one-byte pointer-stepping type used + for returned interior pointers. *) +Axiom object_bytesR : forall `{Σ : cpp_logic} {σ : genv}, + type -> cQp.t -> list Z -> Rep. + +Axiom object_bytesR_cfrac : forall `{Σ : cpp_logic} {σ : genv} byte_ty bytes, + CFractional (fun q => object_bytesR byte_ty q bytes). +#[global] Existing Instance object_bytesR_cfrac. + +#[global] Instance object_bytesR_as_cfrac `{Σ : cpp_logic, σ : genv} + byte_ty q bytes : + AsCFractional (object_bytesR byte_ty q bytes) + (fun q => object_bytesR byte_ty q bytes) q. +Proof. solve_as_cfrac. Qed. + +(** [object_bytes_anyR byte_ty n] owns a writable [n]-byte destination range + whose previous byte values are irrelevant. *) +Axiom object_bytes_anyR : forall `{Σ : cpp_logic} {σ : genv}, + type -> Z -> Rep. + +Axiom object_bytesR_to_arrayLR : forall `{Σ : cpp_logic} {σ : genv} + (p : ptr) ty q hi bytes, + lengthZ bytes = hi -> + p |-> object_bytesR ty q bytes ⊢ + p |-> arrayLR ty 0 hi (fun b : Z => ucharR q b) bytes. + +Axiom object_bytesR_of_arrayLR : forall `{Σ : cpp_logic} {σ : genv} + (p : ptr) ty q hi bytes, + lengthZ bytes = hi -> + p |-> arrayLR ty 0 hi (fun b : Z => ucharR q b) bytes ⊢ + p |-> object_bytesR ty q bytes. + +Axiom object_bytes_anyR_of_anyR_array : forall `{Σ : cpp_logic} {σ : genv} + (p : ptr) ty n, + p |-> anyR (Tarray ty n) 1$m ⊢ + p |-> object_bytes_anyR ty (Z.of_N n). diff --git a/rocq-brick-libstdcpp/proof/cstring/spec.v b/rocq-brick-libstdcpp/proof/cstring/spec.v index 44ee7bb..db98657 100644 --- a/rocq-brick-libstdcpp/proof/cstring/spec.v +++ b/rocq-brick-libstdcpp/proof/cstring/spec.v @@ -4,6 +4,7 @@ * See the LICENSE-BedRock file in the repository root for details. *) Require Import skylabs.auto.cpp.specs. +Require Import skylabs.auto.cpp.prelude.proof. Require Export skylabs.brick.libstdcpp.cstring.pred. Require Import skylabs.brick.libstdcpp.cstring.inc_cstring_cpp. @@ -19,6 +20,13 @@ Notation search_result p found := | None => Vptr nullptr end (only parsing). +Notation byte_search_result byte_ty p found := + match found with + | Some 0 => Vptr p + | Some off => Vptr (p .[ byte_ty ! off ]) + | None => Vptr nullptr + end (only parsing). + Section with_cpp. Context `{Σ : cpp_logic, module ⊧ σ}. @@ -114,4 +122,133 @@ Section with_cpp. \prepost{haystack_q haystack} haystack_p |-> cstring.R haystack_q haystack \prepost{needle_q needle} needle_p |-> cstring.R needle_q needle \post[search_result haystack_p (strstr haystack needle)] emp). + +(* + Archived exact [unsigned char] array specs. These were useful for the first + byte-array slice, but they are too narrow for the standard [void*] memory + APIs, whose textual specifications operate on object bytes. + + cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_spec_old with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \arg{n} "__n" (Vn n) + \prepost{q bytes} s_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR q b) bytes + \require lengthZ bytes = Z.of_N n + \post[byte_search_result s_p (memchr bytes c)] emp). + + cpp.spec "memchr(const void*, int, unsigned long)" as memchr_const_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \arg{n} "__n" (Vn n) + \prepost{q bytes} s_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR q b) bytes + \require lengthZ bytes = Z.of_N n + \post[byte_search_result s_p (memchr bytes c)] emp). + + cpp.spec "memcmp" with + (\arg{s1_p} "__s1" (Vptr s1_p) + \arg{s2_p} "__s2" (Vptr s2_p) + \arg{n} "__n" (Vn n) + \prepost{q1 bytes1} s1_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR q1 b) bytes1 + \prepost{q2 bytes2} s2_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR q2 b) bytes2 + \require lengthZ bytes1 = Z.of_N n + \require lengthZ bytes2 = Z.of_N n + \post[Vint (memcmp bytes1 bytes2)] emp). + + cpp.spec "memset" with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \arg{n} "__n" (Vn n) + \pre s_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) + \post[Vptr s_p] s_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR 1$m b) (memset c (Z.of_N n))). + + cpp.spec "memcpy" with + (\arg{dest_p} "__dest" (Vptr dest_p) + \arg{src_p} "__src" (Vptr src_p) + \arg{n} "__n" (Vn n) + \prepost{q bytes} src_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR q b) bytes + \pre dest_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) + \require lengthZ bytes = Z.of_N n + \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR 1$m b) (memcpy bytes)). + + cpp.spec "memmove" with + (\arg{dest_p} "__dest" (Vptr dest_p) + \arg{src_p} "__src" (Vptr src_p) + \arg{n} "__n" (Vn n) + \prepost{q bytes} src_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR q b) bytes + \pre dest_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) + \require lengthZ bytes = Z.of_N n + \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun b : Z => ucharR 1$m b) (memmove bytes)). + *) + + cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \arg{n} "__n" (Vn n) + \prepost{byte_ty q bytes} s_p |-> object_bytesR byte_ty q bytes + \require lengthZ bytes = Z.of_N n + \post[byte_search_result byte_ty s_p (memchr bytes c)] emp). + + cpp.spec "memchr(const void*, int, unsigned long)" as memchr_const_spec with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \arg{n} "__n" (Vn n) + \prepost{byte_ty q bytes} s_p |-> object_bytesR byte_ty q bytes + \require lengthZ bytes = Z.of_N n + \post[byte_search_result byte_ty s_p (memchr bytes c)] emp). + + cpp.spec "memcmp" with + (\arg{s1_p} "__s1" (Vptr s1_p) + \arg{s2_p} "__s2" (Vptr s2_p) + \arg{n} "__n" (Vn n) + \prepost{byte_ty1 q1 bytes1} s1_p |-> + object_bytesR byte_ty1 q1 bytes1 + \prepost{byte_ty2 q2 bytes2} s2_p |-> + object_bytesR byte_ty2 q2 bytes2 + \require lengthZ bytes1 = Z.of_N n + \require lengthZ bytes2 = Z.of_N n + \post[Vint (memcmp bytes1 bytes2)] emp). + + cpp.spec "memset" with + (\arg{s_p} "__s" (Vptr s_p) + \arg{c} "__c" (Vint c) + \arg{n} "__n" (Vn n) + \pre{byte_ty} s_p |-> object_bytes_anyR byte_ty (Z.of_N n) + \post[Vptr s_p] s_p |-> object_bytesR byte_ty 1$m + (memset c (Z.of_N n))). + + cpp.spec "memcpy" with + (\arg{dest_p} "__dest" (Vptr dest_p) + \arg{src_p} "__src" (Vptr src_p) + \arg{n} "__n" (Vn n) + \prepost{src_byte_ty q bytes} src_p |-> + object_bytesR src_byte_ty q bytes + \pre{dest_byte_ty} dest_p |-> + object_bytes_anyR dest_byte_ty (Z.of_N n) + \require lengthZ bytes = Z.of_N n + \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m + (memcpy bytes)). + + cpp.spec "memmove" with + (\arg{dest_p} "__dest" (Vptr dest_p) + \arg{src_p} "__src" (Vptr src_p) + \arg{n} "__n" (Vn n) + \prepost{src_byte_ty q bytes} src_p |-> + object_bytesR src_byte_ty q bytes + \pre{dest_byte_ty} dest_p |-> + object_bytes_anyR dest_byte_ty (Z.of_N n) + \require lengthZ bytes = Z.of_N n + \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m + (memmove bytes)). End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index 363d7ba..3b0252e 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -5,10 +5,22 @@ *) Require Import skylabs.auto.cpp.proof. Require Import skylabs.auto.cpp.hints.anyR. +(** BEGIN: SKYLABS DEFAULT PROOF IMPORTS *) +Require Import skylabs.auto.cpp.prelude.proof. +Require Import skylabs.cpp.array. +Import expr_join. +#[local] Hint Resolve delayed_case.smash_delayed_case_B | 1000 : br_hints. +#[local] Hint Resolve delayed_case.expr_join.smash_delayed_case_B | 1000 : br_hints. +(** END: SKYLABS DEFAULT PROOF IMPORTS *) Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.cstring.spec. Require Import skylabs.brick.libstdcpp.test.cstring.test_cpp. +Import normalize.only_provable_norm. + +Import normalize.normalize_ptr. +Import refine_lib. + #[local] Lemma borrow_arrayR_cstringR `{Σ : cpp_logic, σ : genv} (p : ptr) q bytes s tail : bytes = cstring.to_zstring s ++ tail -> @@ -32,6 +44,33 @@ Proof. iFrame. Qed. +#[local] Lemma borrow_arrayLR_cstringR `{Σ : cpp_logic, σ : genv} + (p : ptr) q bytes s tail : + bytes = cstring.to_zstring s ++ tail -> + cstring.WF s -> + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) + (fun c : N => charR q c) bytes ⊢ + p |-> cstring.R q s ∗ + (p |-> cstring.R q s -∗ + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) + (fun c : N => charR q c) bytes). +Proof. + intros Hbytes Hwf. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + iPoseProof (borrow_arrayR_cstringR p q bytes s tail Hbytes Hwf with "Harr") + as "[Hs Hclose]". + iSplitL "Hs". + - iExact "Hs". + - iIntros "Hs". + iPoseProof ("Hclose" with "Hs") as "Harr". + rewrite /arrayLR. + iSplit. + + iPureIntro. lia. + + iExact "Harr". +Qed. + #[local] Lemma offset_entails `{Σ : cpp_logic, σ : genv} (o : offset) (P Q : Rep) : (P ⊢ Q) -> o |-> P ⊢ o |-> Q. @@ -39,6 +78,49 @@ Proof. intros HPQ. apply _offsetR_mono. exact HPQ. Qed. +#[local] Lemma at_zero_intro `{Σ : cpp_logic, σ : genv} + (p : ptr) (R : Rep) : + p |-> R ⊢ p .[Tuchar ! 0] |-> R. +Proof. + rewrite _at_sub_0; [reflexivity|done]. +Qed. + +#[local] Lemma at_zero_elim `{Σ : cpp_logic, σ : genv} + (p : ptr) (R : Rep) : + p .[Tuchar ! 0] |-> R ⊢ p |-> R. +Proof. + rewrite _at_sub_0; [reflexivity|done]. +Qed. + +#[local] Lemma at_type_ptrR_validR_plus_one `{Σ : cpp_logic, σ : genv} + (p : ptr) ty : + p |-> type_ptrR ty ⊢ p .[ty ! 1] |-> validR. +Proof. + rewrite -_at_offsetR. + apply heap_pred._at_cancel. + apply type_ptrR_validR_plus_one. +Qed. + +#[local] Lemma at_uchar_offset_add_intro `{Σ : cpp_logic, σ : genv} + (p : ptr) i j k (R : Rep) : + k = (i + j)%Z -> + p .[Tuchar ! k] |-> R ⊢ p .[Tuchar ! i] .[Tuchar ! j] |-> R. +Proof. + intros ->. + rewrite o_sub_sub. + reflexivity. +Qed. + +#[local] Lemma at_uchar_offset_add_elim `{Σ : cpp_logic, σ : genv} + (p : ptr) i j k (R : Rep) : + k = (i + j)%Z -> + p .[Tuchar ! i] .[Tuchar ! j] |-> R ⊢ p .[Tuchar ! k] |-> R. +Proof. + intros ->. + rewrite o_sub_sub. + reflexivity. +Qed. + #[local] Lemma arrayR_charR_Vchar `{Σ : cpp_logic, σ : genv} q xs : arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ arrayR (Tchar_ char_type.Cchar) @@ -75,9 +157,380 @@ Proof. exact Hlen. Qed. +#[local] Lemma arrayLR_charR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) + (fun c : N => charR 1$m c) xs ⊢ + p |-> anyR (Tarray (Tchar_ char_type.Cchar) n) 1$m. +Proof. + intros Hlen. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + iApply (arrayR_charR_anyR with "Harr"). + exact Hlen. +Qed. + +#[local] Lemma at_charR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) q x : + p |-> charR q x ⊢ p |-> anyR (Tchar_ char_type.Cchar) q. +Proof. + apply heap_pred._at_cancel. + apply primR_anyR. +Qed. + +#[local] Lemma arrayR_charR_arrayR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR 1$m c) xs ⊢ + p |-> arrayR (Tchar_ char_type.Cchar) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) + (replicateN (lengthN xs) ()). +Proof. + revert p. + induction xs as [|x xs IH]. + all: intros p. + - rewrite /lengthN /= !arrayR_nil. reflexivity. + - rewrite arrayR_cons !_at_sep _at_offsetR. + iIntros "(Hty & Hx & Hxs)". + replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by + (rewrite /lengthN Nat2N.inj_succ; reflexivity). + rewrite replicateN_S. + rewrite arrayR_cons !_at_sep _at_offsetR. + iFrame "Hty". + iSplitL "Hx". + + iApply (at_charR_anyR with "Hx"). + + iApply (IH with "Hxs"). +Qed. + +#[local] Lemma arrayLR_charR_arrayLR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) + (fun c : N => charR 1$m c) xs ⊢ + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) + (replicateN n ()). +Proof. + intros Hlen. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + replace (replicateN n ()) with (replicateN (lengthN xs) ()) + by (rewrite /replicateN /lengthN -(N2Nat.id n) Hlen; reflexivity). + iPoseProof (arrayR_charR_arrayR_anyR with "Harr") as "Harr". + rewrite /arrayLR. + iSplit. + - iPureIntro. + unfold lengthZ, lengthN, replicateN. + rewrite length_replicate. + replace (length xs) with (N.to_nat n) by exact Hlen. + repeat rewrite N2Nat.id. + lia. + - rewrite _at_offsetR _at_sub_0; [|done]. + iExact "Harr". +Qed. + +#[local] Lemma arrayLR_prefix_tail0 `{Σ : cpp_logic, σ : genv} + {A : Type} (p : ptr) ty mid hi (R : A -> Rep) xs0 xs1 : + lengthN xs0 = Z.to_N mid -> + (0 <= mid)%Z -> + (mid <= hi)%Z -> + p |-> arrayLR ty 0 hi R (xs0 ++ xs1) ⊣⊢ + p |-> arrayLR ty 0 mid R xs0 ∗ + p .[ty ! mid] |-> arrayLR ty 0 (hi - mid) R xs1. +Proof. + intros Hlen Hlo Hhi. + assert (Hlen' : lengthN xs0 = Z.to_N (mid - 0)) by + (replace (mid - 0)%Z with mid by lia; exact Hlen). + rewrite (arrayLR_app' p 0 mid hi R xs0 xs1 Hlen' Hlo Hhi). + rewrite _at_sub_arrayLR. + Arith.arith_simpl. + reflexivity. +Qed. + +#[local] Lemma arrayR_ucharR_object_bytesR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ + p |-> object_bytesR Tuchar 1$m xs. +Proof. + iIntros "Hs". + iApply object_bytesR_of_arrayLR; [reflexivity|]. + rewrite arrayLR.unlock _at_sep. + iSplit; [iPureIntro; lia|]. + rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. +Qed. + +#[local] Lemma object_bytesR_half_split `{Σ : cpp_logic, σ : genv} + (p : ptr) ty bytes : + p |-> object_bytesR ty 1$m bytes ⊣⊢ + p |-> object_bytesR ty (cQp.mk false (1/2)) bytes ∗ + p |-> object_bytesR ty (cQp.mk false (1/2)) bytes. +Proof. + rewrite -(cfractional (P := fun q => p |-> object_bytesR ty q bytes) + (cQp.mk false (1/2)) (cQp.mk false (1/2))). + rewrite -cQp.mk_add' Qp.half_half. + reflexivity. +Qed. + +#[local] Lemma object_bytesR_prefix_tail0 `{Σ : cpp_logic, σ : genv} + (p : ptr) ty q mid hi xs0 xs1 : + lengthZ (xs0 ++ xs1) = hi -> + lengthZ xs0 = mid -> + lengthZ xs1 = (hi - mid)%Z -> + p |-> object_bytesR ty q (xs0 ++ xs1) ⊣⊢ + p |-> object_bytesR ty q xs0 ∗ + p .[ty ! mid] |-> object_bytesR ty q xs1. +Proof. + intros Htotal Hhead Htail. + iSplit. + - iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p ty q hi (xs0 ++ xs1) + Htotal with "Hs") as "Hs". + iPoseProof (arrayLR_prefix_tail0 p ty mid hi + (fun b : Z => ucharR q b) xs0 xs1 + ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) + ltac:(lia) ltac:(lia) with "Hs") as "[Hhead Htail]". + iPoseProof (object_bytesR_of_arrayLR p ty q mid xs0 + Hhead with "Hhead") as "Hhead". + iPoseProof (object_bytesR_of_arrayLR (p .[ ty ! mid]) ty q + (hi - mid) xs1 Htail with "Htail") as "Htail". + iFrame. + - iIntros "[Hhead Htail]". + iPoseProof (object_bytesR_to_arrayLR p ty q mid xs0 + Hhead with "Hhead") as "Hhead". + iPoseProof (object_bytesR_to_arrayLR (p .[ ty ! mid]) ty q + (hi - mid) xs1 Htail with "Htail") as "Htail". + iPoseProof ((arrayLR_prefix_tail0 p ty mid hi + (fun b : Z => ucharR q b) xs0 xs1 + ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) + ltac:(lia) ltac:(lia)) with "[$Hhead $Htail]") as "Hs". + iPoseProof (object_bytesR_of_arrayLR p ty q hi + (xs0 ++ xs1) Htotal with "Hs") as "Hs". + iExact "Hs". +Qed. + +#[local] Lemma arrayLR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayLR Tuchar 0 (Z.of_N n) (fun c : Z => ucharR 1$m c) xs ⊢ + p |-> anyR (Tarray Tuchar n) 1$m. +Proof. + intros Hlen. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + rewrite anyR_array. + iApply (arrayR_anyR_f (fun c : Z => c) with "Harr"). + exact Hlen. +Qed. + +#[local] Lemma lengthZ_of_to_nat_length {A : Type} (n : N) (xs : list A) : + N.to_nat n = length xs -> lengthZ xs = Z.of_N n. +Proof. + intros Hlen. + unfold lengthZ, lengthN. + rewrite <- Hlen, N2Nat.id. + reflexivity. +Qed. + +#[local] Lemma memchr_found_after_prefix prefix b suffix c : + List.Forall (fun x => x <> byte_of_int c) prefix -> + b = byte_of_int c -> + memchr (prefix ++ b :: suffix) c = Some (Z.of_nat (length prefix)). +Proof. + intros Hprefix Hb. + induction Hprefix as [|x prefix Hx _ IH]. + - simpl. + rewrite bool_decide_true; [|done]. + reflexivity. + - simpl. + rewrite bool_decide_false; [|done]. + rewrite IH. + simpl. + f_equal. + rewrite Nat2Z.inj_succ. + rewrite Z.add_1_l. + reflexivity. +Qed. + +#[local] Lemma memchr_missing_if_no_match bytes c : + List.Forall (fun x => x <> byte_of_int c) bytes -> + memchr bytes c = None. +Proof. + intros Hbytes. + induction Hbytes as [|x bytes Hx _ IH]. + - reflexivity. + - simpl. + rewrite bool_decide_false; [|done]. + rewrite IH. + reflexivity. +Qed. + +#[local] Ltac solve_memchr_side := + unfold byte_of_int; + repeat (rewrite Z.mod_small; [|lia]); + match goal with + | |- List.Forall _ [] => constructor + | |- List.Forall _ (_ :: _) => + constructor; [solve_memchr_side | solve_memchr_side] + | |- _ => lia + end. + +#[local] Lemma object_bytesR_ucharR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> anyR (Tarray Tuchar n) 1$m. +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (Z.of_N n) xs + ltac:(apply lengthZ_of_to_nat_length; exact Hlen) + with "Hs") as "Hs". + iApply (arrayLR_ucharR_anyR with "Hs"). + exact Hlen. +Qed. + +#[local] Lemma object_bytesR_ucharR_object_bytes_anyR + `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> object_bytes_anyR Tuchar (Z.of_N n). +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (object_bytesR_ucharR_anyR _ n xs Hlen with "Hs") as "Hs". + iApply (object_bytes_anyR_of_anyR_array with "Hs"). +Qed. + +#[local] Lemma object_bytesR_ucharR_arrayR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. +Proof. + iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ xs) xs + eq_refl with "Hs") as "Hs". + rewrite arrayLR.unlock _at_sep. + iDestruct "Hs" as "[_ Hs]". + rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. +Qed. + +#[local] Lemma at_arrayR_ucharR_cons `{Σ : cpp_logic, σ : genv} + (p : ptr) x xs : + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) (x :: xs) ⊣⊢ + p |-> type_ptrR Tuchar ∗ + p |-> ucharR 1$m x ∗ + p .[Tuchar ! 1] |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. +Proof. + rewrite arrayR_cons !_at_sep. + rewrite _at_offsetR. + reflexivity. +Qed. + +#[local] Lemma at_arrayR_cons `{Σ : cpp_logic, σ : genv} + {A : Type} (p : ptr) ty (R : A -> Rep) x xs : + p |-> arrayR ty R (x :: xs) ⊣⊢ + p |-> type_ptrR ty ∗ + p |-> R x ∗ + p .[ty ! 1] |-> arrayR ty R xs. +Proof. + rewrite arrayR_cons !_at_sep. + rewrite _at_offsetR. + reflexivity. +Qed. + +#[local] Lemma at_ucharR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) q x : + p |-> ucharR q x ⊢ p |-> anyR Tuchar q. +Proof. + apply heap_pred._at_cancel. + apply primR_anyR. +Qed. + +#[local] Lemma arrayR_ucharR_arrayR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ + p |-> arrayR Tuchar (fun _ : unit => anyR Tuchar 1$m) + (replicateN (lengthN xs) ()). +Proof. + revert p. + induction xs as [|x xs IH]. + all: intros p. + - rewrite /lengthN /= !arrayR_nil. reflexivity. + - rewrite (at_arrayR_ucharR_cons p x xs). + iIntros "(Hty & Hx & Hxs)". + replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by + (rewrite /lengthN Nat2N.inj_succ; reflexivity). + rewrite replicateN_S. + rewrite (at_arrayR_cons p Tuchar + (fun _ : unit => anyR Tuchar 1$m) () (replicateN (lengthN xs) ())). + iFrame "Hty". + iSplitL "Hx". + + iApply (at_ucharR_anyR with "Hx"). + + iApply (IH with "Hxs"). +Qed. + +#[local] Lemma object_bytesR_ucharR_arrayLR_anyR + `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun _ : unit => anyR Tuchar 1$m) (replicateN n ()). +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". + rewrite arrayLR.unlock _at_sep. + iSplit. + - iPureIntro. + unfold lengthZ, lengthN, replicateN. + rewrite length_replicate N2Nat.id. + lia. + - + rewrite _at_offsetR _at_sub_0; [|done]. + rewrite -(N2Nat.id n) Hlen. + iApply (arrayR_ucharR_arrayR_anyR with "Hs"). +Qed. + +#[local] Lemma uchar_cells_object_bytesR_two `{Σ : cpp_logic, σ : genv} + (p : ptr) a b : + p |-> ucharR 1$m a ∗ + p .[Tuchar ! 1] |-> ucharR 1$m b ⊢ + p |-> object_bytesR Tuchar 1$m [a; b]. +Proof. + iIntros "(Ha & Hb)". + iDestruct (observe (p |-> type_ptrR Tuchar) with "Ha") as "#Hty0". + iDestruct (observe (p .[Tuchar ! 1] |-> type_ptrR Tuchar) with "Hb") + as "#Hty1". + iApply arrayR_ucharR_object_bytesR. + rewrite (at_arrayR_ucharR_cons p a [b]). + iFrame "Hty0 Ha". + rewrite (at_arrayR_ucharR_cons (p .[Tuchar ! 1]) b []). + iFrame "Hty1 Hb". + rewrite arrayR_nil _at_sep. + iSplit. + - iApply (at_type_ptrR_validR_plus_one with "Hty1"). + - iPureIntro. done. +Qed. + +#[local] Lemma arrayR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ + p |-> anyR (Tarray Tuchar n) 1$m. +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (arrayR_ucharR_object_bytesR with "Hs") as "Hs". + iApply (object_bytesR_ucharR_anyR with "Hs"). + exact Hlen. +Qed. + Section with_cpp. Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. + (* Restored after the byte-array slice landed. This note records why these + proofs were parked temporarily during focused iteration. *) + cpp.spec "test_strlen()" default. Lemma test_strlen_ok : verify[module] "test_strlen()". Proof. verify_spec; go; ego. Qed. @@ -110,7 +563,7 @@ Section with_cpp. verify[module] "test_strlen_array_buffer()". Proof. verify_spec; go. - iPoseProof (borrow_arrayR_cstringR _ _ + iPoseProof (borrow_arrayLR_cstringR _ _ (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) "ab"%bs [99%N; 100%N; 0%N] eq_refl ltac:(apply cstring.WF_cons; @@ -123,7 +576,7 @@ Section with_cpp. iSplit; [go|]. iIntros "Hs". iPoseProof ("Hclose" with "Hs") as "Harr". - iPoseProof (arrayR_charR_anyR _ 6%N + iPoseProof (arrayLR_charR_arrayLR_anyR _ 6%N (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") as "Harr". @@ -137,7 +590,7 @@ Section with_cpp. verify[module] "test_strcmp_array_buffer()". Proof. verify_spec; go. - iPoseProof (borrow_arrayR_cstringR _ _ + iPoseProof (borrow_arrayLR_cstringR _ _ (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) "ab"%bs [120%N; 0%N] eq_refl ltac:(apply cstring.WF_cons; @@ -146,7 +599,7 @@ Section with_cpp. [change (Byte.x62 <> Byte.x00); congruence|]; apply cstring.WF_nil) with "[$]") as "[Hx Hclosex]". - iPoseProof (borrow_arrayR_cstringR _ _ + iPoseProof (borrow_arrayLR_cstringR _ _ (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) "ab"%bs [121%N; 0%N] eq_refl ltac:(apply cstring.WF_cons; @@ -159,11 +612,11 @@ Section with_cpp. iIntros "[Hx Hy]". iPoseProof ("Hclosex" with "Hx") as "Harrx". iPoseProof ("Hclosey" with "Hy") as "Harry". - iPoseProof (arrayR_charR_anyR _ 5%N + iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harrx") as "Harrx". - iPoseProof (arrayR_charR_anyR _ 5%N + iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harry") as "Harry". @@ -177,7 +630,7 @@ Section with_cpp. verify[module] "test_strncmp_array_buffer()". Proof. verify_spec; go. - iPoseProof (borrow_arrayR_cstringR _ _ + iPoseProof (borrow_arrayLR_cstringR _ _ (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) "ab"%bs [120%N; 0%N] eq_refl ltac:(apply cstring.WF_cons; @@ -186,7 +639,7 @@ Section with_cpp. [change (Byte.x62 <> Byte.x00); congruence|]; apply cstring.WF_nil) with "[$]") as "[Hx Hclosex]". - iPoseProof (borrow_arrayR_cstringR _ _ + iPoseProof (borrow_arrayLR_cstringR _ _ (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) "ab"%bs [121%N; 0%N] eq_refl ltac:(apply cstring.WF_cons; @@ -199,11 +652,11 @@ Section with_cpp. iIntros "[Hx Hy]". iPoseProof ("Hclosex" with "Hx") as "Harrx". iPoseProof ("Hclosey" with "Hy") as "Harry". - iPoseProof (arrayR_charR_anyR _ 5%N + iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harrx") as "Harrx". - iPoseProof (arrayR_charR_anyR _ 5%N + iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harry") as "Harry". @@ -256,7 +709,7 @@ Section with_cpp. verify[module] "test_search_embedded_null_array_buffer()". Proof using MOD. verify_spec; go. - iPoseProof (borrow_arrayR_cstringR _ _ + iPoseProof (borrow_arrayLR_cstringR _ _ (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) "ab"%bs [98%N; 99%N; 0%N] eq_refl ltac:(apply cstring.WF_cons; @@ -311,7 +764,7 @@ Section with_cpp. iIntros "[Hs Hempty]". Arith.arith_simpl; go; ego. iPoseProof ("Hclose" with "Hs") as "Harr". - iPoseProof (arrayR_charR_anyR _ 6%N + iPoseProof (arrayLR_charR_arrayLR_anyR _ 6%N (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") as "Harr". @@ -323,4 +776,773 @@ Section with_cpp. cpp.spec "test_cstring_slice1()" default. Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". Proof. verify_spec; go. Qed. + + cpp.spec "test_memset()" default. + Lemma test_memset_ok : verify[module] "test_memset()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (s_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hs". + iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hs") as "Hs". + + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + as "[Htarget Htail]". + iExists Tuchar. + iSplitL "Htarget". + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 2%N + [97%Z; 98%Z] ltac:(reflexivity) with "Htarget"). + - iIntros "Htarget". + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [120%Z; 120%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Htarget $Htail]") as "Hs". + iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". + rewrite (at_arrayR_ucharR_cons s_addr 120%Z + [120%Z; 99%Z; 100%Z]). + iDestruct "Hs" as "[#Hty0 [H0 Hs]]". + iPoseProof (at_zero_intro s_addr with "H0") as "H0". + iExists (Vint 120%Z), (cQp.mk false 1%Qp). + iFrame "H0". iIntros "H0". + go. + iPoseProof (at_arrayR_ucharR_cons (s_addr .[Tuchar ! 1]) + 120%Z [99%Z; 100%Z] with "Hs") as "Hs". + iDestruct "Hs" as "[#Hty1 [H1 Hs]]". + iExists (Vint 120%Z), (cQp.mk false 1%Qp). + iFrame "H1". iIntros "H1". + go. + iPoseProof (at_arrayR_ucharR_cons + (s_addr .[Tuchar ! 1] .[Tuchar ! 1]) + 99%Z [100%Z] with "Hs") as "Hs". + iDestruct "Hs" as "[#Hty2 [H2 Hs]]". + iEval (rewrite o_sub_sub) in "H2". + iEval (rewrite o_sub_sub) in "Hs". + Arith.arith_simpl. + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "H2". iIntros "H2". + go. + iPoseProof (at_arrayR_ucharR_cons + (s_addr .[Tuchar ! 1] .[Tuchar ! 2]) + 100%Z [] with "Hs") as "Hs". + iDestruct "Hs" as "[#Hty3 [H3 Hs]]". + iEval (rewrite o_sub_sub) in "H3". + iEval (rewrite o_sub_sub) in "Hs". + Arith.arith_simpl. + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "H3". iIntros "H3". + go. + iPoseProof (at_zero_elim s_addr with "H0") as "H0". + iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z + with "[$H0 $H1]") as "Hhead". + Arith.arith_simpl. + iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$H2 $H3]") as "Htail". + iPoseProof (object_bytesR_prefix_tail0 (s_addr .[ Tuchar ! 2]) + Tuchar (cQp.mk false 1) 1 2 [99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Htail") + as "[Htarget Htail]". + iRename "Hs" into "Hempty". + go. + go. + iExists Tuchar. + iSplitL "Htarget". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1%N + [99%Z] ltac:(reflexivity) with "Htarget"). + + iIntros "Htarget". + go. + iPoseProof ((object_bytesR_prefix_tail0 (s_addr .[ Tuchar ! 2]) + Tuchar (cQp.mk false 1) 1 2 [35%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Htarget $Htail]") as "Htail". + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [120%Z; 120%Z] [35%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Htail]") as "Hs". + iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". + go. + rewrite (at_arrayR_ucharR_cons s_addr 120%Z + [120%Z; 35%Z; 100%Z]). + iDestruct "Hs" as "[#Hty0' [H0 Hs]]". + iPoseProof (at_zero_intro s_addr with "H0") as "H0_assert". + iPoseProof (at_arrayR_ucharR_cons (s_addr .[Tuchar ! 1]) + 120%Z [35%Z; 100%Z] with "Hs") as "Hs". + iDestruct "Hs" as "[#Hty1' [H1 Hs]]". + iPoseProof (at_arrayR_ucharR_cons + (s_addr .[Tuchar ! 1] .[Tuchar ! 1]) + 35%Z [100%Z] with "Hs") as "Hs". + iDestruct "Hs" as "[#Hty2' [H2 Hs]]". + iEval (rewrite o_sub_sub) in "H2". + iEval (rewrite o_sub_sub) in "Hs". + Arith.arith_simpl. + iExists (Vint 35%Z), (cQp.mk false 1%Qp). + iFrame "H2". iIntros "H2". + go. + iPoseProof (at_arrayR_ucharR_cons + (s_addr .[Tuchar ! 1] .[Tuchar ! 2]) + 100%Z [] with "Hs") as "Hs". + iDestruct "Hs" as "[#Hty3' [H3 Hempty2]]". + iEval (rewrite o_sub_sub) in "H3". + Arith.arith_simpl. + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "H3". iIntros "H3". + go. + iPoseProof (at_zero_elim s_addr with "H0_assert") as "H0". + iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z + with "[$H0 $H1]") as "Hhead". + iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) + 35%Z 100%Z with "[$H2 $H3]") as "Htail". + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [120%Z; 120%Z] [35%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Htail]") as "Hs". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [120%Z; 120%Z; 35%Z; 100%Z] ltac:(reflexivity) with "Hs") + as "Hs". + iFrame "Hs". + go. + Qed. + + cpp.spec "test_memchr()" default. + Lemma test_memchr_ok : verify[module] "test_memchr()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (s_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 97%Z]) as "Hs". + iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 97%Z] ltac:(reflexivity) with "Hs") as "Hs". + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit. + + done. + + iIntros "Hs". + rewrite (memchr_found_after_prefix (@nil Z) 97%Z [98%Z; 99%Z; 97%Z] 97%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [97%Z; 98%Z] 99%Z [97%Z] 99%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iFrame|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_missing_if_no_match [97%Z; 98%Z; 99%Z; 97%Z] 122%Z); [|solve_memchr_side..]. + go. + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 0 4 [] [97%Z; 98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + as "[Hempty Hs]". + iExists Tuchar, (cQp.mk false 1), []. + iSplitL "Hempty"; [iExact "Hempty"|]. + iSplit; [done|]. + iIntros "Hempty". + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 0 4 [] [97%Z; 98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hempty $Hs]") + as "Hs". + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + as "[Hhead Hs]". + iExists Tuchar, (cQp.mk false 1), [98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [98%Z; 99%Z] 97%Z (@nil Z) 97%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Hs]") + as "Hs". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 98%Z; 99%Z; 97%Z] + ltac:(reflexivity) with "Hs") as "Hs". + iFrame "Hs". + go. + rewrite o_sub_sub in H. + simpl in H. + contradiction. + Qed. + + cpp.spec "test_memchr_embedded_null()" default. + Lemma test_memchr_embedded_null_ok : + verify[module] "test_memchr_embedded_null()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (s_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 0%Z; 98%Z; 0%Z]) as "Hs". + iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 0%Z; 98%Z; 0%Z] ltac:(reflexivity) with "Hs") as "Hs". + iExists Tuchar, (cQp.mk false 1), [97%Z; 0%Z; 98%Z; 0%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit. + + done. + + iIntros "Hs". + rewrite (memchr_found_after_prefix [97%Z] 0%Z [98%Z; 0%Z] 0%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 0%Z] [98%Z; 0%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + as "[Hhead Hs]". + iExists Tuchar, (cQp.mk false 1), [98%Z; 0%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [98%Z] 0%Z (@nil Z) 0%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + rewrite o_sub_sub. + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 0%Z] [98%Z; 0%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Hs]") + as "Hs". + iExists Tuchar, (cQp.mk false 1), [97%Z; 0%Z; 98%Z; 0%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [97%Z; 0%Z] 98%Z [0%Z] 98%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 0%Z; 98%Z; 0%Z] + ltac:(reflexivity) with "Hs") as "Hs". + iFrame "Hs". + go. + rewrite o_sub_sub in H. + simpl in H. + contradiction. + Qed. + + cpp.spec "test_memcpy()" default. + Lemma test_memcpy_ok : verify[module] "test_memcpy()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (src_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hsrc". + iDestruct select (dst_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [119%Z; 120%Z; 121%Z; 122%Z]) as "Hdst". + + iPoseProof (object_bytesR_of_arrayLR src_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc") as "Hsrc". + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc") + as "[Hsrc_copy Hsrc_tail]". + + iPoseProof (object_bytesR_of_arrayLR dst_addr Tuchar (cQp.mk false 1) + 4 [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst") as "Hdst". + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 3 4 [119%Z; 120%Z; 121%Z] [122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst") + as "[Hdst_copy Hdst_tail]". + + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. + iExists Tuchar. + iSplitL "Hsrc_copy"; [iExact "Hsrc_copy"|]. + iSplitL "Hdst_copy". + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 3%N + [119%Z; 120%Z; 121%Z] ltac:(reflexivity) with "Hdst_copy"). + - iSplit; [done|]. + iIntros "[Hsrc_copy Hdst_copy]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_copy $Hsrc_tail]") as "Hsrc". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_copy $Hdst_tail]") as "Hdst". + + iPoseProof (object_bytesR_ucharR_arrayR with "Hdst") as "Hdst". + rewrite (at_arrayR_ucharR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z]). + iDestruct "Hdst" as "[#Hdst_ty0 [Hdst0 Hdst]]". + iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) + 98%Z [99%Z; 122%Z] with "Hdst") as "Hdst". + iDestruct "Hdst" as "[#Hdst_ty1 [Hdst1 Hdst]]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) + 99%Z [122%Z] with "Hdst") as "Hdst". + iDestruct "Hdst" as "[#Hdst_ty2 [Hdst2 Hdst]]". + iEval (rewrite o_sub_sub) in "Hdst2". + iEval (rewrite o_sub_sub) in "Hdst". + Arith.arith_simpl. + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "Hdst2". iIntros "Hdst2". + go. + + iPoseProof (at_arrayR_ucharR_cons + (dst_addr .[Tuchar ! 1] .[Tuchar ! 2]) + 122%Z [] with "Hdst") as "Hdst". + iDestruct "Hdst" as "[#Hdst_ty3 [Hdst3 Hdst]]". + iEval (rewrite o_sub_sub) in "Hdst". + Arith.arith_simpl. + iPoseProof (at_uchar_offset_add_elim dst_addr 1 2 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iExists (Vint 122%Z), (cQp.mk false 1%Qp). + iFrame "Hdst3". iIntros "Hdst3". + go. + + iPoseProof (object_bytesR_ucharR_arrayR with "Hsrc") as "Hsrc". + rewrite (at_arrayR_ucharR_cons src_addr 97%Z + [98%Z; 99%Z; 100%Z]). + iDestruct "Hsrc" as "[#Hsrc_ty0 [Hsrc0 Hsrc]]". + iPoseProof (at_zero_intro src_addr with "Hsrc0") as "Hsrc0". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc0". iIntros "Hsrc0". + go. + + iPoseProof (at_arrayR_ucharR_cons (src_addr .[Tuchar ! 1]) + 98%Z [99%Z; 100%Z] with "Hsrc") as "Hsrc". + iDestruct "Hsrc" as "[#Hsrc_ty1 [Hsrc1 Hsrc]]". + iPoseProof (at_arrayR_ucharR_cons + (src_addr .[Tuchar ! 1] .[Tuchar ! 1]) + 99%Z [100%Z] with "Hsrc") as "Hsrc". + iDestruct "Hsrc" as "[#Hsrc_ty2 [Hsrc2 Hsrc]]". + iPoseProof (at_arrayR_ucharR_cons + (src_addr .[Tuchar ! 1] .[Tuchar ! 1] .[Tuchar ! 1]) + 100%Z [] with "Hsrc") as "Hsrc". + iDestruct "Hsrc" as "[#Hsrc_ty3 [Hsrc3 Hsrc]]". + iEval (rewrite o_sub_sub) in "Hsrc2". + iEval (rewrite o_sub_sub) in "Hsrc3". + iEval (rewrite o_sub_sub) in "Hsrc". + Arith.arith_simpl. + iPoseProof (at_uchar_offset_add_elim src_addr 1 2 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc3". iIntros "Hsrc3". + go. + + iPoseProof (at_zero_elim src_addr with "Hsrc0") as "Hsrc0". + iPoseProof (uchar_cells_object_bytesR_two src_addr 97%Z 98%Z + with "[$Hsrc0 $Hsrc1]") as "Hsrc_head". + iPoseProof (at_uchar_offset_add_intro src_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". + iPoseProof (uchar_cells_object_bytesR_two (src_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hsrc2 $Hsrc3]") as "Hsrc_tail2". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_head $Hsrc_tail2]") as "Hsrc_full". + + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc_full") + as "[Hsrc_prefix Hsrc_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". + + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") + as "[Hdst_head1 Hdst_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hdst_suffix") as "[Hdst_empty Hdst_suffix]". + + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar. + iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. + iSplitL "Hdst_empty". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 0%N + [] ltac:(reflexivity) with "Hdst_empty"). + + iSplit; [done|]. + iIntros "[Hsrc_empty Hdst_empty]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_prefix $Hsrc_suffix]") as "Hsrc_full". + + iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_empty $Hdst_suffix]") as "Hdst_suffix". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". + + iPoseProof (object_bytesR_ucharR_arrayR with "Hdst_full") as "Hdst_arr". + rewrite (at_arrayR_ucharR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z]). + iDestruct "Hdst_arr" as "[#Hdst_ty4 [Hdst0 Hdst_arr]]". + iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) + 98%Z [99%Z; 122%Z] with "Hdst_arr") as "Hdst_arr". + iDestruct "Hdst_arr" as "[#Hdst_ty5 [Hdst1 Hdst_arr]]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") as "Hsrc_any". + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iEval (rewrite (at_arrayR_ucharR_cons + (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) 99%Z [122%Z])) + in "Hdst_arr". + iDestruct "Hdst_arr" as "[#Hdst_ty6 [Hdst2 Hdst_arr]]". + iPoseProof (at_arrayR_ucharR_cons + (dst_addr .[Tuchar ! 1] .[Tuchar ! 1] .[Tuchar ! 1]) + 122%Z [] with "Hdst_arr") as "Hdst_arr". + iDestruct "Hdst_arr" as "[#Hdst_ty7 [Hdst3 Hdst_arr]]". + iEval (rewrite o_sub_sub) in "Hdst2". + iEval (rewrite o_sub_sub) in "Hdst3". + iEval (rewrite o_sub_sub) in "Hdst3". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 98%Z; 99%Z; 122%Z] ltac:(reflexivity) with "Hdst_full") as "Hdst_any". + iFrame "Hsrc_any Hdst_any". + go. + Qed. + + cpp.spec "test_memmove()" default. + Lemma test_memmove_ok : verify[module] "test_memmove()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (src_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hsrc". + iDestruct select (dst_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [119%Z; 120%Z; 121%Z; 122%Z]) as "Hdst". + + iPoseProof (object_bytesR_of_arrayLR src_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc") as "Hsrc". + iPoseProof (object_bytesR_of_arrayLR dst_addr Tuchar (cQp.mk false 1) + 4 [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst") as "Hdst". + + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 100%Z]. + iExists Tuchar. + iSplitL "Hsrc"; [iExact "Hsrc"|]. + iSplitL "Hdst". + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 4%N + [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst"). + - iSplit; [done|]. + iIntros "[Hsrc Hdst]". + Arith.arith_simpl. + go. + + iPoseProof (object_bytesR_ucharR_arrayR with "Hdst") as "Hdst_arr". + rewrite (at_arrayR_ucharR_cons dst_addr 97%Z + [98%Z; 99%Z; 100%Z]). + iDestruct "Hdst_arr" as "[#Hdst_ty0 [Hdst0 Hdst_arr]]". + iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) + 98%Z [99%Z; 100%Z] with "Hdst_arr") as "Hdst_arr". + iDestruct "Hdst_arr" as "[#Hdst_ty1 [Hdst1 Hdst_arr]]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (at_arrayR_ucharR_cons + (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) + 99%Z [100%Z] with "Hdst_arr") as "Hdst_arr". + iDestruct "Hdst_arr" as "[#Hdst_ty2 [Hdst2 Hdst_arr]]". + iEval (rewrite o_sub_sub) in "Hdst2". + iEval (rewrite o_sub_sub) in "Hdst_arr". + Arith.arith_simpl. + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "Hdst2". iIntros "Hdst2". + go. + + iPoseProof (at_arrayR_ucharR_cons + (dst_addr .[Tuchar ! 1] .[Tuchar ! 2]) + 100%Z [] with "Hdst_arr") as "Hdst_arr". + iDestruct "Hdst_arr" as "[#Hdst_ty3 [Hdst3 Hdst_arr]]". + iEval (rewrite o_sub_sub) in "Hdst_arr". + Arith.arith_simpl. + iPoseProof (at_uchar_offset_add_elim dst_addr 1 2 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "Hdst3". iIntros "Hdst3". + go. + + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc") + as "[Hsrc_head1 Hsrc_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". + + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") + as "[Hdst_head1 Hdst_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hdst_suffix") as "[Hdst_empty Hdst_suffix]". + + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar. + iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. + iSplitL "Hdst_empty". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 0%N + [] ltac:(reflexivity) with "Hdst_empty"). + + iSplit; [done|]. + iIntros "[Hsrc_empty Hdst_empty]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_head1 $Hsrc_suffix]") as "Hsrc_full". + + iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_empty $Hdst_suffix]") as "Hdst_suffix". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". + + iPoseProof (object_bytesR_ucharR_arrayR with "Hdst_full") as "Hdst_arr2". + rewrite (at_arrayR_ucharR_cons dst_addr 97%Z + [98%Z; 99%Z; 100%Z]). + iDestruct "Hdst_arr2" as "[#Hdst_ty4 [Hdst0 Hdst_arr2]]". + iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". + iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) + 98%Z [99%Z; 100%Z] with "Hdst_arr2") as "Hdst_arr2". + iDestruct "Hdst_arr2" as "[#Hdst_ty5 [Hdst1 Hdst_arr2]]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") + as "Hsrc_any". + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iEval (rewrite (at_arrayR_ucharR_cons + (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) 99%Z [100%Z])) + in "Hdst_arr2". + iDestruct "Hdst_arr2" as "[#Hdst_ty6 [Hdst2 Hdst_arr3]]". + iPoseProof (at_arrayR_ucharR_cons + (dst_addr .[Tuchar ! 1] .[Tuchar ! 1] .[Tuchar ! 1]) + 100%Z [] with "Hdst_arr3") as "Hdst_arr3". + iDestruct "Hdst_arr3" as "[#Hdst_ty7 [Hdst3 Hdst_arr3]]". + iEval (rewrite o_sub_sub) in "Hdst2". + iEval (rewrite o_sub_sub) in "Hdst3". + iEval (rewrite o_sub_sub) in "Hdst3". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hdst_full") + as "Hdst_any". + iFrame "Hsrc_any Hdst_any". + go. + Qed. + + cpp.spec "test_memcmp()" default. + Lemma test_memcmp_ok : verify[module] "test_memcmp()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (abc_addr |-> arrayLR Tuchar 0 3 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z]) as "Habc". + iDestruct select (abd_addr |-> arrayLR Tuchar 0 3 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 100%Z]) as "Habd". + iDestruct select (ab_addr |-> arrayLR Tuchar 0 2 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z]) as "Hab". + + iPoseProof (object_bytesR_of_arrayLR abc_addr Tuchar (cQp.mk false 1) + 3 [97%Z; 98%Z; 99%Z] ltac:(reflexivity) with "Habc") as "Habc". + iPoseProof (object_bytesR_half_split with "Habc") as + "[Habc_left Habc_right]". + iExists Tuchar, (cQp.mk false (1/2)), [97%Z; 98%Z; 99%Z]. + iExists Tuchar, (cQp.mk false (1/2)), [97%Z; 98%Z; 99%Z]. + iSplitL "Habc_left"; [iExact "Habc_left"|]. + iSplitL "Habc_right"; [iExact "Habc_right"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc_left Habc_right]". + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_half_split abc_addr Tuchar + [97%Z; 98%Z; 99%Z]) with "[$Habc_left $Habc_right]") as "Habc". + + iPoseProof (object_bytesR_of_arrayLR abd_addr Tuchar (cQp.mk false 1) + 3 [97%Z; 98%Z; 100%Z] ltac:(reflexivity) with "Habd") as "Habd". + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 100%Z]. + iSplitL "Habc"; [iExact "Habc"|]. + iSplitL "Habd"; [iExact "Habd"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc Habd]". + Arith.arith_simpl. + go. + + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 100%Z]. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. + iSplitL "Habd"; [iExact "Habd"|]. + iSplitL "Habc"; [iExact "Habc"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habd Habc]". + Arith.arith_simpl. + go. + + iPoseProof (object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habc") + as "[Habc_prefix Habc_tail]". + iPoseProof (object_bytesR_prefix_tail0 abd_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habd") + as "[Habd_prefix Habd_tail]". + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z]. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z]. + iSplitL "Habc_prefix"; [iExact "Habc_prefix"|]. + iSplitL "Habd_prefix"; [iExact "Habd_prefix"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc_prefix Habd_prefix]". + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Habc_prefix $Habc_tail]") as "Habc". + iPoseProof ((object_bytesR_prefix_tail0 abd_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Habd_prefix $Habd_tail]") as "Habd". + + iPoseProof (object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 0 3 [] [97%Z; 98%Z; 99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habc") + as "[Habc_empty Habc]". + iPoseProof (object_bytesR_of_arrayLR ab_addr Tuchar (cQp.mk false 1) + 2 [97%Z; 98%Z] ltac:(reflexivity) with "Hab") as "Hab". + iPoseProof (object_bytesR_prefix_tail0 ab_addr Tuchar + (cQp.mk false 1) 0 2 [] [97%Z; 98%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hab") + as "[Hab_empty Hab]". + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar, (cQp.mk false 1), []. + iSplitL "Habc_empty"; [iExact "Habc_empty"|]. + iSplitL "Hab_empty"; [iExact "Hab_empty"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc_empty Hab_empty]". + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 0 3 [] [97%Z; 98%Z; 99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Habc_empty $Habc]") as "Habc". + iPoseProof ((object_bytesR_prefix_tail0 ab_addr Tuchar + (cQp.mk false 1) 0 2 [] [97%Z; 98%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hab_empty $Hab]") as "Hab". + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 3%N + [97%Z; 98%Z; 99%Z] ltac:(reflexivity) with "Habc") as "Habc". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 3%N + [97%Z; 98%Z; 100%Z] ltac:(reflexivity) with "Habd") as "Habd". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 2%N + [97%Z; 98%Z] ltac:(reflexivity) with "Hab") as "Hab". + iFrame "Habc Habd Hab". + go. + Qed. + + cpp.spec "test_memcmp_embedded_null()" default. + + cpp.spec "test_memset_embedded_null()" default. + + cpp.spec "test_memcpy_embedded_null()" default. + + cpp.spec "test_memmove_overlap()" default. + + cpp.spec "test_memmove_embedded_null()" default. + + cpp.spec "test_cstring_slice4()" default. End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/test.cpp b/rocq-brick-libstdcpp/test/cstring/test.cpp index 54e2246..ab855c4 100644 --- a/rocq-brick-libstdcpp/test/cstring/test.cpp +++ b/rocq-brick-libstdcpp/test/cstring/test.cpp @@ -130,8 +130,153 @@ void test_search_embedded_null_array_buffer() { assert(std::strstr(s, "") == s); } +void test_memchr() { + unsigned char s[] = {'a', 'b', 'c', 'a'}; + assert(std::memchr(s, 'a', 4) == s); + assert(std::memchr(s, 'c', 4) == s + 2); + assert(std::memchr(s, 'z', 4) == nullptr); + assert(std::memchr(s, 'a', 0) == nullptr); + assert(std::memchr(s + 1, 'a', 3) == s + 3); +} + +void test_memchr_embedded_null() { + unsigned char s[] = {'a', '\0', 'b', '\0'}; + assert(std::memchr(s, '\0', 4) == s + 1); + assert(std::memchr(s + 2, '\0', 2) == s + 3); + assert(std::memchr(s, 'b', 4) == s + 2); +} + +void test_memcmp() { + unsigned char abc[] = {'a', 'b', 'c'}; + unsigned char abd[] = {'a', 'b', 'd'}; + unsigned char ab[] = {'a', 'b'}; + + assert(std::memcmp(abc, abc, 3) == 0); + assert(std::memcmp(abc, abd, 3) < 0); + assert(std::memcmp(abd, abc, 3) > 0); + assert(std::memcmp(abc, abd, 2) == 0); + assert(std::memcmp(abc, ab, 0) == 0); +} + +void test_memcmp_embedded_null() { + unsigned char x[] = {'a', '\0', 'x'}; + unsigned char y[] = {'a', '\0', 'y'}; + + assert(std::memcmp(x, y, 2) == 0); + assert(std::memcmp(x, y, 3) < 0); + assert(std::memcmp(y, x, 3) > 0); +} + +void test_memset() { + unsigned char s[] = {'a', 'b', 'c', 'd'}; + + assert(std::memset(s, 'x', 2) == s); + assert(s[0] == 'x'); + assert(s[1] == 'x'); + assert(s[2] == 'c'); + assert(s[3] == 'd'); + + assert(std::memset(s + 2, 0x123, 1) == s + 2); + assert(s[2] == static_cast(0x123)); + assert(s[3] == 'd'); +} + +void test_memset_embedded_null() { + unsigned char s[] = {'a', 'b', 'c', 'd'}; + + assert(std::memset(s + 1, '\0', 2) == s + 1); + assert(s[0] == 'a'); + assert(s[1] == '\0'); + assert(s[2] == '\0'); + assert(s[3] == 'd'); +} + +void test_memcpy() { + unsigned char src[] = {'a', 'b', 'c', 'd'}; + unsigned char dst[] = {'w', 'x', 'y', 'z'}; + + assert(std::memcpy(dst, src, 3) == dst); + assert(dst[0] == 'a'); + assert(dst[1] == 'b'); + assert(dst[2] == 'c'); + assert(dst[3] == 'z'); + assert(src[0] == 'a'); + assert(src[3] == 'd'); + + assert(std::memcpy(dst + 1, src + 2, 0) == dst + 1); + assert(dst[0] == 'a'); + assert(dst[1] == 'b'); +} + +void test_memcpy_embedded_null() { + unsigned char src[] = {'a', '\0', 'b', '\0'}; + unsigned char dst[] = {'w', 'x', 'y', 'z'}; + + assert(std::memcpy(dst, src, 4) == dst); + assert(dst[0] == 'a'); + assert(dst[1] == '\0'); + assert(dst[2] == 'b'); + assert(dst[3] == '\0'); +} + +void test_memmove() { + unsigned char src[] = {'a', 'b', 'c', 'd'}; + unsigned char dst[] = {'w', 'x', 'y', 'z'}; + + assert(std::memmove(dst, src, 4) == dst); + assert(dst[0] == 'a'); + assert(dst[1] == 'b'); + assert(dst[2] == 'c'); + assert(dst[3] == 'd'); + + assert(std::memmove(dst + 1, src + 1, 0) == dst + 1); + assert(dst[1] == 'b'); +} + +void test_memmove_overlap() { + char forward[] = {'a', 'b', 'c', 'd', 'e', 'f', '\0'}; + char backward[] = {'a', 'b', 'c', 'd', 'e', 'f', '\0'}; + + assert(std::memmove(forward + 2, forward, 4) == forward + 2); + assert(forward[0] == 'a'); + assert(forward[1] == 'b'); + assert(forward[2] == 'a'); + assert(forward[3] == 'b'); + assert(forward[4] == 'c'); + assert(forward[5] == 'd'); + assert(forward[6] == '\0'); + + assert(std::memmove(backward, backward + 2, 4) == backward); + assert(backward[0] == 'c'); + assert(backward[1] == 'd'); + assert(backward[2] == 'e'); + assert(backward[3] == 'f'); + assert(backward[4] == 'e'); + assert(backward[5] == 'f'); + assert(backward[6] == '\0'); +} + +void test_memmove_embedded_null() { + char s[] = {'a', '\0', 'b', 'c', '\0'}; + + assert(std::memmove(s + 1, s, 4) == s + 1); + assert(s[0] == 'a'); + assert(s[1] == 'a'); + assert(s[2] == '\0'); + assert(s[3] == 'b'); + assert(s[4] == 'c'); +} + void test_cstring_slice1() { test_strlen(); test_strcmp(); test_strncmp(); } + +void test_cstring_slice4() { + test_memchr(); + test_memcmp(); + test_memset(); + test_memcpy(); + test_memmove(); +} From 87a6dff5d8a16eb9002dcee230ef773b6480a160 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Thu, 23 Apr 2026 15:39:43 -0400 Subject: [PATCH 05/11] Added comments about candidate predicates for object_bytesR --- rocq-brick-libstdcpp/proof/cstring/DESIGN.md | 78 ++++-- rocq-brick-libstdcpp/test/cstring/proof.v | 271 ++++++++----------- 2 files changed, 173 insertions(+), 176 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md index 254f4c8..3052614 100644 --- a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md +++ b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md @@ -48,10 +48,12 @@ rather than about the semantic contract of read-only cstring functions. ### `arrayR` and `arrayLR` For hand-written buffer specs and reusable buffer predicates, prefer `arrayLR` -over one-sided `arrayR` or `arrayL` when the surrounding interface leaves us -that choice. The two-sided predicate tends to preserve the right amount of -information for clients that both inspect and later rebuild or mutate a -buffer. +over `arrayR` when the surrounding interface leaves us that choice. The +meaning of the letters in these names is framework-specific and should be +documented explicitly elsewhere; what matters here is that `arrayLR` is the +more informative array view for our present clients. The two-sided predicate +tends to preserve the right amount of information for clients that both inspect +and later rebuild or mutate a buffer. In proofs, however, we must follow the proof state we actually get. With the current proof imports, `verify_spec; go` often exposes stack arrays as @@ -70,25 +72,55 @@ null bytes are ordinary bytes, and the `n` argument determines the whole relevant range. For this slice, use counted object-byte views rather than `cstring.R`. The -public specs use abstract predicates `object_bytesR byte_ty q bytes` and -`object_bytes_anyR byte_ty n`, where `bytes` is the list of unsigned-byte -values observed by the memory operation and `byte_ty` records the one-byte -pointer-stepping type used for returned interior pointers. This is closer to -the textual C++ specification than requiring an actual `unsigned char[]` -object: the standard memory APIs take `void*`/`const void*` and operate on the -object representation as bytes. +current public specs use abstract predicates `object_bytesR byte_ty q bytes` +and `object_bytes_anyR byte_ty n`, where `bytes` is the list of unsigned-byte +values observed by the memory operation. + +Recent inspection of the framework predicates clarified three important +alternatives: + +- `cstring.bufR q sz s` is just `zstring.bufR char_type.Cchar q sz + (cstring.to_zstring s)`; +- `zstring.bufR` is a string-buffer predicate: it stores a logical string + payload, requires `zstring.WF`, and also describes a zero-filled tail up to + the buffer size `sz`; +- `bytesR q xs` is the plain counted-byte predicate + `arrayR "unsigned char" (fun c => ucharR q c) xs`. + +This means `cstring.bufR` and `zstring.bufR` are not suitable definitions of +`object_bytesR`: they are intentionally more structured than the memory +functions require. They model string buffers, not arbitrary object +representations. In contrast, `bytesR` is a much better semantic fit for the +memory-family functions because it represents exactly a counted sequence of +bytes, with no terminator or string well-formedness obligations. + +The remaining design question is whether to expose `bytesR` directly in the +specs or to keep a local wrapper such as `object_bytesR`. At the moment the +development still uses the abstract wrapper, but `bytesR` is now the leading +candidate for the eventual underlying definition. If we keep `object_bytesR`, +it should be viewed as an abstraction boundary over a counted-byte predicate, +not as a string-like buffer predicate. + +The earlier `byte_ty : type` parameter was introduced as proof-level metadata +for writing interior pointers such as `p.[byte_ty ! i]` in results like +`memchr`. After inspecting the framework predicates, this now looks more like +bookkeeping than semantic content. Since `bytesR` is already fixed to +`"unsigned char"`, a future cleanup may well remove `byte_ty` and standardize +these specs on `Tuchar`-based offsets instead. If `object_bytesR` survives as +an abstraction layer, this proof-level role of `byte_ty` should be documented +near the definition in `pred.v` or `model.v`. The previous exact-length `arrayLR Tuchar` specs are preserved in a commented region in `spec.v`. They were useful for bootstrapping the first byte-array proofs but are too narrow as reusable library specs. -`object_bytesR` and `object_bytes_anyR` are parameters rather than definitions. -The concrete meaning of object representation bytes is a framework-level -concept, not just an `unsigned char[]` array. Existing unsigned-char litmus -proofs therefore rely on explicit bridge laws between concrete arrays and the -abstract object-byte predicates. Future work should replace these local bridge -axioms with framework-provided object-representation facts for concrete -`char[]`, `unsigned char[]`, and other trivially copyable objects as needed. +`object_bytesR` and `object_bytes_anyR` are currently parameters rather than +definitions. Existing unsigned-char litmus proofs therefore rely on explicit +bridge laws between concrete arrays and the abstract object-byte predicates. +Future work should either define these wrappers in terms of framework-provided +byte predicates such as `bytesR`, or replace the local bridge axioms with +framework-provided object-representation facts for concrete `char[]`, +`unsigned char[]`, and other trivially copyable objects as needed. Embedded-null and embedded-zero litmus tests remain useful regression cases. At present: @@ -144,6 +176,16 @@ active designs based on `cstring.R` and `object_bytesR`. - Decide whether to keep the archived files as a long-lived comparison surface or retire them once the active development fully subsumes their distinctive coverage. +- Add a short framework-level documentation note somewhere under `docs/` + explaining the intended meaning and use cases of predicates such as `arrayR` + and `arrayLR`, since the names are not self-explanatory and easy to + misdescribe from surface intuition. +- Decide whether the counted-byte specs should switch from the current + `object_bytesR` wrapper to the existing framework predicate `bytesR`, or + whether `object_bytesR` should remain as a documented wrapper around it. +- If `object_bytesR` remains, document the exact role of its current + `byte_ty : type` parameter near the definition and keep that explanation in + sync with these design notes. - Investigate whether fractional automation should be derivable automatically for abstract object-byte predicates. The current parameterized predicates expose fractional behavior axiomatically; the manual split/recombine pattern diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index 3b0252e..a8fd5ca 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -11,6 +11,7 @@ Require Import skylabs.cpp.array. Import expr_join. #[local] Hint Resolve delayed_case.smash_delayed_case_B | 1000 : br_hints. #[local] Hint Resolve delayed_case.expr_join.smash_delayed_case_B | 1000 : br_hints. + (** END: SKYLABS DEFAULT PROOF IMPORTS *) Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.cstring.spec. @@ -486,12 +487,33 @@ Proof. unfold lengthZ, lengthN, replicateN. rewrite length_replicate N2Nat.id. lia. - - + - rewrite _at_offsetR _at_sub_0; [|done]. rewrite -(N2Nat.id n) Hlen. iApply (arrayR_ucharR_arrayR_anyR with "Hs"). Qed. +#[local] Lemma object_bytesR_arrayLR_cons `{Σ : cpp_logic, σ : genv} + (p : ptr) x xs : + p |-> object_bytesR Tuchar 1$m (x :: xs) ⊣⊢ + (type_ptr Tuchar (p .[Tuchar ! 0]) ∗ p .[Tuchar ! 0] |-> ucharR 1$m x) ∗ + p |-> arrayLR Tuchar 1 (lengthZ (x :: xs)) (fun b : Z => ucharR 1$m b) xs. +Proof. + iSplit. + - iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) + (x :: xs) eq_refl with "Hs") as "Hs". + iEval (rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) + (fun b : Z => ucharR 1$m b) x xs)) in "Hs". + iExact "Hs". + - iIntros "[[#Hty Hx] Hs]". + iApply (object_bytesR_of_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) + (x :: xs) eq_refl). + rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) + (fun b : Z => ucharR 1$m b) x xs). + iFrame "# ∗". +Qed. + #[local] Lemma uchar_cells_object_bytesR_two `{Σ : cpp_logic, σ : genv} (p : ptr) a b : p |-> ucharR 1$m a ∗ @@ -800,37 +822,26 @@ Section with_cpp. (cQp.mk false 1) 2 4 [120%Z; 120%Z] [99%Z; 100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Htarget $Htail]") as "Hs". - iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". - rewrite (at_arrayR_ucharR_cons s_addr 120%Z - [120%Z; 99%Z; 100%Z]). - iDestruct "Hs" as "[#Hty0 [H0 Hs]]". - iPoseProof (at_zero_intro s_addr with "H0") as "H0". + iPoseProof (object_bytesR_arrayLR_cons s_addr 120%Z + [120%Z; 99%Z; 100%Z] with "Hs") as "[[#Hty0 H0] Hs]". iExists (Vint 120%Z), (cQp.mk false 1%Qp). iFrame "H0". iIntros "H0". go. - iPoseProof (at_arrayR_ucharR_cons (s_addr .[Tuchar ! 1]) - 120%Z [99%Z; 100%Z] with "Hs") as "Hs". - iDestruct "Hs" as "[#Hty1 [H1 Hs]]". + iEval (rewrite (arrayLR_cons s_addr 1 4 (fun b : Z => ucharR 1$m b) + 120%Z [99%Z; 100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty1 H1] Hs]". iExists (Vint 120%Z), (cQp.mk false 1%Qp). iFrame "H1". iIntros "H1". go. - iPoseProof (at_arrayR_ucharR_cons - (s_addr .[Tuchar ! 1] .[Tuchar ! 1]) - 99%Z [100%Z] with "Hs") as "Hs". - iDestruct "Hs" as "[#Hty2 [H2 Hs]]". - iEval (rewrite o_sub_sub) in "H2". - iEval (rewrite o_sub_sub) in "Hs". - Arith.arith_simpl. + iEval (rewrite (arrayLR_cons s_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty2 H2] Hs]". iExists (Vint 99%Z), (cQp.mk false 1%Qp). iFrame "H2". iIntros "H2". go. - iPoseProof (at_arrayR_ucharR_cons - (s_addr .[Tuchar ! 1] .[Tuchar ! 2]) - 100%Z [] with "Hs") as "Hs". - iDestruct "Hs" as "[#Hty3 [H3 Hs]]". - iEval (rewrite o_sub_sub) in "H3". - iEval (rewrite o_sub_sub) in "Hs". - Arith.arith_simpl. + iEval (rewrite (arrayLR_cons s_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hs". + iDestruct "Hs" as "[[#Hty3 H3] Hs]". iExists (Vint 100%Z), (cQp.mk false 1%Qp). iFrame "H3". iIntros "H3". go. @@ -863,35 +874,25 @@ Section with_cpp. (cQp.mk false 1) 2 4 [120%Z; 120%Z] [35%Z; 100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hhead $Htail]") as "Hs". - iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". go. - rewrite (at_arrayR_ucharR_cons s_addr 120%Z - [120%Z; 35%Z; 100%Z]). - iDestruct "Hs" as "[#Hty0' [H0 Hs]]". - iPoseProof (at_zero_intro s_addr with "H0") as "H0_assert". - iPoseProof (at_arrayR_ucharR_cons (s_addr .[Tuchar ! 1]) - 120%Z [35%Z; 100%Z] with "Hs") as "Hs". - iDestruct "Hs" as "[#Hty1' [H1 Hs]]". - iPoseProof (at_arrayR_ucharR_cons - (s_addr .[Tuchar ! 1] .[Tuchar ! 1]) - 35%Z [100%Z] with "Hs") as "Hs". - iDestruct "Hs" as "[#Hty2' [H2 Hs]]". - iEval (rewrite o_sub_sub) in "H2". - iEval (rewrite o_sub_sub) in "Hs". - Arith.arith_simpl. + iPoseProof (object_bytesR_arrayLR_cons s_addr 120%Z + [120%Z; 35%Z; 100%Z] with "Hs") as "[[#Hty0' H0] Hs]". + iEval (rewrite (arrayLR_cons s_addr 1 4 (fun b : Z => ucharR 1$m b) + 120%Z [35%Z; 100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty1' H1] Hs]". + iEval (rewrite (arrayLR_cons s_addr 2 4 (fun b : Z => ucharR 1$m b) + 35%Z [100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty2' H2] Hs]". iExists (Vint 35%Z), (cQp.mk false 1%Qp). iFrame "H2". iIntros "H2". go. - iPoseProof (at_arrayR_ucharR_cons - (s_addr .[Tuchar ! 1] .[Tuchar ! 2]) - 100%Z [] with "Hs") as "Hs". - iDestruct "Hs" as "[#Hty3' [H3 Hempty2]]". - iEval (rewrite o_sub_sub) in "H3". - Arith.arith_simpl. + iEval (rewrite (arrayLR_cons s_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hs". + iDestruct "Hs" as "[[#Hty3' H3] Hempty2]". iExists (Vint 100%Z), (cQp.mk false 1%Qp). iFrame "H3". iIntros "H3". go. - iPoseProof (at_zero_elim s_addr with "H0_assert") as "H0". + iPoseProof (at_zero_elim s_addr with "H0") as "H0". iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z with "[$H0 $H1]") as "Hhead". iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 @@ -1069,70 +1070,49 @@ Section with_cpp. ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hdst_copy $Hdst_tail]") as "Hdst". - iPoseProof (object_bytesR_ucharR_arrayR with "Hdst") as "Hdst". - rewrite (at_arrayR_ucharR_cons dst_addr 97%Z - [98%Z; 99%Z; 122%Z]). - iDestruct "Hdst" as "[#Hdst_ty0 [Hdst0 Hdst]]". - iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst]". iExists (Vint 97%Z), (cQp.mk false 1%Qp). iFrame "Hdst0". iIntros "Hdst0". go. - iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) - 98%Z [99%Z; 122%Z] with "Hdst") as "Hdst". - iDestruct "Hdst" as "[#Hdst_ty1 [Hdst1 Hdst]]". + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty1 Hdst1] Hdst]". iExists (Vint 98%Z), (cQp.mk false 1%Qp). iFrame "Hdst1". iIntros "Hdst1". go. - iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) - 99%Z [122%Z] with "Hdst") as "Hdst". - iDestruct "Hdst" as "[#Hdst_ty2 [Hdst2 Hdst]]". - iEval (rewrite o_sub_sub) in "Hdst2". - iEval (rewrite o_sub_sub) in "Hdst". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty2 Hdst2] Hdst]". Arith.arith_simpl. iExists (Vint 99%Z), (cQp.mk false 1%Qp). iFrame "Hdst2". iIntros "Hdst2". go. - iPoseProof (at_arrayR_ucharR_cons - (dst_addr .[Tuchar ! 1] .[Tuchar ! 2]) - 122%Z [] with "Hdst") as "Hdst". - iDestruct "Hdst" as "[#Hdst_ty3 [Hdst3 Hdst]]". - iEval (rewrite o_sub_sub) in "Hdst". - Arith.arith_simpl. - iPoseProof (at_uchar_offset_add_elim dst_addr 1 2 3 - (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty3 Hdst3] Hdst_empty]". iExists (Vint 122%Z), (cQp.mk false 1%Qp). iFrame "Hdst3". iIntros "Hdst3". go. - iPoseProof (object_bytesR_ucharR_arrayR with "Hsrc") as "Hsrc". - rewrite (at_arrayR_ucharR_cons src_addr 97%Z - [98%Z; 99%Z; 100%Z]). - iDestruct "Hsrc" as "[#Hsrc_ty0 [Hsrc0 Hsrc]]". - iPoseProof (at_zero_intro src_addr with "Hsrc0") as "Hsrc0". + iPoseProof (object_bytesR_arrayLR_cons src_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hsrc") as "[[#Hsrc_ty0 Hsrc0] Hsrc]". iExists (Vint 97%Z), (cQp.mk false 1%Qp). iFrame "Hsrc0". iIntros "Hsrc0". go. - iPoseProof (at_arrayR_ucharR_cons (src_addr .[Tuchar ! 1]) - 98%Z [99%Z; 100%Z] with "Hsrc") as "Hsrc". - iDestruct "Hsrc" as "[#Hsrc_ty1 [Hsrc1 Hsrc]]". - iPoseProof (at_arrayR_ucharR_cons - (src_addr .[Tuchar ! 1] .[Tuchar ! 1]) - 99%Z [100%Z] with "Hsrc") as "Hsrc". - iDestruct "Hsrc" as "[#Hsrc_ty2 [Hsrc2 Hsrc]]". - iPoseProof (at_arrayR_ucharR_cons - (src_addr .[Tuchar ! 1] .[Tuchar ! 1] .[Tuchar ! 1]) - 100%Z [] with "Hsrc") as "Hsrc". - iDestruct "Hsrc" as "[#Hsrc_ty3 [Hsrc3 Hsrc]]". - iEval (rewrite o_sub_sub) in "Hsrc2". - iEval (rewrite o_sub_sub) in "Hsrc3". - iEval (rewrite o_sub_sub) in "Hsrc". - Arith.arith_simpl. - iPoseProof (at_uchar_offset_add_elim src_addr 1 2 3 - (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". + iEval (rewrite (arrayLR_cons src_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty1 Hsrc1] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty2 Hsrc2] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty3 Hsrc3] Hsrc_empty2]". iExists (Vint 100%Z), (cQp.mk false 1%Qp). iFrame "Hsrc3". iIntros "Hsrc3". go. @@ -1177,16 +1157,16 @@ Section with_cpp. iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hdst_suffix") as "[Hdst_empty Hdst_suffix]". + with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". iExists Tuchar, (cQp.mk false 1), []. iExists Tuchar. iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. - iSplitL "Hdst_empty". + iSplitL "Hdst_empty1". + iApply (object_bytesR_ucharR_object_bytes_anyR _ 0%N - [] ltac:(reflexivity) with "Hdst_empty"). + [] ltac:(reflexivity) with "Hdst_empty1"). + iSplit; [done|]. - iIntros "[Hsrc_empty Hdst_empty]". + iIntros "[Hsrc_empty Hdst_empty1]". Arith.arith_simpl. go. @@ -1202,24 +1182,22 @@ Section with_cpp. iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_empty $Hdst_suffix]") as "Hdst_suffix". + with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". - iPoseProof (object_bytesR_ucharR_arrayR with "Hdst_full") as "Hdst_arr". - rewrite (at_arrayR_ucharR_cons dst_addr 97%Z - [98%Z; 99%Z; 122%Z]). - iDestruct "Hdst_arr" as "[#Hdst_ty4 [Hdst0 Hdst_arr]]". - iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst_full") + as "[[#Hdst_ty4 Hdst0] Hdst_arr]". iExists (Vint 97%Z), (cQp.mk false 1%Qp). iFrame "Hdst0". iIntros "Hdst0". go. - iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) - 98%Z [99%Z; 122%Z] with "Hdst_arr") as "Hdst_arr". - iDestruct "Hdst_arr" as "[#Hdst_ty5 [Hdst1 Hdst_arr]]". + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty5 Hdst1] Hdst_arr]". iExists (Vint 98%Z), (cQp.mk false 1%Qp). iFrame "Hdst1". iIntros "Hdst1". go. @@ -1229,17 +1207,12 @@ Section with_cpp. iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z with "[$Hdst0 $Hdst1]") as "Hdst_head". - iEval (rewrite (at_arrayR_ucharR_cons - (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) 99%Z [122%Z])) - in "Hdst_arr". - iDestruct "Hdst_arr" as "[#Hdst_ty6 [Hdst2 Hdst_arr]]". - iPoseProof (at_arrayR_ucharR_cons - (dst_addr .[Tuchar ! 1] .[Tuchar ! 1] .[Tuchar ! 1]) - 122%Z [] with "Hdst_arr") as "Hdst_arr". - iDestruct "Hdst_arr" as "[#Hdst_ty7 [Hdst3 Hdst_arr]]". - iEval (rewrite o_sub_sub) in "Hdst2". - iEval (rewrite o_sub_sub) in "Hdst3". - iEval (rewrite o_sub_sub) in "Hdst3". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty6 Hdst2] Hdst_arr]". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) @@ -1279,41 +1252,30 @@ Section with_cpp. Arith.arith_simpl. go. - iPoseProof (object_bytesR_ucharR_arrayR with "Hdst") as "Hdst_arr". - rewrite (at_arrayR_ucharR_cons dst_addr 97%Z - [98%Z; 99%Z; 100%Z]). - iDestruct "Hdst_arr" as "[#Hdst_ty0 [Hdst0 Hdst_arr]]". - iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst_arr]". iExists (Vint 97%Z), (cQp.mk false 1%Qp). iFrame "Hdst0". iIntros "Hdst0". go. - iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) - 98%Z [99%Z; 100%Z] with "Hdst_arr") as "Hdst_arr". - iDestruct "Hdst_arr" as "[#Hdst_ty1 [Hdst1 Hdst_arr]]". + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty1 Hdst1] Hdst_arr]". iExists (Vint 98%Z), (cQp.mk false 1%Qp). iFrame "Hdst1". iIntros "Hdst1". go. - iPoseProof (at_arrayR_ucharR_cons - (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) - 99%Z [100%Z] with "Hdst_arr") as "Hdst_arr". - iDestruct "Hdst_arr" as "[#Hdst_ty2 [Hdst2 Hdst_arr]]". - iEval (rewrite o_sub_sub) in "Hdst2". - iEval (rewrite o_sub_sub) in "Hdst_arr". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty2 Hdst2] Hdst_arr]". Arith.arith_simpl. iExists (Vint 99%Z), (cQp.mk false 1%Qp). iFrame "Hdst2". iIntros "Hdst2". go. - iPoseProof (at_arrayR_ucharR_cons - (dst_addr .[Tuchar ! 1] .[Tuchar ! 2]) - 100%Z [] with "Hdst_arr") as "Hdst_arr". - iDestruct "Hdst_arr" as "[#Hdst_ty3 [Hdst3 Hdst_arr]]". - iEval (rewrite o_sub_sub) in "Hdst_arr". - Arith.arith_simpl. - iPoseProof (at_uchar_offset_add_elim dst_addr 1 2 3 - (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty3 Hdst3] Hdst_empty0]". iExists (Vint 100%Z), (cQp.mk false 1%Qp). iFrame "Hdst3". iIntros "Hdst3". go. @@ -1346,16 +1308,16 @@ Section with_cpp. iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hdst_suffix") as "[Hdst_empty Hdst_suffix]". + with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". iExists Tuchar, (cQp.mk false 1), []. iExists Tuchar. iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. - iSplitL "Hdst_empty". + iSplitL "Hdst_empty1". + iApply (object_bytesR_ucharR_object_bytes_anyR _ 0%N - [] ltac:(reflexivity) with "Hdst_empty"). + [] ltac:(reflexivity) with "Hdst_empty1"). + iSplit; [done|]. - iIntros "[Hsrc_empty Hdst_empty]". + iIntros "[Hsrc_empty Hdst_empty1]". Arith.arith_simpl. go. @@ -1371,20 +1333,18 @@ Section with_cpp. iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_empty $Hdst_suffix]") as "Hdst_suffix". + with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". - iPoseProof (object_bytesR_ucharR_arrayR with "Hdst_full") as "Hdst_arr2". - rewrite (at_arrayR_ucharR_cons dst_addr 97%Z - [98%Z; 99%Z; 100%Z]). - iDestruct "Hdst_arr2" as "[#Hdst_ty4 [Hdst0 Hdst_arr2]]". - iPoseProof (at_zero_intro dst_addr with "Hdst0") as "Hdst0". - iPoseProof (at_arrayR_ucharR_cons (dst_addr .[Tuchar ! 1]) - 98%Z [99%Z; 100%Z] with "Hdst_arr2") as "Hdst_arr2". - iDestruct "Hdst_arr2" as "[#Hdst_ty5 [Hdst1 Hdst_arr2]]". + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hdst_full") + as "[[#Hdst_ty4 Hdst0] Hdst_arr2]". + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hdst_arr2". + iDestruct "Hdst_arr2" as "[[#Hdst_ty5 Hdst1] Hdst_arr2]". iExists (Vint 98%Z), (cQp.mk false 1%Qp). iFrame "Hdst1". iIntros "Hdst1". go. @@ -1395,17 +1355,12 @@ Section with_cpp. iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z with "[$Hdst0 $Hdst1]") as "Hdst_head". - iEval (rewrite (at_arrayR_ucharR_cons - (dst_addr .[Tuchar ! 1] .[Tuchar ! 1]) 99%Z [100%Z])) - in "Hdst_arr2". - iDestruct "Hdst_arr2" as "[#Hdst_ty6 [Hdst2 Hdst_arr3]]". - iPoseProof (at_arrayR_ucharR_cons - (dst_addr .[Tuchar ! 1] .[Tuchar ! 1] .[Tuchar ! 1]) - 100%Z [] with "Hdst_arr3") as "Hdst_arr3". - iDestruct "Hdst_arr3" as "[#Hdst_ty7 [Hdst3 Hdst_arr3]]". - iEval (rewrite o_sub_sub) in "Hdst2". - iEval (rewrite o_sub_sub) in "Hdst3". - iEval (rewrite o_sub_sub) in "Hdst3". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hdst_arr2". + iDestruct "Hdst_arr2" as "[[#Hdst_ty6 Hdst2] Hdst_arr3]". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hdst_arr3". + iDestruct "Hdst_arr3" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) From 1df79136c05022893215f8e1373c00fd455d4b64 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Thu, 23 Apr 2026 16:54:18 -0400 Subject: [PATCH 06/11] Split the litmus proof file, upstreamed predicate lemmas, slightly polished the model --- rocq-brick-libstdcpp/proof/cstring/model.v | 6 - rocq-brick-libstdcpp/proof/cstring/pred.v | 527 ++++++++++++++++ rocq-brick-libstdcpp/proof/cstring/spec.v | 8 +- rocq-brick-libstdcpp/test/cstring/proof.v | 592 ------------------ .../test/cstring/proofs_embedded_null.v | 158 +++++ 5 files changed, 689 insertions(+), 602 deletions(-) create mode 100644 rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v diff --git a/rocq-brick-libstdcpp/proof/cstring/model.v b/rocq-brick-libstdcpp/proof/cstring/model.v index cb7c011..1537350 100644 --- a/rocq-brick-libstdcpp/proof/cstring/model.v +++ b/rocq-brick-libstdcpp/proof/cstring/model.v @@ -136,12 +136,6 @@ Fixpoint memcmp (bytes1 bytes2 : list Z) : Z := Definition memset (c n : Z) : list Z := replicateZ n (byte_of_int c). -Definition memcpy (bytes : list Z) : list Z := - bytes. - -Definition memmove (bytes : list Z) : list Z := - bytes. - #[local] Open Scope bs_scope. Succeed Example strcmp_equal : strcmp "abc" "abc" = 0 := eq_refl. diff --git a/rocq-brick-libstdcpp/proof/cstring/pred.v b/rocq-brick-libstdcpp/proof/cstring/pred.v index 5c84c71..adc6283 100644 --- a/rocq-brick-libstdcpp/proof/cstring/pred.v +++ b/rocq-brick-libstdcpp/proof/cstring/pred.v @@ -4,6 +4,9 @@ * See the LICENSE-BedRock file in the repository root for details. *) Require Import skylabs.auto.cpp.prelude.proof. +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.auto.cpp.hints.anyR. +Require Import skylabs.cpp.array. Require Export skylabs.cpp.string. Require Export skylabs.brick.libstdcpp.cstring.model. @@ -49,3 +52,527 @@ Axiom object_bytes_anyR_of_anyR_array : forall `{Σ : cpp_logic} {σ : genv} (p : ptr) ty n, p |-> anyR (Tarray ty n) 1$m ⊢ p |-> object_bytes_anyR ty (Z.of_N n). + +Lemma borrow_arrayR_cstringR `{Σ : cpp_logic, σ : genv} + (p : ptr) q bytes s tail : + bytes = cstring.to_zstring s ++ tail -> + cstring.WF s -> + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) + bytes ⊢ + p |-> cstring.R q s ∗ + (p |-> cstring.R q s -∗ + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) + bytes). +Proof. + intros Hbytes Hwf. + subst bytes. + rewrite (arrayR_app (fun c : N => charR q c) (Tchar_ char_type.Cchar)). + iIntros "[Hs Htail]". + iSplitL "Hs". + - rewrite /cstring.R /zstring.R. iFrame. done. + - iIntros "Hs". + rewrite /cstring.R /zstring.R. + iDestruct "Hs" as "[Hs _]". + iFrame. +Qed. + +Lemma borrow_arrayLR_cstringR `{Σ : cpp_logic, σ : genv} + (p : ptr) q bytes s tail : + bytes = cstring.to_zstring s ++ tail -> + cstring.WF s -> + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) + (fun c : N => charR q c) bytes ⊢ + p |-> cstring.R q s ∗ + (p |-> cstring.R q s -∗ + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) + (fun c : N => charR q c) bytes). +Proof. + intros Hbytes Hwf. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + iPoseProof (borrow_arrayR_cstringR p q bytes s tail Hbytes Hwf with "Harr") + as "[Hs Hclose]". + iSplitL "Hs". + - iExact "Hs". + - iIntros "Hs". + iPoseProof ("Hclose" with "Hs") as "Harr". + rewrite /arrayLR. + iSplit. + + iPureIntro. lia. + + iExact "Harr". +Qed. + +Lemma offset_entails `{Σ : cpp_logic, σ : genv} + (o : offset) (P Q : Rep) : + (P ⊢ Q) -> o |-> P ⊢ o |-> Q. +Proof. + intros HPQ. apply _offsetR_mono. exact HPQ. +Qed. + +Lemma at_zero_intro `{Σ : cpp_logic, σ : genv} + (p : ptr) (R : Rep) : + p |-> R ⊢ p .[Tuchar ! 0] |-> R. +Proof. + rewrite _at_sub_0; [reflexivity|done]. +Qed. + +Lemma at_zero_elim `{Σ : cpp_logic, σ : genv} + (p : ptr) (R : Rep) : + p .[Tuchar ! 0] |-> R ⊢ p |-> R. +Proof. + rewrite _at_sub_0; [reflexivity|done]. +Qed. + +Lemma at_type_ptrR_validR_plus_one `{Σ : cpp_logic, σ : genv} + (p : ptr) ty : + p |-> type_ptrR ty ⊢ p .[ty ! 1] |-> validR. +Proof. + rewrite -_at_offsetR. + apply heap_pred._at_cancel. + apply type_ptrR_validR_plus_one. +Qed. + +Lemma at_uchar_offset_add_intro `{Σ : cpp_logic, σ : genv} + (p : ptr) i j k (R : Rep) : + k = (i + j)%Z -> + p .[Tuchar ! k] |-> R ⊢ p .[Tuchar ! i] .[Tuchar ! j] |-> R. +Proof. + intros ->. + rewrite o_sub_sub. + reflexivity. +Qed. + +Lemma at_uchar_offset_add_elim `{Σ : cpp_logic, σ : genv} + (p : ptr) i j k (R : Rep) : + k = (i + j)%Z -> + p .[Tuchar ! i] .[Tuchar ! j] |-> R ⊢ p .[Tuchar ! k] |-> R. +Proof. + intros ->. + rewrite o_sub_sub. + reflexivity. +Qed. + +Lemma arrayR_charR_Vchar `{Σ : cpp_logic, σ : genv} q xs : + arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ + arrayR (Tchar_ char_type.Cchar) + (fun c : N => primR (Tchar_ char_type.Cchar) q (Vchar c)) xs. +Proof. + induction xs as [| x xs IH]. + - rewrite !arrayR_nil. iIntros "[$ $]". + - rewrite !arrayR_cons. + iIntros "[$ [$ Hxs]]". + iApply (offset_entails with "Hxs"). + exact IH. +Qed. + +Lemma at_arrayR_charR_Vchar `{Σ : cpp_logic, σ : genv} + (p : ptr) q xs : + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ + p |-> arrayR (Tchar_ char_type.Cchar) + (fun c : N => primR (Tchar_ char_type.Cchar) q (Vchar c)) xs. +Proof. + apply heap_pred._at_cancel. + by apply arrayR_charR_Vchar. +Qed. + +Lemma arrayR_charR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR 1$m c) xs ⊢ + p |-> anyR (Tarray (Tchar_ char_type.Cchar) n) 1$m. +Proof. + intros Hlen. + iIntros "Harr". + iPoseProof (at_arrayR_charR_Vchar with "Harr") as "Harr". + rewrite anyR_array. + iApply (arrayR_anyR_f (fun c : N => Vchar c) with "Harr"). + exact Hlen. +Qed. + +Lemma arrayLR_charR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) + (fun c : N => charR 1$m c) xs ⊢ + p |-> anyR (Tarray (Tchar_ char_type.Cchar) n) 1$m. +Proof. + intros Hlen. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + iApply (arrayR_charR_anyR with "Harr"). + exact Hlen. +Qed. + +Lemma at_charR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) q x : + p |-> charR q x ⊢ p |-> anyR (Tchar_ char_type.Cchar) q. +Proof. + apply heap_pred._at_cancel. + apply primR_anyR. +Qed. + +Lemma arrayR_charR_arrayR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR 1$m c) xs ⊢ + p |-> arrayR (Tchar_ char_type.Cchar) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) + (replicateN (lengthN xs) ()). +Proof. + revert p. + induction xs as [|x xs IH]. + all: intros p. + - rewrite /lengthN /= !arrayR_nil. reflexivity. + - rewrite arrayR_cons !_at_sep _at_offsetR. + iIntros "(Hty & Hx & Hxs)". + replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by + (rewrite /lengthN Nat2N.inj_succ; reflexivity). + rewrite replicateN_S. + rewrite arrayR_cons !_at_sep _at_offsetR. + iFrame "Hty". + iSplitL "Hx". + + iApply (at_charR_anyR with "Hx"). + + iApply (IH with "Hxs"). +Qed. + +Lemma arrayLR_charR_arrayLR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) + (fun c : N => charR 1$m c) xs ⊢ + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) + (replicateN n ()). +Proof. + intros Hlen. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + replace (replicateN n ()) with (replicateN (lengthN xs) ()) + by (rewrite /replicateN /lengthN -(N2Nat.id n) Hlen; reflexivity). + iPoseProof (arrayR_charR_arrayR_anyR with "Harr") as "Harr". + rewrite /arrayLR. + iSplit. + - iPureIntro. + unfold lengthZ, lengthN, replicateN. + rewrite length_replicate. + replace (length xs) with (N.to_nat n) by exact Hlen. + repeat rewrite N2Nat.id. + lia. + - rewrite _at_offsetR _at_sub_0; [|done]. + iExact "Harr". +Qed. + +Lemma arrayLR_prefix_tail0 `{Σ : cpp_logic, σ : genv} + {A : Type} (p : ptr) ty mid hi (R : A -> Rep) xs0 xs1 : + lengthN xs0 = Z.to_N mid -> + (0 <= mid)%Z -> + (mid <= hi)%Z -> + p |-> arrayLR ty 0 hi R (xs0 ++ xs1) ⊣⊢ + p |-> arrayLR ty 0 mid R xs0 ∗ + p .[ty ! mid] |-> arrayLR ty 0 (hi - mid) R xs1. +Proof. + intros Hlen Hlo Hhi. + assert (Hlen' : lengthN xs0 = Z.to_N (mid - 0)) by + (replace (mid - 0)%Z with mid by lia; exact Hlen). + rewrite (arrayLR_app' p 0 mid hi R xs0 xs1 Hlen' Hlo Hhi). + rewrite _at_sub_arrayLR. + Arith.arith_simpl. + reflexivity. +Qed. + +Lemma arrayR_ucharR_object_bytesR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ + p |-> object_bytesR Tuchar 1$m xs. +Proof. + iIntros "Hs". + iApply object_bytesR_of_arrayLR; [reflexivity|]. + rewrite arrayLR.unlock _at_sep. + iSplit; [iPureIntro; lia|]. + rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. +Qed. + +Lemma object_bytesR_half_split `{Σ : cpp_logic, σ : genv} + (p : ptr) ty bytes : + p |-> object_bytesR ty 1$m bytes ⊣⊢ + p |-> object_bytesR ty (cQp.mk false (1/2)) bytes ∗ + p |-> object_bytesR ty (cQp.mk false (1/2)) bytes. +Proof. + rewrite -(cfractional (P := fun q => p |-> object_bytesR ty q bytes) + (cQp.mk false (1/2)) (cQp.mk false (1/2))). + rewrite -cQp.mk_add' Qp.half_half. + reflexivity. +Qed. + +Lemma object_bytesR_prefix_tail0 `{Σ : cpp_logic, σ : genv} + (p : ptr) ty q mid hi xs0 xs1 : + lengthZ (xs0 ++ xs1) = hi -> + lengthZ xs0 = mid -> + lengthZ xs1 = (hi - mid)%Z -> + p |-> object_bytesR ty q (xs0 ++ xs1) ⊣⊢ + p |-> object_bytesR ty q xs0 ∗ + p .[ty ! mid] |-> object_bytesR ty q xs1. +Proof. + intros Htotal Hhead Htail. + iSplit. + - iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p ty q hi (xs0 ++ xs1) + Htotal with "Hs") as "Hs". + iPoseProof (arrayLR_prefix_tail0 p ty mid hi + (fun b : Z => ucharR q b) xs0 xs1 + ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) + ltac:(lia) ltac:(lia) with "Hs") as "[Hhead Htail]". + iPoseProof (object_bytesR_of_arrayLR p ty q mid xs0 + Hhead with "Hhead") as "Hhead". + iPoseProof (object_bytesR_of_arrayLR (p .[ ty ! mid]) ty q + (hi - mid) xs1 Htail with "Htail") as "Htail". + iFrame. + - iIntros "[Hhead Htail]". + iPoseProof (object_bytesR_to_arrayLR p ty q mid xs0 + Hhead with "Hhead") as "Hhead". + iPoseProof (object_bytesR_to_arrayLR (p .[ ty ! mid]) ty q + (hi - mid) xs1 Htail with "Htail") as "Htail". + iPoseProof ((arrayLR_prefix_tail0 p ty mid hi + (fun b : Z => ucharR q b) xs0 xs1 + ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) + ltac:(lia) ltac:(lia)) with "[$Hhead $Htail]") as "Hs". + iPoseProof (object_bytesR_of_arrayLR p ty q hi + (xs0 ++ xs1) Htotal with "Hs") as "Hs". + iExact "Hs". +Qed. + +Lemma arrayLR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayLR Tuchar 0 (Z.of_N n) (fun c : Z => ucharR 1$m c) xs ⊢ + p |-> anyR (Tarray Tuchar n) 1$m. +Proof. + intros Hlen. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + rewrite anyR_array. + iApply (arrayR_anyR_f (fun c : Z => c) with "Harr"). + exact Hlen. +Qed. + +Lemma lengthZ_of_to_nat_length {A : Type} (n : N) (xs : list A) : + N.to_nat n = length xs -> lengthZ xs = Z.of_N n. +Proof. + intros Hlen. + unfold lengthZ, lengthN. + rewrite <- Hlen, N2Nat.id. + reflexivity. +Qed. + +Lemma memchr_found_after_prefix prefix b suffix c : + List.Forall (fun x => x <> byte_of_int c) prefix -> + b = byte_of_int c -> + memchr (prefix ++ b :: suffix) c = Some (Z.of_nat (length prefix)). +Proof. + intros Hprefix Hb. + induction Hprefix as [|x prefix Hx _ IH]. + - simpl. + rewrite bool_decide_true; [|done]. + reflexivity. + - simpl. + rewrite bool_decide_false; [|done]. + rewrite IH. + simpl. + f_equal. + rewrite Nat2Z.inj_succ. + rewrite Z.add_1_l. + reflexivity. +Qed. + +Lemma memchr_missing_if_no_match bytes c : + List.Forall (fun x => x <> byte_of_int c) bytes -> + memchr bytes c = None. +Proof. + intros Hbytes. + induction Hbytes as [|x bytes Hx _ IH]. + - reflexivity. + - simpl. + rewrite bool_decide_false; [|done]. + rewrite IH. + reflexivity. +Qed. + +Ltac solve_memchr_side := + unfold byte_of_int; + repeat (rewrite Z.mod_small; [|lia]); + match goal with + | |- List.Forall _ [] => constructor + | |- List.Forall _ (_ :: _) => + constructor; [solve_memchr_side | solve_memchr_side] + | |- _ => lia + end. + +Lemma object_bytesR_ucharR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> anyR (Tarray Tuchar n) 1$m. +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (Z.of_N n) xs + ltac:(apply lengthZ_of_to_nat_length; exact Hlen) + with "Hs") as "Hs". + iApply (arrayLR_ucharR_anyR with "Hs"). + exact Hlen. +Qed. + +Lemma object_bytesR_ucharR_object_bytes_anyR + `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> object_bytes_anyR Tuchar (Z.of_N n). +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (object_bytesR_ucharR_anyR _ n xs Hlen with "Hs") as "Hs". + iApply (object_bytes_anyR_of_anyR_array with "Hs"). +Qed. + +Lemma object_bytesR_ucharR_arrayR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. +Proof. + iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ xs) xs + eq_refl with "Hs") as "Hs". + rewrite arrayLR.unlock _at_sep. + iDestruct "Hs" as "[_ Hs]". + rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. +Qed. + +Lemma at_arrayR_ucharR_cons `{Σ : cpp_logic, σ : genv} + (p : ptr) x xs : + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) (x :: xs) ⊣⊢ + p |-> type_ptrR Tuchar ∗ + p |-> ucharR 1$m x ∗ + p .[Tuchar ! 1] |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. +Proof. + rewrite arrayR_cons !_at_sep. + rewrite _at_offsetR. + reflexivity. +Qed. + +Lemma at_arrayR_cons `{Σ : cpp_logic, σ : genv} + {A : Type} (p : ptr) ty (R : A -> Rep) x xs : + p |-> arrayR ty R (x :: xs) ⊣⊢ + p |-> type_ptrR ty ∗ + p |-> R x ∗ + p .[ty ! 1] |-> arrayR ty R xs. +Proof. + rewrite arrayR_cons !_at_sep. + rewrite _at_offsetR. + reflexivity. +Qed. + +Lemma at_ucharR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) q x : + p |-> ucharR q x ⊢ p |-> anyR Tuchar q. +Proof. + apply heap_pred._at_cancel. + apply primR_anyR. +Qed. + +Lemma arrayR_ucharR_arrayR_anyR `{Σ : cpp_logic, σ : genv} + (p : ptr) xs : + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ + p |-> arrayR Tuchar (fun _ : unit => anyR Tuchar 1$m) + (replicateN (lengthN xs) ()). +Proof. + revert p. + induction xs as [|x xs IH]. + all: intros p. + - rewrite /lengthN /= !arrayR_nil. reflexivity. + - rewrite (at_arrayR_ucharR_cons p x xs). + iIntros "(Hty & Hx & Hxs)". + replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by + (rewrite /lengthN Nat2N.inj_succ; reflexivity). + rewrite replicateN_S. + rewrite (at_arrayR_cons p Tuchar + (fun _ : unit => anyR Tuchar 1$m) () (replicateN (lengthN xs) ())). + iFrame "Hty". + iSplitL "Hx". + + iApply (at_ucharR_anyR with "Hx"). + + iApply (IH with "Hxs"). +Qed. + +Lemma object_bytesR_ucharR_arrayLR_anyR + `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun _ : unit => anyR Tuchar 1$m) (replicateN n ()). +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". + rewrite arrayLR.unlock _at_sep. + iSplit. + - iPureIntro. + unfold lengthZ, lengthN, replicateN. + rewrite length_replicate N2Nat.id. + lia. + - rewrite _at_offsetR _at_sub_0; [|done]. + rewrite -(N2Nat.id n) Hlen. + iApply (arrayR_ucharR_arrayR_anyR with "Hs"). +Qed. + +Lemma object_bytesR_arrayLR_cons `{Σ : cpp_logic, σ : genv} + (p : ptr) x xs : + p |-> object_bytesR Tuchar 1$m (x :: xs) ⊣⊢ + (type_ptr Tuchar (p .[Tuchar ! 0]) ∗ p .[Tuchar ! 0] |-> ucharR 1$m x) ∗ + p |-> arrayLR Tuchar 1 (lengthZ (x :: xs)) (fun b : Z => ucharR 1$m b) xs. +Proof. + iSplit. + - iIntros "Hs". + iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) + (x :: xs) eq_refl with "Hs") as "Hs". + iEval (rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) + (fun b : Z => ucharR 1$m b) x xs)) in "Hs". + iExact "Hs". + - iIntros "[[#Hty Hx] Hs]". + iApply (object_bytesR_of_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) + (x :: xs) eq_refl). + rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) + (fun b : Z => ucharR 1$m b) x xs). + iFrame "# ∗". +Qed. + +Lemma uchar_cells_object_bytesR_two `{Σ : cpp_logic, σ : genv} + (p : ptr) a b : + p |-> ucharR 1$m a ∗ + p .[Tuchar ! 1] |-> ucharR 1$m b ⊢ + p |-> object_bytesR Tuchar 1$m [a; b]. +Proof. + iIntros "(Ha & Hb)". + iDestruct (observe (p |-> type_ptrR Tuchar) with "Ha") as "#Hty0". + iDestruct (observe (p .[Tuchar ! 1] |-> type_ptrR Tuchar) with "Hb") + as "#Hty1". + iApply arrayR_ucharR_object_bytesR. + rewrite (at_arrayR_ucharR_cons p a [b]). + iFrame "Hty0 Ha". + rewrite (at_arrayR_ucharR_cons (p .[Tuchar ! 1]) b []). + iFrame "Hty1 Hb". + rewrite arrayR_nil _at_sep. + iSplit. + - iApply (at_type_ptrR_validR_plus_one with "Hty1"). + - iPureIntro. done. +Qed. + +Lemma arrayR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + N.to_nat n = length xs -> + p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ + p |-> anyR (Tarray Tuchar n) 1$m. +Proof. + intros Hlen. + iIntros "Hs". + iPoseProof (arrayR_ucharR_object_bytesR with "Hs") as "Hs". + iApply (object_bytesR_ucharR_anyR with "Hs"). + exact Hlen. +Qed. diff --git a/rocq-brick-libstdcpp/proof/cstring/spec.v b/rocq-brick-libstdcpp/proof/cstring/spec.v index db98657..fd9af22 100644 --- a/rocq-brick-libstdcpp/proof/cstring/spec.v +++ b/rocq-brick-libstdcpp/proof/cstring/spec.v @@ -177,7 +177,7 @@ Section with_cpp. (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) \require lengthZ bytes = Z.of_N n \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR 1$m b) (memcpy bytes)). + (fun b : Z => ucharR 1$m b) bytes). cpp.spec "memmove" with (\arg{dest_p} "__dest" (Vptr dest_p) @@ -189,7 +189,7 @@ Section with_cpp. (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) \require lengthZ bytes = Z.of_N n \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR 1$m b) (memmove bytes)). + (fun b : Z => ucharR 1$m b) bytes). *) cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_spec with @@ -238,7 +238,7 @@ Section with_cpp. object_bytes_anyR dest_byte_ty (Z.of_N n) \require lengthZ bytes = Z.of_N n \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m - (memcpy bytes)). + bytes). cpp.spec "memmove" with (\arg{dest_p} "__dest" (Vptr dest_p) @@ -250,5 +250,5 @@ Section with_cpp. object_bytes_anyR dest_byte_ty (Z.of_N n) \require lengthZ bytes = Z.of_N n \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m - (memmove bytes)). + bytes). End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index a8fd5ca..b098a5e 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -22,531 +22,6 @@ Import normalize.only_provable_norm. Import normalize.normalize_ptr. Import refine_lib. -#[local] Lemma borrow_arrayR_cstringR `{Σ : cpp_logic, σ : genv} - (p : ptr) q bytes s tail : - bytes = cstring.to_zstring s ++ tail -> - cstring.WF s -> - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) - bytes ⊢ - p |-> cstring.R q s ∗ - (p |-> cstring.R q s -∗ - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) - bytes). -Proof. - intros Hbytes Hwf. - subst bytes. - rewrite (arrayR_app (fun c : N => charR q c) (Tchar_ char_type.Cchar)). - iIntros "[Hs Htail]". - iSplitL "Hs". - - rewrite /cstring.R /zstring.R. iFrame. done. - - iIntros "Hs". - rewrite /cstring.R /zstring.R. - iDestruct "Hs" as "[Hs _]". - iFrame. -Qed. - -#[local] Lemma borrow_arrayLR_cstringR `{Σ : cpp_logic, σ : genv} - (p : ptr) q bytes s tail : - bytes = cstring.to_zstring s ++ tail -> - cstring.WF s -> - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) - (fun c : N => charR q c) bytes ⊢ - p |-> cstring.R q s ∗ - (p |-> cstring.R q s -∗ - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) - (fun c : N => charR q c) bytes). -Proof. - intros Hbytes Hwf. - rewrite arrayLR.unlock _at_sep. - iIntros "[_ Harr]". - rewrite _at_offsetR _at_sub_0; [|done]. - iPoseProof (borrow_arrayR_cstringR p q bytes s tail Hbytes Hwf with "Harr") - as "[Hs Hclose]". - iSplitL "Hs". - - iExact "Hs". - - iIntros "Hs". - iPoseProof ("Hclose" with "Hs") as "Harr". - rewrite /arrayLR. - iSplit. - + iPureIntro. lia. - + iExact "Harr". -Qed. - -#[local] Lemma offset_entails `{Σ : cpp_logic, σ : genv} - (o : offset) (P Q : Rep) : - (P ⊢ Q) -> o |-> P ⊢ o |-> Q. -Proof. - intros HPQ. apply _offsetR_mono. exact HPQ. -Qed. - -#[local] Lemma at_zero_intro `{Σ : cpp_logic, σ : genv} - (p : ptr) (R : Rep) : - p |-> R ⊢ p .[Tuchar ! 0] |-> R. -Proof. - rewrite _at_sub_0; [reflexivity|done]. -Qed. - -#[local] Lemma at_zero_elim `{Σ : cpp_logic, σ : genv} - (p : ptr) (R : Rep) : - p .[Tuchar ! 0] |-> R ⊢ p |-> R. -Proof. - rewrite _at_sub_0; [reflexivity|done]. -Qed. - -#[local] Lemma at_type_ptrR_validR_plus_one `{Σ : cpp_logic, σ : genv} - (p : ptr) ty : - p |-> type_ptrR ty ⊢ p .[ty ! 1] |-> validR. -Proof. - rewrite -_at_offsetR. - apply heap_pred._at_cancel. - apply type_ptrR_validR_plus_one. -Qed. - -#[local] Lemma at_uchar_offset_add_intro `{Σ : cpp_logic, σ : genv} - (p : ptr) i j k (R : Rep) : - k = (i + j)%Z -> - p .[Tuchar ! k] |-> R ⊢ p .[Tuchar ! i] .[Tuchar ! j] |-> R. -Proof. - intros ->. - rewrite o_sub_sub. - reflexivity. -Qed. - -#[local] Lemma at_uchar_offset_add_elim `{Σ : cpp_logic, σ : genv} - (p : ptr) i j k (R : Rep) : - k = (i + j)%Z -> - p .[Tuchar ! i] .[Tuchar ! j] |-> R ⊢ p .[Tuchar ! k] |-> R. -Proof. - intros ->. - rewrite o_sub_sub. - reflexivity. -Qed. - -#[local] Lemma arrayR_charR_Vchar `{Σ : cpp_logic, σ : genv} q xs : - arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ - arrayR (Tchar_ char_type.Cchar) - (fun c : N => primR (Tchar_ char_type.Cchar) q (Vchar c)) xs. -Proof. - induction xs as [| x xs IH]. - - rewrite !arrayR_nil. iIntros "[$ $]". - - rewrite !arrayR_cons. - iIntros "[$ [$ Hxs]]". - iApply (offset_entails with "Hxs"). - exact IH. -Qed. - -#[local] Lemma at_arrayR_charR_Vchar `{Σ : cpp_logic, σ : genv} - (p : ptr) q xs : - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ - p |-> arrayR (Tchar_ char_type.Cchar) - (fun c : N => primR (Tchar_ char_type.Cchar) q (Vchar c)) xs. -Proof. - apply heap_pred._at_cancel. - by apply arrayR_charR_Vchar. -Qed. - -#[local] Lemma arrayR_charR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR 1$m c) xs ⊢ - p |-> anyR (Tarray (Tchar_ char_type.Cchar) n) 1$m. -Proof. - intros Hlen. - iIntros "Harr". - iPoseProof (at_arrayR_charR_Vchar with "Harr") as "Harr". - rewrite anyR_array. - iApply (arrayR_anyR_f (fun c : N => Vchar c) with "Harr"). - exact Hlen. -Qed. - -#[local] Lemma arrayLR_charR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) - (fun c : N => charR 1$m c) xs ⊢ - p |-> anyR (Tarray (Tchar_ char_type.Cchar) n) 1$m. -Proof. - intros Hlen. - rewrite arrayLR.unlock _at_sep. - iIntros "[_ Harr]". - rewrite _at_offsetR _at_sub_0; [|done]. - iApply (arrayR_charR_anyR with "Harr"). - exact Hlen. -Qed. - -#[local] Lemma at_charR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) q x : - p |-> charR q x ⊢ p |-> anyR (Tchar_ char_type.Cchar) q. -Proof. - apply heap_pred._at_cancel. - apply primR_anyR. -Qed. - -#[local] Lemma arrayR_charR_arrayR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR 1$m c) xs ⊢ - p |-> arrayR (Tchar_ char_type.Cchar) - (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) - (replicateN (lengthN xs) ()). -Proof. - revert p. - induction xs as [|x xs IH]. - all: intros p. - - rewrite /lengthN /= !arrayR_nil. reflexivity. - - rewrite arrayR_cons !_at_sep _at_offsetR. - iIntros "(Hty & Hx & Hxs)". - replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by - (rewrite /lengthN Nat2N.inj_succ; reflexivity). - rewrite replicateN_S. - rewrite arrayR_cons !_at_sep _at_offsetR. - iFrame "Hty". - iSplitL "Hx". - + iApply (at_charR_anyR with "Hx"). - + iApply (IH with "Hxs"). -Qed. - -#[local] Lemma arrayLR_charR_arrayLR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) - (fun c : N => charR 1$m c) xs ⊢ - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) - (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) - (replicateN n ()). -Proof. - intros Hlen. - rewrite arrayLR.unlock _at_sep. - iIntros "[_ Harr]". - rewrite _at_offsetR _at_sub_0; [|done]. - replace (replicateN n ()) with (replicateN (lengthN xs) ()) - by (rewrite /replicateN /lengthN -(N2Nat.id n) Hlen; reflexivity). - iPoseProof (arrayR_charR_arrayR_anyR with "Harr") as "Harr". - rewrite /arrayLR. - iSplit. - - iPureIntro. - unfold lengthZ, lengthN, replicateN. - rewrite length_replicate. - replace (length xs) with (N.to_nat n) by exact Hlen. - repeat rewrite N2Nat.id. - lia. - - rewrite _at_offsetR _at_sub_0; [|done]. - iExact "Harr". -Qed. - -#[local] Lemma arrayLR_prefix_tail0 `{Σ : cpp_logic, σ : genv} - {A : Type} (p : ptr) ty mid hi (R : A -> Rep) xs0 xs1 : - lengthN xs0 = Z.to_N mid -> - (0 <= mid)%Z -> - (mid <= hi)%Z -> - p |-> arrayLR ty 0 hi R (xs0 ++ xs1) ⊣⊢ - p |-> arrayLR ty 0 mid R xs0 ∗ - p .[ty ! mid] |-> arrayLR ty 0 (hi - mid) R xs1. -Proof. - intros Hlen Hlo Hhi. - assert (Hlen' : lengthN xs0 = Z.to_N (mid - 0)) by - (replace (mid - 0)%Z with mid by lia; exact Hlen). - rewrite (arrayLR_app' p 0 mid hi R xs0 xs1 Hlen' Hlo Hhi). - rewrite _at_sub_arrayLR. - Arith.arith_simpl. - reflexivity. -Qed. - -#[local] Lemma arrayR_ucharR_object_bytesR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ - p |-> object_bytesR Tuchar 1$m xs. -Proof. - iIntros "Hs". - iApply object_bytesR_of_arrayLR; [reflexivity|]. - rewrite arrayLR.unlock _at_sep. - iSplit; [iPureIntro; lia|]. - rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. -Qed. - -#[local] Lemma object_bytesR_half_split `{Σ : cpp_logic, σ : genv} - (p : ptr) ty bytes : - p |-> object_bytesR ty 1$m bytes ⊣⊢ - p |-> object_bytesR ty (cQp.mk false (1/2)) bytes ∗ - p |-> object_bytesR ty (cQp.mk false (1/2)) bytes. -Proof. - rewrite -(cfractional (P := fun q => p |-> object_bytesR ty q bytes) - (cQp.mk false (1/2)) (cQp.mk false (1/2))). - rewrite -cQp.mk_add' Qp.half_half. - reflexivity. -Qed. - -#[local] Lemma object_bytesR_prefix_tail0 `{Σ : cpp_logic, σ : genv} - (p : ptr) ty q mid hi xs0 xs1 : - lengthZ (xs0 ++ xs1) = hi -> - lengthZ xs0 = mid -> - lengthZ xs1 = (hi - mid)%Z -> - p |-> object_bytesR ty q (xs0 ++ xs1) ⊣⊢ - p |-> object_bytesR ty q xs0 ∗ - p .[ty ! mid] |-> object_bytesR ty q xs1. -Proof. - intros Htotal Hhead Htail. - iSplit. - - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p ty q hi (xs0 ++ xs1) - Htotal with "Hs") as "Hs". - iPoseProof (arrayLR_prefix_tail0 p ty mid hi - (fun b : Z => ucharR q b) xs0 xs1 - ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) - ltac:(lia) ltac:(lia) with "Hs") as "[Hhead Htail]". - iPoseProof (object_bytesR_of_arrayLR p ty q mid xs0 - Hhead with "Hhead") as "Hhead". - iPoseProof (object_bytesR_of_arrayLR (p .[ ty ! mid]) ty q - (hi - mid) xs1 Htail with "Htail") as "Htail". - iFrame. - - iIntros "[Hhead Htail]". - iPoseProof (object_bytesR_to_arrayLR p ty q mid xs0 - Hhead with "Hhead") as "Hhead". - iPoseProof (object_bytesR_to_arrayLR (p .[ ty ! mid]) ty q - (hi - mid) xs1 Htail with "Htail") as "Htail". - iPoseProof ((arrayLR_prefix_tail0 p ty mid hi - (fun b : Z => ucharR q b) xs0 xs1 - ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) - ltac:(lia) ltac:(lia)) with "[$Hhead $Htail]") as "Hs". - iPoseProof (object_bytesR_of_arrayLR p ty q hi - (xs0 ++ xs1) Htotal with "Hs") as "Hs". - iExact "Hs". -Qed. - -#[local] Lemma arrayLR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> arrayLR Tuchar 0 (Z.of_N n) (fun c : Z => ucharR 1$m c) xs ⊢ - p |-> anyR (Tarray Tuchar n) 1$m. -Proof. - intros Hlen. - rewrite arrayLR.unlock _at_sep. - iIntros "[_ Harr]". - rewrite _at_offsetR _at_sub_0; [|done]. - rewrite anyR_array. - iApply (arrayR_anyR_f (fun c : Z => c) with "Harr"). - exact Hlen. -Qed. - -#[local] Lemma lengthZ_of_to_nat_length {A : Type} (n : N) (xs : list A) : - N.to_nat n = length xs -> lengthZ xs = Z.of_N n. -Proof. - intros Hlen. - unfold lengthZ, lengthN. - rewrite <- Hlen, N2Nat.id. - reflexivity. -Qed. - -#[local] Lemma memchr_found_after_prefix prefix b suffix c : - List.Forall (fun x => x <> byte_of_int c) prefix -> - b = byte_of_int c -> - memchr (prefix ++ b :: suffix) c = Some (Z.of_nat (length prefix)). -Proof. - intros Hprefix Hb. - induction Hprefix as [|x prefix Hx _ IH]. - - simpl. - rewrite bool_decide_true; [|done]. - reflexivity. - - simpl. - rewrite bool_decide_false; [|done]. - rewrite IH. - simpl. - f_equal. - rewrite Nat2Z.inj_succ. - rewrite Z.add_1_l. - reflexivity. -Qed. - -#[local] Lemma memchr_missing_if_no_match bytes c : - List.Forall (fun x => x <> byte_of_int c) bytes -> - memchr bytes c = None. -Proof. - intros Hbytes. - induction Hbytes as [|x bytes Hx _ IH]. - - reflexivity. - - simpl. - rewrite bool_decide_false; [|done]. - rewrite IH. - reflexivity. -Qed. - -#[local] Ltac solve_memchr_side := - unfold byte_of_int; - repeat (rewrite Z.mod_small; [|lia]); - match goal with - | |- List.Forall _ [] => constructor - | |- List.Forall _ (_ :: _) => - constructor; [solve_memchr_side | solve_memchr_side] - | |- _ => lia - end. - -#[local] Lemma object_bytesR_ucharR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> object_bytesR Tuchar 1$m xs ⊢ - p |-> anyR (Tarray Tuchar n) 1$m. -Proof. - intros Hlen. - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (Z.of_N n) xs - ltac:(apply lengthZ_of_to_nat_length; exact Hlen) - with "Hs") as "Hs". - iApply (arrayLR_ucharR_anyR with "Hs"). - exact Hlen. -Qed. - -#[local] Lemma object_bytesR_ucharR_object_bytes_anyR - `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> object_bytesR Tuchar 1$m xs ⊢ - p |-> object_bytes_anyR Tuchar (Z.of_N n). -Proof. - intros Hlen. - iIntros "Hs". - iPoseProof (object_bytesR_ucharR_anyR _ n xs Hlen with "Hs") as "Hs". - iApply (object_bytes_anyR_of_anyR_array with "Hs"). -Qed. - -#[local] Lemma object_bytesR_ucharR_arrayR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> object_bytesR Tuchar 1$m xs ⊢ - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. -Proof. - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ xs) xs - eq_refl with "Hs") as "Hs". - rewrite arrayLR.unlock _at_sep. - iDestruct "Hs" as "[_ Hs]". - rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. -Qed. - -#[local] Lemma at_arrayR_ucharR_cons `{Σ : cpp_logic, σ : genv} - (p : ptr) x xs : - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) (x :: xs) ⊣⊢ - p |-> type_ptrR Tuchar ∗ - p |-> ucharR 1$m x ∗ - p .[Tuchar ! 1] |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. -Proof. - rewrite arrayR_cons !_at_sep. - rewrite _at_offsetR. - reflexivity. -Qed. - -#[local] Lemma at_arrayR_cons `{Σ : cpp_logic, σ : genv} - {A : Type} (p : ptr) ty (R : A -> Rep) x xs : - p |-> arrayR ty R (x :: xs) ⊣⊢ - p |-> type_ptrR ty ∗ - p |-> R x ∗ - p .[ty ! 1] |-> arrayR ty R xs. -Proof. - rewrite arrayR_cons !_at_sep. - rewrite _at_offsetR. - reflexivity. -Qed. - -#[local] Lemma at_ucharR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) q x : - p |-> ucharR q x ⊢ p |-> anyR Tuchar q. -Proof. - apply heap_pred._at_cancel. - apply primR_anyR. -Qed. - -#[local] Lemma arrayR_ucharR_arrayR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ - p |-> arrayR Tuchar (fun _ : unit => anyR Tuchar 1$m) - (replicateN (lengthN xs) ()). -Proof. - revert p. - induction xs as [|x xs IH]. - all: intros p. - - rewrite /lengthN /= !arrayR_nil. reflexivity. - - rewrite (at_arrayR_ucharR_cons p x xs). - iIntros "(Hty & Hx & Hxs)". - replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by - (rewrite /lengthN Nat2N.inj_succ; reflexivity). - rewrite replicateN_S. - rewrite (at_arrayR_cons p Tuchar - (fun _ : unit => anyR Tuchar 1$m) () (replicateN (lengthN xs) ())). - iFrame "Hty". - iSplitL "Hx". - + iApply (at_ucharR_anyR with "Hx"). - + iApply (IH with "Hxs"). -Qed. - -#[local] Lemma object_bytesR_ucharR_arrayLR_anyR - `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> object_bytesR Tuchar 1$m xs ⊢ - p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun _ : unit => anyR Tuchar 1$m) (replicateN n ()). -Proof. - intros Hlen. - iIntros "Hs". - iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". - rewrite arrayLR.unlock _at_sep. - iSplit. - - iPureIntro. - unfold lengthZ, lengthN, replicateN. - rewrite length_replicate N2Nat.id. - lia. - - - rewrite _at_offsetR _at_sub_0; [|done]. - rewrite -(N2Nat.id n) Hlen. - iApply (arrayR_ucharR_arrayR_anyR with "Hs"). -Qed. - -#[local] Lemma object_bytesR_arrayLR_cons `{Σ : cpp_logic, σ : genv} - (p : ptr) x xs : - p |-> object_bytesR Tuchar 1$m (x :: xs) ⊣⊢ - (type_ptr Tuchar (p .[Tuchar ! 0]) ∗ p .[Tuchar ! 0] |-> ucharR 1$m x) ∗ - p |-> arrayLR Tuchar 1 (lengthZ (x :: xs)) (fun b : Z => ucharR 1$m b) xs. -Proof. - iSplit. - - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) - (x :: xs) eq_refl with "Hs") as "Hs". - iEval (rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) - (fun b : Z => ucharR 1$m b) x xs)) in "Hs". - iExact "Hs". - - iIntros "[[#Hty Hx] Hs]". - iApply (object_bytesR_of_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) - (x :: xs) eq_refl). - rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) - (fun b : Z => ucharR 1$m b) x xs). - iFrame "# ∗". -Qed. - -#[local] Lemma uchar_cells_object_bytesR_two `{Σ : cpp_logic, σ : genv} - (p : ptr) a b : - p |-> ucharR 1$m a ∗ - p .[Tuchar ! 1] |-> ucharR 1$m b ⊢ - p |-> object_bytesR Tuchar 1$m [a; b]. -Proof. - iIntros "(Ha & Hb)". - iDestruct (observe (p |-> type_ptrR Tuchar) with "Ha") as "#Hty0". - iDestruct (observe (p .[Tuchar ! 1] |-> type_ptrR Tuchar) with "Hb") - as "#Hty1". - iApply arrayR_ucharR_object_bytesR. - rewrite (at_arrayR_ucharR_cons p a [b]). - iFrame "Hty0 Ha". - rewrite (at_arrayR_ucharR_cons (p .[Tuchar ! 1]) b []). - iFrame "Hty1 Hb". - rewrite arrayR_nil _at_sep. - iSplit. - - iApply (at_type_ptrR_validR_plus_one with "Hty1"). - - iPureIntro. done. -Qed. - -#[local] Lemma arrayR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ - p |-> anyR (Tarray Tuchar n) 1$m. -Proof. - intros Hlen. - iIntros "Hs". - iPoseProof (arrayR_ucharR_object_bytesR with "Hs") as "Hs". - iApply (object_bytesR_ucharR_anyR with "Hs"). - exact Hlen. -Qed. - Section with_cpp. Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. @@ -558,27 +33,18 @@ Section with_cpp. Proof. verify_spec; go; ego. Qed. cpp.spec "test_strlen_embedded_null()" default. - Lemma test_strlen_embedded_null_ok : - verify[module] "test_strlen_embedded_null()". - Admitted. cpp.spec "test_strcmp()" default. Lemma test_strcmp_ok : verify[module] "test_strcmp()". Proof. verify_spec; go; ego. Qed. cpp.spec "test_strcmp_embedded_null()" default. - Lemma test_strcmp_embedded_null_ok : - verify[module] "test_strcmp_embedded_null()". - Admitted. cpp.spec "test_strncmp()" default. Lemma test_strncmp_ok : verify[module] "test_strncmp()". Proof. verify_spec; go; ego. Qed. cpp.spec "test_strncmp_embedded_null()" default. - Lemma test_strncmp_embedded_null_ok : - verify[module] "test_strncmp_embedded_null()". - Admitted. cpp.spec "test_strlen_array_buffer()" default. Lemma test_strlen_array_buffer_ok : @@ -977,56 +443,6 @@ Section with_cpp. contradiction. Qed. - cpp.spec "test_memchr_embedded_null()" default. - Lemma test_memchr_embedded_null_ok : - verify[module] "test_memchr_embedded_null()". - Proof using MOD _Σ thread_info Σ σ. - verify_spec; go. - iDestruct select (s_addr |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [97%Z; 0%Z; 98%Z; 0%Z]) as "Hs". - iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) - 4 [97%Z; 0%Z; 98%Z; 0%Z] ltac:(reflexivity) with "Hs") as "Hs". - iExists Tuchar, (cQp.mk false 1), [97%Z; 0%Z; 98%Z; 0%Z]. - iSplitL "Hs"; [iExact "Hs"|]. - iSplit. - + done. - + iIntros "Hs". - rewrite (memchr_found_after_prefix [97%Z] 0%Z [98%Z; 0%Z] 0%Z); [|solve_memchr_side..]. - Arith.arith_simpl; go. - iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 0%Z] [98%Z; 0%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") - as "[Hhead Hs]". - iExists Tuchar, (cQp.mk false 1), [98%Z; 0%Z]. - iSplitL "Hs"; [iExact "Hs"|]. - iSplit; [done|]. - iIntros "Hs". - rewrite (memchr_found_after_prefix [98%Z] 0%Z (@nil Z) 0%Z); [|solve_memchr_side..]. - Arith.arith_simpl; go. - rewrite o_sub_sub. - Arith.arith_simpl. - go. - iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 0%Z] [98%Z; 0%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hhead $Hs]") - as "Hs". - iExists Tuchar, (cQp.mk false 1), [97%Z; 0%Z; 98%Z; 0%Z]. - iSplitL "Hs"; [iExact "Hs"|]. - iSplit; [done|]. - iIntros "Hs". - rewrite (memchr_found_after_prefix [97%Z; 0%Z] 98%Z [0%Z] 98%Z); [|solve_memchr_side..]. - Arith.arith_simpl; go. - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N - [97%Z; 0%Z; 98%Z; 0%Z] - ltac:(reflexivity) with "Hs") as "Hs". - iFrame "Hs". - go. - rewrite o_sub_sub in H. - simpl in H. - contradiction. - Qed. - cpp.spec "test_memcpy()" default. Lemma test_memcpy_ok : verify[module] "test_memcpy()". Proof using MOD _Σ thread_info Σ σ. @@ -1489,15 +905,7 @@ Section with_cpp. go. Qed. - cpp.spec "test_memcmp_embedded_null()" default. - - cpp.spec "test_memset_embedded_null()" default. - - cpp.spec "test_memcpy_embedded_null()" default. - cpp.spec "test_memmove_overlap()" default. - cpp.spec "test_memmove_embedded_null()" default. - cpp.spec "test_cstring_slice4()" default. End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v b/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v new file mode 100644 index 0000000..ed88ef4 --- /dev/null +++ b/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v @@ -0,0 +1,158 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.auto.cpp.hints.anyR. +(** BEGIN: SKYLABS DEFAULT PROOF IMPORTS *) +Require Import skylabs.auto.cpp.prelude.proof. +Require Import skylabs.cpp.array. +Import expr_join. +#[local] Hint Resolve delayed_case.smash_delayed_case_B | 1000 : br_hints. +#[local] Hint Resolve delayed_case.expr_join.smash_delayed_case_B | 1000 : br_hints. + +(** END: SKYLABS DEFAULT PROOF IMPORTS *) +Require Import skylabs.brick.libstdcpp.cassert.spec. +Require Import skylabs.brick.libstdcpp.cstring.spec. +Require Import skylabs.brick.libstdcpp.test.cstring.test_cpp. + +Import normalize.only_provable_norm. + +Import normalize.normalize_ptr. +Import refine_lib. + +Section with_cpp. + Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. + + cpp.spec "test_strlen_embedded_null()" default. + Lemma test_strlen_embedded_null_ok : + verify[module] "test_strlen_embedded_null()". + Admitted. + + cpp.spec "test_strcmp_embedded_null()" default. + Lemma test_strcmp_embedded_null_ok : + verify[module] "test_strcmp_embedded_null()". + Admitted. + + cpp.spec "test_strncmp_embedded_null()" default. + Lemma test_strncmp_embedded_null_ok : + verify[module] "test_strncmp_embedded_null()". + Admitted. + + cpp.spec "test_memset_embedded_null()" default. + Lemma test_memset_embedded_null_ok : + verify[module] "test_memset_embedded_null()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (s_addr |-> arrayLR "unsigned char" (1 + 1) 4 + (fun v : Z => ucharR 1$m v) [99%Z; 100%Z]) as "Htail". + iDestruct select (s_addr .["unsigned char" ! 1] |-> ucharR 1$m 98%Z) + as "H1". + iDestruct select (s_addr .["unsigned char" ! 0] |-> ucharR 1$m 97%Z) + as "H0". + iEval (rewrite (arrayLR_cons s_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Htail". + iDestruct "Htail" as "[[#Hty2 H2] Htail]". + iPoseProof (at_uchar_offset_add_intro s_addr 1 1 2 + (ucharR 1$m 99%Z) ltac:(lia) with "H2") as "H2". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 1]) + 98%Z 99%Z with "[$H1 $H2]") as "Htarget". + iEval (rewrite (arrayLR_cons s_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Htail". + iDestruct "Htail" as "[[#Hty3 H3] Hempty]". + iExists Tuchar. + iSplitL "Htarget". + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 2%N + [98%Z; 99%Z] ltac:(reflexivity) with "Htarget"). + - iIntros "Htarget". + go. + iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 1]) 0%Z + [0%Z] with "Htarget") as "[[#Hty1 H1] Htarget]". + iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 1 2 + (fun b : Z => ucharR 1$m b) 0%Z [])) in "Htarget". + iDestruct "Htarget" as "[[#Hty2' H2] Hempty2]". + iFrame "H0". iIntros "H0". + go. + iPoseProof (at_zero_elim (s_addr .[Tuchar ! 1]) with "H1") as "H1". + iFrame "H1". iIntros "H1". + go. + iPoseProof (at_uchar_offset_add_elim s_addr 1 1 2 + (ucharR 1$m 0%Z) ltac:(lia) with "H2") as "H2". + iFrame "H2". iIntros "H2". + go. + iFrame "H3". iIntros "H3". + go. + iPoseProof (at_zero_elim s_addr with "H0") as "H0". + iPoseProof (uchar_cells_object_bytesR_two s_addr 97%Z 0%Z + with "[$H0 $H1]") as "Hhead". + iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) + 0%Z 100%Z with "[$H2 $H3]") as "Htail". + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 0%Z] [0%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Htail]") as "Hs". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 0%Z; 0%Z; 100%Z] ltac:(reflexivity) with "Hs") as "Hs". + iFrame "Hs". + go. + Qed. + + cpp.spec "test_memchr_embedded_null()" default. + Lemma test_memchr_embedded_null_ok : + verify[module] "test_memchr_embedded_null()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (s_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 0%Z; 98%Z; 0%Z]) as "Hs". + iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 0%Z; 98%Z; 0%Z] ltac:(reflexivity) with "Hs") as "Hs". + iExists Tuchar, (cQp.mk false 1), [97%Z; 0%Z; 98%Z; 0%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit. + + done. + + iIntros "Hs". + rewrite (memchr_found_after_prefix [97%Z] 0%Z [98%Z; 0%Z] 0%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 0%Z] [98%Z; 0%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + as "[Hhead Hs]". + iExists Tuchar, (cQp.mk false 1), [98%Z; 0%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [98%Z] 0%Z (@nil Z) 0%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + rewrite o_sub_sub. + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 0%Z] [98%Z; 0%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Hs]") + as "Hs". + iExists Tuchar, (cQp.mk false 1), [97%Z; 0%Z; 98%Z; 0%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [97%Z; 0%Z] 98%Z [0%Z] 98%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 0%Z; 98%Z; 0%Z] + ltac:(reflexivity) with "Hs") as "Hs". + iFrame "Hs". + go. + rewrite o_sub_sub in H. + simpl in H. + contradiction. + Qed. + + cpp.spec "test_memcmp_embedded_null()" default. + + cpp.spec "test_memcpy_embedded_null()" default. + + cpp.spec "test_memmove_embedded_null()" default. +End with_cpp. From 9d995f55753c9011bdb35a4caf4368f8edfcf32d Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Fri, 24 Apr 2026 05:18:55 -0400 Subject: [PATCH 07/11] Moved remaining specs/proofs ofr embedded_null litmus tests to proofs_embedded_null --- rocq-brick-libstdcpp/test/cstring/proof.v | 75 ------------------- .../test/cstring/proofs_embedded_null.v | 69 +++++++++++++++++ 2 files changed, 69 insertions(+), 75 deletions(-) diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index b098a5e..8d96f0e 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -32,20 +32,14 @@ Section with_cpp. Lemma test_strlen_ok : verify[module] "test_strlen()". Proof. verify_spec; go; ego. Qed. - cpp.spec "test_strlen_embedded_null()" default. - cpp.spec "test_strcmp()" default. Lemma test_strcmp_ok : verify[module] "test_strcmp()". Proof. verify_spec; go; ego. Qed. - cpp.spec "test_strcmp_embedded_null()" default. - cpp.spec "test_strncmp()" default. Lemma test_strncmp_ok : verify[module] "test_strncmp()". Proof. verify_spec; go; ego. Qed. - cpp.spec "test_strncmp_embedded_null()" default. - cpp.spec "test_strlen_array_buffer()" default. Lemma test_strlen_array_buffer_ok : verify[module] "test_strlen_array_buffer()". @@ -192,75 +186,6 @@ Section with_cpp. Arith.arith_simpl; go; ego. Qed. - cpp.spec "test_search_embedded_null_array_buffer()" default. - Lemma test_search_embedded_null_array_buffer_ok : - verify[module] "test_search_embedded_null_array_buffer()". - Proof using MOD. - verify_spec; go. - iPoseProof (borrow_arrayLR_cstringR _ _ - (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) "ab"%bs - [98%N; 99%N; 0%N] eq_refl - ltac:(apply cstring.WF_cons; - [change (Byte.x61 <> Byte.x00); congruence|]; - apply cstring.WF_cons; - [change (Byte.x62 <> Byte.x00); congruence|]; - apply cstring.WF_nil) with "[$]") - as "[Hs Hclose]". - iExists _, "ab"%bs. iFrame "Hs". - iIntros "Hs". - go. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go. - go. - Arith.arith_simpl; go. - go. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "Hs". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "Hs". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "Hs". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "Hs". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "[Hs Haccept]". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "[Hs Hreject]". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "[Hs Hneedle]". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "[Hs Hneedle_b]". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "[Hs Hneedle_bc]". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "[Hs Hneedle_b2]". - Arith.arith_simpl; go; ego. - iSplitL "Hs"; [iExact "Hs"|]. - iIntros "[Hs Hempty]". - Arith.arith_simpl; go; ego. - iPoseProof ("Hclose" with "Hs") as "Harr". - iPoseProof (arrayLR_charR_arrayLR_anyR _ 6%N - (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) - ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") - as "Harr". - go. - iFrame "Harr". - go. - Qed. - cpp.spec "test_cstring_slice1()" default. Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". Proof. verify_spec; go. Qed. diff --git a/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v b/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v index ed88ef4..ba1ed83 100644 --- a/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v +++ b/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v @@ -40,6 +40,75 @@ Section with_cpp. verify[module] "test_strncmp_embedded_null()". Admitted. + cpp.spec "test_search_embedded_null_array_buffer()" default. + Lemma test_search_embedded_null_array_buffer_ok : + verify[module] "test_search_embedded_null_array_buffer()". + Proof using MOD. + verify_spec; go. + iPoseProof (borrow_arrayLR_cstringR _ _ + (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) "ab"%bs + [98%N; 99%N; 0%N] eq_refl + ltac:(apply cstring.WF_cons; + [change (Byte.x61 <> Byte.x00); congruence|]; + apply cstring.WF_cons; + [change (Byte.x62 <> Byte.x00); congruence|]; + apply cstring.WF_nil) with "[$]") + as "[Hs Hclose]". + iExists _, "ab"%bs. iFrame "Hs". + iIntros "Hs". + go. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go; ego. + Arith.arith_simpl; go. + go. + Arith.arith_simpl; go. + go. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "Hs". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Haccept]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hreject]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle_b]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle_bc]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hneedle_b2]". + Arith.arith_simpl; go; ego. + iSplitL "Hs"; [iExact "Hs"|]. + iIntros "[Hs Hempty]". + Arith.arith_simpl; go; ego. + iPoseProof ("Hclose" with "Hs") as "Harr". + iPoseProof (arrayLR_charR_arrayLR_anyR _ 6%N + (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) + ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") + as "Harr". + go. + iFrame "Harr". + go. + Qed. + cpp.spec "test_memset_embedded_null()" default. Lemma test_memset_embedded_null_ok : verify[module] "test_memset_embedded_null()". From 3e3344dd4322a27214e211e7f8a7537dae0e6ba8 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Tue, 28 Apr 2026 10:51:16 -0400 Subject: [PATCH 08/11] Proof progrss in litmus tests proofs but proofs for mem{set|cmp|cpy|chr|move} remain ugly --- rocq-brick-libstdcpp/proof/cstring/pred.v | 100 +- rocq-brick-libstdcpp/proof/cstring/spec.v | 6 +- rocq-brick-libstdcpp/test/cstring/proof.v | 1372 ++++++++++++++--- .../test/cstring/proofs_embedded_null.v | 12 +- 4 files changed, 1229 insertions(+), 261 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/cstring/pred.v b/rocq-brick-libstdcpp/proof/cstring/pred.v index adc6283..6f58525 100644 --- a/rocq-brick-libstdcpp/proof/cstring/pred.v +++ b/rocq-brick-libstdcpp/proof/cstring/pred.v @@ -31,10 +31,11 @@ Axiom object_bytesR_cfrac : forall `{Σ : cpp_logic} {σ : genv} byte_ty bytes, (fun q => object_bytesR byte_ty q bytes) q. Proof. solve_as_cfrac. Qed. -(** [object_bytes_anyR byte_ty n] owns a writable [n]-byte destination range - whose previous byte values are irrelevant. *) +(** [object_bytes_anyR byte_ty q n] owns an [n]-byte destination range at + permission [q] whose previous byte values are irrelevant. Specs for + mutating functions may still require [q = 1$m]. *) Axiom object_bytes_anyR : forall `{Σ : cpp_logic} {σ : genv}, - type -> Z -> Rep. + type -> cQp.t -> Z -> Rep. Axiom object_bytesR_to_arrayLR : forall `{Σ : cpp_logic} {σ : genv} (p : ptr) ty q hi bytes, @@ -49,9 +50,9 @@ Axiom object_bytesR_of_arrayLR : forall `{Σ : cpp_logic} {σ : genv} p |-> object_bytesR ty q bytes. Axiom object_bytes_anyR_of_anyR_array : forall `{Σ : cpp_logic} {σ : genv} - (p : ptr) ty n, - p |-> anyR (Tarray ty n) 1$m ⊢ - p |-> object_bytes_anyR ty (Z.of_N n). + (p : ptr) ty q n, + p |-> anyR (Tarray ty n) q ⊢ + p |-> object_bytes_anyR ty q (Z.of_N n). Lemma borrow_arrayR_cstringR `{Σ : cpp_logic, σ : genv} (p : ptr) q bytes s tail : @@ -212,10 +213,10 @@ Proof. Qed. Lemma arrayR_charR_arrayR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR 1$m c) xs ⊢ + (p : ptr) q xs : + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ p |-> arrayR (Tchar_ char_type.Cchar) - (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) q) (replicateN (lengthN xs) ()). Proof. revert p. @@ -235,28 +236,23 @@ Proof. Qed. Lemma arrayLR_charR_arrayLR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) n xs : - N.to_nat n = length xs -> - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) - (fun c : N => charR 1$m c) xs ⊢ - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (Z.of_N n) - (fun _ : unit => anyR (Tchar_ char_type.Cchar) 1$m) - (replicateN n ()). + (p : ptr) q xs : + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ xs) + (fun c : N => charR q c) xs ⊢ + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ xs) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) q) + (replicateN (lengthN xs) ()). Proof. - intros Hlen. rewrite arrayLR.unlock _at_sep. iIntros "[_ Harr]". rewrite _at_offsetR _at_sub_0; [|done]. - replace (replicateN n ()) with (replicateN (lengthN xs) ()) - by (rewrite /replicateN /lengthN -(N2Nat.id n) Hlen; reflexivity). - iPoseProof (arrayR_charR_arrayR_anyR with "Harr") as "Harr". + iPoseProof (arrayR_charR_arrayR_anyR _ q with "Harr") as "Harr". rewrite /arrayLR. iSplit. - iPureIntro. unfold lengthZ, lengthN, replicateN. rewrite length_replicate. - replace (length xs) with (N.to_nat n) by exact Hlen. - repeat rewrite N2Nat.id. + rewrite Nat2N.id. lia. - rewrite _at_offsetR _at_sub_0; [|done]. iExact "Harr". @@ -341,10 +337,10 @@ Proof. iExact "Hs". Qed. -Lemma arrayLR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : +Lemma arrayLR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) q n xs : N.to_nat n = length xs -> - p |-> arrayLR Tuchar 0 (Z.of_N n) (fun c : Z => ucharR 1$m c) xs ⊢ - p |-> anyR (Tarray Tuchar n) 1$m. + p |-> arrayLR Tuchar 0 (Z.of_N n) (fun c : Z => ucharR q c) xs ⊢ + p |-> anyR (Tarray Tuchar n) q. Proof. intros Hlen. rewrite arrayLR.unlock _at_sep. @@ -408,14 +404,14 @@ Ltac solve_memchr_side := end. Lemma object_bytesR_ucharR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) n xs : + (p : ptr) q n xs : N.to_nat n = length xs -> - p |-> object_bytesR Tuchar 1$m xs ⊢ - p |-> anyR (Tarray Tuchar n) 1$m. + p |-> object_bytesR Tuchar q xs ⊢ + p |-> anyR (Tarray Tuchar n) q. Proof. intros Hlen. iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (Z.of_N n) xs + iPoseProof (object_bytesR_to_arrayLR p Tuchar q (Z.of_N n) xs ltac:(apply lengthZ_of_to_nat_length; exact Hlen) with "Hs") as "Hs". iApply (arrayLR_ucharR_anyR with "Hs"). @@ -423,24 +419,24 @@ Proof. Qed. Lemma object_bytesR_ucharR_object_bytes_anyR - `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + `{Σ : cpp_logic, σ : genv} (p : ptr) q n xs : N.to_nat n = length xs -> - p |-> object_bytesR Tuchar 1$m xs ⊢ - p |-> object_bytes_anyR Tuchar (Z.of_N n). + p |-> object_bytesR Tuchar q xs ⊢ + p |-> object_bytes_anyR Tuchar q (Z.of_N n). Proof. intros Hlen. iIntros "Hs". - iPoseProof (object_bytesR_ucharR_anyR _ n xs Hlen with "Hs") as "Hs". + iPoseProof (object_bytesR_ucharR_anyR _ q n xs Hlen with "Hs") as "Hs". iApply (object_bytes_anyR_of_anyR_array with "Hs"). Qed. Lemma object_bytesR_ucharR_arrayR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> object_bytesR Tuchar 1$m xs ⊢ - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. + (p : ptr) q xs : + p |-> object_bytesR Tuchar q xs ⊢ + p |-> arrayR Tuchar (fun b : Z => ucharR q b) xs. Proof. iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ xs) xs + iPoseProof (object_bytesR_to_arrayLR p Tuchar q (lengthZ xs) xs eq_refl with "Hs") as "Hs". rewrite arrayLR.unlock _at_sep. iDestruct "Hs" as "[_ Hs]". @@ -448,11 +444,11 @@ Proof. Qed. Lemma at_arrayR_ucharR_cons `{Σ : cpp_logic, σ : genv} - (p : ptr) x xs : - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) (x :: xs) ⊣⊢ + (p : ptr) q x xs : + p |-> arrayR Tuchar (fun b : Z => ucharR q b) (x :: xs) ⊣⊢ p |-> type_ptrR Tuchar ∗ - p |-> ucharR 1$m x ∗ - p .[Tuchar ! 1] |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs. + p |-> ucharR q x ∗ + p .[Tuchar ! 1] |-> arrayR Tuchar (fun b : Z => ucharR q b) xs. Proof. rewrite arrayR_cons !_at_sep. rewrite _at_offsetR. @@ -480,22 +476,22 @@ Proof. Qed. Lemma arrayR_ucharR_arrayR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ - p |-> arrayR Tuchar (fun _ : unit => anyR Tuchar 1$m) + (p : ptr) q xs : + p |-> arrayR Tuchar (fun b : Z => ucharR q b) xs ⊢ + p |-> arrayR Tuchar (fun _ : unit => anyR Tuchar q) (replicateN (lengthN xs) ()). Proof. revert p. induction xs as [|x xs IH]. all: intros p. - rewrite /lengthN /= !arrayR_nil. reflexivity. - - rewrite (at_arrayR_ucharR_cons p x xs). + - rewrite (at_arrayR_ucharR_cons p q x xs). iIntros "(Hty & Hx & Hxs)". replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by (rewrite /lengthN Nat2N.inj_succ; reflexivity). rewrite replicateN_S. rewrite (at_arrayR_cons p Tuchar - (fun _ : unit => anyR Tuchar 1$m) () (replicateN (lengthN xs) ())). + (fun _ : unit => anyR Tuchar q) () (replicateN (lengthN xs) ())). iFrame "Hty". iSplitL "Hx". + iApply (at_ucharR_anyR with "Hx"). @@ -503,15 +499,15 @@ Proof. Qed. Lemma object_bytesR_ucharR_arrayLR_anyR - `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : + `{Σ : cpp_logic, σ : genv} (p : ptr) q n xs : N.to_nat n = length xs -> - p |-> object_bytesR Tuchar 1$m xs ⊢ + p |-> object_bytesR Tuchar q xs ⊢ p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun _ : unit => anyR Tuchar 1$m) (replicateN n ()). + (fun _ : unit => anyR Tuchar q) (replicateN n ()). Proof. intros Hlen. iIntros "Hs". - iPoseProof (object_bytesR_ucharR_arrayR with "Hs") as "Hs". + iPoseProof (object_bytesR_ucharR_arrayR p q xs with "Hs") as "Hs". rewrite arrayLR.unlock _at_sep. iSplit. - iPureIntro. @@ -555,9 +551,9 @@ Proof. iDestruct (observe (p .[Tuchar ! 1] |-> type_ptrR Tuchar) with "Hb") as "#Hty1". iApply arrayR_ucharR_object_bytesR. - rewrite (at_arrayR_ucharR_cons p a [b]). + rewrite (at_arrayR_ucharR_cons p 1$m a [b]). iFrame "Hty0 Ha". - rewrite (at_arrayR_ucharR_cons (p .[Tuchar ! 1]) b []). + rewrite (at_arrayR_ucharR_cons (p .[Tuchar ! 1]) 1$m b []). iFrame "Hty1 Hb". rewrite arrayR_nil _at_sep. iSplit. diff --git a/rocq-brick-libstdcpp/proof/cstring/spec.v b/rocq-brick-libstdcpp/proof/cstring/spec.v index fd9af22..a7977fd 100644 --- a/rocq-brick-libstdcpp/proof/cstring/spec.v +++ b/rocq-brick-libstdcpp/proof/cstring/spec.v @@ -224,7 +224,7 @@ Section with_cpp. (\arg{s_p} "__s" (Vptr s_p) \arg{c} "__c" (Vint c) \arg{n} "__n" (Vn n) - \pre{byte_ty} s_p |-> object_bytes_anyR byte_ty (Z.of_N n) + \pre{byte_ty} s_p |-> object_bytes_anyR byte_ty 1$m (Z.of_N n) \post[Vptr s_p] s_p |-> object_bytesR byte_ty 1$m (memset c (Z.of_N n))). @@ -235,7 +235,7 @@ Section with_cpp. \prepost{src_byte_ty q bytes} src_p |-> object_bytesR src_byte_ty q bytes \pre{dest_byte_ty} dest_p |-> - object_bytes_anyR dest_byte_ty (Z.of_N n) + object_bytes_anyR dest_byte_ty 1$m (Z.of_N n) \require lengthZ bytes = Z.of_N n \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m bytes). @@ -247,7 +247,7 @@ Section with_cpp. \prepost{src_byte_ty q bytes} src_p |-> object_bytesR src_byte_ty q bytes \pre{dest_byte_ty} dest_p |-> - object_bytes_anyR dest_byte_ty (Z.of_N n) + object_bytes_anyR dest_byte_ty 1$m (Z.of_N n) \require lengthZ bytes = Z.of_N n \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m bytes). diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index 8d96f0e..dad6359 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -11,7 +11,6 @@ Require Import skylabs.cpp.array. Import expr_join. #[local] Hint Resolve delayed_case.smash_delayed_case_B | 1000 : br_hints. #[local] Hint Resolve delayed_case.expr_join.smash_delayed_case_B | 1000 : br_hints. - (** END: SKYLABS DEFAULT PROOF IMPORTS *) Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.cstring.spec. @@ -25,9 +24,6 @@ Import refine_lib. Section with_cpp. Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. - (* Restored after the byte-array slice landed. This note records why these - proofs were parked temporarily during focused iteration. *) - cpp.spec "test_strlen()" default. Lemma test_strlen_ok : verify[module] "test_strlen()". Proof. verify_spec; go; ego. Qed. @@ -40,31 +36,478 @@ Section with_cpp. Lemma test_strncmp_ok : verify[module] "test_strncmp()". Proof. verify_spec; go; ego. Qed. + #[local] Fixpoint split_bytes_at_null (bytes : list N) : + option (list N * list N) := + match bytes with + | nil => None + | 0%N :: tail => Some (nil, tail) + | b :: rest => + match split_bytes_at_null rest with + | Some (prefix, tail) => Some (b :: prefix, tail) + | None => None + end + end. + + #[local] Lemma split_bytes_at_null_sound bytes prefix tail : + split_bytes_at_null bytes = Some (prefix, tail) -> + bytes = prefix ++ 0%N :: tail /\ + List.Forall (fun b => b <> 0%N) prefix. + Proof. + revert prefix tail. + induction bytes as [|b bytes IH]; intros prefix tail Hsplit; [done|]. + destruct b as [|p]. + - simpl in Hsplit. inversion Hsplit; subst. + split; [reflexivity|constructor]. + - simpl in Hsplit. + destruct (split_bytes_at_null bytes) as [[prefix' tail']|] eqn:Hrec; + [|done]. + inversion Hsplit; subst prefix tail. clear Hsplit. + specialize (IH _ _ eq_refl) as [Hbytes Hfor]. + split. + + simpl. rewrite Hbytes. reflexivity. + + constructor; [discriminate|exact Hfor]. + Qed. + + #[local] Lemma split_bytes_at_null_complete prefix tail : + List.Forall (fun b => b <> 0%N) prefix -> + split_bytes_at_null (prefix ++ 0%N :: tail) = Some (prefix, tail). + Proof. + induction prefix as [|b prefix IH]; intros Hfor. + - reflexivity. + - inversion Hfor as [|? ? Hb Hfor']; subst. + destruct b as [|p]; [done|]. + simpl. + rewrite (IH Hfor'). + reflexivity. + Qed. + + #[local] Lemma split_bytes_at_null_spec bytes prefix tail : + split_bytes_at_null bytes = Some (prefix, tail) <-> + bytes = prefix ++ 0%N :: tail /\ + List.Forall (fun b => b <> 0%N) prefix. + Proof. + split. + - apply split_bytes_at_null_sound. + - intros [-> Hfor]. + exact (split_bytes_at_null_complete _ _ Hfor). + Qed. + + #[local] Definition split_bytes_at_cstring (bytes : list N) : + option (list N * list N) := + match split_bytes_at_null bytes with + | Some (prefix, tail) => Some (prefix ++ [0%N], tail) + | None => None + end. + + #[local] Lemma split_bytes_at_cstring_sound bytes zs tail : + split_bytes_at_cstring bytes = Some (zs, tail) -> + bytes = zs ++ tail /\ + exists prefix, + zs = prefix ++ [0%N] /\ + List.Forall (fun b => b <> 0%N) prefix. + Proof. + rewrite /split_bytes_at_cstring. + destruct (split_bytes_at_null bytes) as [[prefix tail']|] eqn:Hsplit; + [|done]. + intros Hcstring. + inversion Hcstring; subst zs tail. clear Hcstring. + pose proof (split_bytes_at_null_sound _ _ _ Hsplit) as [-> Hfor]. + split. + - change (prefix ++ 0%N :: tail' = (prefix ++ 0%N :: nil) ++ tail'). + rewrite <- app_assoc. + reflexivity. + - eexists. split. + + reflexivity. + + exact Hfor. + Qed. + + #[local] Lemma split_bytes_at_cstring_complete prefix tail : + List.Forall (fun b => b <> 0%N) prefix -> + split_bytes_at_cstring (prefix ++ [0%N] ++ tail) = + Some (prefix ++ [0%N], tail). + Proof. + intros Hfor. + rewrite /split_bytes_at_cstring. + rewrite (split_bytes_at_null_complete prefix tail Hfor). + reflexivity. + Qed. + + #[local] Lemma split_bytes_at_cstring_spec bytes zs tail : + split_bytes_at_cstring bytes = Some (zs, tail) <-> + bytes = zs ++ tail /\ + exists prefix, + zs = prefix ++ [0%N] /\ + List.Forall (fun b => b <> 0%N) prefix. + Proof. + split. + - apply split_bytes_at_cstring_sound. + - intros [Hbytes [prefix [Hzs Hfor]]]. + subst zs bytes. + rewrite <- app_assoc. + exact (split_bytes_at_cstring_complete _ _ Hfor). + Qed. + + #[local] Fixpoint pack (zs : list N) : option cstring.t := + match zs with + | nil => None + | 0%N :: nil => Some BS.EmptyString + | 0%N :: _ => None + | b :: rest => + match Byte.of_N b, pack rest with + | Some ch, Some s => Some (BS.String ch s) + | _, _ => None + end + end. + + #[local] Lemma pack_sound zs s : + pack zs = Some s -> + cstring.to_zstring s = zs. + Proof. + revert s. + induction zs as [|b zs IH]; intros s Hpack; [done|]. + destruct b as [|p]. + - destruct zs as [|b zs]. + + simpl in Hpack. inversion Hpack; subst s. + rewrite cstring.to_zstring_unfold. + reflexivity. + + done. + - destruct (Byte.of_N (N.pos p)) as [ch|] eqn:Hbyte. + + destruct (pack zs) as [s'|] eqn:Hpack'. + * rewrite /pack Hbyte /= in Hpack. + fold pack in Hpack. + rewrite Hpack' in Hpack. + injection Hpack as <-. + pose proof (IH s' eq_refl) as Hzs. + rewrite cstring.to_zstring_unfold. + rewrite cstring.to_zstring_unfold in Hzs. + simpl. + rewrite Hzs. + assert (Hto : Byte.to_N ch = N.pos p). + { apply Byte.to_of_N. exact Hbyte. } + pose proof (Byte.to_N_bounded ch) as Hbound_le. + assert (Hbound : (Byte.to_N ch < 256)%N) by lia. + rewrite Ascii.ascii_of_byte_via_N. + rewrite (Ascii.N_ascii_embedding _ Hbound). + rewrite Hto. + reflexivity. + * rewrite /pack Hbyte /= in Hpack. + fold pack in Hpack. + rewrite Hpack' in Hpack. + discriminate. + + rewrite /pack Hbyte /= in Hpack. + discriminate. + Qed. + + #[local] Lemma pack_WF zs s : + pack zs = Some s -> + cstring.WF s. + Proof. + revert s. + induction zs as [|b zs IH]; intros s Hpack; [done|]. + destruct b as [|p]. + - destruct zs as [|b zs]. + + simpl in Hpack. inversion Hpack; subst s. + apply cstring.WF_nil. + + done. + - destruct (Byte.of_N (N.pos p)) as [ch|] eqn:Hbyte. + + destruct (pack zs) as [s'|] eqn:Hpack'. + * rewrite /pack Hbyte /= in Hpack. + fold pack in Hpack. + rewrite Hpack' in Hpack. + injection Hpack as <-. + pose proof (IH s' eq_refl) as Hwf'. + apply cstring.WF_cons. + { intro Hzero. + apply (f_equal Byte.to_N) in Hzero. + assert (Hto : Byte.to_N ch = N.pos p). + { apply Byte.to_of_N. exact Hbyte. } + rewrite Hto in Hzero. + discriminate. } + { exact Hwf'. } + * rewrite /pack Hbyte /= in Hpack. + fold pack in Hpack. + rewrite Hpack' in Hpack. + discriminate. + + rewrite /pack Hbyte /= in Hpack. + discriminate. + Qed. + + #[local] Definition unpack_cstring (bytes : list N) : + option (cstring.t * list N) := + match split_bytes_at_cstring bytes with + | Some (zs, tail) => + match pack zs with + | Some s => Some (s, tail) + | None => None + end + | None => None + end. + + #[local] Lemma unpack_cstring_sound bytes s tail : + unpack_cstring bytes = Some (s, tail) -> + bytes = cstring.to_zstring s ++ tail /\ + cstring.WF s. + Proof. + rewrite /unpack_cstring. + destruct (split_bytes_at_cstring bytes) as [[zs tail']|] eqn:Hsplit; + [|done]. + destruct (pack zs) as [s'|] eqn:Hpack; [|done]. + intros Hunpack. + inversion Hunpack; subst s tail. clear Hunpack. + pose proof (split_bytes_at_cstring_sound _ _ _ Hsplit) as [Hbytes _]. + pose proof (pack_sound _ _ Hpack) as Hzs. + pose proof (pack_WF _ _ Hpack) as Hwf. + split. + - rewrite Hbytes. + rewrite Hzs. + reflexivity. + - exact Hwf. + Qed. + + + (* Older accepted experiment kept only as a reminder that proof-bearing + binders inside [\proving{...}] are syntactically accepted. *) +(* + #[local] Lemma arrayLR_cstring bytes m tail (p : ptr) s : + bytes = cstring.to_zstring s ++ tail -> + cstring.WF s -> + p |-> arrayLR "char" 0 m (λ v : N, charR 1$m v) bytes ⊢ + p |-> cstring.R 1$m s ∗ + p |-> arrayLR "char" (m - Zlength tail) m (λ v : N, charR 1$m v) tail. +*) + + #[local] Lemma arrayLR_cstring q bytes m tail (p : ptr) s : + bytes = cstring.to_zstring s ++ tail -> + cstring.WF s -> + p |-> arrayLR "char" 0 m (λ v : N, charR q v) bytes ⊢ + [| m = lengthZ bytes |] ∗ + p |-> cstring.R q s ∗ + p |-> arrayLR "char" (m - lengthZ tail) m (λ v : N, charR q v) tail. + Proof. + intros -> Hwf. + rewrite arrayLR.unlock _at_sep lengthN_app. + arith_simpl. + iIntros "[%Hlen Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + rewrite arrayR_app__N. + iDestruct "Harr" as "[Hs Htail]". + assert (H: m - lengthZ tail = lengthZ (cstring.to_zstring s)) by lia. + rewrite H /cstring.R /zstring.R. iFrame. done. + Qed. + Hint Resolve arrayLR_cstring : sl_opacity. + + #[local] Lemma cstring_arrayLR q bytes m tail (p : ptr) s : + bytes = cstring.to_zstring s ++ tail -> + cstring.WF s -> + [| m = lengthZ bytes |] ∗ + p |-> cstring.R q s ∗ + p |-> arrayLR "char" (m - lengthZ tail) m (λ v : N, charR q v) tail ⊢ + p |-> arrayLR "char" 0 m (λ v : N, charR q v) bytes. + Proof. + intros -> Hwf. work. arith_simpl. + rewrite lengthN_app. arith_simpl. + rewrite /cstring.R /zstring.R. work. + rewrite arrayLR.unlock. arith_simpl. work. + rewrite _at_sub_0; [trivial|done]. + Qed. + Hint Resolve cstring_arrayLR : sl_opacity. + + #[local, program] Definition arrayLR_open_cstring_C + (p : ptr) q k bytes tail + (Hex : exists s, unpack_cstring bytes = Some (s, tail)) := + \cancelx + \consuming p |-> arrayLR "char" 0 k + (λ v : N, charR q v) bytes + \proving{s (Hunpack : unpack_cstring bytes = Some (s, tail))} + p |-> cstring.R q s + \deduce p |-> arrayLR "char" (k - lengthZ tail) k + (λ v : N, charR q v) tail + \end@{mpred}. + Next Obligation. + intros p q k bytes tail [s0 Hunpack0]. + iIntros "Harr". + pose proof (unpack_cstring_sound _ _ _ Hunpack0) as [Hbytes0 Hwf0]. + iPoseProof (arrayLR_cstring q bytes k tail p s0 Hbytes0 Hwf0 with "Harr") + as "(%Hk & Hs0 & Htail)". + iFrame "Htail". + iIntros (s Hunpack). + rewrite Hunpack0 in Hunpack. + injection Hunpack as <-. + iExact "Hs0". + Qed. + #[local] Hint Resolve arrayLR_open_cstring_C : sl_opacity. + + #[local, program] Definition arrayLR_close_cstring_C + (p : ptr) q mid k tail s + (Hmid : mid = lengthZ (cstring.to_zstring s)) + (Htailk : mid = k - lengthZ tail) := + \cancelx + \consuming p |-> cstring.R q s + \consuming p |-> arrayLR "char" mid k (λ v : N, charR q v) tail + \proving p |-> arrayLR "char" 0 k + (λ _ : unit, anyR "char" q) (replicateN (Z.to_N k) ()) + \end@{mpred}. + Next Obligation. + intros p q mid k tail s Hmid Htailk. + iIntros "[Hs Htail]". + rewrite /cstring.R /zstring.R. + iDestruct "Hs" as "[Hs %Hwf]". + assert (Hk : k = lengthZ (cstring.to_zstring s ++ tail)). + { rewrite lengthN_app. arith_simpl. lia. } + clear Hmid. + subst mid. + iPoseProof + (cstring_arrayLR q (cstring.to_zstring s ++ tail) k tail p s eq_refl Hwf + with "[Hs Htail]") + as "Harr". + { iSplit. + - iPureIntro. exact Hk. + - rewrite /cstring.R /zstring.R. + iSplitL "Hs". + + iFrame. iPureIntro. exact Hwf. + + iFrame "Htail". } + rewrite Hk N2Z.id. + iPoseProof (arrayLR_charR_arrayLR_anyR _ q (cstring.to_zstring s ++ tail) + with "Harr") as "Harr". + iExact "Harr". + Qed. + #[local] Hint Resolve arrayLR_close_cstring_C : sl_opacity. + + (* These byte-side wrappers are proved and registered, but in the current + [test_memset_ok] proof they still do not fire automatically at the + call-precondition branches where the target is [object_bytes_anyR]. *) + #[local, program] Definition object_bytesR_object_bytes_any_C + (p : ptr) q bytes := + \cancelx + \consuming p |-> object_bytesR Tuchar q bytes + \proving{n (Hlen : n = lengthN bytes)} + p |-> object_bytes_anyR Tuchar q (Z.of_N n) + \end@{mpred}. + Next Obligation. + intros p q bytes. + iIntros "Hbytes" (n Hlen). + iApply (object_bytesR_ucharR_object_bytes_anyR _ q n bytes). + - rewrite Hlen. + rewrite /lengthN Nat2N.id. + reflexivity. + - iExact "Hbytes". + Qed. + #[local] Hint Resolve object_bytesR_object_bytes_any_C : sl_opacity. + + #[local, program] Definition object_bytesR_arrayLR_any_C + (p : ptr) q bytes := + \cancelx + \consuming p |-> object_bytesR Tuchar q bytes + \proving{n (Hlen : n = lengthN bytes)} + p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun _ : unit => anyR Tuchar q) (replicateN n ()) + \end@{mpred}. + Next Obligation. + intros p q bytes. + iIntros "Hbytes" (n Hlen). + iApply (object_bytesR_ucharR_arrayLR_anyR _ q n bytes). + - rewrite Hlen. + rewrite /lengthN Nat2N.id. + reflexivity. + - iExact "Hbytes". + Qed. + #[local] Hint Resolve object_bytesR_arrayLR_any_C : sl_opacity. + + #[local] Lemma at_uchar_offset_eq + (p : ptr) i j (R : Rep) : + i = j -> + p |-> .[Tuchar ! i] |-> R ⊢ + p |-> .[Tuchar ! j] |-> R. + Proof. + intros ->. reflexivity. + Qed. + + (* + Experimental variants that internalize the unpack witness more aggressively. + + Both [arrayLR_open_cstring_guard_C] and [arrayLR_open_cstring_using_C] are + provable, but in this file they do not fire under [go]/[ego] at the + [test_strlen_array_buffer()] call site, even when the matching pure + existence fact is supplied explicitly in the proof context. We therefore + keep them parked for design/reference purposes and continue using the + simpler [arrayLR_open_cstring_C] together with an explicit [Hex] witness in + the verification proof. + + #[local, program] Definition arrayLR_open_cstring_guard_C + (p : ptr) q k bytes := + \cancelx + \guard (exists stail, unpack_cstring bytes = Some stail) + \consuming p |-> arrayLR "char" 0 k + (λ v : N, charR q v) bytes + \deduce{stail} [| unpack_cstring bytes = Some stail |] + \bound_existential s + \proving p |-> cstring.R q s + \instantiate s := fst stail + \deduce p |-> arrayLR "char" (k - lengthZ (snd stail)) k + (λ v : N, charR q v) (snd stail) + \end@{mpred}. + Next Obligation. + intros p q k bytes [stail Hunpack0]. + destruct stail as [s0 tail0]. + iIntros "Harr". + pose proof (unpack_cstring_sound _ _ _ Hunpack0) as [Hbytes0 Hwf0]. + iPoseProof (arrayLR_cstring q bytes k tail0 p s0 Hbytes0 Hwf0 with "Harr") + as "(%Hk & Hs0 & Htail)". + iExists (s0, tail0). + iSplitL "Htail". + { iSplit. + - iPureIntro. exact Hunpack0. + - iFrame. } + iIntros (??). subst. + cbn. + iIntros (?). + subst. + iExact "Hs0". + Qed. + + #[local, program] Definition arrayLR_open_cstring_using_C + (p : ptr) q k bytes := + \cancelx + \using [| exists stail, unpack_cstring bytes = Some stail |] + \consuming p |-> arrayLR "char" 0 k + (λ v : N, charR q v) bytes + \deduce{stail} [| unpack_cstring bytes = Some stail |] + \bound_existential s + \proving p |-> cstring.R q s + \instantiate s := fst stail + \deduce p |-> arrayLR "char" (k - lengthZ (snd stail)) k + (λ v : N, charR q v) (snd stail) + \end@{mpred}. + Next Obligation. + iIntros (p q k bytes) "[%Hex Harr]". + destruct Hex as [[s0 tail0] Hunpack0]. + pose proof (unpack_cstring_sound _ _ _ Hunpack0) as [Hbytes0 Hwf0]. + iPoseProof (arrayLR_cstring q bytes k tail0 p s0 Hbytes0 Hwf0 with "Harr") + as "(%Hk & Hs0 & Htail)". + iExists (s0, tail0). + iSplitL "Htail". + { iSplit. + - iPureIntro. exact Hunpack0. + - iFrame. } + iIntros (??). subst. + cbn. + iIntros (?). + subst. + iExact "Hs0". + Qed. + *) + cpp.spec "test_strlen_array_buffer()" default. Lemma test_strlen_array_buffer_ok : verify[module] "test_strlen_array_buffer()". Proof. verify_spec; go. - iPoseProof (borrow_arrayLR_cstringR _ _ - (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) "ab"%bs - [99%N; 100%N; 0%N] eq_refl - ltac:(apply cstring.WF_cons; - [change (Byte.x61 <> Byte.x00); congruence|]; - apply cstring.WF_cons; - [change (Byte.x62 <> Byte.x00); congruence|]; - apply cstring.WF_nil) with "[$]") - as "[Hs Hclose]". - iExists _, "ab"%bs. iFrame "Hs". - iSplit; [go|]. - iIntros "Hs". - iPoseProof ("Hclose" with "Hs") as "Harr". - iPoseProof (arrayLR_charR_arrayLR_anyR _ 6%N - (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) - ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") - as "Harr". - go. - iFrame "Harr". - go. + assert (Hex : + exists s, + unpack_cstring + (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) = + Some (s, [99%N; 100%N; 0%N])) by (eexists; reflexivity). + ego. Qed. cpp.spec "test_strcmp_array_buffer()" default. @@ -72,39 +515,17 @@ Section with_cpp. verify[module] "test_strcmp_array_buffer()". Proof. verify_spec; go. - iPoseProof (borrow_arrayLR_cstringR _ _ - (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) "ab"%bs - [120%N; 0%N] eq_refl - ltac:(apply cstring.WF_cons; - [change (Byte.x61 <> Byte.x00); congruence|]; - apply cstring.WF_cons; - [change (Byte.x62 <> Byte.x00); congruence|]; - apply cstring.WF_nil) with "[$]") - as "[Hx Hclosex]". - iPoseProof (borrow_arrayLR_cstringR _ _ - (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) "ab"%bs - [121%N; 0%N] eq_refl - ltac:(apply cstring.WF_cons; - [change (Byte.x61 <> Byte.x00); congruence|]; - apply cstring.WF_cons; - [change (Byte.x62 <> Byte.x00); congruence|]; - apply cstring.WF_nil) with "[$]") - as "[Hy Hclosey]". - iExists _, "ab"%bs, _, "ab"%bs. iFrame "Hx Hy". - iIntros "[Hx Hy]". - iPoseProof ("Hclosex" with "Hx") as "Harrx". - iPoseProof ("Hclosey" with "Hy") as "Harry". - iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N - (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) - ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harrx") - as "Harrx". - iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N - (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) - ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harry") - as "Harry". - go. - iFrame "Harrx Harry". - go. + assert (Hex : + exists s, + unpack_cstring + (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) = + Some (s, [120%N; 0%N])) by (eexists; reflexivity). + assert (Hey : + exists s, + unpack_cstring + (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) = + Some (s, [121%N; 0%N])) by (eexists; reflexivity). + ego. Qed. cpp.spec "test_strncmp_array_buffer()" default. @@ -112,39 +533,17 @@ Section with_cpp. verify[module] "test_strncmp_array_buffer()". Proof. verify_spec; go. - iPoseProof (borrow_arrayLR_cstringR _ _ - (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) "ab"%bs - [120%N; 0%N] eq_refl - ltac:(apply cstring.WF_cons; - [change (Byte.x61 <> Byte.x00); congruence|]; - apply cstring.WF_cons; - [change (Byte.x62 <> Byte.x00); congruence|]; - apply cstring.WF_nil) with "[$]") - as "[Hx Hclosex]". - iPoseProof (borrow_arrayLR_cstringR _ _ - (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) "ab"%bs - [121%N; 0%N] eq_refl - ltac:(apply cstring.WF_cons; - [change (Byte.x61 <> Byte.x00); congruence|]; - apply cstring.WF_cons; - [change (Byte.x62 <> Byte.x00); congruence|]; - apply cstring.WF_nil) with "[$]") - as "[Hy Hclosey]". - iExists _, "ab"%bs, _, "ab"%bs. iFrame "Hx Hy". - iIntros "[Hx Hy]". - iPoseProof ("Hclosex" with "Hx") as "Harrx". - iPoseProof ("Hclosey" with "Hy") as "Harry". - iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N - (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) - ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harrx") - as "Harrx". - iPoseProof (arrayLR_charR_arrayLR_anyR _ 5%N - (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) - ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harry") - as "Harry". - go. - iFrame "Harrx Harry". - go. + assert (Hex : + exists s, + unpack_cstring + (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) = + Some (s, [120%N; 0%N])) by (eexists; reflexivity). + assert (Hey : + exists s, + unpack_cstring + (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) = + Some (s, [121%N; 0%N])) by (eexists; reflexivity). + ego. Qed. cpp.spec "test_strchr()" default. @@ -190,115 +589,517 @@ Section with_cpp. Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". Proof. verify_spec; go. Qed. + (* + Planned Family A automation structure for [test_memset()]. + + The intended reusable shape is: + + - an outer entry wrapper from the stack-array [arrayLR] view to one wrapped + [object_bytesR] view + - a core opening principle for a writable subrange inside a wrapped byte + region, where the split is computed canonically from the consumed [bytes] + using [takeZ]/[dropZ] + - a core closing principle that rebuilds one wrapped byte region after the + call from preserved prefix, modified middle, and preserved suffix + + This should let instruction 1 be handled as: + + 1. wrap the initial array into one [object_bytesR] + 2. open the target subrange for the mutating call + 3. close the post-call modified bytes back into one [object_bytesR] + + and instruction 6 should reuse the same core open/close pair, differing + only in the chosen offset and active length. + + #[local, program] Definition arrayLR_wrap_object_bytesR_C + (p : ptr) ty q bytes := + \cancelx + \consuming p |-> arrayLR ty 0 (lengthZ bytes) + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytesR ty q bytes + \end@{mpred}. + + #[local, program] Definition object_bytesR_open_range_any_C + (p : ptr) ty q off len bytes := + \cancelx + \using [| 0 <= off |] + \using [| 0 <= len |] + \using [| off + len <= lengthZ bytes |] + \consuming p |-> object_bytesR ty q bytes + \proving p .[ty ! off] |-> object_bytes_anyR ty q len + \deduce p |-> object_bytesR ty q (takeZ off bytes) + \deduce p .[ty ! (off + len)] |-> + object_bytesR ty q (dropZ (off + len) bytes) + \end@{mpred}. + + #[local, program] Definition object_bytesR_close_range_C + (p : ptr) ty q prefix ys suffix := + \cancelx + \consuming p |-> object_bytesR ty q prefix + \consuming p .[ty ! lengthZ prefix] |-> object_bytesR ty q ys + \consuming p .[ty ! (lengthZ prefix + lengthZ ys)] |-> + object_bytesR ty q suffix + \proving p |-> object_bytesR ty q (prefix ++ ys ++ suffix) + \end@{mpred}. + + Design notes: + - [arrayLR_wrap_object_bytesR_C] is only the outer boundary adapter; it is + not the core mutating-call automation. + - [object_bytesR_open_range_any_C] should only be considered where the + goal is specifically [object_bytes_anyR], which helps avoid eager firing + in the read-only assert steps. + - the opener is phrased in terms of [off] and [len] because those are the + parameters the next instruction naturally determines; the left prefix, + active middle slice, and right suffix are then the canonical split + [takeZ off bytes], [takeZ len (dropZ off bytes)], and + [dropZ (off + len) bytes]. + - [object_bytesR_close_range_C] is the candidate wrapped-state + reestablishment step between instructions. + - if these become real hints, the likely first use is still local to this + proof family; broad installation would risk spurious firing in other + byte-API clients. + *) + + (* + Parked experiments. These are useful design sketches, but they are not the + right live automation surface for the current [memset] work: + [arrayLR_wrap_object_bytesR_C] does not fire even on an exact standalone + [arrayLR ⊢ object_bytesR] goal, and [object_bytesR_open_range_any_C] does + not fire on the standalone range-opening workspaces. Keep them aborted + rather than admitted. + + #[local, program] Definition arrayLR_wrap_object_bytesR_C + (p : ptr) ty q n bytes := + \cancelx + \consuming p |-> arrayLR ty 0 n + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytesR ty q bytes + \end@{mpred}. + Next Obligation. + intros p ty q n bytes. iIntros "X". + iApply object_bytesR_of_arrayLR. 2: iFrame. + Abort. + + #[local, program] Definition object_bytesR_open_range_any_C + (p : ptr) ty q off len bytes := + \cancelx + \using [| 0 <= off |] + \using [| 0 <= len |] + \using [| off + len <= lengthZ bytes |] + \consuming p |-> object_bytesR ty q bytes + \proving p .[ty ! off] |-> object_bytes_anyR ty q len + \deduce p |-> object_bytesR ty q (takeZ off bytes) + \deduce p .[ty ! (off + len)] |-> + object_bytesR ty q (dropZ (off + len) bytes) + \end@{mpred}. + Next Obligation. + intros p ty q off len bytes. + iIntros "[%Hoff [%Hlen [%Hbytes H]]]". + (*iRewrite - (takeN_dropN) in "H". + iPoseProof (object_bytesR_prefix_tail0 p ty q (takeZ off bytes) (dropZ off bytes)) as "X".*) + Abort. + *) + + #[local, program] Definition arrayLR_open_prefix_any_C + (p : ptr) q len n bytes + (Hlen : 0 <= len <= n) := + \cancelx + \consuming p |-> arrayLR Tuchar 0 n + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytes_anyR Tuchar q len + \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) + \end@{mpred}. + Next Obligation. + intros p q len n bytes Hlen. + rewrite arrayLR.unlock _at_sep. arith_simpl. + iIntros "[%Hn Hbytes]". + rewrite _at_offsetR _at_sub_0; [|done]. + assert (HnN : lengthN bytes = Z.to_N n) by lia. + assert (Htake : lengthN (takeZ len bytes) = Z.to_N len). + { rewrite /takeZ lengthN_takeN HnN. + apply N.min_l. + apply Z2N.inj_le; lia. } + assert (Hsplit : takeZ len bytes ++ dropZ len bytes = bytes) + by exact (takeN_dropN (Z.to_N len) bytes). + iAssert (p |-> arrayR Tuchar (fun v : Z => ucharR q v) + (takeZ len bytes ++ dropZ len bytes)) + with "[Hbytes]" as "Hbytes". + { rewrite Hsplit. iExact "Hbytes". } + iEval (rewrite (@arrayR_app__N _ _ _ _ Z (fun v : Z => ucharR q v) Tuchar + (takeZ len bytes) (dropZ len bytes))) in "Hbytes". + iDestruct "Hbytes" as "[Hpre Htail]". + iAssert (p |-> object_bytesR Tuchar q (takeZ len bytes)) + with "[Hpre]" as "Hpre_bytes". + { iApply (object_bytesR_of_arrayLR p Tuchar q len (takeZ len bytes)). + lia. + rewrite arrayLR.unlock _at_sep _at_offsetR _at_sub_0 ; [ work; iFrame | done]. } + iPoseProof (object_bytesR_ucharR_object_bytes_anyR p q + (lengthN (takeZ len bytes)) (takeZ len bytes) + ltac:(rewrite Nat2N.id; reflexivity) with "Hpre_bytes") as "Hpre_any". + rewrite Htake Z2N.id; [ | lia]. iFrame. + iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q + (lengthZ (dropZ len bytes)) + (dropZ len bytes) eq_refl). + rewrite arrayLR.unlock. arith_simpl. work; iFrame. + Qed. + #[local] Hint Resolve arrayLR_open_prefix_any_C | 1000 : sl_opacity. + + #[local, program] Definition arrayLR_open_prefix_bytes_C + (p : ptr) q len n bytes + (Hlen : 0 <= len <= n) := + \cancelx + \consuming p |-> arrayLR Tuchar 0 n + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytesR Tuchar q (takeZ len bytes) + \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) + \end@{mpred}. + Next Obligation. + intros p q len n bytes Hlen. + rewrite arrayLR.unlock _at_sep. arith_simpl. + rewrite _at_offsetR _at_sub_0; [|done]. + iIntros "[%Hn Hbytes]". + assert (HnN : lengthN bytes = Z.to_N n) by lia. + assert (Htake : lengthN (takeZ len bytes) = Z.to_N len). + { rewrite /takeZ lengthN_takeN HnN. + apply N.min_l. + apply Z2N.inj_le; lia. } + assert (Hsplit : takeZ len bytes ++ dropZ len bytes = bytes) + by exact (takeN_dropN (Z.to_N len) bytes). + iAssert (p |-> arrayR Tuchar (fun v : Z => ucharR q v) + (takeZ len bytes ++ dropZ len bytes)) + with "[Hbytes]" as "Hbytes". + { rewrite Hsplit. iExact "Hbytes". } + iEval (rewrite (@arrayR_app__N _ _ _ _ Z (fun v : Z => ucharR q v) Tuchar + (takeZ len bytes) (dropZ len bytes))) in "Hbytes". + iDestruct "Hbytes" as "[Hpre Htail]". + iAssert (p |-> object_bytesR Tuchar q (takeZ len bytes)) + with "[Hpre]" as "Hpre_bytes". + { iApply (object_bytesR_of_arrayLR p Tuchar q len (takeZ len bytes)). + lia. + rewrite arrayLR.unlock _at_sep _at_offsetR _at_sub_0; [work; iFrame | done]. } + iFrame "Hpre_bytes". + iPoseProof (at_uchar_offset_eq p (lengthZ (takeZ len bytes)) len + (arrayR Tuchar (fun v : Z => ucharR q v) (dropZ len bytes)) + ltac:(unfold lengthZ; rewrite Htake; apply Z2N.id; lia) + with "Htail") as "Htail". + iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q + (lengthZ (dropZ len bytes)) + (dropZ len bytes) eq_refl). + rewrite arrayLR.unlock. arith_simpl. work; iFrame. + Qed. + #[local] Hint Resolve arrayLR_open_prefix_bytes_C | 1000 : sl_opacity. + + (* + The generic wrapper/openers above are useful proof principles, but the + workspace lemmas below show a mixed picture: + - both the earlier [lengthZ bytes]-surface and the newer [n]-surface for + [arrayLR_wrap_object_bytesR_C] fail to fire even on an exact standalone + [arrayLR ⊢ object_bytesR] goal. + - [object_bytesR_open_range_any_C] likewise leaves the standalone range + goals unchanged, even when the relevant bounds are available as ordinary + Rocq hypotheses. + - the earlier [lengthZ bytes]-surface for [arrayLR_open_prefix_any_C] left + both the real first-call state and the standalone prefix-opening goals + unchanged. + - the newer [n]-surface for [arrayLR_open_prefix_any_C] does move the real + [verify_spec] first-call workspace to the post-call state, but it still + does not solve the standalone prefix-opening toy goals. + - so the best current reading is that a sufficiently direct opener can be + useful at the real mutating-call surface even if it is not a generally + useful entailment hint. + *) + + (* + Parked experiments that are no longer needed to reach the current memset + workspace state. + + #[local, program] Definition memset_open_2_C (p : ptr) := + \cancelx + \consuming p |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z] + \proving p |-> object_bytes_anyR Tuchar 1$m 2 + \deduce p .[Tuchar ! 2] |-> object_bytesR Tuchar 1$m [99%Z; 100%Z] + \end@{mpred}. + Next Obligation. Admitted. + + #[local] Lemma object_bytesR_read_head_after_open + (p : ptr) q off x xs suffix : + p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) ∗ + p .[Tuchar ! (off + 1 + lengthZ xs)] |-> object_bytesR Tuchar q suffix ⊢ + p .[Tuchar ! off] |-> primR Tuchar q (Vint x) ∗ + p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix). + Admitted. + *) + + #[local] Lemma object_bytesR_read_head_uchar_after_open + (p : ptr) q off x xs suffix : + p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) ∗ + p .[Tuchar ! (off + lengthZ (x :: xs))] |-> object_bytesR Tuchar q suffix ⊢ + p .[Tuchar ! off] |-> ucharR q x ∗ + p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix). + Proof. + iIntros "[Hhead Hsuffix]". + assert (Hhead_total : lengthZ (x :: xs) = 1 + lengthZ xs). + { assert (Hlen_consN : lengthN (x :: xs) = N.succ (lengthN xs)). + { unfold lengthN. + simpl. + rewrite Nat2N.inj_succ. + reflexivity. } + unfold lengthZ. + rewrite Hlen_consN. + destruct (lengthN xs); simpl; lia. } + iPoseProof (at_uchar_offset_add_intro p off (1 + lengthZ xs) + (off + lengthZ (x :: xs)) (object_bytesR Tuchar q suffix) + ltac:(rewrite Hhead_total; lia) with "Hsuffix") as "Hsuffix". + iPoseProof (at_uchar_offset_add_intro (p .[Tuchar ! off]) 1 (lengthZ xs) + (1 + lengthZ xs) (object_bytesR Tuchar q suffix) + ltac:(lia) with "Hsuffix") as "Hsuffix". + iPoseProof ((object_bytesR_prefix_tail0 (p .[Tuchar ! off]) Tuchar q + 1 (1 + lengthZ xs) [x] xs + ltac:(rewrite Hhead_total; reflexivity) + ltac:(reflexivity) ltac:(lia)) + with "Hhead") as "[Hx Hxs]". + iPoseProof (object_bytesR_ucharR_arrayR (p .[Tuchar ! off]) q [x] + with "Hx") as "Hx". + iPoseProof (at_arrayR_ucharR_cons (p .[Tuchar ! off]) q x [] with "Hx") + as "(#Hty & Hx & _)". + assert (Hxs_suffix_total : lengthZ (xs ++ suffix) = lengthZ xs + lengthZ suffix). + { assert (Hsum : lengthZ (xs ++ suffix) = Z.of_N (lengthN xs + lengthN suffix)). + { apply lengthZ_of_to_nat_length. + rewrite N2Nat.inj_add. + unfold lengthN. + rewrite !Nat2N.id. + rewrite List.length_app. + reflexivity. } + rewrite Hsum. + unfold lengthZ. + destruct (lengthN xs), (lengthN suffix); simpl; lia. } + assert (Hsuffix_len : lengthZ suffix = lengthZ (xs ++ suffix) - lengthZ xs) by lia. + iPoseProof ((object_bytesR_prefix_tail0 (p .[Tuchar ! off] .[Tuchar ! 1]) + Tuchar q (lengthZ xs) (lengthZ (xs ++ suffix)) xs suffix + ltac:(reflexivity) ltac:(reflexivity) ltac:(exact Hsuffix_len)) + with "[$Hxs $Hsuffix]") as "Hrest". + iPoseProof (at_uchar_offset_add_elim p off 1 (off + 1) + (object_bytesR Tuchar q (xs ++ suffix)) ltac:(lia) with "Hrest") + as "Hrest". + iFrame "Hx Hrest". + Qed. + + #[local] Lemma object_bytesR_ucharR_ucharR_arrayLR_anyR + (p : ptr) prefix x y : + p |-> object_bytesR Tuchar 1$m prefix ∗ + p .[Tuchar ! lengthZ prefix] |-> ucharR 1$m x ∗ + p .[Tuchar ! (lengthZ prefix + 1)] |-> ucharR 1$m y ⊢ + p |-> arrayLR Tuchar 0 (lengthZ (prefix ++ [x; y])) + (fun _ : unit => anyR Tuchar 1$m) + (replicateN (lengthN (prefix ++ [x; y])) ()). + Proof. + iIntros "(Hprefix & Hx & Hy)". + iPoseProof (at_uchar_offset_add_intro p (lengthZ prefix) 1 + (lengthZ prefix + 1) (ucharR 1$m y) ltac:(lia) with "Hy") as "Hy". + iPoseProof (uchar_cells_object_bytesR_two (p .[Tuchar ! lengthZ prefix]) x y + with "[$Hx $Hy]") as "Htail". + assert (Htail_len : lengthZ [x; y] = lengthZ (prefix ++ [x; y]) - lengthZ prefix). + { assert (HsumN : lengthN (prefix ++ [x; y]) = (lengthN prefix + lengthN [x; y])%N). + { unfold lengthN. + rewrite List.length_app Nat2N.inj_add. + reflexivity. } + unfold lengthZ. + rewrite HsumN. + simpl. + destruct (lengthN prefix); simpl; lia. } + iPoseProof ((object_bytesR_prefix_tail0 p Tuchar 1$m + (lengthZ prefix) (lengthZ (prefix ++ [x; y])) prefix [x; y] + ltac:(reflexivity) ltac:(reflexivity) ltac:(exact Htail_len)) + with "[$Hprefix $Htail]") as "Hall". + iApply (object_bytesR_ucharR_arrayLR_anyR _ 1$m (lengthN (prefix ++ [x; y])) + (prefix ++ [x; y])). + rewrite Nat2N.id. reflexivity. + iExact "Hall". + Qed. + + (* + Parked read-step automation experiments. They were useful to probe whether + the first read after opening could be automated directly, but they are not + needed to reach the current best workspace checkpoint below. + + #[local, program] Definition object_bytesR_read_head_C + (p : ptr) q off x xs suffix := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) + \consuming p .[Tuchar ! (off + 1 + lengthZ xs)] |-> + object_bytesR Tuchar q suffix + \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint x) + \deduce p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + + #[local, program] Definition object_bytesR_read_head_bytes_C + (p : ptr) q off n bytes suffix + (Hn : n = lengthZ bytes) + (Hlen : 1 <= n) := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes + \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix + \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint (hd 0 bytes)) + \deduce p .[Tuchar ! (off + 1)] |-> + object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + + #[local, program] Definition object_bytesR_read_head_assert_C + (p : ptr) q off n bytes suffix + (Hn : n = lengthZ bytes) + (Hlen : 1 <= n) := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes + \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix + \bound k + \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint (hd 0 bytes)) + \goal_trigger (p .[Tuchar ! off] |-> + primR Tuchar q (Vint (hd 0 bytes)) -∗ k) + \deduce p .[Tuchar ! (off + 1)] |-> + object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve object_bytesR_read_head_assert_C | 1000 : sl_opacity. + + #[local, program] Definition object_bytesR_read_head_assert_exact_C + (p : ptr) q off n bytes suffix + (Hn : n = lengthZ bytes) + (Hlen : 1 <= n) := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes + \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix + \bound k + \bound_existential q' + \bound_existential v + \instantiate q' := q + \instantiate v := Vint (hd 0 bytes) + \proving p .[Tuchar ! off] |-> primR Tuchar q' v + \goal_trigger (p .[Tuchar ! off] |-> primR Tuchar q' v -∗ k) + \whole_conclusion + \deduce p .[Tuchar ! (off + 1)] |-> + object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve object_bytesR_read_head_assert_exact_C | 1000 : sl_opacity. + + #[local, program] Definition ucharR_assert_read_B + (p : ptr) q x := + \cancelx + \bound k + \proving p |-> primR Tuchar q (Vint x) ∗ + (p |-> primR Tuchar q (Vint x) -∗ k) + \through p |-> ucharR q x ∗ + (p |-> ucharR q x -∗ k) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve ucharR_assert_read_B | 1000 : sl_opacity. + + #[local, program] Definition ucharR_assert_read_C + (p : ptr) q x := + \cancelx + \consuming p |-> ucharR q x + \bound k + \proving p |-> primR Tuchar q (Vint x) + \goal_trigger (p |-> primR Tuchar q (Vint x) -∗ k) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve ucharR_assert_read_C | 1000 : sl_opacity. + *) + cpp.spec "test_memset()" default. Lemma test_memset_ok : verify[module] "test_memset()". Proof using MOD _Σ thread_info Σ σ. verify_spec; go. - iDestruct select (s_addr |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hs". - iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) - 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hs") as "Hs". - - iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + iExists Tuchar. + ego. + change (memset 120 2) with [120%Z; 120%Z]. + change (lengthZ [120%Z; 120%Z]) with 2%Z. + iAssert ( + s_addr .[Tuchar ! 2] |-> object_bytesR Tuchar 1$m + (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]))%I with "[$]" as "Htail". + iPoseProof (at_zero_intro s_addr + (object_bytesR Tuchar 1$m [120%Z; 120%Z]) with "[$]") as "Hmid". + iPoseProof (object_bytesR_read_head_uchar_after_open + s_addr (cQp.mk false 1%Qp) 0 120%Z [120%Z] + (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) + with "[$Hmid $Htail]") as "[H0 Hrest]". + (* Read back the first modified byte: [assert(s[0] == 'x');]. *) + iSplitL "H0"; [ iExact "H0" | iIntros "H0"]. + (* Now we are onto the next C++ instruction: [assert(s[1] == 'x');]. *) + go. + iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 1]) 120%Z + (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with "Hrest") + as "[[#Hty1 H1] Hrest]". + iPoseProof (at_zero_elim (s_addr .[Tuchar ! 1]) with "H1") as "H1". + (* Read back the second modified byte: [assert(s[1] == 'x');]. *) + iExists (Vint 120%Z), (cQp.mk false 1%Qp); iFrame "H1"; iIntros "H1". + (* Now we are onto the next C++ instruction: [assert(s[2] == 'c');]. *) + go. + change (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with [99%Z; 100%Z]. + change (lengthZ (120%Z :: [99%Z; 100%Z])) with 3%Z. + iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 1 3 + (fun b : Z => ucharR 1$m b) 99%Z [100%Z])) in "Hrest". + iDestruct "Hrest" as "[[#Hty2 H2] Hrest]". + iPoseProof (at_uchar_offset_add_elim s_addr 1 1 2 + (ucharR 1$m 99%Z) ltac:(lia) with "H2") as "H2". + iExists (Vint 99%Z), (cQp.mk false 1%Qp); iFrame "H2"; iIntros "H2". + (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) + go. + iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 2 3 + (fun b : Z => ucharR 1$m b) 100%Z [])) in "Hrest". + iDestruct "Hrest" as "[[#Hty3 H3] _]". + iPoseProof (at_uchar_offset_add_elim s_addr 1 2 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3"; iIntros "H3". + (* Now we are onto the next C++ instruction: + [assert(std::memset(s + 2, 0x123, 1) == s + 2);]. *) + go. + iPoseProof (at_zero_elim s_addr with "H0") as "H0". + iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z + with "[$H0 $H1]") as "Hhead". + Arith.arith_simpl. + iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$H2 $H3]") as "Htail". + iPoseProof (object_bytesR_prefix_tail0 (s_addr .[Tuchar ! 2]) + Tuchar (cQp.mk false 1) 1 2 [99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Htail") as "[Htarget Htail]". iExists Tuchar. iSplitL "Htarget". - - iApply (object_bytesR_ucharR_object_bytes_anyR _ 2%N - [97%Z; 98%Z] ltac:(reflexivity) with "Htarget"). - - iIntros "Htarget". - go. - iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 2 4 [120%Z; 120%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Htarget $Htail]") as "Hs". - iPoseProof (object_bytesR_arrayLR_cons s_addr 120%Z - [120%Z; 99%Z; 100%Z] with "Hs") as "[[#Hty0 H0] Hs]". - iExists (Vint 120%Z), (cQp.mk false 1%Qp). - iFrame "H0". iIntros "H0". - go. - iEval (rewrite (arrayLR_cons s_addr 1 4 (fun b : Z => ucharR 1$m b) - 120%Z [99%Z; 100%Z])) in "Hs". - iDestruct "Hs" as "[[#Hty1 H1] Hs]". - iExists (Vint 120%Z), (cQp.mk false 1%Qp). - iFrame "H1". iIntros "H1". - go. - iEval (rewrite (arrayLR_cons s_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [100%Z])) in "Hs". - iDestruct "Hs" as "[[#Hty2 H2] Hs]". - iExists (Vint 99%Z), (cQp.mk false 1%Qp). - iFrame "H2". iIntros "H2". - go. - iEval (rewrite (arrayLR_cons s_addr 3 4 (fun b : Z => ucharR 1$m b) - 100%Z [])) in "Hs". - iDestruct "Hs" as "[[#Hty3 H3] Hs]". - iExists (Vint 100%Z), (cQp.mk false 1%Qp). - iFrame "H3". iIntros "H3". - go. - iPoseProof (at_zero_elim s_addr with "H0") as "H0". - iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z - with "[$H0 $H1]") as "Hhead". - Arith.arith_simpl. - iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". - iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) - 99%Z 100%Z with "[$H2 $H3]") as "Htail". - iPoseProof (object_bytesR_prefix_tail0 (s_addr .[ Tuchar ! 2]) - Tuchar (cQp.mk false 1) 1 2 [99%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Htail") - as "[Htarget Htail]". - iRename "Hs" into "Hempty". - go. - go. - iExists Tuchar. - iSplitL "Htarget". - + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1%N - [99%Z] ltac:(reflexivity) with "Htarget"). - + iIntros "Htarget". - go. - iPoseProof ((object_bytesR_prefix_tail0 (s_addr .[ Tuchar ! 2]) - Tuchar (cQp.mk false 1) 1 2 [35%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Htarget $Htail]") as "Htail". - iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 2 4 [120%Z; 120%Z] [35%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hhead $Htail]") as "Hs". - go. - iPoseProof (object_bytesR_arrayLR_cons s_addr 120%Z - [120%Z; 35%Z; 100%Z] with "Hs") as "[[#Hty0' H0] Hs]". - iEval (rewrite (arrayLR_cons s_addr 1 4 (fun b : Z => ucharR 1$m b) - 120%Z [35%Z; 100%Z])) in "Hs". - iDestruct "Hs" as "[[#Hty1' H1] Hs]". - iEval (rewrite (arrayLR_cons s_addr 2 4 (fun b : Z => ucharR 1$m b) - 35%Z [100%Z])) in "Hs". - iDestruct "Hs" as "[[#Hty2' H2] Hs]". - iExists (Vint 35%Z), (cQp.mk false 1%Qp). - iFrame "H2". iIntros "H2". - go. - iEval (rewrite (arrayLR_cons s_addr 3 4 (fun b : Z => ucharR 1$m b) - 100%Z [])) in "Hs". - iDestruct "Hs" as "[[#Hty3' H3] Hempty2]". - iExists (Vint 100%Z), (cQp.mk false 1%Qp). - iFrame "H3". iIntros "H3". - go. - iPoseProof (at_zero_elim s_addr with "H0") as "H0". - iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z - with "[$H0 $H1]") as "Hhead". - iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". - iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) - 35%Z 100%Z with "[$H2 $H3]") as "Htail". - iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 2 4 [120%Z; 120%Z] [35%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hhead $Htail]") as "Hs". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N - [120%Z; 120%Z; 35%Z; 100%Z] ltac:(reflexivity) with "Hs") - as "Hs". - iFrame "Hs". - go. + { iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 1%N + [99%Z] ltac:(reflexivity) with "Htarget"). } + iIntros "Htarget". + go. + change (memset 291 1) with [35%Z]. + iPoseProof (at_uchar_offset_add_elim s_addr 2 1 3 + (object_bytesR Tuchar 1$m [100%Z]) ltac:(lia) with "Htail") as "Htail". + iPoseProof (object_bytesR_read_head_uchar_after_open + s_addr (cQp.mk false 1%Qp) 2 35%Z [] + [100%Z] with "[$Htarget $Htail]") as "[H2' Htail]". + iExists (Vint 35%Z), (cQp.mk false 1%Qp); iFrame "H2'"; iIntros "H2'". + (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) + go. + iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 3]) 100%Z [] + with "Htail") as "[[#Hty3' H3'] _]". + iPoseProof (at_zero_elim (s_addr .[Tuchar ! 3]) with "H3'") as "H3'". + iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3'"; iIntros "H3'". + (* Now we are onto establishing the postcondition. *) + go. + iPoseProof (object_bytesR_ucharR_ucharR_arrayLR_anyR s_addr + [120%Z; 120%Z] 35%Z 100%Z with "[$Hhead $H2' $H3']") as "Hs". + iFrame "Hs". + go. Qed. cpp.spec "test_memchr()" default. @@ -358,7 +1159,7 @@ Section with_cpp. ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hhead $Hs]") as "Hs". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N [97%Z; 98%Z; 99%Z; 97%Z] ltac:(reflexivity) with "Hs") as "Hs". iFrame "Hs". @@ -369,6 +1170,7 @@ Section with_cpp. Qed. cpp.spec "test_memcpy()" default. +(* Lemma test_memcpy_ok : verify[module] "test_memcpy()". Proof using MOD _Σ thread_info Σ σ. verify_spec; go. @@ -379,6 +1181,7 @@ Section with_cpp. iPoseProof (object_bytesR_of_arrayLR src_addr Tuchar (cQp.mk false 1) 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc") as "Hsrc". + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc") @@ -568,6 +1371,172 @@ Section with_cpp. go. Qed. + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_copy $Hsrc_tail]") as "Hsrc". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_copy $Hdst_tail]") as "Hdst". + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty1 Hdst1] Hdst]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty2 Hdst2] Hdst]". + Arith.arith_simpl. + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "Hdst2". iIntros "Hdst2". + go. + + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty3 Hdst3] Hdst_empty]". + iExists (Vint 122%Z), (cQp.mk false 1%Qp). + iFrame "Hdst3". iIntros "Hdst3". + go. + + iPoseProof (object_bytesR_arrayLR_cons src_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hsrc") as "[[#Hsrc_ty0 Hsrc0] Hsrc]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc0". iIntros "Hsrc0". + go. + + iEval (rewrite (arrayLR_cons src_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty1 Hsrc1] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty2 Hsrc2] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty3 Hsrc3] Hsrc_empty2]". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc3". iIntros "Hsrc3". + go. + + iPoseProof (at_zero_elim src_addr with "Hsrc0") as "Hsrc0". + iPoseProof (uchar_cells_object_bytesR_two src_addr 97%Z 98%Z + with "[$Hsrc0 $Hsrc1]") as "Hsrc_head". + iPoseProof (at_uchar_offset_add_intro src_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". + iPoseProof (uchar_cells_object_bytesR_two (src_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hsrc2 $Hsrc3]") as "Hsrc_tail2". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_head $Hsrc_tail2]") as "Hsrc_full". + + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc_full") + as "[Hsrc_prefix Hsrc_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". + + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") + as "[Hdst_head1 Hdst_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". + + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar. + iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. + iSplitL "Hdst_empty1". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 0%N + [] ltac:(reflexivity) with "Hdst_empty1"). + + iSplit; [done|]. + iIntros "[Hsrc_empty Hdst_empty1]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_prefix $Hsrc_suffix]") as "Hsrc_full". + + iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst_full") + as "[[#Hdst_ty4 Hdst0] Hdst_arr]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty5 Hdst1] Hdst_arr]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") as "Hsrc_any". + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty6 Hdst2] Hdst_arr]". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [97%Z; 98%Z; 99%Z; 122%Z] ltac:(reflexivity) with "Hdst_full") as "Hdst_any". + iFrame "Hsrc_any Hdst_any". + go. + *) + cpp.spec "test_memmove()" default. Lemma test_memmove_ok : verify[module] "test_memmove()". Proof using MOD _Σ thread_info Σ σ. @@ -586,7 +1555,7 @@ Section with_cpp. iExists Tuchar. iSplitL "Hsrc"; [iExact "Hsrc"|]. iSplitL "Hdst". - - iApply (object_bytesR_ucharR_object_bytes_anyR _ 4%N + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 4%N [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst"). - iSplit; [done|]. iIntros "[Hsrc Hdst]". @@ -655,7 +1624,7 @@ Section with_cpp. iExists Tuchar. iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. iSplitL "Hdst_empty1". - + iApply (object_bytesR_ucharR_object_bytes_anyR _ 0%N + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 0%N [] ltac:(reflexivity) with "Hdst_empty1"). + iSplit; [done|]. iIntros "[Hsrc_empty Hdst_empty1]". @@ -690,7 +1659,7 @@ Section with_cpp. iFrame "Hdst1". iIntros "Hdst1". go. - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") as "Hsrc_any". iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". @@ -710,7 +1679,7 @@ Section with_cpp. (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hdst_full") as "Hdst_any". iFrame "Hsrc_any Hdst_any". @@ -820,11 +1789,11 @@ Section with_cpp. ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hab_empty $Hab]") as "Hab". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 3%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 3%N [97%Z; 98%Z; 99%Z] ltac:(reflexivity) with "Habc") as "Habc". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 3%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 3%N [97%Z; 98%Z; 100%Z] ltac:(reflexivity) with "Habd") as "Habd". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 2%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 2%N [97%Z; 98%Z] ltac:(reflexivity) with "Hab") as "Hab". iFrame "Habc Habd Hab". go. @@ -833,4 +1802,7 @@ Section with_cpp. cpp.spec "test_memmove_overlap()" default. cpp.spec "test_cstring_slice4()" default. + Lemma test_cstring_slice4_ok : verify[module] "test_cstring_slice4()". + Proof. verify_spec; go. Qed. + End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v b/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v index ba1ed83..e22c726 100644 --- a/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v +++ b/rocq-brick-libstdcpp/test/cstring/proofs_embedded_null.v @@ -100,9 +100,8 @@ Section with_cpp. iIntros "[Hs Hempty]". Arith.arith_simpl; go; ego. iPoseProof ("Hclose" with "Hs") as "Harr". - iPoseProof (arrayLR_charR_arrayLR_anyR _ 6%N - (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) - ltac:(rewrite cstring.to_zstring_unfold; reflexivity) with "Harr") + iPoseProof (arrayLR_charR_arrayLR_anyR _ 1$m + (cstring.to_zstring "ab"%bs ++ [98%N; 99%N; 0%N]) with "Harr") as "Harr". go. iFrame "Harr". @@ -132,7 +131,7 @@ Section with_cpp. iDestruct "Htail" as "[[#Hty3 H3] Hempty]". iExists Tuchar. iSplitL "Htarget". - - iApply (object_bytesR_ucharR_object_bytes_anyR _ 2%N + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 2%N [98%Z; 99%Z] ltac:(reflexivity) with "Htarget"). - iIntros "Htarget". go. @@ -163,7 +162,7 @@ Section with_cpp. (cQp.mk false 1) 2 4 [97%Z; 0%Z] [0%Z; 100%Z] ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) with "[$Hhead $Htail]") as "Hs". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N [97%Z; 0%Z; 0%Z; 100%Z] ltac:(reflexivity) with "Hs") as "Hs". iFrame "Hs". go. @@ -209,7 +208,7 @@ Section with_cpp. iIntros "Hs". rewrite (memchr_found_after_prefix [97%Z; 0%Z] 98%Z [0%Z] 98%Z); [|solve_memchr_side..]. Arith.arith_simpl; go. - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N [97%Z; 0%Z; 98%Z; 0%Z] ltac:(reflexivity) with "Hs") as "Hs". iFrame "Hs". @@ -224,4 +223,5 @@ Section with_cpp. cpp.spec "test_memcpy_embedded_null()" default. cpp.spec "test_memmove_embedded_null()" default. + End with_cpp. From b042999900a56cbeb91c9a2b695dc8f9e4499e27 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Tue, 28 Apr 2026 12:08:53 -0400 Subject: [PATCH 09/11] Updated md files; split proofs into string and memory-related functions --- rocq-brick-libstdcpp/proof/cstring/DESIGN.md | 31 +- .../proof/cstring/lessons_learned.md | 66 + rocq-brick-libstdcpp/test/cstring/proof.v | 1289 +---------------- .../test/cstring/proof_mem_functions.v | 1289 +++++++++++++++++ 4 files changed, 1386 insertions(+), 1289 deletions(-) create mode 100644 rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v diff --git a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md index 3052614..cd6a3a0 100644 --- a/rocq-brick-libstdcpp/proof/cstring/DESIGN.md +++ b/rocq-brick-libstdcpp/proof/cstring/DESIGN.md @@ -18,13 +18,16 @@ The counted byte slice uses abstract byte predicates rather than `cstring.R`. These operations are not about null-terminated strings, and embedded zero bytes are ordinary data. -On the client side, the active `test/cstring/proof.v` currently proves: +On the client side, the active proof files currently prove: -- the ordinary `strlen` / `strcmp` / `strncmp` litmus tests; -- the active read-only search and segment litmus tests; -- explicit `char[]` array-buffer clients for the string slice; -- `test_memchr`, `test_memchr_embedded_null`, `test_memset`, `test_memcpy`, - `test_memmove`, and `test_memcmp`. +- `test/cstring/proof.v` proves the ordinary `strlen` / `strcmp` / `strncmp` + litmus tests, the active read-only search and segment litmus tests, and the + explicit `char[]` array-buffer clients for the string slice; +- `test/cstring/proof_mem_functions.v` proves `test_memchr`, `test_memset`, + `test_memcpy`, `test_memmove`, and `test_memcmp`; +- `test/cstring/proofs_embedded_null.v` proves + `test_search_embedded_null_array_buffer`, `test_memset_embedded_null`, and + `test_memchr_embedded_null`. The archived files `model_old.v`, `pred_old.v`, `spec_old.v`, and `test/cstring/proof_old.v` are still present for comparison and rollback. They @@ -126,9 +129,10 @@ Embedded-null and embedded-zero litmus tests remain useful regression cases. At present: - `test_memchr_embedded_null_ok` is proved in the active development; -- `test_memcmp_embedded_null`, `test_memset_embedded_null`, - `test_memcpy_embedded_null`, and `test_memmove_embedded_null` are still only - declared via `cpp.spec` stubs in `test/cstring/proof.v`. +- `test_memset_embedded_null_ok` is also proved in the active development; +- `test_memcmp_embedded_null`, `test_memcpy_embedded_null`, and + `test_memmove_embedded_null` are still only declared via `cpp.spec` stubs in + `test/cstring/proofs_embedded_null.v`. As with the earlier `cstring.R` pivot, reusable specs should describe ranges of exactly the length passed to the function. Clients that start from larger @@ -191,12 +195,13 @@ active designs based on `cstring.R` and `object_bytesR`. expose fractional behavior axiomatically; the manual split/recombine pattern should not spread unchecked. - Extend the byte-array proofs to the remaining embedded-null regression tests: - `memcmp`, `memset`, `memcpy`, and `memmove`. + `memcmp`, `memcpy`, and `memmove`. - Extend the byte-array specs beyond non-overlapping cases. The active `memcpy` and `memmove` proofs stay in the disjoint-source/destination lane. - Overlapping `memmove` needs a separate single-buffer or otherwise aliased - specification that snapshots the source range before updating the - destination range. + `test/cstring/proof_mem_functions.v` now carries the `test_memmove_overlap()` + client stub, but overlapping `memmove` still needs a separate single-buffer + or otherwise aliased specification that snapshots the source range before + updating the destination range. - Keep undefined behavior out of green specs and tests: no null pointers, invalid pointers, arrays without a reachable null terminator for string functions, or out-of-bounds byte counts for memory functions. diff --git a/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md index 926e8a9..7f068c5 100644 --- a/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md +++ b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md @@ -36,9 +36,33 @@ later promotion into shared docs. - Prefer exact active-range specs over built-in `take`/`drop` bookkeeping in the library contract. Let clients partition larger buffers into “active prefix” and “rest” themselves. +- Predicate and support-lemma interfaces should usually be formulated for + general permissions `q` and should avoid baking in concrete byte lists, + offsets, or literal client data unless that specificity is semantically + essential. Specs may still specialize `q` when the API truly requires full + ownership, but even then they should remain as general as possible about + input and output values. ## Proofs +- For arithmetic around list lengths and buffer boundaries, try to stay at the + `Z` level as long as possible. If that is not enough, next prefer `N`-based + lemmas and hypotheses. Drop to `nat` only as a last resort. In this + development, proofs became harder when we rushed downward into `nat` + conversions instead of reusing the `Z`/`N` structure already present. +- Avoid `Zlength` here; prefer `lengthZ`. In this framework `lengthZ` is + notation around the `lengthN`-based story, so many `lengthN` lemmas and + hypotheses can be reused directly with only small interface adjustments. +- Before unfolding a notion, inspect it first with tools such as `Print`, + `Print Notation`, `Locate`, and `Search`. Several failed cleanup attempts + came from assuming a familiar definition shape and rewriting toward the wrong + representation. A quick inspection often shows which arithmetic layer or + library lemma will actually match. +- In particular, inspect apparently “different” resource predicates before + designing bridge lemmas or automation around them. In the `memset` read-step + work, `Print ucharR.` revealed that `ucharR` was already notation for the + relevant `primR` shape, so the real issue was continuation structure, not a + missing predicate-conversion lemma. - Prefer general arithmetic cleanup over test-specific proof hacks. If a proof needs to reconcile different representations of the same number, first ask whether the model can produce an arithmetic expression that @@ -59,6 +83,48 @@ later promotion into shared docs. `arrayLR`-to-`cstring.R`, `object_bytesR`-to-`arrayLR`, prefix/tail split lemmas, and byte-array-to-`anyR` lemmas remove duplicated Iris bookkeeping and make later litmus proofs much easier to repair. +- When proof automation is the goal, directional `_F` / `_B` / `_C`-style + hints are usually a better fit than borrowing lemmas. Borrowing lemmas are + continuation-oriented: open a view now, use it locally, and close it later. + Many reusable BRiCk proof steps are instead directional transformations: + decompose what is already in context, rebuild a canonical goal shape, or + replace one resource view by another. Keep semantically meaningful + split/rebuild steps as ordinary lemmas, and only package them as hints when + the step is routine enough that proof search should apply it opportunistically. +- For `\cancelx` hints, “provable” and “useful to automation” are different + thresholds. In this development, some `_guard` and `_using` variants could be + proved but still did not fire under `go`/`ego` at the relevant call site. +- If a side fact depends on a variable that will only be learned from the + consumed resources, putting that fact in `\using` may be too early. In such + cases, ordinary hint parameters or premises can be a better automation + surface than a more internal-looking `\cancelx` clause. +- Relatedly, ordinary hint parameters can sometimes outperform richer internal + clause structure. Even when a witness or equality seems conceptually “inside” + the hint, exposing it as an ordinary premise may let hint search instantiate + it more effectively. +- Hint matching is very intensional. A reformulation that replaces compound + expressions by variables such as `mid` and `k`, together with simple equality + premises, can fire much more reliably because it matches the post-call proof + state more directly. +- In the `memset` family, a direct Family A opener can be worthwhile even when + a more generic wrapper does not fire. Here, `arrayLR_open_prefix_any_C` + became useful only after its consumed surface was phrased with an explicit + upper bound `n` instead of `lengthZ bytes`, and it still helped mainly at the + real `verify_spec` call site rather than on stripped-down toy entailments. +- The Family B read steps ended up working best as reusable ordinary structural + lemmas plus short explicit proofmode steps, not as auto-firing read hints. + In particular, `object_bytesR_read_head_uchar_after_open` was a good reusable + lemma, while several more automated `\cancelx` readback experiments remained + provable but did not fire usefully under `go`/`ego`. +- For `memset`, Family C also worked better as an explicit closing lemma than + as opportunistic automation. A local lemma that rebuilds the final + `arrayLR ... anyR ...` postcondition from a wrapped prefix plus explicit tail + cells was reusable and stable, without relying on broader close-side hint + firing. +- In other words: for this proof family, the successful split was + “Family A opener as automation, Family B readback as ordinary lemmas, Family + C rebuild as an ordinary lemma”. That is a useful default to try in similar + byte-API client proofs. - When automation stops just short of a goal, first check whether the proof is missing a resource-shape bridge rather than a stronger tactic. Several recent repairs were really about rebuilding the exact array or byte-view predicate diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index dad6359..28228f8 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -81,17 +81,6 @@ Section with_cpp. reflexivity. Qed. - #[local] Lemma split_bytes_at_null_spec bytes prefix tail : - split_bytes_at_null bytes = Some (prefix, tail) <-> - bytes = prefix ++ 0%N :: tail /\ - List.Forall (fun b => b <> 0%N) prefix. - Proof. - split. - - apply split_bytes_at_null_sound. - - intros [-> Hfor]. - exact (split_bytes_at_null_complete _ _ Hfor). - Qed. - #[local] Definition split_bytes_at_cstring (bytes : list N) : option (list N * list N) := match split_bytes_at_null bytes with @@ -132,6 +121,18 @@ Section with_cpp. reflexivity. Qed. + (* + Dead lemmas + #[local] Lemma split_bytes_at_null_spec bytes prefix tail : + split_bytes_at_null bytes = Some (prefix, tail) <-> + bytes = prefix ++ 0%N :: tail /\ + List.Forall (fun b => b <> 0%N) prefix. + Proof. + split. + - apply split_bytes_at_null_sound. + - intros [-> Hfor]. + exact (split_bytes_at_null_complete _ _ Hfor). + Qed. #[local] Lemma split_bytes_at_cstring_spec bytes zs tail : split_bytes_at_cstring bytes = Some (zs, tail) <-> bytes = zs ++ tail /\ @@ -146,6 +147,7 @@ Section with_cpp. rewrite <- app_assoc. exact (split_bytes_at_cstring_complete _ _ Hfor). Qed. + *) #[local] Fixpoint pack (zs : list N) : option cstring.t := match zs with @@ -373,55 +375,6 @@ Section with_cpp. Qed. #[local] Hint Resolve arrayLR_close_cstring_C : sl_opacity. - (* These byte-side wrappers are proved and registered, but in the current - [test_memset_ok] proof they still do not fire automatically at the - call-precondition branches where the target is [object_bytes_anyR]. *) - #[local, program] Definition object_bytesR_object_bytes_any_C - (p : ptr) q bytes := - \cancelx - \consuming p |-> object_bytesR Tuchar q bytes - \proving{n (Hlen : n = lengthN bytes)} - p |-> object_bytes_anyR Tuchar q (Z.of_N n) - \end@{mpred}. - Next Obligation. - intros p q bytes. - iIntros "Hbytes" (n Hlen). - iApply (object_bytesR_ucharR_object_bytes_anyR _ q n bytes). - - rewrite Hlen. - rewrite /lengthN Nat2N.id. - reflexivity. - - iExact "Hbytes". - Qed. - #[local] Hint Resolve object_bytesR_object_bytes_any_C : sl_opacity. - - #[local, program] Definition object_bytesR_arrayLR_any_C - (p : ptr) q bytes := - \cancelx - \consuming p |-> object_bytesR Tuchar q bytes - \proving{n (Hlen : n = lengthN bytes)} - p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun _ : unit => anyR Tuchar q) (replicateN n ()) - \end@{mpred}. - Next Obligation. - intros p q bytes. - iIntros "Hbytes" (n Hlen). - iApply (object_bytesR_ucharR_arrayLR_anyR _ q n bytes). - - rewrite Hlen. - rewrite /lengthN Nat2N.id. - reflexivity. - - iExact "Hbytes". - Qed. - #[local] Hint Resolve object_bytesR_arrayLR_any_C : sl_opacity. - - #[local] Lemma at_uchar_offset_eq - (p : ptr) i j (R : Rep) : - i = j -> - p |-> .[Tuchar ! i] |-> R ⊢ - p |-> .[Tuchar ! j] |-> R. - Proof. - intros ->. reflexivity. - Qed. - (* Experimental variants that internalize the unpack witness more aggressively. @@ -589,1220 +542,4 @@ Section with_cpp. Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". Proof. verify_spec; go. Qed. - (* - Planned Family A automation structure for [test_memset()]. - - The intended reusable shape is: - - - an outer entry wrapper from the stack-array [arrayLR] view to one wrapped - [object_bytesR] view - - a core opening principle for a writable subrange inside a wrapped byte - region, where the split is computed canonically from the consumed [bytes] - using [takeZ]/[dropZ] - - a core closing principle that rebuilds one wrapped byte region after the - call from preserved prefix, modified middle, and preserved suffix - - This should let instruction 1 be handled as: - - 1. wrap the initial array into one [object_bytesR] - 2. open the target subrange for the mutating call - 3. close the post-call modified bytes back into one [object_bytesR] - - and instruction 6 should reuse the same core open/close pair, differing - only in the chosen offset and active length. - - #[local, program] Definition arrayLR_wrap_object_bytesR_C - (p : ptr) ty q bytes := - \cancelx - \consuming p |-> arrayLR ty 0 (lengthZ bytes) - (fun v : Z => ucharR q v) bytes - \proving p |-> object_bytesR ty q bytes - \end@{mpred}. - - #[local, program] Definition object_bytesR_open_range_any_C - (p : ptr) ty q off len bytes := - \cancelx - \using [| 0 <= off |] - \using [| 0 <= len |] - \using [| off + len <= lengthZ bytes |] - \consuming p |-> object_bytesR ty q bytes - \proving p .[ty ! off] |-> object_bytes_anyR ty q len - \deduce p |-> object_bytesR ty q (takeZ off bytes) - \deduce p .[ty ! (off + len)] |-> - object_bytesR ty q (dropZ (off + len) bytes) - \end@{mpred}. - - #[local, program] Definition object_bytesR_close_range_C - (p : ptr) ty q prefix ys suffix := - \cancelx - \consuming p |-> object_bytesR ty q prefix - \consuming p .[ty ! lengthZ prefix] |-> object_bytesR ty q ys - \consuming p .[ty ! (lengthZ prefix + lengthZ ys)] |-> - object_bytesR ty q suffix - \proving p |-> object_bytesR ty q (prefix ++ ys ++ suffix) - \end@{mpred}. - - Design notes: - - [arrayLR_wrap_object_bytesR_C] is only the outer boundary adapter; it is - not the core mutating-call automation. - - [object_bytesR_open_range_any_C] should only be considered where the - goal is specifically [object_bytes_anyR], which helps avoid eager firing - in the read-only assert steps. - - the opener is phrased in terms of [off] and [len] because those are the - parameters the next instruction naturally determines; the left prefix, - active middle slice, and right suffix are then the canonical split - [takeZ off bytes], [takeZ len (dropZ off bytes)], and - [dropZ (off + len) bytes]. - - [object_bytesR_close_range_C] is the candidate wrapped-state - reestablishment step between instructions. - - if these become real hints, the likely first use is still local to this - proof family; broad installation would risk spurious firing in other - byte-API clients. - *) - - (* - Parked experiments. These are useful design sketches, but they are not the - right live automation surface for the current [memset] work: - [arrayLR_wrap_object_bytesR_C] does not fire even on an exact standalone - [arrayLR ⊢ object_bytesR] goal, and [object_bytesR_open_range_any_C] does - not fire on the standalone range-opening workspaces. Keep them aborted - rather than admitted. - - #[local, program] Definition arrayLR_wrap_object_bytesR_C - (p : ptr) ty q n bytes := - \cancelx - \consuming p |-> arrayLR ty 0 n - (fun v : Z => ucharR q v) bytes - \proving p |-> object_bytesR ty q bytes - \end@{mpred}. - Next Obligation. - intros p ty q n bytes. iIntros "X". - iApply object_bytesR_of_arrayLR. 2: iFrame. - Abort. - - #[local, program] Definition object_bytesR_open_range_any_C - (p : ptr) ty q off len bytes := - \cancelx - \using [| 0 <= off |] - \using [| 0 <= len |] - \using [| off + len <= lengthZ bytes |] - \consuming p |-> object_bytesR ty q bytes - \proving p .[ty ! off] |-> object_bytes_anyR ty q len - \deduce p |-> object_bytesR ty q (takeZ off bytes) - \deduce p .[ty ! (off + len)] |-> - object_bytesR ty q (dropZ (off + len) bytes) - \end@{mpred}. - Next Obligation. - intros p ty q off len bytes. - iIntros "[%Hoff [%Hlen [%Hbytes H]]]". - (*iRewrite - (takeN_dropN) in "H". - iPoseProof (object_bytesR_prefix_tail0 p ty q (takeZ off bytes) (dropZ off bytes)) as "X".*) - Abort. - *) - - #[local, program] Definition arrayLR_open_prefix_any_C - (p : ptr) q len n bytes - (Hlen : 0 <= len <= n) := - \cancelx - \consuming p |-> arrayLR Tuchar 0 n - (fun v : Z => ucharR q v) bytes - \proving p |-> object_bytes_anyR Tuchar q len - \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) - \end@{mpred}. - Next Obligation. - intros p q len n bytes Hlen. - rewrite arrayLR.unlock _at_sep. arith_simpl. - iIntros "[%Hn Hbytes]". - rewrite _at_offsetR _at_sub_0; [|done]. - assert (HnN : lengthN bytes = Z.to_N n) by lia. - assert (Htake : lengthN (takeZ len bytes) = Z.to_N len). - { rewrite /takeZ lengthN_takeN HnN. - apply N.min_l. - apply Z2N.inj_le; lia. } - assert (Hsplit : takeZ len bytes ++ dropZ len bytes = bytes) - by exact (takeN_dropN (Z.to_N len) bytes). - iAssert (p |-> arrayR Tuchar (fun v : Z => ucharR q v) - (takeZ len bytes ++ dropZ len bytes)) - with "[Hbytes]" as "Hbytes". - { rewrite Hsplit. iExact "Hbytes". } - iEval (rewrite (@arrayR_app__N _ _ _ _ Z (fun v : Z => ucharR q v) Tuchar - (takeZ len bytes) (dropZ len bytes))) in "Hbytes". - iDestruct "Hbytes" as "[Hpre Htail]". - iAssert (p |-> object_bytesR Tuchar q (takeZ len bytes)) - with "[Hpre]" as "Hpre_bytes". - { iApply (object_bytesR_of_arrayLR p Tuchar q len (takeZ len bytes)). - lia. - rewrite arrayLR.unlock _at_sep _at_offsetR _at_sub_0 ; [ work; iFrame | done]. } - iPoseProof (object_bytesR_ucharR_object_bytes_anyR p q - (lengthN (takeZ len bytes)) (takeZ len bytes) - ltac:(rewrite Nat2N.id; reflexivity) with "Hpre_bytes") as "Hpre_any". - rewrite Htake Z2N.id; [ | lia]. iFrame. - iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q - (lengthZ (dropZ len bytes)) - (dropZ len bytes) eq_refl). - rewrite arrayLR.unlock. arith_simpl. work; iFrame. - Qed. - #[local] Hint Resolve arrayLR_open_prefix_any_C | 1000 : sl_opacity. - - #[local, program] Definition arrayLR_open_prefix_bytes_C - (p : ptr) q len n bytes - (Hlen : 0 <= len <= n) := - \cancelx - \consuming p |-> arrayLR Tuchar 0 n - (fun v : Z => ucharR q v) bytes - \proving p |-> object_bytesR Tuchar q (takeZ len bytes) - \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) - \end@{mpred}. - Next Obligation. - intros p q len n bytes Hlen. - rewrite arrayLR.unlock _at_sep. arith_simpl. - rewrite _at_offsetR _at_sub_0; [|done]. - iIntros "[%Hn Hbytes]". - assert (HnN : lengthN bytes = Z.to_N n) by lia. - assert (Htake : lengthN (takeZ len bytes) = Z.to_N len). - { rewrite /takeZ lengthN_takeN HnN. - apply N.min_l. - apply Z2N.inj_le; lia. } - assert (Hsplit : takeZ len bytes ++ dropZ len bytes = bytes) - by exact (takeN_dropN (Z.to_N len) bytes). - iAssert (p |-> arrayR Tuchar (fun v : Z => ucharR q v) - (takeZ len bytes ++ dropZ len bytes)) - with "[Hbytes]" as "Hbytes". - { rewrite Hsplit. iExact "Hbytes". } - iEval (rewrite (@arrayR_app__N _ _ _ _ Z (fun v : Z => ucharR q v) Tuchar - (takeZ len bytes) (dropZ len bytes))) in "Hbytes". - iDestruct "Hbytes" as "[Hpre Htail]". - iAssert (p |-> object_bytesR Tuchar q (takeZ len bytes)) - with "[Hpre]" as "Hpre_bytes". - { iApply (object_bytesR_of_arrayLR p Tuchar q len (takeZ len bytes)). - lia. - rewrite arrayLR.unlock _at_sep _at_offsetR _at_sub_0; [work; iFrame | done]. } - iFrame "Hpre_bytes". - iPoseProof (at_uchar_offset_eq p (lengthZ (takeZ len bytes)) len - (arrayR Tuchar (fun v : Z => ucharR q v) (dropZ len bytes)) - ltac:(unfold lengthZ; rewrite Htake; apply Z2N.id; lia) - with "Htail") as "Htail". - iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q - (lengthZ (dropZ len bytes)) - (dropZ len bytes) eq_refl). - rewrite arrayLR.unlock. arith_simpl. work; iFrame. - Qed. - #[local] Hint Resolve arrayLR_open_prefix_bytes_C | 1000 : sl_opacity. - - (* - The generic wrapper/openers above are useful proof principles, but the - workspace lemmas below show a mixed picture: - - both the earlier [lengthZ bytes]-surface and the newer [n]-surface for - [arrayLR_wrap_object_bytesR_C] fail to fire even on an exact standalone - [arrayLR ⊢ object_bytesR] goal. - - [object_bytesR_open_range_any_C] likewise leaves the standalone range - goals unchanged, even when the relevant bounds are available as ordinary - Rocq hypotheses. - - the earlier [lengthZ bytes]-surface for [arrayLR_open_prefix_any_C] left - both the real first-call state and the standalone prefix-opening goals - unchanged. - - the newer [n]-surface for [arrayLR_open_prefix_any_C] does move the real - [verify_spec] first-call workspace to the post-call state, but it still - does not solve the standalone prefix-opening toy goals. - - so the best current reading is that a sufficiently direct opener can be - useful at the real mutating-call surface even if it is not a generally - useful entailment hint. - *) - - (* - Parked experiments that are no longer needed to reach the current memset - workspace state. - - #[local, program] Definition memset_open_2_C (p : ptr) := - \cancelx - \consuming p |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z] - \proving p |-> object_bytes_anyR Tuchar 1$m 2 - \deduce p .[Tuchar ! 2] |-> object_bytesR Tuchar 1$m [99%Z; 100%Z] - \end@{mpred}. - Next Obligation. Admitted. - - #[local] Lemma object_bytesR_read_head_after_open - (p : ptr) q off x xs suffix : - p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) ∗ - p .[Tuchar ! (off + 1 + lengthZ xs)] |-> object_bytesR Tuchar q suffix ⊢ - p .[Tuchar ! off] |-> primR Tuchar q (Vint x) ∗ - p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix). - Admitted. - *) - - #[local] Lemma object_bytesR_read_head_uchar_after_open - (p : ptr) q off x xs suffix : - p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) ∗ - p .[Tuchar ! (off + lengthZ (x :: xs))] |-> object_bytesR Tuchar q suffix ⊢ - p .[Tuchar ! off] |-> ucharR q x ∗ - p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix). - Proof. - iIntros "[Hhead Hsuffix]". - assert (Hhead_total : lengthZ (x :: xs) = 1 + lengthZ xs). - { assert (Hlen_consN : lengthN (x :: xs) = N.succ (lengthN xs)). - { unfold lengthN. - simpl. - rewrite Nat2N.inj_succ. - reflexivity. } - unfold lengthZ. - rewrite Hlen_consN. - destruct (lengthN xs); simpl; lia. } - iPoseProof (at_uchar_offset_add_intro p off (1 + lengthZ xs) - (off + lengthZ (x :: xs)) (object_bytesR Tuchar q suffix) - ltac:(rewrite Hhead_total; lia) with "Hsuffix") as "Hsuffix". - iPoseProof (at_uchar_offset_add_intro (p .[Tuchar ! off]) 1 (lengthZ xs) - (1 + lengthZ xs) (object_bytesR Tuchar q suffix) - ltac:(lia) with "Hsuffix") as "Hsuffix". - iPoseProof ((object_bytesR_prefix_tail0 (p .[Tuchar ! off]) Tuchar q - 1 (1 + lengthZ xs) [x] xs - ltac:(rewrite Hhead_total; reflexivity) - ltac:(reflexivity) ltac:(lia)) - with "Hhead") as "[Hx Hxs]". - iPoseProof (object_bytesR_ucharR_arrayR (p .[Tuchar ! off]) q [x] - with "Hx") as "Hx". - iPoseProof (at_arrayR_ucharR_cons (p .[Tuchar ! off]) q x [] with "Hx") - as "(#Hty & Hx & _)". - assert (Hxs_suffix_total : lengthZ (xs ++ suffix) = lengthZ xs + lengthZ suffix). - { assert (Hsum : lengthZ (xs ++ suffix) = Z.of_N (lengthN xs + lengthN suffix)). - { apply lengthZ_of_to_nat_length. - rewrite N2Nat.inj_add. - unfold lengthN. - rewrite !Nat2N.id. - rewrite List.length_app. - reflexivity. } - rewrite Hsum. - unfold lengthZ. - destruct (lengthN xs), (lengthN suffix); simpl; lia. } - assert (Hsuffix_len : lengthZ suffix = lengthZ (xs ++ suffix) - lengthZ xs) by lia. - iPoseProof ((object_bytesR_prefix_tail0 (p .[Tuchar ! off] .[Tuchar ! 1]) - Tuchar q (lengthZ xs) (lengthZ (xs ++ suffix)) xs suffix - ltac:(reflexivity) ltac:(reflexivity) ltac:(exact Hsuffix_len)) - with "[$Hxs $Hsuffix]") as "Hrest". - iPoseProof (at_uchar_offset_add_elim p off 1 (off + 1) - (object_bytesR Tuchar q (xs ++ suffix)) ltac:(lia) with "Hrest") - as "Hrest". - iFrame "Hx Hrest". - Qed. - - #[local] Lemma object_bytesR_ucharR_ucharR_arrayLR_anyR - (p : ptr) prefix x y : - p |-> object_bytesR Tuchar 1$m prefix ∗ - p .[Tuchar ! lengthZ prefix] |-> ucharR 1$m x ∗ - p .[Tuchar ! (lengthZ prefix + 1)] |-> ucharR 1$m y ⊢ - p |-> arrayLR Tuchar 0 (lengthZ (prefix ++ [x; y])) - (fun _ : unit => anyR Tuchar 1$m) - (replicateN (lengthN (prefix ++ [x; y])) ()). - Proof. - iIntros "(Hprefix & Hx & Hy)". - iPoseProof (at_uchar_offset_add_intro p (lengthZ prefix) 1 - (lengthZ prefix + 1) (ucharR 1$m y) ltac:(lia) with "Hy") as "Hy". - iPoseProof (uchar_cells_object_bytesR_two (p .[Tuchar ! lengthZ prefix]) x y - with "[$Hx $Hy]") as "Htail". - assert (Htail_len : lengthZ [x; y] = lengthZ (prefix ++ [x; y]) - lengthZ prefix). - { assert (HsumN : lengthN (prefix ++ [x; y]) = (lengthN prefix + lengthN [x; y])%N). - { unfold lengthN. - rewrite List.length_app Nat2N.inj_add. - reflexivity. } - unfold lengthZ. - rewrite HsumN. - simpl. - destruct (lengthN prefix); simpl; lia. } - iPoseProof ((object_bytesR_prefix_tail0 p Tuchar 1$m - (lengthZ prefix) (lengthZ (prefix ++ [x; y])) prefix [x; y] - ltac:(reflexivity) ltac:(reflexivity) ltac:(exact Htail_len)) - with "[$Hprefix $Htail]") as "Hall". - iApply (object_bytesR_ucharR_arrayLR_anyR _ 1$m (lengthN (prefix ++ [x; y])) - (prefix ++ [x; y])). - rewrite Nat2N.id. reflexivity. - iExact "Hall". - Qed. - - (* - Parked read-step automation experiments. They were useful to probe whether - the first read after opening could be automated directly, but they are not - needed to reach the current best workspace checkpoint below. - - #[local, program] Definition object_bytesR_read_head_C - (p : ptr) q off x xs suffix := - \cancelx - \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) - \consuming p .[Tuchar ! (off + 1 + lengthZ xs)] |-> - object_bytesR Tuchar q suffix - \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint x) - \deduce p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix) - \end@{mpred}. - Next Obligation. - Admitted. - - #[local, program] Definition object_bytesR_read_head_bytes_C - (p : ptr) q off n bytes suffix - (Hn : n = lengthZ bytes) - (Hlen : 1 <= n) := - \cancelx - \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes - \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix - \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint (hd 0 bytes)) - \deduce p .[Tuchar ! (off + 1)] |-> - object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) - \end@{mpred}. - Next Obligation. - Admitted. - - #[local, program] Definition object_bytesR_read_head_assert_C - (p : ptr) q off n bytes suffix - (Hn : n = lengthZ bytes) - (Hlen : 1 <= n) := - \cancelx - \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes - \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix - \bound k - \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint (hd 0 bytes)) - \goal_trigger (p .[Tuchar ! off] |-> - primR Tuchar q (Vint (hd 0 bytes)) -∗ k) - \deduce p .[Tuchar ! (off + 1)] |-> - object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) - \end@{mpred}. - Next Obligation. - Admitted. - #[local] Hint Resolve object_bytesR_read_head_assert_C | 1000 : sl_opacity. - - #[local, program] Definition object_bytesR_read_head_assert_exact_C - (p : ptr) q off n bytes suffix - (Hn : n = lengthZ bytes) - (Hlen : 1 <= n) := - \cancelx - \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes - \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix - \bound k - \bound_existential q' - \bound_existential v - \instantiate q' := q - \instantiate v := Vint (hd 0 bytes) - \proving p .[Tuchar ! off] |-> primR Tuchar q' v - \goal_trigger (p .[Tuchar ! off] |-> primR Tuchar q' v -∗ k) - \whole_conclusion - \deduce p .[Tuchar ! (off + 1)] |-> - object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) - \end@{mpred}. - Next Obligation. - Admitted. - #[local] Hint Resolve object_bytesR_read_head_assert_exact_C | 1000 : sl_opacity. - - #[local, program] Definition ucharR_assert_read_B - (p : ptr) q x := - \cancelx - \bound k - \proving p |-> primR Tuchar q (Vint x) ∗ - (p |-> primR Tuchar q (Vint x) -∗ k) - \through p |-> ucharR q x ∗ - (p |-> ucharR q x -∗ k) - \end@{mpred}. - Next Obligation. - Admitted. - #[local] Hint Resolve ucharR_assert_read_B | 1000 : sl_opacity. - - #[local, program] Definition ucharR_assert_read_C - (p : ptr) q x := - \cancelx - \consuming p |-> ucharR q x - \bound k - \proving p |-> primR Tuchar q (Vint x) - \goal_trigger (p |-> primR Tuchar q (Vint x) -∗ k) - \end@{mpred}. - Next Obligation. - Admitted. - #[local] Hint Resolve ucharR_assert_read_C | 1000 : sl_opacity. - *) - - cpp.spec "test_memset()" default. - Lemma test_memset_ok : verify[module] "test_memset()". - Proof using MOD _Σ thread_info Σ σ. - verify_spec; go. - iExists Tuchar. - ego. - change (memset 120 2) with [120%Z; 120%Z]. - change (lengthZ [120%Z; 120%Z]) with 2%Z. - iAssert ( - s_addr .[Tuchar ! 2] |-> object_bytesR Tuchar 1$m - (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]))%I with "[$]" as "Htail". - iPoseProof (at_zero_intro s_addr - (object_bytesR Tuchar 1$m [120%Z; 120%Z]) with "[$]") as "Hmid". - iPoseProof (object_bytesR_read_head_uchar_after_open - s_addr (cQp.mk false 1%Qp) 0 120%Z [120%Z] - (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) - with "[$Hmid $Htail]") as "[H0 Hrest]". - (* Read back the first modified byte: [assert(s[0] == 'x');]. *) - iSplitL "H0"; [ iExact "H0" | iIntros "H0"]. - (* Now we are onto the next C++ instruction: [assert(s[1] == 'x');]. *) - go. - iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 1]) 120%Z - (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with "Hrest") - as "[[#Hty1 H1] Hrest]". - iPoseProof (at_zero_elim (s_addr .[Tuchar ! 1]) with "H1") as "H1". - (* Read back the second modified byte: [assert(s[1] == 'x');]. *) - iExists (Vint 120%Z), (cQp.mk false 1%Qp); iFrame "H1"; iIntros "H1". - (* Now we are onto the next C++ instruction: [assert(s[2] == 'c');]. *) - go. - change (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with [99%Z; 100%Z]. - change (lengthZ (120%Z :: [99%Z; 100%Z])) with 3%Z. - iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 1 3 - (fun b : Z => ucharR 1$m b) 99%Z [100%Z])) in "Hrest". - iDestruct "Hrest" as "[[#Hty2 H2] Hrest]". - iPoseProof (at_uchar_offset_add_elim s_addr 1 1 2 - (ucharR 1$m 99%Z) ltac:(lia) with "H2") as "H2". - iExists (Vint 99%Z), (cQp.mk false 1%Qp); iFrame "H2"; iIntros "H2". - (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) - go. - iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 2 3 - (fun b : Z => ucharR 1$m b) 100%Z [])) in "Hrest". - iDestruct "Hrest" as "[[#Hty3 H3] _]". - iPoseProof (at_uchar_offset_add_elim s_addr 1 2 3 - (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". - iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3"; iIntros "H3". - (* Now we are onto the next C++ instruction: - [assert(std::memset(s + 2, 0x123, 1) == s + 2);]. *) - go. - iPoseProof (at_zero_elim s_addr with "H0") as "H0". - iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z - with "[$H0 $H1]") as "Hhead". - Arith.arith_simpl. - iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". - iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) - 99%Z 100%Z with "[$H2 $H3]") as "Htail". - iPoseProof (object_bytesR_prefix_tail0 (s_addr .[Tuchar ! 2]) - Tuchar (cQp.mk false 1) 1 2 [99%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Htail") - as "[Htarget Htail]". - iExists Tuchar. - iSplitL "Htarget". - { iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 1%N - [99%Z] ltac:(reflexivity) with "Htarget"). } - iIntros "Htarget". - go. - change (memset 291 1) with [35%Z]. - iPoseProof (at_uchar_offset_add_elim s_addr 2 1 3 - (object_bytesR Tuchar 1$m [100%Z]) ltac:(lia) with "Htail") as "Htail". - iPoseProof (object_bytesR_read_head_uchar_after_open - s_addr (cQp.mk false 1%Qp) 2 35%Z [] - [100%Z] with "[$Htarget $Htail]") as "[H2' Htail]". - iExists (Vint 35%Z), (cQp.mk false 1%Qp); iFrame "H2'"; iIntros "H2'". - (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) - go. - iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 3]) 100%Z [] - with "Htail") as "[[#Hty3' H3'] _]". - iPoseProof (at_zero_elim (s_addr .[Tuchar ! 3]) with "H3'") as "H3'". - iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3'"; iIntros "H3'". - (* Now we are onto establishing the postcondition. *) - go. - iPoseProof (object_bytesR_ucharR_ucharR_arrayLR_anyR s_addr - [120%Z; 120%Z] 35%Z 100%Z with "[$Hhead $H2' $H3']") as "Hs". - iFrame "Hs". - go. - Qed. - - cpp.spec "test_memchr()" default. - Lemma test_memchr_ok : verify[module] "test_memchr()". - Proof using MOD _Σ thread_info Σ σ. - verify_spec; go. - iDestruct select (s_addr |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 97%Z]) as "Hs". - iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) - 4 [97%Z; 98%Z; 99%Z; 97%Z] ltac:(reflexivity) with "Hs") as "Hs". - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. - iSplitL "Hs"; [iExact "Hs"|]. - iSplit. - + done. - + iIntros "Hs". - rewrite (memchr_found_after_prefix (@nil Z) 97%Z [98%Z; 99%Z; 97%Z] 97%Z); [|solve_memchr_side..]. - Arith.arith_simpl; go. - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. - iSplitL "Hs"; [iExact "Hs"|]. - iSplit; [done|]. - iIntros "Hs". - rewrite (memchr_found_after_prefix [97%Z; 98%Z] 99%Z [97%Z] 99%Z); [|solve_memchr_side..]. - Arith.arith_simpl; go. - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. - iSplitL "Hs"; [iFrame|]. - iSplit; [done|]. - iIntros "Hs". - rewrite (memchr_missing_if_no_match [97%Z; 98%Z; 99%Z; 97%Z] 122%Z); [|solve_memchr_side..]. - go. - iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 0 4 [] [97%Z; 98%Z; 99%Z; 97%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") - as "[Hempty Hs]". - iExists Tuchar, (cQp.mk false 1), []. - iSplitL "Hempty"; [iExact "Hempty"|]. - iSplit; [done|]. - iIntros "Hempty". - go. - iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 0 4 [] [97%Z; 98%Z; 99%Z; 97%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hempty $Hs]") - as "Hs". - iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 97%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") - as "[Hhead Hs]". - iExists Tuchar, (cQp.mk false 1), [98%Z; 99%Z; 97%Z]. - iSplitL "Hs"; [iExact "Hs"|]. - iSplit; [done|]. - iIntros "Hs". - rewrite (memchr_found_after_prefix [98%Z; 99%Z] 97%Z (@nil Z) 97%Z); [|solve_memchr_side..]. - Arith.arith_simpl; go. - go. - iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 97%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hhead $Hs]") - as "Hs". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N - [97%Z; 98%Z; 99%Z; 97%Z] - ltac:(reflexivity) with "Hs") as "Hs". - iFrame "Hs". - go. - rewrite o_sub_sub in H. - simpl in H. - contradiction. - Qed. - - cpp.spec "test_memcpy()" default. -(* - Lemma test_memcpy_ok : verify[module] "test_memcpy()". - Proof using MOD _Σ thread_info Σ σ. - verify_spec; go. - iDestruct select (src_addr |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hsrc". - iDestruct select (dst_addr |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [119%Z; 120%Z; 121%Z; 122%Z]) as "Hdst". - - iPoseProof (object_bytesR_of_arrayLR src_addr Tuchar (cQp.mk false 1) - 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc") as "Hsrc". - - iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc") - as "[Hsrc_copy Hsrc_tail]". - - iPoseProof (object_bytesR_of_arrayLR dst_addr Tuchar (cQp.mk false 1) - 4 [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst") as "Hdst". - iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 3 4 [119%Z; 120%Z; 121%Z] [122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst") - as "[Hdst_copy Hdst_tail]". - - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. - iExists Tuchar. - iSplitL "Hsrc_copy"; [iExact "Hsrc_copy"|]. - iSplitL "Hdst_copy". - - iApply (object_bytesR_ucharR_object_bytes_anyR _ 3%N - [119%Z; 120%Z; 121%Z] ltac:(reflexivity) with "Hdst_copy"). - - iSplit; [done|]. - iIntros "[Hsrc_copy Hdst_copy]". - Arith.arith_simpl. - go. - - iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_copy $Hsrc_tail]") as "Hsrc". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_copy $Hdst_tail]") as "Hdst". - - iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z - [98%Z; 99%Z; 122%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hdst0". iIntros "Hdst0". - go. - - iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 122%Z])) in "Hdst". - iDestruct "Hdst" as "[[#Hdst_ty1 Hdst1] Hdst]". - iExists (Vint 98%Z), (cQp.mk false 1%Qp). - iFrame "Hdst1". iIntros "Hdst1". - go. - - iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [122%Z])) in "Hdst". - iDestruct "Hdst" as "[[#Hdst_ty2 Hdst2] Hdst]". - Arith.arith_simpl. - iExists (Vint 99%Z), (cQp.mk false 1%Qp). - iFrame "Hdst2". iIntros "Hdst2". - go. - - iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) - 122%Z [])) in "Hdst". - iDestruct "Hdst" as "[[#Hdst_ty3 Hdst3] Hdst_empty]". - iExists (Vint 122%Z), (cQp.mk false 1%Qp). - iFrame "Hdst3". iIntros "Hdst3". - go. - - iPoseProof (object_bytesR_arrayLR_cons src_addr 97%Z - [98%Z; 99%Z; 100%Z] with "Hsrc") as "[[#Hsrc_ty0 Hsrc0] Hsrc]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hsrc0". iIntros "Hsrc0". - go. - - iEval (rewrite (arrayLR_cons src_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 100%Z])) in "Hsrc". - iDestruct "Hsrc" as "[[#Hsrc_ty1 Hsrc1] Hsrc]". - iEval (rewrite (arrayLR_cons src_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [100%Z])) in "Hsrc". - iDestruct "Hsrc" as "[[#Hsrc_ty2 Hsrc2] Hsrc]". - iEval (rewrite (arrayLR_cons src_addr 3 4 (fun b : Z => ucharR 1$m b) - 100%Z [])) in "Hsrc". - iDestruct "Hsrc" as "[[#Hsrc_ty3 Hsrc3] Hsrc_empty2]". - iExists (Vint 100%Z), (cQp.mk false 1%Qp). - iFrame "Hsrc3". iIntros "Hsrc3". - go. - - iPoseProof (at_zero_elim src_addr with "Hsrc0") as "Hsrc0". - iPoseProof (uchar_cells_object_bytesR_two src_addr 97%Z 98%Z - with "[$Hsrc0 $Hsrc1]") as "Hsrc_head". - iPoseProof (at_uchar_offset_add_intro src_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". - iPoseProof (uchar_cells_object_bytesR_two (src_addr .[Tuchar ! 2]) - 99%Z 100%Z with "[$Hsrc2 $Hsrc3]") as "Hsrc_tail2". - iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_head $Hsrc_tail2]") as "Hsrc_full". - - iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". - iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z - with "[$Hdst0 $Hdst1]") as "Hdst_head". - iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 - (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". - iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) - 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". - - iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc_full") - as "[Hsrc_prefix Hsrc_suffix]". - iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar - (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". - - iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") - as "[Hdst_head1 Hdst_suffix]". - iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". - - iExists Tuchar, (cQp.mk false 1), []. - iExists Tuchar. - iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. - iSplitL "Hdst_empty1". - + iApply (object_bytesR_ucharR_object_bytes_anyR _ 0%N - [] ltac:(reflexivity) with "Hdst_empty1"). - + iSplit; [done|]. - iIntros "[Hsrc_empty Hdst_empty1]". - Arith.arith_simpl. - go. - - iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar - (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". - iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_prefix $Hsrc_suffix]") as "Hsrc_full". - - iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". - - iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z - [98%Z; 99%Z; 122%Z] with "Hdst_full") - as "[[#Hdst_ty4 Hdst0] Hdst_arr]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hdst0". iIntros "Hdst0". - go. - - iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 122%Z])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty5 Hdst1] Hdst_arr]". - iExists (Vint 98%Z), (cQp.mk false 1%Qp). - iFrame "Hdst1". iIntros "Hdst1". - go. - - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N - [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") as "Hsrc_any". - iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". - iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z - with "[$Hdst0 $Hdst1]") as "Hdst_head". - iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [122%Z])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty6 Hdst2] Hdst_arr]". - iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) - 122%Z [])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". - iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 - (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". - iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) - 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N - [97%Z; 98%Z; 99%Z; 122%Z] ltac:(reflexivity) with "Hdst_full") as "Hdst_any". - iFrame "Hsrc_any Hdst_any". - go. - Qed. - - iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_copy $Hsrc_tail]") as "Hsrc". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_copy $Hdst_tail]") as "Hdst". - - iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z - [98%Z; 99%Z; 122%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hdst0". iIntros "Hdst0". - go. - - iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 122%Z])) in "Hdst". - iDestruct "Hdst" as "[[#Hdst_ty1 Hdst1] Hdst]". - iExists (Vint 98%Z), (cQp.mk false 1%Qp). - iFrame "Hdst1". iIntros "Hdst1". - go. - - iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [122%Z])) in "Hdst". - iDestruct "Hdst" as "[[#Hdst_ty2 Hdst2] Hdst]". - Arith.arith_simpl. - iExists (Vint 99%Z), (cQp.mk false 1%Qp). - iFrame "Hdst2". iIntros "Hdst2". - go. - - iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) - 122%Z [])) in "Hdst". - iDestruct "Hdst" as "[[#Hdst_ty3 Hdst3] Hdst_empty]". - iExists (Vint 122%Z), (cQp.mk false 1%Qp). - iFrame "Hdst3". iIntros "Hdst3". - go. - - iPoseProof (object_bytesR_arrayLR_cons src_addr 97%Z - [98%Z; 99%Z; 100%Z] with "Hsrc") as "[[#Hsrc_ty0 Hsrc0] Hsrc]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hsrc0". iIntros "Hsrc0". - go. - - iEval (rewrite (arrayLR_cons src_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 100%Z])) in "Hsrc". - iDestruct "Hsrc" as "[[#Hsrc_ty1 Hsrc1] Hsrc]". - iEval (rewrite (arrayLR_cons src_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [100%Z])) in "Hsrc". - iDestruct "Hsrc" as "[[#Hsrc_ty2 Hsrc2] Hsrc]". - iEval (rewrite (arrayLR_cons src_addr 3 4 (fun b : Z => ucharR 1$m b) - 100%Z [])) in "Hsrc". - iDestruct "Hsrc" as "[[#Hsrc_ty3 Hsrc3] Hsrc_empty2]". - iExists (Vint 100%Z), (cQp.mk false 1%Qp). - iFrame "Hsrc3". iIntros "Hsrc3". - go. - - iPoseProof (at_zero_elim src_addr with "Hsrc0") as "Hsrc0". - iPoseProof (uchar_cells_object_bytesR_two src_addr 97%Z 98%Z - with "[$Hsrc0 $Hsrc1]") as "Hsrc_head". - iPoseProof (at_uchar_offset_add_intro src_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". - iPoseProof (uchar_cells_object_bytesR_two (src_addr .[Tuchar ! 2]) - 99%Z 100%Z with "[$Hsrc2 $Hsrc3]") as "Hsrc_tail2". - iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_head $Hsrc_tail2]") as "Hsrc_full". - - iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". - iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z - with "[$Hdst0 $Hdst1]") as "Hdst_head". - iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 - (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". - iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) - 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". - - iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc_full") - as "[Hsrc_prefix Hsrc_suffix]". - iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar - (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". - - iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") - as "[Hdst_head1 Hdst_suffix]". - iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". - - iExists Tuchar, (cQp.mk false 1), []. - iExists Tuchar. - iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. - iSplitL "Hdst_empty1". - + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 0%N - [] ltac:(reflexivity) with "Hdst_empty1"). - + iSplit; [done|]. - iIntros "[Hsrc_empty Hdst_empty1]". - Arith.arith_simpl. - go. - - iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar - (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". - iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_prefix $Hsrc_suffix]") as "Hsrc_full". - - iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". - - iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z - [98%Z; 99%Z; 122%Z] with "Hdst_full") - as "[[#Hdst_ty4 Hdst0] Hdst_arr]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hdst0". iIntros "Hdst0". - go. - - iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 122%Z])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty5 Hdst1] Hdst_arr]". - iExists (Vint 98%Z), (cQp.mk false 1%Qp). - iFrame "Hdst1". iIntros "Hdst1". - go. - - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N - [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") as "Hsrc_any". - iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". - iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z - with "[$Hdst0 $Hdst1]") as "Hdst_head". - iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [122%Z])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty6 Hdst2] Hdst_arr]". - iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) - 122%Z [])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". - iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 - (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". - iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) - 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N - [97%Z; 98%Z; 99%Z; 122%Z] ltac:(reflexivity) with "Hdst_full") as "Hdst_any". - iFrame "Hsrc_any Hdst_any". - go. - *) - - cpp.spec "test_memmove()" default. - Lemma test_memmove_ok : verify[module] "test_memmove()". - Proof using MOD _Σ thread_info Σ σ. - verify_spec; go. - iDestruct select (src_addr |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hsrc". - iDestruct select (dst_addr |-> arrayLR Tuchar 0 4 - (fun v : Z => ucharR 1$m v) [119%Z; 120%Z; 121%Z; 122%Z]) as "Hdst". - - iPoseProof (object_bytesR_of_arrayLR src_addr Tuchar (cQp.mk false 1) - 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc") as "Hsrc". - iPoseProof (object_bytesR_of_arrayLR dst_addr Tuchar (cQp.mk false 1) - 4 [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst") as "Hdst". - - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 100%Z]. - iExists Tuchar. - iSplitL "Hsrc"; [iExact "Hsrc"|]. - iSplitL "Hdst". - - iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 4%N - [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst"). - - iSplit; [done|]. - iIntros "[Hsrc Hdst]". - Arith.arith_simpl. - go. - - iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z - [98%Z; 99%Z; 100%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst_arr]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hdst0". iIntros "Hdst0". - go. - - iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 100%Z])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty1 Hdst1] Hdst_arr]". - iExists (Vint 98%Z), (cQp.mk false 1%Qp). - iFrame "Hdst1". iIntros "Hdst1". - go. - - iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [100%Z])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty2 Hdst2] Hdst_arr]". - Arith.arith_simpl. - iExists (Vint 99%Z), (cQp.mk false 1%Qp). - iFrame "Hdst2". iIntros "Hdst2". - go. - - iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) - 100%Z [])) in "Hdst_arr". - iDestruct "Hdst_arr" as "[[#Hdst_ty3 Hdst3] Hdst_empty0]". - iExists (Vint 100%Z), (cQp.mk false 1%Qp). - iFrame "Hdst3". iIntros "Hdst3". - go. - - iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". - iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z - with "[$Hdst0 $Hdst1]") as "Hdst_head". - iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". - iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) - 99%Z 100%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". - - iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc") - as "[Hsrc_head1 Hsrc_suffix]". - iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". - - iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") - as "[Hdst_head1 Hdst_suffix]". - iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) - with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". - - iExists Tuchar, (cQp.mk false 1), []. - iExists Tuchar. - iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. - iSplitL "Hdst_empty1". - + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 0%N - [] ltac:(reflexivity) with "Hdst_empty1"). - + iSplit; [done|]. - iIntros "[Hsrc_empty Hdst_empty1]". - Arith.arith_simpl. - go. - - iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". - iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hsrc_head1 $Hsrc_suffix]") as "Hsrc_full". - - iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar - (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". - - iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z - [98%Z; 99%Z; 100%Z] with "Hdst_full") - as "[[#Hdst_ty4 Hdst0] Hdst_arr2]". - iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) - 98%Z [99%Z; 100%Z])) in "Hdst_arr2". - iDestruct "Hdst_arr2" as "[[#Hdst_ty5 Hdst1] Hdst_arr2]". - iExists (Vint 98%Z), (cQp.mk false 1%Qp). - iFrame "Hdst1". iIntros "Hdst1". - go. - - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N - [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") - as "Hsrc_any". - iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". - iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z - with "[$Hdst0 $Hdst1]") as "Hdst_head". - iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) - 99%Z [100%Z])) in "Hdst_arr2". - iDestruct "Hdst_arr2" as "[[#Hdst_ty6 Hdst2] Hdst_arr3]". - iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) - 100%Z [])) in "Hdst_arr3". - iDestruct "Hdst_arr3" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". - iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". - iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) - 99%Z 100%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". - iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar - (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N - [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hdst_full") - as "Hdst_any". - iFrame "Hsrc_any Hdst_any". - go. - Qed. - - cpp.spec "test_memcmp()" default. - Lemma test_memcmp_ok : verify[module] "test_memcmp()". - Proof using MOD _Σ thread_info Σ σ. - verify_spec; go. - iDestruct select (abc_addr |-> arrayLR Tuchar 0 3 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z]) as "Habc". - iDestruct select (abd_addr |-> arrayLR Tuchar 0 3 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 100%Z]) as "Habd". - iDestruct select (ab_addr |-> arrayLR Tuchar 0 2 - (fun v : Z => ucharR 1$m v) [97%Z; 98%Z]) as "Hab". - - iPoseProof (object_bytesR_of_arrayLR abc_addr Tuchar (cQp.mk false 1) - 3 [97%Z; 98%Z; 99%Z] ltac:(reflexivity) with "Habc") as "Habc". - iPoseProof (object_bytesR_half_split with "Habc") as - "[Habc_left Habc_right]". - iExists Tuchar, (cQp.mk false (1/2)), [97%Z; 98%Z; 99%Z]. - iExists Tuchar, (cQp.mk false (1/2)), [97%Z; 98%Z; 99%Z]. - iSplitL "Habc_left"; [iExact "Habc_left"|]. - iSplitL "Habc_right"; [iExact "Habc_right"|]. - iSplit; [done|]. - iSplit; [done|]. - iIntros "[Habc_left Habc_right]". - Arith.arith_simpl. - go. - iPoseProof ((object_bytesR_half_split abc_addr Tuchar - [97%Z; 98%Z; 99%Z]) with "[$Habc_left $Habc_right]") as "Habc". - - iPoseProof (object_bytesR_of_arrayLR abd_addr Tuchar (cQp.mk false 1) - 3 [97%Z; 98%Z; 100%Z] ltac:(reflexivity) with "Habd") as "Habd". - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 100%Z]. - iSplitL "Habc"; [iExact "Habc"|]. - iSplitL "Habd"; [iExact "Habd"|]. - iSplit; [done|]. - iSplit; [done|]. - iIntros "[Habc Habd]". - Arith.arith_simpl. - go. - - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 100%Z]. - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. - iSplitL "Habd"; [iExact "Habd"|]. - iSplitL "Habc"; [iExact "Habc"|]. - iSplit; [done|]. - iSplit; [done|]. - iIntros "[Habd Habc]". - Arith.arith_simpl. - go. - - iPoseProof (object_bytesR_prefix_tail0 abc_addr Tuchar - (cQp.mk false 1) 2 3 [97%Z; 98%Z] [99%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habc") - as "[Habc_prefix Habc_tail]". - iPoseProof (object_bytesR_prefix_tail0 abd_addr Tuchar - (cQp.mk false 1) 2 3 [97%Z; 98%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habd") - as "[Habd_prefix Habd_tail]". - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z]. - iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z]. - iSplitL "Habc_prefix"; [iExact "Habc_prefix"|]. - iSplitL "Habd_prefix"; [iExact "Habd_prefix"|]. - iSplit; [done|]. - iSplit; [done|]. - iIntros "[Habc_prefix Habd_prefix]". - Arith.arith_simpl. - go. - iPoseProof ((object_bytesR_prefix_tail0 abc_addr Tuchar - (cQp.mk false 1) 2 3 [97%Z; 98%Z] [99%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Habc_prefix $Habc_tail]") as "Habc". - iPoseProof ((object_bytesR_prefix_tail0 abd_addr Tuchar - (cQp.mk false 1) 2 3 [97%Z; 98%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Habd_prefix $Habd_tail]") as "Habd". - - iPoseProof (object_bytesR_prefix_tail0 abc_addr Tuchar - (cQp.mk false 1) 0 3 [] [97%Z; 98%Z; 99%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habc") - as "[Habc_empty Habc]". - iPoseProof (object_bytesR_of_arrayLR ab_addr Tuchar (cQp.mk false 1) - 2 [97%Z; 98%Z] ltac:(reflexivity) with "Hab") as "Hab". - iPoseProof (object_bytesR_prefix_tail0 ab_addr Tuchar - (cQp.mk false 1) 0 2 [] [97%Z; 98%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hab") - as "[Hab_empty Hab]". - iExists Tuchar, (cQp.mk false 1), []. - iExists Tuchar, (cQp.mk false 1), []. - iSplitL "Habc_empty"; [iExact "Habc_empty"|]. - iSplitL "Hab_empty"; [iExact "Hab_empty"|]. - iSplit; [done|]. - iSplit; [done|]. - iIntros "[Habc_empty Hab_empty]". - Arith.arith_simpl. - go. - iPoseProof ((object_bytesR_prefix_tail0 abc_addr Tuchar - (cQp.mk false 1) 0 3 [] [97%Z; 98%Z; 99%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Habc_empty $Habc]") as "Habc". - iPoseProof ((object_bytesR_prefix_tail0 ab_addr Tuchar - (cQp.mk false 1) 0 2 [] [97%Z; 98%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) - with "[$Hab_empty $Hab]") as "Hab". - - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 3%N - [97%Z; 98%Z; 99%Z] ltac:(reflexivity) with "Habc") as "Habc". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 3%N - [97%Z; 98%Z; 100%Z] ltac:(reflexivity) with "Habd") as "Habd". - iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 2%N - [97%Z; 98%Z] ltac:(reflexivity) with "Hab") as "Hab". - iFrame "Habc Habd Hab". - go. - Qed. - - cpp.spec "test_memmove_overlap()" default. - - cpp.spec "test_cstring_slice4()" default. - Lemma test_cstring_slice4_ok : verify[module] "test_cstring_slice4()". - Proof. verify_spec; go. Qed. - End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v b/rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v new file mode 100644 index 0000000..4d89f00 --- /dev/null +++ b/rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v @@ -0,0 +1,1289 @@ +(* + * Copyright (c) 2026 SkyLabs AI, Inc. + * This software is distributed under the terms of the BedRock Open-Source License. + * See the LICENSE-BedRock file in the repository root for details. + *) +Require Import skylabs.auto.cpp.proof. +Require Import skylabs.auto.cpp.hints.anyR. +(** BEGIN: SKYLABS DEFAULT PROOF IMPORTS *) +Require Import skylabs.auto.cpp.prelude.proof. +Require Import skylabs.cpp.array. +Import expr_join. +#[local] Hint Resolve delayed_case.smash_delayed_case_B | 1000 : br_hints. +#[local] Hint Resolve delayed_case.expr_join.smash_delayed_case_B | 1000 : br_hints. +(** END: SKYLABS DEFAULT PROOF IMPORTS *) +Require Import skylabs.brick.libstdcpp.cassert.spec. +Require Import skylabs.brick.libstdcpp.cstring.spec. +Require Import skylabs.brick.libstdcpp.test.cstring.test_cpp. + +Import normalize.only_provable_norm. + +Import normalize.normalize_ptr. +Import refine_lib. + +Section with_cpp. + Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. + + #[local, program] Definition object_bytesR_object_bytes_any_C + (p : ptr) q bytes := + \cancelx + \consuming p |-> object_bytesR Tuchar q bytes + \proving{n (Hlen : n = lengthN bytes)} + p |-> object_bytes_anyR Tuchar q (Z.of_N n) + \end@{mpred}. + Next Obligation. + intros p q bytes. + iIntros "Hbytes" (n Hlen). + iApply (object_bytesR_ucharR_object_bytes_anyR _ q n bytes). + - rewrite Hlen. + rewrite /lengthN Nat2N.id. + reflexivity. + - iExact "Hbytes". + Qed. + #[local] Hint Resolve object_bytesR_object_bytes_any_C : sl_opacity. + + #[local, program] Definition object_bytesR_arrayLR_any_C + (p : ptr) q bytes := + \cancelx + \consuming p |-> object_bytesR Tuchar q bytes + \proving{n (Hlen : n = lengthN bytes)} + p |-> arrayLR Tuchar 0 (Z.of_N n) + (fun _ : unit => anyR Tuchar q) (replicateN n ()) + \end@{mpred}. + Next Obligation. + intros p q bytes. + iIntros "Hbytes" (n Hlen). + iApply (object_bytesR_ucharR_arrayLR_anyR _ q n bytes). + - rewrite Hlen. + rewrite /lengthN Nat2N.id. + reflexivity. + - iExact "Hbytes". + Qed. + #[local] Hint Resolve object_bytesR_arrayLR_any_C : sl_opacity. + + #[local] Lemma at_uchar_offset_eq + (p : ptr) i j (R : Rep) : + i = j -> + p |-> .[Tuchar ! i] |-> R ⊢ + p |-> .[Tuchar ! j] |-> R. + Proof. + intros ->. reflexivity. + Qed. + + (* + Planned Family A automation structure for [test_memset()]. + + The intended reusable shape is: + + - an outer entry wrapper from the stack-array [arrayLR] view to one wrapped + [object_bytesR] view + - a core opening principle for a writable subrange inside a wrapped byte + region, where the split is computed canonically from the consumed [bytes] + using [takeZ]/[dropZ] + - a core closing principle that rebuilds one wrapped byte region after the + call from preserved prefix, modified middle, and preserved suffix + + This should let instruction 1 be handled as: + + 1. wrap the initial array into one [object_bytesR] + 2. open the target subrange for the mutating call + 3. close the post-call modified bytes back into one [object_bytesR] + + and instruction 6 should reuse the same core open/close pair, differing + only in the chosen offset and active length. + + #[local, program] Definition arrayLR_wrap_object_bytesR_C + (p : ptr) ty q bytes := + \cancelx + \consuming p |-> arrayLR ty 0 (lengthZ bytes) + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytesR ty q bytes + \end@{mpred}. + + #[local, program] Definition object_bytesR_open_range_any_C + (p : ptr) ty q off len bytes := + \cancelx + \using [| 0 <= off |] + \using [| 0 <= len |] + \using [| off + len <= lengthZ bytes |] + \consuming p |-> object_bytesR ty q bytes + \proving p .[ty ! off] |-> object_bytes_anyR ty q len + \deduce p |-> object_bytesR ty q (takeZ off bytes) + \deduce p .[ty ! (off + len)] |-> + object_bytesR ty q (dropZ (off + len) bytes) + \end@{mpred}. + + #[local, program] Definition object_bytesR_close_range_C + (p : ptr) ty q prefix ys suffix := + \cancelx + \consuming p |-> object_bytesR ty q prefix + \consuming p .[ty ! lengthZ prefix] |-> object_bytesR ty q ys + \consuming p .[ty ! (lengthZ prefix + lengthZ ys)] |-> + object_bytesR ty q suffix + \proving p |-> object_bytesR ty q (prefix ++ ys ++ suffix) + \end@{mpred}. + + Design notes: + - [arrayLR_wrap_object_bytesR_C] is only the outer boundary adapter; it is + not the core mutating-call automation. + - [object_bytesR_open_range_any_C] should only be considered where the + goal is specifically [object_bytes_anyR], which helps avoid eager firing + in the read-only assert steps. + - the opener is phrased in terms of [off] and [len] because those are the + parameters the next instruction naturally determines; the left prefix, + active middle slice, and right suffix are then the canonical split + [takeZ off bytes], [takeZ len (dropZ off bytes)], and + [dropZ (off + len) bytes]. + - [object_bytesR_close_range_C] is the candidate wrapped-state + reestablishment step between instructions. + - if these become real hints, the likely first use is still local to this + proof family; broad installation would risk spurious firing in other + byte-API clients. + *) + + (* + Parked experiments. These are useful design sketches, but they are not the + right live automation surface for the current [memset] work: + [arrayLR_wrap_object_bytesR_C] does not fire even on an exact standalone + [arrayLR ⊢ object_bytesR] goal, and [object_bytesR_open_range_any_C] does + not fire on the standalone range-opening workspaces. Keep them aborted + rather than admitted. + + #[local, program] Definition arrayLR_wrap_object_bytesR_C + (p : ptr) ty q n bytes := + \cancelx + \consuming p |-> arrayLR ty 0 n + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytesR ty q bytes + \end@{mpred}. + Next Obligation. + intros p ty q n bytes. iIntros "X". + iApply object_bytesR_of_arrayLR. 2: iFrame. + Abort. + + #[local, program] Definition object_bytesR_open_range_any_C + (p : ptr) ty q off len bytes := + \cancelx + \using [| 0 <= off |] + \using [| 0 <= len |] + \using [| off + len <= lengthZ bytes |] + \consuming p |-> object_bytesR ty q bytes + \proving p .[ty ! off] |-> object_bytes_anyR ty q len + \deduce p |-> object_bytesR ty q (takeZ off bytes) + \deduce p .[ty ! (off + len)] |-> + object_bytesR ty q (dropZ (off + len) bytes) + \end@{mpred}. + Next Obligation. + intros p ty q off len bytes. + iIntros "[%Hoff [%Hlen [%Hbytes H]]]". + (*iRewrite - (takeN_dropN) in "H". + iPoseProof (object_bytesR_prefix_tail0 p ty q (takeZ off bytes) (dropZ off bytes)) as "X".*) + Abort. + *) + + #[local, program] Definition arrayLR_open_prefix_any_C + (p : ptr) q len n bytes + (Hlen : 0 <= len <= n) := + \cancelx + \consuming p |-> arrayLR Tuchar 0 n + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytes_anyR Tuchar q len + \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) + \end@{mpred}. + Next Obligation. + intros p q len n bytes Hlen. + rewrite arrayLR.unlock _at_sep. arith_simpl. + iIntros "[%Hn Hbytes]". + rewrite _at_offsetR _at_sub_0; [|done]. + assert (HnN : lengthN bytes = Z.to_N n) by lia. + assert (Htake : lengthN (takeZ len bytes) = Z.to_N len). + { rewrite /takeZ lengthN_takeN HnN. + apply N.min_l. + apply Z2N.inj_le; lia. } + assert (Hsplit : takeZ len bytes ++ dropZ len bytes = bytes) + by exact (takeN_dropN (Z.to_N len) bytes). + iAssert (p |-> arrayR Tuchar (fun v : Z => ucharR q v) + (takeZ len bytes ++ dropZ len bytes)) + with "[Hbytes]" as "Hbytes". + { rewrite Hsplit. iExact "Hbytes". } + iEval (rewrite (@arrayR_app__N _ _ _ _ Z (fun v : Z => ucharR q v) Tuchar + (takeZ len bytes) (dropZ len bytes))) in "Hbytes". + iDestruct "Hbytes" as "[Hpre Htail]". + iAssert (p |-> object_bytesR Tuchar q (takeZ len bytes)) + with "[Hpre]" as "Hpre_bytes". + { iApply (object_bytesR_of_arrayLR p Tuchar q len (takeZ len bytes)). + lia. + rewrite arrayLR.unlock _at_sep _at_offsetR _at_sub_0 ; [ work; iFrame | done]. } + iPoseProof (object_bytesR_ucharR_object_bytes_anyR p q + (lengthN (takeZ len bytes)) (takeZ len bytes) + ltac:(rewrite Nat2N.id; reflexivity) with "Hpre_bytes") as "Hpre_any". + rewrite Htake Z2N.id; [ | lia]. iFrame. + iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q + (lengthZ (dropZ len bytes)) + (dropZ len bytes) eq_refl). + rewrite arrayLR.unlock. arith_simpl. work; iFrame. + Qed. + #[local] Hint Resolve arrayLR_open_prefix_any_C | 1000 : sl_opacity. + + #[local, program] Definition arrayLR_open_prefix_bytes_C + (p : ptr) q len n bytes + (Hlen : 0 <= len <= n) := + \cancelx + \consuming p |-> arrayLR Tuchar 0 n + (fun v : Z => ucharR q v) bytes + \proving p |-> object_bytesR Tuchar q (takeZ len bytes) + \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) + \end@{mpred}. + Next Obligation. + intros p q len n bytes Hlen. + rewrite arrayLR.unlock _at_sep. arith_simpl. + rewrite _at_offsetR _at_sub_0; [|done]. + iIntros "[%Hn Hbytes]". + assert (HnN : lengthN bytes = Z.to_N n) by lia. + assert (Htake : lengthN (takeZ len bytes) = Z.to_N len). + { rewrite /takeZ lengthN_takeN HnN. + apply N.min_l. + apply Z2N.inj_le; lia. } + assert (Hsplit : takeZ len bytes ++ dropZ len bytes = bytes) + by exact (takeN_dropN (Z.to_N len) bytes). + iAssert (p |-> arrayR Tuchar (fun v : Z => ucharR q v) + (takeZ len bytes ++ dropZ len bytes)) + with "[Hbytes]" as "Hbytes". + { rewrite Hsplit. iExact "Hbytes". } + iEval (rewrite (@arrayR_app__N _ _ _ _ Z (fun v : Z => ucharR q v) Tuchar + (takeZ len bytes) (dropZ len bytes))) in "Hbytes". + iDestruct "Hbytes" as "[Hpre Htail]". + iAssert (p |-> object_bytesR Tuchar q (takeZ len bytes)) + with "[Hpre]" as "Hpre_bytes". + { iApply (object_bytesR_of_arrayLR p Tuchar q len (takeZ len bytes)). + lia. + rewrite arrayLR.unlock _at_sep _at_offsetR _at_sub_0; [work; iFrame | done]. } + iFrame "Hpre_bytes". + iPoseProof (at_uchar_offset_eq p (lengthZ (takeZ len bytes)) len + (arrayR Tuchar (fun v : Z => ucharR q v) (dropZ len bytes)) + ltac:(unfold lengthZ; rewrite Htake; apply Z2N.id; lia) + with "Htail") as "Htail". + iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q + (lengthZ (dropZ len bytes)) + (dropZ len bytes) eq_refl). + rewrite arrayLR.unlock. arith_simpl. work; iFrame. + Qed. + #[local] Hint Resolve arrayLR_open_prefix_bytes_C | 1000 : sl_opacity. + + (* + The generic wrapper/openers above are useful proof principles, but the + workspace lemmas below show a mixed picture: + - both the earlier [lengthZ bytes]-surface and the newer [n]-surface for + [arrayLR_wrap_object_bytesR_C] fail to fire even on an exact standalone + [arrayLR ⊢ object_bytesR] goal. + - [object_bytesR_open_range_any_C] likewise leaves the standalone range + goals unchanged, even when the relevant bounds are available as ordinary + Rocq hypotheses. + - the earlier [lengthZ bytes]-surface for [arrayLR_open_prefix_any_C] left + both the real first-call state and the standalone prefix-opening goals + unchanged. + - the newer [n]-surface for [arrayLR_open_prefix_any_C] does move the real + [verify_spec] first-call workspace to the post-call state, but it still + does not solve the standalone prefix-opening toy goals. + - so the best current reading is that a sufficiently direct opener can be + useful at the real mutating-call surface even if it is not a generally + useful entailment hint. + *) + + (* + Parked experiments that are no longer needed to reach the current memset + workspace state. + + #[local, program] Definition memset_open_2_C (p : ptr) := + \cancelx + \consuming p |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z] + \proving p |-> object_bytes_anyR Tuchar 1$m 2 + \deduce p .[Tuchar ! 2] |-> object_bytesR Tuchar 1$m [99%Z; 100%Z] + \end@{mpred}. + Next Obligation. Admitted. + + #[local] Lemma object_bytesR_read_head_after_open + (p : ptr) q off x xs suffix : + p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) ∗ + p .[Tuchar ! (off + 1 + lengthZ xs)] |-> object_bytesR Tuchar q suffix ⊢ + p .[Tuchar ! off] |-> primR Tuchar q (Vint x) ∗ + p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix). + Admitted. + *) + + #[local] Lemma object_bytesR_read_head_uchar_after_open + (p : ptr) q off x xs suffix : + p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) ∗ + p .[Tuchar ! (off + lengthZ (x :: xs))] |-> object_bytesR Tuchar q suffix ⊢ + p .[Tuchar ! off] |-> ucharR q x ∗ + p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix). + Proof. + iIntros "[Hhead Hsuffix]". + assert (Hhead_total : lengthZ (x :: xs) = 1 + lengthZ xs). + { assert (Hlen_consN : lengthN (x :: xs) = N.succ (lengthN xs)). + { unfold lengthN. + simpl. + rewrite Nat2N.inj_succ. + reflexivity. } + unfold lengthZ. + rewrite Hlen_consN. + destruct (lengthN xs); simpl; lia. } + iPoseProof (at_uchar_offset_add_intro p off (1 + lengthZ xs) + (off + lengthZ (x :: xs)) (object_bytesR Tuchar q suffix) + ltac:(rewrite Hhead_total; lia) with "Hsuffix") as "Hsuffix". + iPoseProof (at_uchar_offset_add_intro (p .[Tuchar ! off]) 1 (lengthZ xs) + (1 + lengthZ xs) (object_bytesR Tuchar q suffix) + ltac:(lia) with "Hsuffix") as "Hsuffix". + iPoseProof ((object_bytesR_prefix_tail0 (p .[Tuchar ! off]) Tuchar q + 1 (1 + lengthZ xs) [x] xs + ltac:(rewrite Hhead_total; reflexivity) + ltac:(reflexivity) ltac:(lia)) + with "Hhead") as "[Hx Hxs]". + iPoseProof (object_bytesR_ucharR_arrayR (p .[Tuchar ! off]) q [x] + with "Hx") as "Hx". + iPoseProof (at_arrayR_ucharR_cons (p .[Tuchar ! off]) q x [] with "Hx") + as "(#Hty & Hx & _)". + assert (Hxs_suffix_total : lengthZ (xs ++ suffix) = lengthZ xs + lengthZ suffix). + { assert (Hsum : lengthZ (xs ++ suffix) = Z.of_N (lengthN xs + lengthN suffix)). + { apply lengthZ_of_to_nat_length. + rewrite N2Nat.inj_add. + unfold lengthN. + rewrite !Nat2N.id. + rewrite List.length_app. + reflexivity. } + rewrite Hsum. + unfold lengthZ. + destruct (lengthN xs), (lengthN suffix); simpl; lia. } + assert (Hsuffix_len : lengthZ suffix = lengthZ (xs ++ suffix) - lengthZ xs) by lia. + iPoseProof ((object_bytesR_prefix_tail0 (p .[Tuchar ! off] .[Tuchar ! 1]) + Tuchar q (lengthZ xs) (lengthZ (xs ++ suffix)) xs suffix + ltac:(reflexivity) ltac:(reflexivity) ltac:(exact Hsuffix_len)) + with "[$Hxs $Hsuffix]") as "Hrest". + iPoseProof (at_uchar_offset_add_elim p off 1 (off + 1) + (object_bytesR Tuchar q (xs ++ suffix)) ltac:(lia) with "Hrest") + as "Hrest". + iFrame "Hx Hrest". + Qed. + + #[local] Lemma object_bytesR_ucharR_ucharR_arrayLR_anyR + (p : ptr) prefix x y : + p |-> object_bytesR Tuchar 1$m prefix ∗ + p .[Tuchar ! lengthZ prefix] |-> ucharR 1$m x ∗ + p .[Tuchar ! (lengthZ prefix + 1)] |-> ucharR 1$m y ⊢ + p |-> arrayLR Tuchar 0 (lengthZ (prefix ++ [x; y])) + (fun _ : unit => anyR Tuchar 1$m) + (replicateN (lengthN (prefix ++ [x; y])) ()). + Proof. + iIntros "(Hprefix & Hx & Hy)". + iPoseProof (at_uchar_offset_add_intro p (lengthZ prefix) 1 + (lengthZ prefix + 1) (ucharR 1$m y) ltac:(lia) with "Hy") as "Hy". + iPoseProof (uchar_cells_object_bytesR_two (p .[Tuchar ! lengthZ prefix]) x y + with "[$Hx $Hy]") as "Htail". + assert (Htail_len : lengthZ [x; y] = lengthZ (prefix ++ [x; y]) - lengthZ prefix). + { assert (HsumN : lengthN (prefix ++ [x; y]) = (lengthN prefix + lengthN [x; y])%N). + { unfold lengthN. + rewrite List.length_app Nat2N.inj_add. + reflexivity. } + unfold lengthZ. + rewrite HsumN. + simpl. + destruct (lengthN prefix); simpl; lia. } + iPoseProof ((object_bytesR_prefix_tail0 p Tuchar 1$m + (lengthZ prefix) (lengthZ (prefix ++ [x; y])) prefix [x; y] + ltac:(reflexivity) ltac:(reflexivity) ltac:(exact Htail_len)) + with "[$Hprefix $Htail]") as "Hall". + iApply (object_bytesR_ucharR_arrayLR_anyR _ 1$m (lengthN (prefix ++ [x; y])) + (prefix ++ [x; y])). + rewrite Nat2N.id. reflexivity. + iExact "Hall". + Qed. + + (* + Parked read-step automation experiments. They were useful to probe whether + the first read after opening could be automated directly, but they are not + needed to reach the current best workspace checkpoint below. + + #[local, program] Definition object_bytesR_read_head_C + (p : ptr) q off x xs suffix := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q (x :: xs) + \consuming p .[Tuchar ! (off + 1 + lengthZ xs)] |-> + object_bytesR Tuchar q suffix + \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint x) + \deduce p .[Tuchar ! (off + 1)] |-> object_bytesR Tuchar q (xs ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + + #[local, program] Definition object_bytesR_read_head_bytes_C + (p : ptr) q off n bytes suffix + (Hn : n = lengthZ bytes) + (Hlen : 1 <= n) := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes + \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix + \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint (hd 0 bytes)) + \deduce p .[Tuchar ! (off + 1)] |-> + object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + + #[local, program] Definition object_bytesR_read_head_assert_C + (p : ptr) q off n bytes suffix + (Hn : n = lengthZ bytes) + (Hlen : 1 <= n) := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes + \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix + \bound k + \proving p .[Tuchar ! off] |-> primR Tuchar q (Vint (hd 0 bytes)) + \goal_trigger (p .[Tuchar ! off] |-> + primR Tuchar q (Vint (hd 0 bytes)) -∗ k) + \deduce p .[Tuchar ! (off + 1)] |-> + object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve object_bytesR_read_head_assert_C | 1000 : sl_opacity. + + #[local, program] Definition object_bytesR_read_head_assert_exact_C + (p : ptr) q off n bytes suffix + (Hn : n = lengthZ bytes) + (Hlen : 1 <= n) := + \cancelx + \consuming p .[Tuchar ! off] |-> object_bytesR Tuchar q bytes + \consuming p .[Tuchar ! (off + n)] |-> object_bytesR Tuchar q suffix + \bound k + \bound_existential q' + \bound_existential v + \instantiate q' := q + \instantiate v := Vint (hd 0 bytes) + \proving p .[Tuchar ! off] |-> primR Tuchar q' v + \goal_trigger (p .[Tuchar ! off] |-> primR Tuchar q' v -∗ k) + \whole_conclusion + \deduce p .[Tuchar ! (off + 1)] |-> + object_bytesR Tuchar q (dropZ 1 bytes ++ suffix) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve object_bytesR_read_head_assert_exact_C | 1000 : sl_opacity. + + #[local, program] Definition ucharR_assert_read_B + (p : ptr) q x := + \cancelx + \bound k + \proving p |-> primR Tuchar q (Vint x) ∗ + (p |-> primR Tuchar q (Vint x) -∗ k) + \through p |-> ucharR q x ∗ + (p |-> ucharR q x -∗ k) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve ucharR_assert_read_B | 1000 : sl_opacity. + + #[local, program] Definition ucharR_assert_read_C + (p : ptr) q x := + \cancelx + \consuming p |-> ucharR q x + \bound k + \proving p |-> primR Tuchar q (Vint x) + \goal_trigger (p |-> primR Tuchar q (Vint x) -∗ k) + \end@{mpred}. + Next Obligation. + Admitted. + #[local] Hint Resolve ucharR_assert_read_C | 1000 : sl_opacity. + *) + + cpp.spec "test_memset()" default. + Lemma test_memset_ok : verify[module] "test_memset()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iExists Tuchar. + ego. + change (memset 120 2) with [120%Z; 120%Z]. + change (lengthZ [120%Z; 120%Z]) with 2%Z. + iAssert ( + s_addr .[Tuchar ! 2] |-> object_bytesR Tuchar 1$m + (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]))%I with "[$]" as "Htail". + iPoseProof (at_zero_intro s_addr + (object_bytesR Tuchar 1$m [120%Z; 120%Z]) with "[$]") as "Hmid". + iPoseProof (object_bytesR_read_head_uchar_after_open + s_addr (cQp.mk false 1%Qp) 0 120%Z [120%Z] + (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) + with "[$Hmid $Htail]") as "[H0 Hrest]". + (* Read back the first modified byte: [assert(s[0] == 'x');]. *) + iSplitL "H0"; [ iExact "H0" | iIntros "H0"]. + (* Now we are onto the next C++ instruction: [assert(s[1] == 'x');]. *) + go. + iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 1]) 120%Z + (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with "Hrest") + as "[[#Hty1 H1] Hrest]". + iPoseProof (at_zero_elim (s_addr .[Tuchar ! 1]) with "H1") as "H1". + (* Read back the second modified byte: [assert(s[1] == 'x');]. *) + iExists (Vint 120%Z), (cQp.mk false 1%Qp); iFrame "H1"; iIntros "H1". + (* Now we are onto the next C++ instruction: [assert(s[2] == 'c');]. *) + go. + change (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with [99%Z; 100%Z]. + change (lengthZ (120%Z :: [99%Z; 100%Z])) with 3%Z. + iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 1 3 + (fun b : Z => ucharR 1$m b) 99%Z [100%Z])) in "Hrest". + iDestruct "Hrest" as "[[#Hty2 H2] Hrest]". + iPoseProof (at_uchar_offset_add_elim s_addr 1 1 2 + (ucharR 1$m 99%Z) ltac:(lia) with "H2") as "H2". + iExists (Vint 99%Z), (cQp.mk false 1%Qp); iFrame "H2"; iIntros "H2". + (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) + go. + iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 2 3 + (fun b : Z => ucharR 1$m b) 100%Z [])) in "Hrest". + iDestruct "Hrest" as "[[#Hty3 H3] _]". + iPoseProof (at_uchar_offset_add_elim s_addr 1 2 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3"; iIntros "H3". + (* Now we are onto the next C++ instruction: + [assert(std::memset(s + 2, 0x123, 1) == s + 2);]. *) + go. + iPoseProof (at_zero_elim s_addr with "H0") as "H0". + iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z + with "[$H0 $H1]") as "Hhead". + Arith.arith_simpl. + iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$H2 $H3]") as "Htail". + iPoseProof (object_bytesR_prefix_tail0 (s_addr .[Tuchar ! 2]) + Tuchar (cQp.mk false 1) 1 2 [99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Htail") + as "[Htarget Htail]". + iExists Tuchar. + iSplitL "Htarget". + { iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 1%N + [99%Z] ltac:(reflexivity) with "Htarget"). } + iIntros "Htarget". + go. + change (memset 291 1) with [35%Z]. + iPoseProof (at_uchar_offset_add_elim s_addr 2 1 3 + (object_bytesR Tuchar 1$m [100%Z]) ltac:(lia) with "Htail") as "Htail". + iPoseProof (object_bytesR_read_head_uchar_after_open + s_addr (cQp.mk false 1%Qp) 2 35%Z [] + [100%Z] with "[$Htarget $Htail]") as "[H2' Htail]". + iExists (Vint 35%Z), (cQp.mk false 1%Qp); iFrame "H2'"; iIntros "H2'". + (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) + go. + iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 3]) 100%Z [] + with "Htail") as "[[#Hty3' H3'] _]". + iPoseProof (at_zero_elim (s_addr .[Tuchar ! 3]) with "H3'") as "H3'". + iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3'"; iIntros "H3'". + (* Now we are onto establishing the postcondition. *) + go. + iPoseProof (object_bytesR_ucharR_ucharR_arrayLR_anyR s_addr + [120%Z; 120%Z] 35%Z 100%Z with "[$Hhead $H2' $H3']") as "Hs". + iFrame "Hs". + go. + Qed. + + cpp.spec "test_memchr()" default. + Lemma test_memchr_ok : verify[module] "test_memchr()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (s_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 97%Z]) as "Hs". + iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 97%Z] ltac:(reflexivity) with "Hs") as "Hs". + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit. + + done. + + iIntros "Hs". + rewrite (memchr_found_after_prefix (@nil Z) 97%Z [98%Z; 99%Z; 97%Z] 97%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [97%Z; 98%Z] 99%Z [97%Z] 99%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iFrame|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_missing_if_no_match [97%Z; 98%Z; 99%Z; 97%Z] 122%Z); [|solve_memchr_side..]. + go. + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 0 4 [] [97%Z; 98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + as "[Hempty Hs]". + iExists Tuchar, (cQp.mk false 1), []. + iSplitL "Hempty"; [iExact "Hempty"|]. + iSplit; [done|]. + iIntros "Hempty". + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 0 4 [] [97%Z; 98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hempty $Hs]") + as "Hs". + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") + as "[Hhead Hs]". + iExists Tuchar, (cQp.mk false 1), [98%Z; 99%Z; 97%Z]. + iSplitL "Hs"; [iExact "Hs"|]. + iSplit; [done|]. + iIntros "Hs". + rewrite (memchr_found_after_prefix [98%Z; 99%Z] 97%Z (@nil Z) 97%Z); [|solve_memchr_side..]. + Arith.arith_simpl; go. + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 97%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Hs]") + as "Hs". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [97%Z; 98%Z; 99%Z; 97%Z] + ltac:(reflexivity) with "Hs") as "Hs". + iFrame "Hs". + go. + rewrite o_sub_sub in H. + simpl in H. + contradiction. + Qed. + + cpp.spec "test_memcpy()" default. +(* + Lemma test_memcpy_ok : verify[module] "test_memcpy()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (src_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hsrc". + iDestruct select (dst_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [119%Z; 120%Z; 121%Z; 122%Z]) as "Hdst". + + iPoseProof (object_bytesR_of_arrayLR src_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc") as "Hsrc". + + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc") + as "[Hsrc_copy Hsrc_tail]". + + iPoseProof (object_bytesR_of_arrayLR dst_addr Tuchar (cQp.mk false 1) + 4 [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst") as "Hdst". + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 3 4 [119%Z; 120%Z; 121%Z] [122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst") + as "[Hdst_copy Hdst_tail]". + + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. + iExists Tuchar. + iSplitL "Hsrc_copy"; [iExact "Hsrc_copy"|]. + iSplitL "Hdst_copy". + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 3%N + [119%Z; 120%Z; 121%Z] ltac:(reflexivity) with "Hdst_copy"). + - iSplit; [done|]. + iIntros "[Hsrc_copy Hdst_copy]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_copy $Hsrc_tail]") as "Hsrc". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_copy $Hdst_tail]") as "Hdst". + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty1 Hdst1] Hdst]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty2 Hdst2] Hdst]". + Arith.arith_simpl. + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "Hdst2". iIntros "Hdst2". + go. + + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty3 Hdst3] Hdst_empty]". + iExists (Vint 122%Z), (cQp.mk false 1%Qp). + iFrame "Hdst3". iIntros "Hdst3". + go. + + iPoseProof (object_bytesR_arrayLR_cons src_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hsrc") as "[[#Hsrc_ty0 Hsrc0] Hsrc]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc0". iIntros "Hsrc0". + go. + + iEval (rewrite (arrayLR_cons src_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty1 Hsrc1] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty2 Hsrc2] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty3 Hsrc3] Hsrc_empty2]". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc3". iIntros "Hsrc3". + go. + + iPoseProof (at_zero_elim src_addr with "Hsrc0") as "Hsrc0". + iPoseProof (uchar_cells_object_bytesR_two src_addr 97%Z 98%Z + with "[$Hsrc0 $Hsrc1]") as "Hsrc_head". + iPoseProof (at_uchar_offset_add_intro src_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". + iPoseProof (uchar_cells_object_bytesR_two (src_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hsrc2 $Hsrc3]") as "Hsrc_tail2". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_head $Hsrc_tail2]") as "Hsrc_full". + + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc_full") + as "[Hsrc_prefix Hsrc_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". + + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") + as "[Hdst_head1 Hdst_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". + + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar. + iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. + iSplitL "Hdst_empty1". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 0%N + [] ltac:(reflexivity) with "Hdst_empty1"). + + iSplit; [done|]. + iIntros "[Hsrc_empty Hdst_empty1]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_prefix $Hsrc_suffix]") as "Hsrc_full". + + iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst_full") + as "[[#Hdst_ty4 Hdst0] Hdst_arr]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty5 Hdst1] Hdst_arr]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") as "Hsrc_any". + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty6 Hdst2] Hdst_arr]". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 4%N + [97%Z; 98%Z; 99%Z; 122%Z] ltac:(reflexivity) with "Hdst_full") as "Hdst_any". + iFrame "Hsrc_any Hdst_any". + go. + Qed. + + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_copy $Hsrc_tail]") as "Hsrc". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 3 4 [97%Z; 98%Z; 99%Z] [122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_copy $Hdst_tail]") as "Hdst". + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty1 Hdst1] Hdst]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty2 Hdst2] Hdst]". + Arith.arith_simpl. + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "Hdst2". iIntros "Hdst2". + go. + + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst". + iDestruct "Hdst" as "[[#Hdst_ty3 Hdst3] Hdst_empty]". + iExists (Vint 122%Z), (cQp.mk false 1%Qp). + iFrame "Hdst3". iIntros "Hdst3". + go. + + iPoseProof (object_bytesR_arrayLR_cons src_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hsrc") as "[[#Hsrc_ty0 Hsrc0] Hsrc]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc0". iIntros "Hsrc0". + go. + + iEval (rewrite (arrayLR_cons src_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty1 Hsrc1] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty2 Hsrc2] Hsrc]". + iEval (rewrite (arrayLR_cons src_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hsrc". + iDestruct "Hsrc" as "[[#Hsrc_ty3 Hsrc3] Hsrc_empty2]". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "Hsrc3". iIntros "Hsrc3". + go. + + iPoseProof (at_zero_elim src_addr with "Hsrc0") as "Hsrc0". + iPoseProof (uchar_cells_object_bytesR_two src_addr 97%Z 98%Z + with "[$Hsrc0 $Hsrc1]") as "Hsrc_head". + iPoseProof (at_uchar_offset_add_intro src_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hsrc3") as "Hsrc3". + iPoseProof (uchar_cells_object_bytesR_two (src_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hsrc2 $Hsrc3]") as "Hsrc_tail2". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_head $Hsrc_tail2]") as "Hsrc_full". + + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc_full") + as "[Hsrc_prefix Hsrc_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". + + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") + as "[Hdst_head1 Hdst_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". + + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar. + iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. + iSplitL "Hdst_empty1". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 0%N + [] ltac:(reflexivity) with "Hdst_empty1"). + + iSplit; [done|]. + iIntros "[Hsrc_empty Hdst_empty1]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 2]) Tuchar + (cQp.mk false 1) 0 2 [] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_prefix $Hsrc_suffix]") as "Hsrc_full". + + iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 122%Z] with "Hdst_full") + as "[[#Hdst_ty4 Hdst0] Hdst_arr]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty5 Hdst1] Hdst_arr]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") as "Hsrc_any". + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [122%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty6 Hdst2] Hdst_arr]". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 122%Z [])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 122%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 122%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 122%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [97%Z; 98%Z; 99%Z; 122%Z] ltac:(reflexivity) with "Hdst_full") as "Hdst_any". + iFrame "Hsrc_any Hdst_any". + go. + *) + + cpp.spec "test_memmove()" default. + Lemma test_memmove_ok : verify[module] "test_memmove()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (src_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hsrc". + iDestruct select (dst_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [119%Z; 120%Z; 121%Z; 122%Z]) as "Hdst". + + iPoseProof (object_bytesR_of_arrayLR src_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc") as "Hsrc". + iPoseProof (object_bytesR_of_arrayLR dst_addr Tuchar (cQp.mk false 1) + 4 [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst") as "Hdst". + + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z; 100%Z]. + iExists Tuchar. + iSplitL "Hsrc"; [iExact "Hsrc"|]. + iSplitL "Hdst". + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 4%N + [119%Z; 120%Z; 121%Z; 122%Z] ltac:(reflexivity) with "Hdst"). + - iSplit; [done|]. + iIntros "[Hsrc Hdst]". + Arith.arith_simpl. + go. + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst_arr]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. + + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty1 Hdst1] Hdst_arr]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty2 Hdst2] Hdst_arr]". + Arith.arith_simpl. + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "Hdst2". iIntros "Hdst2". + go. + + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hdst_arr". + iDestruct "Hdst_arr" as "[[#Hdst_ty3 Hdst3] Hdst_empty0]". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "Hdst3". iIntros "Hdst3". + go. + + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + + iPoseProof (object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hsrc") + as "[Hsrc_head1 Hsrc_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hsrc_suffix") as "[Hsrc_empty Hsrc_suffix]". + + iPoseProof (object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hdst_full") + as "[Hdst_head1 Hdst_suffix]". + iPoseProof (object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) + with "Hdst_suffix") as "[Hdst_empty1 Hdst_suffix1]". + + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar. + iSplitL "Hsrc_empty"; [iExact "Hsrc_empty"|]. + iSplitL "Hdst_empty1". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 0%N + [] ltac:(reflexivity) with "Hdst_empty1"). + + iSplit; [done|]. + iIntros "[Hsrc_empty Hdst_empty1]". + Arith.arith_simpl. + go. + + iPoseProof ((object_bytesR_prefix_tail0 (src_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_empty $Hsrc_suffix]") as "Hsrc_suffix". + iPoseProof ((object_bytesR_prefix_tail0 src_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hsrc_head1 $Hsrc_suffix]") as "Hsrc_full". + + iPoseProof ((object_bytesR_prefix_tail0 (dst_addr .[Tuchar ! 1]) Tuchar + (cQp.mk false 1) 0 3 [] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_empty1 $Hdst_suffix1]") as "Hdst_suffix". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 1 4 [97%Z] [98%Z; 99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head1 $Hdst_suffix]") as "Hdst_full". + + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hdst_full") + as "[[#Hdst_ty4 Hdst0] Hdst_arr2]". + iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) + 98%Z [99%Z; 100%Z])) in "Hdst_arr2". + iDestruct "Hdst_arr2" as "[[#Hdst_ty5 Hdst1] Hdst_arr2]". + iExists (Vint 98%Z), (cQp.mk false 1%Qp). + iFrame "Hdst1". iIntros "Hdst1". + go. + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hsrc_full") + as "Hsrc_any". + iPoseProof (at_zero_elim dst_addr with "Hdst0") as "Hdst0". + iPoseProof (uchar_cells_object_bytesR_two dst_addr 97%Z 98%Z + with "[$Hdst0 $Hdst1]") as "Hdst_head". + iEval (rewrite (arrayLR_cons dst_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hdst_arr2". + iDestruct "Hdst_arr2" as "[[#Hdst_ty6 Hdst2] Hdst_arr3]". + iEval (rewrite (arrayLR_cons dst_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hdst_arr3". + iDestruct "Hdst_arr3" as "[[#Hdst_ty7 Hdst3] Hdst_empty2]". + iPoseProof (at_uchar_offset_add_intro dst_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "Hdst3") as "Hdst3". + iPoseProof (uchar_cells_object_bytesR_two (dst_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$Hdst2 $Hdst3]") as "Hdst_tail2". + iPoseProof ((object_bytesR_prefix_tail0 dst_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hdst_head $Hdst_tail2]") as "Hdst_full". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hdst_full") + as "Hdst_any". + iFrame "Hsrc_any Hdst_any". + go. + Qed. + + cpp.spec "test_memcmp()" default. + Lemma test_memcmp_ok : verify[module] "test_memcmp()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + iDestruct select (abc_addr |-> arrayLR Tuchar 0 3 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z]) as "Habc". + iDestruct select (abd_addr |-> arrayLR Tuchar 0 3 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 100%Z]) as "Habd". + iDestruct select (ab_addr |-> arrayLR Tuchar 0 2 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z]) as "Hab". + + iPoseProof (object_bytesR_of_arrayLR abc_addr Tuchar (cQp.mk false 1) + 3 [97%Z; 98%Z; 99%Z] ltac:(reflexivity) with "Habc") as "Habc". + iPoseProof (object_bytesR_half_split with "Habc") as + "[Habc_left Habc_right]". + iExists Tuchar, (cQp.mk false (1/2)), [97%Z; 98%Z; 99%Z]. + iExists Tuchar, (cQp.mk false (1/2)), [97%Z; 98%Z; 99%Z]. + iSplitL "Habc_left"; [iExact "Habc_left"|]. + iSplitL "Habc_right"; [iExact "Habc_right"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc_left Habc_right]". + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_half_split abc_addr Tuchar + [97%Z; 98%Z; 99%Z]) with "[$Habc_left $Habc_right]") as "Habc". + + iPoseProof (object_bytesR_of_arrayLR abd_addr Tuchar (cQp.mk false 1) + 3 [97%Z; 98%Z; 100%Z] ltac:(reflexivity) with "Habd") as "Habd". + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 100%Z]. + iSplitL "Habc"; [iExact "Habc"|]. + iSplitL "Habd"; [iExact "Habd"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc Habd]". + Arith.arith_simpl. + go. + + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 100%Z]. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z; 99%Z]. + iSplitL "Habd"; [iExact "Habd"|]. + iSplitL "Habc"; [iExact "Habc"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habd Habc]". + Arith.arith_simpl. + go. + + iPoseProof (object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habc") + as "[Habc_prefix Habc_tail]". + iPoseProof (object_bytesR_prefix_tail0 abd_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habd") + as "[Habd_prefix Habd_tail]". + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z]. + iExists Tuchar, (cQp.mk false 1), [97%Z; 98%Z]. + iSplitL "Habc_prefix"; [iExact "Habc_prefix"|]. + iSplitL "Habd_prefix"; [iExact "Habd_prefix"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc_prefix Habd_prefix]". + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Habc_prefix $Habc_tail]") as "Habc". + iPoseProof ((object_bytesR_prefix_tail0 abd_addr Tuchar + (cQp.mk false 1) 2 3 [97%Z; 98%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Habd_prefix $Habd_tail]") as "Habd". + + iPoseProof (object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 0 3 [] [97%Z; 98%Z; 99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Habc") + as "[Habc_empty Habc]". + iPoseProof (object_bytesR_of_arrayLR ab_addr Tuchar (cQp.mk false 1) + 2 [97%Z; 98%Z] ltac:(reflexivity) with "Hab") as "Hab". + iPoseProof (object_bytesR_prefix_tail0 ab_addr Tuchar + (cQp.mk false 1) 0 2 [] [97%Z; 98%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hab") + as "[Hab_empty Hab]". + iExists Tuchar, (cQp.mk false 1), []. + iExists Tuchar, (cQp.mk false 1), []. + iSplitL "Habc_empty"; [iExact "Habc_empty"|]. + iSplitL "Hab_empty"; [iExact "Hab_empty"|]. + iSplit; [done|]. + iSplit; [done|]. + iIntros "[Habc_empty Hab_empty]". + Arith.arith_simpl. + go. + iPoseProof ((object_bytesR_prefix_tail0 abc_addr Tuchar + (cQp.mk false 1) 0 3 [] [97%Z; 98%Z; 99%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Habc_empty $Habc]") as "Habc". + iPoseProof ((object_bytesR_prefix_tail0 ab_addr Tuchar + (cQp.mk false 1) 0 2 [] [97%Z; 98%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hab_empty $Hab]") as "Hab". + + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 3%N + [97%Z; 98%Z; 99%Z] ltac:(reflexivity) with "Habc") as "Habc". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 3%N + [97%Z; 98%Z; 100%Z] ltac:(reflexivity) with "Habd") as "Habd". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 2%N + [97%Z; 98%Z] ltac:(reflexivity) with "Hab") as "Hab". + iFrame "Habc Habd Hab". + go. + Qed. + + cpp.spec "test_memmove_overlap()" default. + + cpp.spec "test_cstring_slice4()" default. + Lemma test_cstring_slice4_ok : verify[module] "test_cstring_slice4()". + Proof. verify_spec; go. Qed. + +End with_cpp. From 60ae984d79070c5f291e108ad148fc726cfac3e7 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Wed, 29 Apr 2026 07:44:36 -0400 Subject: [PATCH 10/11] Better usage of cancelx makes string proofs mostly-automatic --- .../proof/cstring/lessons_learned.md | 16 +++ rocq-brick-libstdcpp/proof/cstring/spec.v | 4 +- rocq-brick-libstdcpp/test/cstring/proof.v | 136 +++++++----------- 3 files changed, 71 insertions(+), 85 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md index 7f068c5..668d0d0 100644 --- a/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md +++ b/rocq-brick-libstdcpp/proof/cstring/lessons_learned.md @@ -102,10 +102,26 @@ later promotion into shared docs. clause structure. Even when a witness or equality seems conceptually “inside” the hint, exposing it as an ordinary premise may let hint search instantiate it more effectively. +- That negative lesson has an important complement: if a witness is computable + from consumed data and the main problem is aligning with the actual + goal-side parameters, a stronger `_C` hint may still work well if it + combines: + - a computation-friendly wrapper premise such as + `unpack_cstring bytes =[Vm]=> Some (s, tail)` + - `\bound` variables on the `\proving` side + - pure `\through` equalities tying those bound variables to the computed + values + In the `` opener, this was the reformulation that finally let the + hint fire cleanly under `go`/`ego` without an explicit client-side `Hex`. - Hint matching is very intensional. A reformulation that replaces compound expressions by variables such as `mid` and `k`, together with simple equality premises, can fire much more reliably because it matches the post-call proof state more directly. +- Reducibility/evaluation-style premises can be a better automation surface + than plain equalities or existentials when the hint should compute a witness + from concrete data. In wrapper obligations, converting such a premise with + `%RedEq_eq` gives back an ordinary equality while keeping the client-facing + hint surface computation-friendly. - In the `memset` family, a direct Family A opener can be worthwhile even when a more generic wrapper does not fire. Here, `arrayLR_open_prefix_any_C` became useful only after its consumed surface was phrased with an explicit diff --git a/rocq-brick-libstdcpp/proof/cstring/spec.v b/rocq-brick-libstdcpp/proof/cstring/spec.v index a7977fd..b0f921f 100644 --- a/rocq-brick-libstdcpp/proof/cstring/spec.v +++ b/rocq-brick-libstdcpp/proof/cstring/spec.v @@ -131,8 +131,8 @@ Section with_cpp. cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_spec_old with (\arg{s_p} "__s" (Vptr s_p) \arg{c} "__c" (Vint c) - \arg{n} "__n" (Vn n) - \prepost{q bytes} s_p |-> arrayLR Tuchar 0 (Z.of_N n) + \arg{k} "__n" (Vint k) + \prepost{q n bytes} s_p |-> arrayLR Tuchar 0 n (fun b : Z => ucharR q b) bytes \require lengthZ bytes = Z.of_N n \post[byte_search_result s_p (memchr bytes c)] emp). diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index 28228f8..554135e 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -3,14 +3,12 @@ * This software is distributed under the terms of the BedRock Open-Source License. * See the LICENSE-BedRock file in the repository root for details. *) +(* Require Import skylabs.auto.cpp.proof. -Require Import skylabs.auto.cpp.hints.anyR. +Require Import skylabs.auto.cpp.hints.anyR.*) (** BEGIN: SKYLABS DEFAULT PROOF IMPORTS *) Require Import skylabs.auto.cpp.prelude.proof. -Require Import skylabs.cpp.array. -Import expr_join. -#[local] Hint Resolve delayed_case.smash_delayed_case_B | 1000 : br_hints. -#[local] Hint Resolve delayed_case.expr_join.smash_delayed_case_B | 1000 : br_hints. +(*Require Import skylabs.cpp.array.*) (** END: SKYLABS DEFAULT PROOF IMPORTS *) Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.cstring.spec. @@ -20,21 +18,27 @@ Import normalize.only_provable_norm. Import normalize.normalize_ptr. Import refine_lib. +Import expr_join. + +#[local] Hint Resolve delayed_case.smash_delayed_case_B | 1000 : br_hints. +#[local] Hint Resolve delayed_case.expr_join.smash_delayed_case_B | 1000 : br_hints. + +#[only(cfracsplittable)] derive cstring.R. (*Upstream into auto*) Section with_cpp. - Context `{Σ : cpp_logic} `{MOD : module ⊧ σ}. + Context `{Σ : cpp_logic} {σ:genv} . (*`{MOD : module ⊧ σ}.*) - cpp.spec "test_strlen()" default. + cpp.spec "test_strlen()" from module default. Lemma test_strlen_ok : verify[module] "test_strlen()". - Proof. verify_spec; go; ego. Qed. + Proof. verify_spec; go. Qed. - cpp.spec "test_strcmp()" default. + cpp.spec "test_strcmp()" from module default. Lemma test_strcmp_ok : verify[module] "test_strcmp()". - Proof. verify_spec; go; ego. Qed. + Proof. verify_spec; go. Qed. - cpp.spec "test_strncmp()" default. + cpp.spec "test_strncmp()" from module default. Lemma test_strncmp_ok : verify[module] "test_strncmp()". - Proof. verify_spec; go; ego. Qed. + Proof. verify_spec; go. Qed. #[local] Fixpoint split_bytes_at_null (bytes : list N) : option (list N * list N) := @@ -315,27 +319,21 @@ Section with_cpp. Hint Resolve cstring_arrayLR : sl_opacity. #[local, program] Definition arrayLR_open_cstring_C - (p : ptr) q k bytes tail - (Hex : exists s, unpack_cstring bytes = Some (s, tail)) := + (p : ptr) q k bytes s tail + (Hex : unpack_cstring bytes =[Vm]=> Some (s, tail)) := \cancelx - \consuming p |-> arrayLR "char" 0 k - (λ v : N, charR q v) bytes - \proving{s (Hunpack : unpack_cstring bytes = Some (s, tail))} - p |-> cstring.R q s + \consuming p |-> arrayLR "char" 0 k (λ v : N, charR q v) bytes + \bound qq ss + \proving p |-> cstring.R qq ss + \through [| qq = q |] + \through [| ss = s |] \deduce p |-> arrayLR "char" (k - lengthZ tail) k (λ v : N, charR q v) tail \end@{mpred}. Next Obligation. - intros p q k bytes tail [s0 Hunpack0]. - iIntros "Harr". - pose proof (unpack_cstring_sound _ _ _ Hunpack0) as [Hbytes0 Hwf0]. - iPoseProof (arrayLR_cstring q bytes k tail p s0 Hbytes0 Hwf0 with "Harr") - as "(%Hk & Hs0 & Htail)". - iFrame "Htail". - iIntros (s Hunpack). - rewrite Hunpack0 in Hunpack. - injection Hunpack as <-. - iExact "Hs0". + intros p q k bytes s tail Hs%RedEq_eq. + pose proof (unpack_cstring_sound _ _ _ Hs) as [Hbytes0 Hwf0]. work. + rewrite arrayLR_cstring . work. by rewrite app_nil_r. done. Qed. #[local] Hint Resolve arrayLR_open_cstring_C : sl_opacity. @@ -450,95 +448,67 @@ Section with_cpp. Qed. *) - cpp.spec "test_strlen_array_buffer()" default. + cpp.spec "test_strlen_array_buffer()" from module default. Lemma test_strlen_array_buffer_ok : verify[module] "test_strlen_array_buffer()". Proof. verify_spec; go. - assert (Hex : - exists s, - unpack_cstring - (cstring.to_zstring "ab"%bs ++ [99%N; 100%N; 0%N]) = - Some (s, [99%N; 100%N; 0%N])) by (eexists; reflexivity). - ego. Qed. - cpp.spec "test_strcmp_array_buffer()" default. + cpp.spec "test_strcmp_array_buffer()" from module default. Lemma test_strcmp_array_buffer_ok : verify[module] "test_strcmp_array_buffer()". Proof. verify_spec; go. - assert (Hex : - exists s, - unpack_cstring - (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) = - Some (s, [120%N; 0%N])) by (eexists; reflexivity). - assert (Hey : - exists s, - unpack_cstring - (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) = - Some (s, [121%N; 0%N])) by (eexists; reflexivity). - ego. Qed. - cpp.spec "test_strncmp_array_buffer()" default. + cpp.spec "test_strncmp_array_buffer()" from module default. Lemma test_strncmp_array_buffer_ok : verify[module] "test_strncmp_array_buffer()". Proof. verify_spec; go. - assert (Hex : - exists s, - unpack_cstring - (cstring.to_zstring "ab"%bs ++ [120%N; 0%N]) = - Some (s, [120%N; 0%N])) by (eexists; reflexivity). - assert (Hey : - exists s, - unpack_cstring - (cstring.to_zstring "ab"%bs ++ [121%N; 0%N]) = - Some (s, [121%N; 0%N])) by (eexists; reflexivity). - ego. Qed. - cpp.spec "test_strchr()" default. + cpp.spec "test_strchr()" from module default. Lemma test_strchr_ok : verify[module] "test_strchr()". - Proof using MOD. - verify_spec; go; ego. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go; ego. + Proof. + verify_spec; go. + Arith.arith_simpl; go. + Arith.arith_simpl; go. Qed. - cpp.spec "test_strrchr()" default. + cpp.spec "test_strrchr()" from module default. Lemma test_strrchr_ok : verify[module] "test_strrchr()". - Proof using MOD. - verify_spec; go; ego. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go; ego. + Proof. + verify_spec; go. + Arith.arith_simpl; go. + Arith.arith_simpl; go. Qed. - cpp.spec "test_strspn()" default. + cpp.spec "test_strspn()" from module default. Lemma test_strspn_ok : verify[module] "test_strspn()". - Proof. verify_spec; go; ego. Qed. + Proof. verify_spec; go. Qed. - cpp.spec "test_strcspn()" default. + cpp.spec "test_strcspn()" from module default. Lemma test_strcspn_ok : verify[module] "test_strcspn()". - Proof. verify_spec; go; ego. Qed. + Proof. verify_spec; go. Qed. - cpp.spec "test_strpbrk()" default. + cpp.spec "test_strpbrk()" from module default. Lemma test_strpbrk_ok : verify[module] "test_strpbrk()". - Proof using MOD. - verify_spec; go; ego. - Arith.arith_simpl; go; ego. + Proof. + verify_spec; go. + Arith.arith_simpl; go. Qed. - cpp.spec "test_strstr()" default. + cpp.spec "test_strstr()" from module default. Lemma test_strstr_ok : verify[module] "test_strstr()". - Proof using MOD. - verify_spec; go; ego. - Arith.arith_simpl; go; ego. - Arith.arith_simpl; go; ego. + Proof. + verify_spec; go. + Arith.arith_simpl; go. + Arith.arith_simpl; go. Qed. - cpp.spec "test_cstring_slice1()" default. + cpp.spec "test_cstring_slice1()" from module default. Lemma test_cstring_slice1_ok : verify[module] "test_cstring_slice1()". Proof. verify_spec; go. Qed. From 699fffdef08dd9056a24823c9a27019f49b6ea43 Mon Sep 17 00:00:00 2001 From: Lennart Beringer Date: Fri, 1 May 2026 03:32:11 -0400 Subject: [PATCH 11/11] Reviewed specs --- rocq-brick-libstdcpp/proof/cstring/pred.v | 264 +----------------- rocq-brick-libstdcpp/proof/cstring/spec.v | 154 ++++------ rocq-brick-libstdcpp/test/cstring/proof.v | 173 +++++------- .../test/cstring/proof_mem_functions.v | 246 +++++++++------- 4 files changed, 272 insertions(+), 565 deletions(-) diff --git a/rocq-brick-libstdcpp/proof/cstring/pred.v b/rocq-brick-libstdcpp/proof/cstring/pred.v index 6f58525..7f3787a 100644 --- a/rocq-brick-libstdcpp/proof/cstring/pred.v +++ b/rocq-brick-libstdcpp/proof/cstring/pred.v @@ -14,96 +14,6 @@ Require Export skylabs.brick.libstdcpp.cstring.model. #[local] Open Scope Z_scope. -(** [object_bytesR byte_ty q bytes] is an abstract counted byte view of an - object range. The payload is the unsigned-byte values observed by the - memory functions; [byte_ty] records the one-byte pointer-stepping type used - for returned interior pointers. *) -Axiom object_bytesR : forall `{Σ : cpp_logic} {σ : genv}, - type -> cQp.t -> list Z -> Rep. - -Axiom object_bytesR_cfrac : forall `{Σ : cpp_logic} {σ : genv} byte_ty bytes, - CFractional (fun q => object_bytesR byte_ty q bytes). -#[global] Existing Instance object_bytesR_cfrac. - -#[global] Instance object_bytesR_as_cfrac `{Σ : cpp_logic, σ : genv} - byte_ty q bytes : - AsCFractional (object_bytesR byte_ty q bytes) - (fun q => object_bytesR byte_ty q bytes) q. -Proof. solve_as_cfrac. Qed. - -(** [object_bytes_anyR byte_ty q n] owns an [n]-byte destination range at - permission [q] whose previous byte values are irrelevant. Specs for - mutating functions may still require [q = 1$m]. *) -Axiom object_bytes_anyR : forall `{Σ : cpp_logic} {σ : genv}, - type -> cQp.t -> Z -> Rep. - -Axiom object_bytesR_to_arrayLR : forall `{Σ : cpp_logic} {σ : genv} - (p : ptr) ty q hi bytes, - lengthZ bytes = hi -> - p |-> object_bytesR ty q bytes ⊢ - p |-> arrayLR ty 0 hi (fun b : Z => ucharR q b) bytes. - -Axiom object_bytesR_of_arrayLR : forall `{Σ : cpp_logic} {σ : genv} - (p : ptr) ty q hi bytes, - lengthZ bytes = hi -> - p |-> arrayLR ty 0 hi (fun b : Z => ucharR q b) bytes ⊢ - p |-> object_bytesR ty q bytes. - -Axiom object_bytes_anyR_of_anyR_array : forall `{Σ : cpp_logic} {σ : genv} - (p : ptr) ty q n, - p |-> anyR (Tarray ty n) q ⊢ - p |-> object_bytes_anyR ty q (Z.of_N n). - -Lemma borrow_arrayR_cstringR `{Σ : cpp_logic, σ : genv} - (p : ptr) q bytes s tail : - bytes = cstring.to_zstring s ++ tail -> - cstring.WF s -> - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) - bytes ⊢ - p |-> cstring.R q s ∗ - (p |-> cstring.R q s -∗ - p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) - bytes). -Proof. - intros Hbytes Hwf. - subst bytes. - rewrite (arrayR_app (fun c : N => charR q c) (Tchar_ char_type.Cchar)). - iIntros "[Hs Htail]". - iSplitL "Hs". - - rewrite /cstring.R /zstring.R. iFrame. done. - - iIntros "Hs". - rewrite /cstring.R /zstring.R. - iDestruct "Hs" as "[Hs _]". - iFrame. -Qed. - -Lemma borrow_arrayLR_cstringR `{Σ : cpp_logic, σ : genv} - (p : ptr) q bytes s tail : - bytes = cstring.to_zstring s ++ tail -> - cstring.WF s -> - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) - (fun c : N => charR q c) bytes ⊢ - p |-> cstring.R q s ∗ - (p |-> cstring.R q s -∗ - p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ bytes) - (fun c : N => charR q c) bytes). -Proof. - intros Hbytes Hwf. - rewrite arrayLR.unlock _at_sep. - iIntros "[_ Harr]". - rewrite _at_offsetR _at_sub_0; [|done]. - iPoseProof (borrow_arrayR_cstringR p q bytes s tail Hbytes Hwf with "Harr") - as "[Hs Hclose]". - iSplitL "Hs". - - iExact "Hs". - - iIntros "Hs". - iPoseProof ("Hclose" with "Hs") as "Harr". - rewrite /arrayLR. - iSplit. - + iPureIntro. lia. - + iExact "Harr". -Qed. - Lemma offset_entails `{Σ : cpp_logic, σ : genv} (o : offset) (P Q : Rep) : (P ⊢ Q) -> o |-> P ⊢ o |-> Q. @@ -276,67 +186,6 @@ Proof. reflexivity. Qed. -Lemma arrayR_ucharR_object_bytesR `{Σ : cpp_logic, σ : genv} - (p : ptr) xs : - p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ - p |-> object_bytesR Tuchar 1$m xs. -Proof. - iIntros "Hs". - iApply object_bytesR_of_arrayLR; [reflexivity|]. - rewrite arrayLR.unlock _at_sep. - iSplit; [iPureIntro; lia|]. - rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. -Qed. - -Lemma object_bytesR_half_split `{Σ : cpp_logic, σ : genv} - (p : ptr) ty bytes : - p |-> object_bytesR ty 1$m bytes ⊣⊢ - p |-> object_bytesR ty (cQp.mk false (1/2)) bytes ∗ - p |-> object_bytesR ty (cQp.mk false (1/2)) bytes. -Proof. - rewrite -(cfractional (P := fun q => p |-> object_bytesR ty q bytes) - (cQp.mk false (1/2)) (cQp.mk false (1/2))). - rewrite -cQp.mk_add' Qp.half_half. - reflexivity. -Qed. - -Lemma object_bytesR_prefix_tail0 `{Σ : cpp_logic, σ : genv} - (p : ptr) ty q mid hi xs0 xs1 : - lengthZ (xs0 ++ xs1) = hi -> - lengthZ xs0 = mid -> - lengthZ xs1 = (hi - mid)%Z -> - p |-> object_bytesR ty q (xs0 ++ xs1) ⊣⊢ - p |-> object_bytesR ty q xs0 ∗ - p .[ty ! mid] |-> object_bytesR ty q xs1. -Proof. - intros Htotal Hhead Htail. - iSplit. - - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p ty q hi (xs0 ++ xs1) - Htotal with "Hs") as "Hs". - iPoseProof (arrayLR_prefix_tail0 p ty mid hi - (fun b : Z => ucharR q b) xs0 xs1 - ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) - ltac:(lia) ltac:(lia) with "Hs") as "[Hhead Htail]". - iPoseProof (object_bytesR_of_arrayLR p ty q mid xs0 - Hhead with "Hhead") as "Hhead". - iPoseProof (object_bytesR_of_arrayLR (p .[ ty ! mid]) ty q - (hi - mid) xs1 Htail with "Htail") as "Htail". - iFrame. - - iIntros "[Hhead Htail]". - iPoseProof (object_bytesR_to_arrayLR p ty q mid xs0 - Hhead with "Hhead") as "Hhead". - iPoseProof (object_bytesR_to_arrayLR (p .[ ty ! mid]) ty q - (hi - mid) xs1 Htail with "Htail") as "Htail". - iPoseProof ((arrayLR_prefix_tail0 p ty mid hi - (fun b : Z => ucharR q b) xs0 xs1 - ltac:(rewrite <- Hhead; rewrite N2Z.id; reflexivity) - ltac:(lia) ltac:(lia)) with "[$Hhead $Htail]") as "Hs". - iPoseProof (object_bytesR_of_arrayLR p ty q hi - (xs0 ++ xs1) Htotal with "Hs") as "Hs". - iExact "Hs". -Qed. - Lemma arrayLR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) q n xs : N.to_nat n = length xs -> p |-> arrayLR Tuchar 0 (Z.of_N n) (fun c : Z => ucharR q c) xs ⊢ @@ -403,46 +252,6 @@ Ltac solve_memchr_side := | |- _ => lia end. -Lemma object_bytesR_ucharR_anyR `{Σ : cpp_logic, σ : genv} - (p : ptr) q n xs : - N.to_nat n = length xs -> - p |-> object_bytesR Tuchar q xs ⊢ - p |-> anyR (Tarray Tuchar n) q. -Proof. - intros Hlen. - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar q (Z.of_N n) xs - ltac:(apply lengthZ_of_to_nat_length; exact Hlen) - with "Hs") as "Hs". - iApply (arrayLR_ucharR_anyR with "Hs"). - exact Hlen. -Qed. - -Lemma object_bytesR_ucharR_object_bytes_anyR - `{Σ : cpp_logic, σ : genv} (p : ptr) q n xs : - N.to_nat n = length xs -> - p |-> object_bytesR Tuchar q xs ⊢ - p |-> object_bytes_anyR Tuchar q (Z.of_N n). -Proof. - intros Hlen. - iIntros "Hs". - iPoseProof (object_bytesR_ucharR_anyR _ q n xs Hlen with "Hs") as "Hs". - iApply (object_bytes_anyR_of_anyR_array with "Hs"). -Qed. - -Lemma object_bytesR_ucharR_arrayR `{Σ : cpp_logic, σ : genv} - (p : ptr) q xs : - p |-> object_bytesR Tuchar q xs ⊢ - p |-> arrayR Tuchar (fun b : Z => ucharR q b) xs. -Proof. - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar q (lengthZ xs) xs - eq_refl with "Hs") as "Hs". - rewrite arrayLR.unlock _at_sep. - iDestruct "Hs" as "[_ Hs]". - rewrite _at_offsetR _at_sub_0; [iExact "Hs"|done]. -Qed. - Lemma at_arrayR_ucharR_cons `{Σ : cpp_logic, σ : genv} (p : ptr) q x xs : p |-> arrayR Tuchar (fun b : Z => ucharR q b) (x :: xs) ⊣⊢ @@ -498,77 +307,16 @@ Proof. + iApply (IH with "Hxs"). Qed. -Lemma object_bytesR_ucharR_arrayLR_anyR - `{Σ : cpp_logic, σ : genv} (p : ptr) q n xs : - N.to_nat n = length xs -> - p |-> object_bytesR Tuchar q xs ⊢ - p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun _ : unit => anyR Tuchar q) (replicateN n ()). -Proof. - intros Hlen. - iIntros "Hs". - iPoseProof (object_bytesR_ucharR_arrayR p q xs with "Hs") as "Hs". - rewrite arrayLR.unlock _at_sep. - iSplit. - - iPureIntro. - unfold lengthZ, lengthN, replicateN. - rewrite length_replicate N2Nat.id. - lia. - - rewrite _at_offsetR _at_sub_0; [|done]. - rewrite -(N2Nat.id n) Hlen. - iApply (arrayR_ucharR_arrayR_anyR with "Hs"). -Qed. - -Lemma object_bytesR_arrayLR_cons `{Σ : cpp_logic, σ : genv} - (p : ptr) x xs : - p |-> object_bytesR Tuchar 1$m (x :: xs) ⊣⊢ - (type_ptr Tuchar (p .[Tuchar ! 0]) ∗ p .[Tuchar ! 0] |-> ucharR 1$m x) ∗ - p |-> arrayLR Tuchar 1 (lengthZ (x :: xs)) (fun b : Z => ucharR 1$m b) xs. -Proof. - iSplit. - - iIntros "Hs". - iPoseProof (object_bytesR_to_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) - (x :: xs) eq_refl with "Hs") as "Hs". - iEval (rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) - (fun b : Z => ucharR 1$m b) x xs)) in "Hs". - iExact "Hs". - - iIntros "[[#Hty Hx] Hs]". - iApply (object_bytesR_of_arrayLR p Tuchar 1$m (lengthZ (x :: xs)) - (x :: xs) eq_refl). - rewrite (arrayLR_cons p 0 (lengthZ (x :: xs)) - (fun b : Z => ucharR 1$m b) x xs). - iFrame "# ∗". -Qed. - -Lemma uchar_cells_object_bytesR_two `{Σ : cpp_logic, σ : genv} - (p : ptr) a b : - p |-> ucharR 1$m a ∗ - p .[Tuchar ! 1] |-> ucharR 1$m b ⊢ - p |-> object_bytesR Tuchar 1$m [a; b]. -Proof. - iIntros "(Ha & Hb)". - iDestruct (observe (p |-> type_ptrR Tuchar) with "Ha") as "#Hty0". - iDestruct (observe (p .[Tuchar ! 1] |-> type_ptrR Tuchar) with "Hb") - as "#Hty1". - iApply arrayR_ucharR_object_bytesR. - rewrite (at_arrayR_ucharR_cons p 1$m a [b]). - iFrame "Hty0 Ha". - rewrite (at_arrayR_ucharR_cons (p .[Tuchar ! 1]) 1$m b []). - iFrame "Hty1 Hb". - rewrite arrayR_nil _at_sep. - iSplit. - - iApply (at_type_ptrR_validR_plus_one with "Hty1"). - - iPureIntro. done. -Qed. - Lemma arrayR_ucharR_anyR `{Σ : cpp_logic, σ : genv} (p : ptr) n xs : - N.to_nat n = length xs -> + n = lengthN xs -> p |-> arrayR Tuchar (fun b : Z => ucharR 1$m b) xs ⊢ p |-> anyR (Tarray Tuchar n) 1$m. Proof. intros Hlen. iIntros "Hs". - iPoseProof (arrayR_ucharR_object_bytesR with "Hs") as "Hs". - iApply (object_bytesR_ucharR_anyR with "Hs"). - exact Hlen. + iPoseProof (arrayR_ucharR_arrayR_anyR with "Hs") as "Hs". + subst n. + work. + rewrite arrayLR.unlock _at_sep. arith_simpl. work. + rewrite _at_sub_0; [ rewrite lengthN_replicateN; iFrame |]; done. Qed. diff --git a/rocq-brick-libstdcpp/proof/cstring/spec.v b/rocq-brick-libstdcpp/proof/cstring/spec.v index b0f921f..3a4eb5c 100644 --- a/rocq-brick-libstdcpp/proof/cstring/spec.v +++ b/rocq-brick-libstdcpp/proof/cstring/spec.v @@ -6,7 +6,7 @@ Require Import skylabs.auto.cpp.specs. Require Import skylabs.auto.cpp.prelude.proof. -Require Export skylabs.brick.libstdcpp.cstring.pred. +Require Export skylabs.brick.libstdcpp.cstring.model. Require Import skylabs.brick.libstdcpp.cstring.inc_cstring_cpp. #[local] Set Primitive Projections. @@ -14,11 +14,11 @@ Require Import skylabs.brick.libstdcpp.cstring.inc_cstring_cpp. #[local] Open Scope Z_scope. Notation search_result p found := - match found with + (match found with | Some 0 => Vptr p | Some off => Vptr (p .[ Tchar ! off ]) | None => Vptr nullptr - end (only parsing). + end) (only parsing). Notation byte_search_result byte_ty p found := match found with @@ -34,7 +34,7 @@ Section with_cpp. (\arg{s_p} "__s" (Vptr s_p) \prepost{q s} s_p |-> cstring.R q s \require valid<"unsigned long"> (cstring.strlen s) - \post[Vn (Z.to_N (cstring.strlen s))] emp). + \post[Vint (cstring.strlen s)] emp). cpp.spec "strcmp" with (\arg{s1_p} "__s1" (Vptr s1_p) @@ -123,132 +123,82 @@ Section with_cpp. \prepost{needle_q needle} needle_p |-> cstring.R needle_q needle \post[search_result haystack_p (strstr haystack needle)] emp). -(* - Archived exact [unsigned char] array specs. These were useful for the first - byte-array slice, but they are too narrow for the standard [void*] memory - APIs, whose textual specifications operate on object bytes. - - cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_spec_old with +(* sound but weak in C++17: memchr behaves as if it reads the bytes + sequentially and stops as soon as a matching bytes is found: if the array + pointed to by ptr is smaller than count, but the match is found within the + array, the behavior is well-defined. *) + cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_spec with (\arg{s_p} "__s" (Vptr s_p) \arg{c} "__c" (Vint c) - \arg{k} "__n" (Vint k) - \prepost{q n bytes} s_p |-> arrayLR Tuchar 0 n + \arg{n} "__n" (Vint n) + \prepost{q hi bytes} s_p |-> arrayLR Tuchar 0 hi (fun b : Z => ucharR q b) bytes - \require lengthZ bytes = Z.of_N n - \post[byte_search_result s_p (memchr bytes c)] emp). + \require match memchr bytes c with + | Some off => True + | None => (n <= hi)%Z + end + (*equivalently: \require hi >= n \/ (hi < n /\ exists off, memchr bytes c = Some off)*) + \post[byte_search_result Tuchar s_p + (memchr (takeZ n bytes) c)] emp). cpp.spec "memchr(const void*, int, unsigned long)" as memchr_const_spec with (\arg{s_p} "__s" (Vptr s_p) \arg{c} "__c" (Vint c) - \arg{n} "__n" (Vn n) - \prepost{q bytes} s_p |-> arrayLR Tuchar 0 (Z.of_N n) + \arg{n} "__n" (Vint n) + \prepost{q hi bytes} s_p |-> arrayLR Tuchar 0 hi (fun b : Z => ucharR q b) bytes - \require lengthZ bytes = Z.of_N n - \post[byte_search_result s_p (memchr bytes c)] emp). - - cpp.spec "memcmp" with - (\arg{s1_p} "__s1" (Vptr s1_p) - \arg{s2_p} "__s2" (Vptr s2_p) - \arg{n} "__n" (Vn n) - \prepost{q1 bytes1} s1_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR q1 b) bytes1 - \prepost{q2 bytes2} s2_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR q2 b) bytes2 - \require lengthZ bytes1 = Z.of_N n - \require lengthZ bytes2 = Z.of_N n - \post[Vint (memcmp bytes1 bytes2)] emp). - - cpp.spec "memset" with + \require match memchr bytes c with + | Some off => True + | None => (n <= hi)%Z + end + (*equivalently: \require hi >= n \/ (hi < n /\ exists off, memchr bytes c = Some off)*) + \post[byte_search_result Tuchar s_p + (memchr (takeZ n bytes) c)] emp). + + cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_simple_spec with (\arg{s_p} "__s" (Vptr s_p) \arg{c} "__c" (Vint c) - \arg{n} "__n" (Vn n) - \pre s_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) - \post[Vptr s_p] s_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR 1$m b) (memset c (Z.of_N n))). + \arg{n} "__n" (Vint n) + \prepost{q bytes} s_p |-> arrayLR Tuchar 0 n (fun b : Z => ucharR q b) bytes + \post[byte_search_result Tuchar s_p (memchr bytes c)] emp). - cpp.spec "memcpy" with - (\arg{dest_p} "__dest" (Vptr dest_p) - \arg{src_p} "__src" (Vptr src_p) - \arg{n} "__n" (Vn n) - \prepost{q bytes} src_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR q b) bytes - \pre dest_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) - \require lengthZ bytes = Z.of_N n - \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR 1$m b) bytes). - - cpp.spec "memmove" with - (\arg{dest_p} "__dest" (Vptr dest_p) - \arg{src_p} "__src" (Vptr src_p) - \arg{n} "__n" (Vn n) - \prepost{q bytes} src_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR q b) bytes - \pre dest_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun _ : unit => anyR Tuchar 1$m) (replicateZ (Z.of_N n) tt) - \require lengthZ bytes = Z.of_N n - \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 (Z.of_N n) - (fun b : Z => ucharR 1$m b) bytes). - *) - - cpp.spec "memchr(void*, int, unsigned long)" as memchr_mut_spec with + cpp.spec "memchr(const void*, int, unsigned long)" as memchr_const_simple_spec with (\arg{s_p} "__s" (Vptr s_p) \arg{c} "__c" (Vint c) - \arg{n} "__n" (Vn n) - \prepost{byte_ty q bytes} s_p |-> object_bytesR byte_ty q bytes - \require lengthZ bytes = Z.of_N n - \post[byte_search_result byte_ty s_p (memchr bytes c)] emp). - - cpp.spec "memchr(const void*, int, unsigned long)" as memchr_const_spec with - (\arg{s_p} "__s" (Vptr s_p) - \arg{c} "__c" (Vint c) - \arg{n} "__n" (Vn n) - \prepost{byte_ty q bytes} s_p |-> object_bytesR byte_ty q bytes - \require lengthZ bytes = Z.of_N n - \post[byte_search_result byte_ty s_p (memchr bytes c)] emp). + \arg{n} "__n" (Vint n) + \prepost{q bytes} s_p |-> arrayLR Tuchar 0 n (fun b : Z => ucharR q b) bytes + \post[byte_search_result Tuchar s_p (memchr bytes c)] emp). cpp.spec "memcmp" with (\arg{s1_p} "__s1" (Vptr s1_p) \arg{s2_p} "__s2" (Vptr s2_p) - \arg{n} "__n" (Vn n) - \prepost{byte_ty1 q1 bytes1} s1_p |-> - object_bytesR byte_ty1 q1 bytes1 - \prepost{byte_ty2 q2 bytes2} s2_p |-> - object_bytesR byte_ty2 q2 bytes2 - \require lengthZ bytes1 = Z.of_N n - \require lengthZ bytes2 = Z.of_N n + \arg{z} "__n" (Vint z) + \prepost{q1 bytes1} s1_p |-> arrayLR Tuchar 0 z (fun b : Z => ucharR q1 b) bytes1 + \prepost{q2 bytes2} s2_p |-> arrayLR Tuchar 0 z (fun b : Z => ucharR q2 b) bytes2 \post[Vint (memcmp bytes1 bytes2)] emp). cpp.spec "memset" with (\arg{s_p} "__s" (Vptr s_p) \arg{c} "__c" (Vint c) - \arg{n} "__n" (Vn n) - \pre{byte_ty} s_p |-> object_bytes_anyR byte_ty 1$m (Z.of_N n) - \post[Vptr s_p] s_p |-> object_bytesR byte_ty 1$m - (memset c (Z.of_N n))). + \arg{z} "__n" (Vint z) + \pre{l} s_p |-> arrayLR Tuchar 0 z (fun _ : unit => anyR Tuchar 1$m) l (*(replicateZ z tt)*) + \post[Vptr s_p] s_p |-> arrayLR Tuchar 0 z (fun b : Z => ucharR 1$m b) (memset c z)). cpp.spec "memcpy" with (\arg{dest_p} "__dest" (Vptr dest_p) \arg{src_p} "__src" (Vptr src_p) - \arg{n} "__n" (Vn n) - \prepost{src_byte_ty q bytes} src_p |-> - object_bytesR src_byte_ty q bytes - \pre{dest_byte_ty} dest_p |-> - object_bytes_anyR dest_byte_ty 1$m (Z.of_N n) - \require lengthZ bytes = Z.of_N n - \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m - bytes). + \arg{z} "__n" (Vint z) + \prepost{q bytes} src_p |-> arrayLR Tuchar 0 z (fun b : Z => ucharR q b) bytes + \pre{l} dest_p |-> arrayLR Tuchar 0 z (fun _ : unit => anyR Tuchar 1$m) l (*(replicateZ z tt)*) + \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 z (fun b : Z => ucharR 1$m b) bytes). + (*Sound but weak: overlapping buffers not supported here*) cpp.spec "memmove" with (\arg{dest_p} "__dest" (Vptr dest_p) \arg{src_p} "__src" (Vptr src_p) - \arg{n} "__n" (Vn n) - \prepost{src_byte_ty q bytes} src_p |-> - object_bytesR src_byte_ty q bytes - \pre{dest_byte_ty} dest_p |-> - object_bytes_anyR dest_byte_ty 1$m (Z.of_N n) - \require lengthZ bytes = Z.of_N n - \post[Vptr dest_p] dest_p |-> object_bytesR dest_byte_ty 1$m - bytes). + \arg{z} "__n" (Vint z) + \prepost{q bytes} src_p |-> arrayLR Tuchar 0 z (fun b : Z => ucharR q b) bytes + \pre{l} dest_p |-> arrayLR Tuchar 0 z (fun _ : unit => anyR Tuchar 1$m) l (*(replicateZ z tt)*) + \post[Vptr dest_p] dest_p |-> arrayLR Tuchar 0 z (fun b : Z => ucharR 1$m b) bytes). + End with_cpp. diff --git a/rocq-brick-libstdcpp/test/cstring/proof.v b/rocq-brick-libstdcpp/test/cstring/proof.v index 554135e..f0a685e 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof.v +++ b/rocq-brick-libstdcpp/test/cstring/proof.v @@ -3,19 +3,14 @@ * This software is distributed under the terms of the BedRock Open-Source License. * See the LICENSE-BedRock file in the repository root for details. *) -(* -Require Import skylabs.auto.cpp.proof. -Require Import skylabs.auto.cpp.hints.anyR.*) -(** BEGIN: SKYLABS DEFAULT PROOF IMPORTS *) Require Import skylabs.auto.cpp.prelude.proof. -(*Require Import skylabs.cpp.array.*) -(** END: SKYLABS DEFAULT PROOF IMPORTS *) Require Import skylabs.brick.libstdcpp.cassert.spec. Require Import skylabs.brick.libstdcpp.cstring.spec. +Require Export skylabs.cpp.string. + Require Import skylabs.brick.libstdcpp.test.cstring.test_cpp. Import normalize.only_provable_norm. - Import normalize.normalize_ptr. Import refine_lib. Import expr_join. @@ -114,6 +109,7 @@ Section with_cpp. + exact Hfor. Qed. + (* Currently dead but provable lemmas #[local] Lemma split_bytes_at_cstring_complete prefix tail : List.Forall (fun b => b <> 0%N) prefix -> split_bytes_at_cstring (prefix ++ [0%N] ++ tail) = @@ -125,8 +121,6 @@ Section with_cpp. reflexivity. Qed. - (* - Dead lemmas #[local] Lemma split_bytes_at_null_spec bytes prefix tail : split_bytes_at_null bytes = Some (prefix, tail) <-> bytes = prefix ++ 0%N :: tail /\ @@ -270,18 +264,6 @@ Section with_cpp. - exact Hwf. Qed. - - (* Older accepted experiment kept only as a reminder that proof-bearing - binders inside [\proving{...}] are syntactically accepted. *) -(* - #[local] Lemma arrayLR_cstring bytes m tail (p : ptr) s : - bytes = cstring.to_zstring s ++ tail -> - cstring.WF s -> - p |-> arrayLR "char" 0 m (λ v : N, charR 1$m v) bytes ⊢ - p |-> cstring.R 1$m s ∗ - p |-> arrayLR "char" (m - Zlength tail) m (λ v : N, charR 1$m v) tail. -*) - #[local] Lemma arrayLR_cstring q bytes m tail (p : ptr) s : bytes = cstring.to_zstring s ++ tail -> cstring.WF s -> @@ -290,15 +272,11 @@ Section with_cpp. p |-> cstring.R q s ∗ p |-> arrayLR "char" (m - lengthZ tail) m (λ v : N, charR q v) tail. Proof. - intros -> Hwf. - rewrite arrayLR.unlock _at_sep lengthN_app. - arith_simpl. - iIntros "[%Hlen Harr]". - rewrite _at_offsetR _at_sub_0; [|done]. - rewrite arrayR_app__N. - iDestruct "Harr" as "[Hs Htail]". - assert (H: m - lengthZ tail = lengthZ (cstring.to_zstring s)) by lia. - rewrite H /cstring.R /zstring.R. iFrame. done. + intros -> Hwf; work. + rewrite arrayLR.unlock _at_sep. + arith_simpl; work. + rewrite _at_sub_0; [|done]. + rewrite /cstring.R /zstring.R; iFrame; done. Qed. Hint Resolve arrayLR_cstring : sl_opacity. @@ -310,10 +288,10 @@ Section with_cpp. p |-> arrayLR "char" (m - lengthZ tail) m (λ v : N, charR q v) tail ⊢ p |-> arrayLR "char" 0 m (λ v : N, charR q v) bytes. Proof. - intros -> Hwf. work. arith_simpl. - rewrite lengthN_app. arith_simpl. - rewrite /cstring.R /zstring.R. work. - rewrite arrayLR.unlock. arith_simpl. work. + intros -> Hwf; work. + rewrite lengthN_app; arith_simpl. + rewrite /cstring.R /zstring.R; work. + rewrite arrayLR.unlock; arith_simpl; work. rewrite _at_sub_0; [trivial|done]. Qed. Hint Resolve cstring_arrayLR : sl_opacity. @@ -337,10 +315,60 @@ Section with_cpp. Qed. #[local] Hint Resolve arrayLR_open_cstring_C : sl_opacity. + Lemma at_charR_anyR (p : ptr) q x : + p |-> charR q x ⊢ p |-> anyR (Tchar_ char_type.Cchar) q. + Proof. + apply heap_pred._at_cancel. + apply primR_anyR. + Qed. + Lemma arrayR_charR_arrayR_anyR (p : ptr) q xs : + p |-> arrayR (Tchar_ char_type.Cchar) (fun c : N => charR q c) xs ⊢ + p |-> arrayR (Tchar_ char_type.Cchar) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) q) + (replicateN (lengthN xs) ()). + Proof. + revert p. + induction xs as [|x xs IH]. + all: intros p. + - rewrite /lengthN /= !arrayR_nil. reflexivity. + - rewrite arrayR_cons !_at_sep _at_offsetR. + iIntros "(Hty & Hx & Hxs)". + replace (lengthN (x :: xs)) with (N.succ (lengthN xs)) by + (rewrite /lengthN Nat2N.inj_succ; reflexivity). + rewrite replicateN_S. + rewrite arrayR_cons !_at_sep _at_offsetR. + iFrame "Hty". + iSplitL "Hx". + + iApply (at_charR_anyR with "Hx"). + + iApply (IH with "Hxs"). + Qed. + + Lemma arrayLR_charR_arrayLR_anyR (p : ptr) q xs : + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ xs) + (fun c : N => charR q c) xs ⊢ + p |-> arrayLR (Tchar_ char_type.Cchar) 0 (lengthZ xs) + (fun _ : unit => anyR (Tchar_ char_type.Cchar) q) + (replicateN (lengthN xs) ()). + Proof. + rewrite arrayLR.unlock _at_sep. + iIntros "[_ Harr]". + rewrite _at_offsetR _at_sub_0; [|done]. + iPoseProof (arrayR_charR_arrayR_anyR _ q with "Harr") as "Harr". + rewrite /arrayLR. + iSplit. + - iPureIntro. + unfold lengthZ, lengthN, replicateN. + rewrite length_replicate. + rewrite Nat2N.id. + lia. + - rewrite _at_offsetR _at_sub_0; [|done]. + iExact "Harr". + Qed. + #[local, program] Definition arrayLR_close_cstring_C (p : ptr) q mid k tail s (Hmid : mid = lengthZ (cstring.to_zstring s)) - (Htailk : mid = k - lengthZ tail) := + (Htailk : (mid = k - lengthZ tail)%Z) := \cancelx \consuming p |-> cstring.R q s \consuming p |-> arrayLR "char" mid k (λ v : N, charR q v) tail @@ -373,81 +401,6 @@ Section with_cpp. Qed. #[local] Hint Resolve arrayLR_close_cstring_C : sl_opacity. - (* - Experimental variants that internalize the unpack witness more aggressively. - - Both [arrayLR_open_cstring_guard_C] and [arrayLR_open_cstring_using_C] are - provable, but in this file they do not fire under [go]/[ego] at the - [test_strlen_array_buffer()] call site, even when the matching pure - existence fact is supplied explicitly in the proof context. We therefore - keep them parked for design/reference purposes and continue using the - simpler [arrayLR_open_cstring_C] together with an explicit [Hex] witness in - the verification proof. - - #[local, program] Definition arrayLR_open_cstring_guard_C - (p : ptr) q k bytes := - \cancelx - \guard (exists stail, unpack_cstring bytes = Some stail) - \consuming p |-> arrayLR "char" 0 k - (λ v : N, charR q v) bytes - \deduce{stail} [| unpack_cstring bytes = Some stail |] - \bound_existential s - \proving p |-> cstring.R q s - \instantiate s := fst stail - \deduce p |-> arrayLR "char" (k - lengthZ (snd stail)) k - (λ v : N, charR q v) (snd stail) - \end@{mpred}. - Next Obligation. - intros p q k bytes [stail Hunpack0]. - destruct stail as [s0 tail0]. - iIntros "Harr". - pose proof (unpack_cstring_sound _ _ _ Hunpack0) as [Hbytes0 Hwf0]. - iPoseProof (arrayLR_cstring q bytes k tail0 p s0 Hbytes0 Hwf0 with "Harr") - as "(%Hk & Hs0 & Htail)". - iExists (s0, tail0). - iSplitL "Htail". - { iSplit. - - iPureIntro. exact Hunpack0. - - iFrame. } - iIntros (??). subst. - cbn. - iIntros (?). - subst. - iExact "Hs0". - Qed. - - #[local, program] Definition arrayLR_open_cstring_using_C - (p : ptr) q k bytes := - \cancelx - \using [| exists stail, unpack_cstring bytes = Some stail |] - \consuming p |-> arrayLR "char" 0 k - (λ v : N, charR q v) bytes - \deduce{stail} [| unpack_cstring bytes = Some stail |] - \bound_existential s - \proving p |-> cstring.R q s - \instantiate s := fst stail - \deduce p |-> arrayLR "char" (k - lengthZ (snd stail)) k - (λ v : N, charR q v) (snd stail) - \end@{mpred}. - Next Obligation. - iIntros (p q k bytes) "[%Hex Harr]". - destruct Hex as [[s0 tail0] Hunpack0]. - pose proof (unpack_cstring_sound _ _ _ Hunpack0) as [Hbytes0 Hwf0]. - iPoseProof (arrayLR_cstring q bytes k tail0 p s0 Hbytes0 Hwf0 with "Harr") - as "(%Hk & Hs0 & Htail)". - iExists (s0, tail0). - iSplitL "Htail". - { iSplit. - - iPureIntro. exact Hunpack0. - - iFrame. } - iIntros (??). subst. - cbn. - iIntros (?). - subst. - iExact "Hs0". - Qed. - *) - cpp.spec "test_strlen_array_buffer()" from module default. Lemma test_strlen_array_buffer_ok : verify[module] "test_strlen_array_buffer()". diff --git a/rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v b/rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v index 4d89f00..7d9233d 100644 --- a/rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v +++ b/rocq-brick-libstdcpp/test/cstring/proof_mem_functions.v @@ -187,7 +187,11 @@ Section with_cpp. \cancelx \consuming p |-> arrayLR Tuchar 0 n (fun v : Z => ucharR q v) bytes - \proving p |-> object_bytes_anyR Tuchar q len + \bound byte_ty qq nn + \proving p |-> object_bytes_anyR byte_ty qq nn + \through [| byte_ty = Tuchar |] + \through [| qq = q |] + \through [| nn = len |] \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) \end@{mpred}. Next Obligation. @@ -217,11 +221,18 @@ Section with_cpp. iPoseProof (object_bytesR_ucharR_object_bytes_anyR p q (lengthN (takeZ len bytes)) (takeZ len bytes) ltac:(rewrite Nat2N.id; reflexivity) with "Hpre_bytes") as "Hpre_any". - rewrite Htake Z2N.id; [ | lia]. iFrame. - iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q - (lengthZ (dropZ len bytes)) - (dropZ len bytes) eq_refl). - rewrite arrayLR.unlock. arith_simpl. work; iFrame. + rewrite Htake Z2N.id; [ | lia]. + iAssert (p.[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes)) + with "[Htail]" as "Htail_bytes". + { iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q + (lengthZ (dropZ len bytes)) + (dropZ len bytes) eq_refl). + rewrite arrayLR.unlock. arith_simpl. work; iFrame. } + iSplitL "Htail_bytes". + - iExact "Htail_bytes". + - iIntros (byte_ty qq nn) "(%Hty & %Hq & %Hnn)". + subst byte_ty qq nn. + iExact "Hpre_any". Qed. #[local] Hint Resolve arrayLR_open_prefix_any_C | 1000 : sl_opacity. @@ -231,7 +242,11 @@ Section with_cpp. \cancelx \consuming p |-> arrayLR Tuchar 0 n (fun v : Z => ucharR q v) bytes - \proving p |-> object_bytesR Tuchar q (takeZ len bytes) + \bound byte_ty qq seg + \proving p |-> object_bytesR byte_ty qq seg + \through [| byte_ty = Tuchar |] + \through [| qq = q |] + \through [| seg = takeZ len bytes |] \deduce p .[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes) \end@{mpred}. Next Obligation. @@ -258,18 +273,26 @@ Section with_cpp. { iApply (object_bytesR_of_arrayLR p Tuchar q len (takeZ len bytes)). lia. rewrite arrayLR.unlock _at_sep _at_offsetR _at_sub_0; [work; iFrame | done]. } - iFrame "Hpre_bytes". iPoseProof (at_uchar_offset_eq p (lengthZ (takeZ len bytes)) len (arrayR Tuchar (fun v : Z => ucharR q v) (dropZ len bytes)) ltac:(unfold lengthZ; rewrite Htake; apply Z2N.id; lia) with "Htail") as "Htail". - iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q - (lengthZ (dropZ len bytes)) - (dropZ len bytes) eq_refl). - rewrite arrayLR.unlock. arith_simpl. work; iFrame. + iAssert (p.[Tuchar ! len] |-> object_bytesR Tuchar q (dropZ len bytes)) + with "[Htail]" as "Htail_bytes". + { iApply (object_bytesR_of_arrayLR (p.[Tuchar ! len]) Tuchar q + (lengthZ (dropZ len bytes)) + (dropZ len bytes) eq_refl). + rewrite arrayLR.unlock. arith_simpl. work; iFrame. } + iSplitL "Htail_bytes". + - iExact "Htail_bytes". + - iIntros (byte_ty qq seg) "(%Hty & %Hq & %Hseg)". + subst byte_ty qq seg. + iExact "Hpre_bytes". Qed. #[local] Hint Resolve arrayLR_open_prefix_bytes_C | 1000 : sl_opacity. + Remove Hints arrayLR_open_prefix_any_C arrayLR_open_prefix_bytes_C : sl_opacity. + (* The generic wrapper/openers above are useful proof principles, but the workspace lemmas below show a mixed picture: @@ -500,87 +523,110 @@ Section with_cpp. Lemma test_memset_ok : verify[module] "test_memset()". Proof using MOD _Σ thread_info Σ σ. verify_spec; go. - iExists Tuchar. - ego. - change (memset 120 2) with [120%Z; 120%Z]. - change (lengthZ [120%Z; 120%Z]) with 2%Z. - iAssert ( - s_addr .[Tuchar ! 2] |-> object_bytesR Tuchar 1$m - (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]))%I with "[$]" as "Htail". - iPoseProof (at_zero_intro s_addr - (object_bytesR Tuchar 1$m [120%Z; 120%Z]) with "[$]") as "Hmid". - iPoseProof (object_bytesR_read_head_uchar_after_open - s_addr (cQp.mk false 1%Qp) 0 120%Z [120%Z] - (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) - with "[$Hmid $Htail]") as "[H0 Hrest]". - (* Read back the first modified byte: [assert(s[0] == 'x');]. *) - iSplitL "H0"; [ iExact "H0" | iIntros "H0"]. - (* Now we are onto the next C++ instruction: [assert(s[1] == 'x');]. *) - go. - iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 1]) 120%Z - (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with "Hrest") - as "[[#Hty1 H1] Hrest]". - iPoseProof (at_zero_elim (s_addr .[Tuchar ! 1]) with "H1") as "H1". - (* Read back the second modified byte: [assert(s[1] == 'x');]. *) - iExists (Vint 120%Z), (cQp.mk false 1%Qp); iFrame "H1"; iIntros "H1". - (* Now we are onto the next C++ instruction: [assert(s[2] == 'c');]. *) - go. - change (dropZ 2 [97%Z; 98%Z; 99%Z; 100%Z]) with [99%Z; 100%Z]. - change (lengthZ (120%Z :: [99%Z; 100%Z])) with 3%Z. - iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 1 3 - (fun b : Z => ucharR 1$m b) 99%Z [100%Z])) in "Hrest". - iDestruct "Hrest" as "[[#Hty2 H2] Hrest]". - iPoseProof (at_uchar_offset_add_elim s_addr 1 1 2 - (ucharR 1$m 99%Z) ltac:(lia) with "H2") as "H2". - iExists (Vint 99%Z), (cQp.mk false 1%Qp); iFrame "H2"; iIntros "H2". - (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) - go. - iEval (rewrite (arrayLR_cons (s_addr .[Tuchar ! 1]) 2 3 - (fun b : Z => ucharR 1$m b) 100%Z [])) in "Hrest". - iDestruct "Hrest" as "[[#Hty3 H3] _]". - iPoseProof (at_uchar_offset_add_elim s_addr 1 2 3 - (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". - iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3"; iIntros "H3". - (* Now we are onto the next C++ instruction: - [assert(std::memset(s + 2, 0x123, 1) == s + 2);]. *) - go. - iPoseProof (at_zero_elim s_addr with "H0") as "H0". - iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z - with "[$H0 $H1]") as "Hhead". - Arith.arith_simpl. - iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 - (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". - iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) - 99%Z 100%Z with "[$H2 $H3]") as "Htail". - iPoseProof (object_bytesR_prefix_tail0 (s_addr .[Tuchar ! 2]) - Tuchar (cQp.mk false 1) 1 2 [99%Z] [100%Z] - ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Htail") + iDestruct select (s_addr |-> arrayLR Tuchar 0 4 + (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hs". + iPoseProof (object_bytesR_of_arrayLR s_addr Tuchar (cQp.mk false 1) + 4 [97%Z; 98%Z; 99%Z; 100%Z] ltac:(reflexivity) with "Hs") as "Hs". + + iPoseProof (object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [97%Z; 98%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Hs") as "[Htarget Htail]". iExists Tuchar. iSplitL "Htarget". - { iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 1%N - [99%Z] ltac:(reflexivity) with "Htarget"). } - iIntros "Htarget". - go. - change (memset 291 1) with [35%Z]. - iPoseProof (at_uchar_offset_add_elim s_addr 2 1 3 - (object_bytesR Tuchar 1$m [100%Z]) ltac:(lia) with "Htail") as "Htail". - iPoseProof (object_bytesR_read_head_uchar_after_open - s_addr (cQp.mk false 1%Qp) 2 35%Z [] - [100%Z] with "[$Htarget $Htail]") as "[H2' Htail]". - iExists (Vint 35%Z), (cQp.mk false 1%Qp); iFrame "H2'"; iIntros "H2'". - (* Now we are onto the next C++ instruction: [assert(s[3] == 'd');]. *) - go. - iPoseProof (object_bytesR_arrayLR_cons (s_addr .[Tuchar ! 3]) 100%Z [] - with "Htail") as "[[#Hty3' H3'] _]". - iPoseProof (at_zero_elim (s_addr .[Tuchar ! 3]) with "H3'") as "H3'". - iExists (Vint 100%Z), (cQp.mk false 1%Qp); iFrame "H3'"; iIntros "H3'". - (* Now we are onto establishing the postcondition. *) - go. - iPoseProof (object_bytesR_ucharR_ucharR_arrayLR_anyR s_addr - [120%Z; 120%Z] 35%Z 100%Z with "[$Hhead $H2' $H3']") as "Hs". - iFrame "Hs". - go. + - iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 2%N + [97%Z; 98%Z] ltac:(reflexivity) with "Htarget"). + - iIntros "Htarget". + go. + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [120%Z; 120%Z] [99%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Htarget $Htail]") as "Hs". + iPoseProof (object_bytesR_arrayLR_cons s_addr 120%Z + [120%Z; 99%Z; 100%Z] with "Hs") as "[[#Hty0 H0] Hs]". + iExists (Vint 120%Z), (cQp.mk false 1%Qp). + iFrame "H0". iIntros "H0". + go. + iEval (rewrite (arrayLR_cons s_addr 1 4 (fun b : Z => ucharR 1$m b) + 120%Z [99%Z; 100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty1 H1] Hs]". + iExists (Vint 120%Z), (cQp.mk false 1%Qp). + iFrame "H1". iIntros "H1". + go. + iEval (rewrite (arrayLR_cons s_addr 2 4 (fun b : Z => ucharR 1$m b) + 99%Z [100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty2 H2] Hs]". + iExists (Vint 99%Z), (cQp.mk false 1%Qp). + iFrame "H2". iIntros "H2". + go. + iEval (rewrite (arrayLR_cons s_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hs". + iDestruct "Hs" as "[[#Hty3 H3] Hs]". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "H3". iIntros "H3". + go. + iPoseProof (at_zero_elim s_addr with "H0") as "H0". + iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z + with "[$H0 $H1]") as "Hhead". + Arith.arith_simpl. + iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) + 99%Z 100%Z with "[$H2 $H3]") as "Htail". + iPoseProof (object_bytesR_prefix_tail0 (s_addr .[ Tuchar ! 2]) + Tuchar (cQp.mk false 1) 1 2 [99%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity) with "Htail") + as "[Htarget Htail]". + iRename "Hs" into "Hempty". + go. + go. + iExists Tuchar. + iSplitL "Htarget". + + iApply (object_bytesR_ucharR_object_bytes_anyR _ 1$m 1%N + [99%Z] ltac:(reflexivity) with "Htarget"). + + iIntros "Htarget". + go. + iPoseProof ((object_bytesR_prefix_tail0 (s_addr .[ Tuchar ! 2]) + Tuchar (cQp.mk false 1) 1 2 [35%Z] [100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Htarget $Htail]") as "Htail". + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [120%Z; 120%Z] [35%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Htail]") as "Hs". + go. + iPoseProof (object_bytesR_arrayLR_cons s_addr 120%Z + [120%Z; 35%Z; 100%Z] with "Hs") as "[[#Hty0' H0] Hs]". + iEval (rewrite (arrayLR_cons s_addr 1 4 (fun b : Z => ucharR 1$m b) + 120%Z [35%Z; 100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty1' H1] Hs]". + iEval (rewrite (arrayLR_cons s_addr 2 4 (fun b : Z => ucharR 1$m b) + 35%Z [100%Z])) in "Hs". + iDestruct "Hs" as "[[#Hty2' H2] Hs]". + iExists (Vint 35%Z), (cQp.mk false 1%Qp). + iFrame "H2". iIntros "H2". + go. + iEval (rewrite (arrayLR_cons s_addr 3 4 (fun b : Z => ucharR 1$m b) + 100%Z [])) in "Hs". + iDestruct "Hs" as "[[#Hty3' H3] Hempty2]". + iExists (Vint 100%Z), (cQp.mk false 1%Qp). + iFrame "H3". iIntros "H3". + go. + iPoseProof (at_zero_elim s_addr with "H0") as "H0". + iPoseProof (uchar_cells_object_bytesR_two s_addr 120%Z 120%Z + with "[$H0 $H1]") as "Hhead". + iPoseProof (at_uchar_offset_add_intro s_addr 2 1 3 + (ucharR 1$m 100%Z) ltac:(lia) with "H3") as "H3". + iPoseProof (uchar_cells_object_bytesR_two (s_addr .[Tuchar ! 2]) + 35%Z 100%Z with "[$H2 $H3]") as "Htail". + iPoseProof ((object_bytesR_prefix_tail0 s_addr Tuchar + (cQp.mk false 1) 2 4 [120%Z; 120%Z] [35%Z; 100%Z] + ltac:(reflexivity) ltac:(reflexivity) ltac:(reflexivity)) + with "[$Hhead $Htail]") as "Hs". + iPoseProof (object_bytesR_ucharR_arrayLR_anyR _ 1$m 4%N + [120%Z; 120%Z; 35%Z; 100%Z] with "Hs") as "Hs". + iFrame "Hs". + go. Qed. cpp.spec "test_memchr()" default. @@ -1018,9 +1064,19 @@ Section with_cpp. go. *) + (* cpp.spec "test_memmove()" default. + Lemma test_memmove_ok_workspace : verify[module] "test_memmove()". + Proof using MOD _Σ thread_info Σ σ. + verify_spec; go. + (*USING ego. HERE LEADS TO NONTREMINATION!*) + Show. + Abort.*) + Lemma test_memmove_ok : verify[module] "test_memmove()". Proof using MOD _Σ thread_info Σ σ. + (* Workspace probe for the first memmove call boundary: + [test_memmove_ok_workspace]. *) verify_spec; go. iDestruct select (src_addr |-> arrayLR Tuchar 0 4 (fun v : Z => ucharR 1$m v) [97%Z; 98%Z; 99%Z; 100%Z]) as "Hsrc". @@ -1043,11 +1099,11 @@ Section with_cpp. Arith.arith_simpl. go. - iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z - [98%Z; 99%Z; 100%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst_arr]". - iExists (Vint 97%Z), (cQp.mk false 1%Qp). - iFrame "Hdst0". iIntros "Hdst0". - go. + iPoseProof (object_bytesR_arrayLR_cons dst_addr 97%Z + [98%Z; 99%Z; 100%Z] with "Hdst") as "[[#Hdst_ty0 Hdst0] Hdst_arr]". + iExists (Vint 97%Z), (cQp.mk false 1%Qp). + iFrame "Hdst0". iIntros "Hdst0". + go. iEval (rewrite (arrayLR_cons dst_addr 1 4 (fun b : Z => ucharR 1$m b) 98%Z [99%Z; 100%Z])) in "Hdst_arr".