Imported Upstream version 8.3.pl4upstream/8.3.pl4

4 files changed, 17 insertions, 9 deletions

diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 4310a01e..96393659 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: constrintern.ml 14656 2011-11-16 08:46:31Z herbelin $ *)
+(* $Id: constrintern.ml 15072 2012-03-20 17:36:33Z herbelin $ *)
 
 open Pp
 open Util
@@ -693,8 +693,9 @@ let apply_scope_env (ids,unb,_,scopes) = function
   | [] -> (ids,unb,None,scopes), []
   | sc::scl -> (ids,unb,sc,scopes), scl
 
-let rec simple_adjust_scopes n = function
-  | [] -> if n=0 then [] else None :: simple_adjust_scopes (n-1) []
+let rec simple_adjust_scopes n scopes =
+  if n=0 then [] else match scopes with
+  | [] -> None :: simple_adjust_scopes (n-1) []
   | sc::scopes -> sc :: simple_adjust_scopes (n-1) scopes
 
 let find_remaining_constructor_scopes pl1 pl2 (ind,j as cstr) =
@@ -771,9 +772,6 @@ let message_redundant_alias (id1,id2) =
 
 (* Expanding notations *)
 
-let error_invalid_pattern_notation loc =
-  user_err_loc (loc,"",str "Invalid notation for pattern.")
-
 let chop_aconstr_constructor loc (ind,k) args =
   if List.length args = 0 then (* Tolerance for a @id notation *) args else
     begin
diff --git a/interp/notation.ml b/interp/notation.ml
index 6e02c40b..4b67f8bd 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: notation.ml 14820 2011-12-18 22:11:32Z herbelin $ *)
+(* $Id: notation.ml 14882 2012-01-05 23:44:40Z herbelin $ *)
 
 (*i*)
 open Util
diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index 2d4e41ec..bcd07aea 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: topconstr.ml 14641 2011-11-06 11:59:10Z herbelin $ *)
+(* $Id: topconstr.ml 15072 2012-03-20 17:36:33Z herbelin $ *)
 
 (*i*)
 open Pp
@@ -903,6 +903,12 @@ let names_of_local_binders bl =
   List.flatten (List.map (function LocalRawAssum(l,_,_)->l|LocalRawDef(l,_)->[l]) bl)
 
 (**********************************************************************)
+(* Miscellaneous *)
+
+let error_invalid_pattern_notation loc =
+  user_err_loc (loc,"",str "Invalid notation for pattern.")
+
+(**********************************************************************)
 (* Functions on constr_expr *)
 
 let constr_loc = function
diff --git a/interp/topconstr.mli b/interp/topconstr.mli
index ce9de27b..abfbd9a1 100644
--- a/interp/topconstr.mli
+++ b/interp/topconstr.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: topconstr.mli 14641 2011-11-06 11:59:10Z herbelin $ i*)
+(*i $Id: topconstr.mli 15072 2012-03-20 17:36:33Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -282,3 +282,7 @@ val ntn_loc :
   Util.loc -> constr_notation_substitution -> string -> (int * int) list
 val patntn_loc :
   Util.loc -> cases_pattern_notation_substitution -> string -> (int * int) list
+
+(** For cases pattern parsing errors *)
+
+val error_invalid_pattern_notation : Util.loc -> 'a