diff options
| author | Pierre-Marie Pédrot | 2013-11-26 21:17:01 +0100 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2013-11-26 21:22:20 +0100 |
| commit | e057d9cb8276d1d727825a940673bfb95660ddf5 (patch) | |
| tree | 04229e6c8a7d0f3b9e9b7cda4aa4697f2eb8dad0 | |
| parent | 51d4da4ac126b4b3bb033ec88253866345594e01 (diff) | |
Do not use ugly Dyn features in the Quote plugin. Use instead the
provided tactic environment to handle open terms.
| -rw-r--r-- | plugins/quote/g_quote.ml4 | 18 | ||||
| -rw-r--r-- | tactics/tacinterp.ml | 4 | ||||
| -rw-r--r-- | tactics/tacinterp.mli | 3 |
3 files changed, 20 insertions, 5 deletions
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4 index abb13efd5c..1f11b07ad9 100644 --- a/plugins/quote/g_quote.ml4 +++ b/plugins/quote/g_quote.ml4 @@ -8,14 +8,22 @@ (*i camlp4deps: "grammar/grammar.cma" i*) +open Names +open Misctypes open Tacexpr +open Geninterp open Quote -let make_cont k x = - let k = TacDynamic(Loc.ghost, Tacinterp.tactic_in (fun _ -> k)) in - let x = TacDynamic(Loc.ghost, Pretyping.constr_in x) in - let tac = <:tactic<let cont := $k in cont $x>> in - Tacinterp.interp tac +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 [] ] diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml index 4e20c2fa9f..845b3ad9fb 100644 --- a/tactics/tacinterp.ml +++ b/tactics/tacinterp.ml @@ -2072,6 +2072,10 @@ let eval_tactic t = Proofview.tclLIFT db_initialize <*> interp_tactic (default_ist ()) t +let eval_tactic_ist ist t = + Proofview.tclLIFT db_initialize <*> + interp_tactic ist t + (* globalization + interpretation *) diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli index 5a1e12923a..6a236afda1 100644 --- a/tactics/tacinterp.mli +++ b/tactics/tacinterp.mli @@ -93,6 +93,9 @@ val interp_open_constr_with_bindings : interp_sign -> Environ.env -> Evd.evar_ma val eval_tactic : glob_tactic_expr -> unit Proofview.tactic +val eval_tactic_ist : interp_sign -> glob_tactic_expr -> unit Proofview.tactic +(** Same as [eval_tactic], but with the provided [interp_sign]. *) + (** Globalization + interpretation *) val interp_tac_gen : value Id.Map.t -> Id.t list -> |