Skip to content

Commit 684fc88

Browse files
committed
copied Cyril's monoid_enriched_cat.v to enriched_cat.v
1 parent 57d5b66 commit 684fc88

File tree

1 file changed

+71
-0
lines changed

1 file changed

+71
-0
lines changed

tests/enriched_cat.v

Lines changed: 71 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,74 @@
11
(* testing enriched categories *)
22

3+
From HB Require Import structures.
4+
From Coq Require Import ssreflect ssrfun.
5+
6+
HB.mixin Record isQuiver Obj := { hom : Obj -> Obj -> Type }.
7+
8+
HB.structure Definition Quiver := { Obj of isQuiver Obj }.
9+
10+
HB.mixin Record isMon A := {
11+
zero : A;
12+
add : A -> A -> A;
13+
addrA : associative add;
14+
add0r : left_id zero add;
15+
addr0 : right_id zero add;
16+
}.
17+
18+
HB.structure
19+
Definition Monoid := { A of isMon A }.
20+
21+
(**)
22+
HB.mixin Record hom_isMonT T of Quiver T :=
23+
{ private : forall A B, isMon (@hom T A B) }.
24+
25+
HB.structure
26+
Definition Monoid_enriched_quiverT :=
27+
{ Obj of isQuiver Obj & hom_isMonT Obj }.
28+
29+
(**)
30+
31+
32+
Fail HB.structure
33+
Definition Monoid_enriched_quiver :=
34+
{ Obj of isQuiver Obj &
35+
(forall A B : Obj, isMon (@hom (Quiver.clone Obj _) A B)) }.
36+
37+
(* Step 0: define a wrapper predicate in coq-elpi *)
38+
(* 5 lines of documentation + 1 line of elpi code in structure.v
39+
`pred wrapper-mixin o:mixinname, o:gref, o:mixinname`
40+
*)
41+
(* Step 1: add a wrapper attribute to declare wrappers,
42+
they should index:
43+
- the wrapped mixin (`isMon`)
44+
- the wrapper mixin (`hom_isMon`)
45+
- the new subject (`hom`)
46+
This attribute will add an entry in the `wrapper-mixin` database.
47+
As an addition substep, we should check that the wrapper has
48+
exactly one field, which is the wrapped mixin.
49+
*)
50+
#[wrapper]
51+
HB.mixin Record hom_isMon T of Quiver T :=
52+
{ private : forall A B, isMon (@hom T A B) }.
53+
54+
(* Step 2: at structure declaration, export the main and only projection
55+
of each declared wrapper as an instance of the wrapped structure on
56+
its subject *)
57+
HB.structure
58+
Definition Monoid_enriched_quiver :=
59+
{ Obj of isQuiver Obj & hom_isMon Obj }.
60+
61+
HB.instance Definition _ (T : Monoid_enriched_quiver.type) (A B : T) :
62+
isMon (@hom T A B) := @private T A B.
63+
64+
(* each instance of isMon should be tried as an instance of hom_isMon *)
65+
66+
(* Step 3: for each instance of a wrapped mixin on a subject known
67+
to be wrapped, automatically produce an instance of the wrapper mixin too. *)
68+
HB.instance Definition _ := isQuiver.Build Type (fun A B => A -> B).
69+
Fail HB.instance Definition homTypeMon (A B : Quiver.type) := isMon.Build (hom A B) (* ... *).
70+
(* This last command should create a `Monoid_enriched_quiver`, in order to do so it should
71+
automatically instanciate the wrapper `hom_isMon`:
72+
HB.instance Definition _ := hom_isMon.Build Type homTypeMon.
73+
*)
374

0 commit comments

Comments
 (0)