Skip to content

Commit 4d43bd9

Browse files
committed
[TC] primitive constructor for fold in instance (pre-)compilation
1 parent 1931f7b commit 4d43bd9

File tree

2 files changed

+5
-1
lines changed

2 files changed

+5
-1
lines changed

apps/tc/elpi/ho_compile.elpi

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ namespace tc {
2323
decompile-term-aux (pglobal _ _ as T) L T' L :- !, copy T T', !.
2424
decompile-term-aux (sort _ as T) L T' L :- !, copy T T', !.
2525
decompile-term-aux (uvar as X) L X L :- !.
26+
decompile-term-aux (primitive _ as X) L X L :- !.
2627

2728
decompile-term-aux (tc.maybe-eta-tm T S) (pr [X|XS] L1) Y (pr XS' [NL | L2]) :- !,
2829
name Y X S,
@@ -327,6 +328,8 @@ namespace tc {
327328
get-uva-pair-arity Y L Z.
328329

329330
pred decompile-problematic-term i:term, i:list prop, o:term, o:list prop.
331+
decompile-problematic-term (primitive _ as C) A C A :- !.
332+
330333
decompile-problematic-term (tc.maybe-eta-tm T S) L V [tc.link.eta V T' | L2] :-
331334
prune V S, !, fold-map T L T' L2.
332335

apps/tc/elpi/ho_precompile.elpi

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -105,6 +105,7 @@ namespace tc {
105105
precompile-aux _ (global _ as C) A C A :- !.
106106
precompile-aux _ (pglobal _ _ as C) A C A :- !.
107107
precompile-aux _ (sort _ as C) A C A :- !.
108+
precompile-aux _ (primitive _ as C) A C A :- !.
108109

109110
% Detect maybe-eta term
110111
% TODO: should I precompile also the type of the fun and put it in the output term
@@ -142,7 +143,6 @@ namespace tc {
142143
% precompile-aux IsP Ty A Ty1 A1, pi x\ is-name x => precompile-aux IsP (F x) A1 (F1 x) A2.
143144
% precompile-aux IsP (match T Rty B) A (match T1 Rty1 B1) A3 :- !,
144145
% precompile-aux IsP T A T1 A1, precompile-aux IsP Rty A1 Rty1 A2, std.fold-map B A2 (precompile-aux IsP) B1 A3.
145-
% precompile-aux _ (primitive _ as C) A C A :- !.
146146
% precompile-aux IsP (uvar M L as X) A W A1 :- var X, !, std.fold-map L A (precompile-aux IsP) L1 A1, coq.mk-app-uvar M L1 W.
147147
% % when used in CHR rules
148148
% precompile-aux IsP (uvar X L) A (uvar X L1) A1 :- std.fold-map L A (precompile-aux IsP) L1 A1.
@@ -226,6 +226,7 @@ namespace tc {
226226
precompile-aux (global _ as C) A C A :- !.
227227
precompile-aux (pglobal _ _ as C) A C A :- !.
228228
precompile-aux (sort _ as C) A C A :- !.
229+
precompile-aux (primitive _ as C) A C A :- !.
229230

230231
% Detect maybe-eta term
231232
precompile-aux (fun Name Ty B as T) N (tc.maybe-eta-tm (fun Name Ty' B') Scope) M :-

0 commit comments

Comments
 (0)