summaryrefslogtreecommitdiff
path: root/plugins/quote/g_quote.ml4
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/quote/g_quote.ml4')
-rw-r--r--plugins/quote/g_quote.ml425
1 files changed, 17 insertions, 8 deletions
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4
index e2c9dbaa..e27fe7f4 100644
--- a/plugins/quote/g_quote.ml4
+++ b/plugins/quote/g_quote.ml4
@@ -1,22 +1,31 @@
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
-(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2014 *)
+(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2015 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
-(*i camlp4deps: "parsing/grammar.cma" i*)
+(*i camlp4deps: "grammar/grammar.cma" i*)
-open Util
+open Names
+open Misctypes
open Tacexpr
+open Geninterp
open Quote
-let make_cont k x =
- let k = TacDynamic(dummy_loc, Tacinterp.tactic_in (fun _ -> k)) in
- let x = TacDynamic(dummy_loc, Pretyping.constr_in x) in
- let tac = <:tactic<let cont := $k in cont $x>> in
- Tacinterp.interp tac
+DECLARE PLUGIN "quote_plugin"
+
+let loc = Loc.ghost
+let cont = (loc, Id.of_string "cont")
+let x = (loc, Id.of_string "x")
+
+let make_cont (k : glob_tactic_expr) (c : Constr.t) =
+ let c = Tacinterp.Value.of_constr c in
+ let tac = TacCall (loc, ArgVar cont, [Reference (ArgVar x)]) in
+ let tac = TacLetIn (false, [(cont, Tacexp k)], TacArg (loc, tac)) in
+ let ist = { lfun = Id.Map.singleton (snd x) c; extra = TacStore.empty; } in
+ Tacinterp.eval_tactic_ist ist tac
TACTIC EXTEND quote
[ "quote" ident(f) ] -> [ quote f [] ]