From b3c75936a4912ca794cdcecfeb92044552336c63 Mon Sep 17 00:00:00 2001
From: Pierre Letouzey
Date: Wed, 4 Apr 2018 10:43:38 +0200
Subject: prim notations backtrackable, their declarations now in two parts
 (API change)

 The first part (e.g. register_bignumeral_interpretation) deals only with
 the interp/uninterp closures. It should typically be done as a side
 effect during a syntax plugin loading. No prim notation are active yet
 after this phase.

 The second part (enable_prim_token_interpretation) activates the prim
 notation. It is now correctly talking to Summary and to the LibStack.
 To avoid "phantom" objects in libstack after a mere Require, this
 second part should be done inside a Mltop.declare_cache_obj

 The link between the two parts is a prim_token_uid (a string), which
 should be unique for each primitive notation. When this primitive
 notation is specific to a scope, the scope_name could be used as uid.

 Btw, the list of "patterns" for detecting when an uninterpreter should
 be considered is now restricted to a list of global_reference
 (inductive constructors, or injection functions such as IZR).
 The earlier API was accepting a glob_constr list, but was actually
 only working well for global_reference.

 A minimal compatibility is provided (declare_numeral_interpreter),
 but is discouraged, since it is known to store uncessary objects
 in the libstack.
---
 plugins/syntax/ascii_syntax.ml    | 17 +++++++++++++----
 plugins/syntax/int31_syntax.ml    | 20 ++++++++++++++------
 plugins/syntax/n_syntax.ml        | 21 ++++++++++++++-------
 plugins/syntax/nat_syntax.ml      | 18 ++++++++++++++----
 plugins/syntax/positive_syntax.ml | 22 ++++++++++++++--------
 plugins/syntax/r_syntax.ml        | 21 +++++++++++++++------
 plugins/syntax/string_syntax.ml   | 19 +++++++++++++------
 plugins/syntax/z_syntax.ml        | 22 ++++++++++++++--------
 8 files changed, 111 insertions(+), 49 deletions(-)

(limited to 'plugins')

diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml
index 47a59ba631..9bf0b29b61 100644
--- a/plugins/syntax/ascii_syntax.ml
+++ b/plugins/syntax/ascii_syntax.ml
@@ -83,8 +83,17 @@ let make_ascii_string n =
 
 let uninterp_ascii_string (AnyGlobConstr r) = Option.map make_ascii_string (uninterp_ascii r)
 
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
 let _ =
-  Notation.declare_string_interpreter "char_scope"
-    (ascii_path,ascii_module)
-    interp_ascii_string
-    ([DAst.make @@ GRef (static_glob_Ascii,None)], uninterp_ascii_string, true)
+  let sc = "char_scope" in
+  register_string_interpretation sc (interp_ascii_string,uninterp_ascii_string);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = sc;
+      pt_uid = sc;
+      pt_required = (ascii_path,ascii_module);
+      pt_refs = [static_glob_Ascii];
+      pt_in_match = true }
diff --git a/plugins/syntax/int31_syntax.ml b/plugins/syntax/int31_syntax.ml
index f10f98e23b..731eae349a 100644
--- a/plugins/syntax/int31_syntax.ml
+++ b/plugins/syntax/int31_syntax.ml
@@ -96,10 +96,18 @@ let uninterp_int31 (AnyGlobConstr i) =
   with Non_closed ->
     None
 
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
 (* Actually declares the interpreter for int31 *)
-let _ = Notation.declare_numeral_interpreter int31_scope
-  (int31_path, int31_module)
-  interp_int31
-  ([DAst.make (GRef (int31_construct, None))],
-   uninterp_int31,
-   true)
+
+let _ =
+  register_bignumeral_interpretation int31_scope (interp_int31,uninterp_int31);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = int31_scope;
+      pt_uid = int31_scope;
+      pt_required = (int31_path,int31_module);
+      pt_refs = [int31_construct];
+      pt_in_match = true }
diff --git a/plugins/syntax/n_syntax.ml b/plugins/syntax/n_syntax.ml
index 0e202be47f..29b88b1cb3 100644
--- a/plugins/syntax/n_syntax.ml
+++ b/plugins/syntax/n_syntax.ml
@@ -72,10 +72,17 @@ let uninterp_n (AnyGlobConstr p) =
 (************************************************************************)
 (* Declaring interpreters and uninterpreters for N *)
 
-let _ = Notation.declare_numeral_interpreter "N_scope"
-  (n_path,binnums)
-  n_of_int
-  ([DAst.make @@ GRef (glob_N0, None);
-    DAst.make @@ GRef (glob_Npos, None)],
-  uninterp_n,
-  true)
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
+let _ =
+  let scope = "N_scope" in
+  register_bignumeral_interpretation scope (n_of_int,uninterp_n);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = scope;
+      pt_uid = scope;
+      pt_required = (n_path,binnums);
+      pt_refs = [glob_N0; glob_Npos];
+      pt_in_match = true }
diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml
index e158e0b516..85cb49586d 100644
--- a/plugins/syntax/nat_syntax.ml
+++ b/plugins/syntax/nat_syntax.ml
@@ -78,8 +78,18 @@ let uninterp_nat (AnyGlobConstr p) =
 (************************************************************************)
 (* Declare the primitive parsers and printers *)
 
+open Notation
+
+let nat_scope = "nat_scope"
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
 let _ =
-  Notation.declare_numeral_interpreter "nat_scope"
-    (nat_path,datatypes_module_name)
-    nat_of_int
-    ([DAst.make @@ GRef (glob_S,None); DAst.make @@ GRef (glob_O,None)], uninterp_nat, true)
+  register_bignumeral_interpretation nat_scope (nat_of_int,uninterp_nat);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = nat_scope;
+      pt_uid = nat_scope;
+      pt_required = (nat_path,datatypes_module_name);
+      pt_refs = [glob_S; glob_O];
+      pt_in_match = true }
diff --git a/plugins/syntax/positive_syntax.ml b/plugins/syntax/positive_syntax.ml
index 0c82e47445..6fce4de9ef 100644
--- a/plugins/syntax/positive_syntax.ml
+++ b/plugins/syntax/positive_syntax.ml
@@ -91,11 +91,17 @@ let uninterp_positive (AnyGlobConstr p) =
 (* Declaring interpreters and uninterpreters for positive *)
 (************************************************************************)
 
-let _ = Notation.declare_numeral_interpreter "positive_scope"
-  (positive_path,binnums)
-  interp_positive
-  ([DAst.make @@ GRef (glob_xI, None);
-    DAst.make @@ GRef (glob_xO, None);
-    DAst.make @@ GRef (glob_xH, None)],
-   uninterp_positive,
-   true)
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
+let _ =
+  let scope = "positive_scope" in
+  register_bignumeral_interpretation scope (interp_positive,uninterp_positive);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = scope;
+      pt_uid = scope;
+      pt_required = (positive_path,binnums);
+      pt_refs = [glob_xI; glob_xO; glob_xH];
+      pt_in_match = true }
diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml
index 94aa143350..eccc544e41 100644
--- a/plugins/syntax/r_syntax.ml
+++ b/plugins/syntax/r_syntax.ml
@@ -131,9 +131,18 @@ let uninterp_r (AnyGlobConstr p) =
   with Non_closed_number ->
     None
 
-let _ = Notation.declare_numeral_interpreter "R_scope"
-  (r_path,["Coq";"Reals";"Rdefinitions"])
-  r_of_int
-  ([DAst.make @@ GRef (glob_IZR, None)],
-    uninterp_r,
-    false)
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
+let r_scope = "R_scope"
+
+let _ =
+  register_bignumeral_interpretation r_scope (r_of_int,uninterp_r);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = r_scope;
+      pt_uid = r_scope;
+      pt_required = (r_path,["Coq";"Reals";"Rdefinitions"]);
+      pt_refs = [glob_IZR];
+      pt_in_match = false }
diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml
index c22869f4d6..ca1bf0df27 100644
--- a/plugins/syntax/string_syntax.ml
+++ b/plugins/syntax/string_syntax.ml
@@ -64,10 +64,17 @@ let uninterp_string (AnyGlobConstr r) =
   with
    Non_closed_string -> None
 
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
 let _ =
-  Notation.declare_string_interpreter "string_scope"
-    (string_path,["Coq";"Strings";"String"])
-    interp_string
-    ([DAst.make @@ GRef (static_glob_String,None);
-      DAst.make @@ GRef (static_glob_EmptyString,None)],
-     uninterp_string, true)
+  let sc = "string_scope" in
+  register_string_interpretation sc (interp_string,uninterp_string);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = sc;
+      pt_uid = sc;
+      pt_required = (string_path,["Coq";"Strings";"String"]);
+      pt_refs = [static_glob_String; static_glob_EmptyString];
+      pt_in_match = true }
diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml
index 2534162e36..72e1321eab 100644
--- a/plugins/syntax/z_syntax.ml
+++ b/plugins/syntax/z_syntax.ml
@@ -68,11 +68,17 @@ let uninterp_z (AnyGlobConstr p) =
 (************************************************************************)
 (* Declaring interpreters and uninterpreters for Z *)
 
-let _ = Notation.declare_numeral_interpreter "Z_scope"
-  (z_path,binnums)
-  z_of_int
-  ([DAst.make @@ GRef (glob_ZERO, None);
-    DAst.make @@ GRef (glob_POS, None);
-    DAst.make @@ GRef (glob_NEG, None)],
-  uninterp_z,
-  true)
+open Notation
+
+let at_declare_ml_module f x =
+  Mltop.declare_cache_obj (fun () -> f x) __coq_plugin_name
+
+let _ =
+  let scope = "Z_scope" in
+  register_bignumeral_interpretation scope (z_of_int,uninterp_z);
+  at_declare_ml_module enable_prim_token_interpretation
+    { pt_scope = scope;
+      pt_uid = scope;
+      pt_required = (z_path,binnums);
+      pt_refs = [glob_ZERO; glob_POS; glob_NEG];
+      pt_in_match = true }
-- 
cgit v1.2.3