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/nat_syntax.ml | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) (limited to 'plugins/syntax/nat_syntax.ml') 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 } -- cgit v1.2.3 From ec0ad20de8daf2ad9f3237de92a745247db845f5 Mon Sep 17 00:00:00 2001 From: Pierre Letouzey Date: Tue, 21 Mar 2017 16:13:24 +0100 Subject: remove legacy syntax plugins subsumed by Numeral Notation --- plugins/syntax/nat_syntax.ml | 95 -------------------------------------------- 1 file changed, 95 deletions(-) delete mode 100644 plugins/syntax/nat_syntax.ml (limited to 'plugins/syntax/nat_syntax.ml') diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml deleted file mode 100644 index 85cb49586d..0000000000 --- a/plugins/syntax/nat_syntax.ml +++ /dev/null @@ -1,95 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) -(* > *) - -let threshold = of_int 5000 - -let warn_large_nat = - CWarnings.create ~name:"large-nat" ~category:"numbers" - (fun () -> strbrk "Stack overflow or segmentation fault happens when " ++ - strbrk "working with large numbers in nat (observed threshold " ++ - strbrk "may vary from 5000 to 70000 depending on your system " ++ - strbrk "limits and on the command executed).") - -let nat_of_int ?loc n = - if is_pos_or_zero n then begin - if less_than threshold n then warn_large_nat (); - let ref_O = DAst.make ?loc @@ GRef (glob_O, None) in - let ref_S = DAst.make ?loc @@ GRef (glob_S, None) in - let rec mk_nat acc n = - if n <> zero then - mk_nat (DAst.make ?loc @@ GApp (ref_S, [acc])) (sub_1 n) - else - acc - in - mk_nat ref_O n - end - else - user_err ?loc ~hdr:"nat_of_int" - (str "Cannot interpret a negative number as a number of type nat") - -(************************************************************************) -(* Printing via scopes *) - -exception Non_closed_number - -let rec int_of_nat x = DAst.with_val (function - | GApp (r, [a]) -> - begin match DAst.get r with - | GRef (s,_) when GlobRef.equal s glob_S -> add_1 (int_of_nat a) - | _ -> raise Non_closed_number - end - | GRef (z,_) when GlobRef.equal z glob_O -> zero - | _ -> raise Non_closed_number - ) x - -let uninterp_nat (AnyGlobConstr p) = - try - Some (int_of_nat p) - with - Non_closed_number -> None - -(************************************************************************) -(* 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 _ = - 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 } -- cgit v1.2.3