aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2017-08-26 00:52:39 +0200
committerPierre-Marie Pédrot2017-08-26 01:31:07 +0200
commit126dc656963a7feb589b2a3574f0c55ad84d5f69 (patch)
treee329a2409e310d71804bd5e2489eb1b6dbebeebf /src
parentb3471b2bf449041b47c19e8e12249e4bb36af3ec (diff)
Allowing to insert calls to Ltac1 references in Ltac2.
Diffstat (limited to 'src')
-rw-r--r--src/g_ltac2.ml45
-rw-r--r--src/tac2core.ml14
2 files changed, 19 insertions, 0 deletions
diff --git a/src/g_ltac2.ml4 b/src/g_ltac2.ml4
index e7ab574747..6822b8e7ba 100644
--- a/src/g_ltac2.ml4
+++ b/src/g_ltac2.ml4
@@ -72,10 +72,14 @@ let tac2def_ext = Gram.entry_create "tactic:tac2def_ext"
let tac2def_syn = Gram.entry_create "tactic:tac2def_syn"
let tac2mode = Gram.entry_create "vernac:ltac2_command"
+(** FUCK YOU API *)
+let ltac1_expr = (Obj.magic Pltac.tactic_expr : Tacexpr.raw_tactic_expr Gram.entry)
+
let inj_wit wit loc x = CTacExt (loc, Genarg.in_gen (Genarg.rawwit wit) x)
let inj_open_constr loc c = inj_wit Stdarg.wit_open_constr loc c
let inj_pattern loc c = inj_wit Tac2env.wit_pattern loc c
let inj_reference loc c = inj_wit Tac2env.wit_reference loc c
+let inj_ltac1 loc e = inj_wit Tacarg.wit_tactic loc e
let pattern_of_qualid loc id =
if Tac2env.is_constructor (snd id) then CPatRef (loc, RelId id, [])
@@ -170,6 +174,7 @@ GEXTEND Gram
| IDENT "ident"; ":"; "("; c = lident; ")" -> Tac2quote.of_ident c
| IDENT "pattern"; ":"; "("; c = Constr.lconstr_pattern; ")" -> inj_pattern !@loc c
| IDENT "reference"; ":"; "("; c = globref; ")" -> inj_reference !@loc c
+ | IDENT "ltac1"; ":"; "("; qid = ltac1_expr; ")" -> inj_ltac1 !@loc qid
] ]
;
let_clause:
diff --git a/src/tac2core.ml b/src/tac2core.ml
index b67d70a5cb..b95410f40e 100644
--- a/src/tac2core.ml
+++ b/src/tac2core.ml
@@ -738,6 +738,20 @@ let () =
define_ml_object Tac2env.wit_reference obj
let () =
+ let interp _ tac =
+ (** FUCK YOU API *)
+ (Obj.magic Ltac_plugin.Tacinterp.eval_tactic tac : unit Proofview.tactic) >>= fun () ->
+ return v_unit
+ in
+ let obj = {
+ ml_type = t_unit;
+ ml_interp = interp;
+ } in
+ define_ml_object Ltac_plugin.Tacarg.wit_tactic obj
+
+(** Ltac2 in terms *)
+
+let () =
let interp ist env sigma concl tac =
let fold id (Val.Dyn (tag, v)) (accu : environment) : environment =
match Val.eq tag val_valexpr with