Imported Upstream version 8.2~beta3+dfsgupstream/8.2.beta3+dfsg

43 files changed, 2476 insertions, 1159 deletions

diff --git a/parsing/argextend.ml4 b/parsing/argextend.ml4
index 2731fc90..57e88133 100644
--- a/parsing/argextend.ml4
+++ b/parsing/argextend.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: argextend.ml4 10185 2007-10-06 18:05:13Z herbelin $ *)
+(*i camlp4use: "pa_extend.cmo q_MLast.cmo" i*)
+
+(* $Id: argextend.ml4 10122 2007-09-15 10:35:59Z letouzey $ *)
 
 open Genarg
 open Q_util
diff --git a/parsing/egrammar.ml b/parsing/egrammar.ml
index 07a0a65f..9416bff2 100644
--- a/parsing/egrammar.ml
+++ b/parsing/egrammar.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: egrammar.ml 9333 2006-11-02 13:59:14Z barras $ *)
+(* $Id: egrammar.ml 10987 2008-05-26 12:28:36Z herbelin $ *)
 
 open Pp
 open Util
@@ -73,7 +73,7 @@ let make_constr_action
 	  make ((p,CPrim (dummy_loc,Numeral v)) :: env) tl)
     | Some (p, ETConstrList _) :: tl ->
         Gramext.action (fun (v:constr_expr list) ->
-          let dummyid = Ident (dummy_loc,id_of_string "") in
+          let dummyid = Ident (dummy_loc,id_of_string "_") in
 	  make ((p,CAppExpl (dummy_loc,(None,dummyid),v)) :: env) tl)
     | Some (p, ETPattern) :: tl -> 
 	failwith "Unexpected entry of type cases pattern" in
@@ -99,7 +99,7 @@ let make_cases_pattern_action
 	  make ((p,CPatPrim (dummy_loc,Numeral v)) :: env) tl)
     | Some (p, ETConstrList _) :: tl ->
         Gramext.action (fun (v:cases_pattern_expr list) ->
-          let dummyid = Ident (dummy_loc,id_of_string "") in
+          let dummyid = Ident (dummy_loc,id_of_string "_") in
 	  make ((p,CPatCstr (dummy_loc,dummyid,v)) :: env) tl)
     | Some (p, (ETPattern | ETOther _)) :: tl -> 
 	failwith "Unexpected entry of type cases pattern or other" in
@@ -111,24 +111,29 @@ let make_constr_prod_item univ assoc from forpat = function
       let eobj = symbol_of_production assoc from forpat nt in
       (eobj, ovar)
 
-let extend_constr entry (n,assoc,pos,p4assoc,name) mkact (forpat,pt) =
+let prepare_empty_levels entry (pos,p4assoc,name,reinit) =
+  grammar_extend entry pos reinit [(name, p4assoc, [])]
+
+let extend_constr entry (n,assoc,pos,p4assoc,name,reinit) mkact (forpat,pt) =
   let univ = get_univ "constr" in
   let pil = List.map (make_constr_prod_item univ assoc n forpat) pt in
   let (symbs,ntl) = List.split pil in
-  grammar_extend entry pos [(name, p4assoc, [symbs, mkact ntl])]
+  let needed_levels = register_empty_levels forpat symbs in
+  List.iter (prepare_empty_levels entry) needed_levels;
+  grammar_extend entry pos reinit [(name, p4assoc, [symbs, mkact ntl])]
 
 let extend_constr_notation (n,assoc,ntn,rule) =
   (* Add the notation in constr *)
   let mkact loc env = CNotation (loc,ntn,List.map snd env) in
-  let (e,level,keepassoc) = get_constr_entry false (ETConstr (n,())) in
-  let pos,p4assoc,name = find_position false keepassoc assoc level in
-  extend_constr e (ETConstr(n,()),assoc,pos,p4assoc,name)
+  let (e,level) = get_constr_entry false (ETConstr (n,())) in
+  let pos,p4assoc,name,reinit = find_position false assoc level in
+  extend_constr e (ETConstr(n,()),assoc,pos,p4assoc,name,reinit)
     (make_constr_action mkact) (false,rule);
   (* Add the notation in cases_pattern *)
   let mkact loc env = CPatNotation (loc,ntn,List.map snd env) in
-  let (e,level,keepassoc) = get_constr_entry true (ETConstr (n,())) in
-  let pos,p4assoc,name = find_position true keepassoc assoc level in
-  extend_constr e (ETConstr (n,()),assoc,pos,p4assoc,name)
+  let (e,level) = get_constr_entry true (ETConstr (n,())) in
+  let pos,p4assoc,name,reinit = find_position true assoc level in
+  extend_constr e (ETConstr (n,()),assoc,pos,p4assoc,name,reinit)
     (make_cases_pattern_action mkact) (true,rule)
 
 (**********************************************************************)
@@ -160,7 +165,7 @@ type grammar_tactic_production =
 
 let make_prod_item = function
   | TacTerm s -> (Gramext.Stoken (Lexer.terminal s), None)
-  | TacNonTerm (_,(nont,t), po) -> (nont, option_map (fun p -> (p,t)) po)
+  | TacNonTerm (_,(nont,t), po) -> (nont, Option.map (fun p -> (p,t)) po)
 
 (* Tactic grammar extensions *)
 
@@ -194,7 +199,7 @@ let extend_vernac_command_grammar s gl =
 let find_index s t =
   let t,n = repr_ident (id_of_string t) in
   if s <> t or n = None then raise Not_found;
-  out_some n
+  Option.get n
 
 let rec interp_entry_name up_level s =
   let l = String.length s in
@@ -233,7 +238,7 @@ let make_vprod_item n = function
   | VTerm s -> (Gramext.Stoken (Lexer.terminal s), None)
   | VNonTerm (loc, nt, po) ->
       let (etyp, e) = interp_entry_name n nt in
-      e, option_map (fun p -> (p,etyp)) po
+      e, Option.map (fun p -> (p,etyp)) po
 
 let get_tactic_entry n =
   if n = 0 then
@@ -265,8 +270,8 @@ let add_tactic_entry (key,lev,prods,tac) =
       let mkact s tac loc l = 
 	(TacAtom(loc,TacAlias(loc,s,l,tac)):raw_tactic_expr) in
       make_rule univ (mkact key tac) mkprod prods in
-  let _ = find_position true true None None (* to synchronise with remove *) in
-  grammar_extend entry pos [(None, None, List.rev [rules])]
+  synchronize_level_positions ();
+  grammar_extend entry pos None [(None, None, List.rev [rules])]
 
 (**********************************************************************)
 (** State of the grammar extensions                                   *)
diff --git a/parsing/egrammar.mli b/parsing/egrammar.mli
index 4216899b..d2d912d1 100644
--- a/parsing/egrammar.mli
+++ b/parsing/egrammar.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: egrammar.mli 10185 2007-10-06 18:05:13Z herbelin $ i*)
+(*i $Id: egrammar.mli 10122 2007-09-15 10:35:59Z letouzey $ i*)
 
 (*i*)
 open Util
diff --git a/parsing/g_ascii_syntax.ml b/parsing/g_ascii_syntax.ml
index ac54fc63..b262b978 100644
--- a/parsing/g_ascii_syntax.ml
+++ b/parsing/g_ascii_syntax.ml
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
+(*i $Id: g_ascii_syntax.ml 10744 2008-04-03 14:09:56Z herbelin $ i*)
+
 open Pp
 open Util
 open Names
@@ -72,7 +74,7 @@ let make_ascii_string n =
   if n>=32 && n<=126 then String.make 1 (char_of_int n)
   else Printf.sprintf "%03d" n
 
-let uninterp_ascii_string r = option_map make_ascii_string (uninterp_ascii r)
+let uninterp_ascii_string r = Option.map make_ascii_string (uninterp_ascii r)
 
 let _ =
   Notation.declare_string_interpreter "char_scope"
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index 1cde66e2..ba61eb61 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_constr.ml4 9976 2007-07-12 11:58:30Z msozeau $ *)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(* $Id: g_constr.ml4 11024 2008-05-30 12:41:39Z msozeau $ *)
 
 open Pcoq
 open Constr
@@ -21,7 +23,7 @@ open Util
 
 let constr_kw =
   [ "forall"; "fun"; "match"; "fix"; "cofix"; "with"; "in"; "for"; 
-    "end"; "as"; "let"; "dest"; "if"; "then"; "else"; "return";
+    "end"; "as"; "let"; "if"; "then"; "else"; "return";
     "Prop"; "Set"; "Type"; ".("; "_"; ".." ]
 
 let _ = List.iter (fun s -> Lexer.add_token("",s)) constr_kw
@@ -35,54 +37,35 @@ let mk_lam = function
   | (bl,c) -> CLambdaN(constr_loc c, bl,c)
 
 let loc_of_binder_let = function
-  | LocalRawAssum ((loc,_)::_,_)::_ -> loc
+  | LocalRawAssum ((loc,_)::_,_,_)::_ -> loc
   | LocalRawDef ((loc,_),_)::_ -> loc
   | _ -> dummy_loc
 
-let rec mkCProdN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,t) :: bll -> 
-      CProdN (loc,[idl,t],mkCProdN (join_loc loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll -> 
-      CLetIn (loc,id,b,mkCProdN (join_loc loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_) :: bll -> mkCProdN loc bll c
-
-let rec mkCLambdaN loc bll c =
-  match bll with
-  | LocalRawAssum ((loc1,_)::_ as idl,t) :: bll -> 
-      CLambdaN (loc,[idl,t],mkCLambdaN (join_loc loc1 loc) bll c)
-  | LocalRawDef ((loc1,_) as id,b) :: bll -> 
-      CLetIn (loc,id,b,mkCLambdaN (join_loc loc1 loc) bll c)
-  | [] -> c
-  | LocalRawAssum ([],_) :: bll -> mkCLambdaN loc bll c
-
 let rec index_and_rec_order_of_annot loc bl ann =
   match names_of_local_assums bl,ann with
-    | [_], (None, r) -> Some 0, r
-    | lids, (Some x, ro) ->
-        let ids = List.map snd lids in
-        (try Some (list_index (snd x) ids - 1), ro
-        with Not_found ->
-          user_err_loc(fst x,"index_of_annot", Pp.str"no such fix variable"))
+    | [loc,Name id], (None, r) -> Some (loc, id), r
+    | lids, (Some (loc, n), ro) ->
+        if List.exists (fun (_, x) -> x = Name n) lids then
+	  Some (loc, n), ro
+        else user_err_loc(loc,"index_of_annot", Pp.str"no such fix variable")
     | _, (None, r) -> None, r
 
 let mk_fixb (id,bl,ann,body,(loc,tyc)) =
   let n,ro = index_and_rec_order_of_annot (fst id) bl ann in
   let ty = match tyc with
       Some ty -> ty
-    | None -> CHole loc in
-  (snd id,(n,ro),bl,ty,body)
+    | None -> CHole (loc, None) in
+  (id,(n,ro),bl,ty,body)
 
 let mk_cofixb (id,bl,ann,body,(loc,tyc)) =
-  let _ = option_map (fun (aloc,_) ->
+  let _ = Option.map (fun (aloc,_) ->
     Util.user_err_loc
       (aloc,"Constr:mk_cofixb",
        Pp.str"Annotation forbidden in cofix expression")) (fst ann) in
   let ty = match tyc with
       Some ty -> ty
-    | None -> CHole loc in
-  (snd id,bl,ty,body)
+    | None -> CHole (loc, None) in
+  (id,bl,ty,body)
 
 let mk_fix(loc,kw,id,dcls) =
   if kw then 
@@ -115,10 +98,39 @@ let lpar_id_coloneq =
               | _ -> raise Stream.Failure)
         | _ -> raise Stream.Failure)
 
+let impl_ident =
+  Gram.Entry.of_parser "impl_ident"
+    (fun strm ->
+      match Stream.npeek 1 strm with
+	| [(_,"{")] -> 
+	    (match Stream.npeek 2 strm with
+	      | [_;("IDENT",("wf"|"struct"|"measure"))] ->
+		  raise Stream.Failure
+	      | [_;("IDENT",s)] -> 
+		  Stream.junk strm; Stream.junk strm;
+		  Names.id_of_string s
+	      | _ -> raise Stream.Failure)
+	| _ -> raise Stream.Failure)
+    
+let ident_colon =
+  Gram.Entry.of_parser "ident_colon"
+    (fun strm ->
+      match Stream.npeek 1 strm with
+	| [("IDENT",s)] ->
+            (match Stream.npeek 2 strm with
+              | [_; ("", ":")] ->
+                  Stream.junk strm; Stream.junk strm;
+                  Names.id_of_string s
+              | _ -> raise Stream.Failure)
+        | _ -> raise Stream.Failure)
+
+let aliasvar = function CPatAlias (_, _, id) -> Some (Name id) | _ -> None
 
 GEXTEND Gram
   GLOBAL: binder_constr lconstr constr operconstr sort global
-  constr_pattern lconstr_pattern Constr.ident binder binder_let pattern;
+  constr_pattern lconstr_pattern Constr.ident
+  binder binder_let binders_let
+  binders_let_fixannot typeclass_constraint pattern appl_arg;
   Constr.ident:
     [ [ id = Prim.ident -> id
 
@@ -129,10 +141,7 @@ GEXTEND Gram
     [ [ "_" -> (loc, Anonymous) ] ]
   ;
   global:
-    [ [ r = Prim.reference -> r
-
-      (* This is used in quotations *)
-      | id = METAIDENT -> Ident (loc,id_of_string id) ] ]
+    [ [ r = Prim.reference -> r ] ]
   ;
   constr_pattern:
     [ [ c = constr -> c ] ]
@@ -149,7 +158,8 @@ GEXTEND Gram
     [ [ c = operconstr LEVEL "200" -> c ] ]
   ;
   constr:
-    [ [ c = operconstr LEVEL "9" -> c ] ]
+    [ [ c = operconstr LEVEL "8" -> c 
+      | "@"; f=global -> CAppExpl(loc,(None,f),[]) ] ]
   ;
   operconstr:
     [ "200" RIGHTA
@@ -171,10 +181,14 @@ GEXTEND Gram
       | c1 = operconstr; "->"; c2 = SELF -> CArrow(loc,c1,c2)]
     | "10" LEFTA
       [ f=operconstr; args=LIST1 appl_arg -> CApp(loc,(None,f),args)
-      | "@"; f=global; args=LIST0 NEXT -> CAppExpl(loc,(None,f),args) ]
+      | "@"; f=global; args=LIST0 NEXT -> CAppExpl(loc,(None,f),args)
+      | "@"; (locid,id) = pattern_identref; args=LIST1 identref ->
+          let args = List.map (fun x -> CRef (Ident x), None) args in
+          CApp(loc,(None,CPatVar(locid,(true,id))),args) ]
     | "9"
         [ ".."; c = operconstr LEVEL "0"; ".." ->
           CAppExpl (loc,(None,Ident (loc,Topconstr.ldots_var)),[c]) ]
+    | "8" [ ]
     | "1" LEFTA
       [ c=operconstr; ".("; f=global; args=LIST0 appl_arg; ")" ->
 	CApp(loc,(Some (List.length args+1),CRef f),args@[c,None])
@@ -191,12 +205,22 @@ GEXTEND Gram
                 CNotation(loc,"( _ )",[c])
             | _ -> c) ] ]
   ;
+  forall: 
+    [ [ "forall" -> () 
+    | IDENT "Π" -> ()
+    ] ]
+  ;
+  lambda: 
+    [ [ "fun" -> () 
+    | IDENT "λ" -> ()
+    ] ]
+  ;
   binder_constr:
-    [ [ "forall"; bl = binder_list; ","; c = operconstr LEVEL "200" ->
+    [ [ forall; bl = binder_list; ","; c = operconstr LEVEL "200" ->
           mkCProdN loc bl c
-      | "fun"; bl = binder_list; "=>"; c = operconstr LEVEL "200" ->
+      | lambda; bl = binder_list; [ "=>" | "," ]; c = operconstr LEVEL "200" ->
           mkCLambdaN loc bl c
-      | "let"; id=name; bl = LIST0 binder_let; ty = type_cstr; ":=";
+      | "let"; id=name; bl = binders_let; ty = type_cstr; ":=";
         c1 = operconstr LEVEL "200"; "in"; c2 = operconstr LEVEL "200" ->
           let loc1 = loc_of_binder_let bl in
           CLetIn(loc,id,mkCLambdaN loc1 bl (mk_cast(c1,ty)),c2)
@@ -212,10 +236,16 @@ GEXTEND Gram
 	  ":="; c1 = operconstr LEVEL "200"; "in";
           c2 = operconstr LEVEL "200" ->
           CLetTuple (loc,List.map snd lb,po,c1,c2)
-      | "dest"; c1 = operconstr LEVEL "200"; "as"; p=pattern;
+      | "let"; "'"; p=pattern; ":="; c1 = operconstr LEVEL "200";
           "in"; c2 = operconstr LEVEL "200" ->
-         CCases (loc, None, [(c1, (None, None))],
-                 [loc, [[p]], c2])
+	    CCases (loc, LetPatternStyle, None, [(c1,(None,None))], [(loc, [(loc,[p])], c2)])
+      | "let"; "'"; p=pattern; ":="; c1 = operconstr LEVEL "200"; 
+	  rt = case_type; "in"; c2 = operconstr LEVEL "200" ->
+	    CCases (loc, LetPatternStyle, Some rt, [(c1, (aliasvar p, None))], [(loc, [(loc, [p])], c2)])
+      | "let"; "'"; p=pattern; "in"; t = operconstr LEVEL "200"; 
+	  ":="; c1 = operconstr LEVEL "200"; rt = case_type;
+          "in"; c2 = operconstr LEVEL "200" ->
+	    CCases (loc, LetPatternStyle, Some rt, [(c1, (aliasvar p, Some t))], [(loc, [(loc, [p])], c2)])
       | "if"; c=operconstr LEVEL "200"; po = return_type;
 	"then"; b1=operconstr LEVEL "200";
         "else"; b2=operconstr LEVEL "200" ->
@@ -225,15 +255,15 @@ GEXTEND Gram
   appl_arg:
     [ [ id = lpar_id_coloneq; c=lconstr; ")" ->
 	  (c,Some (loc,ExplByName id))
-      | c=constr -> (c,None) ] ]
+      | c=operconstr LEVEL "9" -> (c,None) ] ]
   ;
   atomic_constr:
     [ [ g=global -> CRef g
       | s=sort -> CSort (loc,s)
       | n=INT -> CPrim (loc, Numeral (Bigint.of_string n))
       | s=string -> CPrim (loc, String s)
-      | "_" -> CHole loc
-      | "?"; id=ident -> CPatVar(loc,(false,id)) ] ]
+      | "_" -> CHole (loc, None)
+      | id=pattern_ident -> CPatVar(loc,(false,id)) ] ]
   ;
   fix_constr:
     [ [ fx1=single_fix -> mk_single_fix fx1
@@ -250,19 +280,12 @@ GEXTEND Gram
       | "cofix" -> false ] ]
   ;
   fix_decl:
-    [ [ id=identref; bl=LIST0 binder_let; ann=fixannot; ty=type_cstr; ":=";
-        c=operconstr LEVEL "200" -> (id,bl,ann,c,ty) ] ]
-  ;
-  fixannot:
-    [ [ "{"; IDENT "struct"; id=name; "}" -> (Some id, CStructRec)
-      | "{"; IDENT "wf"; rel=constr; id=name; "}" -> (Some id, CWfRec rel)
-      | "{"; IDENT "measure"; rel=constr; id=name; "}" -> (Some id, CMeasureRec rel)
-      | ->  (None, CStructRec)
-      ] ]
+    [ [ id=identref; bl=binders_let_fixannot; ty=type_cstr; ":=";
+        c=operconstr LEVEL "200" -> (id,fst bl,snd bl,c,ty) ] ]
   ;
   match_constr:
     [ [ "match"; ci=LIST1 case_item SEP ","; ty=OPT case_type; "with";
-        br=branches; "end" -> CCases(loc,ty,ci,br) ] ]
+        br=branches; "end" -> CCases(loc,RegularStyle,ty,ci,br) ] ]
   ;
   case_item:
     [ [ c=operconstr LEVEL "100"; p=pred_pattern -> (c,p) ] ]
@@ -285,8 +308,11 @@ GEXTEND Gram
   branches:
     [ [ OPT"|"; br=LIST0 eqn SEP "|" -> br ] ]
   ;
+  mult_pattern:
+    [ [ pl = LIST1 pattern LEVEL "99" SEP "," -> (loc,pl) ] ]
+  ;
   eqn:
-    [ [ pll = LIST0 LIST1 pattern LEVEL "99" SEP "," SEP "|"; 
+    [ [ pll = LIST1 mult_pattern SEP "|";
         "=>"; rhs = lconstr -> (loc,pll,rhs) ] ]
   ;
   pattern:
@@ -317,30 +343,86 @@ GEXTEND Gram
       | s = string -> CPatPrim (loc, String s) ] ]
   ;
   binder_list:
-    [ [ idl=LIST1 name; bl=LIST0 binder_let -> 
-          LocalRawAssum (idl,CHole loc)::bl
-      | idl=LIST1 name; ":"; c=lconstr -> 
-          [LocalRawAssum (idl,c)]
-      | "("; idl=LIST1 name; ":"; c=lconstr; ")"; bl=LIST0 binder_let ->
-          LocalRawAssum (idl,c)::bl ] ]
+    [ [ idl=LIST1 name; bl=binders_let -> 
+      LocalRawAssum (idl,Default Explicit,CHole (loc, Some (Evd.BinderType (snd (List.hd idl)))))::bl
+    | idl=LIST1 name; ":"; c=lconstr -> 
+        [LocalRawAssum (idl,Default Explicit,c)]
+    | cl = binders_let -> cl
+    ] ]
+  ;
+  binder_assum:
+    [ [ "}" -> fun id -> LocalRawAssum([id], Default Implicit, CHole(loc, None))
+    | idl=LIST1 name; ":"; c=lconstr; "}" ->
+        (fun id -> LocalRawAssum (id::idl,Default Implicit,c))
+    | idl=LIST1 name; "}" ->
+        (fun id -> LocalRawAssum (id::idl,Default Implicit,CHole (loc, None)))
+    | ":"; c=lconstr; "}" ->
+	(fun id -> LocalRawAssum ([id],Default Implicit,c))
+    ] ]
+  ;
+  fixannot:
+    [ [ "{"; IDENT "struct"; id=identref; "}" -> (Some id, CStructRec)
+    | "{"; IDENT "wf"; rel=constr; id=OPT identref; "}" -> (id, CWfRec rel)
+    | "{"; IDENT "measure"; rel=constr; id=OPT identref; "}" -> (id, CMeasureRec rel)
+    ] ]
+  ;
+  binders_let_fixannot:
+    [ [ id=impl_ident; assum=binder_assum; bl = binders_let_fixannot -> 
+	(assum (loc, Name id) :: fst bl), snd bl
+    | f = fixannot -> [], f
+    | b = binder_let; bl = binders_let_fixannot -> 
+	b @ fst bl, snd bl
+    | -> [], (None, CStructRec)
+    ] ]
+  ;
+  binders_let:
+    [ [ b = binder_let; bl = binders_let -> b @ bl
+    | -> [] ] ]
   ;
   binder_let:
     [ [ id=name ->
-          LocalRawAssum ([id],CHole loc)
-      | "("; id=name; idl=LIST1 name; ":"; c=lconstr; ")" -> 
-          LocalRawAssum (id::idl,c)
-      | "("; id=name; ":"; c=lconstr; ")" -> 
-          LocalRawAssum ([id],c)
-      | "("; id=name; ":="; c=lconstr; ")" ->
-          LocalRawDef (id,c)
-      | "("; id=name; ":"; t=lconstr; ":="; c=lconstr; ")" -> 
-          LocalRawDef (id,CCast (join_loc (constr_loc t) loc,c, CastConv (DEFAULTcast,t)))
+      [LocalRawAssum ([id],Default Explicit,CHole (loc, None))]
+    | "("; id=name; idl=LIST1 name; ":"; c=lconstr; ")" -> 
+        [LocalRawAssum (id::idl,Default Explicit,c)]
+    | "("; id=name; ":"; c=lconstr; ")" -> 
+        [LocalRawAssum ([id],Default Explicit,c)]
+    | "("; id=name; ":="; c=lconstr; ")" ->
+        [LocalRawDef (id,c)]
+    | "("; id=name; ":"; t=lconstr; ":="; c=lconstr; ")" -> 
+        [LocalRawDef (id,CCast (join_loc (constr_loc t) loc,c, CastConv (DEFAULTcast,t)))]
+    | "{"; id=name; "}" ->
+        [LocalRawAssum ([id],Default Implicit,CHole (loc, None))]
+    | "{"; id=name; idl=LIST1 name; ":"; c=lconstr; "}" -> 
+        [LocalRawAssum (id::idl,Default Implicit,c)]
+    | "{"; id=name; ":"; c=lconstr; "}" -> 
+        [LocalRawAssum ([id],Default Implicit,c)]
+    | "{"; id=name; idl=LIST1 name; "}" -> 
+        List.map (fun id -> LocalRawAssum ([id],Default Implicit,CHole (loc, None))) (id::idl)
+    | "["; tc = LIST1 typeclass_constraint_binder SEP ","; "]" -> tc
     ] ]
   ;
   binder:
-    [ [ id=name -> ([id],CHole loc)
-      | "("; idl=LIST1 name; ":"; c=lconstr; ")" -> (idl,c) ] ]
+    [ [ id=name -> ([id],Default Explicit,CHole (loc, None))
+      | "("; idl=LIST1 name; ":"; c=lconstr; ")" -> (idl,Default Explicit,c) 
+      | "{"; idl=LIST1 name; ":"; c=lconstr; "}" -> (idl,Default Implicit,c) 
+    ] ]
+  ;
+  typeclass_constraint_binder:
+    [ [ tc = typeclass_constraint ->
+      let (n,bk,t) = tc in
+	LocalRawAssum ([n], TypeClass bk, t)
+    ] ]
+  ;
+
+  typeclass_constraint:
+    [ [ "!" ; c = operconstr LEVEL "200" -> (loc, Anonymous), Explicit, c
+    | iid=ident_colon ; expl = [ "!" -> Explicit | -> Implicit ] ; c = operconstr LEVEL "200" ->
+	(loc, Name iid), expl, c
+    | c = operconstr LEVEL "200" ->
+	(loc, Anonymous), Implicit, c
+    ] ]
   ;
+  
   type_cstr:
     [ [ c=OPT [":"; c=lconstr -> c] -> (loc,c) ] ]
   ;
diff --git a/parsing/g_decl_mode.ml4 b/parsing/g_decl_mode.ml4
index 5c7b40af..61c3474d 100644
--- a/parsing/g_decl_mode.ml4
+++ b/parsing/g_decl_mode.ml4
@@ -6,8 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id$ *)
 (*i camlp4deps: "parsing/grammar.cma" i*)
+(*i camlp4use: "pa_extend.cmo q_MLast.cmo" i*)
+
+(* $Id: g_decl_mode.ml4 10739 2008-04-01 14:45:20Z herbelin $ *)
+
 
 open Decl_expr
 open Names
@@ -28,7 +31,6 @@ GLOBAL: proof_instr;
   thesis :
     [[ "thesis" -> Plain 
      | "thesis"; "for"; i=ident -> (For i)
-     | "thesis"; "["; n=INT ;"]" -> (Sub (int_of_string n))
      ]];
   statement :
     [[ i=ident ; ":" ; c=constr -> {st_label=Name i;st_it=c}
diff --git a/parsing/g_intsyntax.ml b/parsing/g_intsyntax.ml
new file mode 100644
index 00000000..6ab8f99c
--- /dev/null
+++ b/parsing/g_intsyntax.ml
@@ -0,0 +1,342 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(*i $Id: g_intsyntax.ml 11087 2008-06-10 13:29:52Z letouzey $ i*)
+
+(* digit-based syntax for int31, bigN bigZ and bigQ *)
+
+open Bigint
+open Libnames
+open Rawterm
+
+(*** Constants for locating the int31 and bigN ***)
+
+
+
+let make_dir l = Names.make_dirpath (List.map Names.id_of_string (List.rev l))
+let make_path dir id = Libnames.make_path (make_dir dir) (Names.id_of_string id)
+
+(* copied on g_zsyntax.ml, where it is said to be a temporary hack*)
+(* takes a path an identifier in the form of a string list and a string, 
+   returns a kernel_name *)
+let make_kn dir id = Libnames.encode_kn (make_dir dir) (Names.id_of_string id)
+
+
+(* int31 stuff *)
+let int31_module = ["Coq"; "Numbers"; "Cyclic"; "Int31"; "Int31"]
+let int31_path = make_path int31_module "int31"
+let int31_id = make_kn int31_module
+let int31_scope = "int31_scope"
+
+let int31_construct = ConstructRef ((int31_id "int31",0),1)
+
+let int31_0 = ConstructRef ((int31_id "digits",0),1)
+let int31_1 = ConstructRef ((int31_id "digits",0),2)
+
+
+(* bigN stuff*)
+let zn2z_module = ["Coq"; "Numbers"; "Cyclic"; "DoubleCyclic"; "DoubleType"]
+let zn2z_path = make_path zn2z_module "zn2z"
+let zn2z_id = make_kn zn2z_module
+
+let zn2z_W0 = ConstructRef ((zn2z_id "zn2z",0),1)
+let zn2z_WW = ConstructRef ((zn2z_id "zn2z",0),2)
+
+let bigN_module = ["Coq"; "Numbers"; "Natural"; "BigN"; "BigN" ]
+let bigN_path = make_path (bigN_module@["BigN"]) "t"
+(* big ugly hack *)
+let bigN_id id = (Obj.magic ((Names.MPdot ((Names.MPfile (make_dir bigN_module)), 
+                             Names.mk_label "BigN")),
+              [], Names.id_of_string id) : Names.kernel_name)
+let bigN_scope = "bigN_scope"
+
+(* number of inlined level of bigN (actually the level 0 to n_inlined-1 are inlined) *)
+let n_inlined = of_string "7"
+let bigN_constructor =
+ (* converts a bigint into an int the ugly way *)
+  let rec to_int i =
+    if equal i zero then
+      0
+    else
+      let (quo,rem) = div2_with_rest i in
+      if rem then
+	2*(to_int quo)+1
+      else
+	2*(to_int quo)
+  in
+  fun i -> 
+  ConstructRef ((bigN_id "t_",0),
+		if less_than i n_inlined then
+		  (to_int i)+1
+		else
+		  (to_int n_inlined)+1
+	       )
+
+(*bigZ stuff*)
+let bigZ_module = ["Coq"; "Numbers"; "Integer"; "BigZ"; "BigZ" ]
+let bigZ_path = make_path (bigZ_module@["BigZ"]) "t"
+(* big ugly hack bis *)
+let bigZ_id id = (Obj.magic ((Names.MPdot ((Names.MPfile (make_dir bigZ_module)), 
+                             Names.mk_label "BigZ")),
+              [], Names.id_of_string id) : Names.kernel_name)
+let bigZ_scope = "bigZ_scope"
+
+let bigZ_pos = ConstructRef ((bigZ_id "t_",0),1)
+let bigZ_neg = ConstructRef ((bigZ_id "t_",0),2)
+
+
+(*bigQ stuff*)
+let bigQ_module = ["Coq"; "Numbers"; "Rational"; "BigQ"; "BigQ"]
+let qmake_module = ["Coq"; "Numbers"; "Rational"; "BigQ"; "QMake_base"]
+let bigQ_path = make_path (bigQ_module@["BigQ"]) "t"
+(* big ugly hack bis *)
+let bigQ_id = make_kn qmake_module
+let bigQ_scope = "bigQ_scope"
+
+let bigQ_z =  ConstructRef ((bigQ_id "q_type",0),1)
+
+
+(*** Definition of the Non_closed exception, used in the pretty printing ***)
+exception Non_closed
+
+(*** Parsing for int31 in digital notation ***)
+
+(* parses a *non-negative* integer (from bigint.ml) into an int31
+   wraps modulo 2^31 *)
+let int31_of_pos_bigint dloc n = 
+  let ref_construct = RRef (dloc, int31_construct) in
+  let ref_0 = RRef (dloc, int31_0) in
+  let ref_1 = RRef (dloc, int31_1) in
+  let rec args counter n =
+    if counter <= 0 then
+      []
+    else
+      let (q,r) = div2_with_rest n in
+	(if r then ref_1 else ref_0)::(args (counter-1) q)
+  in
+  RApp (dloc, ref_construct, List.rev (args 31 n))
+
+let error_negative dloc =
+  Util.user_err_loc (dloc, "interp_int31", Pp.str "int31 are only non-negative numbers")
+
+let interp_int31 dloc n = 
+  if is_pos_or_zero n then
+    int31_of_pos_bigint dloc n
+  else
+    error_negative dloc
+
+(* Pretty prints an int31 *)
+
+let bigint_of_int31 = 
+  let rec args_parsing args cur = 
+    match args with 
+      | [] -> cur
+      | (RRef (_,b))::l when b = int31_0 -> args_parsing l (mult_2 cur)
+      | (RRef (_,b))::l when b = int31_1 -> args_parsing l (add_1 (mult_2 cur))
+      | _ -> raise Non_closed
+  in
+  function 
+  | RApp (_, RRef (_, c), args) when c=int31_construct -> args_parsing args zero
+  | _ -> raise Non_closed
+
+let uninterp_int31 i = 
+  try 
+    Some (bigint_of_int31 i)
+  with Non_closed ->
+    None
+
+(* Actually declares the interpreter for int31 *)
+let _ = Notation.declare_numeral_interpreter int31_scope
+  (int31_path, int31_module)
+  interp_int31
+  ([RRef (Util.dummy_loc, int31_construct)],
+   uninterp_int31,
+   true)
+
+
+(*** Parsing for bigN in digital notation ***)
+(* the base for bigN (in Coq) that is 2^31 in our case *)
+let base = pow two (of_string "31")
+
+(* base of the bigN of height N : *)
+let rank n = pow base (pow two n)
+
+(* splits a number bi at height n, that is the rest needs 2^n int31 to be stored
+   it is expected to be used only when the quotient would also need 2^n int31 to be
+   stored *)
+let split_at n bi = 
+  euclid bi (rank (sub_1 n))
+
+(* search the height of the Coq bigint needed to represent the integer bi *)
+let height bi =
+  let rec height_aux n = 
+    if less_than bi (rank n) then
+      n
+    else
+      height_aux (add_1 n)
+  in
+  height_aux zero
+
+
+(* n must be a non-negative integer (from bigint.ml) *)
+let word_of_pos_bigint dloc hght n =
+  let ref_W0 = RRef (dloc, zn2z_W0) in
+  let ref_WW = RRef (dloc, zn2z_WW) in
+  let rec decomp hgt n =
+    if is_neg_or_zero hgt then
+      int31_of_pos_bigint dloc n
+    else if equal n zero then
+      RApp (dloc, ref_W0, [RHole (dloc, Evd.InternalHole)])
+    else
+      let (h,l) = split_at hgt n in
+      RApp (dloc, ref_WW, [RHole (dloc, Evd.InternalHole);
+			   decomp (sub_1 hgt) h;
+			   decomp (sub_1 hgt) l])
+  in
+  decomp hght n
+      
+let bigN_of_pos_bigint dloc n =
+  let ref_constructor i = RRef (dloc, bigN_constructor i) in
+  let result h word = RApp (dloc, ref_constructor h, if less_than h n_inlined then
+				                       [word]
+			                             else
+				                      [G_natsyntax.nat_of_int dloc (sub h n_inlined);
+						       word])
+  in
+  let hght = height n in
+  result hght (word_of_pos_bigint dloc hght n)
+  
+let bigN_error_negative dloc =
+  Util.user_err_loc (dloc, "interp_bigN", Pp.str "bigN are only non-negative numbers")
+
+let interp_bigN dloc n = 
+  if is_pos_or_zero n then
+    bigN_of_pos_bigint dloc n
+  else
+    bigN_error_negative dloc
+
+
+(* Pretty prints a bigN *)
+
+let bigint_of_word = 
+  let rec get_height rc =
+    match rc with
+    | RApp (_,RRef(_,c), [_;lft;rght]) when c = zn2z_WW -> 
+	                                  let hleft = get_height lft in
+					  let hright = get_height rght in
+					  add_1 
+					    (if less_than hleft hright then
+						 hright
+					     else
+						 hleft)
+    | _ -> zero
+  in
+  let rec transform hght rc =
+    match rc with
+    | RApp (_,RRef(_,c),_) when c = zn2z_W0-> zero
+    | RApp (_,RRef(_,c), [_;lft;rght]) when c=zn2z_WW-> let new_hght = sub_1 hght in
+	                                                add (mult (rank new_hght)
+                                                          (transform (new_hght) lft))
+	                                            (transform (new_hght) rght)
+    | _ -> bigint_of_int31 rc
+  in
+  fun rc ->
+    let hght = get_height rc in
+    transform hght rc
+    
+let bigint_of_bigN rc =
+  match rc with
+  | RApp (_,_,[one_arg]) -> bigint_of_word one_arg
+  | RApp (_,_,[_;second_arg]) -> bigint_of_word second_arg
+  | _ -> raise Non_closed
+
+let uninterp_bigN rc = 
+  try 
+    Some (bigint_of_bigN rc)
+  with Non_closed ->
+    None
+
+
+(* declare the list of constructors of bigN used in the declaration of the
+   numeral interpreter *)
+
+let bigN_list_of_constructors =
+  let rec build i = 
+    if less_than i (add_1 n_inlined) then
+      RRef (Util.dummy_loc, bigN_constructor i)::(build (add_1 i))
+    else
+      []
+  in
+  build zero
+
+(* Actually declares the interpreter for bigN *)
+let _ = Notation.declare_numeral_interpreter bigN_scope
+  (bigN_path, bigN_module)
+  interp_bigN
+  (bigN_list_of_constructors,
+   uninterp_bigN,
+   true)
+
+
+(*** Parsing for bigZ in digital notation ***)
+let interp_bigZ dloc n = 
+  let ref_pos = RRef (dloc, bigZ_pos) in
+  let ref_neg = RRef (dloc, bigZ_neg) in
+  if is_pos_or_zero n then
+    RApp (dloc, ref_pos, [bigN_of_pos_bigint dloc n])
+  else
+    RApp (dloc, ref_neg, [bigN_of_pos_bigint dloc (neg n)])
+
+(* pretty printing functions for bigZ *)
+let bigint_of_bigZ = function
+  | RApp (_, RRef(_,c), [one_arg]) when c = bigZ_pos -> bigint_of_bigN one_arg
+  | RApp (_, RRef(_,c), [one_arg]) when c = bigZ_neg -> 
+      let opp_val = bigint_of_bigN one_arg in 
+      if equal opp_val zero then
+	raise Non_closed
+      else
+	neg opp_val
+  | _ -> raise Non_closed
+
+
+let uninterp_bigZ rc = 
+  try 
+    Some (bigint_of_bigZ rc)
+  with Non_closed ->
+    None
+
+(* Actually declares the interpreter for bigN *)
+let _ = Notation.declare_numeral_interpreter bigZ_scope
+  (bigZ_path, bigZ_module)
+  interp_bigZ
+  ([RRef (Util.dummy_loc, bigZ_pos);
+    RRef (Util.dummy_loc, bigZ_neg)],
+   uninterp_bigZ,
+   true)
+
+(*** Parsing for bigQ in digital notation ***)
+let interp_bigQ dloc n = 
+  let ref_z = RRef (dloc, bigQ_z) in
+  let ref_pos = RRef (dloc, bigZ_pos) in
+  let ref_neg = RRef (dloc, bigZ_neg) in
+  if is_pos_or_zero n then
+    RApp (dloc, ref_z,
+       [RApp (dloc, ref_pos, [bigN_of_pos_bigint dloc n])])
+  else
+    RApp (dloc, ref_z,
+       [RApp (dloc, ref_neg, [bigN_of_pos_bigint dloc (neg n)])])
+
+let uninterp_bigQ rc = None
+
+
+(* Actually declares the interpreter for bigQ *)
+let _ = Notation.declare_numeral_interpreter bigQ_scope
+  (bigQ_path, bigQ_module)
+  interp_bigQ
+  ([], uninterp_bigQ,
+   true)
diff --git a/parsing/g_intsyntax.mli b/parsing/g_intsyntax.mli
new file mode 100644
index 00000000..c74ae578
--- /dev/null
+++ b/parsing/g_intsyntax.mli
@@ -0,0 +1,13 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+
+(*i $$ i*)
+
+
+(* digit based syntax for int31 and bigint *)
diff --git a/parsing/g_ltac.ml4 b/parsing/g_ltac.ml4
index 27ff8140..78a9fbc7 100644
--- a/parsing/g_ltac.ml4
+++ b/parsing/g_ltac.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_ltac.ml4 9333 2006-11-02 13:59:14Z barras $ *)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(* $Id: g_ltac.ml4 10919 2008-05-11 22:04:26Z msozeau $ *)
 
 open Pp
 open Util
@@ -18,27 +20,11 @@ open Pcoq
 open Prim
 open Tactic
 
-type let_clause_kind =
-  | LETTOPCLAUSE of Names.identifier * constr_expr
-  | LETCLAUSE of
-      (Names.identifier Util.located * raw_tactic_expr option * raw_tactic_arg)
-
 let fail_default_value = ArgArg 0
 
-let out_letin_clause loc = function
-  | LETTOPCLAUSE _ -> user_err_loc (loc, "", (str "Syntax Error"))
-  | LETCLAUSE (id,c,d) -> (id,c,d)
-
-let make_letin_clause loc = List.map (out_letin_clause loc)
-
 let arg_of_expr = function
     TacArg a -> a
   | e -> Tacexp (e:raw_tactic_expr)
-    
-let tacarg_of_expr = function
-  | TacArg (Reference r) -> TacCall (dummy_loc,r,[])
-  | TacArg a -> a
-  | e -> Tacexp (e:raw_tactic_expr)
 
 (* Tactics grammar rules *)
 
@@ -46,16 +32,31 @@ GEXTEND Gram
   GLOBAL: tactic Vernac_.command tactic_expr binder_tactic tactic_arg
           constr_may_eval;
 
+  tactic_then_last:
+    [ [ "|"; lta = LIST0 OPT tactic_expr SEP "|" ->
+          Array.map (function None -> TacId [] | Some t -> t) (Array.of_list lta)
+      | -> [||] 
+    ] ]
+  ;
+  tactic_then_gen:
+    [ [ ta = tactic_expr; "|"; (first,last) = tactic_then_gen -> (ta::first, last)
+      | ta = tactic_expr; ".."; l = tactic_then_last -> ([], Some (ta, l))
+      | ".."; l = tactic_then_last -> ([], Some (TacId [], l))
+      | ta = tactic_expr -> ([ta], None)
+      | "|"; (first,last) = tactic_then_gen -> (TacId [] :: first, last)
+      | -> ([TacId []], None)
+    ] ]
+  ;
   tactic_expr:
     [ "5" RIGHTA
       [ te = binder_tactic -> te ]
     | "4" LEFTA
-      [ ta0 = tactic_expr; ";"; ta1 = binder_tactic -> TacThen (ta0, ta1)
-      | ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0, ta1)
-      | ta = tactic_expr; ";"; 
-	"["; lta = LIST0 OPT tactic_expr SEP "|"; "]" ->
-	  let lta = List.map (function None -> TacId [] | Some t -> t) lta in 
-	  TacThens (ta, lta) ]
+      [ ta0 = tactic_expr; ";"; ta1 = binder_tactic -> TacThen (ta0, [||], ta1, [||])
+      | ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0,  [||], ta1, [||])
+      | ta0 = tactic_expr; ";"; "["; (first,tail) = tactic_then_gen; "]" ->
+	  match tail with 
+	  | Some (t,last) -> TacThen (ta0, Array.of_list first, t, last)
+	  | None -> TacThens (ta0,first) ]
     | "3" RIGHTA
       [ IDENT "try"; ta = tactic_expr -> TacTry ta
       | IDENT "do"; n = int_or_var; ta = tactic_expr -> TacDo (n,ta)
@@ -89,13 +90,14 @@ GEXTEND Gram
 	  TacArg (TacExternal (loc,com,req,la))
       | st = simple_tactic -> TacAtom (loc,st)
       | a = may_eval_arg -> TacArg(a)
+      | IDENT "constr"; ":"; id = METAIDENT ->
+          TacArg(MetaIdArg (loc,false,id))
       | IDENT "constr"; ":"; c = Constr.constr ->
           TacArg(ConstrMayEval(ConstrTerm c))
       | IDENT "ipattern"; ":"; ipat = simple_intropattern -> 
 	  TacArg(IntroPattern ipat)
-      | r = reference; la = LIST1 tactic_arg ->
-          TacArg(TacCall (loc,r,la))
-      | r = reference -> TacArg (Reference r) ]
+      | r = reference; la = LIST0 tactic_arg ->
+          TacArg(TacCall (loc,r,la)) ]
     | "0"
       [ "("; a = tactic_expr; ")" -> a
       | a = tactic_atom -> TacArg a ] ]
@@ -105,20 +107,22 @@ GEXTEND Gram
     [ RIGHTA
       [ "fun"; it = LIST1 input_fun ; "=>"; body = tactic_expr LEVEL "5" ->
           TacFun (it,body)
-      | "let"; IDENT "rec"; rcl = LIST1 rec_clause SEP "with"; "in";
-          body = tactic_expr LEVEL "5" -> TacLetRecIn (rcl,body)
-      | "let"; llc = LIST1 let_clause SEP "with"; "in";
-          u = tactic_expr LEVEL "5" -> TacLetIn (make_letin_clause loc llc,u)
+      | "let"; isrec = [IDENT "rec" -> true | -> false]; 
+          llc = LIST1 let_clause SEP "with"; "in";
+          body = tactic_expr LEVEL "5" -> TacLetIn (isrec,llc,body)
       | IDENT "info"; tc = tactic_expr LEVEL "5" -> TacInfo tc ] ]
   ;
   (* Tactic arguments *)
   tactic_arg:
-    [ [ IDENT "ltac"; ":"; a = tactic_expr LEVEL "0" -> tacarg_of_expr a
+    [ [ IDENT "ltac"; ":"; a = tactic_expr LEVEL "0" -> arg_of_expr a
+      | IDENT "ltac"; ":"; n = natural -> Integer n
       | IDENT "ipattern"; ":"; ipat = simple_intropattern -> IntroPattern ipat
       | a = may_eval_arg -> a
       | r = reference -> Reference r
-      | a = tactic_atom -> a
-      | c = Constr.constr -> ConstrMayEval (ConstrTerm c) ] ]
+      | c = Constr.constr -> ConstrMayEval (ConstrTerm c)
+      (* Unambigous entries: tolerated w/o "ltac:" modifier *)
+      | id = METAIDENT -> MetaIdArg (loc,true,id)
+      | "()" -> TacVoid ] ]
   ;
   may_eval_arg:
     [ [ c = constr_eval -> ConstrMayEval c
@@ -140,7 +144,9 @@ GEXTEND Gram
       | c = Constr.constr -> ConstrTerm c ] ]
   ;
   tactic_atom:
-    [ [ id = METAIDENT -> MetaIdArg (loc,id)
+    [ [ id = METAIDENT -> MetaIdArg (loc,true,id)
+      | n = integer -> Integer n
+      | r = reference -> TacCall (loc,r,[])
       | "()" -> TacVoid ] ]
   ;
   match_key:
@@ -152,13 +158,9 @@ GEXTEND Gram
   ;
   let_clause:
     [ [ id = identref; ":="; te = tactic_expr ->
-          LETCLAUSE (id, None, arg_of_expr te)
+         (id, arg_of_expr te)
       | id = identref; args = LIST1 input_fun; ":="; te = tactic_expr ->
-          LETCLAUSE (id, None, arg_of_expr (TacFun(args,te))) ] ]
-  ;
-  rec_clause:
-    [ [ name = identref; it = LIST1 input_fun; ":="; body = tactic_expr ->
-          (name,(it,body)) ] ]
+         (id, arg_of_expr (TacFun(args,te))) ] ]
   ;
   match_pattern:
     [ [ IDENT "context";  oid = OPT Constr.ident;
@@ -194,12 +196,17 @@ GEXTEND Gram
       | n = integer -> MsgInt n ] ]
   ;
 
+  ltac_def_kind:
+    [ [ ":=" -> false
+      | "::=" -> true ] ]
+  ;
+	
   (* Definitions for tactics *)
   tacdef_body:
-    [ [ name = identref; it=LIST1 input_fun; ":="; body = tactic_expr ->
-	  (name, TacFun (it, body))
-      | name = identref; ":="; body = tactic_expr ->
-	  (name, body) ] ]
+    [ [ name = Constr.global; it=LIST1 input_fun; redef = ltac_def_kind; body = tactic_expr ->
+	  (name, redef, TacFun (it, body))
+      | name = Constr.global; redef = ltac_def_kind; body = tactic_expr ->
+	  (name, redef, body) ] ]
   ;
   tactic:
     [ [ tac = tactic_expr -> tac ] ]
diff --git a/parsing/g_minicoq.ml4 b/parsing/g_minicoq.ml4
index ed8dda5c..a9275cf9 100644
--- a/parsing/g_minicoq.ml4
+++ b/parsing/g_minicoq.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_minicoq.ml4 5920 2004-07-16 20:01:26Z herbelin $ *)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(* $Id: g_minicoq.ml4 10007 2007-07-16 09:18:44Z corbinea $ *)
 
 open Pp
 open Util
diff --git a/parsing/g_natsyntax.ml b/parsing/g_natsyntax.ml
index f764bc28..8804d81a 100644
--- a/parsing/g_natsyntax.ml
+++ b/parsing/g_natsyntax.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_natsyntax.ml 7988 2006-02-04 20:28:29Z herbelin $ *)
+(* $Id: g_natsyntax.ml 10348 2007-12-06 17:36:14Z aspiwack $ *)
 
 (* This file defines the printer for natural numbers in [nat] *)
 
@@ -32,11 +32,12 @@ open Names
 
 let nat_of_int dloc n =
   if is_pos_or_zero n then begin
-      if less_than (of_string "5000") n & Options.is_verbose () then begin
-	warning ("You may experience stack overflow and segmentation fault\
-                  \nwhile parsing numbers in nat greater than 5000");
-	flush_all ()
-      end;
+      if less_than (of_string "5000") n then
+	Flags.if_warn msg_warning 
+	  (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 ref_O = RRef (dloc, glob_O) in
       let ref_S = RRef (dloc, glob_S) in
       let rec mk_nat acc n =
diff --git a/parsing/g_natsyntax.mli b/parsing/g_natsyntax.mli
index 174be771..09095959 100644
--- a/parsing/g_natsyntax.mli
+++ b/parsing/g_natsyntax.mli
@@ -6,6 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_natsyntax.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: g_natsyntax.mli 11087 2008-06-10 13:29:52Z letouzey $ i*)
 
 (* Nice syntax for naturals. *)
+
+open Notation
+
+val nat_of_int : Bigint.bigint prim_token_interpreter
diff --git a/parsing/g_prim.ml4 b/parsing/g_prim.ml4
index d5ca5e0c..c3792d65 100644
--- a/parsing/g_prim.ml4
+++ b/parsing/g_prim.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: g_prim.ml4 7922 2006-01-23 19:11:11Z herbelin $ i*)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(*i $Id: g_prim.ml4 10155 2007-09-28 22:36:35Z glondu $ i*)
 
 open Pcoq
 open Names
@@ -25,13 +27,19 @@ GEXTEND Gram
   GLOBAL: 
     bigint natural integer identref name ident var preident
     fullyqualid qualid reference dirpath
-    ne_string string;
+    ne_string string pattern_ident pattern_identref;
   preident:
     [ [ s = IDENT -> s ] ]
   ;
   ident:
     [ [ s = IDENT -> id_of_string s ] ]
   ;
+  pattern_ident:
+    [ [ s = PATTERNIDENT -> id_of_string s ] ]
+  ;
+  pattern_identref:
+    [ [ id = pattern_ident -> (loc, id) ] ]
+  ;
   var: (* as identref, but interpret as a term identifier in ltac *)
     [ [ id = ident -> (loc,id) ] ]
   ;
diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4
index 0a48748f..05878e97 100644
--- a/parsing/g_proofs.ml4
+++ b/parsing/g_proofs.ml4
@@ -6,7 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_proofs.ml4 9976 2007-07-12 11:58:30Z msozeau $ *)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(* $Id: g_proofs.ml4 10628 2008-03-06 14:56:08Z msozeau $ *)
+
 
 open Pcoq
 open Pp
@@ -59,6 +62,7 @@ GEXTEND Gram
       | IDENT "Proof"; c = lconstr -> VernacExactProof c
       | IDENT "Undo" -> VernacUndo 1
       | IDENT "Undo"; n = natural -> VernacUndo n
+      | IDENT "Undo"; IDENT "To"; n = natural -> VernacUndoTo n
       | IDENT "Focus" -> VernacFocus None
       | IDENT "Focus"; n = natural -> VernacFocus (Some n)
       | IDENT "Unfocus" -> VernacUnfocus
@@ -101,7 +105,8 @@ GEXTEND Gram
     [ [ IDENT "Local" -> true | -> false ] ]
   ;
   hint:
-    [ [ IDENT "Resolve"; lc = LIST1 constr -> HintsResolve lc
+    [ [ IDENT "Resolve"; lc = LIST1 constr; n = OPT [ n = natural -> n ] -> 
+          HintsResolve (List.map (fun x -> (n, x)) lc)
       | IDENT "Immediate"; lc = LIST1 constr -> HintsImmediate lc
       | IDENT "Unfold"; lqid = LIST1 global -> HintsUnfold lqid
       | IDENT "Constructors"; lc = LIST1 global -> HintsConstructors lc
diff --git a/parsing/g_rsyntax.ml b/parsing/g_rsyntax.ml
index 45647903..b3425899 100644
--- a/parsing/g_rsyntax.ml
+++ b/parsing/g_rsyntax.ml
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(*i $Id: g_rsyntax.ml 10739 2008-04-01 14:45:20Z herbelin $ i*)
+
 open Pp
 open Util
 open Names
diff --git a/parsing/g_string_syntax.ml b/parsing/g_string_syntax.ml
index 6d879fb2..6a650987 100644
--- a/parsing/g_string_syntax.ml
+++ b/parsing/g_string_syntax.ml
@@ -6,6 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
+(*i $Id: g_string_syntax.ml 10739 2008-04-01 14:45:20Z herbelin $ i*)
+
 open Pp
 open Util
 open Names
diff --git a/parsing/g_tactic.ml4 b/parsing/g_tactic.ml4
index a80d3075..c0a4ba5b 100644
--- a/parsing/g_tactic.ml4
+++ b/parsing/g_tactic.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_tactic.ml4 9551 2007-01-29 15:13:35Z bgregoir $ *)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(* $Id: g_tactic.ml4 11094 2008-06-10 19:35:23Z herbelin $ *)
 
 open Pp
 open Pcoq
@@ -15,8 +17,9 @@ open Tacexpr
 open Rawterm
 open Genarg
 open Topconstr
+open Libnames
 
-let compute = Cbv all_flags
+let all_with delta = make_red_flag [FBeta;FIota;FZeta;delta]
 
 let tactic_kw = [ "->"; "<-" ]
 let _ = List.iter (fun s -> Lexer.add_token("",s)) tactic_kw
@@ -68,6 +71,30 @@ let lpar_id_colon =
               | _ -> raise Stream.Failure)
         | _ -> raise Stream.Failure)
 
+(* idem for (x1..xn:t) [n^2 complexity but exceptional use] *)
+let check_for_coloneq =
+  Gram.Entry.of_parser "lpar_id_colon"
+    (fun strm ->
+      let rec skip_to_rpar n =
+	match list_last (Stream.npeek n strm) with
+        | ("",")") -> n+1
+	| ("",".") -> raise Stream.Failure
+	| _ -> skip_to_rpar (n+1) in
+      let rec skip_names n =
+	match list_last (Stream.npeek n strm) with
+        | ("IDENT",_) | ("","_") -> skip_names (n+1)
+	| ("",":") -> skip_to_rpar (n+1) (* skip a constr *)
+	| _ -> raise Stream.Failure in
+      let rec skip_binders n =
+	match list_last (Stream.npeek n strm) with
+        | ("","(") -> skip_binders (skip_names (n+1))
+        | ("IDENT",_) | ("","_") -> skip_binders (n+1)
+	| ("",":=") -> ()
+	| _ -> raise Stream.Failure in
+      match Stream.npeek 1 strm with
+      | [("","(")] -> skip_binders 2
+      | _ -> raise Stream.Failure)
+
 let guess_lpar_ipat s strm =
   match Stream.npeek 1 strm with
     | [("","(")] ->
@@ -86,6 +113,13 @@ let guess_lpar_coloneq =
 let guess_lpar_colon =
   Gram.Entry.of_parser "guess_lpar_colon" (guess_lpar_ipat ":")
 
+let lookup_at_as_coma =
+  Gram.Entry.of_parser "lookup_at_as_coma"
+    (fun strm ->
+      match Stream.npeek 1 strm with
+	| [("",(","|"at"|"as"))] -> ()
+	| _ -> raise Stream.Failure)
+
 open Constr
 open Prim
 open Tactic
@@ -93,25 +127,44 @@ open Tactic
 let mk_fix_tac (loc,id,bl,ann,ty) =
   let n =
     match bl,ann with
-        [([_],_)], None -> 1
+        [([_],_,_)], None -> 1
       | _, Some x ->
-          let ids = List.map snd (List.flatten (List.map fst bl)) in
+          let ids = List.map snd (List.flatten (List.map pi1 bl)) in
           (try list_index (snd x) ids
           with Not_found -> error "no such fix variable")
       | _ -> error "cannot guess decreasing argument of fix" in
   (id,n,CProdN(loc,bl,ty))
 
 let mk_cofix_tac (loc,id,bl,ann,ty) =
-  let _ = option_map (fun (aloc,_) ->
+  let _ = Option.map (fun (aloc,_) ->
     Util.user_err_loc
       (aloc,"Constr:mk_cofix_tac",
        Pp.str"Annotation forbidden in cofix expression")) ann in
   (id,CProdN(loc,bl,ty))
 
 (* Functions overloaded by quotifier *)
-let induction_arg_of_constr c =
-  try ElimOnIdent (constr_loc c,snd(coerce_to_id c))
-  with _ -> ElimOnConstr c
+let induction_arg_of_constr (c,lbind as clbind) =
+  if lbind = NoBindings then
+    try ElimOnIdent (constr_loc c,snd(coerce_to_id c))
+    with _ -> ElimOnConstr clbind
+  else ElimOnConstr clbind
+
+let rec mkCLambdaN_simple_loc loc bll c =
+  match bll with
+  | ((loc1,_)::_ as idl,bk,t) :: bll -> 
+      CLambdaN (loc,[idl,bk,t],mkCLambdaN_simple_loc (join_loc loc1 loc) bll c)
+  | ([],_,_) :: bll -> mkCLambdaN_simple_loc loc bll c
+  | [] -> c
+
+let mkCLambdaN_simple bl c =
+  if bl=[] then c
+  else
+    let loc = join_loc (fst (List.hd (pi1 (List.hd bl)))) (constr_loc c) in
+    mkCLambdaN_simple_loc loc bl c
+
+let map_int_or_var f = function
+  | Rawterm.ArgArg x -> Rawterm.ArgArg (f x)
+  | Rawterm.ArgVar _ as y -> y
 
 (* Auxiliary grammar rules *)
 
@@ -124,6 +177,10 @@ GEXTEND Gram
     [ [ n = integer  -> Rawterm.ArgArg n
       | id = identref -> Rawterm.ArgVar id ] ]
   ;
+  nat_or_var:
+    [ [ n = natural  -> Rawterm.ArgArg n
+      | id = identref -> Rawterm.ArgVar id ] ]
+  ;
   (* An identifier or a quotation meta-variable *)
   id_or_meta:
     [ [ id = identref -> AI id 
@@ -145,7 +202,7 @@ GEXTEND Gram
   ;
   induction_arg:
     [ [ n = natural -> ElimOnAnonHyp n
-      | c = constr -> induction_arg_of_constr c
+      | c = constr_with_bindings -> induction_arg_of_constr c
     ] ]
   ;
   quantified_hypothesis:
@@ -154,30 +211,52 @@ GEXTEND Gram
   ;
   conversion:
     [ [ c = constr -> (None, c)
-      | c1 = constr; "with"; c2 = constr -> (Some ([],c1), c2)
-      | c1 = constr; "at"; nl = LIST1 int_or_var; "with"; c2 = constr ->
-	  (Some (nl,c1), c2) ] ]
-  ;
-  occurrences:
-    [ [ "at"; nl = LIST1 int_or_var -> nl
-      | -> [] ] ]
+      | c1 = constr; "with"; c2 = constr -> (Some (all_occurrences_expr,c1),c2)
+      | c1 = constr; "at"; occs = occs_nums; "with"; c2 = constr ->
+          (Some (occs,c1), c2) ] ]
+  ;
+  smart_global:
+    [ [ c = global -> AN c
+      | s = ne_string -> ByNotation (loc,s) ] ]
+  ;
+  occs_nums:
+    [ [ nl = LIST1 nat_or_var -> no_occurrences_expr_but nl
+      | "-"; n = nat_or_var; nl = LIST0 int_or_var ->
+	  (* have used int_or_var instead of nat_or_var for compatibility *)
+	   all_occurrences_expr_but (List.map (map_int_or_var abs) (n::nl)) ] ]
+  ; 
+  occs:
+    [ [ "at"; occs = occs_nums -> occs | -> all_occurrences_expr_but [] ] ]
   ;
   pattern_occ:
-    [ [ c = constr; nl = occurrences -> (nl,c) ] ]
+    [ [ c = constr; nl = occs -> (nl,c) ] ]
   ;
   unfold_occ:
-    [ [ c = global; nl = occurrences -> (nl,c) ] ]
+    [ [ c = smart_global; nl = occs -> (nl,c) ] ]
   ;
   intropatterns:
     [ [ l = LIST0 simple_intropattern -> l ]]
   ;
   simple_intropattern:
     [ [ "["; tc = LIST1 intropatterns SEP "|" ; "]" -> IntroOrAndPattern tc
-      | "("; tc = LIST0 simple_intropattern SEP "," ; ")" -> IntroOrAndPattern [tc]
       | "()" -> IntroOrAndPattern [[]]
+      | "("; si = simple_intropattern; ")" -> IntroOrAndPattern [[si]]
+      | "("; si = simple_intropattern; ","; 
+             tc = LIST1 simple_intropattern SEP "," ; ")" -> 
+	       IntroOrAndPattern [si::tc]
+      | "("; si = simple_intropattern; "&"; 
+	     tc = LIST1 simple_intropattern SEP "&" ; ")" -> 
+	  (* (A & B & C) is translated into (A,(B,C)) *)
+	  let rec pairify = function 
+	    | ([]|[_]|[_;_]) as l -> IntroOrAndPattern [l]
+	    | t::q -> IntroOrAndPattern [[t;pairify q]]
+	  in pairify (si::tc)
       | "_" -> IntroWildcard
+      | prefix = pattern_ident -> IntroFresh prefix
       | "?" -> IntroAnonymous
       | id = ident -> IntroIdentifier id
+      | "->" -> IntroRewrite true
+      | "<-" -> IntroRewrite false
       ] ]
   ;
   simple_binding:
@@ -189,6 +268,9 @@ GEXTEND Gram
           ExplicitBindings bl
       | bl = LIST1 constr -> ImplicitBindings bl ] ]
   ;
+  opt_bindings:
+    [ [ bl = bindings -> bl | -> NoBindings ] ]
+  ;
   constr_with_bindings:
     [ [ c = constr; l = with_bindings -> (c, l) ] ]
   ;
@@ -197,37 +279,46 @@ GEXTEND Gram
   ;
   red_flag:
     [ [ IDENT "beta" -> FBeta
-      | IDENT "delta" -> FDeltaBut []
       | IDENT "iota" -> FIota
       | IDENT "zeta" -> FZeta
-      | IDENT "delta"; "["; idl = LIST1 global; "]" -> FConst idl
-      | IDENT "delta"; "-"; "["; idl = LIST1 global; "]" -> FDeltaBut idl
+      | IDENT "delta"; d = delta_flag -> d
+    ] ]
+  ;
+  delta_flag:
+    [ [ "-"; "["; idl = LIST1 smart_global; "]" -> FDeltaBut idl
+      | "["; idl = LIST1 smart_global; "]" -> FConst idl
+      | -> FDeltaBut []
+    ] ]
+  ;
+  strategy_flag:
+    [ [ s = LIST1 red_flag -> make_red_flag s
+      | d = delta_flag -> all_with d
     ] ]
   ;
   red_tactic:
     [ [ IDENT "red" -> Red false
       | IDENT "hnf" -> Hnf
       | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
-      | IDENT "cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
-      | IDENT "lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
-      | IDENT "compute" -> compute
+      | IDENT "cbv"; s = strategy_flag -> Cbv s
+      | IDENT "lazy"; s = strategy_flag -> Lazy s
+      | IDENT "compute"; delta = delta_flag -> Cbv (all_with delta)
       | IDENT "vm_compute" -> CbvVm
       | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> Unfold ul
       | IDENT "fold"; cl = LIST1 constr -> Fold cl
-      | IDENT "pattern"; pl = LIST1 pattern_occ SEP","-> Pattern pl ] ]
+      | IDENT "pattern"; pl = LIST1 pattern_occ SEP"," -> Pattern pl ] ]
   ;
   (* This is [red_tactic] including possible extensions *)
   red_expr:
     [ [ IDENT "red" -> Red false
       | IDENT "hnf" -> Hnf
       | IDENT "simpl"; po = OPT pattern_occ -> Simpl po
-      | IDENT "cbv"; s = LIST1 red_flag -> Cbv (make_red_flag s)
-      | IDENT "lazy"; s = LIST1 red_flag -> Lazy (make_red_flag s)
-      | IDENT "compute" -> compute
+      | IDENT "cbv"; s = strategy_flag -> Cbv s
+      | IDENT "lazy"; s = strategy_flag -> Lazy s
+      | IDENT "compute"; delta = delta_flag -> Cbv (all_with delta)
       | IDENT "vm_compute" -> CbvVm
       | IDENT "unfold"; ul = LIST1 unfold_occ -> Unfold ul
       | IDENT "fold"; cl = LIST1 constr -> Fold cl
-      | IDENT "pattern"; pl = LIST1 pattern_occ -> Pattern pl
+      | IDENT "pattern"; pl = LIST1 pattern_occ SEP"," -> Pattern pl
       | s = IDENT -> ExtraRedExpr s ] ]
   ;
   hypident:
@@ -240,22 +331,33 @@ GEXTEND Gram
     ] ]
   ;
   hypident_occ:
-    [ [ (id,l)=hypident; occs=occurrences -> ((occs,id),l) ] ]
-  ;
-  clause:
-    [ [ "in"; "*"; occs=occurrences ->
-        {onhyps=None;onconcl=true;concl_occs=occs}
-      | "in"; "*"; "|-"; (b,occs)=concl_occ ->
-          {onhyps=None; onconcl=b; concl_occs=occs}
-      | "in"; hl=LIST0 hypident_occ SEP","; "|-"; (b,occs)=concl_occ ->
-          {onhyps=Some hl; onconcl=b; concl_occs=occs}
-      | "in"; hl=LIST0 hypident_occ SEP"," ->
-          {onhyps=Some hl; onconcl=false; concl_occs=[]}
-      | -> {onhyps=Some[];onconcl=true; concl_occs=[]} ] ]
+    [ [ (id,l)=hypident; occs=occs -> ((occs,id),l) ] ]
+  ;
+  in_clause:
+    [ [ "*"; occs=occs ->
+          {onhyps=None; concl_occs=occs}
+      | "*"; "|-"; occs=concl_occ ->
+          {onhyps=None; concl_occs=occs}
+      | hl=LIST0 hypident_occ SEP","; "|-"; occs=concl_occ ->
+          {onhyps=Some hl; concl_occs=occs}
+      | hl=LIST0 hypident_occ SEP"," ->
+          {onhyps=Some hl; concl_occs=no_occurrences_expr} ] ]
+  ;
+  clause_dft_concl:
+    [ [ "in"; cl = in_clause -> cl
+      | occs=occs -> {onhyps=Some[]; concl_occs=occs}
+      | -> {onhyps=Some[]; concl_occs=all_occurrences_expr} ] ]
+  ;
+  clause_dft_all:
+    [ [ "in"; cl = in_clause -> cl
+      | -> {onhyps=None; concl_occs=all_occurrences_expr} ] ]
+  ;
+  opt_clause:
+    [ [ "in"; cl = in_clause -> Some cl | -> None ] ]
   ;
   concl_occ:
-    [ [ "*"; occs = occurrences -> (true,occs)
-      | -> (false, []) ] ]
+    [ [ "*"; occs = occs -> occs
+      | -> no_occurrences_expr ] ]
   ;
   simple_clause:
     [ [ "in"; idl = LIST1 id_or_meta -> idl
@@ -265,15 +367,28 @@ GEXTEND Gram
     [ [ "->" -> true 
       | "<-" -> false
       | -> true ]]
-  ; 
+  ;
+  simple_binder:
+    [ [ na=name -> ([na],Default Explicit,CHole (loc, None))
+      | "("; nal=LIST1 name; ":"; c=lconstr; ")" -> (nal,Default Explicit,c) 
+    ] ]
+  ;
   fixdecl:
-    [ [ "("; id = ident; bl=LIST0 Constr.binder; ann=fixannot;
+    [ [ "("; id = ident; bl=LIST0 simple_binder; ann=fixannot;
         ":"; ty=lconstr; ")" -> (loc,id,bl,ann,ty) ] ]
   ;
   fixannot:
     [ [ "{"; IDENT "struct"; id=name; "}" -> Some id
       | -> None ] ]
   ;
+  cofixdecl:
+    [ [ "("; id = ident; bl=LIST0 simple_binder; ":"; ty=lconstr; ")" ->
+        (loc,id,bl,None,ty) ] ]
+  ;
+  bindings_with_parameters:
+    [ [ check_for_coloneq; "(";  id = ident; bl = LIST0 simple_binder; 
+        ":="; c = lconstr; ")" -> (id, mkCLambdaN_simple bl c) ] ]
+  ;
   hintbases:
     [ [ "with"; "*" -> None
       | "with"; l = LIST1 IDENT -> Some l
@@ -289,10 +404,41 @@ GEXTEND Gram
   with_names:
     [ [ "as"; ipat = simple_intropattern -> ipat | -> IntroAnonymous ] ]
   ;
+  as_name:
+    [ [ "as"; id = ident -> Names.Name id | -> Names.Anonymous ] ]
+  ;
   by_tactic:
     [ [ IDENT "by"; tac = tactic_expr LEVEL "3" -> TacComplete tac
       | -> TacId [] ] ]
   ;
+  opt_by_tactic:
+    [ [ IDENT "by"; tac = tactic_expr LEVEL "3" -> Some tac
+    | -> None ] ]
+  ;
+  rename : 
+    [ [ id1 = id_or_meta; IDENT "into"; id2 = id_or_meta -> (id1,id2) ] ]
+  ;
+  rewriter : 
+    [ [ 
+    (* hack for allowing "rewrite ?t" and "rewrite NN?t" that normally 
+       produce a pattern_ident *)
+        c = pattern_ident -> 
+	  let c = (CRef (Ident (loc,c)), NoBindings) in  
+	  (RepeatStar, c)
+      | n = natural; c = pattern_ident -> 
+	  let c = (CRef (Ident (loc,c)), NoBindings) in  
+	  (UpTo n, c)
+      | "!"; c = constr_with_bindings -> (RepeatPlus,c)
+      |	"?"; c = constr_with_bindings -> (RepeatStar,c)
+      | n = natural; "!"; c = constr_with_bindings -> (Precisely n,c)
+      |	n = natural; "?"; c = constr_with_bindings -> (UpTo n,c)
+      | n = natural; c = constr_with_bindings -> (Precisely n,c)
+      | c = constr_with_bindings -> (Precisely 1, c)
+      ] ]
+  ;
+  oriented_rewriter : 
+    [ [ b = orient; p = rewriter -> let (m,c) = p in (b,m,c) ] ]
+  ; 
   simple_tactic:
     [ [ 
       (* Basic tactics *)
@@ -311,29 +457,39 @@ GEXTEND Gram
       | IDENT "exact_no_check"; c = constr -> TacExactNoCheck c
       | IDENT "vm_cast_no_check"; c = constr -> TacVmCastNoCheck c
 
-      | IDENT "apply"; cl = constr_with_bindings -> TacApply cl
+      | IDENT "apply"; cl = constr_with_bindings -> TacApply (true,false,cl)
+      | IDENT "eapply"; cl = constr_with_bindings -> TacApply (true,true,cl)
+      | IDENT "simple"; IDENT "apply"; cl = constr_with_bindings -> 
+          TacApply (false,false,cl)
+      | IDENT "simple"; IDENT "eapply"; cl = constr_with_bindings -> 
+          TacApply (false, true,cl)
       | IDENT "elim"; cl = constr_with_bindings; el = OPT eliminator ->
-          TacElim (cl,el)
+          TacElim (false,cl,el)
+      | IDENT "eelim"; cl = constr_with_bindings; el = OPT eliminator ->
+          TacElim (true,cl,el)
       | IDENT "elimtype"; c = constr -> TacElimType c
-      | IDENT "case"; cl = constr_with_bindings -> TacCase cl
+      | IDENT "case"; cl = constr_with_bindings -> TacCase (false,cl)
+      | IDENT "ecase"; cl = constr_with_bindings -> TacCase (true,cl)
       | IDENT "casetype"; c = constr -> TacCaseType c
       | "fix"; n = natural -> TacFix (None,n)
       | "fix"; id = ident; n = natural -> TacFix (Some id,n)
       | "fix"; id = ident; n = natural; "with"; fd = LIST1 fixdecl ->
-	  TacMutualFix (id,n,List.map mk_fix_tac fd)
+	  TacMutualFix (false,id,n,List.map mk_fix_tac fd)
       | "cofix" -> TacCofix None
       | "cofix"; id = ident -> TacCofix (Some id)
-      | "cofix"; id = ident; "with"; fd = LIST1 fixdecl ->
-	  TacMutualCofix (id,List.map mk_cofix_tac fd)
-
-      | IDENT "pose"; id = lpar_id_coloneq; b = lconstr; ")" ->
-	  TacLetTac (Names.Name id,b,nowhere)
-      | IDENT "pose"; b = constr ->
-	  TacLetTac (Names.Anonymous,b,nowhere)
-      | IDENT "set"; id = lpar_id_coloneq; c = lconstr; ")"; p = clause ->
-	  TacLetTac (Names.Name id,c,p)
-      | IDENT "set"; c = constr; p = clause ->
-          TacLetTac (Names.Anonymous,c,p)
+      | "cofix"; id = ident; "with"; fd = LIST1 cofixdecl ->
+	  TacMutualCofix (false,id,List.map mk_cofix_tac fd)
+
+      | IDENT "pose"; (id,b) = bindings_with_parameters ->
+	  TacLetTac (Names.Name id,b,nowhere,true)
+      | IDENT "pose"; b = constr; na = as_name ->
+	  TacLetTac (na,b,nowhere,true)
+      | IDENT "set"; (id,c) = bindings_with_parameters; p = clause_dft_concl ->
+	  TacLetTac (Names.Name id,c,p,true)
+      | IDENT "set"; c = constr; na = as_name; p = clause_dft_concl ->
+          TacLetTac (na,c,p,true)
+      | IDENT "remember"; c = constr; na = as_name; p = clause_dft_all ->
+          TacLetTac (na,c,p,false)
 
       (* Begin compatibility *)
       | IDENT "assert"; id = lpar_id_coloneq; c = lconstr; ")" -> 
@@ -348,14 +504,16 @@ GEXTEND Gram
 	  TacAssert (None,ipat,c)
 
       | IDENT "cut"; c = constr -> TacCut c
-      | IDENT "generalize"; lc = LIST1 constr -> TacGeneralize lc
+      | IDENT "generalize"; c = constr ->
+	  TacGeneralize [((all_occurrences_expr,c),Names.Anonymous)]
+      | IDENT "generalize"; c = constr; l = LIST1 constr ->
+	  let gen_everywhere c = ((all_occurrences_expr,c),Names.Anonymous) in
+          TacGeneralize (List.map gen_everywhere (c::l))
+      | IDENT "generalize"; c = constr; lookup_at_as_coma; nl = occs; 
+          na = as_name; 
+          l = LIST0 [","; c = pattern_occ; na = as_name -> (c,na)] ->
+          TacGeneralize (((nl,c),na)::l)
       | IDENT "generalize"; IDENT "dependent"; c = constr -> TacGeneralizeDep c
-    (*  | IDENT "instantiate"; "("; n = natural; ":="; c = lconstr; ")"; "in";
-	  hid = hypident ->
-	    let (id,(hloc,_)) = hid in
-              TacInstantiate (n,c,HypLocation (id,hloc))
-      | IDENT "instantiate"; "("; n = natural; ":="; c = lconstr; ")" ->
-            TacInstantiate (n,c,ConclLocation ()) *)
 
       | IDENT "specialize"; n = OPT natural; lcb = constr_with_bindings ->
 	  TacSpecialize (n,lcb)
@@ -365,16 +523,24 @@ GEXTEND Gram
       | IDENT "simple"; IDENT"induction"; h = quantified_hypothesis ->
           TacSimpleInduction h
       | IDENT "induction"; lc = LIST1 induction_arg; ids = with_names; 
-	  el = OPT eliminator -> TacNewInduction (lc,el,ids)
+	  el = OPT eliminator; cl = opt_clause -> 
+	    TacNewInduction (false,lc,el,ids,cl)
+      | IDENT "einduction"; lc = LIST1 induction_arg; ids = with_names; 
+	  el = OPT eliminator; cl = opt_clause ->
+	    TacNewInduction (true,lc,el,ids,cl)
       | IDENT "double"; IDENT "induction"; h1 = quantified_hypothesis;
 	  h2 = quantified_hypothesis -> TacDoubleInduction (h1,h2)
-      | IDENT "simple"; IDENT"destruct"; h = quantified_hypothesis ->
+      | IDENT "simple"; IDENT "destruct"; h = quantified_hypothesis ->
           TacSimpleDestruct h
       | IDENT "destruct"; lc = LIST1 induction_arg; ids = with_names; 
-	  el = OPT eliminator -> TacNewDestruct (lc,el,ids)
+	  el = OPT eliminator; cl = opt_clause ->
+	    TacNewDestruct (false,lc,el,ids,cl)
+      | IDENT "edestruct"; lc = LIST1 induction_arg; ids = with_names; 
+	  el = OPT eliminator; cl = opt_clause ->
+	    TacNewDestruct (true,lc,el,ids,cl)
       | IDENT "decompose"; IDENT "record" ; c = constr -> TacDecomposeAnd c
       | IDENT "decompose"; IDENT "sum"; c = constr -> TacDecomposeOr c
-      | IDENT "decompose"; "["; l = LIST1 global; "]"; c = constr
+      | IDENT "decompose"; "["; l = LIST1 smart_global; "]"; c = constr
         -> TacDecompose (l,c)
 
       (* Automation tactic *)
@@ -390,8 +556,10 @@ GEXTEND Gram
       | IDENT "dconcl"  -> TacDestructConcl
       | IDENT "superauto"; l = autoargs -> TacSuperAuto l
 *)
-      | IDENT "auto"; n = OPT int_or_var; IDENT "decomp"; p = OPT natural ->
-	  TacDAuto (n, p)
+      | IDENT "auto"; IDENT "decomp"; p = OPT natural;
+          lems = auto_using -> TacDAuto (None,p,lems)
+      | IDENT "auto"; n = OPT int_or_var; IDENT "decomp"; p = OPT natural;
+          lems = auto_using -> TacDAuto (n,p,lems)
 
       (* Context management *)
       | IDENT "clear"; "-"; l = LIST1 id_or_meta -> TacClear (true, l)
@@ -399,27 +567,35 @@ GEXTEND Gram
       | IDENT "clearbody"; l = LIST1 id_or_meta -> TacClearBody l
       | IDENT "move"; id1 = id_or_meta; IDENT "after"; id2 = id_or_meta -> 
 	  TacMove (true,id1,id2)
-      | IDENT "rename"; id1 = id_or_meta; IDENT "into"; id2 = id_or_meta -> 
-	  TacRename (id1,id2)
+      | IDENT "rename"; l = LIST1 rename SEP "," -> TacRename l
+      | IDENT "revert"; l = LIST1 id_or_meta -> TacRevert l
 
       (* Constructors *)
-      | IDENT "left"; bl = with_bindings -> TacLeft bl
-      | IDENT "right"; bl = with_bindings -> TacRight bl
-      | IDENT "split"; bl = with_bindings -> TacSplit (false,bl)
-      | "exists"; bl = bindings -> TacSplit (true,bl)
-      | "exists" -> TacSplit (true,NoBindings)
+      | IDENT "left";   bl = with_bindings -> TacLeft  (false,bl)
+      | IDENT "eleft";  bl = with_bindings -> TacLeft  (true,bl)
+      | IDENT "right";  bl = with_bindings -> TacRight (false,bl)
+      | IDENT "eright"; bl = with_bindings -> TacRight (true,bl)
+      | IDENT "split";  bl = with_bindings -> TacSplit (false,false,bl)
+      | IDENT "esplit"; bl = with_bindings -> TacSplit (true,false,bl)
+      | "exists";        bl = opt_bindings -> TacSplit (false,true,bl)
+      | IDENT "eexists"; bl = opt_bindings -> TacSplit (true,true,bl)
       | IDENT "constructor"; n = num_or_meta; l = with_bindings ->
-	  TacConstructor (n,l)
-      | IDENT "constructor"; t = OPT tactic -> TacAnyConstructor t
+	  TacConstructor (false,n,l)
+      | IDENT "econstructor"; n = num_or_meta; l = with_bindings ->
+	  TacConstructor (true,n,l)
+      | IDENT "constructor"; t = OPT tactic -> TacAnyConstructor (false,t)
+      | IDENT "econstructor"; t = OPT tactic -> TacAnyConstructor (true,t)
 
       (* Equivalence relations *)
       | IDENT "reflexivity" -> TacReflexivity
-      | IDENT "symmetry"; cls = clause -> TacSymmetry cls
+      | IDENT "symmetry"; cl = clause_dft_concl -> TacSymmetry cl
       | IDENT "transitivity"; c = constr -> TacTransitivity c
 
       (* Equality and inversion *)
-      | IDENT "rewrite"; b = orient; c = constr_with_bindings ; cl = clause -> 
-	  TacRewrite (b,c,cl)
+      | IDENT "rewrite"; l = LIST1 oriented_rewriter SEP ","; 
+	  cl = clause_dft_concl; t=opt_by_tactic -> TacRewrite (false,l,cl,t)
+      | IDENT "erewrite"; l = LIST1 oriented_rewriter SEP ","; 
+	  cl = clause_dft_concl; t=opt_by_tactic -> TacRewrite (true,l,cl,t)
       | IDENT "dependent"; k =
 	  [ IDENT "simple"; IDENT "inversion" -> SimpleInversion
 	  | IDENT "inversion" -> FullInversion
@@ -441,9 +617,10 @@ GEXTEND Gram
 	    TacInversion (InversionUsing (c,cl), hyp)
 
       (* Conversion *)
-      | r = red_tactic; cl = clause -> TacReduce (r, cl)
+      | r = red_tactic; cl = clause_dft_concl -> TacReduce (r, cl)
       (* Change ne doit pas s'appliquer dans un Definition t := Eval ... *)
-      | IDENT "change"; (oc,c) = conversion; cl = clause -> TacChange (oc,c,cl)
+      | IDENT "change"; (oc,c) = conversion; cl = clause_dft_concl ->
+	  TacChange (oc,c,cl)
     ] ]
   ;
 END;;
diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4
index cdd484e7..00469ad5 100644
--- a/parsing/g_vernac.ml4
+++ b/parsing/g_vernac.ml4
@@ -6,8 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_vernac.ml4 10067 2007-08-09 17:13:16Z msozeau $ *)
 (*i camlp4deps: "parsing/grammar.cma" i*)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(* $Id: g_vernac.ml4 11083 2008-06-09 22:08:14Z herbelin $ *)
+
 
 open Pp
 open Util
@@ -43,6 +46,8 @@ let noedit_mode = Gram.Entry.create "vernac:noedit_command"
 let class_rawexpr = Gram.Entry.create "vernac:class_rawexpr"
 let thm_token = Gram.Entry.create "vernac:thm_token"
 let def_body = Gram.Entry.create "vernac:def_body"
+let typeclass_context = Gram.Entry.create "vernac:typeclass_context"
+let of_type_with_opt_coercion = Gram.Entry.create "vernac:of_type_with_opt_coercion"
 
 let get_command_entry () =
   match Decl_mode.get_current_mode () with
@@ -102,7 +107,7 @@ END
 
 let test_plurial_form = function
   | [(_,([_],_))] ->
-      Options.if_verbose warning
+      Flags.if_verbose warning
    "Keywords Variables/Hypotheses/Parameters expect more than one assumption"
   | _ -> ()
 
@@ -113,18 +118,21 @@ let no_coercion loc (c,x) =
 
 (* Gallina declarations *)
 GEXTEND Gram
-  GLOBAL: gallina gallina_ext thm_token def_body;
+  GLOBAL: gallina gallina_ext thm_token def_body of_type_with_opt_coercion
+    typeclass_context typeclass_constraint;
 
   gallina:
       (* Definition, Theorem, Variable, Axiom, ... *)
-    [ [ thm = thm_token; id = identref; bl = LIST0 binder_let; ":";
-        c = lconstr ->
-          VernacStartTheoremProof (thm, id, (bl, c), false, no_hook)
-      | stre = assumption_token; bl = assum_list -> 
-	  VernacAssumption (stre, bl)
-      | stre = assumptions_token; bl = assum_list ->
+    [ [ thm = thm_token; id = identref; bl = binders_let; ":"; c = lconstr;
+        l = LIST0 
+          [ "with"; id = identref; bl = binders_let; ":"; c = lconstr ->
+            (Some id,(bl,c)) ] ->
+          VernacStartTheoremProof (thm,(Some id,(bl,c))::l, false, no_hook)
+      | stre = assumption_token; nl = inline; bl = assum_list -> 
+	  VernacAssumption (stre, nl, bl)
+      | stre = assumptions_token; nl = inline; bl = assum_list ->
 	  test_plurial_form bl;
-	  VernacAssumption (stre, bl)
+	  VernacAssumption (stre, nl, bl)
       | IDENT "Boxed";"Definition";id = identref; b = def_body -> 
 	  VernacDefinition ((Global,true,Definition), id, b, no_hook)
       | IDENT "Unboxed";"Definition";id = identref; b = def_body -> 
@@ -140,7 +148,7 @@ GEXTEND Gram
       | IDENT "Unboxed";"Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
           VernacFixpoint (recs,false)
        | "Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
-          VernacFixpoint (recs,Options.boxed_definitions())
+          VernacFixpoint (recs,Flags.boxed_definitions())
       | "CoFixpoint"; corecs = LIST1 corec_definition SEP "with" ->
           VernacCoFixpoint (corecs,false)
       | IDENT "Scheme"; l = LIST1 scheme SEP "with" -> VernacScheme l
@@ -149,8 +157,9 @@ GEXTEND Gram
   ;
   gallina_ext:
     [ [ b = record_token; oc = opt_coercion; name = identref;
-        ps = LIST0 binder_let; ":";
-	s = lconstr; ":="; cstr = OPT identref; "{";
+        ps = binders_let; 
+	s = [ ":"; s = lconstr -> s | -> CSort (loc,Rawterm.RType None) ];
+	":="; cstr = OPT identref; "{";
         fs = LIST0 record_field SEP ";"; "}" ->
 	  VernacRecord (b,(oc,name),ps,s,cstr,fs)
 (* Non port�� ?
@@ -160,6 +169,10 @@ GEXTEND Gram
 *)
     ] ]
   ;
+  typeclass_context:
+    [ [ "["; l=LIST1 typeclass_constraint SEP ","; "]" -> l 
+    | -> [] ] ]
+  ;
   thm_token:
     [ [ "Theorem" -> Theorem
       | IDENT "Lemma" -> Lemma
@@ -171,11 +184,11 @@ GEXTEND Gram
   ;
   def_token:
     [ [ "Definition" -> 
-	no_hook, (Global, Options.boxed_definitions(), Definition)
+	no_hook, (Global, Flags.boxed_definitions(), Definition)
       | IDENT "Let" -> 
-	no_hook, (Local, Options.boxed_definitions(), Definition)
+	no_hook, (Local, Flags.boxed_definitions(), Definition)
       | IDENT "Example" -> 
-	no_hook, (Global, Options.boxed_definitions(), Example)
+	no_hook, (Global, Flags.boxed_definitions(), Example)
       | IDENT "SubClass"  -> Class.add_subclass_hook, (Global, false, SubClass)
       | IDENT "Local"; IDENT "SubClass"  ->
           Class.add_subclass_hook, (Local, false, SubClass) ] ] 
@@ -193,6 +206,9 @@ GEXTEND Gram
       | IDENT "Axioms" -> (Global, Logical)
       | IDENT "Parameters" -> (Global, Definitional) ] ]
   ;
+  inline:
+    [ ["Inline" -> true |  -> false] ]
+  ;
   finite_token:
     [ [ "Inductive" -> true
       | "CoInductive" -> false ] ]
@@ -202,14 +218,14 @@ GEXTEND Gram
   ;
   (* Simple definitions *)
   def_body:
-    [ [ bl = LIST0 binder_let; ":="; red = reduce; c = lconstr ->
+    [ [ bl = binders_let; ":="; red = reduce; c = lconstr ->
       (match c with
           CCast(_,c, Rawterm.CastConv (k,t)) -> DefineBody (bl, red, c, Some t)
         | _ -> DefineBody (bl, red, c, None))
-      | bl = LIST0 binder_let; ":"; t = lconstr; ":="; red = reduce; c = lconstr ->
-          DefineBody (bl, red, c, Some t)
-      | bl = LIST0 binder_let; ":"; t = lconstr ->
-          ProveBody (bl, t) ] ]
+    | bl = binders_let; ":"; t = lconstr; ":="; red = reduce; c = lconstr ->
+	DefineBody (bl, red, c, Some t)
+    | bl = binders_let; ":"; t = lconstr ->
+        ProveBody (bl, t) ] ]
   ;
   reduce:
     [ [ IDENT "Eval"; r = Tactic.red_expr; "in" -> Some r
@@ -221,7 +237,8 @@ GEXTEND Gram
     ;
   (* Inductives and records *)
   inductive_definition:
-    [ [ id = identref; indpar = LIST0 binder_let; ":"; c = lconstr;
+    [ [ id = identref; indpar = binders_let; 
+        c = [ ":"; c = lconstr -> c | -> CSort (loc,Rawterm.RType None) ];
         ":="; lc = constructor_list; ntn = decl_notation ->
 	  ((id,indpar,c,lc),ntn) ] ]
   ;
@@ -241,49 +258,49 @@ GEXTEND Gram
   ;
   (* (co)-fixpoints *)
   rec_definition:
-    [ [ id = ident; bl = LIST1 binder_let;
-        annot = rec_annotation; ty = type_cstr; 
+    [ [ id = identref; 
+	bl = binders_let_fixannot;
+        ty = type_cstr; 
 	":="; def = lconstr; ntn = decl_notation ->
-          let names = List.map snd (names_of_local_assums bl) in
+	  let bl, annot = bl in
+          let names = names_of_local_assums bl in
           let ni =
             match fst annot with
-                Some id ->
-                  (try Some (list_index (Name id) names - 1)
-                   with Not_found ->  Util.user_err_loc
-                     (loc,"Fixpoint",
+                Some (loc, id) ->
+                  (if List.exists (fun (_, id') -> Name id = id') names then
+		    Some (loc, id)
+		    else Util.user_err_loc
+                      (loc,"Fixpoint",
                       Pp.str "No argument named " ++ Nameops.pr_id id))
               | None -> 
 		  (* If there is only one argument, it is the recursive one, 
 		     otherwise, we search the recursive index later *)
-		  if List.length names = 1 then Some 0 else None	  
+		  match names with
+		    | [(loc, Name na)] -> Some (loc, na)
+		    | _ -> None	  
 	  in 
 	  ((id,(ni,snd annot),bl,ty,def),ntn) ] ]
   ;
   corec_definition:
-    [ [ id = ident; bl = LIST0 binder_let; ty = type_cstr; ":=";
+    [ [ id = identref; bl = binders_let; ty = type_cstr; ":=";
         def = lconstr; ntn = decl_notation ->
           ((id,bl,ty,def),ntn) ] ]
   ;
-  rec_annotation:
-    [ [ "{"; IDENT "struct"; id=IDENT; "}" -> (Some (id_of_string id), CStructRec)
-      | "{"; IDENT "wf"; rel=constr; id=OPT IDENT; "}" -> (option_map id_of_string id, CWfRec rel) 
-      | "{"; IDENT "measure"; rel=constr; id=OPT IDENT; "}" -> (option_map id_of_string id, CMeasureRec rel) 
-      | ->  (None, CStructRec)
-      ] ]
-  ;
   type_cstr:
     [ [ ":"; c=lconstr -> c 
-      | -> CHole loc ] ]
+      | -> CHole (loc, None) ] ]
   ;
   (* Inductive schemes *)
   scheme:
-    [ [ id = identref; ":="; dep = dep_scheme; "for"; ind = global;
-        IDENT "Sort"; s = sort ->
-          (id,dep,ind,s) ] ]
+    [ [ kind = scheme_kind -> (None,kind)
+      | id = identref; ":="; kind = scheme_kind -> (Some id,kind) ] ]
   ;
-  dep_scheme:
-    [ [ IDENT "Induction" -> true
-      | IDENT "Minimality" -> false ] ]
+  scheme_kind:
+    [ [ IDENT "Induction"; "for"; ind = global;
+          IDENT "Sort"; s = sort-> InductionScheme(true,ind,s)
+      | IDENT "Minimality"; "for"; ind = global;
+          IDENT "Sort"; s = sort-> InductionScheme(false,ind,s)
+      | IDENT "Equality"; "for" ; ind = global -> EqualityScheme(ind)  ] ]
   ;
   (* Various Binders *)
 (*
@@ -299,7 +316,7 @@ GEXTEND Gram
 *)
   (* ... with coercions *)
   record_field:
-    [ [ id = name -> (false,AssumExpr(id,CHole loc))
+    [ [ id = name -> (false,AssumExpr(id,CHole (loc, None)))
       | id = name; oc = of_type_with_opt_coercion; t = lconstr ->
          (oc,AssumExpr (id,t))
       | id = name; oc = of_type_with_opt_coercion;
@@ -320,11 +337,11 @@ GEXTEND Gram
         (oc,(idl,c)) ] ]
   ;
   constructor:
-    [ [ id = identref; l = LIST0 binder_let; 
+    [ [ id = identref; l = binders_let; 
         coe = of_type_with_opt_coercion; c = lconstr ->
-	  (coe,(id,G_constr.mkCProdN loc l c))
-      | id = identref; l = LIST0 binder_let ->
-	  (false,(id,G_constr.mkCProdN loc l (CHole loc))) ] ]
+	  (coe,(id,mkCProdN loc l c))
+      | id = identref; l = binders_let ->
+	  (false,(id,mkCProdN loc l (CHole (loc, None)))) ] ]
   ;
   of_type_with_opt_coercion:
     [ [ ":>" -> true
@@ -360,25 +377,20 @@ GEXTEND Gram
       | IDENT "End"; id = identref -> VernacEndSegment id
 
       (* Requiring an already compiled module *)
-      | IDENT "Require"; export = export_token; specif = specif_token;
-        qidl = LIST1 global ->
-          VernacRequire (export, specif, qidl)
-      | IDENT "Require"; export = export_token; specif = specif_token;
-        filename = ne_string -> 
-	  VernacRequireFrom (export, specif, filename)
+      | IDENT "Require"; export = export_token; qidl = LIST1 global ->
+          VernacRequire (export, None, qidl)
+      | IDENT "Require"; export = export_token; filename = ne_string -> 
+	  VernacRequireFrom (export, None, filename)
       | IDENT "Import"; qidl = LIST1 global -> VernacImport (false,qidl)
-      | IDENT "Export"; qidl = LIST1 global -> VernacImport (true,qidl) ] ]
+      | IDENT "Export"; qidl = LIST1 global -> VernacImport (true,qidl) 
+      | IDENT "Include"; expr = module_expr -> VernacInclude(CIME(expr))
+      | IDENT "Include"; "Type"; expr = module_type -> VernacInclude(CIMTE(expr)) ] ]
   ;
   export_token:
     [ [ IDENT "Import" -> Some false
       | IDENT "Export" -> Some true
       |  -> None ] ]
   ;
-  specif_token:
-    [ [ IDENT "Implementation" -> Some false
-      | IDENT "Specification" -> Some true
-      |  -> None ] ]
-  ;
   of_module_type:
     [ [ ":"; mty = module_type -> (mty, true) 
       | "<:"; mty = module_type -> (mty, false) ] ]
@@ -398,12 +410,13 @@ GEXTEND Gram
 
   (* Module expressions *)
   module_expr:
-    [ [ qid = qualid -> CMEident qid
-      | me1 = module_expr; me2 = module_expr -> CMEapply (me1,me2)
-      | "("; me = module_expr; ")" -> me
-(* ... *)
+    [ [ me = module_expr_atom -> me
+      | me1 = module_expr; me2 = module_expr_atom -> CMEapply (me1,me2)
       ] ]
   ;
+  module_expr_atom:
+    [ [ qid = qualid -> CMEident qid | "("; me = module_expr; ")" -> me ] ]
+  ;
   with_declaration:
     [ [ "Definition"; fqid = fullyqualid; ":="; c = Constr.lconstr ->
           CWith_Definition (fqid,c)
@@ -414,8 +427,9 @@ GEXTEND Gram
   module_type:
     [ [ qid = qualid -> CMTEident qid
 (* ... *)
-      | mty = module_type; "with"; decl = with_declaration -> 
-	  CMTEwith (mty,decl) ] ]
+      | mty = module_type; me = module_expr_atom -> CMTEapply (mty,me) 
+      | mty = module_type; "with"; decl = with_declaration -> CMTEwith (mty,decl)
+      ] ]
   ;
 END
 
@@ -425,9 +439,16 @@ GEXTEND Gram
 
   gallina_ext:
     [ [ (* Transparent and Opaque *)
-        IDENT "Transparent"; l = LIST1 global -> VernacSetOpacity (false, l)
-      | IDENT "Opaque"; l = LIST1 global -> VernacSetOpacity (true, l)
-
+        IDENT "Transparent"; l = LIST1 global ->
+          VernacSetOpacity (true,[Conv_oracle.transparent,l])
+      | IDENT "Opaque"; l = LIST1 global ->
+          VernacSetOpacity (true,[Conv_oracle.Opaque, l])
+      | IDENT "Strategy"; l =
+          LIST1 [ lev=strategy_level; "["; q=LIST1 global; "]" -> (lev,q)] ->
+            VernacSetOpacity (false,l)
+      | IDENT "Local"; IDENT "Strategy"; l =
+          LIST1 [ lev=strategy_level; "["; q=LIST1 global; "]" -> (lev,q)] ->
+            VernacSetOpacity (true,l)
       (* Canonical structure *)
       | IDENT "Canonical"; IDENT "Structure"; qid = global ->
 	  VernacCanonical qid
@@ -457,15 +478,77 @@ GEXTEND Gram
          t = class_rawexpr ->
 	  VernacCoercion (Global, qid, s, t)
 
+      (* Type classes, new syntax without artificial sup. *)
+      | IDENT "Class"; qid = identref; pars = binders_let;
+	 s = [ ":"; c = sort -> Some (loc, c) | -> None ];
+	 props = typeclass_field_types ->
+	   VernacClass (qid, pars, s, [], props)
+
+      (* Type classes *)
+      | IDENT "Class"; sup = OPT [ l = binders_let; "=>" -> l ];
+	 qid = identref; pars = binders_let;
+	 s = [ ":"; c = sort -> Some (loc, c) | -> None ];
+	 props = typeclass_field_types ->
+	   VernacClass (qid, pars, s, (match sup with None -> [] | Some l -> l), props)
+	     
+      | IDENT "Context"; c = typeclass_context -> 
+	  VernacContext c
+	    
+      | global = [ IDENT "Global" -> true | -> false ];
+	 IDENT "Instance"; name = identref; sup = OPT binders_let; ":";
+	 expl = [ "!" -> Rawterm.Implicit | -> Rawterm.Explicit ] ; t = operconstr LEVEL "200";
+	 pri = OPT [ "|"; i = natural -> i ] ; props = typeclass_field_defs ->
+	   let sup =
+	     match sup with
+		 None -> []
+	       | Some l -> l
+	   in
+	   let n = 
+	     let (loc, id) = name in 
+	       (loc, Name id)
+	   in
+	     VernacInstance (global, sup, (n, expl, t), props, pri)
+
+      | IDENT "Existing"; IDENT "Instance"; is = identref -> VernacDeclareInstance is
+
       (* Implicit *)
-      | IDENT "Implicit"; IDENT "Arguments"; qid = global; 
-         pos = OPT [ "["; l = LIST0 ident; "]" -> l ] ->
-	   let pos = option_map (List.map (fun id -> ExplByName id)) pos in
-	   VernacDeclareImplicits (true,qid,pos)
+      | IDENT "Implicit"; IDENT "Arguments"; 
+	   local = [ IDENT "Global" -> false | IDENT "Local" -> true | -> Lib.sections_are_opened () ]; 
+	   qid = global; 
+	   pos = OPT [ "["; l = LIST0 implicit_name; "]" -> 
+	     List.map (fun (id,b,f) -> (ExplByName id,b,f)) l ] ->
+	   VernacDeclareImplicits (local,qid,pos)
 
       | IDENT "Implicit"; ["Type" | IDENT "Types"];
 	   idl = LIST1 identref; ":"; c = lconstr -> VernacReserve (idl,c) ] ]
   ;
+  implicit_name:
+    [ [ "!"; id = ident -> (id, false, true)
+    | id = ident -> (id,false,false)
+    | "["; "!"; id = ident; "]" -> (id,true,true) 
+    | "["; id = ident; "]" -> (id,true, false) ] ]
+  ;
+  typeclass_field_type:
+    [ [ id = identref; oc = of_type_with_opt_coercion; t = lconstr -> id, oc, t ] ]
+  ;
+  typeclass_field_def:
+    [ [ id = identref; params = LIST0 identref; ":="; t = lconstr -> id, params, t ] ]
+  ;
+  typeclass_field_types:
+    [ [ ":="; l = LIST1 typeclass_field_type SEP ";" -> l
+    | -> [] ] ]
+  ;
+  typeclass_field_defs:
+    [ [ ":="; l = LIST1 typeclass_field_def SEP ";" -> l
+    | -> [] ] ]
+  ;
+  strategy_level:
+    [ [ IDENT "expand" -> Conv_oracle.Expand
+      | IDENT "opaque" -> Conv_oracle.Opaque
+      | n=INT -> Conv_oracle.Level (int_of_string n)
+      | "-"; n=INT -> Conv_oracle.Level (- int_of_string n)
+      | IDENT "transparent" -> Conv_oracle.transparent ] ]
+  ;
 END
 
 GEXTEND Gram
@@ -544,48 +627,35 @@ GEXTEND Gram
 	  VernacAddMLPath (true, dir)
 
       (* Pour intervenir sur les tables de param��tres *)
-      | "Set"; table = IDENT; field = IDENT; v = option_value ->
-  	  VernacSetOption (SecondaryTable (table,field),v)
-      | "Set"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
-  	  VernacAddOption (SecondaryTable (table,field),lv)
-      | "Set"; table = IDENT; field = IDENT ->
-  	  VernacSetOption (SecondaryTable (table,field),BoolValue true)
-      | IDENT "Unset"; table = IDENT; field = IDENT ->
-  	  VernacUnsetOption (SecondaryTable (table,field))
-      | IDENT "Unset"; table = IDENT; field = IDENT; lv = LIST1 option_ref_value ->
-  	  VernacRemoveOption (SecondaryTable (table,field),lv)
-      | "Set"; table = IDENT; value = option_value ->
-  	  VernacSetOption (PrimaryTable table, value)
-      | "Set"; table = IDENT ->
-  	  VernacSetOption (PrimaryTable table, BoolValue true)
-      | IDENT "Unset"; table = IDENT ->
-  	  VernacUnsetOption (PrimaryTable table)
-
-      | IDENT "Print"; IDENT "Table"; table = IDENT; field = IDENT ->
-	  VernacPrintOption (SecondaryTable (table,field))
-      | IDENT "Print"; IDENT "Table"; table = IDENT ->
-	  VernacPrintOption (PrimaryTable table)
+      | "Set"; table = option_table; v = option_value ->
+  	  VernacSetOption (table,v)
+      | "Set"; table = option_table ->
+  	  VernacSetOption (table,BoolValue true)
+      | IDENT "Unset"; table = option_table ->
+  	  VernacUnsetOption table
+
+      | IDENT "Print"; IDENT "Table"; table = option_table ->
+	  VernacPrintOption table
 
       | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
         -> VernacAddOption (SecondaryTable (table,field), v)
-
       (* Un value global ci-dessous va ��tre cach�� par un field au dessus! *)
+      (* En fait, on donne priorit�� aux tables secondaires *)
+      (* Pas de syntaxe pour les tables tertiaires pour cause de conflit *)
+      (* (mais de toutes fa��ons, pas utilis��es) *)
       | IDENT "Add"; table = IDENT; v = LIST1 option_ref_value ->
           VernacAddOption (PrimaryTable table, v)
 
-      | IDENT "Test"; table = IDENT; field = IDENT; v = LIST1 option_ref_value
-        -> VernacMemOption (SecondaryTable (table,field), v)
-      | IDENT "Test"; table = IDENT; field = IDENT ->
-          VernacPrintOption (SecondaryTable (table,field))
-      | IDENT "Test"; table = IDENT; v = LIST1 option_ref_value ->
-          VernacMemOption (PrimaryTable table, v)
-      | IDENT "Test"; table = IDENT ->
-          VernacPrintOption (PrimaryTable table)
+      | IDENT "Test"; table = option_table; "for"; v = LIST1 option_ref_value
+        -> VernacMemOption (table, v)
+      | IDENT "Test"; table = option_table ->
+          VernacPrintOption table
 
       | IDENT "Remove"; table = IDENT; field = IDENT; v= LIST1 option_ref_value
         -> VernacRemoveOption (SecondaryTable (table,field), v)
       | IDENT "Remove"; table = IDENT; v = LIST1 option_ref_value ->
 	  VernacRemoveOption (PrimaryTable table, v) 
+
       | IDENT "proof" -> VernacDeclProof
       | "return" -> VernacReturn ]]
   ;
@@ -601,14 +671,18 @@ GEXTEND Gram
       | IDENT "Section"; s = global -> PrintSectionContext s
       | IDENT "Grammar"; ent = IDENT ->
           (* This should be in "syntax" section but is here for factorization*)
-	  PrintGrammar ("", ent)
+	  PrintGrammar ent
       | IDENT "LoadPath" -> PrintLoadPath
-      | IDENT "Modules" -> PrintModules
+      | IDENT "Modules" -> 
+          error "Print Modules is obsolete; use Print Libraries instead"
+      | IDENT "Libraries" -> PrintModules
 
       | IDENT "ML"; IDENT "Path" -> PrintMLLoadPath
       | IDENT "ML"; IDENT "Modules" -> PrintMLModules
       | IDENT "Graph" -> PrintGraph
       | IDENT "Classes" ->  PrintClasses
+      | IDENT "TypeClasses" -> PrintTypeClasses
+      | IDENT "Instances"; qid = global -> PrintInstances qid
       | IDENT "Ltac"; qid = global -> PrintLtac qid
       | IDENT "Coercions" -> PrintCoercions
       | IDENT "Coercion"; IDENT "Paths"; s = class_rawexpr; t = class_rawexpr
@@ -628,7 +702,8 @@ GEXTEND Gram
       | IDENT "Scope"; s = IDENT -> PrintScope s
       | IDENT "Visibility"; s = OPT IDENT -> PrintVisibility s
       | IDENT "Implicit"; qid = global -> PrintImplicit qid
-      | IDENT "Universes"; fopt = OPT ne_string -> PrintUniverses fopt ] ]
+      | IDENT "Universes"; fopt = OPT ne_string -> PrintUniverses fopt
+      | IDENT "Assumptions"; qid = global -> PrintAssumptions qid ] ]
   ;
   class_rawexpr:
     [ [ IDENT "Funclass" -> FunClass
@@ -650,6 +725,11 @@ GEXTEND Gram
     [ [ id = global   -> QualidRefValue id
       | s  = STRING   -> StringRefValue s ] ]
   ;
+  option_table:
+    [ [ f1 = IDENT; f2 = IDENT; f3 = IDENT -> TertiaryTable (f1,f2,f3)
+      | f1 = IDENT; f2 = IDENT -> SecondaryTable (f1,f2)
+      | f1 = IDENT -> PrimaryTable f1 ] ]
+  ;
   as_dirpath:
     [ [ d = OPT [ "as"; d = dirpath -> d ] -> d ] ]
   ;
@@ -676,6 +756,7 @@ GEXTEND Gram
 
 (* Resetting *)
       | IDENT "Reset"; id = identref -> VernacResetName id
+      | IDENT "Delete"; id = identref -> VernacRemoveName id
       | IDENT "Reset"; IDENT "Initial" -> VernacResetInitial
       | IDENT "Back" -> VernacBack 1
       | IDENT "Back"; n = natural -> VernacBack n
@@ -712,17 +793,18 @@ GEXTEND Gram
      | IDENT "Bind"; IDENT "Scope"; sc = IDENT; "with"; 
        refl = LIST1 class_rawexpr -> VernacBindScope (sc,refl)
 
-     | IDENT "Arguments"; IDENT "Scope"; qid = global;
-       "["; scl = LIST0 opt_scope; "]" -> VernacArgumentsScope (true,qid,scl)
+     | IDENT "Arguments"; IDENT "Scope"; local = non_globality; qid = global;
+       "["; scl = LIST0 opt_scope; "]" -> VernacArgumentsScope (local,qid,scl)
 
      | IDENT "Infix"; local = locality;
 	 op = ne_string; ":="; p = global; 
          modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
 	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
          VernacInfix (local,(op,modl),p,sc)
-     | IDENT "Notation"; local = locality; id = ident; ":="; c = constr;
+     | IDENT "Notation"; local = locality; id = identref; idl = LIST0 ident; 
+	 ":="; c = constr;
 	 b = [ "("; IDENT "only"; IDENT "parsing"; ")" -> true | -> false ] ->
-           VernacSyntacticDefinition (id,c,local,b)
+           VernacSyntacticDefinition (id,(idl,c),local,b)
      | IDENT "Notation"; local = locality; s = ne_string; ":="; c = constr;
          modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
 	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
@@ -744,7 +826,10 @@ GEXTEND Gram
     [ [ "("; "at"; IDENT "level"; n = natural; ")" -> n | -> 0 ] ]
   ;
   locality:
-    [ [ IDENT "Local" -> true | -> false ] ]
+    [ [ IDENT "Global" -> false | IDENT "Local" -> true | -> false ] ]
+  ;
+  non_globality:
+    [ [ IDENT "Global" -> false | IDENT "Local" -> true | -> true ] ]
   ;
   level:
     [ [ IDENT "level"; n = natural -> NumLevel n
diff --git a/parsing/g_xml.ml4 b/parsing/g_xml.ml4
index ce284454..5b2d8668 100644
--- a/parsing/g_xml.ml4
+++ b/parsing/g_xml.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_xml.ml4 10090 2007-08-24 10:53:53Z herbelin $ *)
+(*i camlp4use: "pa_extend.cmo" i*)
+
+(* $Id: g_xml.ml4 10727 2008-03-28 20:22:43Z msozeau $ *)
 
 open Pp
 open Util
@@ -139,12 +141,12 @@ let rec interp_xml_constr = function
   | XmlTag (loc,"LAMBDA",al,(_::_ as xl)) ->
       let body,decls = list_sep_last xl in
       let ctx = List.map interp_xml_decl decls in
-      List.fold_right (fun (na,t) b -> RLambda (loc, na, t, b))
+      List.fold_right (fun (na,t) b -> RLambda (loc, na, Explicit, t, b))
 	ctx (interp_xml_target body)
   | XmlTag (loc,"PROD",al,(_::_ as xl)) ->
       let body,decls = list_sep_last xl in
       let ctx = List.map interp_xml_decl decls in
-      List.fold_right (fun (na,t) b -> RProd (loc, na, t, b))
+      List.fold_right (fun (na,t) b -> RProd (loc, na, Explicit, t, b))
 	ctx (interp_xml_target body)
   | XmlTag (loc,"LETIN",al,(_::_ as xl)) ->
       let body,defs = list_sep_last xl in
@@ -169,7 +171,7 @@ let rec interp_xml_constr = function
       let mat = simple_cases_matrix_of_branches ind brns brs in
       let nparams,n = compute_inductive_nargs ind in
       let nal,rtn = return_type_of_predicate ind nparams n p in
-      RCases (loc,rtn,[tm,nal],mat)
+      RCases (loc,RegularStyle,rtn,[tm,nal],mat)
   | XmlTag (loc,"MUTIND",al,[]) ->
       RRef (loc, IndRef (get_xml_inductive al))
   | XmlTag (loc,"MUTCONSTRUCT",al,[]) ->
diff --git a/parsing/g_zsyntax.ml b/parsing/g_zsyntax.ml
index 554040d1..aab266c0 100644
--- a/parsing/g_zsyntax.ml
+++ b/parsing/g_zsyntax.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_zsyntax.ml 7988 2006-02-04 20:28:29Z herbelin $ *)
+(* $Id: g_zsyntax.ml 10806 2008-04-16 23:51:06Z letouzey $ *)
 
 open Pcoq
 open Pp
diff --git a/parsing/lexer.ml4 b/parsing/lexer.ml4
index 80eaf7f0..c1e4cfc6 100644
--- a/parsing/lexer.ml4
+++ b/parsing/lexer.ml4
@@ -6,9 +6,15 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: lexer.ml4 9015 2006-07-05 17:19:22Z herbelin $ i*)
+(*i $Id: lexer.ml4 11059 2008-06-06 09:29:20Z herbelin $ i*)
+
+
+(*i camlp4use: "pr_o.cmo" i*) 
+(* Add pr_o.cmo to circumvent a useless-warning bug when preprocessed with
+ * ast-based camlp4 *)
 
 open Pp
+open Util
 open Token
 
 (* Dictionaries: trees annotated with string options, each node being a map
@@ -71,8 +77,10 @@ let bad_token str = raise (Error (Bad_token str))
 
 (* Lexer conventions on tokens *)
 
-type utf8_token =
-    Utf8Letter of int | Utf8IdentPart of int | Utf8Symbol | AsciiChar
+type token_kind =
+  | Utf8Token of (utf8_status * int)
+  | AsciiChar
+  | EmptyStream
 
 let error_unsupported_unicode_character n cs =
   let bp = Stream.count cs in
@@ -80,6 +88,7 @@ let error_unsupported_unicode_character n cs =
 
 let error_utf8 cs =
   let bp = Stream.count cs in
+  Stream.junk cs; (* consume the char to avoid read it and fail again *)
   err (bp, bp+1) Illegal_character
 
 let njunk n = Util.repeat n Stream.junk
@@ -115,114 +124,14 @@ let lookup_utf8_tail c cs =
 	  (Char.code c3 land 0x3F) lsl 6 + (Char.code c4 land 0x3F)
       | _ -> error_utf8 cs
     in
-    match unicode land 0x1F000 with
-    | 0x0 ->
-    begin match unicode with
-    (* utf-8 Latin-1 non breaking space U00A0 *)
-    | 0x00A0 -> Utf8Letter n
-    (* utf-8 Latin-1 symbols U00A1-00BF *)
-    | x when 0x00A0 <= x & x <= 0x00BF -> Utf8Symbol
-    (* utf-8 Latin-1 letters U00C0-00D6 *)
-    | x when 0x00C0 <= x & x <= 0x00D6 -> Utf8Letter n
-    (* utf-8 Latin-1 symbol U00D7 *)
-    | 0x00D7 -> Utf8Symbol
-    (* utf-8 Latin-1 letters U00D8-00F6 *)
-    | x when 0x00D8 <= x & x <= 0x00F6 -> Utf8Letter n
-    (* utf-8 Latin-1 symbol U00F7 *)
-    | 0x00F7 -> Utf8Symbol
-    (* utf-8 Latin-1 letters U00F8-00FF *)
-    | x when 0x00F8 <= x & x <= 0x00FF -> Utf8Letter n
-    (* utf-8 Latin Extended A U0100-017F and Latin Extended B U0180-U0241 *)
-    | x when 0x0100 <= x & x <= 0x0241 -> Utf8Letter n
-    (* utf-8 Phonetic letters U0250-02AF *)
-    | x when 0x0250 <= x & x <= 0x02AF -> Utf8Letter n
-    (* utf-8 what do to with diacritics U0300-U036F ? *)
-    (* utf-8 Greek letters U0380-03FF *)
-    | x when 0x0380 <= x & x <= 0x03FF -> Utf8Letter n
-    (* utf-8 Cyrillic letters U0400-0481 *)
-    | x when 0x0400 <= x & x <= 0x0481 -> Utf8Letter n
-    (* utf-8 Cyrillic symbol U0482 *)
-    | 0x0482 -> Utf8Symbol
-    (* utf-8 what do to with diacritics U0483-U0489 \ U0487 ? *)
-    (* utf-8 Cyrillic letters U048A-U4F9 (Warning: 04CF) *)
-    | x when 0x048A <= x & x <= 0x04F9 -> Utf8Letter n
-    (* utf-8 Cyrillic supplement letters U0500-U050F *)
-    | x when 0x0500 <= x & x <= 0x050F -> Utf8Letter n
-    (* utf-8 Hebrew letters U05D0-05EA *)
-    | x when 0x05D0 <= x & x <= 0x05EA -> Utf8Letter n
-    (* utf-8 Arabic letters U0621-064A *)
-    | x when 0x0621 <= x & x <= 0x064A -> Utf8Letter n
-    (* utf-8 Arabic supplement letters U0750-076D *)
-    | x when 0x0750 <= x & x <= 0x076D -> Utf8Letter n
-    | _ -> error_unsupported_unicode_character n cs
-    end
-    | 0x1000 ->
-    begin match unicode with
-    (* utf-8 Georgian U10A0-10FF (has holes) *)
-    | x when 0x10A0 <= x & x <= 0x10FF -> Utf8Letter n
-    (* utf-8 Hangul Jamo U1100-11FF (has holes) *)
-    | x when 0x1100 <= x & x <= 0x11FF -> Utf8Letter n
-    (* utf-8 Latin additional letters U1E00-1E9B and U1EA0-1EF9 *)
-    | x when 0x1E00 <= x & x <= 0x1E9B -> Utf8Letter n
-    | x when 0x1EA0 <= x & x <= 0x1EF9 -> Utf8Letter n
-    | _ -> error_unsupported_unicode_character n cs
-    end
-    | 0x2000 ->
-    begin match unicode with
-    (* utf-8 general punctuation U2080-2089 *)
-    (* Hyphens *)
-    | x when 0x2010 <= x & x <= 0x2011 -> Utf8Letter n 
-    (* Dashes and other symbols *)
-    | x when 0x2012 <= x & x <= 0x2027 -> Utf8Symbol
-    (* Per mille and per ten thousand signs *)
-    | x when 0x2030 <= x & x <= 0x2031 -> Utf8Symbol
-    (* Prime letters *)
-    | x when 0x2032 <= x & x <= 0x2034 or x = 0x2057 -> Utf8IdentPart n
-    (* Miscellaneous punctuation *)
-    | x when 0x2039 <= x & x <= 0x2056 -> Utf8Symbol
-    | x when 0x2058 <= x & x <= 0x205E -> Utf8Symbol
-    (* Invisible mathematical operators *)
-    | x when 0x2061 <= x & x <= 0x2063 -> Utf8Symbol
-
-    (* utf-8 subscript U2080-2089 *) 
-    | x when 0x2080 <= x & x <= 0x2089 -> Utf8IdentPart n
-    (* utf-8 letter-like U2100-214F *)
-    | x when 0x2100 <= x & x <= 0x214F -> Utf8Letter n
-    (* utf-8 number-forms U2153-2183 *)
-    | x when 0x2153 <= x & x <= 0x2183 -> Utf8Symbol
-    (* utf-8 arrows A U2190-21FF *)
-    (* utf-8 mathematical operators U2200-22FF *)
-    (* utf-8 miscellaneous technical U2300-23FF *)
-    | x when 0x2190 <= x & x <= 0x23FF -> Utf8Symbol
-    (* utf-8 box drawing U2500-257F has ceiling, etc. *)
-    (* utf-8 block elements U2580-259F *)
-    (* utf-8 geom. shapes U25A0-25FF (has triangles, losange, etc) *)
-    (* utf-8 miscellaneous symbols U2600-26FF *)
-    | x when 0x2500 <= x & x <= 0x26FF -> Utf8Symbol
-    (* utf-8 arrows B U2900-297F *)
-    | x when 0x2900 <= x & x <= 0x297F -> Utf8Symbol
-    (* utf-8 mathematical operators U2A00-2AFF *)
-    | x when 0x2A00 <= x & x <= 0x2AFF -> Utf8Symbol
-    | _ -> error_unsupported_unicode_character n cs
-    end
-    | _ ->
-    begin match unicode with
-    (* utf-8 Hiragana U3040-309F and Katakana U30A0-30FF *)
-    | x when 0x3040 <= x & x <= 0x30FF -> Utf8Letter n
-    (* utf-8 Unified CJK Ideographs U4E00-9FA5 *)
-    | x when 0x4E00 <= x & x <= 0x9FA5 -> Utf8Letter n
-    (* utf-8 Hangul syllables UAC00-D7AF *)
-    | x when 0xAC00 <= x & x <= 0xD7AF -> Utf8Letter n
-    (* utf-8 Gothic U10330-1034A *)
-    | x when 0x10330 <= x & x <= 0x1034A -> Utf8Letter n
-    | _ -> error_unsupported_unicode_character n cs
-    end
+    try classify_unicode unicode, n
+    with UnsupportedUtf8 -> error_unsupported_unicode_character n cs
 	
 let lookup_utf8 cs =
   match Stream.peek cs with
-    | Some ('\x00'..'\x7F') -> Some AsciiChar
-    | Some ('\x80'..'\xFF' as c) -> Some (lookup_utf8_tail c cs)
-    | None -> None
+    | Some ('\x00'..'\x7F') -> AsciiChar
+    | Some ('\x80'..'\xFF' as c) -> Utf8Token (lookup_utf8_tail c cs)
+    | None -> EmptyStream
 
 let check_special_token str =
   let rec loop_symb = parser
@@ -234,16 +143,16 @@ let check_special_token str =
 
 let check_ident str =
   let rec loop_id intail = parser
-    | [< ' ('$' | 'a'..'z' | 'A'..'Z' | '_'); s >] ->
+    | [< ' ('a'..'z' | 'A'..'Z' | '_'); s >] ->
         loop_id true s
     | [< ' ('0'..'9' | ''') when intail; s >] ->
         loop_id true s
     | [< s >] ->
 	match lookup_utf8 s with
-	| Some (Utf8Letter n) -> njunk n s; loop_id true s
-	| Some (Utf8IdentPart n) when intail -> njunk n s; loop_id true s
-	| Some _ -> bad_token str
-	| None -> ()
+	| Utf8Token (UnicodeLetter, n) -> njunk n s; loop_id true s
+	| Utf8Token (UnicodeIdentPart, n) when intail -> njunk n s; loop_id true s
+	| EmptyStream -> ()
+	| Utf8Token _ | AsciiChar -> bad_token str
   in
   loop_id false (Stream.of_string str)
 
@@ -266,7 +175,7 @@ let add_keyword str =
 (* Adding a new token (keyword or special token). *)
 let add_token (con, str) = match con with
   | "" -> add_keyword str
-  | "METAIDENT" | "IDENT" | "FIELD" | "INT" | "STRING" | "EOI"
+  | "METAIDENT" | "PATTERNIDENT" | "IDENT" | "FIELD" | "INT" | "STRING" | "EOI"
       -> ()
   | _ ->
       raise (Token.Error ("\
@@ -308,7 +217,7 @@ let rec ident_tail len = parser
       ident_tail (store len c) s
   | [< s >] ->
       match lookup_utf8 s with
-      | Some (Utf8IdentPart n | Utf8Letter n) ->
+      | Utf8Token ((UnicodeIdentPart | UnicodeLetter), n) ->
 	  ident_tail (nstore n len s) s
       | _ -> len
 
@@ -368,10 +277,10 @@ let null_comment s =
 
 let comment_stop ep =
   let current_s = Buffer.contents current in
-  if !Options.xml_export && Buffer.length current > 0 &&
+  if !Flags.xml_export && Buffer.length current > 0 &&
     (!between_com || not(null_comment current_s)) then
       !xml_output_comment current_s;
-  (if Options.do_translate() && Buffer.length current > 0 &&
+  (if Flags.do_translate() && Buffer.length current > 0 &&
     (!between_com || not(null_comment current_s)) then
     let bp = match !comment_begin with
         Some bp -> bp
@@ -406,7 +315,7 @@ let rec comment bp = parser bp2
          | [< '')' >] -> push_string "*)";
          | [< s >] -> real_push_char '*'; comment bp s >] -> ()
   | [< ''"'; s >] ->
-      if Options.do_translate() then (push_string"\"";comm_string bp2 s)
+      if Flags.do_translate() then (push_string"\"";comm_string bp2 s)
       else ignore (string bp2 0 s);
       comment bp s
   | [< _ = Stream.empty >] ep -> err (bp, ep) Unterminated_comment
@@ -457,27 +366,30 @@ let process_chars bp c cs =
     | Some t -> (("", t), (bp, ep))
     | None -> err (bp, ep) Undefined_token
 
-(* Parse what follows a dot *)
-let parse_after_dot bp c = parser
+(* Parse what follows a dot/question mark *)
+let parse_after_dot bp c =
+  let constructor = if c = '?' then "PATTERNIDENT" else "FIELD" in
+  parser
   | [< ' ('a'..'z' | 'A'..'Z' | '_' as c); len = ident_tail (store 0 c) >] ->
-      ("FIELD", get_buff len)
+      (constructor, get_buff len)
   | [< s >] ->
       match lookup_utf8 s with
-      | Some (Utf8Letter n) -> 
-	  ("FIELD", get_buff (ident_tail (nstore n 0 s) s))
-      | Some (Utf8IdentPart _ | AsciiChar | Utf8Symbol) | None -> 
+      | Utf8Token (UnicodeLetter, n) -> 
+	  (constructor, get_buff (ident_tail (nstore n 0 s) s))
+      | AsciiChar | Utf8Token _ | EmptyStream -> 
 	  fst (process_chars bp c s)
 
 (* Parse a token in a char stream *)
 let rec next_token = parser bp
   | [< '' ' | '\t' | '\n' |'\r' as c; s >] ->
       comm_loc bp; push_char c; next_token s
-  | [< ''$'; len = ident_tail (store 0 '$') >] ep -> 
+  | [< ''$'; ' ('a'..'z' | 'A'..'Z' | '_' as c); 
+      len = ident_tail (store 0 c) >] ep -> 
       comment_stop bp;
       (("METAIDENT", get_buff len), (bp,ep))
-  | [< ''.' as c; t = parse_after_dot bp c >] ep ->
+  | [< ' ('.' | '?') as c; t = parse_after_dot bp c >] ep ->
       comment_stop bp;
-      if Options.do_translate() & t=("",".") then between_com := true;
+      if Flags.do_translate() & t=("",".") then between_com := true;
       (t, (bp,ep))
   | [< ' ('a'..'z' | 'A'..'Z' | '_' as c);
        len = ident_tail (store 0 c) >] ep ->
@@ -501,16 +413,16 @@ let rec next_token = parser bp
       t
   | [< s >] ->
       match lookup_utf8 s with
-	| Some (Utf8Letter n) ->
+	| Utf8Token (UnicodeLetter, n) ->
 	    let len = ident_tail (nstore n 0 s) s in
 	    let id = get_buff len in
 	    let ep = Stream.count s in
 	    comment_stop bp;
 	    (try ("",find_keyword id) with Not_found -> ("IDENT",id)), (bp, ep)
-	| Some (Utf8Symbol | AsciiChar | Utf8IdentPart _) -> 
+	| AsciiChar | Utf8Token ((UnicodeSymbol | UnicodeIdentPart), _) -> 
 	    let t = process_chars bp (Stream.next s) s in
 	    comment_stop bp; t
-	| None ->
+	| EmptyStream ->
 	    comment_stop bp; (("EOI", ""), (bp, bp + 1))
 
 (* Location table system for creating tables associating a token count
diff --git a/parsing/pcoq.ml4 b/parsing/pcoq.ml4
index bf3cb084..70a41ddc 100644
--- a/parsing/pcoq.ml4
+++ b/parsing/pcoq.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pcoq.ml4 10185 2007-10-06 18:05:13Z herbelin $ i*)
+(*i camlp4use: "pa_extend.cmo pa_macro.cmo" i*)
+
+(*i $Id: pcoq.ml4 10987 2008-05-26 12:28:36Z herbelin $ i*)
 
 open Pp
 open Util
@@ -70,11 +72,27 @@ module G = Grammar.Make(L)
 
 END
 
-let grammar_delete e rls =
+let grammar_delete e pos reinit rls =
   List.iter
-    (fun (_,_,lev) ->
-       List.iter (fun (pil,_) -> G.delete_rule e pil) (List.rev lev))
-    (List.rev rls)
+    (fun (n,ass,lev) ->
+
+      (* Caveat: deletion is not the converse of extension: when an
+	 empty level is extended, deletion removes the level instead
+	 of keeping it empty. This has an effect on the empty levels 8,
+	 99 and 200. We didn't find a good solution to this problem
+	 (e.g. using G.extend to know if the level exists results in a
+	 printed error message as side effect). As a consequence an
+	 extension at 99 or 8 (and for pattern 200 too) inside a section 
+         corrupts the parser. *)
+
+      List.iter (fun (pil,_) -> G.delete_rule e pil) (List.rev lev))
+    (List.rev rls);
+  if reinit <> None then
+    let lev = match pos with Some (Gramext.Level n) -> n | _ -> assert false in
+    let pos =
+      if lev = "200" then Gramext.First 
+      else Gramext.After (string_of_int (int_of_string lev + 1)) in
+    G.extend e (Some pos) [Some lev,reinit,[]];
 
 (* grammar_object is the superclass of all grammar entries *)
 module type Gramobj =
@@ -120,7 +138,8 @@ type ext_kind =
   | ByGrammar of
       grammar_object G.Entry.e * Gramext.position option *
       (string option * Gramext.g_assoc option *
-       (Compat.token Gramext.g_symbol list * Gramext.g_action) list) list
+       (Compat.token Gramext.g_symbol list * Gramext.g_action) list) list *
+        Gramext.g_assoc option
   | ByGEXTEND of (unit -> unit) * (unit -> unit)
 
 let camlp4_state = ref []
@@ -132,7 +151,7 @@ module Gram =
     include G
     let extend e pos rls =
       camlp4_state :=
-      (ByGEXTEND ((fun () -> grammar_delete e rls),
+      (ByGEXTEND ((fun () -> grammar_delete e pos None rls),
                   (fun () -> G.extend e pos rls)))
       :: !camlp4_state;
       G.extend e pos rls
@@ -149,9 +168,9 @@ let camlp4_verbosity silent f x =
 
 (* This extension command is used by the Grammar constr *)
 
-let grammar_extend te pos rls =
-  camlp4_state := ByGrammar (Gramobj.weaken_entry te,pos,rls) :: !camlp4_state;
-  camlp4_verbosity (Options.is_verbose ()) (G.extend te pos) rls
+let grammar_extend te pos reinit rls =
+  camlp4_state := ByGrammar (weaken_entry te,pos,rls,reinit) :: !camlp4_state;
+  camlp4_verbosity (Flags.is_verbose ()) (G.extend te pos) rls
 
 (* n is the number of extended entries (not the number of Grammar commands!)
    to remove. *)
@@ -159,8 +178,8 @@ let rec remove_grammars n =
   if n>0 then
     (match !camlp4_state with
        | [] -> anomaly "Pcoq.remove_grammars: too many rules to remove"
-       | ByGrammar(g,_,rls)::t ->
-           grammar_delete g rls;
+       | ByGrammar(g,pos,rls,reinit)::t ->
+           grammar_delete g pos reinit rls;
            camlp4_state := t;
            remove_grammars (n-1)
        | ByGEXTEND (undo,redo)::t ->
@@ -388,6 +407,8 @@ module Prim =
 
     let name = Gram.Entry.create "Prim.name"
     let identref = Gram.Entry.create "Prim.identref"
+    let pattern_ident = Gram.Entry.create "pattern_ident"
+    let pattern_identref = Gram.Entry.create "pattern_identref"
 
     (* A synonym of ident - maybe ident will be located one day *)
     let base_ident = Gram.Entry.create "Prim.base_ident"
@@ -421,6 +442,10 @@ module Constr =
     let lconstr_pattern = gec_constr "lconstr_pattern"
     let binder = Gram.Entry.create "constr:binder"
     let binder_let = Gram.Entry.create "constr:binder_let"
+    let binders_let = Gram.Entry.create "constr:binders_let"
+    let binders_let_fixannot = Gram.Entry.create "constr:binders_let_fixannot"
+    let typeclass_constraint = Gram.Entry.create "constr:typeclass_constraint"
+    let appl_arg = Gram.Entry.create "constr:appl_arg"
   end
 
 module Module =
@@ -501,27 +526,32 @@ END
    left border and into "constr LEVEL n" elsewhere), to the level below
    (to be translated into "NEXT") or to an below wrt associativity (to be
    translated in camlp4 into "constr" without level) or to another level
-   (to be translated into "constr LEVEL n") *)
+   (to be translated into "constr LEVEL n") 
+
+   The boolean is true if the entry was existing _and_ empty; this to
+   circumvent a weakness of camlp4/camlp5 whose undo mechanism is not the
+   converse of the extension mechanism *)
 
 let constr_level = string_of_int
 
 let default_levels =
-  [200,Gramext.RightA;
-   100,Gramext.RightA;
-   99,Gramext.RightA;
-   90,Gramext.RightA;
-   10,Gramext.RightA;
-   9,Gramext.RightA;
-   1,Gramext.LeftA;
-   0,Gramext.RightA]
+  [200,Gramext.RightA,false;
+   100,Gramext.RightA,false;
+   99,Gramext.RightA,true;
+   90,Gramext.RightA,false;
+   10,Gramext.RightA,false;
+   9,Gramext.RightA,false;
+   8,Gramext.RightA,true;
+   1,Gramext.LeftA,false;
+   0,Gramext.RightA,false]
 
 let default_pattern_levels =
-  [200,Gramext.RightA;
-   100,Gramext.RightA;
-   99,Gramext.RightA;
-   10,Gramext.LeftA;
-   1,Gramext.LeftA;
-   0,Gramext.RightA]
+  [200,Gramext.RightA,true;
+   100,Gramext.RightA,false;
+   99,Gramext.RightA,true;
+   10,Gramext.LeftA,false;
+   1,Gramext.LeftA,false;
+   0,Gramext.RightA,false]
 
 let level_stack = 
   ref [(default_levels, default_pattern_levels)]
@@ -550,40 +580,69 @@ let error_level_assoc p current expected =
      pr_assoc current ++ str " associative while it is now expected to be " ++
      pr_assoc expected ++ str " associative")
 
-let find_position forpat other assoc lev =
-  let ccurrent,pcurrent as current = List.hd !level_stack in 
+let find_position_gen forpat ensure assoc lev =
+  let ccurrent,pcurrent as current = List.hd !level_stack in
   match lev with
   | None ->
       level_stack := current :: !level_stack;
-      None, (if other then assoc else None), None
+      None, None, None, None
   | Some n ->
       let after = ref None in
+      let init = ref None in
       let rec add_level q = function
-        | (p,_ as pa)::l when p > n -> pa :: add_level (Some p) l
-        | (p,a)::l when p = n ->
-	    if admissible_assoc (a,assoc) then raise Exit;
-	    error_level_assoc p a (out_some assoc)
-	| l -> after := q; (n,create_assoc assoc)::l
+        | (p,_,_ as pa)::l when p > n -> pa :: add_level (Some p) l
+        | (p,a,reinit)::l when p = n ->
+            if reinit then
+	      let a' = create_assoc assoc in (init := Some a'; (p,a',false)::l)
+	    else if admissible_assoc (a,assoc) then
+	      raise Exit
+            else
+	      error_level_assoc p a (Option.get assoc)
+	| l -> after := q; (n,create_assoc assoc,ensure)::l
       in
       try
-	(* Create the entry *)
 	let updated =
 	  if forpat then (ccurrent, add_level None pcurrent)
 	  else (add_level None ccurrent, pcurrent) in
         level_stack := updated:: !level_stack;
 	let assoc = create_assoc assoc in
-	(if !after = None then Some Gramext.First
-	else Some (Gramext.After (constr_level (out_some !after)))),
-	Some assoc, Some (constr_level n)
+        if !init = None then
+	  (* Create the entry *)
+	  (if !after = None then Some Gramext.First
+	   else Some (Gramext.After (constr_level (Option.get !after)))),
+	   Some assoc, Some (constr_level n), None
+        else
+	  (* The reinit flag has been updated *)
+	   Some (Gramext.Level (constr_level n)), None, None, !init
       with
+	  (* Nothing has changed *)
           Exit ->
             level_stack := current :: !level_stack;
 	    (* Just inherit the existing associativity and name (None) *)
-	    Some (Gramext.Level (constr_level n)), None, None
+	    Some (Gramext.Level (constr_level n)), None, None, None
 
 let remove_levels n =
   level_stack := list_skipn n !level_stack
 
+let rec list_mem_assoc_triple x = function
+  | [] -> false
+  | (a,b,c) :: l -> a = x or list_mem_assoc_triple x l
+
+let register_empty_levels forpat symbs =
+  map_succeed (function
+    | Gramext.Snterml (_,n) when
+	let levels = (if forpat then snd else fst) (List.hd !level_stack) in
+	not (list_mem_assoc_triple (int_of_string n) levels) ->
+	find_position_gen forpat true None (Some (int_of_string n))
+    | _ -> failwith "") symbs
+
+let find_position forpat assoc level =
+  find_position_gen forpat false assoc level
+
+(* Synchronise the stack of level updates *) 
+let synchronize_level_positions () =
+  let _ = find_position true None None in ()
+
 (* Camlp4 levels do not treat NonA: use RightA with a NEXT on the left *)
 let camlp4_assoc = function
   | Some Gramext.NonA | Some Gramext.RightA -> Gramext.RightA 
@@ -647,9 +706,10 @@ let compute_entry allow_create adjust forpat = function
 (* This computes the name of the level where to add a new rule *)
 let get_constr_entry forpat = function
   | ETConstr(200,()) when not forpat ->
-      weaken_entry Constr.binder_constr, None, false
+      weaken_entry Constr.binder_constr, None
   | e ->
-      compute_entry true (fun (n,()) -> Some n) forpat e
+      let (e,level,_) = compute_entry true (fun (n,()) -> Some n) forpat e in
+      (e, level)
 
 (* This computes the name to give to a production knowing the name and
    associativity of the level where it must be added *)
diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli
index 681a6b2c..44a3686e 100644
--- a/parsing/pcoq.mli
+++ b/parsing/pcoq.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pcoq.mli 10185 2007-10-06 18:05:13Z herbelin $ i*)
+(*i $Id: pcoq.mli 10987 2008-05-26 12:28:36Z herbelin $ i*)
 
 open Util
 open Names
@@ -37,10 +37,11 @@ val object_of_typed_entry : typed_entry -> grammar_object Gram.Entry.e
 val weaken_entry : 'a Gram.Entry.e -> grammar_object Gram.Entry.e
 
 val get_constr_entry :
-  bool -> constr_entry -> grammar_object Gram.Entry.e * int option * bool
+  bool -> constr_entry -> grammar_object Gram.Entry.e * int option
 
 val grammar_extend :
-  grammar_object Gram.Entry.e -> Gramext.position option ->
+  grammar_object Gram.Entry.e -> Gramext.position option -> 
+   (* for reinitialization if ever: *) Gramext.g_assoc option ->
     (string option * Gramext.g_assoc option *
      (Compat.token Gramext.g_symbol list * Gramext.g_action) list) list
     -> unit
@@ -77,7 +78,7 @@ val force_entry_type :
 
 val create_constr_entry :
   string * gram_universe -> string -> constr_expr Gram.Entry.e
-val create_generic_entry : string -> ('a, rlevel,raw_tactic_expr) abstract_argument_type -> 'a Gram.Entry.e
+val create_generic_entry : string -> ('a, rlevel) abstract_argument_type -> 'a Gram.Entry.e
 val get_generic_entry : string -> grammar_object Gram.Entry.e
 val get_generic_entry_type : string * gram_universe -> string -> Genarg.argument_type
 
@@ -85,33 +86,33 @@ val get_generic_entry_type : string * gram_universe -> string -> Genarg.argument
 
 val tactic_main_level : int
 
-val rawwit_tactic : int -> (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type
-val globwit_tactic : int -> (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type
-val wit_tactic : int -> (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type
+val rawwit_tactic : int -> (raw_tactic_expr,rlevel) abstract_argument_type
+val globwit_tactic : int -> (glob_tactic_expr,glevel) abstract_argument_type
+val wit_tactic : int -> (glob_tactic_expr,tlevel) abstract_argument_type
 
-val rawwit_tactic0 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type
-val globwit_tactic0 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type
-val wit_tactic0 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type
+val rawwit_tactic0 : (raw_tactic_expr,rlevel) abstract_argument_type
+val globwit_tactic0 : (glob_tactic_expr,glevel) abstract_argument_type
+val wit_tactic0 : (glob_tactic_expr,tlevel) abstract_argument_type
 
-val rawwit_tactic1 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type
-val globwit_tactic1 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type
-val wit_tactic1 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type
+val rawwit_tactic1 : (raw_tactic_expr,rlevel) abstract_argument_type
+val globwit_tactic1 : (glob_tactic_expr,glevel) abstract_argument_type
+val wit_tactic1 : (glob_tactic_expr,tlevel) abstract_argument_type
 
-val rawwit_tactic2 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type
-val globwit_tactic2 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type
-val wit_tactic2 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type
+val rawwit_tactic2 : (raw_tactic_expr,rlevel) abstract_argument_type
+val globwit_tactic2 : (glob_tactic_expr,glevel) abstract_argument_type
+val wit_tactic2 : (glob_tactic_expr,tlevel) abstract_argument_type
 
-val rawwit_tactic3 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type
-val globwit_tactic3 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type
-val wit_tactic3 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type
+val rawwit_tactic3 : (raw_tactic_expr,rlevel) abstract_argument_type
+val globwit_tactic3 : (glob_tactic_expr,glevel) abstract_argument_type
+val wit_tactic3 : (glob_tactic_expr,tlevel) abstract_argument_type
 
-val rawwit_tactic4 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type
-val globwit_tactic4 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type
-val wit_tactic4 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type
+val rawwit_tactic4 : (raw_tactic_expr,rlevel) abstract_argument_type
+val globwit_tactic4 : (glob_tactic_expr,glevel) abstract_argument_type
+val wit_tactic4 : (glob_tactic_expr,tlevel) abstract_argument_type
 
-val rawwit_tactic5 : (raw_tactic_expr,rlevel,raw_tactic_expr) abstract_argument_type
-val globwit_tactic5 : (glob_tactic_expr,glevel,glob_tactic_expr) abstract_argument_type
-val wit_tactic5 : (glob_tactic_expr,tlevel,glob_tactic_expr) abstract_argument_type
+val rawwit_tactic5 : (raw_tactic_expr,rlevel) abstract_argument_type
+val globwit_tactic5 : (glob_tactic_expr,glevel) abstract_argument_type
+val wit_tactic5 : (glob_tactic_expr,tlevel) abstract_argument_type
 
 val is_tactic_genarg : argument_type -> bool
 
@@ -132,6 +133,8 @@ module Prim :
     val ident : identifier Gram.Entry.e
     val name : name located Gram.Entry.e
     val identref : identifier located Gram.Entry.e
+    val pattern_ident : identifier Gram.Entry.e
+    val pattern_identref : identifier located Gram.Entry.e
     val base_ident : identifier Gram.Entry.e
     val natural : int Gram.Entry.e
     val bigint : Bigint.bigint Gram.Entry.e
@@ -159,8 +162,12 @@ module Constr :
     val annot : constr_expr Gram.Entry.e
     val constr_pattern : constr_expr Gram.Entry.e
     val lconstr_pattern : constr_expr Gram.Entry.e
-    val binder : (name located list * constr_expr) Gram.Entry.e
-    val binder_let : local_binder Gram.Entry.e
+    val binder : (name located list * binder_kind * constr_expr) Gram.Entry.e
+    val binder_let : local_binder list Gram.Entry.e
+    val binders_let : local_binder list Gram.Entry.e
+    val binders_let_fixannot : (local_binder list * (identifier located option * recursion_order_expr)) Gram.Entry.e
+    val typeclass_constraint : (name located * binding_kind * constr_expr) Gram.Entry.e
+    val appl_arg : (constr_expr * explicitation located option) Gram.Entry.e
   end
 
 module Module : 
@@ -176,7 +183,7 @@ module Tactic :
     val casted_open_constr : open_constr_expr Gram.Entry.e
     val constr_with_bindings : constr_expr with_bindings Gram.Entry.e
     val bindings : constr_expr bindings Gram.Entry.e
-    val constr_may_eval : (constr_expr,reference) may_eval Gram.Entry.e
+    val constr_may_eval : (constr_expr,reference or_by_notation) may_eval Gram.Entry.e
     val quantified_hypothesis : quantified_hypothesis Gram.Entry.e
     val int_or_var : int or_var Gram.Entry.e
     val red_expr : raw_red_expr Gram.Entry.e
@@ -215,8 +222,16 @@ val symbol_of_production : Gramext.g_assoc option -> constr_entry ->
 (* Registering/resetting the level of an entry *)
 
 val find_position : 
-  bool -> bool -> Gramext.g_assoc option -> int option ->
-    Gramext.position option * Gramext.g_assoc option * string option
+  bool (* true if for creation in pattern entry; false if in constr entry *) ->
+  Gramext.g_assoc option -> int option ->
+    Gramext.position option * Gramext.g_assoc option * string option * 
+    (* for reinitialization: *) Gramext.g_assoc option
+
+val synchronize_level_positions : unit -> unit
+
+val register_empty_levels : bool -> Compat.token Gramext.g_symbol list ->
+    (Gramext.position option * Gramext.g_assoc option *
+     string option * Gramext.g_assoc option) list
 
 val remove_levels : int -> unit 
 
diff --git a/parsing/ppconstr.ml b/parsing/ppconstr.ml
index 92c6715e..985396f5 100644
--- a/parsing/ppconstr.ml
+++ b/parsing/ppconstr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ppconstr.ml 10087 2007-08-24 10:39:30Z herbelin $ *)      
+(* $Id: ppconstr.ml 11094 2008-06-10 19:35:23Z herbelin $ *)      
 
 (*i*)
 open Util
@@ -36,6 +36,7 @@ let lprod = 200
 let llambda = 200
 let lif = 200
 let lletin = 200
+let lletpattern = 200
 let lfix = 200
 let larrow = 90
 let lcast = 100
@@ -96,13 +97,13 @@ let pr_delimiters key strm =
   strm ++ str ("%"^key)
 
 let pr_located pr (loc,x) =
-  if Options.do_translate() && loc<>dummy_loc then
+  if Flags.do_translate() && loc<>dummy_loc then
     let (b,e) = unloc loc in
     comment b ++ pr x ++ comment e
   else pr x
 
 let pr_com_at n =
-  if Options.do_translate() && n <> 0 then comment n 
+  if Flags.do_translate() && n <> 0 then comment n 
   else mt()
 
 let pr_with_comments loc pp = pr_located (fun x -> x) (loc,pp)
@@ -129,7 +130,7 @@ let pr_qualid = pr_qualid
 let pr_expl_args pr (a,expl) =
   match expl with
   | None -> pr (lapp,L) a
-  | Some (_,ExplByPos n) ->
+  | Some (_,ExplByPos (n,_id)) ->
       anomaly("Explicitation by position not implemented")
   | Some (_,ExplByName id) -> 
       str "(" ++ pr_id id ++ str ":=" ++ pr ltop a ++ str ")"
@@ -160,6 +161,16 @@ let pr_prim_token = function
   | Numeral n -> Bigint.pr_bigint n
   | String s -> qs s
 
+let pr_evar pr n l =
+  hov 0 (str (Evd.string_of_existential n) ++
+  (match l with
+   | Some l ->
+       spc () ++ pr_in_comment
+         (fun l -> 
+	   str"[" ++ hov 0 (prlist_with_sep pr_coma (pr ltop) l) ++ str"]")
+         (List.rev l)
+   | None -> mt()))
+
 let las = lapp
 let lpator = 100
 
@@ -187,6 +198,7 @@ let rec pr_patt sep inh p =
 let pr_patt = pr_patt mt
 
 let pr_eqn pr (loc,pl,rhs) =
+  let pl = List.map snd pl in
   spc() ++ hov 4
     (pr_with_comments loc
       (str "| " ++
@@ -196,30 +208,41 @@ let pr_eqn pr (loc,pl,rhs) =
 
 let begin_of_binder = function
     LocalRawDef((loc,_),_) -> fst (unloc loc)
-  | LocalRawAssum((loc,_)::_,_) -> fst (unloc loc)
+  | LocalRawAssum((loc,_)::_,_,_) -> fst (unloc loc)
   | _ -> assert false
 
 let begin_of_binders = function
   | b::_ -> begin_of_binder b
   | _ -> 0
 
-let pr_binder many pr (nal,t) =
+let surround_binder k p = 
+  match k with
+      Default Explicit -> hov 1 (str"(" ++ p ++ str")")
+    | Default Implicit -> hov 1 (str"{" ++ p ++ str"}")
+    | TypeClass b -> hov 1 (str"[" ++ p ++ str"]")
+
+let surround_implicit k p =
+  match k with
+      Default Explicit -> p
+    | Default Implicit -> (str"{" ++ p ++ str"}")
+    | TypeClass b -> (str"[" ++ p ++ str"]")
+
+let pr_binder many pr (nal,k,t) =
   match t with
   | CHole _ -> prlist_with_sep spc pr_lname nal
   | _ ->
     let s = prlist_with_sep spc pr_lname nal ++ str" : " ++ pr t in
-    hov 1 (if many then surround s else s)
+      hov 1 (if many then surround_binder k s else surround_implicit k s)
 
 let pr_binder_among_many pr_c = function
-  | LocalRawAssum (nal,t) ->
-      pr_binder true pr_c (nal,t)
+  | LocalRawAssum (nal,k,t) ->
+      pr_binder true pr_c (nal,k,t)
   | LocalRawDef (na,c) ->
       let c,topt = match c with
         | CCast(_,c, CastConv (_,t)) -> c, t
-        | _ -> c, CHole dummy_loc in
-      hov 1 (surround
-        (pr_lname na ++ pr_opt_type pr_c topt ++
-         str":=" ++ cut() ++ pr_c c))
+        | _ -> c, CHole (dummy_loc, None) in
+      hov 1 (pr_lname na ++ pr_opt_type pr_c topt ++
+         str":=" ++ cut() ++ pr_c c)
 
 let pr_undelimited_binders pr_c =
   prlist_with_sep spc (pr_binder_among_many pr_c)
@@ -227,25 +250,21 @@ let pr_undelimited_binders pr_c =
 let pr_delimited_binders kw pr_c bl =
   let n = begin_of_binders bl in
   match bl with
-  | [LocalRawAssum (nal,t)] ->
-      pr_com_at n ++ kw() ++ pr_binder false pr_c (nal,t)
+  | [LocalRawAssum (nal,k,t)] ->
+      pr_com_at n ++ kw() ++ pr_binder false pr_c (nal,k,t)
   | LocalRawAssum _ :: _ as bdl ->
       pr_com_at n ++ kw() ++ pr_undelimited_binders pr_c bdl
   | _ -> assert false
 
-let pr_let_binder pr x a =
-  hov 0 (hov 0 (pr_name x ++ brk(0,1) ++ str ":=") ++
-         pr_sep_com (fun () -> brk(0,1)) (pr ltop) a)
-
 let rec extract_prod_binders = function
 (*  | CLetIn (loc,na,b,c) as x ->
       let bl,c = extract_prod_binders c in
       if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
   | CProdN (loc,[],c) ->
       extract_prod_binders c
-  | CProdN (loc,(nal,t)::bl,c) ->
+  | CProdN (loc,(nal,bk,t)::bl,c) ->
       let bl,c = extract_prod_binders (CProdN(loc,bl,c)) in
-      LocalRawAssum (nal,t) :: bl, c
+      LocalRawAssum (nal,bk,t) :: bl, c
   | c -> [], c
 
 let rec extract_lam_binders = function
@@ -254,15 +273,15 @@ let rec extract_lam_binders = function
       if bl = [] then [], x else LocalRawDef (na,b) :: bl, c*)
   | CLambdaN (loc,[],c) ->
       extract_lam_binders c
-  | CLambdaN (loc,(nal,t)::bl,c) ->
+  | CLambdaN (loc,(nal,bk,t)::bl,c) ->
       let bl,c = extract_lam_binders (CLambdaN(loc,bl,c)) in
-      LocalRawAssum (nal,t) :: bl, c
+      LocalRawAssum (nal,bk,t) :: bl, c
   | c -> [], c
     
 let split_lambda = function
-  | CLambdaN (loc,[[na],t],c) -> (na,t,c)
-  | CLambdaN (loc,([na],t)::bl,c) -> (na,t,CLambdaN(loc,bl,c))
-  | CLambdaN (loc,(na::nal,t)::bl,c) -> (na,t,CLambdaN(loc,(nal,t)::bl,c))
+  | CLambdaN (loc,[[na],bk,t],c) -> (na,t,c)
+  | CLambdaN (loc,([na],bk,t)::bl,c) -> (na,t,CLambdaN(loc,bl,c))
+  | CLambdaN (loc,(na::nal,bk,t)::bl,c) -> (na,t,CLambdaN(loc,(nal,bk,t)::bl,c))
   | _ -> anomaly "ill-formed fixpoint body"
 
 let rename na na' t c =
@@ -273,13 +292,13 @@ let rename na na' t c =
   
 let split_product na' = function
   | CArrow (loc,t,c) -> (na',t,c)
-  | CProdN (loc,[[na],t],c) -> rename na na' t c
-  | CProdN (loc,([na],t)::bl,c) -> rename na na' t (CProdN(loc,bl,c))
-  | CProdN (loc,(na::nal,t)::bl,c) ->
-      rename na na' t (CProdN(loc,(nal,t)::bl,c))
+  | CProdN (loc,[[na],bk,t],c) -> rename na na' t c
+  | CProdN (loc,([na],bk,t)::bl,c) -> rename na na' t (CProdN(loc,bl,c))
+  | CProdN (loc,(na::nal,bk,t)::bl,c) ->
+      rename na na' t (CProdN(loc,(nal,bk,t)::bl,c))
   | _ -> anomaly "ill-formed fixpoint body"
 
-let merge_binders (na1,ty1) cofun (na2,ty2) codom =
+let merge_binders (na1,bk1,ty1) cofun (na2,bk2,ty2) codom =
   let na =
     match snd na1, snd na2 with
         Anonymous, Name id ->
@@ -300,42 +319,42 @@ let merge_binders (na1,ty1) cofun (na2,ty2) codom =
       | _ ->
           Constrextern.check_same_type ty1 ty2;
           ty2 in
-  (LocalRawAssum ([na],ty), codom)
+  (LocalRawAssum ([na],bk1,ty), codom)
             
 let rec strip_domain bvar cofun c =
   match c with
     | CArrow(loc,a,b) ->
-        merge_binders bvar cofun ((dummy_loc,Anonymous),a) b
-    | CProdN(loc,[([na],ty)],c') ->
-        merge_binders bvar cofun (na,ty) c'
-    | CProdN(loc,([na],ty)::bl,c') ->
-        merge_binders bvar cofun (na,ty) (CProdN(loc,bl,c'))
-    | CProdN(loc,(na::nal,ty)::bl,c') ->
-        merge_binders bvar cofun (na,ty) (CProdN(loc,(nal,ty)::bl,c'))
+        merge_binders bvar cofun ((dummy_loc,Anonymous),default_binder_kind,a) b
+    | CProdN(loc,[([na],bk,ty)],c') ->
+        merge_binders bvar cofun (na,bk,ty) c'
+    | CProdN(loc,([na],bk,ty)::bl,c') ->
+        merge_binders bvar cofun (na,bk,ty) (CProdN(loc,bl,c'))
+    | CProdN(loc,(na::nal,bk,ty)::bl,c') ->
+        merge_binders bvar cofun (na,bk,ty) (CProdN(loc,(nal,bk,ty)::bl,c'))
     | _ -> failwith "not a product"
 
 (* Note: binder sharing is lost *)
-let rec strip_domains (nal,ty) cofun c =
+let rec strip_domains (nal,bk,ty) cofun c =
   match nal with
       [] -> assert false
     | [na] ->
-        let bnd, c' = strip_domain (na,ty) cofun c in
+        let bnd, c' = strip_domain (na,bk,ty) cofun c in
         ([bnd],None,c')
     | na::nal ->
-        let f = CLambdaN(dummy_loc,[(nal,ty)],cofun) in
-        let bnd, c1 = strip_domain (na,ty) f c in
+        let f = CLambdaN(dummy_loc,[(nal,bk,ty)],cofun) in
+        let bnd, c1 = strip_domain (na,bk,ty) f c in
         (try
-          let bl, rest, c2 = strip_domains (nal,ty) cofun c1 in
+          let bl, rest, c2 = strip_domains (nal,bk,ty) cofun c1 in
           (bnd::bl, rest, c2)
-        with Failure _ -> ([bnd],Some (nal,ty), c1))
+        with Failure _ -> ([bnd],Some (nal,bk,ty), c1))
 
 (* Re-share binders *)
 let rec factorize_binders = function
   | ([] | [_] as l) -> l
-  | LocalRawAssum (nal,ty) as d :: (LocalRawAssum (nal',ty')::l as l') ->
+  | LocalRawAssum (nal,k,ty) as d :: (LocalRawAssum (nal',k',ty')::l as l') ->
       (try
 	let _ = Constrextern.check_same_type ty ty' in
-	factorize_binders (LocalRawAssum (nal@nal',ty)::l)
+	factorize_binders (LocalRawAssum (nal@nal',k,ty)::l)
       with _ ->
 	d :: factorize_binders l')
   | d :: l -> d :: factorize_binders l
@@ -364,7 +383,7 @@ let rec split_fix n typ def =
     let (na,_,def) = split_lambda def in
     let (na,t,typ) = split_product na typ in
     let (bl,typ,def) = split_fix (n-1) typ def in
-    (LocalRawAssum ([na],t)::bl,typ,def)
+    (LocalRawAssum ([na],default_binder_kind,t)::bl,typ,def)
 
 let pr_recursive_decl pr pr_dangling dangling_with_for id bl annot t c =
   let pr_body =
@@ -374,22 +393,21 @@ let pr_recursive_decl pr pr_dangling dangling_with_for id bl annot t c =
   pr_opt_type_spc pr t ++ str " :=" ++
   pr_sep_com (fun () -> brk(1,2)) (pr_body ltop) c
 
-let pr_fixdecl pr prd dangling_with_for (id,(n,ro),bl,t,c) =
+let pr_fixdecl pr prd dangling_with_for ((_,id),(n,ro),bl,t,c) =
   let annot =
-    let ids = names_of_local_assums bl in
-      match ro with
-	  CStructRec ->
-	    if List.length ids > 1 && n <> None then 
-	      spc() ++ str "{struct " ++ pr_name (snd (List.nth ids (out_some n))) ++ str"}"
-	    else mt() 
-	| CWfRec c ->
-	    spc () ++ str "{wf " ++ pr lsimple c ++ pr_name (snd (List.nth ids (out_some n))) ++ str"}"
-	| CMeasureRec c ->
-	    spc () ++ str "{measure " ++ pr lsimple c ++ pr_name (snd (List.nth ids (out_some n))) ++ str"}"
+    match ro with
+	CStructRec ->
+	  if List.length bl > 1 && n <> None then 
+	    spc() ++ str "{struct " ++ pr_id (snd (Option.get n)) ++ str"}"
+	  else mt() 
+      | CWfRec c ->
+	  spc () ++ str "{wf " ++ pr lsimple c ++ pr_id (snd (Option.get n)) ++ str"}"
+      | CMeasureRec c ->
+	  spc () ++ str "{measure " ++ pr lsimple c ++ pr_id (snd (Option.get n)) ++ str"}"
   in
     pr_recursive_decl pr prd dangling_with_for id bl annot t c
 
-let pr_cofixdecl pr prd dangling_with_for (id,bl,t,c) =
+let pr_cofixdecl pr prd dangling_with_for ((_,id),bl,t,c) =
   pr_recursive_decl pr prd dangling_with_for id bl (mt()) t c
 
 let pr_recursive pr_decl id = function
@@ -415,27 +433,16 @@ let tm_clash = function
       -> Some id
   | _ -> None
 
-let pr_case_item pr (tm,(na,indnalopt)) =
-  hov 0 (pr (lcast,E) tm ++
-(*
-  (match na with
-    | Name id when not (is_var id tm) -> spc () ++ str "as " ++  pr_id id
-    | Anonymous when tm_clash (tm,indnalopt) <> None ->
-	(* hide [tm] name to avoid conflicts *)
-	spc () ++ str "as _" (* ++ pr_id (out_some (tm_clash (tm,indnalopt)))*)
-    | _ -> mt ()) ++
-*)
+let pr_asin pr (na,indnalopt) =
   (match na with (* Decision of printing "_" or not moved to constrextern.ml *)
     | Some na -> spc () ++ str "as " ++  pr_name na
     | None -> mt ()) ++
   (match indnalopt with
     | None -> mt ()
-(*
-    | Some (_,ind,nal) ->
-        spc () ++ str "in " ++ 
-        hov 0 (pr_reference ind ++ prlist (pr_arg pr_name) nal))
-*)
-    | Some t -> spc () ++ str "in " ++ pr lsimple t))
+    | Some t -> spc () ++ str "in " ++ pr lsimple t)
+    
+let pr_case_item pr (tm,asin) =
+  hov 0 (pr (lcast,E) tm ++ pr_asin pr asin)
 
 let pr_case_type pr po =
   match po with
@@ -465,6 +472,16 @@ let pr_app pr a l =
     pr (lapp,L) a  ++ 
     prlist (fun a -> spc () ++ pr_expl_args pr a) l)
 
+let pr_forall () =
+  if !Flags.unicode_syntax then str"Π" ++ spc ()
+  else str"forall" ++ spc ()
+
+let pr_fun () =
+  if !Flags.unicode_syntax then str"λ" ++ spc ()
+  else str"fun" ++ spc ()
+
+let pr_fun_sep = lazy (if !Flags.unicode_syntax then str "," else str " =>")
+
 let rec pr sep inherited a =
   let (strm,prec) = match a with
   | CRef r -> pr_reference r, latom
@@ -485,17 +502,16 @@ let rec pr sep inherited a =
   | CProdN _ ->
       let (bl,a) = extract_prod_binders a in
       hov 0 (
-	hov 2 (pr_delimited_binders (fun () -> str"forall" ++ spc())
+	hov 2 (pr_delimited_binders pr_forall
                  (pr mt ltop) bl) ++
         str "," ++ pr spc ltop a),
       lprod
   | CLambdaN _ ->
       let (bl,a) = extract_lam_binders a in
       hov 0 (
-        hov 2 (pr_delimited_binders (fun () -> str"fun" ++ spc())
-                 (pr mt ltop) bl) ++
-
-        str " =>" ++ pr spc ltop a),
+        hov 2 (pr_delimited_binders pr_fun
+                (pr mt ltop) bl) ++
+	  Lazy.force pr_fun_sep ++ pr spc ltop a),
       llambda
   | CLetIn (_,(_,Name x),(CFix(_,(_,x'),[_])|CCoFix(_,(_,x'),[_]) as fx), b)
       when x=x' ->
@@ -532,15 +548,24 @@ let rec pr sep inherited a =
       else
 	p, lproj
   | CApp (_,(None,a),l) -> pr_app (pr mt) a l, lapp
-  | CCases (_,rtntypopt,c,eqns) ->
+  | CCases (_,LetPatternStyle,rtntypopt,[c,asin],[(_,[(loc,[p])],b)]) ->
+      hv 0 (
+	str "let '" ++ 
+	  hov 0 (pr_patt ltop p ++ 
+		 pr_asin (pr_dangling_with_for mt) asin ++
+		 str " :=" ++ pr spc ltop c ++ 
+		 pr_case_type (pr_dangling_with_for mt) rtntypopt ++
+		 str " in" ++ pr spc ltop b)),
+	lletpattern
+  | CCases(_,_,rtntypopt,c,eqns) ->
       v 0
         (hv 0 (str "match" ++ brk (1,2) ++
-	  hov 0 (
-	    prlist_with_sep sep_v
-              (pr_case_item (pr_dangling_with_for mt)) c
-            ++ pr_case_type (pr_dangling_with_for mt) rtntypopt) ++
-	spc () ++ str "with") ++
-        prlist (pr_eqn (pr mt)) eqns ++ spc() ++ str "end"),
+		  hov 0 (
+		    prlist_with_sep sep_v
+		      (pr_case_item (pr_dangling_with_for mt)) c
+		    ++ pr_case_type (pr_dangling_with_for mt) rtntypopt) ++
+		  spc () ++ str "with") ++
+		  prlist (pr_eqn (pr mt)) eqns ++ spc() ++ str "end"),
       latom
   | CLetTuple (_,nal,(na,po),c,b) ->
       hv 0 (
@@ -553,8 +578,8 @@ let rec pr sep inherited a =
         pr spc ltop b),
       lletin
   | CIf (_,c,(na,po),b1,b2) ->
-      (* On force les parenth�ses autour d'un "if" sous-terme (m�me si le
-	 parsing est lui plus tol�rant) *)
+      (* On force les parenthèses autour d'un "if" sous-terme (même si le
+	 parsing est lui plus tolérant) *)
       hv 0 (
 	hov 1 (str "if " ++ pr mt ltop c ++ pr_simple_return_type (pr mt) na po) ++
 	spc () ++
@@ -563,7 +588,7 @@ let rec pr sep inherited a =
       lif
      
   | CHole _ -> str "_", latom
-  | CEvar (_,n) -> str (Evd.string_of_existential n), latom
+  | CEvar (_,n,l) -> pr_evar (pr mt) n l, latom
   | CPatVar (_,(_,p)) -> str "?" ++ pr_patvar p, latom
   | CSort (_,s) -> pr_rawsort s, latom
   | CCast (_,a,CastConv (k,b)) ->
@@ -595,46 +620,70 @@ let rec strip_context n iscast t =
   if n = 0 then
     [], if iscast then match t with CCast (_,c,_) -> c | _ -> t else t
   else match t with
-    | CLambdaN (loc,(nal,t)::bll,c) ->
+    | CLambdaN (loc,(nal,bk,t)::bll,c) ->
 	let n' = List.length nal in
 	if n' > n then
 	  let nal1,nal2 = list_chop n nal in
-	  [LocalRawAssum (nal1,t)], CLambdaN (loc,(nal2,t)::bll,c)
+	  [LocalRawAssum (nal1,bk,t)], CLambdaN (loc,(nal2,bk,t)::bll,c)
 	else
 	let bl', c = strip_context (n-n') iscast
 	  (if bll=[] then c else CLambdaN (loc,bll,c)) in
-	LocalRawAssum (nal,t) :: bl', c 
-    | CProdN (loc,(nal,t)::bll,c) ->
+	LocalRawAssum (nal,bk,t) :: bl', c 
+    | CProdN (loc,(nal,bk,t)::bll,c) ->
 	let n' = List.length nal in
 	if n' > n then
 	  let nal1,nal2 = list_chop n nal in
-	  [LocalRawAssum (nal1,t)], CProdN (loc,(nal2,t)::bll,c)
+	  [LocalRawAssum (nal1,bk,t)], CProdN (loc,(nal2,bk,t)::bll,c)
 	else
 	let bl', c = strip_context (n-n') iscast
 	  (if bll=[] then c else CProdN (loc,bll,c)) in
-	LocalRawAssum (nal,t) :: bl', c 
+	LocalRawAssum (nal,bk,t) :: bl', c 
     | CArrow (loc,t,c) ->
 	let bl', c = strip_context (n-1) iscast c in
-	LocalRawAssum ([loc,Anonymous],t) :: bl', c 
+	LocalRawAssum ([loc,Anonymous],default_binder_kind,t) :: bl', c
     | CCast (_,c,_) -> strip_context n false c
     | CLetIn (_,na,b,c) -> 
 	let bl', c = strip_context (n-1) iscast c in
 	LocalRawDef (na,b) :: bl', c
     | _ -> anomaly "strip_context"
 
-let pr_constr_expr c = pr lsimple c
-let pr_lconstr_expr c = pr ltop c
-let pr_pattern_expr c = pr lsimple c
-let pr_lpattern_expr c = pr ltop c
+type term_pr = {
+  pr_constr_expr   : constr_expr -> std_ppcmds;
+  pr_lconstr_expr  : constr_expr -> std_ppcmds;
+  pr_pattern_expr  : Tacexpr.pattern_expr -> std_ppcmds;
+  pr_lpattern_expr : Tacexpr.pattern_expr -> std_ppcmds
+}
+
+let default_term_pr = {
+  pr_constr_expr   = pr lsimple;
+  pr_lconstr_expr  = pr ltop;
+  pr_pattern_expr  = pr lsimple;
+  pr_lpattern_expr = pr ltop
+}
+
+let term_pr = ref default_term_pr
+
+let set_term_pr = (:=) term_pr
+
+let pr_constr_expr c   = !term_pr.pr_constr_expr   c
+let pr_lconstr_expr c  = !term_pr.pr_lconstr_expr  c
+let pr_pattern_expr c  = !term_pr.pr_pattern_expr  c
+let pr_lpattern_expr c = !term_pr.pr_lpattern_expr c
 
 let pr_cases_pattern_expr = pr_patt ltop
 
 let pr_binders = pr_undelimited_binders (pr ltop)
 
-let pr_with_occurrences pr = function
-    ([],c) -> pr c
-  | (nl,c) -> hov 1 (pr c ++ spc() ++ str"at " ++
-                     hov 0 (prlist_with_sep spc (pr_or_var int) nl))
+let pr_with_occurrences_with_trailer pr occs trailer =
+  match occs with
+    ((false,[]),c) -> pr c ++ trailer
+  | ((nowhere_except_in,nl),c) ->
+      hov 1 (pr c ++ spc() ++ str"at " ++
+        (if nowhere_except_in then mt() else str "- ") ++
+        hov 0 (prlist_with_sep spc (pr_or_var int) nl) ++ trailer)
+
+let pr_with_occurrences pr occs = 
+  pr_with_occurrences_with_trailer pr occs (mt())
 
 let pr_red_flag pr r =
   (if r.rBeta then pr_arg str "beta" else mt ()) ++
diff --git a/parsing/ppconstr.mli b/parsing/ppconstr.mli
index 8f965d9b..a0eb4ad9 100644
--- a/parsing/ppconstr.mli
+++ b/parsing/ppconstr.mli
@@ -7,7 +7,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: ppconstr.mli 8878 2006-05-30 16:44:25Z herbelin $ i*)
+(*i $Id: ppconstr.mli 11094 2008-06-10 19:35:23Z herbelin $ i*)
 
 open Pp
 open Environ
@@ -55,6 +55,8 @@ val pr_qualid : qualid -> std_ppcmds
 
 val pr_with_occurrences :
   ('a -> std_ppcmds) -> 'a with_occurrences -> std_ppcmds
+val pr_with_occurrences_with_trailer :
+  ('a -> std_ppcmds) -> 'a with_occurrences -> std_ppcmds -> std_ppcmds
 val pr_red_expr :
   ('a -> std_ppcmds) * ('a -> std_ppcmds) * ('b -> std_ppcmds) ->
     ('a,'b) red_expr_gen -> std_ppcmds
@@ -70,3 +72,13 @@ val pr_lpattern_expr : Tacexpr.pattern_expr -> std_ppcmds
 val pr_constr_expr : constr_expr -> std_ppcmds
 val pr_lconstr_expr : constr_expr -> std_ppcmds
 val pr_cases_pattern_expr : cases_pattern_expr -> std_ppcmds
+
+type term_pr = {
+  pr_constr_expr   : constr_expr -> std_ppcmds;
+  pr_lconstr_expr  : constr_expr -> std_ppcmds;
+  pr_pattern_expr  : Tacexpr.pattern_expr -> std_ppcmds;
+  pr_lpattern_expr : Tacexpr.pattern_expr -> std_ppcmds
+}
+
+val set_term_pr : term_pr -> unit
+val default_term_pr : term_pr
diff --git a/parsing/ppdecl_proof.ml b/parsing/ppdecl_proof.ml
index bb0662da..3b9a002f 100644
--- a/parsing/ppdecl_proof.ml
+++ b/parsing/ppdecl_proof.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id$ *)
+(* $Id: ppdecl_proof.ml 10739 2008-04-01 14:45:20Z herbelin $ *)
 
 open Util 
 open Pp
@@ -32,7 +32,7 @@ let pr_justification_items env = function
 let pr_justification_method env = function
     None -> mt ()
   | Some tac -> 
-      spc () ++ str "using" ++  pr_tac env tac
+      spc () ++ str "using" ++ spc () ++ pr_tac env tac
 
 let pr_statement pr_it env st = 
   pr_label st.st_label ++ pr_it env st.st_it
@@ -41,7 +41,6 @@ let pr_or_thesis pr_this env = function
     Thesis Plain -> str "thesis"
   | Thesis (For id) -> 
       str "thesis" ++ spc() ++ str "for" ++ spc () ++ pr_id id 
-  | Thesis (Sub n) -> str "thesis[" ++ int n ++ str "]"
   | This c -> pr_this env c
 
 let pr_cut pr_it env c = 
@@ -156,7 +155,7 @@ let rec pr_bare_proof_instr _then _thus env = function
   | Pcast (id,typ) -> 
       str "reconsider" ++ spc () ++ 
 	pr_or_thesis (fun _ -> pr_id) env id ++ spc () ++ 
-	str "as" ++ (pr_constr env typ)  
+	str "as" ++ spc () ++ (pr_constr env typ)  
   | Psuppose hyps -> 
       str "suppose" ++ 
 	print_hyps pr_constr _I env false false "we have" hyps
diff --git a/parsing/pptactic.ml b/parsing/pptactic.ml
index c68a2d6f..f955d83b 100644
--- a/parsing/pptactic.ml
+++ b/parsing/pptactic.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pptactic.ml 9551 2007-01-29 15:13:35Z bgregoir $ *)
+(* $Id: pptactic.ml 11094 2008-06-10 19:35:23Z herbelin $ *)
 
 open Pp
 open Names
@@ -77,6 +77,10 @@ let pr_or_metaid pr = function
 
 let pr_and_short_name pr (c,_) = pr c
 
+let pr_or_by_notation f = function
+  | AN v -> f v
+  | ByNotation (_,s) -> str s
+
 let pr_located pr (loc,x) = pr x
 
 let pr_evaluable_reference = function 
@@ -129,7 +133,14 @@ let rec pr_message_token prid = function
 
 let pr_fresh_ids = prlist (fun s -> spc() ++ pr_or_var qs s)
 
-let rec pr_raw_generic prc prlc prtac prref (x:(Genarg.rlevel, Tacexpr.raw_tactic_expr) Genarg.generic_argument) =
+let with_evars ev s = if ev then "e" ^ s else s
+
+let out_bindings = function
+  | ImplicitBindings l -> ImplicitBindings (List.map snd l)
+  | ExplicitBindings l -> ExplicitBindings (List.map (fun (loc,id,c) -> (loc,id,snd c)) l)
+  | NoBindings -> NoBindings
+
+let rec pr_raw_generic prc prlc prtac prref (x:Genarg.rlevel Genarg.generic_argument) =
   match Genarg.genarg_tag x with
   | BoolArgType -> pr_arg str (if out_gen rawwit_bool x then "true" else "false")
   | IntArgType -> pr_arg int (out_gen rawwit_int x)
@@ -144,11 +155,13 @@ let rec pr_raw_generic prc prlc prtac prref (x:(Genarg.rlevel, Tacexpr.raw_tacti
   | SortArgType -> pr_arg pr_rawsort (out_gen rawwit_sort x)
   | ConstrArgType -> pr_arg prc (out_gen rawwit_constr x)
   | ConstrMayEvalArgType ->
-      pr_arg (pr_may_eval prc prlc prref) (out_gen rawwit_constr_may_eval x)
+      pr_arg (pr_may_eval prc prlc (pr_or_by_notation prref))
+        (out_gen rawwit_constr_may_eval x)
   | QuantHypArgType ->
       pr_arg pr_quantified_hypothesis (out_gen rawwit_quant_hyp x)
   | RedExprArgType ->
-      pr_arg (pr_red_expr (prc,prlc,prref)) (out_gen rawwit_red_expr x)
+      pr_arg (pr_red_expr (prc,prlc,pr_or_by_notation prref))
+        (out_gen rawwit_red_expr x)
   | OpenConstrArgType b -> pr_arg prc (snd (out_gen (rawwit_open_constr_gen b) x))
   | ConstrWithBindingsArgType -> 
       pr_arg (pr_with_bindings prc prlc) (out_gen rawwit_constr_with_bindings x)
@@ -238,10 +251,12 @@ let rec pr_generic prc prlc prtac x =
       pr_arg (pr_red_expr (prc,prlc,pr_evaluable_reference)) 
         (out_gen wit_red_expr x)
   | OpenConstrArgType b -> pr_arg prc (snd (out_gen (wit_open_constr_gen b) x))
-  | ConstrWithBindingsArgType -> 
-      pr_arg (pr_with_bindings prc prlc) (out_gen wit_constr_with_bindings x)
+  | ConstrWithBindingsArgType ->
+      let (c,b) = out_gen wit_constr_with_bindings x in
+      pr_arg (pr_with_bindings prc prlc) (c,out_bindings b)
   | BindingsArgType -> 
-      pr_arg (pr_bindings_no_with prc prlc) (out_gen wit_bindings x)
+      pr_arg (pr_bindings_no_with prc prlc)
+        (out_bindings (out_gen wit_bindings x))
   | List0ArgType _ -> 
       hov 0 (fold_list0 (fun x a -> pr_generic prc prlc prtac x ++ a) x (mt()))
   | List1ArgType _ ->
@@ -277,7 +292,7 @@ let pr_raw_extend prc prlc prtac =
 let pr_glob_extend prc prlc prtac =
   pr_extend_gen (pr_glob_generic prc prlc prtac)
 let pr_extend prc prlc prtac =
-  pr_extend_gen (pr_generic prc prlc prtac)
+  pr_extend_gen (pr_generic (fun c -> prc (Evd.empty,c)) (fun c -> prlc (Evd.empty,c)) prtac)
 
 (**********************************************************************)
 (* The tactic printer                                                 *)
@@ -289,9 +304,10 @@ let strip_prod_binders_expr n ty =
     match ty with
         Topconstr.CProdN(_,bll,a) ->
           let nb =
-            List.fold_left (fun i (nal,_) -> i + List.length nal) 0 bll in
-          if nb >= n then (List.rev (bll@acc), a)
-          else strip_ty (bll@acc) (n-nb) a
+            List.fold_left (fun i (nal,_,_) -> i + List.length nal) 0 bll in
+	  let bll = List.map (fun (x, _, y) -> x, y) bll in
+            if nb >= n then (List.rev (bll@acc)), a
+            else strip_ty (bll@acc) (n-nb) a
       | Topconstr.CArrow(_,a,b) ->
           if n=1 then
             (List.rev (([(dummy_loc,Anonymous)],a)::acc), b)
@@ -354,6 +370,13 @@ let pr_with_names = function
   | IntroAnonymous -> mt ()
   | ipat -> spc () ++ hov 1 (str "as" ++ spc () ++ pr_intro_pattern ipat)
 
+let pr_as_name = function
+  | Anonymous -> mt ()
+  | Name id -> str "as " ++ pr_lident (dummy_loc,id)
+
+let pr_pose_as_style prc na c =
+  spc() ++ prc c ++ pr_as_name na
+
 let pr_pose prlc prc na c = match na with
   | Anonymous -> spc() ++ prc c
   | Name id -> spc() ++ surround (pr_id id ++ str " :=" ++ spc() ++ prlc c)
@@ -394,14 +417,14 @@ let pr_simple_clause pr_id = function
   | l -> pr_in (spc () ++ prlist_with_sep spc pr_id l)
 
 let pr_clauses pr_id = function
-    { onhyps=None; onconcl=true; concl_occs=nl } ->
-      pr_in (pr_with_occurrences (fun () -> str " *") (nl,()))
-  | { onhyps=None; onconcl=false } -> pr_in (str " * |-")
-  | { onhyps=Some l; onconcl=true; concl_occs=nl } -> 
-      pr_in (prlist_with_sep (fun () -> str",") (pr_hyp_location pr_id) l
-             ++ pr_with_occurrences (fun () -> str" |- *") (nl,()))
-  | { onhyps=Some l; onconcl=false } ->
-      pr_in (prlist_with_sep (fun()->str",") (pr_hyp_location pr_id) l)
+  | { onhyps=None; concl_occs=occs } ->
+      if occs = no_occurrences_expr then pr_in (str " * |-")
+      else pr_in (pr_with_occurrences (fun () -> str " *") (occs,()))
+  | { onhyps=Some l; concl_occs=occs } ->
+      pr_in
+        (prlist_with_sep (fun () -> str",") (pr_hyp_location pr_id) l ++
+	 (if occs = no_occurrences_expr then mt ()
+	  else pr_with_occurrences (fun () -> str" |- *") (occs,())))
 
 let pr_clause_pattern pr_id = function
   | (None, []) -> mt ()
@@ -414,8 +437,15 @@ let pr_clause_pattern pr_id = function
 
 let pr_orient b = if b then mt () else str " <-"
 
-let pr_induction_arg prc = function
-  | ElimOnConstr c -> prc c
+let pr_multi = function 
+  | Precisely 1 -> mt ()
+  | Precisely n -> pr_int n ++ str "!"
+  | UpTo n -> pr_int n ++ str "?"
+  | RepeatStar -> str "?"
+  | RepeatPlus -> str "!"
+
+let pr_induction_arg prlc prc = function
+  | ElimOnConstr c -> pr_with_bindings prlc prc c
   | ElimOnIdent (loc,id) -> pr_with_comments loc (pr_id id)
   | ElimOnAnonHyp n -> int n
 
@@ -459,34 +489,32 @@ let pr_funvar = function
   | None -> spc () ++ str "_"
   | Some id -> spc () ++ pr_id id
 
-let pr_let_clause k pr = function
-  | (id,None,t) ->
-      hov 0 (str k ++ pr_lident id ++ str " :=" ++ brk (1,1) ++
-             pr (TacArg t))
-  | (id,Some c,t) ->
-      hv 0 (str k ++ pr_lident id ++ str" :" ++ brk(1,2) ++
-      pr c ++
-      str " :=" ++ brk (1,1) ++ pr (TacArg t))
+let pr_let_clause k pr (id,t) =
+  hov 0 (str k ++ pr_lident id ++ str " :=" ++ brk (1,1) ++ pr (TacArg t))
 
-let pr_let_clauses pr = function
+let pr_let_clauses recflag pr = function
   | hd::tl ->
       hv 0
-        (pr_let_clause "let " pr hd ++
+        (pr_let_clause (if recflag then "let rec " else "let ") pr hd ++
          prlist (fun t -> spc () ++ pr_let_clause "with " pr t) tl)
   | [] -> anomaly "LetIn must declare at least one binding"
 
-let pr_rec_clause pr (id,(l,t)) =
-  hov 0
-    (pr_lident id ++ prlist pr_funvar l ++ str " :=") ++ spc () ++ pr t
-
-let pr_rec_clauses pr l = 
-  prlist_with_sep (fun () -> fnl () ++ str "with ") (pr_rec_clause pr) l
-
 let pr_seq_body pr tl =
   hv 0 (str "[ " ++
         prlist_with_sep (fun () -> spc () ++ str "| ") pr tl ++
         str " ]")
 
+let pr_opt_tactic pr = function
+  | TacId [] -> mt ()
+  | t -> pr t
+
+let pr_then_gen pr tf tm tl =
+  hv 0 (str "[ " ++
+        prvect_with_sep mt (fun t -> pr t ++ spc () ++ str "| ") tf ++
+	pr_opt_tactic pr tm ++ str ".." ++
+	prvect_with_sep mt (fun t -> spc () ++ str "| " ++ pr t) tl ++
+        str " ]")
+
 let pr_hintbases = function
   | None -> spc () ++ str "with *"
   | Some [] -> mt ()
@@ -618,7 +646,8 @@ let rec pr_atom0 = function
   | TacIntroPattern [] -> str "intros"
   | TacIntroMove (None,None) -> str "intro"
   | TacAssumption -> str "assumption"
-  | TacAnyConstructor None -> str "constructor"
+  | TacAnyConstructor (false,None) -> str "constructor"
+  | TacAnyConstructor (true,None) -> str "econstructor"
   | TacTrivial ([],Some []) -> str "trivial"
   | TacAuto (None,[],Some []) -> str "auto"
   | TacReflexivity -> str "reflexivity"
@@ -653,19 +682,25 @@ and pr_atom1 = function
   | TacExact c -> hov 1 (str "exact" ++ pr_constrarg c)
   | TacExactNoCheck c -> hov 1 (str "exact_no_check" ++ pr_constrarg c)
   | TacVmCastNoCheck c -> hov 1 (str "vm_cast_no_check" ++ pr_constrarg c)
-  | TacApply cb -> hov 1 (str "apply" ++ spc () ++ pr_with_bindings cb)
-  | TacElim (cb,cbo) ->
-      hov 1 (str "elim" ++ pr_arg pr_with_bindings cb ++ 
+  | TacApply (a,ev,cb) ->
+      hov 1 ((if a then mt() else str "simple ") ++
+             str (with_evars ev "apply") ++ spc () ++ 
+             pr_with_bindings cb)
+  | TacElim (ev,cb,cbo) ->
+      hov 1 (str (with_evars ev "elim") ++ pr_arg pr_with_bindings cb ++ 
         pr_opt pr_eliminator cbo)
   | TacElimType c -> hov 1 (str "elimtype" ++ pr_constrarg c)
-  | TacCase cb -> hov 1 (str "case" ++ spc () ++ pr_with_bindings cb)
+  | TacCase (ev,cb) ->
+      hov 1 (str (with_evars ev "case") ++ spc () ++ pr_with_bindings cb)
   | TacCaseType c -> hov 1 (str "casetype" ++ pr_constrarg c)
   | TacFix (ido,n) -> hov 1 (str "fix" ++ pr_opt pr_id ido ++ pr_intarg n)
-  | TacMutualFix (id,n,l) ->
+  | TacMutualFix (hidden,id,n,l) ->
+      if hidden then str "idtac" (* should caught before! *) else
       hov 1 (str "fix" ++ spc () ++ pr_id id ++ pr_intarg n ++ spc() ++
              str"with " ++ prlist_with_sep spc pr_fix_tac l)
   | TacCofix ido -> hov 1 (str "cofix" ++ pr_opt pr_id ido)
-  | TacMutualCofix (id,l) ->
+  | TacMutualCofix (hidden,id,l) ->
+      if hidden then str "idtac" (* should be caught before! *) else
       hov 1 (str "cofix" ++ spc () ++ pr_id id ++ spc() ++
              str"with " ++ prlist_with_sep spc pr_cofix_tac l)
   | TacCut c -> hov 1 (str "cut" ++ pr_constrarg c)
@@ -678,14 +713,18 @@ and pr_atom1 = function
              pr_assertion pr_lconstr pr_constr ipat c)
   | TacGeneralize l ->
       hov 1 (str "generalize" ++ spc () ++
-             prlist_with_sep spc pr_constr l)
+             prlist_with_sep pr_coma (fun (cl,na) -> 
+	       pr_with_occurrences pr_constr cl ++ pr_as_name na)
+	     l)
   | TacGeneralizeDep c ->
       hov 1 (str "generalize" ++ spc () ++ str "dependent" ++
              pr_constrarg c)
-  | TacLetTac (na,c,cl) when cl = nowhere ->
+  | TacLetTac (na,c,cl,true) when cl = nowhere ->
       hov 1 (str "pose" ++ pr_pose pr_lconstr pr_constr na c)
-  | TacLetTac (na,c,cl) ->
-      hov 1 (str "set" ++ pr_pose pr_lconstr pr_constr na c ++
+  | TacLetTac (na,c,cl,b) ->
+      hov 1 ((if b then str "set" else str "remember") ++
+             (if b then pr_pose pr_lconstr else pr_pose_as_style)
+	        pr_constr na c ++
              pr_clauses pr_ident cl)
 (*  | TacInstantiate (n,c,ConclLocation ()) ->
       hov 1 (str "instantiate" ++ spc() ++
@@ -700,18 +739,20 @@ and pr_atom1 = function
   (* Derived basic tactics *)
   | TacSimpleInduction h ->
       hov 1 (str "simple induction" ++ pr_arg pr_quantified_hypothesis h)
-  | TacNewInduction (h,e,ids) ->
-      hov 1 (str "induction" ++ spc () ++
-	     prlist_with_sep spc (pr_induction_arg pr_constr) h ++
+  | TacNewInduction (ev,h,e,ids,cl) ->
+      hov 1 (str (with_evars ev "induction") ++ spc () ++
+	     prlist_with_sep spc (pr_induction_arg pr_lconstr pr_constr) h ++
 	     pr_with_names ids ++
-             pr_opt pr_eliminator e)
+             pr_opt pr_eliminator e ++
+             pr_opt_no_spc (pr_clauses pr_ident) cl)
   | TacSimpleDestruct h ->
       hov 1 (str "simple destruct" ++ pr_arg pr_quantified_hypothesis h)
-  | TacNewDestruct (h,e,ids) ->
-      hov 1 (str "destruct" ++ spc () ++
-             prlist_with_sep spc (pr_induction_arg pr_constr) h ++ 
+  | TacNewDestruct (ev,h,e,ids,cl) ->
+      hov 1 (str (with_evars ev "destruct") ++ spc () ++
+             prlist_with_sep spc (pr_induction_arg pr_lconstr pr_constr) h ++ 
 	     pr_with_names ids ++
-             pr_opt pr_eliminator e)
+             pr_opt pr_eliminator e ++
+             pr_opt_no_spc (pr_clauses pr_ident) cl)
   | TacDoubleInduction (h1,h2) ->
       hov 1
         (str "double induction" ++  
@@ -740,8 +781,9 @@ and pr_atom1 = function
   | TacAuto (n,lems,db) ->
       hov 0 (str "auto" ++ pr_opt (pr_or_var int) n ++ 
              pr_auto_using pr_constr lems ++ pr_hintbases db)
-  | TacDAuto (n,p) ->
-      hov 1 (str "auto" ++ pr_opt (pr_or_var int) n ++ str "decomp" ++ pr_opt int p)
+  | TacDAuto (n,p,lems) ->
+      hov 1 (str "auto" ++ pr_opt (pr_or_var int) n ++ str "decomp" ++ 
+             pr_opt int p ++ pr_auto_using pr_constr lems)
 
   (* Context management *)
   | TacClear (true,[]) as t -> pr_atom0 t
@@ -756,21 +798,28 @@ and pr_atom1 = function
       hov 1
         (str "move" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
 	 str "after" ++ brk (1,1) ++ pr_ident id2)
-  | TacRename (id1,id2) ->
+  | TacRename l ->
       hov 1
-        (str "rename" ++ brk (1,1) ++ pr_ident id1 ++ spc () ++ 
-	 str "into" ++ brk (1,1) ++ pr_ident id2)
+        (str "rename" ++ brk (1,1) ++
+         prlist_with_sep 
+	   (fun () -> str "," ++ brk (1,1))
+	   (fun (i1,i2) -> 
+	      pr_ident i1 ++ spc () ++ str "into" ++ spc () ++ pr_ident i2)
+	   l)
+  | TacRevert l -> 
+      hov 1 (str "revert" ++ spc () ++ prlist_with_sep spc pr_ident l) 
 
   (* Constructors *)
-  | TacLeft l -> hov 1 (str "left" ++ pr_bindings l)
-  | TacRight l -> hov 1 (str "right" ++ pr_bindings l)
-  | TacSplit (false,l) -> hov 1 (str "split" ++ pr_bindings l)
-  | TacSplit (true,l) -> hov 1 (str "exists" ++ pr_ex_bindings l)
-  | TacAnyConstructor (Some t) ->
-      hov 1 (str "constructor" ++ pr_arg (pr_tac_level (latom,E)) t)
-  | TacAnyConstructor None as t -> pr_atom0 t
-  | TacConstructor (n,l) ->
-      hov 1 (str "constructor" ++ pr_or_metaid pr_intarg n ++ pr_bindings l)
+  | TacLeft (ev,l) -> hov 1 (str (with_evars ev "left") ++ pr_bindings l)
+  | TacRight (ev,l) -> hov 1 (str (with_evars ev "right") ++ pr_bindings l)
+  | TacSplit (ev,false,l) -> hov 1 (str (with_evars ev "split") ++ pr_bindings l)
+  | TacSplit (ev,true,l) -> hov 1 (str (with_evars ev "exists") ++ pr_ex_bindings l)
+  | TacAnyConstructor (ev,Some t) ->
+      hov 1 (str (with_evars ev "constructor") ++ pr_arg (pr_tac_level (latom,E)) t)
+  | TacAnyConstructor (ev,None) as t -> pr_atom0 t
+  | TacConstructor (ev,n,l) ->
+      hov 1 (str (with_evars ev "constructor") ++ 
+             pr_or_metaid pr_intarg n ++ pr_bindings l)
 
   (* Conversion *)  
   | TacReduce (r,h) ->
@@ -780,12 +829,9 @@ and pr_atom1 = function
       hov 1 (str "change" ++ brk (1,1) ++
       (match occ with
           None -> mt()
-        | Some([],c1) -> hov 1 (pr_constr c1 ++ spc() ++ str "with ")
-        | Some(ocl,c1) ->
-            hov 1 (pr_constr c1 ++ spc() ++
-	           str "at " ++ prlist_with_sep spc (pr_or_var int) ocl) ++
-                   spc() ++
-	           str "with ") ++
+        | Some occlc ->
+	    pr_with_occurrences_with_trailer pr_constr occlc 
+	      (spc () ++ str "with ")) ++
       pr_constr c ++ pr_clauses pr_ident h)
 
   (* Equivalence relations *)
@@ -794,9 +840,15 @@ and pr_atom1 = function
   | TacTransitivity c -> str "transitivity" ++ pr_constrarg c
 
   (* Equality and inversion *)
-  | TacRewrite (b,c,cl) -> 
-      hov 1 (str "rewrite" ++ pr_orient b ++ spc() ++ pr_with_bindings c ++ 
-             pr_clauses pr_ident cl) 
+  | TacRewrite (ev,l,cl,by) -> 
+      hov 1 (str (with_evars ev "rewrite") ++ 
+	     prlist_with_sep
+	     (fun () -> str ","++spc())
+	     (fun (b,m,c) -> 
+		pr_orient b ++ spc() ++ pr_multi m ++ pr_with_bindings c)
+	     l
+	     ++ pr_clauses pr_ident cl
+	     ++	(match by with Some by -> pr_by_tactic (pr_tac_level ltop) by | None -> mt())) 
   | TacInversion (DepInversion (k,c,ids),hyp) ->
       hov 1 (str "dependent " ++ pr_induction_kind k ++ spc () ++
       pr_quantified_hypothesis hyp ++
@@ -821,15 +873,9 @@ let rec pr_tac inherited tac =
        (str "abstract (" ++ pr_tac (labstract,L) t ++ str")" ++ spc () ++
         str "using " ++ pr_id s),
       labstract
-  | TacLetRecIn (l,t) -> 
-      hv 0
-        (str "let rec " ++ pr_rec_clauses (pr_tac ltop) l ++ str " in" ++
-         fnl () ++ pr_tac (llet,E) t),
-      llet
-  | TacLetIn (llc,u) ->
+  | TacLetIn (recflag,llc,u) ->
       v 0
-       (hv 0 (pr_let_clauses (pr_tac ltop) llc
-       ++ str " in") ++
+       (hv 0 (pr_let_clauses recflag (pr_tac ltop) llc ++ str " in") ++
        fnl () ++ pr_tac (llet,E) u),
       llet
   | TacMatch (lz,t,lrul) ->
@@ -858,10 +904,14 @@ let rec pr_tac inherited tac =
       hov 1 (pr_tac (lseq,E) t ++ pr_then () ++ spc () ++
              pr_seq_body (pr_tac ltop) tl),
       lseq
-  | TacThen (t1,t2) ->
+  | TacThen (t1,[||],t2,[||]) ->
       hov 1 (pr_tac (lseq,E) t1 ++ pr_then () ++ spc () ++
              pr_tac (lseq,L) t2),
       lseq
+  | TacThen (t1,tf,t2,tl) ->
+      hov 1 (pr_tac (lseq,E) t1 ++ pr_then () ++ spc () ++
+             pr_then_gen (pr_tac ltop) tf t2 tl),
+      lseq
   | TacTry t ->
       hov 1 (str "try" ++ spc () ++ pr_tac (ltactical,E) t),
       ltactical
@@ -906,6 +956,7 @@ let rec pr_tac inherited tac =
       pr_may_eval pr_constr pr_lconstr pr_cst c, leval
   | TacArg(TacFreshId l) -> str "fresh" ++ pr_fresh_ids l, latom
   | TacArg(Integer n) -> int n, latom
+  | TacArg(TacCall(loc,f,[])) -> pr_ref f, latom
   | TacArg(TacCall(loc,f,l)) ->
       pr_with_comments loc
         (hov 1 (pr_ref f ++ spc () ++
@@ -919,7 +970,8 @@ let rec pr_tac inherited tac =
 and pr_tacarg = function
   | TacDynamic (loc,t) ->
       pr_with_comments loc (str ("<dynamic ["^(Dyn.tag t)^"]>"))
-  | MetaIdArg (loc,s) -> pr_with_comments loc (str ("$" ^ s))
+  | MetaIdArg (loc,true,s) -> pr_with_comments loc (str ("$" ^ s))
+  | MetaIdArg (loc,false,s) -> pr_with_comments loc (str ("constr: $" ^ s))
   | IntroPattern ipat -> str "ipattern:" ++ pr_intro_pattern ipat
   | TacVoid -> str "()"
   | Reference r -> pr_ref r
@@ -938,17 +990,17 @@ let strip_prod_binders_rawterm n (ty,_) =
   let rec strip_ty acc n ty =
     if n=0 then (List.rev acc, (ty,None)) else
       match ty with
-          Rawterm.RProd(loc,na,a,b) ->
+          Rawterm.RProd(loc,na,Explicit,a,b) ->
             strip_ty (([dummy_loc,na],(a,None))::acc) (n-1) b
         | _ -> error "Cannot translate fix tactic: not enough products" in
   strip_ty [] n ty
 
-let strip_prod_binders_constr n ty =
+let strip_prod_binders_constr n (sigma,ty) =
   let rec strip_ty acc n ty =
-    if n=0 then (List.rev acc, ty) else
+    if n=0 then (List.rev acc, (sigma,ty)) else
       match Term.kind_of_term ty with
           Term.Prod(na,a,b) ->
-            strip_ty (([dummy_loc,na],a)::acc) (n-1) b
+            strip_ty (([dummy_loc,na],(sigma,a))::acc) (n-1) b
         | _ -> error "Cannot translate fix tactic: not enough products" in
   strip_ty [] n ty
 
@@ -959,8 +1011,8 @@ let rec raw_printers =
      drop_env pr_constr_expr,
      drop_env pr_lconstr_expr,
      pr_lpattern_expr,
-     drop_env pr_reference,
-     drop_env pr_reference,
+     drop_env (pr_or_by_notation pr_reference),
+     drop_env (pr_or_by_notation pr_reference),
      pr_reference,
      pr_or_metaid pr_lident,
      pr_raw_extend,
@@ -994,8 +1046,8 @@ and pr_glob_match_rule env t =
 
 let typed_printers =
     (pr_glob_tactic_level,
-     pr_constr_env,
-     pr_lconstr_env,
+     pr_open_constr_env,
+     pr_open_lconstr_env,
      pr_lconstr_pattern,
      pr_evaluable_reference_env,
      pr_inductive,
diff --git a/parsing/pptactic.mli b/parsing/pptactic.mli
index ccdf3776..e5162dae 100644
--- a/parsing/pptactic.mli
+++ b/parsing/pptactic.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pptactic.mli 7937 2006-01-28 19:58:11Z herbelin $ i*)
+(*i $Id: pptactic.mli 9842 2007-05-20 17:44:23Z herbelin $ i*)
 
 open Pp
 open Genarg
@@ -17,10 +17,12 @@ open Topconstr
 open Rawterm
 open Ppextend
 open Environ
+open Evd
 
 val pr_or_var : ('a -> std_ppcmds) -> 'a or_var -> std_ppcmds
 val pr_or_metaid : ('a -> std_ppcmds) -> 'a or_metaid -> std_ppcmds
 val pr_and_short_name : ('a -> std_ppcmds) -> 'a and_short_name -> std_ppcmds
+val pr_or_by_notation : ('a -> std_ppcmds) -> 'a or_by_notation -> std_ppcmds
 
 type 'a raw_extra_genarg_printer =
     (constr_expr -> std_ppcmds) -> 
@@ -44,7 +46,7 @@ type 'a extra_genarg_printer =
 val declare_extra_genarg_pprule : 
   ('c raw_abstract_argument_type * 'c raw_extra_genarg_printer) ->
   ('a glob_abstract_argument_type * 'a glob_extra_genarg_printer) ->
-  ('b closed_abstract_argument_type * 'b extra_genarg_printer) -> unit
+  ('b typed_abstract_argument_type * 'b extra_genarg_printer) -> unit
 
 type grammar_terminals = string option list
 
@@ -58,9 +60,8 @@ val pr_raw_generic :
   (constr_expr -> std_ppcmds) ->
   (constr_expr -> std_ppcmds) ->
   (tolerability -> raw_tactic_expr -> std_ppcmds) ->
-  (Libnames.reference -> std_ppcmds) ->
-    (constr_expr, raw_tactic_expr) generic_argument ->
-      std_ppcmds
+  (Libnames.reference -> std_ppcmds) -> constr_expr generic_argument ->
+    std_ppcmds
 
 val pr_raw_extend:
   (constr_expr -> std_ppcmds) -> (constr_expr -> std_ppcmds) ->
@@ -73,9 +74,9 @@ val pr_glob_extend:
     string -> glob_generic_argument list -> std_ppcmds
 
 val pr_extend :
-  (Term.constr -> std_ppcmds) -> (Term.constr -> std_ppcmds) ->
+  (open_constr -> std_ppcmds) -> (open_constr -> std_ppcmds) ->
   (tolerability -> glob_tactic_expr -> std_ppcmds) -> int ->
-    string -> closed_generic_argument list -> std_ppcmds
+    string -> typed_generic_argument list -> std_ppcmds
 
 val pr_raw_tactic : env -> raw_tactic_expr -> std_ppcmds
 
@@ -88,3 +89,7 @@ val pr_tactic : env -> Proof_type.tactic_expr -> std_ppcmds
 val pr_hintbases : string list option -> std_ppcmds
 
 val pr_auto_using : ('constr -> std_ppcmds) -> 'constr list -> std_ppcmds
+
+val pr_bindings :
+  ('constr -> std_ppcmds) ->
+  ('constr -> std_ppcmds) -> 'constr bindings -> std_ppcmds
diff --git a/parsing/ppvernac.ml b/parsing/ppvernac.ml
index 77f0d5cb..ac2adde2 100644
--- a/parsing/ppvernac.ml
+++ b/parsing/ppvernac.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ppvernac.ml 10087 2007-08-24 10:39:30Z herbelin $ *)  
+(* $Id: ppvernac.ml 11059 2008-06-06 09:29:20Z herbelin $ *)  
 
 open Pp
 open Names
@@ -50,7 +50,7 @@ let pr_lname = function
     (loc,Name id) -> pr_lident (loc,id)
   | lna -> pr_located pr_name lna
 
-let pr_ltac_id = Nameops.pr_id
+let pr_ltac_id = Libnames.pr_reference
 
 let pr_module = Libnames.pr_reference
 
@@ -144,10 +144,14 @@ let pr_search a b pr_p = match a with
   | SearchAbout sl -> str"SearchAbout" ++ spc() ++ str "[" ++ prlist_with_sep spc pr_search_about sl ++ str "]" ++ pr_in_out_modules b
 
 let pr_locality local = if local then str "Local " else str ""
+let pr_non_globality local = if local then str "" else str "Global "
 
-let pr_explanation imps = function
-  | ExplByPos n -> pr_id (Impargs.name_of_implicit (List.nth imps (n-1)))
-  | ExplByName id -> pr_id id
+let pr_explanation (e,b,f) =
+  let a = match e with
+  | ExplByPos (n,_) -> anomaly "No more supported"
+  | ExplByName id -> pr_id id in
+  let a = if f then str"!" ++ a else a in
+    if b then str "[" ++ a ++ str "]" else a
 
 let pr_class_rawexpr = function
   | FunClass -> str"Funclass"
@@ -161,6 +165,9 @@ let pr_option_ref_value = function
 let pr_printoption a b = match a with
   | Goptions.PrimaryTable table -> str table ++ pr_opt (prlist_with_sep sep pr_option_ref_value) b
   | Goptions.SecondaryTable (table,field) -> str table ++ spc() ++ str field ++ pr_opt (prlist_with_sep sep pr_option_ref_value) b
+  | Goptions.TertiaryTable (table,field1,field2) -> str table ++ spc() ++
+      str field1 ++ spc() ++ str field2 ++ 
+      pr_opt (prlist_with_sep sep pr_option_ref_value) b
 
 let pr_set_option a b = 
   let pr_opt_value = function 
@@ -184,7 +191,10 @@ let pr_hints local db h pr_c pr_pat =
   let pph =
     match h with
     | HintsResolve l ->
-        str "Resolve " ++ prlist_with_sep sep pr_c l
+        str "Resolve " ++ prlist_with_sep sep 
+	  (fun (pri, c) -> pr_c c ++ 
+	    match pri with Some x -> spc () ++ str"(" ++ int x ++ str")" | None -> mt ())
+	  l
     | HintsImmediate l ->
         str"Immediate" ++ spc() ++ prlist_with_sep sep pr_c l
     | HintsUnfold l ->
@@ -215,6 +225,18 @@ let rec pr_module_type pr_c = function
       let m = pr_module_type pr_c mty in
       let p = pr_with_declaration pr_c decl in
       m ++ spc() ++ str"with" ++ spc() ++ p
+  | CMTEapply (fexpr,mexpr)->
+      let f = pr_module_type pr_c fexpr in
+      let m = pr_module_expr mexpr in
+	f ++ spc () ++ m 
+	  
+and  pr_module_expr = function
+  | CMEident qid -> pr_located pr_qualid qid
+  | CMEapply (me1,(CMEident _ as me2)) ->
+      pr_module_expr me1 ++ spc() ++ pr_module_expr me2
+  | CMEapply (me1,me2) ->
+      pr_module_expr me1 ++ spc() ++
+      hov 1 (str"(" ++ pr_module_expr me2 ++ str")")
 
 let pr_of_module_type prc (mty,b) =
   str (if b then ":" else "<:") ++
@@ -247,16 +269,8 @@ let pr_module_binders l pr_c =
 
 let pr_module_binders_list l pr_c = pr_module_binders l pr_c
 
-let rec pr_module_expr = function
-  | CMEident qid -> pr_located pr_qualid qid
-  | CMEapply (me1,(CMEident _ as me2)) ->
-      pr_module_expr me1 ++ spc() ++ pr_module_expr me2
-  | CMEapply (me1,me2) ->
-      pr_module_expr me1 ++ spc() ++
-      hov 1 (str"(" ++ pr_module_expr me2 ++ str")")
-
 let pr_type_option pr_c = function
-  | CHole loc -> mt()
+  | CHole (loc, k) -> mt()
   | _ as c -> brk(0,2) ++ str":" ++ pr_c c
 
 let pr_decl_notation prc =
@@ -273,11 +287,23 @@ let pr_binders_arg =
 let pr_and_type_binders_arg bl =
   pr_binders_arg bl
 
-let pr_onescheme (id,dep,ind,s) =
-  hov 0 (pr_lident id ++ str" :=") ++ spc() ++
-  hov 0 ((if dep then str"Induction for" else str"Minimality for")
-  ++ spc() ++ pr_reference ind) ++ spc() ++ 
-  hov 0 (str"Sort" ++ spc() ++ pr_rawsort s)
+let pr_onescheme (idop,schem) =
+  match schem with 
+  | InductionScheme (dep,ind,s) ->
+    (match idop with
+      | Some id -> hov 0 (pr_lident id ++ str" :=") ++ spc()
+      | None -> spc ()
+    ) ++
+    hov 0 ((if dep then str"Induction for" else str"Minimality for")
+    ++ spc() ++ pr_reference ind) ++ spc() ++ 
+    hov 0 (str"Sort" ++ spc() ++ pr_rawsort s)
+  | EqualityScheme ind -> 
+    (match idop with
+      | Some id -> hov 0 (pr_lident id ++ str" :=") ++ spc()
+      | None -> spc()
+    ) ++
+    hov 0 (str"Equality for")
+    ++ spc() ++ pr_reference ind
 
 let begin_of_inductive = function
     [] -> 0
@@ -376,6 +402,12 @@ let make_pr_vernac pr_constr pr_lconstr =
 let pr_constrarg c = spc () ++ pr_constr c in
 let pr_lconstrarg c = spc () ++ pr_lconstr c in
 let pr_intarg n = spc () ++ int n in
+let pr_lident_constr sep (i,c) = pr_lident i ++ sep ++ pr_constrarg c in
+let pr_lname_lident_constr (oi,bk,a) = 
+  (match snd oi with Anonymous -> mt () | Name id -> pr_lident (fst oi, id) ++ spc () ++ str":" ++ spc ()) 
+  ++ pr_lconstr a in
+let pr_instance_def sep (i,l,c) = pr_lident i ++ prlist_with_sep spc pr_lident l 
+  ++ sep ++ pr_constrarg c in
 
 let rec pr_vernac = function
   
@@ -388,6 +420,7 @@ let rec pr_vernac = function
   | VernacAbort id -> str"Abort" ++ pr_opt pr_lident id
   | VernacResume id -> str"Resume" ++ pr_opt pr_lident id
   | VernacUndo i -> if i=1 then str"Undo" else str"Undo" ++ pr_intarg i
+  | VernacUndoTo i -> str"Undo" ++ spc() ++ str"To" ++ pr_intarg i
   | VernacBacktrack (i,j,k) -> 
       str "Backtrack" ++  spc() ++ prlist_with_sep sep int [i;j;k]
   | VernacFocus i -> str"Focus" ++ pr_opt int i
@@ -417,6 +450,7 @@ let rec pr_vernac = function
   | VernacCheckGuard -> str"Guarded"
 
   (* Resetting *)
+  | VernacRemoveName id -> str"Remove" ++ spc() ++ pr_lident id
   | VernacResetName id -> str"Reset" ++ spc() ++ pr_lident id
   | VernacResetInitial -> str"Reset Initial"
   | VernacBack i -> if i=1 then str"Back" else str"Back" ++ pr_intarg i
@@ -434,7 +468,6 @@ let rec pr_vernac = function
   | VernacLoad (f,s) -> str"Load" ++ if f then (spc() ++ str"Verbose"
   ++ spc()) else spc()  ++ qs s
   | VernacTime v -> str"Time" ++ spc() ++ pr_vernac v
-  | VernacVar id -> pr_lident id
   
   (* Syntax *) 
   | VernacTacticNotation (n,r,e) -> pr_grammar_tactic_rule n ("",r,e)
@@ -450,7 +483,8 @@ let rec pr_vernac = function
   | VernacArgumentsScope (local,q,scl) -> let pr_opt_scope = function 
       |	None -> str"_"
       |	Some sc -> str sc in 
-    str"Arguments Scope" ++ spc() ++ pr_reference q ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
+    str"Arguments Scope" ++ spc() ++ pr_non_globality local ++ pr_reference q 
+    ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
   | VernacInfix (local,(s,mv),q,sn) -> (* A Verifier *)
       hov 0 (hov 0 (str"Infix " ++ pr_locality local
       ++ qs s ++ str " :=" ++ spc() ++ pr_reference q) ++
@@ -482,7 +516,7 @@ let rec pr_vernac = function
         | None -> mt()
         | Some r ->
             str"Eval" ++ spc() ++
-            pr_red_expr (pr_constr, pr_lconstr, pr_reference) r ++
+            pr_red_expr (pr_constr, pr_lconstr, pr_or_by_notation pr_reference) r ++
             str" in" ++ spc() in
       let pr_def_body = function
         | DefineBody (bl,red,body,d) ->
@@ -499,12 +533,15 @@ let rec pr_vernac = function
         | None -> mt()
         | Some cc -> str" :=" ++ spc() ++ cc))
 
-  | VernacStartTheoremProof (ki,id,(bl,c),b,d) ->
-      hov 1 (pr_thm_token ki ++ spc() ++ pr_lident id ++ spc() ++
-      (match bl with
-        | [] -> mt()
-        | _ -> pr_binders bl ++ spc())
-      ++ str":" ++ pr_spc_lconstr c)
+  | VernacStartTheoremProof (ki,l,_,_) ->
+      let pr_statement head (id,(bl,c)) =
+        hov 0
+          (head ++ spc () ++ pr_opt pr_lident id ++ spc() ++
+              (match bl with [] -> mt() | _ -> pr_binders bl ++ spc()) ++
+              str":" ++ pr_spc_lconstr c) in
+      hov 1 (pr_statement (pr_thm_token ki) (List.hd l) ++
+             prlist (pr_statement (str "with ")) (List.tl l))
+
   | VernacEndProof Admitted -> str"Admitted"
   | VernacEndProof (Proved (opac,o)) -> (match o with
     | None -> if opac then str"Qed" else str"Defined"
@@ -513,7 +550,7 @@ let rec pr_vernac = function
       |	Some tok -> str"Save" ++ spc() ++ pr_thm_token tok ++ spc() ++ pr_lident id)) 
   | VernacExactProof c ->
       hov 2 (str"Proof" ++ pr_lconstrarg c)
-  | VernacAssumption (stre,l) ->
+  | VernacAssumption (stre,_,l) ->
       let n = List.length (List.flatten (List.map fst (List.map snd l))) in
       hov 2
         (pr_assumption_token (n > 1) stre ++ spc() ++ 
@@ -546,35 +583,30 @@ let rec pr_vernac = function
 
   | VernacFixpoint (recs,b) ->
       let name_of_binder = function
-        | LocalRawAssum (nal,_) -> nal
+        | LocalRawAssum (nal,_,_) -> nal
         | LocalRawDef (_,_) -> [] in
       let pr_onerec = function
-        | (id,(n,ro),bl,type_,def),ntn ->
+        | ((loc,id),(n,ro),bl,type_,def),ntn ->
             let (bl',def,type_) =
-              if Options.do_translate() then extract_def_binders def type_
+              if Flags.do_translate() then extract_def_binders def type_
               else ([],def,type_) in
             let bl = bl @ bl' in
             let ids = List.flatten (List.map name_of_binder bl) in
             let annot =
 	      match n with 
 		| None -> mt () 
-		| Some n -> 
-		    let name =
-		      try snd (List.nth ids n)
-		      with Failure _ ->
-			warn (str "non-printable fixpoint \""++pr_id id++str"\"");
-			Anonymous in
+		| Some (loc, id) -> 
 		    match (ro : Topconstr.recursion_order_expr) with
 			CStructRec -> 
 			  if List.length ids > 1 then 
-			    spc() ++ str "{struct " ++ pr_name name ++ str"}"
+			    spc() ++ str "{struct " ++ pr_id id ++ str"}"
 			  else mt()
 		      | CWfRec c -> 
 			  spc() ++ str "{wf " ++ pr_lconstr_expr c ++ spc() ++ 
-			    pr_name name ++ str"}"
+			    pr_id id ++ str"}"
 		      | CMeasureRec c -> 
 			  spc() ++ str "{measure " ++ pr_lconstr_expr c ++ spc() ++ 
-			    pr_name name ++ str"}"
+			    pr_id id ++ str"}"
 	    in
             pr_id id ++ pr_binders_arg bl ++ annot ++ spc()
             ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) type_
@@ -586,9 +618,9 @@ let rec pr_vernac = function
         prlist_with_sep (fun _ -> fnl() ++ fnl() ++ str"with ") pr_onerec recs)
 
   | VernacCoFixpoint (corecs,b) ->
-      let pr_onecorec ((id,bl,c,def),ntn) =
+      let pr_onecorec (((loc,id),bl,c,def),ntn) =
         let (bl',def,c) =
-              if Options.do_translate() then extract_def_binders def c
+              if Flags.do_translate() then extract_def_binders def c
               else ([],def,c) in
         let bl = bl @ bl' in
         pr_id id ++ spc() ++ pr_binders bl ++ spc() ++ str":" ++
@@ -660,23 +692,64 @@ let rec pr_vernac = function
 	spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++ spc() ++ str">->" ++
 	spc() ++ pr_class_rawexpr c2)
 
+
+  | VernacClass (id, par, ar, sup, props) ->
+      hov 1 (
+	str"Class" ++ spc () ++ pr_lident id ++
+(* 	  prlist_with_sep (spc) (pr_lident_constr (spc() ++ str ":" ++ spc())) par ++  *)
+	  pr_and_type_binders_arg par ++
+	  (match ar with Some ar -> spc () ++ str":" ++ spc() ++ pr_rawsort (snd ar) | None -> mt()) ++
+	  spc () ++ str"where" ++ spc () ++
+	  prlist_with_sep (fun () -> str";" ++ spc()) 
+	  (fun (lid,oc,c) -> pr_lident_constr ((if oc then str" :>" else str" :") ++ spc()) (lid,c)) props )
+	
+ | VernacInstance (glob, sup, (instid, bk, cl), props, pri) -> 
+     hov 1 (
+       pr_non_globality (not glob) ++
+       str"Instance" ++ spc () ++ 
+	 pr_and_type_binders_arg sup ++
+	 str"=>" ++ spc () ++ 
+	 (match snd instid with Name id -> pr_lident (fst instid, id) ++ spc () ++ str":" ++ spc () | Anonymous -> mt ()) ++
+	 pr_constr_expr cl ++ spc () ++
+	 spc () ++ str"where" ++ spc () ++
+	 prlist_with_sep (fun () -> str";" ++ spc()) (pr_instance_def (spc () ++ str":=" ++ spc())) props)
+
+ | VernacContext l ->
+     hov 1 (
+       str"Context" ++ spc () ++ str"[" ++ spc () ++
+	 prlist_with_sep (fun () -> str"," ++ spc()) pr_lname_lident_constr l ++
+	 spc () ++ str "]")
+	      
+
+ | VernacDeclareInstance id ->
+     hov 1 (str"Instance" ++ spc () ++ pr_lident id)
+       
   (* Modules and Module Types *)
   | VernacDefineModule (export,m,bl,ty,bd) ->
       let b = pr_module_binders_list bl pr_lconstr in 
       hov 2 (str"Module" ++ spc() ++ pr_require_token export ++
-             pr_lident m ++ b ++
-             pr_opt (pr_of_module_type pr_lconstr) ty ++
-             pr_opt (fun me -> str ":= " ++ pr_module_expr me) bd)
+               pr_lident m ++ b ++
+               pr_opt (pr_of_module_type pr_lconstr) ty ++
+               pr_opt (fun me -> str ":= " ++ pr_module_expr me) bd)
   | VernacDeclareModule (export,id,bl,m1) ->
       let b = pr_module_binders_list bl pr_lconstr in 
-      hov 2 (str"Declare Module" ++ spc() ++ pr_require_token export ++
+	hov 2 (str"Declare Module" ++ spc() ++ pr_require_token export ++
              pr_lident id ++ b ++
              pr_of_module_type pr_lconstr m1)
   | VernacDeclareModuleType (id,bl,m) ->
       let b = pr_module_binders_list bl pr_lconstr in 
-      hov 2 (str"Module Type " ++ pr_lident id ++ b ++
-             pr_opt (fun mt -> str ":= " ++ pr_module_type pr_lconstr mt) m)
-
+	hov 2 (str"Module Type " ++ pr_lident id ++ b ++
+		 pr_opt (fun mt -> str ":= " ++ pr_module_type pr_lconstr mt) m)
+  | VernacInclude (in_ast) ->
+      begin
+	match in_ast with
+	  | CIMTE mty ->
+	      hov 2 (str"Include" ++ 
+		       (fun mt -> str " " ++ pr_module_type pr_lconstr mt) mty)
+	  | CIME mexpr ->
+	      hov 2 (str"Include" ++ 
+		       (fun me -> str " " ++ pr_module_expr me) mexpr)
+      end
   (* Solving *)
   | VernacSolve (i,tac,deftac) ->
       (if i = 1 then mt() else int i ++ str ": ") ++
@@ -719,49 +792,62 @@ let rec pr_vernac = function
 
   (* Commands *)
   | VernacDeclareTacticDefinition (rc,l) ->
-      let pr_tac_body (id, body) =
+      let pr_tac_body (id, redef, body) =
         let idl, body =
           match body with
 	    | Tacexpr.TacFun (idl,b) -> idl,b
             | _ -> [], body in
-        pr_located pr_ltac_id id ++ 
+        pr_ltac_id id ++ 
 	prlist (function None -> str " _"
                        | Some id -> spc () ++ pr_id id) idl
-	++ str" :=" ++ brk(1,1) ++
-	let idl = List.map out_some (List.filter (fun x -> not (x=None)) idl)in
+	++ (if redef then str" ::=" else str" :=") ++ brk(1,1) ++
+	let idl = List.map Option.get (List.filter (fun x -> not (x=None)) idl)in
         pr_raw_tactic_env 
-	  (idl @ List.map snd (List.map fst l))
+	  (idl @ List.map coerce_global_to_id 
+	    (List.map (fun (x, _, _) -> x) (List.filter (fun (_, redef, _) -> not redef) l)))
 	  (Global.env())
 	  body in
       hov 1
-        (((*if !Options.p1 then
+        (((*if !Flags.p1 then
 	  (if rc then str "Recursive " else mt()) ++
 	  str "Tactic Definition " else*)
 	    (* Rec by default *) str "Ltac ") ++
         prlist_with_sep (fun () -> fnl() ++ str"with ") pr_tac_body l)
   | VernacHints (local,dbnames,h) ->
       pr_hints local dbnames h pr_constr pr_pattern_expr
-  | VernacSyntacticDefinition (id,c,local,onlyparsing) ->
+  | VernacSyntacticDefinition (id,(ids,c),local,onlyparsing) ->
       hov 2
-        (str"Notation " ++ pr_locality local ++ pr_id id ++ str" :=" ++
-         pr_constrarg c ++
+        (str"Notation " ++ pr_locality local ++ pr_lident id ++ 
+	 prlist_with_sep spc pr_id ids ++ str" :=" ++ pr_constrarg c ++
          pr_syntax_modifiers (if onlyparsing then [SetOnlyParsing] else []))
   | VernacDeclareImplicits (local,q,None) ->
       hov 2 (str"Implicit Arguments" ++ spc() ++ pr_reference q)
-  | VernacDeclareImplicits (local,q,Some l) ->
-      let r = Nametab.global q in
-      Impargs.declare_manual_implicits local r l;
-      let imps = Impargs.implicits_of_global r in
-      hov 1 (str"Implicit Arguments" ++ spc() ++ pr_reference q ++ spc() ++
-             str"[" ++ prlist_with_sep sep (pr_explanation imps) l ++ str"]")
+  | VernacDeclareImplicits (local,q,Some imps) ->
+      hov 1 (str"Implicit Arguments " ++ pr_non_globality local ++
+	spc() ++ pr_reference q ++ spc() ++
+	str"[" ++ prlist_with_sep sep pr_explanation imps ++ str"]")
   | VernacReserve (idl,c) ->
       hov 1 (str"Implicit Type" ++
         str (if List.length idl > 1 then "s " else " ") ++
         prlist_with_sep spc pr_lident idl ++ str " :" ++ spc () ++
         pr_lconstr c)
-  | VernacSetOpacity (fl,l) ->
-      hov 1 ((if fl then str"Opaque" else str"Transparent") ++
+  | VernacSetOpacity(true,[k,l]) when k=Conv_oracle.transparent ->
+      hov 1 (str"Transparent" ++
+             spc() ++ prlist_with_sep sep pr_reference l)
+  | VernacSetOpacity(true,[Conv_oracle.Opaque,l]) ->
+      hov 1 (str"Opaque" ++
              spc() ++ prlist_with_sep sep pr_reference l)
+  | VernacSetOpacity (local,l) ->
+      let pr_lev = function
+          Conv_oracle.Opaque -> str"opaque"
+        | Conv_oracle.Expand -> str"expand"
+        | l when l = Conv_oracle.transparent -> str"transparent"
+        | Conv_oracle.Level n -> int n in
+      let pr_line (l,q) =
+        hov 2 (pr_lev l ++ spc() ++
+               str"[" ++ prlist_with_sep sep pr_reference q ++ str"]") in
+      hov 1 (pr_locality local ++ str"Strategy" ++ spc() ++
+             hv 0 (prlist_with_sep sep pr_line l))
   | VernacUnsetOption na ->
       hov 1 (str"Unset" ++ spc() ++ pr_printoption na None)
   | VernacSetOption (na,v) -> hov 2 (str"Set" ++ spc() ++ pr_set_option na v)
@@ -773,11 +859,11 @@ let rec pr_vernac = function
       let pr_mayeval r c = match r with 
       | Some r0 ->
           hov 2 (str"Eval" ++ spc() ++
-          pr_red_expr (pr_constr,pr_lconstr,pr_reference) r0 ++
+          pr_red_expr (pr_constr,pr_lconstr,pr_or_by_notation pr_reference) r0 ++
           spc() ++ str"in" ++ spc () ++ pr_constr c)
       | None -> hov 2 (str"Check" ++ spc() ++ pr_constr c) 
       in 
-      (if io = None then mt() else int (out_some io) ++ str ": ") ++ 
+      (if io = None then mt() else int (Option.get io) ++ str ": ") ++ 
       pr_mayeval r c
   | VernacGlobalCheck c -> hov 2 (str"Type" ++ pr_constrarg c)
   | VernacPrint p -> 
@@ -785,8 +871,7 @@ let rec pr_vernac = function
 	| PrintFullContext -> str"Print All"
 	| PrintSectionContext s ->
             str"Print Section" ++ spc() ++ Libnames.pr_reference s
-	| PrintGrammar (uni,ent) ->
-            msgerrnl (str "warning: no direct translation of Print Grammar entry"); 
+	| PrintGrammar ent ->
             str"Print Grammar" ++ spc() ++ str ent
 	| PrintLoadPath -> str"Print LoadPath"
 	| PrintModules -> str"Print Modules"
@@ -794,6 +879,8 @@ let rec pr_vernac = function
 	| PrintMLModules -> str"Print ML Modules"
 	| PrintGraph -> str"Print Graph"
 	| PrintClasses -> str"Print Classes"
+	| PrintTypeClasses -> str"Print TypeClasses"
+	| PrintInstances qid -> str"Print Instances" ++ spc () ++ pr_reference qid
 	| PrintLtac qid -> str"Print Ltac" ++ spc() ++ pr_reference qid
 	| PrintCoercions -> str"Print Coercions"
 	| PrintCoercionPaths (s,t) -> str"Print Coercion Paths" ++ spc() ++ pr_class_rawexpr s ++ spc() ++ pr_class_rawexpr t
@@ -810,12 +897,15 @@ let rec pr_vernac = function
 	| PrintModuleType qid -> str"Print Module Type" ++ spc() ++ pr_reference qid
 	| PrintModule qid -> str"Print Module" ++ spc() ++ pr_reference qid
 	| PrintInspect n -> str"Inspect" ++ spc() ++ int n
-  | PrintSetoids -> str"Print Setoids"
+	| PrintSetoids -> str"Print Setoids"
 	| PrintScopes -> str"Print Scopes"
 	| PrintScope s -> str"Print Scope" ++ spc() ++ str s 
 	| PrintVisibility s -> str"Print Visibility" ++ pr_opt str s 
 	| PrintAbout qid -> str"About" ++ spc()  ++ pr_reference qid
 	| PrintImplicit qid -> str"Print Implicit" ++ spc()  ++ pr_reference qid
+(* spiwack: command printing all the axioms and section variables used in a 
+         term *)
+	| PrintAssumptions qid -> str"Print Assumptions"++spc()++pr_reference qid
       in pr_printable p
   | VernacSearch (sea,sea_r) -> pr_search sea sea_r pr_pattern_expr
   | VernacLocate loc -> 
diff --git a/parsing/prettyp.ml b/parsing/prettyp.ml
index 57028469..401ef7fe 100644
--- a/parsing/prettyp.ml
+++ b/parsing/prettyp.ml
@@ -6,7 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: prettyp.ml 9314 2006-10-29 20:11:08Z herbelin $ *)
+(* Changed by (and thus parts copyright ©) by Lionel Elie Mamane <lionel@mamane.lu>
+ * on May-June 2006 for implementation of abstraction of pretty-printing of objects.
+ *)
+
+(* $Id: prettyp.ml 10971 2008-05-22 17:12:11Z barras $ *)
 
 open Pp
 open Util
@@ -29,6 +33,24 @@ open Libnames
 open Nametab
 open Recordops
 
+type object_pr = {
+  print_inductive           : mutual_inductive -> std_ppcmds;
+  print_constant_with_infos : constant -> std_ppcmds;
+  print_section_variable    : variable -> std_ppcmds;
+  print_syntactic_def       : kernel_name -> std_ppcmds;
+  print_module              : bool -> Names.module_path -> std_ppcmds;
+  print_modtype             : module_path -> std_ppcmds;
+  print_named_decl          : identifier * constr option * types -> std_ppcmds;
+  print_leaf_entry          : bool -> Libnames.object_name * Libobject.obj -> Pp.std_ppcmds;
+  print_library_entry       : bool -> (object_name * Lib.node) -> std_ppcmds option;
+  print_context             : bool -> int option -> Lib.library_segment -> std_ppcmds;
+  print_typed_value_in_env  : Environ.env -> Term.constr * Term.types -> Pp.std_ppcmds;
+  print_eval                : Reductionops.reduction_function -> env -> Evd.evar_map -> Topconstr.constr_expr -> unsafe_judgment -> std_ppcmds;
+}
+
+let gallina_print_module  = print_module
+let gallina_print_modtype = print_modtype
+
 (*********************)
 (** Basic printing   *)
 
@@ -36,29 +58,29 @@ let print_basename sp = pr_global (ConstRef sp)
 
 let print_closed_sections = ref false
 
+let with_line_skip p = if ismt p then mt() else (fnl () ++ p)
+
 (********************************)
 (** Printing implicit arguments *)
 			  		  
-let print_impl_args_by_pos = function
-  | []  -> mt ()
-  | [i] -> str"Position [" ++ int i ++ str"] is implicit" ++ fnl()
-  | l   -> 
-      str"Positions [" ++ 
-      prlist_with_sep (fun () -> str "; ") int l ++
-      str"] are implicit" ++ fnl()
+let conjugate_to_be = function [_] -> "is" | _ -> "are"
 
-let print_impl_args_by_name = function
+let pr_implicit imp = pr_id (name_of_implicit imp)
+
+let print_impl_args_by_name max = function
   | []  -> mt ()
-  | [i] -> str"Argument " ++ pr_id (name_of_implicit i) ++ str" is implicit" ++
-      fnl()
-  | l   -> 
-      str"Arguments " ++ 
-      prlist_with_sep (fun () -> str ", ")
-        (fun imp -> pr_id (name_of_implicit imp)) l ++
-      str" are implicit" ++ fnl()
+  | impls -> 
+      hov 0 (str (plural (List.length impls) "Argument") ++ spc() ++ 
+      prlist_with_sep pr_coma pr_implicit impls ++ spc() ++ 
+      str (conjugate_to_be impls) ++ str" implicit" ++
+      (if max then strbrk " and maximally inserted" else mt())) ++ fnl()
 
 let print_impl_args l = 
-  print_impl_args_by_name (List.filter is_status_implicit l)
+  let imps = List.filter is_status_implicit l in
+  let maximps = List.filter Impargs.maximal_insertion_of imps in
+  let nonmaximps = list_subtract imps maximps in
+  print_impl_args_by_name false nonmaximps ++
+  print_impl_args_by_name true maximps
 
 (*********************)
 (** Printing Scopes  *)
@@ -90,16 +112,17 @@ let need_expansion impl ref =
 
 type opacity =
   | FullyOpaque
-  | TransparentMaybeOpacified of bool
+  | TransparentMaybeOpacified of Conv_oracle.level
 
 let opacity env = function
   | VarRef v when pi2 (Environ.lookup_named v env) <> None -> 
-      Some (TransparentMaybeOpacified (Conv_oracle.is_opaque_var v))
+      Some(TransparentMaybeOpacified (Conv_oracle.get_strategy(VarKey v)))
   | ConstRef cst ->
       let cb = Environ.lookup_constant cst env in
       if cb.const_body = None then None
       else if cb.const_opaque then Some FullyOpaque
-      else Some (TransparentMaybeOpacified (Conv_oracle.is_opaque_cst cst))
+      else Some
+        (TransparentMaybeOpacified (Conv_oracle.get_strategy(ConstKey cst)))
   | _ -> None
 
 let print_opacity ref =
@@ -108,8 +131,14 @@ let print_opacity ref =
     | Some s -> pr_global ref ++ str " is " ++ 
         str (match s with
           | FullyOpaque -> "opaque"
-          | TransparentMaybeOpacified true -> "basically transparent but considered opaque for reduction"
-          | TransparentMaybeOpacified false -> "transparent") ++ fnl()
+          | TransparentMaybeOpacified Conv_oracle.Opaque ->
+              "basically transparent but considered opaque for reduction"
+          | TransparentMaybeOpacified lev when lev = Conv_oracle.transparent ->
+              "transparent"
+          | TransparentMaybeOpacified (Conv_oracle.Level n) ->
+              "transparent (with expansion weight "^string_of_int n^")"
+          | TransparentMaybeOpacified Conv_oracle.Expand ->
+              "transparent (with minimal expansion weight)") ++ fnl()
     
 let print_name_infos ref =
   let impl = implicits_of_global ref in
@@ -120,12 +149,7 @@ let print_name_infos ref =
       str "Expanded type for implicit arguments" ++ fnl () ++ 
       print_ref true ref ++ fnl()
     else mt() in
-  (if (List.filter is_status_implicit impl<>[])
-      or not (List.for_all ((=) None) scopes) 
-  then fnl()
-  else mt())
-  ++ type_for_implicit 
-  ++ print_impl_args impl ++ print_argument_scopes scopes
+  type_for_implicit ++ print_impl_args impl ++ print_argument_scopes scopes
 
 let print_id_args_data test pr id l =
   if List.exists test l then
@@ -158,7 +182,7 @@ type logical_name =
   | Term of global_reference
   | Dir of global_dir_reference
   | Syntactic of kernel_name
-  | ModuleType of qualid * kernel_name
+  | ModuleType of qualid * module_path
   | Undefined of qualid
 
 let locate_any_name ref =
@@ -223,21 +247,12 @@ let print_located_qualid ref =
 
 (******************************************)
 (**** Printing declarations and judgments *)
+(****  Gallina layer                  *****)
 
-let print_typed_value_in_env env (trm,typ) =
+let gallina_print_typed_value_in_env env (trm,typ) =
   (pr_lconstr_env env trm ++ fnl () ++
      str "     : " ++ pr_ltype_env env typ ++ fnl ())
 
-let print_typed_value x = print_typed_value_in_env (Global.env ()) x
-
-let print_judgment env {uj_val=trm;uj_type=typ} =
-  print_typed_value_in_env env (trm, typ)
-    
-let print_safe_judgment env j =
-  let trm = Safe_typing.j_val j in
-  let typ = Safe_typing.j_type j in
-  print_typed_value_in_env env (trm, typ)
-    
 (* To be improved; the type should be used to provide the types in the
    abstractions. This should be done recursively inside pr_lconstr, so that
    the pretty-print of a proposition (P:(nat->nat)->Prop)(P [u]u)
@@ -250,12 +265,12 @@ let print_named_def name body typ =
   (str "*** [" ++ str name ++ str " " ++
      hov 0 (str ":=" ++ brk (1,2) ++ pbody ++ spc () ++
 	      str ":" ++ brk (1,2) ++ ptyp) ++
-	   str "]" ++ fnl ())
+	   str "]")
 
 let print_named_assum name typ =
-  (str "*** [" ++ str name ++ str " : " ++ pr_ltype typ ++ str "]" ++ fnl ())
+  str "*** [" ++ str name ++ str " : " ++ pr_ltype typ ++ str "]"
 
-let print_named_decl (id,c,typ) =
+let gallina_print_named_decl (id,c,typ) =
   let s = string_of_id id in
   match c with
     | Some body -> print_named_def s body typ
@@ -307,28 +322,64 @@ let pr_mutual_inductive finite indl =
   hov 0 (
     str (if finite then "Inductive " else "CoInductive ") ++
     prlist_with_sep (fun () -> fnl () ++ str"  with ")
-      print_one_inductive indl) ++
-  fnl ()
+      print_one_inductive indl)
+
+let get_fields =
+  let rec prodec_rec l subst c =
+    match kind_of_term c with
+    | Prod (na,t,c) ->
+	let id = match na with Name id -> id | Anonymous -> id_of_string "_" in
+	prodec_rec ((id,true,substl subst t)::l) (mkVar id::subst) c
+    | LetIn (na,b,_,c) ->
+	let id = match na with Name id -> id | Anonymous -> id_of_string "_" in
+	prodec_rec ((id,false,substl subst b)::l) (mkVar id::subst) c
+    | _               -> List.rev l
+  in 
+  prodec_rec [] []
 
-let print_mutual sp =
+let pr_record (sp,tyi) =
+  let (ref, params, arity, cstrnames, cstrtypes) = build_inductive sp tyi in
+  let env = Global.env () in
+  let envpar = push_rel_context params env in
+  let fields = get_fields cstrtypes.(0) in
+  hov 0 (
+    hov 0 (
+      str "Record " ++ pr_global (IndRef (sp,tyi)) ++ brk(1,4) ++ 
+      print_params env params ++
+      str ": " ++ pr_lconstr_env envpar arity ++ brk(1,2) ++ 
+      str ":= " ++ pr_id cstrnames.(0)) ++ 
+    brk(1,2) ++
+    hv 2 (str "{ " ++
+      prlist_with_sep (fun () -> str "; " ++ brk(1,0))
+        (fun (id,b,c) -> 
+	  pr_id id ++ str (if b then " : " else " := ") ++ 
+	  pr_lconstr_env envpar c) fields) ++ str" }")
+
+let gallina_print_inductive sp =
   let (mib,mip) = Global.lookup_inductive (sp,0) in
   let mipv = mib.mind_packets in
   let names = list_tabulate (fun x -> (sp,x)) (Array.length mipv) in
-  pr_mutual_inductive mib.mind_finite names ++
-  print_inductive_implicit_args sp mipv ++
-  print_inductive_argument_scopes sp mipv
+  (if mib.mind_record & not !Flags.raw_print then
+    pr_record (List.hd names)
+  else
+    pr_mutual_inductive mib.mind_finite names) ++ fnl () ++
+  with_line_skip 
+    (print_inductive_implicit_args sp mipv ++
+     print_inductive_argument_scopes sp mipv)
+
+let print_named_decl id = 
+  gallina_print_named_decl (Global.lookup_named id) ++ fnl ()
 
-let print_section_variable sp =
-  let d = get_variable sp in
-  print_named_decl d ++ 
-  print_name_infos (VarRef sp)
+let gallina_print_section_variable id =
+  print_named_decl id ++
+  with_line_skip (print_name_infos (VarRef id))
 
 let print_body = function
   | Some lc  -> pr_lconstr (Declarations.force lc)
   | None -> (str"<no body>")
 
 let print_typed_body (val_0,typ) =
-  (print_body val_0 ++ fnl () ++ str "     : " ++ pr_ltype typ ++ fnl ())
+  (print_body val_0 ++ fnl () ++ str "     : " ++ pr_ltype typ)
 
 let ungeneralized_type_of_constant_type = function
   | PolymorphicArity (ctx,a) -> mkArity (ctx, Type a.poly_level)
@@ -343,84 +394,190 @@ let print_constant with_values sep sp =
     | None -> 
 	str"*** [ " ++ 
 	print_basename sp ++ str " : " ++ cut () ++ pr_ltype typ ++ 
-	str" ]" ++ fnl ()
+	str" ]"
     | _ -> 
 	print_basename sp ++ str sep ++ cut () ++
-	(if with_values then print_typed_body (val_0,typ) else pr_ltype typ) ++
-	fnl ())
-
-let print_constant_with_infos sp =
-  print_constant true " = " sp ++ print_name_infos (ConstRef sp)
-
-let print_inductive sp = (print_mutual sp)
-
-let print_syntactic_def sep kn =
-  let qid = Nametab.shortest_qualid_of_syndef Idset.empty kn in
-  let c = Syntax_def.search_syntactic_definition dummy_loc kn in 
-  str "Notation " ++ pr_qualid qid ++ str sep ++ 
+	(if with_values then print_typed_body (val_0,typ) else pr_ltype typ))
+  ++ fnl ()
+
+let gallina_print_constant_with_infos sp =
+  print_constant true " = " sp ++ 
+  with_line_skip (print_name_infos (ConstRef sp))
+
+let gallina_print_syntactic_def kn =
+  let sep = " := "
+  and qid = Nametab.shortest_qualid_of_syndef Idset.empty kn
+  and (vars,a) = Syntax_def.search_syntactic_definition dummy_loc kn in 
+  let c = Topconstr.rawconstr_of_aconstr dummy_loc a in
+  str "Notation " ++ pr_qualid qid ++ 
+  prlist_with_sep spc pr_id (List.map fst vars) ++ str sep ++
   Constrextern.without_symbols pr_lrawconstr c ++ fnl ()
 
-let print_leaf_entry with_values sep ((sp,kn as oname),lobj) =
-  let tag = object_tag lobj in
-  match (oname,tag) with
-    | (_,"VARIABLE") ->
-	(* Outside sections, VARIABLES still exist but only with universes 
-           constraints *)
-	(try Some(print_section_variable (basename sp)) with Not_found -> None)
-    | (_,"CONSTANT") ->
-	Some (print_constant with_values sep (constant_of_kn kn))
-    | (_,"INDUCTIVE") ->
-	Some (print_inductive kn)
-    | (_,"MODULE") ->
-	let (mp,_,l) = repr_kn kn in 
-	Some (print_module with_values (MPdot (mp,l)))
-    | (_,"MODULE TYPE") ->
-	Some (print_modtype kn)
-    | (_,("AUTOHINT"|"GRAMMAR"|"SYNTAXCONSTANT"|"PPSYNTAX"|"TOKEN"|"CLASS"|
-	"COERCION"|"REQUIRE"|"END-SECTION"|"STRUCTURE")) -> None
-    (* To deal with forgotten cases... *)
-    | (_,s) -> None
-(*
-    | (_,s) -> 
-	(str(string_of_path sp) ++ str" : " ++
-           str"Unrecognized object " ++ str s ++ fnl ())
-*)
-
-let rec print_library_entry with_values ent = 
-  let sep = if with_values then " = " else " : " in 
+let gallina_print_leaf_entry with_values ((sp,kn as oname),lobj) =
+  let sep = if with_values then " = " else " : "
+  and tag = object_tag lobj in
+    match (oname,tag) with
+      | (_,"VARIABLE") ->
+	  (* Outside sections, VARIABLES still exist but only with universes 
+             constraints *)
+	  (try Some(print_named_decl (basename sp)) with Not_found -> None)
+      | (_,"CONSTANT") ->
+	  Some (print_constant with_values sep (constant_of_kn kn))
+      | (_,"INDUCTIVE") ->
+	  Some (gallina_print_inductive kn)
+      | (_,"MODULE") ->
+	  let (mp,_,l) = repr_kn kn in 
+	    Some (print_module with_values (MPdot (mp,l)))
+      | (_,"MODULE TYPE") ->
+	  let (mp,_,l) = repr_kn kn in 
+	  Some (print_modtype (MPdot (mp,l)))
+      | (_,("AUTOHINT"|"GRAMMAR"|"SYNTAXCONSTANT"|"PPSYNTAX"|"TOKEN"|"CLASS"|
+	    "COERCION"|"REQUIRE"|"END-SECTION"|"STRUCTURE")) -> None
+      (* To deal with forgotten cases... *)
+      | (_,s) -> None
+
+let gallina_print_library_entry with_values ent = 
   let pr_name (sp,_) = pr_id (basename sp) in
   match ent with
     | (oname,Lib.Leaf lobj) -> 
-	print_leaf_entry with_values sep (oname,lobj)
+	gallina_print_leaf_entry with_values (oname,lobj)
     | (oname,Lib.OpenedSection (dir,_)) -> 
         Some (str " >>>>>>> Section " ++ pr_name oname)
-    | (oname,Lib.ClosedSection) -> 
+    | (oname,Lib.ClosedSection _) -> 
         Some (str " >>>>>>> Closed Section " ++ pr_name oname)
     | (_,Lib.CompilingLibrary (dir,_)) ->
 	Some (str " >>>>>>> Library " ++ pr_dirpath dir)
     | (oname,Lib.OpenedModule _) ->
 	Some (str " >>>>>>> Module " ++ pr_name oname)
+    | (oname,Lib.ClosedModule _) -> 
+        Some (str " >>>>>>> Closed Module " ++ pr_name oname)
     | (oname,Lib.OpenedModtype _) ->
 	Some (str " >>>>>>> Module Type " ++ pr_name oname)
+    | (oname,Lib.ClosedModtype _) -> 
+        Some (str " >>>>>>> Closed Module Type " ++ pr_name oname)
     | (_,Lib.FrozenState _) ->
 	None
-	
-let print_context with_values = 
+
+let gallina_print_leaf_entry with_values c =
+  match gallina_print_leaf_entry with_values c with
+    | None    -> mt ()
+    | Some pp -> pp ++ fnl()
+
+let gallina_print_context with_values = 
   let rec prec n = function
-    | h::rest when n = None or out_some n > 0 -> 
-	(match print_library_entry with_values h with
+    | h::rest when n = None or Option.get n > 0 -> 
+	(match gallina_print_library_entry with_values h with
 	  | None -> prec n rest
-	  | Some pp -> prec (option_map ((+) (-1)) n) rest ++ pp ++ fnl ())
+	  | Some pp -> prec (Option.map ((+) (-1)) n) rest ++ pp ++ fnl ())
     | _ -> mt ()
   in 
   prec
 
+let gallina_print_eval red_fun env evmap _ {uj_val=trm;uj_type=typ} =
+  let ntrm = red_fun env evmap trm in
+  (str "     = " ++ gallina_print_typed_value_in_env env (ntrm,typ))
+
+(******************************************)
+(**** Printing abstraction layer          *)
+
+let default_object_pr = {
+  print_inductive           = gallina_print_inductive;
+  print_constant_with_infos = gallina_print_constant_with_infos;
+  print_section_variable    = gallina_print_section_variable;
+  print_syntactic_def       = gallina_print_syntactic_def;
+  print_module              = gallina_print_module;
+  print_modtype             = gallina_print_modtype;
+  print_named_decl          = gallina_print_named_decl;
+  print_leaf_entry          = gallina_print_leaf_entry;
+  print_library_entry       = gallina_print_library_entry;
+  print_context             = gallina_print_context;
+  print_typed_value_in_env  = gallina_print_typed_value_in_env;
+  print_eval                = gallina_print_eval;
+}
+
+let object_pr = ref default_object_pr
+let set_object_pr = (:=) object_pr
+
+let print_inductive x = !object_pr.print_inductive x
+let print_constant_with_infos c = !object_pr.print_constant_with_infos c
+let print_section_variable c = !object_pr.print_section_variable c
+let print_syntactic_def x = !object_pr.print_syntactic_def x
+let print_module x  = !object_pr.print_module  x
+let print_modtype x = !object_pr.print_modtype x
+let print_named_decl x = !object_pr.print_named_decl x
+let print_leaf_entry x = !object_pr.print_leaf_entry x
+let print_library_entry x = !object_pr.print_library_entry x
+let print_context x = !object_pr.print_context x
+let print_typed_value_in_env x = !object_pr.print_typed_value_in_env x
+let print_eval x = !object_pr.print_eval x
+
+(******************************************)
+(**** Printing declarations and judgments *)
+(****  Abstract layer                 *****)
+
+let print_typed_value x = print_typed_value_in_env (Global.env ()) x
+
+let print_judgment env {uj_val=trm;uj_type=typ} =
+  print_typed_value_in_env env (trm, typ)
+    
+let print_safe_judgment env j =
+  let trm = Safe_typing.j_val j in
+  let typ = Safe_typing.j_type j in
+  print_typed_value_in_env env (trm, typ)
+    
+(*********************)
+(* *)
+
 let print_full_context () = 
   print_context true None (Lib.contents_after None)
 
 let print_full_context_typ () =
   print_context false None (Lib.contents_after None)
 
+let print_full_pure_context () =
+  let rec prec = function
+  | ((_,kn),Lib.Leaf lobj)::rest ->
+      let pp = match object_tag lobj with
+      | "CONSTANT" ->
+	  let con = constant_of_kn kn in
+	  let cb = Global.lookup_constant con in
+	  let val_0 = cb.const_body in
+	  let typ = ungeneralized_type_of_constant_type cb.const_type in
+	  hov 0 (
+	    match val_0 with 
+	    | None ->
+		str (if cb.const_opaque then "Axiom " else "Parameter ") ++
+		print_basename con ++ str " : " ++ cut () ++ pr_ltype typ
+	    | Some v ->
+		if cb.const_opaque then
+		  str "Theorem " ++ print_basename con ++ cut () ++ 
+		  str " : " ++ pr_ltype typ ++ str "." ++ fnl () ++
+		  str "Proof " ++ print_body val_0
+		else
+		  str "Definition " ++ print_basename con ++ cut () ++ 
+		  str "  : " ++ pr_ltype typ ++ cut () ++ str " := " ++
+		  print_body val_0) ++ str "." ++ fnl () ++ fnl ()
+      | "INDUCTIVE" ->
+	  let (mib,mip) = Global.lookup_inductive (kn,0) in
+	  let mipv = mib.mind_packets in
+	  let names = list_tabulate (fun x -> (kn,x)) (Array.length mipv) in
+	  pr_mutual_inductive mib.mind_finite names ++ str "." ++ 
+	  fnl () ++ fnl ()
+      | "MODULE" ->
+	  (* TODO: make it reparsable *)
+	  let (mp,_,l) = repr_kn kn in 
+	  print_module true (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl ()
+      | "MODULE TYPE" ->
+	  (* TODO: make it reparsable *)
+	  (* TODO: make it reparsable *)
+	  let (mp,_,l) = repr_kn kn in
+	  print_modtype (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl ()
+      | _ -> mt () in
+      prec rest ++ pp
+  | _::rest -> prec rest
+  | _ -> mt () in 
+  prec (Lib.contents_after None)
+
 (* For printing an inductive definition with
    its constructors and elimination,
    assume that the declaration of constructors and eliminations
@@ -446,8 +603,9 @@ let read_sec_context r =
   let rec get_cxt in_cxt = function
     | (_,Lib.OpenedSection ((dir',_),_) as hd)::rest ->
         if dir = dir' then (hd::in_cxt) else get_cxt (hd::in_cxt) rest
-    | (_,Lib.ClosedSection)::rest ->
+    | (_,Lib.ClosedSection _)::rest ->
         error "Cannot print the contents of a closed section"
+	(* LEM: Actually, we could if we wanted to. *)
     | [] -> []
     | hd::rest -> get_cxt (hd::in_cxt) rest 
   in
@@ -460,17 +618,13 @@ let print_sec_context sec =
 let print_sec_context_typ sec =
   print_context false None (read_sec_context sec)
 
-let print_eval red_fun env {uj_val=trm;uj_type=typ} =
-  let ntrm = red_fun env Evd.empty trm in
-  (str "     = " ++ print_judgment env {uj_val = ntrm; uj_type = typ})
-
 let print_name ref = 
   match locate_any_name ref with
   | Term (ConstRef sp) -> print_constant_with_infos sp
   | Term (IndRef (sp,_)) -> print_inductive sp
   | Term (ConstructRef ((sp,_),_)) -> print_inductive sp
   | Term (VarRef sp) -> print_section_variable sp
-  | Syntactic kn -> print_syntactic_def " := " kn
+  | Syntactic kn -> print_syntactic_def kn
   | Dir (DirModule(dirpath,(mp,_))) -> print_module (printable_body dirpath) mp
   | Dir _ -> mt ()
   | ModuleType (_,kn) -> print_modtype kn
@@ -491,9 +645,7 @@ let print_name ref =
 	| Lib.Leaf obj -> (oname,obj)
 	| _ -> raise Not_found
     in
-    match print_leaf_entry true " = " (oname,lobj) with
-      | None -> mt ()
-      | Some pp -> pp ++ fnl()
+    print_leaf_entry true (oname,lobj)
   with Not_found ->
     errorlabstrm
       "print_name" (pr_qualid qid ++ spc () ++ str "not a defined object")
@@ -508,7 +660,7 @@ let print_opaque_name qid =
         else 
 	  error "not a defined constant"
     | IndRef (sp,_) ->
-        print_mutual sp
+        print_inductive sp
     | ConstructRef cstr -> 
 	let ty = Inductiveops.type_of_constructor env cstr in
 	print_typed_value (mkConstruct cstr, ty)
@@ -519,10 +671,11 @@ let print_opaque_name qid =
 let print_about ref = 
   let k = locate_any_name ref in
   begin match k with
-  | Term ref -> 
-      print_ref false ref ++ print_name_infos ref ++ print_opacity ref
+  | Term ref ->
+      print_ref false ref ++ fnl () ++ print_name_infos ref ++ 
+      print_opacity ref
   | Syntactic kn ->
-      print_syntactic_def " := " kn
+      print_syntactic_def kn
   | Dir _ | ModuleType _ | Undefined _ ->
       mt () end
   ++
@@ -597,9 +750,40 @@ let print_path_between cls clt =
   in
   print_path ((i,j),p)
 
+let pr_cs_pattern = function  
+    Const_cs c -> pr_global c
+  | Prod_cs -> str "_ -> _"
+  | Default_cs -> str "_"
+  | Sort_cs s -> pr_sort_family s
+
 let print_canonical_projections () =
-  prlist_with_sep pr_fnl (fun ((r1,r2),o) -> 
-    pr_global r2 ++ str " <- " ++ pr_global r1 ++ str " ( " ++ pr_lconstr o.o_DEF ++ str " )")
+  prlist_with_sep pr_fnl 
+    (fun ((r1,r2),o) -> pr_cs_pattern r2 ++ 
+    str " <- " ++ 
+    pr_global r1 ++ str " ( " ++ pr_lconstr o.o_DEF ++ str " )")
     (canonical_projections ())
 
 (*************************************************************************)
+
+(*************************************************************************)
+(* Pretty-printing functions for type classes                     *)
+
+open Typeclasses
+
+let pr_typeclass env t = 
+  print_ref false t.cl_impl
+
+let print_typeclasses () =
+  let env = Global.env () in
+    prlist_with_sep fnl (pr_typeclass env) (typeclasses ())
+      
+let pr_instance env i = 
+  (*   gallina_print_constant_with_infos i.is_impl *)
+  (* lighter *)
+  print_ref false (ConstRef (instance_impl i))
+    
+let print_instances r =
+  let env = Global.env () in
+  let inst = instances r in 
+    prlist_with_sep fnl (pr_instance env) inst
+      
diff --git a/parsing/prettyp.mli b/parsing/prettyp.mli
index 13c11db7..a487ef62 100644
--- a/parsing/prettyp.mli
+++ b/parsing/prettyp.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: prettyp.mli 7740 2005-12-26 20:07:21Z herbelin $ i*)
+(*i $Id: prettyp.mli 10697 2008-03-19 17:58:43Z msozeau $ i*)
 
 (*i*)
 open Pp
@@ -30,16 +30,16 @@ val print_context : bool -> int option -> Lib.library_segment -> std_ppcmds
 val print_library_entry : bool -> (object_name * Lib.node) -> std_ppcmds option
 val print_full_context : unit -> std_ppcmds
 val print_full_context_typ : unit -> std_ppcmds
+val print_full_pure_context : unit -> std_ppcmds
 val print_sec_context : reference -> std_ppcmds
 val print_sec_context_typ : reference -> std_ppcmds
 val print_judgment : env -> unsafe_judgment -> std_ppcmds
 val print_safe_judgment : env -> Safe_typing.judgment -> std_ppcmds
 val print_eval :
-  reduction_function -> env -> unsafe_judgment -> std_ppcmds
+  reduction_function -> env -> Evd.evar_map -> Topconstr.constr_expr -> unsafe_judgment -> std_ppcmds
 (* This function is exported for the graphical user-interface pcoq *)
 val build_inductive : mutual_inductive -> int ->
   global_reference * rel_context * types * identifier array * types array
-val print_mutual : mutual_inductive -> std_ppcmds
 val print_name : reference -> std_ppcmds
 val print_opaque_name : reference -> std_ppcmds
 val print_about : reference -> std_ppcmds
@@ -58,7 +58,30 @@ val print_coercions : unit -> std_ppcmds
 val print_path_between : Classops.cl_typ -> Classops.cl_typ -> std_ppcmds
 val print_canonical_projections : unit -> std_ppcmds
 
+(* Pretty-printing functions for type classes and instances *)
+val print_typeclasses : unit -> std_ppcmds
+val print_instances : global_reference -> std_ppcmds
+
+
 val inspect : int -> std_ppcmds
 
 (* Locate *)
 val print_located_qualid : reference -> std_ppcmds
+
+type object_pr = {
+  print_inductive           : mutual_inductive -> std_ppcmds;
+  print_constant_with_infos : constant -> std_ppcmds;
+  print_section_variable    : variable -> std_ppcmds;
+  print_syntactic_def       : kernel_name -> std_ppcmds;
+  print_module              : bool -> Names.module_path -> std_ppcmds;
+  print_modtype             : module_path -> std_ppcmds;
+  print_named_decl          : identifier * constr option * types -> std_ppcmds;
+  print_leaf_entry          : bool -> Libnames.object_name * Libobject.obj -> Pp.std_ppcmds;
+  print_library_entry       : bool -> (object_name * Lib.node) -> std_ppcmds option;
+  print_context             : bool -> int option -> Lib.library_segment -> std_ppcmds;
+  print_typed_value_in_env  : Environ.env -> Term.constr * Term.types -> Pp.std_ppcmds;
+  print_eval                : reduction_function -> env -> Evd.evar_map -> Topconstr.constr_expr -> unsafe_judgment -> std_ppcmds
+}
+
+val set_object_pr : object_pr -> unit
+val default_object_pr : object_pr
diff --git a/parsing/printer.ml b/parsing/printer.ml
index 6fb492ae..6a19cb0a 100644
--- a/parsing/printer.ml
+++ b/parsing/printer.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: printer.ml 9573 2007-01-31 20:18:18Z notin $ *)
+(* $Id: printer.ml 11001 2008-05-27 16:56:07Z aspiwack $ *)
 
 open Pp
 open Util
@@ -30,7 +30,7 @@ open Ppconstr
 open Constrextern
 
 let emacs_str s alts = 
-  match !Options.print_emacs, !Options.print_emacs_safechar with
+  match !Flags.print_emacs, !Flags.print_emacs_safechar with
     | true, true -> alts
     | true , false -> s
     | false,_ -> "" 
@@ -48,10 +48,16 @@ let pr_lconstr_env_at_top env = pr_lconstr_core true env
 let pr_lconstr_env env = pr_lconstr_core false env
 let pr_constr_env env = pr_constr_core false env
 
+let pr_open_lconstr_env env (_,c) = pr_lconstr_env env c
+let pr_open_constr_env env (_,c) = pr_constr_env env c
+
   (* NB do not remove the eta-redexes! Global.env() has side-effects... *)
 let pr_lconstr t = pr_lconstr_env (Global.env()) t
 let pr_constr t = pr_constr_env (Global.env()) t
 
+let pr_open_lconstr (_,c) = pr_lconstr c
+let pr_open_constr (_,c) = pr_constr c
+
 let pr_type_core at_top env t =
   pr_constr_expr (extern_type at_top env t)
 let pr_ltype_core at_top env t =
@@ -165,15 +171,7 @@ let pr_named_context env ne_context =
           ne_context ~init:(mt ()))
 
 let pr_rel_context env rel_context =
-  let rec prec env = function
-    | [] -> (mt ()) 
-    | [b] -> str "(" ++ pr_rel_decl env b ++ str")"
-    | b::rest ->
-        let pb = pr_rel_decl env b in
-        let penvtl = prec (push_rel b env) rest in
-        str "(" ++ pb ++ str")" ++ spc () ++ penvtl
-  in 
-  hov 0 (prec env (List.rev rel_context))
+  pr_binders (extern_rel_context None env rel_context)
 
 let pr_rel_context_of env =
   pr_rel_context env (rel_context env)
@@ -229,12 +227,39 @@ let pr_context_limit n env =
     in 
     (sign_env ++ db_env)
 
-let pr_context_of env = match Options.print_hyps_limit () with 
+let pr_context_of env = match Flags.print_hyps_limit () with 
   | None -> hv 0 (pr_context_unlimited env)
   | Some n -> hv 0 (pr_context_limit n env)
 
 (* display goal parts (Proof mode) *)
 
+let pr_restricted_named_context among env =
+  hv 0 (fold_named_context
+	  (fun env ((id,_,_) as d) pps ->
+	     if true || Idset.mem id among then
+	       pps ++ 
+		 fnl () ++ str (emacs_str (String.make 1 (Char.chr 253)) "") ++
+		 pr_var_decl env d
+	     else 
+	       pps)
+          env ~init:(mt ()))
+
+
+let pr_predicate pr_elt (b, elts) = 
+  let pr_elts = prlist_with_sep spc pr_elt elts in
+    if b then
+      str"all" ++ 
+	(if elts = [] then mt () else str" except: " ++ pr_elts)
+    else
+      if elts = [] then str"none" else pr_elts
+      
+let pr_cpred p = pr_predicate pr_con (Cpred.elements p)
+let pr_idpred p = pr_predicate Nameops.pr_id (Idpred.elements p)
+
+let pr_transparent_state (ids, csts) = 
+  hv 0 (str"VARIABLES: " ++ pr_idpred ids ++ fnl () ++
+	str"CONSTANTS: " ++ pr_cpred csts ++ fnl ())
+
 let pr_subgoal_metas metas env=
   let pr_one (meta,typ) = 
     str "?" ++ int meta ++ str " : " ++ 
@@ -243,25 +268,24 @@ let pr_subgoal_metas metas env=
     hv 0 (prlist_with_sep mt pr_one metas)
 
 (* display complete goal *)
-
-let pr_goal g =
-  let env = evar_env g in
-  let preamb,penv,pc =
+let default_pr_goal g =
+  let env = evar_unfiltered_env g in
+  let preamb,thesis,penv,pc =
     if g.evar_extra = None then
-          mt (),
+          mt (), mt (),
 	  pr_context_of env,
 	  pr_ltype_env_at_top env g.evar_concl
     else 
-      let {pm_subgoals=metas} = get_info g in
-	(str "     *** Declarative Mode ***" ++ fnl ()++fnl ()),
-    pr_context_of env,
-    pr_subgoal_metas metas env
+      (str "     *** Declarative Mode ***" ++ fnl ()++fnl ()),
+      (str"thesis := "  ++ fnl ()),
+       pr_context_of env,
+       pr_ltype_env_at_top env g.evar_concl
   in
     preamb ++
     str"  " ++ hv 0 (penv ++ fnl () ++
 		       str (emacs_str (String.make 1 (Char.chr 253)) "")  ++
 		       str "============================" ++ fnl ()  ++
-		       str" "  ++ pc) ++ fnl ()
+		       thesis ++ str " " ++  pc) ++ fnl ()
      
 (* display the conclusion of a goal *)
 let pr_concl n g =
@@ -270,12 +294,17 @@ let pr_concl n g =
     str (emacs_str (String.make 1 (Char.chr 253)) "")  ++
       str "subgoal " ++ int n ++ str " is:" ++ cut () ++ str" "  ++ pc
 
-
 (* display evar type: a context and a type *)
 let pr_evgl_sign gl = 
-  let ps = pr_named_context_of (evar_env gl) in
+  let ps = pr_named_context_of (evar_unfiltered_env gl) in
+  let _,l = list_filter2 (fun b c -> not b) (evar_filter gl,evar_context gl) in
+  let ids = List.rev (List.map pi1 l) in
+  let warn =
+    if ids = [] then mt () else
+      (str "(" ++ prlist_with_sep pr_coma pr_id ids ++ str " cannot be used)")
+  in
   let pc = pr_lconstr gl.evar_concl in
-  hov 0 (str"["  ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]")
+  hov 0 (str"[" ++ ps ++ spc () ++ str"|- "  ++ pc ++ str"]" ++ spc () ++ warn)
 
 (* Print an enumerated list of existential variables *)
 let rec pr_evars_int i = function
@@ -287,12 +316,12 @@ let rec pr_evars_int i = function
               str (string_of_existential ev)  ++ str " : " ++ pegl)) ++ 
       fnl () ++ pei
 
-let pr_subgoal n =
+let default_pr_subgoal n =
   let rec prrec p = function
     | [] -> error "No such goal"
     | g::rest ->
        	if p = 1 then
-          let pg = pr_goal g in
+          let pg = default_pr_goal g in
           v 0 (str "subgoal " ++ int n ++ str " is:" ++ cut () ++ pg)
        	else 
 	  prrec (p-1) rest
@@ -300,7 +329,7 @@ let pr_subgoal n =
   prrec n
 
 (* Print open subgoals. Checks for uninstantiated existential variables *)
-let pr_subgoals close_cmd sigma = function 
+let default_pr_subgoals close_cmd sigma = function 
   | [] -> 
       begin
 	match close_cmd with
@@ -317,7 +346,7 @@ let pr_subgoals close_cmd sigma = function
 		     str "variables :"  ++fnl () ++ (hov 0 pei))
       end
   | [g] ->
-      let pg = pr_goal g in
+      let pg = default_pr_goal g in
       v 0 (str ("1 "^"subgoal") ++cut () ++ pg)
   | g1::rest ->
       let rec pr_rec n = function
@@ -327,11 +356,39 @@ let pr_subgoals close_cmd sigma = function
             let prest = pr_rec (n+1) rest in
             (cut () ++ pc ++ prest) 
       in
-      let pg1 = pr_goal g1 in
+      let pg1 = default_pr_goal g1 in
       let prest = pr_rec 2 rest in
       v 0 (int(List.length rest+1) ++ str" subgoals" ++ cut () 
 	   ++ pg1 ++ prest ++ fnl ())
 
+
+(**********************************************************************)
+(* Abstraction layer                                                  *)
+
+
+type printer_pr = {
+ pr_subgoals            : string option -> evar_map -> goal list -> std_ppcmds;
+ pr_subgoal             : int -> goal list -> std_ppcmds;
+ pr_goal                : goal -> std_ppcmds;
+}
+
+let default_printer_pr = {
+ pr_subgoals = default_pr_subgoals;
+ pr_subgoal  = default_pr_subgoal;
+ pr_goal     = default_pr_goal;
+}
+
+let printer_pr = ref default_printer_pr
+
+let set_printer_pr = (:=) printer_pr
+
+let pr_subgoals x = !printer_pr.pr_subgoals x
+let pr_subgoal  x = !printer_pr.pr_subgoal  x
+let pr_goal     x = !printer_pr.pr_goal     x
+
+(* End abstraction layer                                              *)
+(**********************************************************************)
+
 let pr_subgoals_of_pfts pfts =
   let close_cmd = Decl_mode.get_end_command pfts in
   let gls = fst (Refiner.frontier (proof_of_pftreestate pfts)) in 
@@ -350,6 +407,7 @@ let pr_open_subgoals () =
 	if List.length gls < 2 then 
 	  pr_subgoal n gls
 	else 
+	  (* LEM TODO: this way of saying how many subgoals has to be abstracted out*)
 	  v 0 (int(List.length gls) ++ str" subgoals" ++ cut () ++
 	  pr_subgoal n gls)
 
@@ -430,3 +488,42 @@ let pr_prim_rule = function
 
 let prterm = pr_lconstr
 
+
+(* spiwack: printer function for sets of Environ.assumption.
+            It is used primarily by the Print Assumption command. *)
+let pr_assumptionset env s = 
+  if (Environ.ContextObjectMap.is_empty s) then
+    str "Closed under the global context"
+  else
+    let (vars,axioms) =
+      Environ.ContextObjectMap.fold (fun o typ r ->
+	let (v,a) = r in
+	match o with
+	| Variable id -> (  Some (
+	                      Option.default (fnl ()) v 
+			   ++ str (string_of_id id)
+			   ++ str " : "
+	                   ++ pr_ltype typ
+	                   ++ fnl ()
+			    )
+	                 ,
+	                   a )
+	| Axiom kn    -> ( v ,
+			     Some (
+			      Option.default (fnl ()) a
+			   ++ (pr_constant env kn)
+	                   ++ str " : "
+	                   ++ pr_ltype typ
+	                   ++ fnl ()
+			     )
+			 )
+	)
+	s (None,None)
+    in
+    let (vars,axioms) = 
+      ( Option.map (fun p -> str "Section Variables:" ++ p) vars ,
+	Option.map (fun p -> str "Axioms:" ++ p) axioms 
+      )
+    in
+    (Option.default (mt ()) vars) ++ (Option.default (mt ()) axioms)
+
diff --git a/parsing/printer.mli b/parsing/printer.mli
index 86af523f..935fca12 100644
--- a/parsing/printer.mli
+++ b/parsing/printer.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: printer.mli 9385 2006-11-17 15:14:14Z courtieu $ i*)
+(*i $Id: printer.mli 11001 2008-05-27 16:56:07Z aspiwack $ i*)
 
 (*i*)
 open Pp
@@ -35,6 +35,12 @@ val pr_lconstr             : constr -> std_ppcmds
 val pr_constr_env          : env -> constr -> std_ppcmds
 val pr_constr              : constr -> std_ppcmds
 
+val pr_open_constr_env     : env -> open_constr -> std_ppcmds
+val pr_open_constr         : open_constr -> std_ppcmds
+
+val pr_open_lconstr_env    : env -> open_constr -> std_ppcmds
+val pr_open_lconstr        : open_constr -> std_ppcmds
+
 val pr_ltype_env_at_top    : env -> types -> std_ppcmds
 val pr_ltype_env           : env -> types -> std_ppcmds
 val pr_ltype               : types -> std_ppcmds
@@ -85,6 +91,13 @@ val pr_rel_context         : env -> rel_context -> std_ppcmds
 val pr_rel_context_of      : env -> std_ppcmds
 val pr_context_of          : env -> std_ppcmds
 
+(* Predicates *)
+
+val pr_predicate           : ('a -> std_ppcmds) -> (bool * 'a list) -> std_ppcmds
+val pr_cpred               : Cpred.t -> std_ppcmds
+val pr_idpred              : Idpred.t -> std_ppcmds
+val pr_transparent_state   : transparent_state -> std_ppcmds
+
 (* Proofs *)
 
 val pr_goal                : goal -> std_ppcmds
@@ -107,3 +120,20 @@ val emacs_str              : string -> string -> string
 (* Backwards compatibility *)
 
 val prterm                 : constr -> std_ppcmds (* = pr_lconstr *)
+
+
+(* spiwack: printer function for sets of Environ.assumption.
+            It is used primarily by the Print Assumption command. *)
+val pr_assumptionset : env -> Term.types Environ.ContextObjectMap.t ->std_ppcmds
+
+
+type printer_pr = {
+ pr_subgoals            : string option -> evar_map -> goal list -> std_ppcmds;
+ pr_subgoal             : int -> goal list -> std_ppcmds;
+ pr_goal                : goal -> std_ppcmds;
+};;
+
+val set_printer_pr : printer_pr -> unit
+
+val default_printer_pr : printer_pr
+
diff --git a/parsing/printmod.ml b/parsing/printmod.ml
index aaf4a662..0bdae7c7 100644
--- a/parsing/printmod.ml
+++ b/parsing/printmod.ml
@@ -42,73 +42,98 @@ let print_kn locals kn =
       pr_qualid qid
   with
       Not_found -> 
-	let (mp,_,l) = repr_kn kn in
-	  print_local_modpath locals mp ++ str"." ++ pr_lab l
+	try
+	  print_local_modpath locals kn
+	with
+	    Not_found -> print_modpath locals kn
 
 let rec flatten_app mexpr l = match mexpr with
-  | MEBapply (mexpr,marg,_) -> flatten_app mexpr (marg::l)
+  | SEBapply (mexpr,marg,_) -> flatten_app mexpr (marg::l)
   | mexpr -> mexpr::l
 
 let rec print_module name locals with_body mb =
-  let body = match mb.mod_equiv, with_body, mb.mod_expr with 
-    | None, false, _ 
-    | None, true, None -> mt()
-    | None, true, Some mexpr -> 
+  let body = match with_body, mb.mod_expr with 
+    | false, _ 
+    | true, None -> mt()
+    | true, Some mexpr -> 
 	spc () ++ str ":= " ++ print_modexpr locals mexpr
-    | Some mp, _, _ -> str " == " ++ print_modpath locals mp
   in
-  hv 2 (str "Module " ++ name ++ spc () ++ str": " ++ 
-	print_modtype locals mb.mod_type ++ body)
-
-and print_modtype locals mty = match mty with
-  | MTBident kn -> print_kn locals kn
-  | MTBfunsig (mbid,mtb1,mtb2) ->
-(*    let env' = Modops.add_module (MPbid mbid) (Modops.body_of_type mtb) env 
-      in *) 
-      let locals' = (mbid, get_new_id locals (id_of_mbid mbid))::locals in
-      hov 2 (str "Funsig" ++ spc () ++ str "(" ++ 
-        pr_id (id_of_mbid mbid) ++ str " : " ++ print_modtype locals mtb1 ++ 
-      str ")" ++ spc() ++ print_modtype locals' mtb2)
-  | MTBsig (msid,sign) -> 
+  let modtype = match mb.mod_type with
+      None -> str ""
+    | Some t ->  str": " ++ 
+	print_modtype locals t
+  in
+    hv 2 (str "Module " ++ name ++ spc () ++ modtype ++ body)
+
+and print_modtype locals mty = 
+  match mty with
+    | SEBident kn -> print_kn locals kn
+    | SEBfunctor (mbid,mtb1,mtb2) ->
+      (*    let env' = Modops.add_module (MPbid mbid) 
+	    (Modops.body_of_type mtb) env 
+	    in *) 
+      let locals' = (mbid, get_new_id locals (id_of_mbid mbid))
+	::locals in
+	hov 2 (str "Funsig" ++ spc () ++ str "(" ++ 
+		 pr_id (id_of_mbid mbid) ++ str " : " ++ 
+		 print_modtype locals mtb1.typ_expr ++ 
+		 str ")" ++ spc() ++ print_modtype locals' mtb2)
+  | SEBstruct (msid,sign) -> 
       hv 2 (str "Sig" ++ spc () ++ print_sig locals msid sign ++ brk (1,-2) ++ str "End")
+  | SEBapply (mexpr,marg,_) -> 
+      let lapp = flatten_app mexpr [marg] in
+      let fapp = List.hd lapp in
+      let mapp = List.tl lapp in
+	hov 3 (str"(" ++ (print_modtype locals fapp) ++ spc () ++ 
+		 prlist_with_sep spc (print_modexpr locals) mapp ++ str")")
+  | SEBwith(seb,With_definition_body(idl,cb))->
+      let s = (String.concat "." (List.map string_of_id idl)) in
+      hov 2 (print_modtype locals seb ++ spc() ++ str "with" ++ spc() ++ 
+	       str "Definition"++ spc() ++ str s ++ spc() ++  str ":="++ spc())
+  | SEBwith(seb,With_module_body(idl,mp,_))->
+      let s =(String.concat "." (List.map string_of_id idl)) in
+      hov 2 (print_modtype locals seb ++ spc() ++ str "with" ++ spc() ++ 
+	       str "Module"++ spc() ++ str s ++ spc() ++ str ":="++ spc())
 
 and print_sig locals msid sign = 
   let print_spec (l,spec) = (match spec with
-    | SPBconst {const_body=Some _; const_opaque=false} -> str "Definition "
-    | SPBconst {const_body=None}
-    | SPBconst {const_opaque=true} -> str "Parameter "
-    | SPBmind _ -> str "Inductive "
-    | SPBmodule _ -> str "Module "
-    | SPBmodtype _ -> str "Module Type ") ++ str (string_of_label l)
+    | SFBconst {const_body=Some _; const_opaque=false} -> str "Definition "
+    | SFBconst {const_body=None}
+    | SFBconst {const_opaque=true} -> str "Parameter "
+    | SFBmind _ -> str "Inductive "
+    | SFBmodule _ -> str "Module "
+    | SFBalias (mp,_) -> str "Module"
+    | SFBmodtype _ -> str "Module Type ") ++ str (string_of_label l)
   in
     prlist_with_sep spc print_spec sign
 
 and print_struct locals msid struc = 
   let print_body (l,body) = (match body with
-    | SEBconst {const_body=Some _; const_opaque=false} -> str "Definition "
-    | SEBconst {const_body=Some _; const_opaque=true} -> str "Theorem "
-    | SEBconst {const_body=None} -> str "Parameter "
-    | SEBmind _ -> str "Inductive "
-    | SEBmodule _ -> str "Module "
-    | SEBmodtype _ -> str "Module Type ") ++ str (string_of_label l)
+    | SFBconst {const_body=Some _; const_opaque=false} -> str "Definition "
+    | SFBconst {const_body=Some _; const_opaque=true} -> str "Theorem "
+    | SFBconst {const_body=None} -> str "Parameter "
+    | SFBmind _ -> str "Inductive "
+    | SFBmodule _ -> str "Module "
+    | SFBalias (mp,_) -> str "Module"
+    | SFBmodtype _ -> str "Module Type ") ++ str (string_of_label l)
   in
     prlist_with_sep spc print_body struc
 
 and print_modexpr locals mexpr = match mexpr with 
-  | MEBident mp -> print_modpath locals mp
-  | MEBfunctor (mbid,mty,mexpr) ->
+  | SEBident mp -> print_modpath locals mp
+  | SEBfunctor (mbid,mty,mexpr) ->
 (*    let env' = Modops.add_module (MPbid mbid) (Modops.body_of_type mtb) env 
       in *)
       let locals' = (mbid, get_new_id locals (id_of_mbid mbid))::locals in
       hov 2 (str "Functor" ++ spc() ++ str"[" ++ pr_id(id_of_mbid mbid) ++ 
-	     str ":" ++ print_modtype locals mty ++ 
+	     str ":" ++ print_modtype locals mty.typ_expr ++ 
       str "]" ++ spc () ++ print_modexpr locals' mexpr)
-  | MEBstruct (msid, struc) -> 
+  | SEBstruct (msid, struc) -> 
       hv 2 (str "Struct" ++ spc () ++ print_struct locals msid struc ++ brk (1,-2) ++ str "End")
-  | MEBapply (mexpr,marg,_) -> 
+  | SEBapply (mexpr,marg,_) -> 
       let lapp = flatten_app mexpr [marg] in
 	hov 3 (str"(" ++ prlist_with_sep spc (print_modexpr locals) lapp ++ str")")
-
+  | SEBwith (_,_)-> anomaly "Not avaible yet"
 
 
 let rec printable_body dir =     
@@ -128,6 +153,7 @@ let print_module with_body mp =
     print_module name [] with_body (Global.lookup_module mp) ++ fnl ()
 
 let print_modtype kn = 
+  let mtb = Global.lookup_modtype kn in
   let name = print_kn [] kn in
-    str "Module Type " ++ name ++ str " = " ++ 
-      print_modtype [] (Global.lookup_modtype kn) ++ fnl ()
+      str "Module Type " ++ name ++ str " = " ++ 
+	print_modtype [] mtb.typ_expr ++ fnl ()
diff --git a/parsing/printmod.mli b/parsing/printmod.mli
index 2df0581c..a3a16e8e 100644
--- a/parsing/printmod.mli
+++ b/parsing/printmod.mli
@@ -14,4 +14,4 @@ val printable_body : dir_path -> bool
 
 val print_module : bool -> module_path -> std_ppcmds
 
-val print_modtype : kernel_name -> std_ppcmds
+val print_modtype : module_path -> std_ppcmds
diff --git a/parsing/q_constr.ml4 b/parsing/q_constr.ml4
index 21c851df..72d81051 100644
--- a/parsing/q_constr.ml4
+++ b/parsing/q_constr.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_constr.ml4,v 1.58 2005/12/30 10:55:32 herbelin Exp $ *)
+(*i camlp4use: "pa_extend.cmo q_MLast.cmo" i*)
+
+(* $Id: q_constr.ml4 10739 2008-04-01 14:45:20Z herbelin $ *)
 
 open Rawterm
 open Term
@@ -47,9 +49,9 @@ EXTEND
   constr:
     [ "200" RIGHTA
       [ LIDENT "forall"; id = ident; ":"; c1 = constr; ","; c2 = constr ->
-        <:expr< Rawterm.RProd ($dloc$,Name $id$,$c1$,$c2$) >>
+        <:expr< Rawterm.RProd ($dloc$,Name $id$,Rawterm.Explicit,$c1$,$c2$) >>
       | "fun"; id = ident; ":"; c1 = constr; "=>"; c2 = constr ->
-        <:expr< Rawterm.RLambda ($dloc$,Name $id$,$c1$,$c2$) >>
+        <:expr< Rawterm.RLambda ($dloc$,Name $id$,Rawterm.Explicit,$c1$,$c2$) >>
       | "let"; id = ident; ":="; c1 = constr; "in"; c2 = constr ->
         <:expr< Rawterm.RLetin ($dloc$,Name $id$,$c1$,$c2$) >>
       (* fix todo *)
@@ -59,7 +61,7 @@ EXTEND
         <:expr< Rawterm.RCast($dloc$,$c1$,DEFAULTcast,$c2$) >> ]
     | "90" RIGHTA
       [ c1 = constr; "->"; c2 = SELF -> 
-        <:expr< Rawterm.RProd ($dloc$,Anonymous,$c1$,$c2$) >> ]
+        <:expr< Rawterm.RProd ($dloc$,Anonymous,Rawterm.Explicit,$c1$,$c2$) >> ]
     | "75" RIGHTA
       [ "~"; c = constr -> 
         apply_ref <:expr< coq_not_ref >> [c] ]
diff --git a/parsing/q_coqast.ml4 b/parsing/q_coqast.ml4
index 9f828c96..24562459 100644
--- a/parsing/q_coqast.ml4
+++ b/parsing/q_coqast.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: q_coqast.ml4 10185 2007-10-06 18:05:13Z herbelin $ *)
+(*i camlp4use: "q_MLast.cmo pa_macro.cmo" i*)
+
+(* $Id: q_coqast.ml4 11094 2008-06-10 19:35:23Z herbelin $ *)
 
 open Util
 open Names
@@ -60,12 +62,18 @@ let mlexpr_of_reference = function
   | Libnames.Qualid (loc,qid) -> <:expr< Libnames.Qualid $dloc$ $mlexpr_of_qualid qid$ >>
   | Libnames.Ident (loc,id) -> <:expr< Libnames.Ident $dloc$ $mlexpr_of_ident id$ >>
 
+let mlexpr_of_by_notation f = function
+  | Genarg.AN x -> <:expr< Genarg.AN $f x$ >>
+  | Genarg.ByNotation (loc,s) -> <:expr< Genarg.ByNotation $dloc$ $str:s$ >>
+
 let mlexpr_of_intro_pattern = function
-  | Genarg.IntroOrAndPattern _ -> failwith "mlexpr_of_intro_pattern: TODO"
   | Genarg.IntroWildcard -> <:expr< Genarg.IntroWildcard >>
   | Genarg.IntroAnonymous -> <:expr< Genarg.IntroAnonymous >>
+  | Genarg.IntroFresh id -> <:expr< Genarg.IntroFresh (mlexpr_of_ident $dloc$ id) >>
   | Genarg.IntroIdentifier id ->
       <:expr< Genarg.IntroIdentifier (mlexpr_of_ident $dloc$ id) >>
+  | Genarg.IntroOrAndPattern _ | Genarg.IntroRewrite _ ->
+      failwith "mlexpr_of_intro_pattern: TODO"
 
 let mlexpr_of_ident_option = mlexpr_of_option (mlexpr_of_ident)
 
@@ -87,7 +95,9 @@ let mlexpr_of_or_var f = function
 
 let mlexpr_of_hyp = mlexpr_of_or_metaid (mlexpr_of_located mlexpr_of_ident)
 
-let mlexpr_of_occs = mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int)
+let mlexpr_of_occs =
+  mlexpr_of_pair
+    mlexpr_of_bool (mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int))
 
 let mlexpr_of_occurrences f = mlexpr_of_pair mlexpr_of_occs f
 
@@ -103,7 +113,6 @@ let mlexpr_of_clause cl =
   <:expr< {Tacexpr.onhyps=
              $mlexpr_of_option (mlexpr_of_list mlexpr_of_hyp_location)
                cl.Tacexpr.onhyps$;
-           Tacexpr.onconcl= $mlexpr_of_bool cl.Tacexpr.onconcl$;
            Tacexpr.concl_occs= $mlexpr_of_occs cl.Tacexpr.concl_occs$} >>
 
 let mlexpr_of_red_flags {
@@ -117,13 +126,21 @@ let mlexpr_of_red_flags {
   Rawterm.rIota = $mlexpr_of_bool bi$;
   Rawterm.rZeta = $mlexpr_of_bool bz$;
   Rawterm.rDelta = $mlexpr_of_bool bd$;
-  Rawterm.rConst = $mlexpr_of_list mlexpr_of_reference l$
+  Rawterm.rConst = $mlexpr_of_list (mlexpr_of_by_notation mlexpr_of_reference) l$
 } >>
 
 let mlexpr_of_explicitation = function
   | Topconstr.ExplByName id -> <:expr< Topconstr.ExplByName $mlexpr_of_ident id$ >>
-  | Topconstr.ExplByPos n -> <:expr< Topconstr.ExplByPos $mlexpr_of_int n$ >>
+  | Topconstr.ExplByPos (n,_id) -> <:expr< Topconstr.ExplByPos $mlexpr_of_int n$ >>
  
+let mlexpr_of_binding_kind = function
+  | Rawterm.Implicit -> <:expr< Rawterm.Implicit >>
+  | Rawterm.Explicit -> <:expr< Rawterm.Explicit >>
+
+let mlexpr_of_binder_kind = function
+  | Topconstr.Default b -> <:expr< Topconstr.Default $mlexpr_of_binding_kind b$ >>
+  | Topconstr.TypeClass b -> <:expr< Topconstr.TypeClass $mlexpr_of_binding_kind b$ >>
+
 let rec mlexpr_of_constr = function
   | Topconstr.CRef (Libnames.Ident (loc,id)) when is_meta (string_of_id id) ->
       anti loc (string_of_id id)
@@ -132,13 +149,15 @@ let rec mlexpr_of_constr = function
   | Topconstr.CCoFix (loc,_,_) -> failwith "mlexpr_of_constr: TODO"
   | Topconstr.CArrow (loc,a,b) ->
   <:expr< Topconstr.CArrow $dloc$ $mlexpr_of_constr a$ $mlexpr_of_constr b$ >>
-  | Topconstr.CProdN (loc,l,a) -> <:expr< Topconstr.CProdN $dloc$ $mlexpr_of_list (mlexpr_of_pair (mlexpr_of_list (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_name)) mlexpr_of_constr) l$ $mlexpr_of_constr a$ >>
-  | Topconstr.CLambdaN (loc,l,a) -> <:expr< Topconstr.CLambdaN $dloc$ $mlexpr_of_list (mlexpr_of_pair (mlexpr_of_list (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_name)) mlexpr_of_constr) l$ $mlexpr_of_constr a$ >>
+  | Topconstr.CProdN (loc,l,a) -> <:expr< Topconstr.CProdN $dloc$ $mlexpr_of_list 
+      (mlexpr_of_triple (mlexpr_of_list (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_name)) mlexpr_of_binder_kind mlexpr_of_constr) l$ $mlexpr_of_constr a$ >>
+  | Topconstr.CLambdaN (loc,l,a) -> <:expr< Topconstr.CLambdaN $dloc$ $mlexpr_of_list (mlexpr_of_triple (mlexpr_of_list (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_name)) mlexpr_of_binder_kind mlexpr_of_constr) l$ $mlexpr_of_constr a$ >>
   | Topconstr.CLetIn (loc,_,_,_) -> failwith "mlexpr_of_constr: TODO"
   | Topconstr.CAppExpl (loc,a,l) -> <:expr< Topconstr.CAppExpl $dloc$ $mlexpr_of_pair (mlexpr_of_option mlexpr_of_int) mlexpr_of_reference a$ $mlexpr_of_list mlexpr_of_constr l$ >>
   | Topconstr.CApp (loc,a,l) -> <:expr< Topconstr.CApp $dloc$ $mlexpr_of_pair (mlexpr_of_option mlexpr_of_int) mlexpr_of_constr a$ $mlexpr_of_list (mlexpr_of_pair mlexpr_of_constr (mlexpr_of_option (mlexpr_of_located mlexpr_of_explicitation))) l$ >>
-  | Topconstr.CCases (loc,_,_,_) -> failwith "mlexpr_of_constr: TODO"
-  | Topconstr.CHole loc -> <:expr< Topconstr.CHole $dloc$ >>
+  | Topconstr.CCases (loc,_,_,_,_) -> failwith "mlexpr_of_constr: TODO"
+  | Topconstr.CHole (loc, None) -> <:expr< Topconstr.CHole $dloc$ None >>
+  | Topconstr.CHole (loc, Some _) -> failwith "mlexpr_of_constr: TODO CHole (Some _)"
   | Topconstr.CNotation(_,ntn,l) ->
       <:expr< Topconstr.CNotation $dloc$ $mlexpr_of_string ntn$
                 $mlexpr_of_list mlexpr_of_constr l$ >>
@@ -147,8 +166,7 @@ let rec mlexpr_of_constr = function
   | _ -> failwith "mlexpr_of_constr: TODO"
 
 let mlexpr_of_occ_constr =
-  mlexpr_of_pair (mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int))
-    mlexpr_of_constr
+  mlexpr_of_occurrences mlexpr_of_constr
 
 let mlexpr_of_red_expr = function
   | Rawterm.Red b -> <:expr< Rawterm.Red $mlexpr_of_bool b$ >>
@@ -159,9 +177,8 @@ let mlexpr_of_red_expr = function
   | Rawterm.Lazy f ->
       <:expr< Rawterm.Lazy $mlexpr_of_red_flags f$ >>
   | Rawterm.Unfold l ->
-      let f1 = mlexpr_of_list (mlexpr_of_or_var mlexpr_of_int) in
-      let f2 = mlexpr_of_reference in
-      let f = mlexpr_of_list (mlexpr_of_pair f1 f2) in
+      let f1 = mlexpr_of_by_notation mlexpr_of_reference in
+      let f = mlexpr_of_list (mlexpr_of_occurrences f1) in
       <:expr< Rawterm.Unfold $f l$ >>
   | Rawterm.Fold l ->
       <:expr< Rawterm.Fold $mlexpr_of_list mlexpr_of_constr l$ >>
@@ -220,19 +237,19 @@ let mlexpr_of_binding_kind = function
   | Rawterm.NoBindings -> 
        <:expr< Rawterm.NoBindings >>
 
+let mlexpr_of_binding = mlexpr_of_pair mlexpr_of_binding_kind mlexpr_of_constr
+
+let mlexpr_of_constr_with_binding =
+  mlexpr_of_pair mlexpr_of_constr mlexpr_of_binding_kind
+
 let mlexpr_of_induction_arg = function
   | Tacexpr.ElimOnConstr c ->
-      <:expr< Tacexpr.ElimOnConstr $mlexpr_of_constr c$ >>
+      <:expr< Tacexpr.ElimOnConstr $mlexpr_of_constr_with_binding c$ >>
   | Tacexpr.ElimOnIdent (_,id) -> 
       <:expr< Tacexpr.ElimOnIdent $dloc$ $mlexpr_of_ident id$ >>
   | Tacexpr.ElimOnAnonHyp n ->
       <:expr< Tacexpr.ElimOnAnonHyp $mlexpr_of_int n$ >>
 
-let mlexpr_of_binding = mlexpr_of_pair mlexpr_of_binding_kind mlexpr_of_constr
-
-let mlexpr_of_constr_with_binding =
-  mlexpr_of_pair mlexpr_of_constr mlexpr_of_binding_kind
-
 let mlexpr_of_clause_pattern _ = failwith "mlexpr_of_clause_pattern: TODO"
 
 let mlexpr_of_pattern_ast = mlexpr_of_constr
@@ -278,37 +295,39 @@ let rec mlexpr_of_atomic_tactic = function
       <:expr< Tacexpr.TacExactNoCheck $mlexpr_of_constr c$ >>
   | Tacexpr.TacVmCastNoCheck c ->
       <:expr< Tacexpr.TacVmCastNoCheck $mlexpr_of_constr c$ >>
-  | Tacexpr.TacApply cb ->
-      <:expr< Tacexpr.TacApply $mlexpr_of_constr_with_binding cb$ >>
-  | Tacexpr.TacElim (cb,cbo) ->
+  | Tacexpr.TacApply (b,false,cb) ->
+      <:expr< Tacexpr.TacApply $mlexpr_of_bool b$ False $mlexpr_of_constr_with_binding cb$ >>
+  | Tacexpr.TacElim (false,cb,cbo) ->
       let cb = mlexpr_of_constr_with_binding cb in
       let cbo = mlexpr_of_option mlexpr_of_constr_with_binding cbo in
-      <:expr< Tacexpr.TacElim $cb$ $cbo$ >>
+      <:expr< Tacexpr.TacElim False $cb$ $cbo$ >>
   | Tacexpr.TacElimType c ->
       <:expr< Tacexpr.TacElimType $mlexpr_of_constr c$ >>
-  | Tacexpr.TacCase cb ->
+  | Tacexpr.TacCase (false,cb) ->
       let cb = mlexpr_of_constr_with_binding cb in
-      <:expr< Tacexpr.TacCase $cb$ >>
+      <:expr< Tacexpr.TacCase False $cb$ >>
   | Tacexpr.TacCaseType c ->
       <:expr< Tacexpr.TacCaseType $mlexpr_of_constr c$ >>
   | Tacexpr.TacFix (ido,n) ->
       let ido = mlexpr_of_ident_option ido in
       let n = mlexpr_of_int n in
       <:expr< Tacexpr.TacFix $ido$ $n$ >>
-  | Tacexpr.TacMutualFix (id,n,l) ->
+  | Tacexpr.TacMutualFix (b,id,n,l) ->
+      let b = mlexpr_of_bool b in
       let id = mlexpr_of_ident id in
       let n = mlexpr_of_int n in
       let f =mlexpr_of_triple mlexpr_of_ident mlexpr_of_int mlexpr_of_constr in
       let l = mlexpr_of_list f l in
-      <:expr< Tacexpr.TacMutualFix $id$ $n$ $l$ >>
+      <:expr< Tacexpr.TacMutualFix $b$ $id$ $n$ $l$ >>
   | Tacexpr.TacCofix ido ->
       let ido = mlexpr_of_ident_option ido in
       <:expr< Tacexpr.TacCofix $ido$ >>
-  | Tacexpr.TacMutualCofix (id,l) ->
+  | Tacexpr.TacMutualCofix (b,id,l) ->
+      let b = mlexpr_of_bool b in
       let id = mlexpr_of_ident id in
       let f = mlexpr_of_pair mlexpr_of_ident mlexpr_of_constr in
       let l = mlexpr_of_list f l in
-      <:expr< Tacexpr.TacMutualCofix $id$ $l$ >>
+      <:expr< Tacexpr.TacMutualCofix $b$ $id$ $l$ >>
 
   | Tacexpr.TacCut c ->
       <:expr< Tacexpr.TacCut $mlexpr_of_constr c$ >>
@@ -317,29 +336,30 @@ let rec mlexpr_of_atomic_tactic = function
       <:expr< Tacexpr.TacAssert $mlexpr_of_option mlexpr_of_tactic t$ $ipat$ 
 	      $mlexpr_of_constr c$ >>
   | Tacexpr.TacGeneralize cl ->
-      <:expr< Tacexpr.TacGeneralize $mlexpr_of_list mlexpr_of_constr cl$ >>
+      <:expr< Tacexpr.TacGeneralize
+	      $mlexpr_of_list 
+                (mlexpr_of_pair mlexpr_of_occ_constr mlexpr_of_name) cl$ >>
   | Tacexpr.TacGeneralizeDep c ->
       <:expr< Tacexpr.TacGeneralizeDep $mlexpr_of_constr c$ >>
-  | Tacexpr.TacLetTac (na,c,cl) ->
+  | Tacexpr.TacLetTac (na,c,cl,b) ->
       let na = mlexpr_of_name na in
       let cl = mlexpr_of_clause_pattern cl in
-      <:expr< Tacexpr.TacLetTac $na$ $mlexpr_of_constr c$ $cl$ >>
+      <:expr< Tacexpr.TacLetTac $na$ $mlexpr_of_constr c$ $cl$
+	      $mlexpr_of_bool b$ >>
 
   (* Derived basic tactics *)
   | Tacexpr.TacSimpleInduction h ->
       <:expr< Tacexpr.TacSimpleInduction ($mlexpr_of_quantified_hypothesis h$) >>
-  | Tacexpr.TacNewInduction (cl,cbo,ids) ->
+  | Tacexpr.TacNewInduction (false,cl,cbo,ids,cls) ->
       let cbo = mlexpr_of_option mlexpr_of_constr_with_binding cbo in
       let ids = mlexpr_of_intro_pattern ids in
-(*       let ids = mlexpr_of_option mlexpr_of_intro_pattern ids in *)
-(*       <:expr< Tacexpr.TacNewInduction $mlexpr_of_induction_arg c$ $cbo$ $ids$>> *)
-      <:expr< Tacexpr.TacNewInduction $mlexpr_of_list mlexpr_of_induction_arg cl$ $cbo$ $ids$>>
+      <:expr< Tacexpr.TacNewInduction False $mlexpr_of_list mlexpr_of_induction_arg cl$ $cbo$ $ids$ $mlexpr_of_option mlexpr_of_clause cls$ >>
   | Tacexpr.TacSimpleDestruct h ->
       <:expr< Tacexpr.TacSimpleDestruct $mlexpr_of_quantified_hypothesis h$ >>
-  | Tacexpr.TacNewDestruct (c,cbo,ids) ->
+  | Tacexpr.TacNewDestruct (false,c,cbo,ids,cls) ->
       let cbo = mlexpr_of_option mlexpr_of_constr_with_binding cbo in
       let ids = mlexpr_of_intro_pattern ids in
-      <:expr< Tacexpr.TacNewDestruct $mlexpr_of_list mlexpr_of_induction_arg c$ $cbo$ $ids$ >>
+      <:expr< Tacexpr.TacNewDestruct False $mlexpr_of_list mlexpr_of_induction_arg c$ $cbo$ $ids$ $mlexpr_of_option mlexpr_of_clause cls$ >>
 
   (* Context management *)
   | Tacexpr.TacClear (b,l) ->
@@ -354,18 +374,18 @@ let rec mlexpr_of_atomic_tactic = function
               $mlexpr_of_hyp id2$ >>
 
   (* Constructors *)
-  | Tacexpr.TacLeft l ->
-      <:expr< Tacexpr.TacLeft $mlexpr_of_binding_kind l$>>
-  | Tacexpr.TacRight l ->
-      <:expr< Tacexpr.TacRight $mlexpr_of_binding_kind l$>>
-  | Tacexpr.TacSplit (b,l) ->
+  | Tacexpr.TacLeft (ev,l) ->
+      <:expr< Tacexpr.TacLeft $mlexpr_of_bool ev$ $mlexpr_of_binding_kind l$>>
+  | Tacexpr.TacRight (ev,l) ->
+      <:expr< Tacexpr.TacRight $mlexpr_of_bool ev$ $mlexpr_of_binding_kind l$>>
+  | Tacexpr.TacSplit (ev,b,l) ->
       <:expr< Tacexpr.TacSplit
-        ($mlexpr_of_bool b$,$mlexpr_of_binding_kind l$)>>
-  | Tacexpr.TacAnyConstructor t ->
-      <:expr< Tacexpr.TacAnyConstructor $mlexpr_of_option mlexpr_of_tactic t$>>
-  | Tacexpr.TacConstructor (n,l) ->
+        ($mlexpr_of_bool ev$,$mlexpr_of_bool b$,$mlexpr_of_binding_kind l$)>>
+  | Tacexpr.TacAnyConstructor (ev,t) ->
+      <:expr< Tacexpr.TacAnyConstructor $mlexpr_of_bool ev$ $mlexpr_of_option mlexpr_of_tactic t$>>
+  | Tacexpr.TacConstructor (ev,n,l) ->
       let n = mlexpr_of_or_metaid mlexpr_of_int n in
-      <:expr< Tacexpr.TacConstructor $n$ $mlexpr_of_binding_kind l$>>
+      <:expr< Tacexpr.TacConstructor $mlexpr_of_bool ev$ $n$ $mlexpr_of_binding_kind l$>>
 
   (* Conversion *)
   | Tacexpr.TacReduce (r,cl) ->
@@ -403,8 +423,8 @@ let rec mlexpr_of_atomic_tactic = function
 and mlexpr_of_tactic : (Tacexpr.raw_tactic_expr -> MLast.expr) = function
   | Tacexpr.TacAtom (loc,t) ->
       <:expr< Tacexpr.TacAtom $dloc$ $mlexpr_of_atomic_tactic t$ >>
-  | Tacexpr.TacThen (t1,t2) -> 
-      <:expr< Tacexpr.TacThen $mlexpr_of_tactic t1$ $mlexpr_of_tactic t2$ >>
+  | Tacexpr.TacThen (t1,[||],t2,[||]) -> 
+      <:expr< Tacexpr.TacThen $mlexpr_of_tactic t1$ [||] $mlexpr_of_tactic t2$ [||]>>
   | Tacexpr.TacThens (t,tl) ->
       <:expr< Tacexpr.TacThens $mlexpr_of_tactic t$ $mlexpr_of_list mlexpr_of_tactic tl$>>
   | Tacexpr.TacFirst tl ->
@@ -431,13 +451,12 @@ and mlexpr_of_tactic : (Tacexpr.raw_tactic_expr -> MLast.expr) = function
   | Tacexpr.TacRec (id,(idl,t)) -> TacRec (loc,(id,(idl,f t)))
   | Tacexpr.TacRecIn (l,t) -> TacRecIn(loc,List.map (fun (id,t) -> (id,f t)) l,f t)
 *)
-  | Tacexpr.TacLetIn (l,t) ->
+  | Tacexpr.TacLetIn (isrec,l,t) ->
       let f =
-	mlexpr_of_triple
+	mlexpr_of_pair
 	  (mlexpr_of_pair (fun _ -> dloc) mlexpr_of_ident)
-	  (mlexpr_of_option mlexpr_of_tactic)
 	  mlexpr_of_tactic_arg in
-      <:expr< Tacexpr.TacLetIn $mlexpr_of_list f l$ $mlexpr_of_tactic t$ >>
+      <:expr< Tacexpr.TacLetIn $mlexpr_of_bool isrec$ $mlexpr_of_list f l$ $mlexpr_of_tactic t$ >>
   | Tacexpr.TacMatch (lz,t,l) ->
       <:expr< Tacexpr.TacMatch
         $mlexpr_of_bool lz$
@@ -453,19 +472,15 @@ and mlexpr_of_tactic : (Tacexpr.raw_tactic_expr -> MLast.expr) = function
       <:expr< Tacexpr.TacFun
         ($mlexpr_of_list mlexpr_of_ident_option idol$,
          $mlexpr_of_tactic body$) >>
-(*
-  | Tacexpr.TacFunRec of $dloc$ * identifier * tactic_fun_ast
-*)
-(*
-  | Tacexpr.TacArg (Tacexpr.AstTacArg (Coqast.Nmeta $dloc$ id)) -> anti loc id
-*)
-  | Tacexpr.TacArg (Tacexpr.MetaIdArg (_,id)) -> anti loc id
+  | Tacexpr.TacArg (Tacexpr.MetaIdArg (_,true,id)) -> anti loc id
   | Tacexpr.TacArg t ->
       <:expr< Tacexpr.TacArg $mlexpr_of_tactic_arg t$ >>
   | _ -> failwith "Quotation of tactic expressions: TODO"
 
 and mlexpr_of_tactic_arg = function
-  | Tacexpr.MetaIdArg (loc,id) -> anti loc id
+  | Tacexpr.MetaIdArg (loc,true,id) -> anti loc id
+  | Tacexpr.MetaIdArg (loc,false,id) -> 
+      <:expr< Tacexpr.ConstrMayEval (Rawterm.ConstrTerm $anti loc id$) >>
   | Tacexpr.TacCall (loc,t,tl) ->
       <:expr< Tacexpr.TacCall $dloc$ $mlexpr_of_reference t$ $mlexpr_of_list mlexpr_of_tactic_arg tl$>>
   | Tacexpr.Tacexp t ->
diff --git a/parsing/q_util.ml4 b/parsing/q_util.ml4
index 552c144a..da78e287 100644
--- a/parsing/q_util.ml4
+++ b/parsing/q_util.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: q_util.ml4 10087 2007-08-24 10:39:30Z herbelin $ *)
+(*i camlp4use: "q_MLast.cmo" i*)
+
+(* $Id: q_util.ml4 10091 2007-08-24 10:57:37Z herbelin $ *)
 
 (* This file defines standard combinators to build ml expressions *)
 
diff --git a/parsing/search.ml b/parsing/search.ml
index 28362d72..c375826c 100644
--- a/parsing/search.ml
+++ b/parsing/search.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: search.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
+(* $Id: search.ml 10840 2008-04-23 21:29:34Z herbelin $ *)
 
 open Pp
 open Util
@@ -50,17 +50,17 @@ let gen_crible refopt (fn : global_reference -> env -> constr -> unit) =
   let crible_rec (sp,_) lobj = match object_tag lobj with
     | "VARIABLE" ->
 	(try 
-	   let (idc,_,typ) = get_variable (basename sp) in 
+	   let (id,_,typ) = Global.lookup_named (basename sp) in 
            if refopt = None
-	     || head_const typ = constr_of_global (out_some refopt)
+	     || head_const typ = constr_of_global (Option.get refopt)
 	   then
-	     fn (VarRef idc) env typ
+	     fn (VarRef id) env typ
 	 with Not_found -> (* we are in a section *) ())
     | "CONSTANT" ->
 	let cst = locate_constant (qualid_of_sp sp) in
 	let typ = Typeops.type_of_constant env cst in
         if refopt = None
-	  || head_const typ = constr_of_global (out_some refopt)
+	  || head_const typ = constr_of_global (Option.get refopt)
 	then
 	  fn (ConstRef cst) env typ
     | "INDUCTIVE" -> 
@@ -214,7 +214,8 @@ let search_about_item (itemref,typ) = function
 let raw_search_about filter_modules display_function l =
   let filter ref' env typ =
     filter_modules ref' env typ &&
-    List.for_all (search_about_item (ref',typ)) l
+    List.for_all (search_about_item (ref',typ)) l && 
+    not (string_string_contains (name_of_reference ref') "_subproof")
   in
   gen_filtered_search filter display_function
 
diff --git a/parsing/tacextend.ml4 b/parsing/tacextend.ml4
index 2dfe489e..3d71af84 100644
--- a/parsing/tacextend.ml4
+++ b/parsing/tacextend.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacextend.ml4 10089 2007-08-24 10:49:43Z herbelin $ *)
+(*i camlp4use: "pa_extend.cmo q_MLast.cmo" i*)
+
+(* $Id: tacextend.ml4 10091 2007-08-24 10:57:37Z herbelin $ *)
 
 open Util
 open Genarg
@@ -64,7 +66,7 @@ let rec extract_signature = function
 let check_unicity s l =
   let l' = List.map (fun (l,_) -> extract_signature l) l in
   if not (Util.list_distinct l') then
-    Pp.warning_with Pp_control.err_ft
+    Pp.warning_with !Pp_control.err_ft
       ("Two distinct rules of tactic entry "^s^" have the same\n"^
       "non-terminals in the same order: put them in distinct tactic entries")
 
diff --git a/parsing/tactic_printer.ml b/parsing/tactic_printer.ml
index 1fef688c..c5b77774 100644
--- a/parsing/tactic_printer.ml
+++ b/parsing/tactic_printer.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tactic_printer.ml 9593 2007-02-05 13:58:52Z corbinea $ *)
+(* $Id: tactic_printer.ml 11146 2008-06-19 08:26:38Z corbinea $ *)
 
 open Pp
 open Util
@@ -34,7 +34,7 @@ let pr_rule = function
   | Nested(cmpd,_) ->
       begin
 	match cmpd with 
-	    Tactic (texp,_) -> hov 0 (pr_tactic texp)
+	  | Tactic (texp,_) -> hov 0 (pr_tactic texp)
 	  | Proof_instr (_,instr) -> hov 0 (pr_proof_instr instr)
       end
   | Daimon -> str "<Daimon>"
@@ -46,10 +46,20 @@ let uses_default_tac = function
 
 (* Does not print change of evars *)
 let pr_rule_dot = function 
-  | Prim Change_evars -> mt ()
+  | Prim Change_evars ->str "PC: ch_evars" ++  mt () 
+      (* PC: this might be redundant *)
   | r ->
       pr_rule r ++ if uses_default_tac r then str "..." else str"."
 
+let pr_rule_dot_fnl = function
+  | Nested (Tactic (TacAtom (_,(TacMutualFix (true,_,_,_)
+                              | TacMutualCofix (true,_,_))),_),_) ->
+      (* Very big hack to not display hidden tactics in "Theorem with" *)
+      (* (would not scale!) *)
+      mt ()
+   | Prim Change_evars -> mt ()
+   | r -> pr_rule_dot r ++ fnl ()
+
 exception Different
 
 (* We remove from the var context of env what is already in osign *)
@@ -88,40 +98,39 @@ let rec print_decl_script tac_printer nochange sigma pf =
 	 else 
 	   pr_change pf.goal)
 	++ fnl ()
-    | Some (Daimon,[]) -> mt ()
-    | Some (Prim Change_evars,[next]) -> 
-      (* ignore evar changes *)
-        print_decl_script tac_printer nochange sigma next
+    | Some (Daimon,[]) -> str "(* Some proof has been skipped here *)"
+    | Some (Prim Change_evars,[subpf]) ->   
+	print_decl_script tac_printer nochange sigma subpf
     | Some (Nested(Proof_instr (opened,instr),_) as rule,subprfs) ->
 	begin
 	  match instr.instr,subprfs with
 	    Pescape,[{ref=Some(_,subsubprfs)}] ->
 	      hov 7
-		(pr_rule_dot rule ++ fnl () ++
+		(pr_rule_dot_fnl rule ++
 		   prlist_with_sep pr_fnl tac_printer subsubprfs) ++ fnl () ++
 		if opened then mt () else str "return."
 	  | Pclaim _,[body;cont] ->
 	      hov 2
-		(pr_rule_dot rule ++ fnl () ++
+		(pr_rule_dot_fnl rule ++
 		   print_decl_script tac_printer nochange sigma body) ++ 
 		fnl () ++
 		if opened then mt () else str "end claim." ++ fnl () ++
 		  print_decl_script tac_printer nochange sigma cont
 	  | Pfocus _,[body;cont] ->
 	      hov 2 
-		(pr_rule_dot rule ++ fnl () ++
+		(pr_rule_dot_fnl rule ++
 		   print_decl_script tac_printer nochange sigma body) ++ 
 		fnl () ++
 		if opened then mt () else str "end focus." ++ fnl () ++
 		  print_decl_script tac_printer nochange sigma cont
 	  | (Psuppose _ |Pcase (_,_,_)),[body;cont] ->
 	      hov 2 
-		(pr_rule_dot rule ++ fnl () ++
+		(pr_rule_dot_fnl rule ++
 		   print_decl_script tac_printer nochange sigma body) ++ 
 		fnl () ++
 		print_decl_script tac_printer nochange sigma cont 
 	  | _,[next] ->
-	      pr_rule_dot rule ++ fnl () ++
+	      pr_rule_dot_fnl rule ++
 		print_decl_script tac_printer nochange sigma next
 	  | _,[] ->
 	      pr_rule_dot rule		
@@ -156,30 +165,28 @@ let rec print_script nochange sigma pf =
            (print_script nochange sigma) spfl )
     | Some(rule,spfl) ->
 	((if nochange then (mt ()) else (pr_change pf.goal ++ fnl ())) ++
-	   pr_rule_dot rule ++ fnl () ++
+	   pr_rule_dot_fnl rule ++
 	   prlist_with_sep pr_fnl
            (print_script nochange sigma) spfl )	
 
 (* printed by Show Script command *)
 
 let print_treescript nochange sigma pf =
-  let rec aux top pf =
+  let rec aux pf =
     match pf.ref with
     | None ->
         if nochange then 
-	  if pf.goal.evar_extra=None then
-	    (str"<Your Tactic Text here>")
-	  else (str"<Your Proof Text here>")
-	else 
-	  (pr_change pf.goal)
+	  if pf.goal.evar_extra=None then str"<Your Tactic Text here>"
+	  else str"<Your Proof Text here>"
+	else pr_change pf.goal
     | Some(Decl_proof opened,script) ->
 	assert (List.length script = 1);
 	begin
-	  if nochange then (mt ()) else (pr_change pf.goal ++ fnl ())
+	  if nochange then mt () else pr_change pf.goal ++ fnl ()
 	end ++
 	  hov 0 
 	  begin str "proof." ++ fnl () ++
-	    print_decl_script (aux false)  
+	    print_decl_script aux
 	    nochange sigma (List.hd script) 
 	  end ++ fnl () ++ 
 	  begin
@@ -190,22 +197,10 @@ let print_treescript nochange sigma pf =
 	   prlist_with_sep pr_fnl
            (print_script nochange sigma) spfl )
     | Some(r,spfl) ->
+        let indent = if List.length spfl >= 2 then 1 else 0 in
         (if nochange then mt () else (pr_change pf.goal ++ fnl ())) ++
-	  pr_rule_dot r ++
-	  begin
-	    if List.length spfl > 1 then
-	      fnl ()  ++ 
-		str " " ++  hov 0 (aux false (List.hd spfl)) ++ fnl () ++
-		hov 0 (prlist_with_sep fnl (aux false) (List.tl spfl))
-	    else
-	      match spfl with
-		| [] -> mt ()
-		| [spf] -> fnl () ++ 
-		    (if top then mt () else str "  ") ++ aux top spf
-		| _ -> fnl () ++ str " " ++
-		    hov 0 (prlist_with_sep fnl (aux false) spfl)
-	  end
-  in hov 0 (aux true pf)
+        hv indent (pr_rule_dot_fnl r ++ prlist_with_sep mt aux spfl)
+  in hov 0 (aux pf)
 
 let rec print_info_script sigma osign pf =
   let {evar_hyps=sign; evar_concl=cl} = pf.goal in
diff --git a/parsing/tactic_printer.mli b/parsing/tactic_printer.mli
index b1f6d41c..676dbdf2 100644
--- a/parsing/tactic_printer.mli
+++ b/parsing/tactic_printer.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tactic_printer.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
+(*i $Id: tactic_printer.mli 10580 2008-02-22 13:39:13Z lmamane $ i*)
 
 (*i*)
 open Pp
@@ -21,6 +21,7 @@ open Proof_type
 val print_proof : evar_map -> named_context -> proof_tree -> std_ppcmds
 val pr_rule     : rule -> std_ppcmds
 val pr_tactic   : tactic_expr -> std_ppcmds
+val pr_proof_instr : Decl_expr.proof_instr -> Pp.std_ppcmds
 val print_script :
   bool -> evar_map -> proof_tree -> std_ppcmds
 val print_treescript :
diff --git a/parsing/vernacextend.ml4 b/parsing/vernacextend.ml4
index 4847f385..d12ca098 100644
--- a/parsing/vernacextend.ml4
+++ b/parsing/vernacextend.ml4
@@ -6,7 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: vernacextend.ml4 10089 2007-08-24 10:49:43Z herbelin $ *)
+(*i camlp4use: "pa_extend.cmo q_MLast.cmo" i*)
+
+(* $Id: vernacextend.ml4 10091 2007-08-24 10:57:37Z herbelin $ *)
 
 open Util
 open Genarg
@@ -56,7 +58,7 @@ let rec extract_signature = function
 let check_unicity s l =
   let l' = List.map (fun (_,l,_) -> extract_signature l) l in
   if not (Util.list_distinct l') then
-    Pp.warning_with Pp_control.err_ft
+    Pp.warning_with !Pp_control.err_ft
       ("Two distinct rules of entry "^s^" have the same\n"^
       "non-terminals in the same order: put them in distinct vernac entries")