Skip to content

Commit 101a634

Browse files
committed
a bit unsure about this, it looks too smart in some cases
we should juggle with the section or infer by hand...
1 parent 2cb6f0b commit 101a634

File tree

3 files changed

+30
-3
lines changed

3 files changed

+30
-3
lines changed

HB/common/utils.elpi

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -367,6 +367,25 @@ re-enable-id-phant T T1 :-
367367
(pi f1 f2 t v\ copy {{lib:@hb.ignore_disabled lp:t lp:f1 lp:v lp:f2}} {{lib:@hb.ignore lp:t lp:v}} :- !) =>
368368
copy T T1.
369369

370+
pred failsafe-structure-inference i:term, o:term.
371+
failsafe-structure-inference T T1 :-
372+
(pi OP Args Args1\
373+
copy (app [global (const OP)|Args]) (app [global (const OP)| Args1]) :-
374+
exported-op _ _ OP, !, eta-structure-record OP Args Args1) =>
375+
copy T T1.
376+
377+
pred eta-structure-record i:constant, i:list term, o:list term.
378+
eta-structure-record OP L L1 :-
379+
exported-op M _ OP, mixin-first-class M Class, factory-nparams Class NP,
380+
std.split-at NP L Params [S|Rest],
381+
var S,
382+
class-def (class Class Structure _),
383+
get-constructor Structure K,
384+
std.map Params copy Params1,
385+
std.map Rest copy Rest1,
386+
coq.mk-app {coq.env.global K} {std.append Params1 [_,_]} EtaS,
387+
std.append Params1 [EtaS|Rest1] L1.
388+
370389
pred prod-last i:term, o:term.
371390
prod-last (prod N S X) Y :- !, @pi-decl N S x\ prod-last (X x) Y.
372391
prod-last X X :- !.

HB/structure.elpi

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,11 @@ pred declare i:string, i:term, i:sort.
99
pred declare i:string, i:term, i:universe.
1010
declare Module BSkel Sort :- std.do! [
1111
disable-id-phant BSkel BSkelNoId,
12-
std.assert-ok! (coq.elaborate-skeleton BSkelNoId _ BNoId) "illtyped structure definition",
12+
failsafe-structure-inference BSkelNoId BSkelNoIdX,
13+
coq.say BSkelNoIdX,
14+
std.assert-ok! (coq.elaborate-skeleton BSkelNoIdX _ BNoId) "illtyped structure definition",
1315
re-enable-id-phant BNoId B,
16+
1417
private.sigT->list-w-params B GRFSwP_or_ThingtoBeWrapped ClosureCheck,
1518

1619
% do some work to go back to factories on a single subject

tests/monoid_enriched_cat.v

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,12 +52,17 @@ HB.mixin Record hom_isMon T of Quiver T :=
5252
{ hom_isMon_private : forall A B, isMon (@hom T A B) }.
5353

5454

55-
Fail HB.structure
55+
Succeed HB.structure
5656
Definition Monoid_enriched_quiver :=
5757
{ Obj of isQuiver Obj &
5858
(forall A B : Obj, isMon (hom A B)) }.
5959

60-
(* which one is best? *)
60+
Succeed HB.structure
61+
Definition Monoid_enriched_quiver :=
62+
{ Obj of (*isQuiver Obj & once we wrap we pull this in as a dep! *)
63+
(forall A B : Obj, isMon (hom A B)) }.
64+
65+
(* which one is best? *)
6166
Succeed HB.structure
6267
Definition Monoid_enriched_quiver :=
6368
{ Obj of isQuiver Obj &

0 commit comments

Comments
 (0)