Skip to content

Commit b44cfce

Browse files
committed
added command to take over evarconv
1 parent 74ba0d4 commit b44cfce

File tree

6 files changed

+1972
-6
lines changed

6 files changed

+1972
-6
lines changed

apps/cs/_CoqProject

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55

66
-R theories elpi.apps
77

8+
src/evarconv_hacked.ml
89
src/coq_elpi_cs_hook.mlg
910
src/elpi_cs_plugin.mlpack
1011

apps/cs/src/coq_elpi_cs_hook.ml

Lines changed: 20 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@ open Elpi
77
open Elpi_plugin
88
open Coq_elpi_arg_syntax
99
open Coq_elpi_vernacular
10+
module Evarconv = Evarconv
11+
module Evarconv_hacked = Evarconv_hacked
1012

1113

1214
let elpi_cs_hook program env sigma lhs rhs =
@@ -50,15 +52,18 @@ let elpi_cs_hook program env sigma lhs rhs =
5052
let add_cs_hook =
5153
let cs_hook_program = Summary.ref ~name:"elpi-cs" None in
5254
let cs_hook env sigma proj pat =
55+
Feedback.msg_info (Pp.str "run");
5356
match !cs_hook_program with
5457
| None -> None
5558
| Some h -> elpi_cs_hook h env sigma proj pat in
5659
let name = "elpi-cs" in
57-
Evarconv.register_hook ~name cs_hook;
60+
Evarconv_hacked.register_hook ~name cs_hook;
5861
let inCs =
5962
let cache program =
6063
cs_hook_program := Some program;
61-
Evarconv.activate_hook ~name in
64+
Feedback.msg_info (Pp.str "activate");
65+
66+
Evarconv_hacked.activate_hook ~name in
6267
let open Libobject in
6368
declare_object
6469
@@ superglobal_object_nodischarge "ELPI-CS" ~cache ~subst:None in
@@ -73,12 +78,23 @@ let () = Vernacextend.static_vernac_extend ~plugin:(Some "coq-elpi-cs.plugin") ~
7378
Vernacextend.TyNil))), (let coqpp_body p
7479
atts = Vernactypes.vtdefault (fun () ->
7580

76-
# 72 "src/coq_elpi_cs_hook.mlg"
81+
# 74 "src/coq_elpi_cs_hook.mlg"
7782

7883
let () = ignore_unknown_attributes atts in
7984
add_cs_hook (snd p)
8085
) in fun p
8186
?loc ~atts ()
8287
-> coqpp_body p
83-
(Attributes.parse any_attribute atts)), None))]
88+
(Attributes.parse any_attribute atts)), None));
89+
(Vernacextend.TyML (false, Vernacextend.TyTerminal ("Elpi",
90+
Vernacextend.TyTerminal ("Override",
91+
Vernacextend.TyTerminal ("CS", Vernacextend.TyNonTerminal (
92+
Extend.TUentry (Genarg.get_arg_tag wit_qualified_name),
93+
Vernacextend.TyNil)))),
94+
(let coqpp_body p atts = Vernactypes.vtdefault (fun () ->
95+
# 77 "src/coq_elpi_cs_hook.mlg"
96+
97+
Evarconv.set_evar_conv Evarconv_hacked.evar_conv_x
98+
) in fun p
99+
?loc ~atts () -> coqpp_body p (Attributes.parse any_attribute atts)), None))]
84100

apps/cs/src/coq_elpi_cs_hook.mlg

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,8 @@ open Elpi
66
open Elpi_plugin
77
open Coq_elpi_arg_syntax
88
open Coq_elpi_vernacular
9+
module Evarconv = Evarconv
10+
module Evarconv_hacked = Evarconv_hacked
911

1012

1113
let elpi_cs_hook program env sigma lhs rhs =
@@ -54,13 +56,13 @@ let add_cs_hook =
5456
| None -> None
5557
| Some h -> elpi_cs_hook h env sigma proj pat in
5658
let name = "elpi-cs" in
57-
Evarconv.register_hook ~name cs_hook;
59+
Evarconv_hacked.register_hook ~name cs_hook;
5860
let inCs =
5961
let cache program =
6062
cs_hook_program := Some program;
6163
Feedback.msg_info (Pp.str "activate");
6264

63-
Evarconv.activate_hook ~name in
65+
Evarconv_hacked.activate_hook ~name in
6466
let open Libobject in
6567
declare_object
6668
@@ superglobal_object_nodischarge "ELPI-CS" ~cache ~subst:None in
@@ -72,5 +74,7 @@ VERNAC COMMAND EXTEND ElpiCS CLASSIFIED AS SIDEFF
7274
| #[ atts = any_attribute ] [ "Elpi" "CSFallbackTactic" qualified_name(p) ] -> {
7375
let () = ignore_unknown_attributes atts in
7476
add_cs_hook (snd p) }
77+
| #[ atts = any_attribute ] [ "Elpi" "Override" "CS" qualified_name(p) ] -> {
78+
Evarconv.set_evar_conv Evarconv_hacked.evar_conv_x }
7579

7680
END

apps/cs/src/elpi_cs_plugin.mlpack

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1 +1,2 @@
1+
Evarconv_hacked
12
Coq_elpi_cs_hook

0 commit comments

Comments
 (0)