This patch (against OCaml 3.07) fixes the following issues:

- Camlp4: parsing of labeled function arguments.

- Emacs interface: portability issues between versions of GnuEmacs and XEmacs.

- Incorrect code generated for certain recursive module definitions.

- Name pollution issue on Mac OS X 10.3.

How to apply this patch:

* Go to the ocaml-3.07 source directory.

* Do "make clean".

* If you already applied the earlier patch ocaml-3.07-patch1.diffs,

  un-apply it first by running patch -p1 -R < /path/to/ocaml-3.07-patch1.diffs

* Run patch -p1 < /path/to/ocaml-3.07-patch2.diffs (this patch)

* Compile and install as usual (see file INSTALL).

--------------

Index: csl/bytecomp/translmod.ml

diff -u csl/bytecomp/translmod.ml:1.44 csl/bytecomp/translmod.ml:1.45

--- csl/bytecomp/translmod.ml:1.44	Mon Jul  7 15:42:49 2003

+++ csl/bytecomp/translmod.ml	Fri Oct  3 16:36:00 2003

@@ -10,7 +10,7 @@

 (*                                                                     *)

 (***********************************************************************)

-(* $Id: translmod.ml,v 1.44 2003/07/07 13:42:49 xleroy Exp $ *)

+(* $Id: translmod.ml,v 1.45 2003/10/03 14:36:00 xleroy Exp $ *)

 (* Translation from typed abstract syntax to lambda terms,

    for the module language *)

@@ -310,11 +310,12 @@

            transl_module Tcoerce_none (field_path rootpath id) modl,

            transl_structure (id :: fields) cc rootpath rem)

   | Tstr_recmodule bindings :: rem ->

+      let ext_fields = List.rev_append (List.map fst bindings) fields in

       compile_recmodule

         (fun id modl ->

           transl_module Tcoerce_none (field_path rootpath id) modl)

         bindings

-        (transl_structure (map_end fst bindings fields) cc rootpath rem)

+        (transl_structure ext_fields cc rootpath rem)

   | Tstr_modtype(id, decl) :: rem ->

       transl_structure fields cc rootpath rem

   | Tstr_open path :: rem ->

Index: csl/camlp4/camlp4/ast2pt.ml

diff -u csl/camlp4/camlp4/ast2pt.ml:1.25 csl/camlp4/camlp4/ast2pt.ml:1.26

--- csl/camlp4/camlp4/ast2pt.ml:1.25	Wed Jul 16 20:59:12 2003

+++ csl/camlp4/camlp4/ast2pt.ml	Tue Sep 30 16:39:26 2003

@@ -10,7 +10,7 @@

 (*                                                                     *)

 (***********************************************************************)

-(* $Id: ast2pt.ml,v 1.25 2003/07/16 18:59:12 mauny Exp $ *)

+(* $Id: ast2pt.ml,v 1.26 2003/09/30 14:39:26 mauny Exp $ *)

 open Stdpp;

 open MLast;

@@ -177,10 +177,10 @@

   | TyObj loc fl v -> mktyp loc (Ptyp_object (meth_list loc fl v))

   | TyCls loc id ->

       mktyp loc (Ptyp_class (long_id_of_string_list loc id) [] [])

-  | TyLab loc _ _ -> error loc "labeled type not allowed here"

+  | TyLab loc _ _ -> error loc "labelled type not allowed here"

   | TyLid loc s -> mktyp loc (Ptyp_constr (lident s) [])

-  | TyMan loc _ _ -> error loc "type manifest not allowed here"

-  | TyOlb loc lab _ -> error loc "labeled type not allowed here"

+  | TyMan loc _ _ -> error loc "manifest type not allowed here"

+  | TyOlb loc lab _ -> error loc "labelled type not allowed here"

   | TyPol loc pl t -> mktyp loc (Ptyp_poly pl (ctyp t))

   | TyQuo loc s -> mktyp loc (Ptyp_var s)

   | TyRec loc _ _ -> error loc "record type not allowed here"

Index: csl/camlp4/etc/pa_o.ml

diff -u csl/camlp4/etc/pa_o.ml:1.52 csl/camlp4/etc/pa_o.ml:1.54

--- csl/camlp4/etc/pa_o.ml:1.52	Thu Sep 25 14:05:05 2003

+++ csl/camlp4/etc/pa_o.ml	Tue Sep 30 16:39:38 2003

@@ -10,7 +10,7 @@

 (*                                                                     *)

 (***********************************************************************)

-(* $Id: pa_o.ml,v 1.52 2003/09/25 12:05:05 mauny Exp $ *)

+(* $Id: pa_o.ml,v 1.54 2003/09/30 14:39:38 mauny Exp $ *)

 open Stdpp;

 open Pcaml;

@@ -1148,16 +1148,16 @@

       | i = LIDENT -> [i] ] ]

   ;

   (* Labels *)

-  ctyp: AFTER "arrow"

-    [ NONA

+  ctyp: LEVEL "arrow"

+    [ RIGHTA

       [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->

-          <:ctyp< ~ $i$ : $t1$ -> $t2$ >>

+          <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >>

       | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->

-          <:ctyp< ? $i$ : $t1$ -> $t2$ >>

+          <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >>

       | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->

-          <:ctyp< ? $i$ : $t1$ -> $t2$ >>

+          <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >>

       | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->

-          <:ctyp< ? $i$ : $t1$ -> $t2$ >> ] ]

+          <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ]

   ;

   ctyp: LEVEL "simple"

     [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" ->

Index: csl/camlp4/meta/pa_r.ml

diff -u csl/camlp4/meta/pa_r.ml:1.53 csl/camlp4/meta/pa_r.ml:1.55

--- csl/camlp4/meta/pa_r.ml:1.53	Thu Sep 25 14:05:06 2003

+++ csl/camlp4/meta/pa_r.ml	Thu Oct  2 14:33:43 2003

@@ -10,7 +10,7 @@

 (*                                                                     *)

 (***********************************************************************)

-(* $Id: pa_r.ml,v 1.53 2003/09/25 12:05:06 mauny Exp $ *)

+(* $Id: pa_r.ml,v 1.55 2003/10/02 12:33:43 mauny Exp $ *)

 open Stdpp;

 open Pcaml;

@@ -542,6 +542,11 @@

           <:ctyp< ! $list:pl$ . $t$ >> ]

     | "arrow" RIGHTA

       [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ]

+    | "label" NONA

+      [ i = TILDEIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>

+      | i = LABEL; t =  SELF  -> <:ctyp< ~ $i$ : $t$ >>

+      | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >>

+      | i = OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ]

     | LEFTA

       [ t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >> ]

     | LEFTA

@@ -746,14 +751,6 @@

   class_longident:

     [ [ m = UIDENT; "."; l = SELF -> [m :: l]

       | i = LIDENT -> [i] ] ]

-  ;

-  (* Labels *)

-  ctyp: AFTER "arrow"

-    [ NONA

-      [ i = TILDEIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>

-      | i = LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >>

-      | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >> 

-      | i = OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ] ]

   ;

   ctyp: LEVEL "simple"

     [ [ "["; "="; rfl = row_field_list; "]" ->

Index: csl/camlp4/meta/q_MLast.ml

diff -u csl/camlp4/meta/q_MLast.ml:1.51 csl/camlp4/meta/q_MLast.ml:1.53

--- csl/camlp4/meta/q_MLast.ml:1.51	Wed Jul 16 14:50:08 2003

+++ csl/camlp4/meta/q_MLast.ml	Thu Oct  2 14:33:43 2003

@@ -10,7 +10,7 @@

 (*                                                                     *)

 (***********************************************************************)

-(* $Id: q_MLast.ml,v 1.51 2003/07/16 12:50:08 mauny Exp $ *)

+(* $Id: q_MLast.ml,v 1.53 2003/10/02 12:33:43 mauny Exp $ *)

 value gram = Grammar.gcreate (Plexer.gmake ());

@@ -127,7 +127,9 @@

 value a_STRING = Grammar.Entry.create gram "a_STRING";

 value a_CHAR = Grammar.Entry.create gram "a_CHAR";

 value a_TILDEIDENT = Grammar.Entry.create gram "a_TILDEIDENT";

+value a_LABEL = Grammar.Entry.create gram "a_LABEL";

 value a_QUESTIONIDENT = Grammar.Entry.create gram "a_QUESTIONIDENT";

+value a_OPTLABEL = Grammar.Entry.create gram "a_OPTLABEL";

 value o2b =

   fun

@@ -793,6 +795,13 @@

           Qast.Node "TyPol" [Qast.Loc; pl; t] ]

     | "arrow" RIGHTA

       [ t1 = SELF; "->"; t2 = SELF -> Qast.Node "TyArr" [Qast.Loc; t1; t2] ]

+    | "label" NONA

+      [ i = a_TILDEIDENT; ":"; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]

+      | i = a_LABEL; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]

+      | i = a_QUESTIONIDENT; ":"; t = SELF ->

+          Qast.Node "TyOlb" [Qast.Loc; i; t]

+      | i = a_OPTLABEL; t = SELF ->

+          Qast.Node "TyOlb" [Qast.Loc; i; t] ]

     | LEFTA

       [ t1 = SELF; t2 = SELF -> Qast.Node "TyApp" [Qast.Loc; t1; t2] ]

     | LEFTA

@@ -1006,13 +1015,6 @@

     [ [ m = a_UIDENT; "."; l = SELF -> Qast.Cons m l

       | i = a_LIDENT -> Qast.List [i] ] ]

   ;

-  (* Labels *)

-  ctyp: AFTER "arrow"

-    [ NONA

-      [ i = a_TILDEIDENT; ":"; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]

-      | i = a_QUESTIONIDENT; ":"; t = SELF ->

-          Qast.Node "TyOlb" [Qast.Loc; i; t] ] ]

-  ;

   ctyp: LEVEL "simple"

     [ [ "["; "="; rfl = row_field_list; "]" ->

           Qast.Node "TyVrn" [Qast.Loc; rfl; Qast.Option None]

@@ -1044,11 +1046,16 @@

       | "#"; sl = mod_ident -> Qast.Node "PaTyp" [Qast.Loc; sl]

       | i = a_TILDEIDENT; ":"; p = SELF ->

           Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]

+      | i = a_LABEL; p = SELF ->

+          Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]

       | i = a_TILDEIDENT -> Qast.Node "PaLab" [Qast.Loc; i; Qast.Option None]

       | i = a_QUESTIONIDENT; ":"; "("; p = patt_tcon; eo = SOPT eq_expr;

         ")" ->

           Qast.Node "PaOlb"

             [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]

+      | i = a_OPTLABEL; "("; p = patt_tcon; eo = SOPT eq_expr; ")" ->

+          Qast.Node "PaOlb"

+            [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]

       | i = a_QUESTIONIDENT ->

           Qast.Node "PaOlb" [Qast.Loc; i; Qast.Option None]

       | "?"; "("; p = patt_tcon; eo = SOPT eq_expr; ")" ->

@@ -1063,11 +1070,16 @@

   ipatt:

     [ [ i = a_TILDEIDENT; ":"; p = SELF ->

           Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]

+      | i = a_LABEL; p = SELF ->

+          Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]

       | i = a_TILDEIDENT -> Qast.Node "PaLab" [Qast.Loc; i; Qast.Option None]

       | i = a_QUESTIONIDENT; ":"; "("; p = ipatt_tcon; eo = SOPT eq_expr;

         ")" ->

           Qast.Node "PaOlb"

             [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]

+      | i = a_OPTLABEL; "("; p = ipatt_tcon; eo = SOPT eq_expr; ")" ->

+          Qast.Node "PaOlb"

+            [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]

       | i = a_QUESTIONIDENT ->

           Qast.Node "PaOlb" [Qast.Loc; i; Qast.Option None]

       | "?"; "("; p = ipatt_tcon; eo = SOPT eq_expr; ")" ->

@@ -1086,9 +1098,13 @@

     [ "label" NONA

       [ i = a_TILDEIDENT; ":"; e = SELF ->

           Qast.Node "ExLab" [Qast.Loc; i; Qast.Option (Some e)]

+      | i = a_LABEL; e = SELF ->

+          Qast.Node "ExLab" [Qast.Loc; i; Qast.Option (Some e)]

       | i = a_TILDEIDENT -> Qast.Node "ExLab" [Qast.Loc; i; Qast.Option None]

       | i = a_QUESTIONIDENT; ":"; e = SELF ->

           Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option (Some e)]

+      | i = a_OPTLABEL; e = SELF ->

+          Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option (Some e)]

       | i = a_QUESTIONIDENT ->

           Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option None] ] ]

   ;

@@ -1335,9 +1351,15 @@

     [ [ "~"; a = ANTIQUOT -> antiquot "" loc a

       | s = TILDEIDENT -> Qast.Str s ] ]

   ;

+  a_LABEL:

+    [ [ s = LABEL -> Qast.Str s ] ]

+  ;

   a_QUESTIONIDENT:

     [ [ "?"; a = ANTIQUOT -> antiquot "" loc a

       | s = QUESTIONIDENT -> Qast.Str s ] ]

+  ;

+  a_OPTLABEL:

+    [ [ s = OPTLABEL -> Qast.Str s ] ]

   ;

 END;

Index: csl/camlp4/ocaml_src/camlp4/ast2pt.ml

diff -u csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.24 csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.25

--- csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.24	Thu Jul 24 00:26:18 2003

+++ csl/camlp4/ocaml_src/camlp4/ast2pt.ml	Tue Sep 30 16:39:38 2003

@@ -169,10 +169,10 @@

   | TyObj (loc, fl, v) -> mktyp loc (Ptyp_object (meth_list loc fl v))

   | TyCls (loc, id) ->

       mktyp loc (Ptyp_class (long_id_of_string_list loc id, [], []))

-  | TyLab (loc, _, _) -> error loc "labeled type not allowed here"

+  | TyLab (loc, _, _) -> error loc "labelled type not allowed here"

   | TyLid (loc, s) -> mktyp loc (Ptyp_constr (lident s, []))

-  | TyMan (loc, _, _) -> error loc "type manifest not allowed here"

-  | TyOlb (loc, lab, _) -> error loc "labeled type not allowed here"

+  | TyMan (loc, _, _) -> error loc "manifest type not allowed here"

+  | TyOlb (loc, lab, _) -> error loc "labelled type not allowed here"

   | TyPol (loc, pl, t) -> mktyp loc (Ptyp_poly (pl, ctyp t))

   | TyQuo (loc, s) -> mktyp loc (Ptyp_var s)

   | TyRec (loc, _, _) -> error loc "record type not allowed here"

Index: csl/camlp4/ocaml_src/meta/pa_r.ml

diff -u csl/camlp4/ocaml_src/meta/pa_r.ml:1.48 csl/camlp4/ocaml_src/meta/pa_r.ml:1.50

--- csl/camlp4/ocaml_src/meta/pa_r.ml:1.48	Thu Sep 25 14:05:07 2003

+++ csl/camlp4/ocaml_src/meta/pa_r.ml	Thu Oct  2 14:33:44 2003

@@ -1540,6 +1540,25 @@

       Gramext.action

         (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->

            (MLast.TyArr (loc, t1, t2) : 'ctyp))];

+     Some "label", Some Gramext.NonA,

+     [[Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) (i : string) (loc : int * int) ->

+           (MLast.TyOlb (loc, i, t) : 'ctyp));

+      [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");

+       Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->

+           (MLast.TyOlb (loc, i, t) : 'ctyp));

+      [Gramext.Stoken ("LABEL", ""); Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) (i : string) (loc : int * int) ->

+           (MLast.TyLab (loc, i, t) : 'ctyp));

+      [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");

+       Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->

+           (MLast.TyLab (loc, i, t) : 'ctyp))];

      None, Some Gramext.LeftA,

      [[Gramext.Sself; Gramext.Sself],

       Gramext.action

@@ -2240,27 +2259,6 @@

       Gramext.action

         (fun (l : 'class_longident) _ (m : string) (loc : int * int) ->

            (m :: l : 'class_longident))]];

-    Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),

-    Some (Gramext.After "arrow"),

-    [None, Some Gramext.NonA,

-     [[Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],

-      Gramext.action

-        (fun (t : 'ctyp) (i : string) (loc : int * int) ->

-           (MLast.TyOlb (loc, i, t) : 'ctyp));

-      [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");

-       Gramext.Sself],

-      Gramext.action

-        (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->

-           (MLast.TyOlb (loc, i, t) : 'ctyp));

-      [Gramext.Stoken ("LABEL", ""); Gramext.Sself],

-      Gramext.action

-        (fun (t : 'ctyp) (i : string) (loc : int * int) ->

-           (MLast.TyLab (loc, i, t) : 'ctyp));

-      [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");

-       Gramext.Sself],

-      Gramext.action

-        (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->

-           (MLast.TyLab (loc, i, t) : 'ctyp))]];

     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),

     Some (Gramext.Level "simple"),

     [None, None,

Index: csl/camlp4/ocaml_src/meta/q_MLast.ml

diff -u csl/camlp4/ocaml_src/meta/q_MLast.ml:1.56 csl/camlp4/ocaml_src/meta/q_MLast.ml:1.58

--- csl/camlp4/ocaml_src/meta/q_MLast.ml:1.56	Thu Jul 24 00:26:19 2003

+++ csl/camlp4/ocaml_src/meta/q_MLast.ml	Thu Oct  2 14:33:44 2003

@@ -153,7 +153,9 @@

 let a_STRING = Grammar.Entry.create gram "a_STRING";;

 let a_CHAR = Grammar.Entry.create gram "a_CHAR";;

 let a_TILDEIDENT = Grammar.Entry.create gram "a_TILDEIDENT";;

+let a_LABEL = Grammar.Entry.create gram "a_LABEL";;

 let a_QUESTIONIDENT = Grammar.Entry.create gram "a_QUESTIONIDENT";;

+let a_OPTLABEL = Grammar.Entry.create gram "a_OPTLABEL";;

 let o2b =

   function

@@ -626,7 +628,7 @@

                 Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3

               | _ ->

                   match () with

-                  _ -> raise (Match_failure ("q_MLast.ml", 300, 19))

+                  _ -> raise (Match_failure ("q_MLast.ml", 302, 19))

             in

             Qast.Node ("StExc", [Qast.Loc; c; tl; b]) :

             'str_item));

@@ -896,7 +898,7 @@

                 Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3

               | _ ->

                   match () with

-                  _ -> raise (Match_failure ("q_MLast.ml", 358, 19))

+                  _ -> raise (Match_failure ("q_MLast.ml", 360, 19))

             in

             Qast.Node ("SgExc", [Qast.Loc; c; tl]) :

             'sig_item));

@@ -2254,6 +2256,32 @@

       Gramext.action

         (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->

            (Qast.Node ("TyArr", [Qast.Loc; t1; t2]) : 'ctyp))];

+     Some "label", Some Gramext.NonA,

+     [[Gramext.Snterm

+         (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));

+       Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) (i : 'a_OPTLABEL) (loc : int * int) ->

+           (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));

+      [Gramext.Snterm

+         (Grammar.Entry.obj

+            (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));

+       Gramext.Stoken ("", ":"); Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->

+           (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));

+      [Gramext.Snterm

+         (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));

+       Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) (i : 'a_LABEL) (loc : int * int) ->

+           (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp));

+      [Gramext.Snterm

+         (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));

+       Gramext.Stoken ("", ":"); Gramext.Sself],

+      Gramext.action

+        (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT) (loc : int * int) ->

+           (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp))];

      None, Some Gramext.LeftA,

      [[Gramext.Sself; Gramext.Sself],

       Gramext.action

@@ -3345,22 +3373,6 @@

         (fun (l : 'class_longident) _ (m : 'a_UIDENT) (loc : int * int) ->

            (Qast.Cons (m, l) : 'class_longident))]];

     Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),

-    Some (Gramext.After "arrow"),

-    [None, Some Gramext.NonA,

-     [[Gramext.Snterm

-         (Grammar.Entry.obj

-            (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));

-       Gramext.Stoken ("", ":"); Gramext.Sself],

-      Gramext.action

-        (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->

-           (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));

-      [Gramext.Snterm

-         (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));

-       Gramext.Stoken ("", ":"); Gramext.Sself],

-      Gramext.action

-        (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT) (loc : int * int) ->

-           (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp))]];

-    Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),

     Some (Gramext.Level "simple"),

     [None, None,

      [[Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");

@@ -3518,6 +3530,30 @@

         (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->

            (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'patt));

       [Gramext.Snterm

+         (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));

+       Gramext.Stoken ("", "(");

+       Gramext.Snterm

+         (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e));

+       Gramext.srules

+         [[Gramext.Sopt

+             (Gramext.Snterm

+                (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],

+          Gramext.action

+            (fun (a : 'eq_expr option) (loc : int * int) ->

+               (Qast.Option a : 'a_opt));

+          [Gramext.Snterm

+             (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],

+          Gramext.action

+            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];

+       Gramext.Stoken ("", ")")],

+      Gramext.action

+        (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ (i : 'a_OPTLABEL)

+           (loc : int * int) ->

+           (Qast.Node

+              ("PaOlb",

+               [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :

+            'patt));

+      [Gramext.Snterm

          (Grammar.Entry.obj

             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));

        Gramext.Stoken ("", ":"); Gramext.Stoken ("", "(");

@@ -3548,6 +3584,13 @@

         (fun (i : 'a_TILDEIDENT) (loc : int * int) ->

            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'patt));

       [Gramext.Snterm

+         (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));

+       Gramext.Sself],

+      Gramext.action

+        (fun (p : 'patt) (i : 'a_LABEL) (loc : int * int) ->

+           (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :

+            'patt));

+      [Gramext.Snterm

          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));

        Gramext.Stoken ("", ":"); Gramext.Sself],

       Gramext.action

@@ -3606,6 +3649,30 @@

         (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->

            (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'ipatt));

       [Gramext.Snterm

+         (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));

+       Gramext.Stoken ("", "(");

+       Gramext.Snterm

+         (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e));

+       Gramext.srules

+         [[Gramext.Sopt

+             (Gramext.Snterm

+                (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],

+          Gramext.action

+            (fun (a : 'eq_expr option) (loc : int * int) ->

+               (Qast.Option a : 'a_opt));

+          [Gramext.Snterm

+             (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],

+          Gramext.action

+            (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];

+       Gramext.Stoken ("", ")")],

+      Gramext.action

+        (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ (i : 'a_OPTLABEL)

+           (loc : int * int) ->

+           (Qast.Node

+              ("PaOlb",

+               [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :

+            'ipatt));

+      [Gramext.Snterm

          (Grammar.Entry.obj

             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));

        Gramext.Stoken ("", ":"); Gramext.Stoken ("", "(");

@@ -3636,6 +3703,13 @@

         (fun (i : 'a_TILDEIDENT) (loc : int * int) ->

            (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'ipatt));

       [Gramext.Snterm

+         (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));

+       Gramext.Sself],

+      Gramext.action

+        (fun (p : 'ipatt) (i : 'a_LABEL) (loc : int * int) ->

+           (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :

+            'ipatt));

+      [Gramext.Snterm

          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));

        Gramext.Stoken ("", ":"); Gramext.Sself],

       Gramext.action

@@ -3669,6 +3743,13 @@

         (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->

            (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option None]) : 'expr));

       [Gramext.Snterm

+         (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));

+       Gramext.Sself],

+      Gramext.action

+        (fun (e : 'expr) (i : 'a_OPTLABEL) (loc : int * int) ->

+           (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option (Some e)]) :

+            'expr));

+      [Gramext.Snterm

          (Grammar.Entry.obj

             (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));

        Gramext.Stoken ("", ":"); Gramext.Sself],

@@ -3682,6 +3763,13 @@

         (fun (i : 'a_TILDEIDENT) (loc : int * int) ->

            (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option None]) : 'expr));

       [Gramext.Snterm

+         (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));

+       Gramext.Sself],

+      Gramext.action

+        (fun (e : 'expr) (i : 'a_LABEL) (loc : int * int) ->

+           (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option (Some e)]) :

+            'expr));

+      [Gramext.Snterm

          (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));

        Gramext.Stoken ("", ":"); Gramext.Sself],

       Gramext.action

@@ -4427,6 +4515,11 @@

      Gramext.action

        (fun (a : string) _ (loc : int * int) ->

           (antiquot "" loc a : 'a_TILDEIDENT))]];

+   Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e), None,

+   [None, None,

+    [[Gramext.Stoken ("LABEL", "")],

+     Gramext.action

+       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_LABEL))]];

    Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e),

    None,

    [None, None,

@@ -4437,7 +4530,12 @@

      [Gramext.Stoken ("", "?"); Gramext.Stoken ("ANTIQUOT", "")],

      Gramext.action

        (fun (a : string) _ (loc : int * int) ->

-          (antiquot "" loc a : 'a_QUESTIONIDENT))]]];;

+          (antiquot "" loc a : 'a_QUESTIONIDENT))]];

+   Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e), None,

+   [None, None,

+    [[Gramext.Stoken ("OPTLABEL", "")],

+     Gramext.action

+       (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_OPTLABEL))]]];;

 let apply_entry e =

   let f s = Grammar.Entry.parse e (Stream.of_string s) in

Index: csl/emacs/Makefile

diff -u csl/emacs/Makefile:1.15 csl/emacs/Makefile:1.16

--- csl/emacs/Makefile:1.15	Fri Aug 29 17:38:28 2003

+++ csl/emacs/Makefile	Fri Oct 10 15:25:38 2003

@@ -1,4 +1,4 @@

-# $Id: Makefile,v 1.15 2003/08/29 15:38:28 doligez Exp $

+# $Id: Makefile,v 1.16 2003/10/10 13:25:38 remy Exp $

 include ../config/Makefile

@@ -24,6 +24,7 @@

               (byte-compile-file "caml.el") \

               (byte-compile-file "inf-caml.el") \

               (byte-compile-file "caml-help.el") \

+              (byte-compile-file "caml-types.el") \

               (byte-compile-file "camldebug.el"))

 install:

Index: csl/emacs/caml-emacs.el

diff -u csl/emacs/caml-emacs.el:1.4 csl/emacs/caml-emacs.el:1.5

--- csl/emacs/caml-emacs.el:1.4	Mon Aug 25 17:01:20 2003

+++ csl/emacs/caml-emacs.el	Fri Oct 10 15:25:38 2003

@@ -8,7 +8,7 @@

 (defun caml-event-window (e) (posn-window (event-start e)))

 (defun caml-event-point-start (e) (posn-point (event-start e)))

 (defun caml-event-point-end (e) (posn-point (event-end e)))

-(defalias 'caml-track-mouse 'track-mouse)

 (defalias 'caml-read-event 'read-event)

+(defmacro caml-track-mouse (&rest body) (cons 'track-mouse body))

 (provide 'caml-emacs)

Index: csl/emacs/caml-types.el

diff -u csl/emacs/caml-types.el:1.24 csl/emacs/caml-types.el:1.26

--- csl/emacs/caml-types.el:1.24	Fri Sep  5 20:01:46 2003

+++ csl/emacs/caml-types.el	Sat Oct 11 02:00:14 2003

@@ -10,7 +10,7 @@

 ;(*                                                                     *)

 ;(***********************************************************************)

-;(* $Id: caml-types.el,v 1.24 2003/09/05 18:01:46 remy Exp $ *)

+;(* $Id: caml-types.el,v 1.26 2003/10/11 00:00:14 doligez Exp $ *)

 ; An emacs-lisp complement to the "-dtypes" option of ocamlc and ocamlopt.

@@ -21,6 +21,8 @@

       (require 'caml-xemacs)

     (require 'caml-emacs)))

+

+

 (defvar caml-types-location-re nil "Regexp to parse *.annot files.

 Annotation files *.annot may be generated with the \"-dtypes\" option 

@@ -160,8 +162,10 @@

          (target-file (file-name-nondirectory (buffer-file-name)))

          (target-date (nth 5 (file-attributes target-file))))

     (unless (and caml-types-annotation-tree

+                 type-date

+                 caml-types-annotation-date

                  (not (caml-types-date< caml-types-annotation-date type-date)))

-      (if (caml-types-date< type-date target-date)

+      (if (and type-date target-date (caml-types-date< type-date target-date))

           (error (format "%s is more recent than %s" target-file type-file)))

       (message "Reading annotation file...")

       (let* ((type-buf (caml-types-find-file type-file))

@@ -376,10 +380,13 @@

      (with-current-buffer buf (toggle-read-only 1))

      )

    (t

-    (error "No annotation file. You may compile with \"-dtypes\" option"))

+    (error "No annotation file. You should compile with option \"-dtypes\"."))

     )

   buf))

+(defun caml-types-mouse-ignore (event)

+  (interactive "e")

+  nil)

 (defun caml-types-explore (event)

   "Explore type annotations by mouse dragging.

@@ -395,58 +402,79 @@

          (target-line) (target-bol)

          target-pos

          Left Right limits cnum node mes type

-         (tree caml-types-annotation-tree)

          region

+         target-tree

          )

-    (caml-types-preprocess type-file)

-    (unless caml-types-buffer 

-      (setq caml-types-buffer (get-buffer-create caml-types-buffer-name)))

-      ;; (message "Drag the mouse to explore types")

     (unwind-protect

-        (caml-track-mouse

-         (setq region

-               (caml-types-typed-make-overlay target-buf

-                                        (caml-event-point-start event)))

-         (while (and event

-                     (integer-or-marker-p

-                      (setq cnum (caml-event-point-end event))))

-           (if (and region (<= (car region) cnum) (<= cnum (cdr region)))

-               (if (and limits (>= cnum (car limits)) (< cnum (cdr limits)))

-                   (message mes)

-                 (setq target-bol

-                       (save-excursion (goto-char cnum)

-                                       (caml-line-beginning-position)))

-                 (setq target-line

-                       (1+ (count-lines (point-min) target-bol)))

-                 (setq target-pos (vector target-file target-line target-bol cnum))

-                 (save-excursion

-                   (setq node (caml-types-find-location target-pos () tree))

-                   (set-buffer caml-types-buffer)

-                   (erase-buffer)

-                   (cond

-                    (node

-                     (setq Left (caml-types-get-pos target-buf (elt node 0)))

-                     (setq Right (caml-types-get-pos target-buf (elt node 1)))

-                     (move-overlay caml-types-expr-ovl Left Right target-buf)

-                     (setq limits (caml-types-find-interval target-buf target-pos

-                                                            node))

-                     (setq type (elt node 2))

-                     )

-                    (t

-                     (delete-overlay caml-types-expr-ovl)

-                     (setq type "*no type information*")

-                     (setq limits (caml-types-find-interval target-buf target-pos

-                                                            tree))

-                     ))

-                   (message (setq mes (format "type: %s" type)))

-                   (insert type)

-                   )))

-             (setq event (caml-read-event))

-             (unless (mouse-movement-p event) (setq event nil))

-             )

-         )

-      (delete-overlay caml-types-expr-ovl)

-      (delete-overlay caml-types-typed-ovl)

+        (progn

+          (caml-types-preprocess type-file)

+          (setq target-tree caml-types-annotation-tree)

+          (unless caml-types-buffer 

+            (setq caml-types-buffer

+                  (get-buffer-create caml-types-buffer-name)))

+          ;; (message "Drag the mouse to explore types")

+          (unwind-protect

+              (caml-track-mouse

+               (setq region

+                     (caml-types-typed-make-overlay

+                      target-buf (caml-event-point-start event)))

+               (while (and event

+                           (integer-or-marker-p

+                            (setq cnum (caml-event-point-end event))))

+                 (if (and region (<= (car region) cnum) (< cnum (cdr region)))

+                     (if (and limits

+                              (>= cnum (car limits)) (< cnum (cdr limits)))

+                         (message mes)

+                       (setq target-bol

+                             (save-excursion

+                               (goto-char cnum) (caml-line-beginning-position))

+                             target-line (1+ (count-lines (point-min)

+                                                          target-bol))

+                             target-pos

+                             (vector target-file target-line target-bol cnum))

+                       (save-excursion

+                         (setq node (caml-types-find-location

+                                     target-pos () target-tree))

+                         (set-buffer caml-types-buffer)

+                         (erase-buffer)

+                         (cond

+                          (node

+                           (setq Left

+                                 (caml-types-get-pos target-buf (elt node 0))

+                                 Right

+                                 (caml-types-get-pos target-buf (elt node 1)))

+                           (move-overlay

+                            caml-types-expr-ovl Left Right target-buf)

+                           (setq limits

+                                 (caml-types-find-interval target-buf

+                                                           target-pos node)

+                                 type (elt node 2))

+                           )

+                          (t

+                           (delete-overlay caml-types-expr-ovl)

+                           (setq type "*no type information*")

+                           (setq limits

+                                 (caml-types-find-interval

+                                  target-buf target-pos target-tree))

+                           ))

+                         (message (setq mes (format "type: %s" type)))

+                         (insert type)

+                         )))

+                 (setq event (caml-read-event))

+                 (unless (mouse-movement-p event) (setq event nil))

+                 )

+               )

+            (delete-overlay caml-types-expr-ovl)

+            (delete-overlay caml-types-typed-ovl)

+            ))

+      ;; the mouse is down. One should prevent against mouse release,

+      ;; which could do something undesirable.

+      ;; In most common cases, next event will be mouse release.

+      ;; However, it could also be a key stroke before mouse release.

+      ;; Will then execute the action for mouse release (if bound).

+      ;; Emacs does not allow to test whether mouse is up or down.

+      ;; Same problem may happen above while exploring

+      (if (and event (caml-read-event)))

       )))

 (defun caml-types-typed-make-overlay (target-buf pos)

@@ -459,7 +487,7 @@

         (if (and (equal target-buf (current-buffer))

                  (setq left (caml-types-get-pos target-buf (elt node 0))

                        right (caml-types-get-pos target-buf (elt node 1)))

-                 (<= left pos) (>= right pos)

+                 (<= left pos) (> right pos)

                  )

             (setq start (min start left)

                   end (max end right))

Index: csl/emacs/caml-xemacs.el

diff -u csl/emacs/caml-xemacs.el:1.3 csl/emacs/caml-xemacs.el:1.4

--- csl/emacs/caml-xemacs.el:1.3	Tue Jul 29 09:30:03 2003

+++ csl/emacs/caml-xemacs.el	Fri Oct 10 15:25:38 2003

@@ -12,8 +12,9 @@

 (defun caml-event-window (e) (event-window e))

 (defun caml-event-point-start (e) (event-closest-point e))

 (defun caml-event-point-end (e) (event-closest-point e))

-(defalias 'caml-track-mouse 'progn)

 (defalias 'caml-read-event 'next-event)

+(defmacro caml-track-mouse (&rest body) (cons 'progn body))

+

 (defun mouse-movement-p (e) (equal (event-type e) 'motion))

 (provide 'caml-xemacs)

Index: csl/emacs/caml.el

diff -u csl/emacs/caml.el:1.34 csl/emacs/caml.el:1.35

--- csl/emacs/caml.el:1.34	Mon Jul 28 20:06:49 2003

+++ csl/emacs/caml.el	Fri Oct 10 15:25:38 2003

@@ -283,6 +283,8 @@

   ;; caml-types

   (define-key caml-mode-map [?\C-c?\C-t] 'caml-types-show-type)

+  ;; to prevent misbehavior in case of error during exploration.

+  (define-key caml-mode-map [mouse-2] 'caml-types-mouse-ignore)

   (define-key caml-mode-map [down-mouse-2] 'caml-types-explore)

   ;; caml-help

   (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path)

Index: csl/otherlibs/threads/scheduler.c

diff -u csl/otherlibs/threads/scheduler.c:1.56 csl/otherlibs/threads/scheduler.c:1.57

--- csl/otherlibs/threads/scheduler.c:1.56	Thu Mar 20 17:23:03 2003

+++ csl/otherlibs/threads/scheduler.c	Fri Oct 10 15:13:21 2003

@@ -11,7 +11,7 @@

 /*                                                                     */

 /***********************************************************************/

-/* $Id: scheduler.c,v 1.56 2003/03/20 16:23:03 xleroy Exp $ */

+/* $Id: scheduler.c,v 1.57 2003/10/10 13:13:21 doligez Exp $ */

 /* The thread scheduler */

@@ -72,10 +72,10 @@

 /* The thread descriptors */

-struct thread_struct {

+struct caml_thread_struct {

   value ident;                  /* Unique id (for equality comparisons) */

-  struct thread_struct * next;  /* Double linking of threads */

-  struct thread_struct * prev;

+  struct caml_thread_struct * next;  /* Double linking of threads */

+  struct caml_thread_struct * prev;

   value * stack_low;            /* The execution stack for this thread */

   value * stack_high;

   value * stack_threshold;

@@ -94,7 +94,7 @@

   value retval;                 /* Value to return when thread resumes */

 };

-typedef struct thread_struct * thread_t;

+typedef struct caml_thread_struct * caml_thread_t;

 #define RUNNABLE Val_int(0)

 #define KILLED Val_int(1)

@@ -122,7 +122,7 @@

 #define DELAY_INFTY 1E30        /* +infty, for this purpose */

 /* The thread currently active */

-static thread_t curr_thread = NULL;

+static caml_thread_t curr_thread = NULL;

 /* Identifier for next thread creation */

 static value next_ident = Val_int(0);

@@ -134,7 +134,7 @@

 static void thread_scan_roots(scanning_action action)

 {

-  thread_t th, start;

+  caml_thread_t th, start;

   /* Scan all active descriptors */

   start = curr_thread;