diff --git a/heap_lang/sugar.v b/heap_lang/sugar.v index 8ac024ab33bd15e1a76938bae737e73a6a44c12c..fe5c7c8e530916519aa8b12df3be80dc9933f2a2 100644 --- a/heap_lang/sugar.v +++ b/heap_lang/sugar.v @@ -1,6 +1,5 @@ Require Export heap_lang.heap_lang heap_lang.lifting. -Import uPred. -Import heap_lang. +Import uPred heap_lang. (** Define some syntactic sugar. LitTrue and LitFalse are defined in heap_lang.v. *) Definition Lam (e : {bind expr}) := Rec e.[ren(+1)]. @@ -17,42 +16,38 @@ Definition LamV (e : {bind expr}) := RecV e.[ren(+1)]. Definition LetCtx (e2 : {bind expr}) := AppRCtx (LamV e2). Definition SeqCtx (e2 : expr) := LetCtx (e2.[ren(+1)]). -Delimit Scope lang_scope with L. -Bind Scope lang_scope with expr. -Arguments wp {_ _} _ _%L _. -(* TODO: The levels are all random. Also maybe we should not - make 'new' a keyword. What about Arguments for hoare triples?. *) -(* The colons indicate binders. "let" is not consistent here though, - thing are only bound in the "in". *) -Notation "'rec::' e" := (Rec e) (at level 100) : lang_scope. -Notation "'λ:' e" := (Lam e) (at level 100) : lang_scope. -Notation "'let:' e1 'in' e2" := (Let e1 e2) (at level 70) : lang_scope. -Notation "e1 ';' e2" := (Seq e1 e2) (at level 70) : lang_scope. -Notation "'if' e1 'then' e2 'else' e3" := (If e1 e2 e3) : lang_scope. +Module notations. + Delimit Scope lang_scope with L. + Bind Scope lang_scope with expr. + Arguments wp {_ _} _ _%L _. -Notation "#0" := (Var 0) (at level 0) : lang_scope. -Notation "#1" := (Var 1) (at level 0) : lang_scope. -Notation "#2" := (Var 2) (at level 0) : lang_scope. -Notation "#3" := (Var 3) (at level 0) : lang_scope. -Notation "#4" := (Var 4) (at level 0) : lang_scope. -Notation "#5" := (Var 5) (at level 0) : lang_scope. -Notation "#6" := (Var 6) (at level 0) : lang_scope. -Notation "#7" := (Var 7) (at level 0) : lang_scope. -Notation "#8" := (Var 8) (at level 0) : lang_scope. -Notation "#9" := (Var 9) (at level 0) : lang_scope. + Coercion LitNat : nat >-> expr. + Coercion LitNatV : nat >-> val. + Coercion Loc : loc >-> expr. + Coercion LocV : loc >-> val. + Coercion App : expr >-> Funclass. -Notation "'★' e" := (Load e) (at level 30) : lang_scope. -Notation "e1 '<-' e2" := (Store e1 e2) (at level 60) : lang_scope. -Notation "'new' e" := (Alloc e) (at level 60) : lang_scope. -Notation "e1 '+' e2" := (Plus e1 e2) : lang_scope. -Notation "e1 '≤' e2" := (Le e1 e2) : lang_scope. -Notation "e1 '<' e2" := (Lt e1 e2) : lang_scope. - -Coercion LitNat : nat >-> expr. -Coercion LitNatV : nat >-> val. -Coercion Loc : loc >-> expr. -Coercion LocV : loc >-> val. -Coercion App : expr >-> Funclass. + (** Syntax inspired by Coq/Ocaml. Constructions with higher precedence come + first. *) + (* 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 "! 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) + (at level 50, left associativity) : lang_scope. + Notation "e1 ≤ e2" := (Le e1%L e2%L) (at level 70) : lang_scope. + 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 "'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. +End notations. Section suger. Context {Σ : iFunctor}. diff --git a/heap_lang/tests.v b/heap_lang/tests.v index 610ac9d96f7837071564ce92012d9f74c5cc1b74..f91514f3c4e24483c790e25338aefe16555a3fc7 100644 --- a/heap_lang/tests.v +++ b/heap_lang/tests.v @@ -1,8 +1,7 @@ (** This file is essentially a bunch of testcases. *) Require Import program_logic.upred. Require Import heap_lang.lifting heap_lang.sugar. -Import heap_lang. -Import uPred. +Import heap_lang uPred notations. Module LangTests. Definition add := (21 + 21)%L. @@ -24,7 +23,7 @@ Module LiftingTests. Implicit Types Q : val → iProp heap_lang Σ. (* FIXME: Fix levels so that we do not need the parenthesis here. *) - Definition e : expr := let: new 1 in (#0 <- ★#0 + 1 ; ★#0)%L. + Definition e : expr := (let: ref 1 in #0 <- !#0 + 1; !#0)%L. Goal ∀ σ E, (ownP σ : iProp heap_lang Σ) ⊑ (wp E e (λ v, ■(v = 2))). Proof. move=> σ E. rewrite /e. @@ -56,15 +55,12 @@ 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 := 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 Pred : expr := λ: (if #0 ≤ 0 - then 0 - else FindPred (#0) 0 - )%L. + Definition FindPred' n1 Sn1 n2 f : 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 Pred : expr := + λ: (if #0 ≤ 0 then 0 else FindPred #0 0)%L. Lemma FindPred_spec n1 n2 E Q : (■(n1 < n2) ∧ Q (pred n2)) ⊑ @@ -112,9 +108,7 @@ Module LiftingTests. Qed. Goal ∀ E, - True ⊑ wp (Σ:=Σ) E - (* FIXME why do we need %L here? *) - (let: Pred 42 in Pred #0)%L (λ v, ■(v = 40)). + True ⊑ wp (Σ:=Σ) E (let: Pred 42 in Pred #0) (λ v, ■(v = 40)). Proof. intros E. rewrite -wp_let. rewrite -Pred_spec -!later_intro. asimpl. (* TODO RJ: Can we somehow make it so that Pred gets folded again? *)