diff options
| author | Pierre-Marie Pédrot | 2017-08-29 15:23:37 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot | 2017-08-29 15:41:34 +0200 |
| commit | 94397f6e022176a29add6369f0a310b1d7decf62 (patch) | |
| tree | 7b5db0eb33af0dd3ac7e2cfdfa9c3e33386fe288 /src | |
| parent | f6154c8a086faee725b4f41fb4b2586d7cb6c51d (diff) | |
Pass Ltac2 variables in a dedicated environment for generic arguments.
This is a way to hack around the fact that various interpretation functions
rely wrongly on the values of the environment to do nasty tricks. Typically,
the interpretation of terms is broken, as it will fail when there is a bound
variable with the same name as a hypothesis, instead of producing the
hypothesis itself.
Diffstat (limited to 'src')
| -rw-r--r-- | src/tac2core.ml | 10 | ||||
| -rw-r--r-- | src/tac2interp.ml | 19 | ||||
| -rw-r--r-- | src/tac2interp.mli | 5 |
3 files changed, 26 insertions, 8 deletions
diff --git a/src/tac2core.ml b/src/tac2core.ml index 609dd40587..d14849a2a6 100644 --- a/src/tac2core.ml +++ b/src/tac2core.ml @@ -656,8 +656,7 @@ let open_constr_no_classes_flags () = (** Embed all Ltac2 data into Values *) let to_lvar ist = let open Glob_ops in - let map e = Val.Dyn (val_valexpr, e) in - let lfun = Id.Map.map map ist in + let lfun = Tac2interp.set_env ist Id.Map.empty in { empty_lvar with Glob_term.ltac_genargs = lfun } let interp_constr flags ist (c, _) = @@ -728,12 +727,7 @@ let () = 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 - | None -> accu - | Some Refl -> Id.Map.add id v accu - in - let ist = Id.Map.fold fold ist Id.Map.empty in + let ist = Tac2interp.get_env ist in let tac = Proofview.tclIGNORE (interp ist tac) in let c, sigma = Pfedit.refine_by_tactic env sigma concl tac in (EConstr.of_constr c, sigma) diff --git a/src/tac2interp.ml b/src/tac2interp.ml index 3490b1a2a8..691c795502 100644 --- a/src/tac2interp.ml +++ b/src/tac2interp.ml @@ -155,3 +155,22 @@ and interp_set ist e p r = match e with return (ValInt 0) | ValInt _ | ValExt _ | ValStr _ | ValCls _ | ValOpn _ -> anomaly (str "Unexpected value shape") + +(** Cross-boundary hacks. *) + +open Geninterp + +let val_env : environment Val.typ = Val.create "ltac2:env" +let env_ref = Id.of_string_soft "@@ltac2_env@@" + +let extract_env (Val.Dyn (tag, v)) : environment = +match Val.eq tag val_env with +| None -> assert false +| Some Refl -> v + +let get_env ist = + try extract_env (Id.Map.find env_ref ist) + with Not_found -> empty_environment + +let set_env env ist = + Id.Map.add env_ref (Val.Dyn (val_env, env)) ist diff --git a/src/tac2interp.mli b/src/tac2interp.mli index 42e9e3adeb..f99008c506 100644 --- a/src/tac2interp.mli +++ b/src/tac2interp.mli @@ -17,6 +17,11 @@ val interp : environment -> glb_tacexpr -> valexpr Proofview.tactic val interp_app : valexpr -> valexpr list -> valexpr Proofview.tactic +(** {5 Cross-boundary encodings} *) + +val get_env : Glob_term.unbound_ltac_var_map -> environment +val set_env : environment -> Glob_term.unbound_ltac_var_map -> Glob_term.unbound_ltac_var_map + (** {5 Exceptions} *) exception LtacError of KerName.t * valexpr array |
