From 66f61d4920e2eb941897b5604475f62a3579e3c5 Mon Sep 17 00:00:00 2001 From: Robbert Krebbers <mail@robbertkrebbers.nl> Date: Mon, 8 Feb 2016 15:56:57 +0100 Subject: [PATCH] Improve heap_lang notations a bit. --- heap_lang/sugar.v | 14 ++++++++------ heap_lang/tests.v | 17 +++++++++-------- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/heap_lang/sugar.v b/heap_lang/sugar.v index fe5c7c8e5..46d5597f5 100644 --- a/heap_lang/sugar.v +++ b/heap_lang/sugar.v @@ -32,7 +32,7 @@ Module notations. (* What about Arguments for hoare triples?. *) (* The colons indicate binders. "let" is not consistent here though, thing are only bound in the "in". *) - Notation "# n" := (Var n) (at level 1, format "# n") : lang_scope. + Notation "# n" := (ids (term:=expr) n) (at level 1, format "# n") : lang_scope. Notation "! e" := (Load e%L) (at level 10, format "! e") : lang_scope. Notation "'ref' e" := (Alloc e%L) (at level 30) : lang_scope. Notation "e1 + e2" := (Plus e1%L e2%L) @@ -41,12 +41,14 @@ Module notations. Notation "e1 < e2" := (Lt e1%L e2%L) (at level 70) : lang_scope. (* The unicode ↠is already part of the notation "_ ↠_; _" for bind. *) Notation "e1 <- e2" := (Store e1%L e2%L) (at level 80) : lang_scope. - Notation "e1 ; e2" := (Seq e1%L e2%L) (at level 100) : lang_scope. - Notation "'let:' e1 'in' e2" := (Let e1%L e2%L) (at level 102) : lang_scope. - Notation "'λ:' e" := (Lam e%L) (at level 102) : lang_scope. - Notation "'rec::' e" := (Rec e%L) (at level 102) : lang_scope. + Notation "e1 ; e2" := (Seq e1%L e2%L) + (at level 100, e2 at level 200) : lang_scope. + Notation "'let:' e1 'in' e2" := (Let e1%L e2%L) + (at level 102, e2 at level 200) : lang_scope. + Notation "'λ:' e" := (Lam e%L) (at level 102, e at level 200) : lang_scope. + Notation "'rec::' e" := (Rec e%L) (at level 102, e at level 200) : lang_scope. Notation "'if' e1 'then' e2 'else' e3" := (If e1%L e2%L e3%L) - (at level 200, e1, e2, e3 at level 200, only parsing) : lang_scope. + (at level 200, e1, e2, e3 at level 200) : lang_scope. End notations. Section suger. diff --git a/heap_lang/tests.v b/heap_lang/tests.v index 6996b7096..775b4c7f9 100644 --- a/heap_lang/tests.v +++ b/heap_lang/tests.v @@ -54,16 +54,15 @@ Module LiftingTests. (* TODO: once asimpl preserves notation, we don't need FindPred' anymore. *) (* FIXME: fix notation so that we do not need parenthesis or %L *) - Definition FindPred' n1 Sn1 n2 f : expr := + Definition FindPred' (n1 Sn1 n2 f : expr) : expr := if Sn1 < n2 then f Sn1 else n1. - Definition FindPred n2 : expr := - rec:: (let: #1 + 1 in FindPred' #2 #0 n2.[ren(+3)] #1)%L. + Definition FindPred (n2 : expr) : expr := + rec:: let: #1 + 1 in FindPred' #2 #0 n2.[ren(+3)] #1. Definition Pred : expr := - λ: (if #0 ≤ 0 then 0 else FindPred #0 0)%L. + λ: if #0 ≤ 0 then 0 else FindPred #0 0. Lemma FindPred_spec n1 n2 E Q : - (■(n1 < n2) ∧ Q (pred n2)) ⊑ - wp E (FindPred n2 n1) Q. + (■(n1 < n2) ∧ Q (pred n2)) ⊑ wp E (FindPred n2 n1) Q. Proof. revert n1. apply löb_all_1=>n1. rewrite -wp_rec //. asimpl. @@ -71,8 +70,10 @@ Module LiftingTests. etransitivity; first (etransitivity; last eapply equiv_spec, later_and). { apply and_mono; first done. by rewrite -later_intro. } apply later_mono. - (* Go on. *) - rewrite -(wp_let _ _ (FindPred' n1 #0 n2 (FindPred n2))). + (* "rewrite -(wp_let _ _ (FindPred' n1 #0 n2 (FindPred n2)))" started to + fail after we changed # n to use ids instead of Var *) + pose proof (wp_let (Σ:=Σ) E (n1 + 1)%L (FindPred' n1 #0 n2 (FindPred n2)) Q). + unfold Let, Lam in H; rewrite -H. rewrite -wp_plus. asimpl. rewrite -(wp_bindi (CaseCtx _ _)). rewrite -!later_intro /=. -- GitLab