aboutsummaryrefslogtreecommitdiffhomepage
path: root/interp
diff options
context:
space:
mode:
Diffstat (limited to 'interp')
-rw-r--r--interp/constrintern.ml10
-rw-r--r--interp/constrintern.mli2
-rw-r--r--interp/genintern.ml12
-rw-r--r--interp/genintern.mli8
4 files changed, 27 insertions, 5 deletions
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 2426366c6..ab1b27eec 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -68,6 +68,7 @@ type internalization_env =
type ltac_sign = {
ltac_vars : Id.Set.t;
ltac_bound : Id.Set.t;
+ ltac_extra : Genintern.Store.t;
}
let interning_grammar = ref false
@@ -1717,12 +1718,14 @@ let internalize globalenv env allow_patvar (_, ntnvars as lvar) c =
| Some gen ->
let (ltacvars, ntnvars) = lvar in
let ntnvars = Id.Map.domain ntnvars in
+ let extra = ltacvars.ltac_extra in
let lvars = Id.Set.union ltacvars.ltac_bound ltacvars.ltac_vars in
let lvars = Id.Set.union lvars ntnvars in
- let lvars = Id.Set.union lvars env.ids in
+ let ltacvars = Id.Set.union lvars env.ids in
let ist = {
- Genintern.ltacvars = lvars;
- genv = globalenv;
+ Genintern.genv = globalenv;
+ ltacvars;
+ extra;
} in
let (_, glb) = Genintern.generic_intern ist gen in
Some glb
@@ -1913,6 +1916,7 @@ let scope_of_type_kind = function
let empty_ltac_sign = {
ltac_vars = Id.Set.empty;
ltac_bound = Id.Set.empty;
+ ltac_extra = Genintern.Store.empty;
}
let intern_gen kind env
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index fdd50c6a1..644cafe57 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -70,6 +70,8 @@ type ltac_sign = {
(** Variables of Ltac which may be bound to a term *)
ltac_bound : Id.Set.t;
(** Other variables of Ltac *)
+ ltac_extra : Genintern.Store.t;
+ (** Arbitrary payload *)
}
val empty_ltac_sign : ltac_sign
diff --git a/interp/genintern.ml b/interp/genintern.ml
index be7abfa99..e443824bd 100644
--- a/interp/genintern.ml
+++ b/interp/genintern.ml
@@ -10,9 +10,19 @@ open Names
open Mod_subst
open Genarg
+module Store = Store.Make(struct end)
+
type glob_sign = {
ltacvars : Id.Set.t;
- genv : Environ.env }
+ genv : Environ.env;
+ extra : Store.t;
+}
+
+let empty_glob_sign env = {
+ ltacvars = Id.Set.empty;
+ genv = env;
+ extra = Store.empty;
+}
type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb
type 'glb subst_fun = substitution -> 'glb -> 'glb
diff --git a/interp/genintern.mli b/interp/genintern.mli
index 4b0354be3..658caa08c 100644
--- a/interp/genintern.mli
+++ b/interp/genintern.mli
@@ -10,9 +10,15 @@ open Names
open Mod_subst
open Genarg
+module Store : Store.S
+
type glob_sign = {
ltacvars : Id.Set.t;
- genv : Environ.env }
+ genv : Environ.env;
+ extra : Store.t;
+}
+
+val empty_glob_sign : Environ.env -> glob_sign
(** {5 Internalization functions} *)