diff --git a/.cvsignore b/.cvsignore index e69de29..5a0a4c7 100644 --- a/.cvsignore +++ b/.cvsignore @@ -0,0 +1,4 @@ +ocaml-3.07-refman.html.tar.gz +ocaml-3.07-refman.info.tar.gz +ocaml-3.07-refman.ps.gz +ocaml-3.07.tar.gz diff --git a/ocaml-3.07-patch2.diffs b/ocaml-3.07-patch2.diffs new file mode 100644 index 0000000..7ded54f --- /dev/null +++ b/ocaml-3.07-patch2.diffs @@ -0,0 +1,1016 @@ +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; +@@ -161,7 +161,8 @@ + if (curr_thread != NULL) return Val_unit; + /* Create a descriptor for the current thread */ + curr_thread = +- (thread_t) alloc_shr(sizeof(struct thread_struct) / sizeof(value), 0); ++ (caml_thread_t) alloc_shr(sizeof(struct caml_thread_struct) ++ / sizeof(value), 0); + curr_thread->ident = next_ident; + next_ident = Val_int(Int_val(next_ident) + 1); + curr_thread->next = curr_thread; +@@ -218,10 +219,11 @@ + + value thread_new(value clos) /* ML */ + { +- thread_t th; ++ caml_thread_t th; + /* Allocate the thread and its stack */ + Begin_root(clos); +- th = (thread_t) alloc_shr(sizeof(struct thread_struct) / sizeof(value), 0); ++ th = (caml_thread_t) alloc_shr(sizeof(struct caml_thread_struct) ++ / sizeof(value), 0); + End_roots(); + th->ident = next_ident; + next_ident = Val_int(Int_val(next_ident) + 1); +@@ -268,7 +270,7 @@ + + value thread_id(value th) /* ML */ + { +- return ((struct thread_struct *)th)->ident; ++ return ((caml_thread_t)th)->ident; + } + + /* Return the current time as a floating-point number */ +@@ -293,7 +295,7 @@ + + static value schedule_thread(void) + { +- thread_t run_thread, th; ++ caml_thread_t run_thread, th; + fd_set readfds, writefds, exceptfds; + double delay, now; + int need_select, need_wait; +@@ -353,7 +355,7 @@ + } + } + if (th->status & (BLOCKED_JOIN - 1)) { +- if (((thread_t)(th->joining))->status == KILLED) { ++ if (((caml_thread_t)(th->joining))->status == KILLED) { + th->status = RUNNABLE; + Assign(th->retval, RESUMED_JOIN); + } +@@ -682,7 +684,7 @@ + { + check_callback(); + Assert(curr_thread != NULL); +- if (((thread_t)th)->status == KILLED) return Val_unit; ++ if (((caml_thread_t)th)->status == KILLED) return Val_unit; + curr_thread->status = BLOCKED_JOIN; + Assign(curr_thread->joining, th); + return schedule_thread(); +@@ -703,7 +705,7 @@ + + value thread_wakeup(value thread) /* ML */ + { +- thread_t th = (thread_t) thread; ++ caml_thread_t th = (caml_thread_t) thread; + switch (th->status) { + case SUSPENDED: + th->status = RUNNABLE; +@@ -730,7 +732,7 @@ + value thread_kill(value thread) /* ML */ + { + value retval = Val_unit; +- thread_t th = (thread_t) thread; ++ caml_thread_t th = (caml_thread_t) thread; + if (th->status == KILLED) failwith("Thread.kill: killed thread"); + /* Don't paint ourselves in a corner */ + if (th == th->next) failwith("Thread.kill: cannot kill the last thread"); +@@ -740,7 +742,7 @@ + if (th == curr_thread) { + Begin_root(thread); + retval = schedule_thread(); +- th = (thread_t) thread; ++ th = (caml_thread_t) thread; + End_roots(); + } + /* Remove thread from the doubly-linked list */ +Index: csl/stdlib/buffer.mli +diff -u csl/stdlib/buffer.mli:1.16 csl/stdlib/buffer.mli:1.17 +--- csl/stdlib/buffer.mli:1.16 Wed May 14 19:52:19 2003 ++++ csl/stdlib/buffer.mli Wed Oct 8 15:12:44 2003 +@@ -74,7 +74,7 @@ + - a non empty sequence of alphanumeric or [_] characters, + - an arbitrary sequence of characters enclosed by a pair of + matching parentheses or curly brackets. +- An escaped [$] character is a [$] that immediately folows a backslash ++ An escaped [$] character is a [$] that immediately follows a backslash + character; it then stands for a plain [$]. + Raise [Not_found] if the closing character of a parenthesized variable + cannot be found. *) +Index: csl/stdlib/pervasives.mli +diff -u csl/stdlib/pervasives.mli:1.93 csl/stdlib/pervasives.mli:1.94 +--- csl/stdlib/pervasives.mli:1.93 Thu Sep 4 14:44:48 2003 ++++ csl/stdlib/pervasives.mli Wed Oct 8 15:13:33 2003 +@@ -11,7 +11,7 @@ + (* *) + (***********************************************************************) + +-(* $Id: pervasives.mli,v 1.93 2003/09/04 12:44:48 doligez Exp $ *) ++(* $Id: pervasives.mli,v 1.94 2003/10/08 13:13:33 weis Exp $ *) + + (** The initially opened module. + +@@ -800,7 +800,7 @@ + + external string_of_format : + ('a, 'b, 'c, 'd) format4 -> string = "%identity" +-(** Converts a format string into a string.*) ++(** Converts a format string into a string. *) + external format_of_string : + ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4 = "%identity" + (** [format_of_string s] returns a format string read from the string +Index: csl/stdlib/sys.ml +diff -u csl/stdlib/sys.ml:1.78 csl/stdlib/sys.ml:1.80 +--- csl/stdlib/sys.ml:1.78 Fri Sep 12 09:46:23 2003 ++++ csl/stdlib/sys.ml Mon Oct 13 09:39:46 2003 +@@ -11,7 +11,7 @@ + (* *) + (***********************************************************************) + +-(* $Id: sys.ml,v 1.78 2003/09/12 07:46:23 xleroy Exp $ *) ++(* $Id: sys.ml,v 1.80 2003/10/13 07:39:46 xleroy Exp $ *) + + (* System interface *) + +@@ -78,4 +78,4 @@ + + (* OCaml version string, must be in the format described in sys.mli. *) + +-let ocaml_version = "3.07";; ++let ocaml_version = "3.07+2";; diff --git a/ocaml.spec b/ocaml.spec new file mode 100644 index 0000000..7bb4f39 --- /dev/null +++ b/ocaml.spec @@ -0,0 +1,201 @@ +Name: ocaml +Version: 3.07 +Release: 0.fdr.5.rh90 +Epoch: 0 +Summary: The Objective Caml compiler and programming environment + +Group: Development/Languages +License: QPL/LGPL +URL: http://www.ocaml.org/ +Source0: http://caml.inria.fr/distrib/ocaml-3.07/ocaml-3.07.tar.gz +Source1: http://caml.inria.fr/distrib/ocaml-3.07/ocaml-3.07-refman.html.tar.gz +Source2: http://caml.inria.fr/distrib/ocaml-3.07/ocaml-3.07-refman.ps.gz +Source3: http://caml.inria.fr/distrib/ocaml-3.07/ocaml-3.07-refman.info.tar.gz +Patch0: http://caml.inria.fr/distrib/ocaml-3.07/ocaml-3.07-patch2.diffs +BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) +BuildRequires: ncurses-devel, gdbm-devel, XFree86-devel +BuildRequires: /usr/include/tcl.h, /usr/include/tk.h +BuildRequires: emacs, perl +Requires(post,preun): /sbin/install-info + +%description +Objective Caml is a high-level, strongly-typed, functional and +object-oriented programming language from the ML family of languages. + +This package comprises two batch compilers (a fast bytecode compiler +and an optimizing native-code compiler), an interactive toplevel system, +parsing tools (Lex,Yacc,Camlp4), a replay debugger, a documentation generator, +and a comprehensive library. + +%package -n labltk +Group: Development/Languages +Summary: Tk bindings for Objective Caml +Requires: ocaml = %{epoch}:%{version}-%{release} + +%description -n labltk +A library for interfacing Objective Caml with the scripting language +Tcl/Tk. It include the OCamlBrowser code editor / library browser. + +%package -n camlp4 +Group: Development/Languages +Summary: A Pre-Processor-Pretty-Printer for OCaml +Requires: ocaml = %{epoch}:%{version}-%{release} + +%description -n camlp4 +Camlp4 is a Pre-Processor-Pretty-Printer for OCaml, parsing a source +file and printing some result on standard output. + +%package ocamldoc +Group: Development/Languages +Summary: Documentation generator for OCaml +Requires: ocaml = %{epoch}:%{version}-%{release} + +%description ocamldoc +Documentation generator for Objective Caml. + +%package emacs +Group: Development/Languages +Summary: Emacs mode for Objective Caml +Requires: ocaml = %{epoch}:%{version}-%{release} +Requires: emacs + +%description emacs +Emacs mode for Objective Caml. + +%package docs +Group: Development/Languages +Summary: Documentation for OCaml +Requires: ocaml = %{epoch}:%{version}-%{release} + +%description docs +Documentation for Objective Caml. + +%prep +%setup -q -T -b 0 +%setup -q -T -D -a 1 +%setup -q -T -D -a 3 +cp %{SOURCE2} refman.ps.gz +%patch0 -p1 + +%build +./configure \ + -ccoption "gcc $RPM_OPT_FLAGS" \ + -bindir %{_bindir} \ + -libdir %{_libdir}/ocaml \ + -mandir %{_mandir}/man1 +make world opt opt.opt +# %{?_smp_mflags} breaks the build +(cd emacs; make ocamltags) + +%install +rm -rf $RPM_BUILD_ROOT +%makeinstall BINDIR=$RPM_BUILD_ROOT%{_bindir} LIBDIR=$RPM_BUILD_ROOT%{_libdir}/ocaml MANDIR=$RPM_BUILD_ROOT%{_mandir} +perl -pi -e "s|^$RPM_BUILD_ROOT||" $RPM_BUILD_ROOT%{_libdir}/ocaml/ld.conf +( + cd emacs; + make install BINDIR=$RPM_BUILD_ROOT%{_bindir} EMACSDIR=$RPM_BUILD_ROOT%{_datadir}/emacs/site-lisp + make install-ocamltags BINDIR=$RPM_BUILD_ROOT%{_bindir} +) +( + mkdir -p $RPM_BUILD_ROOT%{_infodir}; + cd infoman; cp ocaml*.gz $RPM_BUILD_ROOT%{_infodir} +) + +%clean +rm -rf $RPM_BUILD_ROOT + +%post +/sbin/install-info \ + --entry "* ocaml: (ocaml). The Objective Caml compiler and programming environment" \ + --section "Programming Languages" \ + %{_infodir}/%{name}.info \ + %{_infodir}/dir 2>/dev/null || : + +%preun +if [ $1 = 0 ]; then + /sbin/install-info --delete %{_infodir}/%{name}.info %{_infodir}/dir 2>/dev/null || : +fi + +%files +%defattr(-,root,root,-) +%{_bindir}/* +%{_mandir}/man1/* +%{_mandir}/man3/* +%{_libdir}/ocaml +%{_infodir}/* +%exclude %{_bindir}/camlp4* +%exclude %{_bindir}/mkcamlp4 +%exclude %{_bindir}/ocpp +%exclude %{_bindir}/labltk +%exclude %{_bindir}/ocamltags +%exclude %{_bindir}/ocamlbrowser +%exclude %{_bindir}/ocamldoc* +%exclude %{_libdir}/ocaml/camlp4 +%exclude %{_libdir}/ocaml/labltk +%exclude %{_libdir}/ocaml/ocamldoc +%exclude %{_mandir}/man1/camlp4* +%exclude %{_mandir}/man1/mkcamlp4* +%exclude %{_libdir}/ocaml/stublibs/dlllabltk.so +%exclude %{_libdir}/ocaml/stublibs/dlltkanim.so +%doc README LICENSE Changes + +%files -n labltk +%defattr(-,root,root,-) +%{_bindir}/labltk +%{_bindir}/ocamlbrowser +%{_libdir}/ocaml/labltk +%{_libdir}/ocaml/stublibs/dlllabltk.so +%{_libdir}/ocaml/stublibs/dlltkanim.so +%doc otherlibs/labltk/examples_labltk +%doc otherlibs/labltk/examples_camltk + +%files -n camlp4 +%defattr(-,root,root,-) +%{_bindir}/camlp4* +%{_bindir}/mkcamlp4 +%{_bindir}/ocpp +%{_libdir}/ocaml/camlp4 +%{_mandir}/man1/camlp4* +%{_mandir}/man1/mkcamlp4* + +%files ocamldoc +%defattr(-,root,root,-) +%{_bindir}/ocamldoc* +%{_libdir}/ocaml/ocamldoc +%doc ocamldoc/Changes.txt + +%files docs +%defattr(-,root,root,-) +%doc refman.ps.gz htmlman + +%files emacs +%defattr(-,root,root,-) +%{_datadir}/emacs/site-lisp/* +%{_bindir}/ocamltags +%doc emacs/README + +%changelog +* Tue Dec 2 2003 Gerard Milmeister - 0:3.07-0.fdr.5 +- ocamldoc -> ocaml-ocamldoc +- ocaml-doc -> ocaml-docs + +* Fri Nov 28 2003 Gerard Milmeister - 0:3.07-0.fdr.4 +- Make separate packages for labltk, camlp4, ocamldoc, emacs and documentation + +* Thu Nov 27 2003 Gerard Milmeister - 0:3.07-0.fdr.2 +- Changed license tag +- Register info files +- Honor RPM_OPT_FLAGS +- New Patch + +* Fri Oct 31 2003 Gerard Milmeister - 0:3.07-0.fdr.1 +- First Fedora release + +* Mon Oct 13 2003 Axel Thimm +- Updated to 3.07. + +* Wed Apr 9 2003 Axel Thimm +- Rebuilt for Red Hat 9. + +* Tue Nov 26 2002 Axel Thimm +- Added %{_mandir}/mano/* entry diff --git a/sources b/sources index e69de29..4f633c8 100644 --- a/sources +++ b/sources @@ -0,0 +1,4 @@ +0b823da30bdc8b3f27b348d078ead2b1 ocaml-3.07-refman.html.tar.gz +541fd4dffbb43f2c89c6ce61e03f7bca ocaml-3.07-refman.info.tar.gz +76b0518b055c2af0ccd02564cb8272ca ocaml-3.07-refman.ps.gz +2dd038055f5e1350078ad81270411b78 ocaml-3.07.tar.gz