Commit 0269f5af authored by Michael Sammler's avatar Michael Sammler

Started with binary search

parent e96df13c
...@@ -34,3 +34,4 @@ ...@@ -34,3 +34,4 @@
-Q _build/default/tutorial/adequacy refinedc.tutorial.adequacy -Q _build/default/tutorial/adequacy refinedc.tutorial.adequacy
-Q _build/default/tutorial/proofs/quicksort_solution refinedc.tutorial.quicksort_solution -Q _build/default/tutorial/proofs/quicksort_solution refinedc.tutorial.quicksort_solution
-Q _build/default/tutorial/proofs/quicksort_exercise refinedc.tutorial.quicksort_exercise -Q _build/default/tutorial/proofs/quicksort_exercise refinedc.tutorial.quicksort_exercise
-Q _build/default/examples/proofs/binary_search refinedc.examples.binary_search
#include <stddef.h>
#include <stdbool.h>
#include <refinedc.h>
//@rc::import binary_search_extra from refinedc.examples.binary_search
typedef bool (*comp_fn)(void *, void *);
[[rc::parameters("R: {Z → Z → Prop}", "ls : {list Z}", "x : Z", "p : loc", "ty : {Z → type}")]]
[[rc::args("p @ &own<array<LPtr, {(fun x => &own (ty x) : type) <$> ls}>>", "{length ls} @ int<i32>",
"&own<{ty x}>", "function_ptr<{fn(∀ (x, y, px, py) : (Z * Z * loc * loc); px @ &own (ty x), py @ &own (ty y); True) → ∃ (b) : (bool), b @ boolean bool_it; px ◁ₗ ty x ∗ py ◁ₗ ty y ∗ ⌜b ↔ R x y⌝}>")]]
[[rc::requires("{StronglySorted R ls}", "{Transitive R}")]]
[[rc::exists("n : nat")]]
[[rc::returns("n @ int<i32>")]]
[[rc::ensures("{∀ i y, (i < n)%nat → ls !! i = Some y → R y x}",
"{∀ i y, (n ≤ i)%nat → ls !! i = Some y → ¬ R y x}")]]
[[rc::ensures("p @ &own<array<LPtr, {(fun x => &own (ty x) : type) <$> ls}>>")]]
[[rc::tactics("all: try by [revert select (∀ i j, _ → _ → ¬ R _ _); apply; [| done];solve_goal].")]]
[[rc::tactics("all: try by apply: (binary_search_cond_1 y); solve_goal.")]]
[[rc::tactics("all: try by apply: (binary_search_cond_2 y); solve_goal.")]]
int binary_search(void **xs, int n, void *x, comp_fn comp) {
int l = 0, r = n;
[[rc::exists("vl : nat", "vr : nat")]]
[[rc::inv_vars("l : vl @ int<i32>", "r : vr @ int<i32>")]]
[[rc::constraints("{vl <= vr}", "{vr <= length ls}")]]
[[rc::constraints("{∀ i y, (i < vl)%nat → ls !! i = Some y → R y x}",
"{∀ i y, (vr ≤ i)%nat → ls !! i = Some y → ¬ R y x}")]]
while(l < r) {
int k = l + (r - l) / 2;
if (comp(xs[k], x)) {
l = k + 1;
} else {
r = k;
}
}
return l;
}
From refinedc.lang Require Import base.
Lemma binary_search_cond_1 {A} y R (l : list A) i j x z `{!Transitive R}:
StronglySorted R l l !! i = Some x l !! j = Some y (i j)%nat R y z R x z.
Proof.
move => ?????.
have [||||->|?]:= StronglySorted_lookup_le R l i j x y => //. by etrans.
Qed.
Lemma binary_search_cond_2 {A} y R (l : list A) i j x z `{!Transitive R}:
StronglySorted R l l !! i = Some x l !! j = Some y (j i)%nat ¬ R y z ¬ R x z.
Proof.
move => ???? Hneg. have [||||<-|?]:= StronglySorted_lookup_le R l j i y x => //.
contradict Hneg. by etrans.
Qed.
; Generated by [refinedc], do not edit.
(coq.theory
(flags -w -notation-overridden -w -redundant-canonical-projection)
(name refinedc.examples.binary_search)
(theories refinedc.lang refinedc.lithium refinedc.typing refinedc.typing.automation))
From refinedc.lang Require Export notation.
From refinedc.lang Require Import tactics.
From refinedc.typing Require Import annotations.
Set Default Proof Using "Type".
(* Generated from [examples/binary_search.c]. *)
Section code.
Definition file_0 : string := "examples/binary_search.c".
Definition loc_2 : location_info := LocationInfo file_0 22 2 22 19.
Definition loc_3 : location_info := LocationInfo file_0 28 2 35 3.
Definition loc_4 : location_info := LocationInfo file_0 36 2 36 11.
Definition loc_5 : location_info := LocationInfo file_0 36 9 36 10.
Definition loc_6 : location_info := LocationInfo file_0 36 9 36 10.
Definition loc_7 : location_info := LocationInfo file_0 28 2 35 3.
Definition loc_8 : location_info := LocationInfo file_0 28 15 35 3.
Definition loc_9 : location_info := LocationInfo file_0 29 4 29 28.
Definition loc_10 : location_info := LocationInfo file_0 30 4 34 5.
Definition loc_11 : location_info := LocationInfo file_0 28 2 35 3.
Definition loc_12 : location_info := LocationInfo file_0 28 2 35 3.
Definition loc_13 : location_info := LocationInfo file_0 30 24 32 7.
Definition loc_14 : location_info := LocationInfo file_0 31 6 31 16.
Definition loc_15 : location_info := LocationInfo file_0 31 6 31 7.
Definition loc_16 : location_info := LocationInfo file_0 31 10 31 15.
Definition loc_17 : location_info := LocationInfo file_0 31 10 31 11.
Definition loc_18 : location_info := LocationInfo file_0 31 10 31 11.
Definition loc_19 : location_info := LocationInfo file_0 31 14 31 15.
Definition loc_20 : location_info := LocationInfo file_0 32 13 34 5.
Definition loc_21 : location_info := LocationInfo file_0 33 6 33 12.
Definition loc_22 : location_info := LocationInfo file_0 33 6 33 7.
Definition loc_23 : location_info := LocationInfo file_0 33 10 33 11.
Definition loc_24 : location_info := LocationInfo file_0 33 10 33 11.
Definition loc_25 : location_info := LocationInfo file_0 30 8 30 22.
Definition loc_26 : location_info := LocationInfo file_0 30 8 30 12.
Definition loc_27 : location_info := LocationInfo file_0 30 8 30 12.
Definition loc_28 : location_info := LocationInfo file_0 30 8 30 12.
Definition loc_29 : location_info := LocationInfo file_0 30 13 30 18.
Definition loc_30 : location_info := LocationInfo file_0 30 13 30 18.
Definition loc_31 : location_info := LocationInfo file_0 30 13 30 18.
Definition loc_32 : location_info := LocationInfo file_0 30 13 30 15.
Definition loc_33 : location_info := LocationInfo file_0 30 13 30 15.
Definition loc_34 : location_info := LocationInfo file_0 30 16 30 17.
Definition loc_35 : location_info := LocationInfo file_0 30 16 30 17.
Definition loc_36 : location_info := LocationInfo file_0 30 20 30 21.
Definition loc_37 : location_info := LocationInfo file_0 30 20 30 21.
Definition loc_38 : location_info := LocationInfo file_0 29 12 29 27.
Definition loc_39 : location_info := LocationInfo file_0 29 12 29 13.
Definition loc_40 : location_info := LocationInfo file_0 29 12 29 13.
Definition loc_41 : location_info := LocationInfo file_0 29 16 29 27.
Definition loc_42 : location_info := LocationInfo file_0 29 16 29 23.
Definition loc_43 : location_info := LocationInfo file_0 29 17 29 18.
Definition loc_44 : location_info := LocationInfo file_0 29 17 29 18.
Definition loc_45 : location_info := LocationInfo file_0 29 21 29 22.
Definition loc_46 : location_info := LocationInfo file_0 29 21 29 22.
Definition loc_47 : location_info := LocationInfo file_0 29 26 29 27.
Definition loc_50 : location_info := LocationInfo file_0 28 8 28 13.
Definition loc_51 : location_info := LocationInfo file_0 28 8 28 9.
Definition loc_52 : location_info := LocationInfo file_0 28 8 28 9.
Definition loc_53 : location_info := LocationInfo file_0 28 12 28 13.
Definition loc_54 : location_info := LocationInfo file_0 28 12 28 13.
Definition loc_55 : location_info := LocationInfo file_0 22 17 22 18.
Definition loc_56 : location_info := LocationInfo file_0 22 17 22 18.
Definition loc_59 : location_info := LocationInfo file_0 22 10 22 11.
(* Definition of function [binary_search]. *)
Definition impl_binary_search : function := {|
f_args := [
("xs", LPtr);
("n", it_layout i32);
("x", LPtr);
("comp", LPtr)
];
f_local_vars := [
("r", it_layout i32);
("l", it_layout i32);
("k", it_layout i32)
];
f_init := "#0";
f_code := (
<[ "#0" :=
"l" <-{ it_layout i32 } LocInfoE loc_59 (i2v 0 i32) ;
"r" <-{ it_layout i32 }
LocInfoE loc_55 (use{it_layout i32} (LocInfoE loc_56 ("n"))) ;
locinfo: loc_3 ;
Goto "#1"
]> $
<[ "#1" :=
locinfo: loc_50 ;
if: LocInfoE loc_50 (UnOp (CastOp $ IntOp bool_it) (IntOp i32) (LocInfoE loc_50 ((LocInfoE loc_51 (use{it_layout i32} (LocInfoE loc_52 ("l")))) <{IntOp i32, IntOp i32} (LocInfoE loc_53 (use{it_layout i32} (LocInfoE loc_54 ("r")))))))
then
Goto "#2"
else
locinfo: loc_4 ;
Goto "#3"
]> $
<[ "#2" :=
"k" <-{ it_layout i32 }
LocInfoE loc_38 ((LocInfoE loc_39 (use{it_layout i32} (LocInfoE loc_40 ("l")))) +{IntOp i32, IntOp i32} (LocInfoE loc_41 ((LocInfoE loc_42 ((LocInfoE loc_43 (use{it_layout i32} (LocInfoE loc_44 ("r")))) -{IntOp i32, IntOp i32} (LocInfoE loc_45 (use{it_layout i32} (LocInfoE loc_46 ("l")))))) /{IntOp i32, IntOp i32} (LocInfoE loc_47 (i2v 2 i32))))) ;
locinfo: loc_25 ;
"$0" <- LocInfoE loc_27 (use{LPtr} (LocInfoE loc_28 ("comp"))) with
[ LocInfoE loc_29 (use{LPtr} (LocInfoE loc_31 ((LocInfoE loc_32 (!{LPtr} (LocInfoE loc_33 ("xs")))) at_offset{LPtr, PtrOp, IntOp i32} (LocInfoE loc_34 (use{it_layout i32} (LocInfoE loc_35 ("k"))))))) ;
LocInfoE loc_36 (use{LPtr} (LocInfoE loc_37 ("x"))) ] ;
locinfo: loc_25 ;
if: LocInfoE loc_25 ("$0")
then
locinfo: loc_14 ;
Goto "#5"
else
locinfo: loc_21 ;
Goto "#6"
]> $
<[ "#3" :=
locinfo: loc_4 ;
Return (LocInfoE loc_5 (use{it_layout i32} (LocInfoE loc_6 ("l"))))
]> $
<[ "#4" :=
locinfo: loc_11 ;
Goto "continue2"
]> $
<[ "#5" :=
locinfo: loc_14 ;
LocInfoE loc_15 ("l") <-{ it_layout i32 }
LocInfoE loc_16 ((LocInfoE loc_17 (use{it_layout i32} (LocInfoE loc_18 ("k")))) +{IntOp i32, IntOp i32} (LocInfoE loc_19 (i2v 1 i32))) ;
locinfo: loc_11 ;
Goto "#4"
]> $
<[ "#6" :=
locinfo: loc_21 ;
LocInfoE loc_22 ("r") <-{ it_layout i32 }
LocInfoE loc_23 (use{it_layout i32} (LocInfoE loc_24 ("k"))) ;
locinfo: loc_11 ;
Goto "#4"
]> $
<[ "continue2" :=
locinfo: loc_3 ;
Goto "#1"
]> $
)%E
|}.
End code.
From refinedc.typing Require Import typing.
From refinedc.examples.binary_search Require Import generated_code.
From refinedc.examples.binary_search Require Import generated_spec.
From refinedc.examples.binary_search Require Import binary_search_extra.
Set Default Proof Using "Type".
(* Generated from [examples/binary_search.c]. *)
Section proof_binary_search.
Context `{!typeG Σ} `{!globalG Σ}.
(* Typing proof for [binary_search]. *)
Lemma type_binary_search :
typed_function impl_binary_search type_of_binary_search.
Proof.
start_function "binary_search" ([[[[R ls] x] p] ty]) => arg_xs arg_n arg_x arg_comp local_r local_l local_k.
split_blocks ((
<[ "#1" :=
vl : nat,
vr : nat,
arg_xs ◁ₗ (p @ (&own (array (LPtr) ((fun x => &own (ty x) : type) <$> ls))))
arg_n ◁ₗ ((length ls) @ (int (i32)))
arg_x ◁ₗ (&own (ty x))
arg_comp ◁ₗ (function_ptr (fn( (x, y, px, py) : (Z * Z * loc * loc); px @ &own (ty x), py @ &own (ty y); True) (b) : (bool), b @ boolean bool_it; px ◁ₗ ty x py ◁ₗ ty y b R x y))
local_k ◁ₗ uninit (it_layout i32)
local_l ◁ₗ (vl @ (int (i32)))
local_r ◁ₗ (vr @ (int (i32)))
vl <= vr
vr <= length ls
i y, (i < vl)%nat ls !! i = Some y R y x
i y, (vr i)%nat ls !! i = Some y ¬ R y x
]> $
)%I : gmap label (iProp Σ)) ((
)%I : gmap label (iProp Σ)).
- repeat liRStep; liShow.
all: print_typesystem_goal "binary_search" "#0".
- repeat liRStep; liShow.
all: print_typesystem_goal "binary_search" "#1".
Unshelve. all: sidecond_hook; prepare_sideconditions; normalize_and_simpl_goal; try solve_goal; unsolved_sidecond_hook.
all: try by [revert select ( i j, _ _ ¬ R _ _); apply; [| done];solve_goal].
all: try by apply: (binary_search_cond_1 y); solve_goal.
all: try by apply: (binary_search_cond_2 y); solve_goal.
all: print_sidecondition_goal "binary_search".
Qed.
End proof_binary_search.
From refinedc.typing Require Import typing.
From refinedc.examples.binary_search Require Import generated_code.
From refinedc.examples.binary_search Require Import binary_search_extra.
Set Default Proof Using "Type".
(* Generated from [examples/binary_search.c]. *)
Section spec.
Context `{!typeG Σ} `{!globalG Σ}.
(* Type definitions. *)
(* Specifications for function [binary_search]. *)
Definition type_of_binary_search :=
fn( (R, ls, x, p, ty) : (Z Z Prop) * (list Z) * Z * loc * (Z type); (p @ (&own (array (LPtr) ((fun x => &own (ty x) : type) <$> ls)))), ((length ls) @ (int (i32))), (&own (ty x)), (function_ptr (fn( (x, y, px, py) : (Z * Z * loc * loc); px @ &own (ty x), py @ &own (ty y); True) (b) : (bool), b @ boolean bool_it; px ◁ₗ ty x py ◁ₗ ty y b R x y)); StronglySorted R ls Transitive R)
n : nat, (n @ (int (i32))); i y, (i < n)%nat ls !! i = Some y R y x i y, (n i)%nat ls !! i = Some y ¬ R y x (p ◁ₗ (array (LPtr) ((fun x => &own (ty x) : type) <$> ls))).
End spec.
generated_proof_binary_search.v
...@@ -186,6 +186,15 @@ Lemma bool_decide_eq_x_x_true {A} (x : A) `{!Decision (x = x)} : ...@@ -186,6 +186,15 @@ Lemma bool_decide_eq_x_x_true {A} (x : A) `{!Decision (x = x)} :
bool_decide (x = x) = true. bool_decide (x = x) = true.
Proof. by case_bool_decide. Qed. Proof. by case_bool_decide. Qed.
Lemma StronglySorted_lookup_le {A} R (l : list A) i j x y:
StronglySorted R l l !! i = Some x l !! j = Some y (i j)%nat x = y R x y.
Proof.
move => Hsorted. elim: Hsorted i j => // z {}l ? IH Hall [|?] [|?]//=???; simplify_eq; try lia.
- by left.
- right. by apply: (Forall_lookup_1 _ _ _ _ Hall).
- apply: IH => //. lia.
Qed.
Lemma StronglySorted_lookup_lt {A} R (l : list A) i j x y: Lemma StronglySorted_lookup_lt {A} R (l : list A) i j x y:
StronglySorted R l l !! i = Some x l !! j = Some y ¬ R y x x y (i < j)%nat. StronglySorted R l l !! i = Some x l !! j = Some y ¬ R y x x y (i < j)%nat.
......
...@@ -92,8 +92,9 @@ Ltac liRIntroduceLetInGoal := ...@@ -92,8 +92,9 @@ Ltac liRIntroduceLetInGoal :=
end end
end. end.
(* TODO: make this extensible via a hook tactic *) Ltac liRInstantiateEvars_hook := idtac.
Ltac liRInstantiateEvars := Ltac liRInstantiateEvars :=
liRInstantiateEvars_hook;
lazymatch goal with lazymatch goal with
| |- (_ < protected ?H)%nat _ => liInst H (S (protected (EVAR_ID _))) | |- (_ < protected ?H)%nat _ => liInst H (S (protected (EVAR_ID _)))
(* This is very hard to figure out for unification because of the (* This is very hard to figure out for unification because of the
...@@ -101,6 +102,7 @@ Ltac liRInstantiateEvars := ...@@ -101,6 +102,7 @@ Ltac liRInstantiateEvars :=
definition of ty without this. This is the reason why do_instantiate definition of ty without this. This is the reason why do_instantiate
evars must come before do_side_cond *) evars must come before do_side_cond *)
| |- protected ?H = ( _ @ ?ty)%I _ => liInst H ((protected (EVAR_ID _)) @ ty)%I | |- protected ?H = ( _ @ ?ty)%I _ => liInst H ((protected (EVAR_ID _)) @ ty)%I
| |- protected ?H = ty_of_rty (frac_ptr ?β _)%I _ => liInst H (frac_ptr β (protected (EVAR_ID _)))%I
| |- envs_entails _ (subsume (?x ◁ₗ{?β} ?ty) (_ ◁ₗ{_} (protected ?H)) _) => liInst H ty | |- envs_entails _ (subsume (?x ◁ₗ{?β} ?ty) (_ ◁ₗ{_} (protected ?H)) _) => liInst H ty
| |- envs_entails _ (subsume (?x ◁ₗ{?β} ?ty) (_ ◁ₗ{protected ?H} _) _) => liInst H β | |- envs_entails _ (subsume (?x ◁ₗ{?β} ?ty) (_ ◁ₗ{protected ?H} _) _) => liInst H β
end. end.
......
...@@ -45,6 +45,14 @@ Section function. ...@@ -45,6 +45,14 @@ Section function.
Next Obligation. iIntros (f v ???) "?". iDestruct 1 as (? ->) "?". iFrame. iExists _. by iFrame. Qed. Next Obligation. iIntros (f v ???) "?". iDestruct 1 as (? ->) "?". iFrame. iExists _. by iFrame. Qed.
Next Obligation. by iIntros (f v). Qed. Next Obligation. by iIntros (f v). Qed.
Global Program Instance copyable_function_ptr p fp : Copyable (p @ function_ptr fp).
Next Obligation.
iIntros (p fp E l ?). iDestruct 1 as (fn Hl) "(Hl&?&?)".
iMod (heap_mapsto_own_state_to_mt with "Hl") as (q) "[_ Hl]" => //. iSplitR => //.
iExists _, _. iFrame. iModIntro. iSplit. by iExists _; iFrame.
by iIntros "_".
Qed.
Definition typed_callable (v : val) (ty : type) `{!Movable ty} (T : (A fn_params) iProp Σ) : iProp Σ := Definition typed_callable (v : val) (ty : type) `{!Movable ty} (T : (A fn_params) iProp Σ) : iProp Σ :=
(v ◁ᵥ ty - f fn fp, v = val_of_loc f fntbl_entry f fn typed_function fn fp T fp)%I. (v ◁ᵥ ty - f fn fp, v = val_of_loc f fntbl_entry f fn typed_function fn fp T fp)%I.
......
...@@ -524,6 +524,14 @@ Section typing. ...@@ -524,6 +524,14 @@ Section typing.
SubsumeVal v (x1 @ ty)%I (x2 @ ty)%I | 2:= SubsumeVal v (x1 @ ty)%I (x2 @ ty)%I | 2:=
λ T, i2p (subsume_val_refinement_id v ty T x1 x2). λ T, i2p (subsume_val_refinement_id v ty T x1 x2).
Lemma subtype_var {A} (ty : A type) x y l β T:
x = y T -
subsume (l ◁ₗ{β} ty x) (l ◁ₗ{β} ty y) T.
Proof. iIntros "[-> $] $". Qed.
(* This must be an hint extern because an instance would be a big slowdown . *)
Definition subtype_var_inst {A} (ty : A type) x y l β : SubsumePlace l β (ty x) (ty y) :=
λ T, i2p (subtype_var ty x y l β T).
Lemma typed_binop_simplify v1 P1 v2 P2 T o1 o2 ot1 ot2 {SH1 : SimplifyHyp P1 o1} {SH2 : SimplifyHyp P2 o2} op: Lemma typed_binop_simplify v1 P1 v2 P2 T o1 o2 ot1 ot2 {SH1 : SimplifyHyp P1 o1} {SH2 : SimplifyHyp P2 o2} op:
let G1 := (SH1 (find_in_context (FindValP v1) (λ P, typed_bin_op v1 P v2 P2 op ot1 ot2 T))).(i2p_P) in let G1 := (SH1 (find_in_context (FindValP v1) (λ P, typed_bin_op v1 P v2 P2 op ot1 ot2 T))).(i2p_P) in
let G2 := (SH2 (find_in_context (FindValP v2) (λ P, typed_bin_op v1 P1 v2 P op ot1 ot2 T))).(i2p_P) in let G2 := (SH2 (find_in_context (FindValP v2) (λ P, typed_bin_op v1 P1 v2 P op ot1 ot2 T))).(i2p_P) in
...@@ -980,6 +988,10 @@ Section typing. ...@@ -980,6 +988,10 @@ Section typing.
λ T, i2p (annot_learn l β ty T). λ T, i2p (annot_learn l β ty T).
End typing. End typing.
(* This must be an hint extern because an instance would be a big slowdown . *)
Hint Extern 1 (SubsumePlace _ _ (?ty _) (?ty2 _)) =>
match ty with | ty2 => is_var ty; class_apply subtype_var_inst end : typeclass_instances.
(*** guarded *) (*** guarded *)
Section guarded. Section guarded.
Context `{!typeG Σ}. Context `{!typeG Σ}.
......
...@@ -35,7 +35,7 @@ Section singleton_val. ...@@ -35,7 +35,7 @@ Section singleton_val.
iIntros "[% [% Hl]]". iApply "HT". by iApply (ty_ref with "[] Hl Hv"). iIntros "[% [% Hl]]". iApply "HT". by iApply (ty_ref with "[] Hl Hv").
Qed. Qed.
Global Instance singleton_val_merge_inst v l ly: Global Instance singleton_val_merge_inst v l ly:
SimplifyHypPlace l Own (singleton_val ly v)%I (Some 50%N) := SimplifyHypPlace l Own (singleton_val ly v)%I (Some 50%N) | 20 :=
λ T, i2p (singleton_val_merge v l ly T). λ T, i2p (singleton_val_merge v l ly T).
Lemma type_read_move T l ty ly a `{!Movable ty}: Lemma type_read_move T l ty ly a `{!Movable ty}:
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment