diff options
| author | Pierre-Marie Pédrot | 2017-08-26 00:52:39 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2017-08-26 01:31:07 +0200 |
| commit | 126dc656963a7feb589b2a3574f0c55ad84d5f69 (patch) | |
| tree | e329a2409e310d71804bd5e2489eb1b6dbebeebf /src | |
| parent | b3471b2bf449041b47c19e8e12249e4bb36af3ec (diff) | |
Allowing to insert calls to Ltac1 references in Ltac2.
Diffstat (limited to 'src')
| -rw-r--r-- | src/g_ltac2.ml4 | 5 | ||||
| -rw-r--r-- | src/tac2core.ml | 14 |
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 |
