From d288152f7d886ca6dba3944d20c6ca21452533da Mon Sep 17 00:00:00 2001
From: herbelin
Date: Tue, 20 Mar 2012 13:59:03 +0000
Subject: Continuing r15045-15046 and r15055 (fixing bug #2732 about atomic
 tactic arguments of ltac functions).

Added support for recursive entries in ARGUMENT EXTEND, for right-hand
sides of ARGUMENT EXTEND raising exceptions and for right-hand sides
referring to "loc". Also fixed parsing level of initial value in
create_arg (raw instead of glob). Thanks to the Ssreflect plugin for
revealing these problems.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@15065 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 interp/genarg.mli   | 4 ++--
 interp/notation.ml  | 5 +++++
 interp/notation.mli | 2 ++
 3 files changed, 9 insertions(+), 2 deletions(-)

(limited to 'interp')

diff --git a/interp/genarg.mli b/interp/genarg.mli
index 43cd73aedb..540fc400c6 100644
--- a/interp/genarg.mli
+++ b/interp/genarg.mli
@@ -257,7 +257,7 @@ val app_pair :
 
 (** create a new generic type of argument: force to associate
    unique ML types at each of the three levels *)
-val create_arg : 'globa option ->
+val create_arg : 'rawa option ->
     string ->
       ('a,tlevel) abstract_argument_type
       * ('globa,glevel) abstract_argument_type
@@ -314,4 +314,4 @@ type an_arg_of_this_type
 val in_generic :
   argument_type -> an_arg_of_this_type -> 'co generic_argument
 
-val default_empty_value : ('a,glevel) abstract_argument_type -> 'a option
+val default_empty_value : ('a,rlevel) abstract_argument_type -> 'a option
diff --git a/interp/notation.ml b/interp/notation.ml
index 96de08da3a..397f46fc42 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -818,3 +818,8 @@ let _ =
     { freeze_function = freeze;
       unfreeze_function = unfreeze;
       init_function = init }
+
+let with_notation_protection f x =
+  let fs = freeze () in
+  try let a = f x in unfreeze fs; a
+  with e -> unfreeze fs; raise e
diff --git a/interp/notation.mli b/interp/notation.mli
index 25ea594190..de14c95155 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -178,3 +178,5 @@ val declare_notation_printing_rule : notation -> unparsing_rule -> unit
 val find_notation_printing_rule : notation -> unparsing_rule
 
 (** Rem: printing rules for primitive token are canonical *)
+
+val with_notation_protection : ('a -> 'b) -> 'a -> 'b
-- 
cgit v1.2.3