-
Notifications
You must be signed in to change notification settings - Fork 640
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
Browse the repository at this point in the history
… applications in notations Reviewed-by: ejgallego Ack-by: maximedenes
- Loading branch information
Showing
6 changed files
with
138 additions
and
1 deletion.
There are no files selected for viewing
8 changes: 8 additions & 0 deletions
8
...hangelog/03-notations/12960-master+fix9403-missing-flattening-app-notations.rst
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,8 @@ | ||
- **Fixed:** | ||
Issues in the presence of notations recursively referring to another | ||
applicative notations, such as missing scope propagation, or failure | ||
to use a notation for printing | ||
(`#12960 <https://github.com/coq/coq/pull/12960>`_, | ||
fixes `#9403 <https://github.com/coq/coq/issues/9403>`_ | ||
and `#10803 <https://github.com/coq/coq/issues/10803>`_, | ||
by Hugo Herbelin). |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,10 @@ | ||
a ! | ||
: Foo | ||
where | ||
?y : [ |- nat] | ||
a ! | ||
: Foo | ||
a | ||
: Foo -> Foo | ||
a ! | ||
: Foo |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,14 @@ | ||
Inductive Foo := foo. | ||
Declare Scope foo_scope. | ||
Delimit Scope foo_scope with foo. | ||
Bind Scope foo_scope with Foo. | ||
Notation "'!'" := foo : foo_scope. | ||
Definition of_foo {x : nat} {y : nat} (f : Foo) := f. | ||
Notation a := (@of_foo O). | ||
Notation b := (@a). | ||
Check a !. | ||
Check @a O !. | ||
Check @b O. | ||
Check @b O !. (* was failing *) | ||
(* All are printed "a !", without making explicit the "0", which is | ||
incidentally disputable *) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,6 @@ | ||
1 subgoal | ||
|
||
X : tele | ||
α, β, γ1, γ2 : X → Prop | ||
============================ | ||
accessor α β γ1 → accessor α β (λ.. x : X, γ1 x ∨ γ2 x) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,99 @@ | ||
(* Uselessly long but why not *) | ||
|
||
From Coq Require Export Utf8. | ||
|
||
Local Set Universe Polymorphism. | ||
|
||
Module tele. | ||
(** Telescopes *) | ||
Inductive tele : Type := | ||
| TeleO : tele | ||
| TeleS {X} (binder : X → tele) : tele. | ||
|
||
Arguments TeleS {_} _. | ||
|
||
(** The telescope version of Coq's function type *) | ||
Fixpoint tele_fun (TT : tele) (T : Type) : Type := | ||
match TT with | ||
| TeleO => T | ||
| TeleS b => ∀ x, tele_fun (b x) T | ||
end. | ||
|
||
Notation "TT -t> A" := | ||
(tele_fun TT A) (at level 99, A at level 200, right associativity). | ||
|
||
(** An eliminator for elements of [tele_fun]. | ||
We use a [fix] because, for some reason, that makes stuff print nicer | ||
in the proofs in iris:bi/lib/telescopes.v *) | ||
Definition tele_fold {X Y} {TT : tele} (step : ∀ {A : Type}, (A → Y) → Y) (base : X → Y) | ||
: (TT -t> X) → Y := | ||
(fix rec {TT} : (TT -t> X) → Y := | ||
match TT as TT return (TT -t> X) → Y with | ||
| TeleO => λ x : X, base x | ||
| TeleS b => λ f, step (λ x, rec (f x)) | ||
end) TT. | ||
Arguments tele_fold {_ _ !_} _ _ _ /. | ||
|
||
(** A sigma-like type for an "element" of a telescope, i.e. the data it | ||
takes to get a [T] from a [TT -t> T]. *) | ||
Inductive tele_arg : tele → Type := | ||
| TargO : tele_arg TeleO | ||
(* the [x] is the only relevant data here *) | ||
| TargS {X} {binder} (x : X) : tele_arg (binder x) → tele_arg (TeleS binder). | ||
|
||
Definition tele_app {TT : tele} {T} (f : TT -t> T) : tele_arg TT → T := | ||
λ a, (fix rec {TT} (a : tele_arg TT) : (TT -t> T) → T := | ||
match a in tele_arg TT return (TT -t> T) → T with | ||
| TargO => λ t : T, t | ||
| TargS x a => λ f, rec a (f x) | ||
end) TT a f. | ||
Arguments tele_app {!_ _} _ !_ /. | ||
|
||
Coercion tele_arg : tele >-> Sortclass. | ||
Local Coercion tele_app : tele_fun >-> Funclass. | ||
|
||
(** Operate below [tele_fun]s with argument telescope [TT]. *) | ||
Fixpoint tele_bind {U} {TT : tele} : (TT → U) → TT -t> U := | ||
match TT as TT return (TT → U) → TT -t> U with | ||
| TeleO => λ F, F TargO | ||
| @TeleS X b => λ (F : TeleS b → U) (x : X), (* b x -t> U *) | ||
tele_bind (λ a, F (TargS x a)) | ||
end. | ||
Arguments tele_bind {_ !_} _ /. | ||
|
||
(** Notation-compatible telescope mapping *) | ||
(* This adds (tele_app ∘ tele_bind), which is an identity function, around every | ||
binder so that, after simplifying, this matches the way we typically write | ||
notations involving telescopes. *) | ||
Notation "t $ r" := (t r) | ||
(at level 65, right associativity, only parsing). | ||
Notation "'λ..' x .. y , e" := | ||
(tele_app $ tele_bind (λ x, .. (tele_app $ tele_bind (λ y, e)) .. )) | ||
(at level 200, x binder, y binder, right associativity, | ||
format "'[ ' 'λ..' x .. y ']' , e"). | ||
|
||
(** Telescopic quantifiers *) | ||
Definition texist {TT : tele} (Ψ : TT → Prop) : Prop := | ||
tele_fold ex (λ x, x) (tele_bind Ψ). | ||
Arguments texist {!_} _ /. | ||
|
||
Notation "'∃..' x .. y , P" := (texist (λ x, .. (texist (λ y, P)) .. )) | ||
(at level 200, x binder, y binder, right associativity, | ||
format "∃.. x .. y , P"). | ||
End tele. | ||
Import tele. | ||
|
||
(* This is like Iris' accessors, but in Prop. Just to play with telescopes. *) | ||
Definition accessor {X : tele} (α β γ : X → Prop) : Prop := | ||
∃.. x, α x ∧ (β x → γ x). | ||
|
||
(* Working with abstract telescopes. *) | ||
Section tests. | ||
Context {X : tele}. | ||
Implicit Types α β γ : X → Prop. | ||
|
||
Lemma acc_mono_disj α β γ1 γ2 : | ||
accessor α β γ1 → accessor α β (λ.. x, γ1 x ∨ γ2 x). | ||
Show. | ||
Abort. | ||
End tests. |