1 This patch (against OCaml 3.07) fixes the following issues:
3 - Camlp4: parsing of labeled function arguments.
4 - Emacs interface: portability issues between versions of GnuEmacs and XEmacs.
5 - Incorrect code generated for certain recursive module definitions.
6 - Name pollution issue on Mac OS X 10.3.
8 How to apply this patch:
10 * Go to the ocaml-3.07 source directory.
14 * If you already applied the earlier patch ocaml-3.07-patch1.diffs,
15 un-apply it first by running patch -p1 -R < /path/to/ocaml-3.07-patch1.diffs
17 * Run patch -p1 < /path/to/ocaml-3.07-patch2.diffs (this patch)
19 * Compile and install as usual (see file INSTALL).
23 Index: csl/bytecomp/translmod.ml
24 diff -u csl/bytecomp/translmod.ml:1.44 csl/bytecomp/translmod.ml:1.45
25 --- csl/bytecomp/translmod.ml:1.44 Mon Jul 7 15:42:49 2003
26 +++ csl/bytecomp/translmod.ml Fri Oct 3 16:36:00 2003
28 transl_module Tcoerce_none (field_path rootpath id) modl,
29 transl_structure (id :: fields) cc rootpath rem)
30 | Tstr_recmodule bindings :: rem ->
31 + let ext_fields = List.rev_append (List.map fst bindings) fields in
34 transl_module Tcoerce_none (field_path rootpath id) modl)
36 - (transl_structure (map_end fst bindings fields) cc rootpath rem)
37 + (transl_structure ext_fields cc rootpath rem)
38 | Tstr_modtype(id, decl) :: rem ->
39 transl_structure fields cc rootpath rem
40 | Tstr_open path :: rem ->
41 Index: csl/camlp4/camlp4/ast2pt.ml
42 diff -u csl/camlp4/camlp4/ast2pt.ml:1.25 csl/camlp4/camlp4/ast2pt.ml:1.26
43 --- csl/camlp4/camlp4/ast2pt.ml:1.25 Wed Jul 16 20:59:12 2003
44 +++ csl/camlp4/camlp4/ast2pt.ml Tue Sep 30 16:39:26 2003
46 | TyObj loc fl v -> mktyp loc (Ptyp_object (meth_list loc fl v))
48 mktyp loc (Ptyp_class (long_id_of_string_list loc id) [] [])
49 - | TyLab loc _ _ -> error loc "labeled type not allowed here"
50 + | TyLab loc _ _ -> error loc "labelled type not allowed here"
51 | TyLid loc s -> mktyp loc (Ptyp_constr (lident s) [])
52 - | TyMan loc _ _ -> error loc "type manifest not allowed here"
53 - | TyOlb loc lab _ -> error loc "labeled type not allowed here"
54 + | TyMan loc _ _ -> error loc "manifest type not allowed here"
55 + | TyOlb loc lab _ -> error loc "labelled type not allowed here"
56 | TyPol loc pl t -> mktyp loc (Ptyp_poly pl (ctyp t))
57 | TyQuo loc s -> mktyp loc (Ptyp_var s)
58 | TyRec loc _ _ -> error loc "record type not allowed here"
59 Index: csl/camlp4/etc/pa_o.ml
60 diff -u csl/camlp4/etc/pa_o.ml:1.52 csl/camlp4/etc/pa_o.ml:1.54
61 --- csl/camlp4/etc/pa_o.ml:1.52 Thu Sep 25 14:05:05 2003
62 +++ csl/camlp4/etc/pa_o.ml Tue Sep 30 16:39:38 2003
63 @@ -1148,16 +1148,16 @@
64 | i = LIDENT -> [i] ] ]
71 [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
72 - <:ctyp< ~ $i$ : $t1$ -> $t2$ >>
73 + <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >>
74 | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
75 - <:ctyp< ? $i$ : $t1$ -> $t2$ >>
76 + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >>
77 | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
78 - <:ctyp< ? $i$ : $t1$ -> $t2$ >>
79 + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >>
80 | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF ->
81 - <:ctyp< ? $i$ : $t1$ -> $t2$ >> ] ]
82 + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ]
85 [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" ->
86 Index: csl/camlp4/meta/pa_r.ml
87 diff -u csl/camlp4/meta/pa_r.ml:1.53 csl/camlp4/meta/pa_r.ml:1.55
88 --- csl/camlp4/meta/pa_r.ml:1.53 Thu Sep 25 14:05:06 2003
89 +++ csl/camlp4/meta/pa_r.ml Thu Oct 2 14:33:43 2003
91 <:ctyp< ! $list:pl$ . $t$ >> ]
93 [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ]
95 + [ i = TILDEIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
96 + | i = LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
97 + | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >>
98 + | i = OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ]
100 [ t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >> ]
104 [ [ m = UIDENT; "."; l = SELF -> [m :: l]
105 | i = LIDENT -> [i] ] ]
108 - ctyp: AFTER "arrow"
110 - [ i = TILDEIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
111 - | i = LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
112 - | i = QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >>
113 - | i = OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ] ]
116 [ [ "["; "="; rfl = row_field_list; "]" ->
117 Index: csl/camlp4/meta/q_MLast.ml
118 diff -u csl/camlp4/meta/q_MLast.ml:1.51 csl/camlp4/meta/q_MLast.ml:1.53
119 --- csl/camlp4/meta/q_MLast.ml:1.51 Wed Jul 16 14:50:08 2003
120 +++ csl/camlp4/meta/q_MLast.ml Thu Oct 2 14:33:43 2003
122 value a_STRING = Grammar.Entry.create gram "a_STRING";
123 value a_CHAR = Grammar.Entry.create gram "a_CHAR";
124 value a_TILDEIDENT = Grammar.Entry.create gram "a_TILDEIDENT";
125 +value a_LABEL = Grammar.Entry.create gram "a_LABEL";
126 value a_QUESTIONIDENT = Grammar.Entry.create gram "a_QUESTIONIDENT";
127 +value a_OPTLABEL = Grammar.Entry.create gram "a_OPTLABEL";
132 Qast.Node "TyPol" [Qast.Loc; pl; t] ]
134 [ t1 = SELF; "->"; t2 = SELF -> Qast.Node "TyArr" [Qast.Loc; t1; t2] ]
136 + [ i = a_TILDEIDENT; ":"; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]
137 + | i = a_LABEL; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]
138 + | i = a_QUESTIONIDENT; ":"; t = SELF ->
139 + Qast.Node "TyOlb" [Qast.Loc; i; t]
140 + | i = a_OPTLABEL; t = SELF ->
141 + Qast.Node "TyOlb" [Qast.Loc; i; t] ]
143 [ t1 = SELF; t2 = SELF -> Qast.Node "TyApp" [Qast.Loc; t1; t2] ]
145 @@ -1006,13 +1015,6 @@
146 [ [ m = a_UIDENT; "."; l = SELF -> Qast.Cons m l
147 | i = a_LIDENT -> Qast.List [i] ] ]
150 - ctyp: AFTER "arrow"
152 - [ i = a_TILDEIDENT; ":"; t = SELF -> Qast.Node "TyLab" [Qast.Loc; i; t]
153 - | i = a_QUESTIONIDENT; ":"; t = SELF ->
154 - Qast.Node "TyOlb" [Qast.Loc; i; t] ] ]
157 [ [ "["; "="; rfl = row_field_list; "]" ->
158 Qast.Node "TyVrn" [Qast.Loc; rfl; Qast.Option None]
159 @@ -1044,11 +1046,16 @@
160 | "#"; sl = mod_ident -> Qast.Node "PaTyp" [Qast.Loc; sl]
161 | i = a_TILDEIDENT; ":"; p = SELF ->
162 Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
163 + | i = a_LABEL; p = SELF ->
164 + Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
165 | i = a_TILDEIDENT -> Qast.Node "PaLab" [Qast.Loc; i; Qast.Option None]
166 | i = a_QUESTIONIDENT; ":"; "("; p = patt_tcon; eo = SOPT eq_expr;
169 [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
170 + | i = a_OPTLABEL; "("; p = patt_tcon; eo = SOPT eq_expr; ")" ->
172 + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
173 | i = a_QUESTIONIDENT ->
174 Qast.Node "PaOlb" [Qast.Loc; i; Qast.Option None]
175 | "?"; "("; p = patt_tcon; eo = SOPT eq_expr; ")" ->
176 @@ -1063,11 +1070,16 @@
178 [ [ i = a_TILDEIDENT; ":"; p = SELF ->
179 Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
180 + | i = a_LABEL; p = SELF ->
181 + Qast.Node "PaLab" [Qast.Loc; i; Qast.Option (Some p)]
182 | i = a_TILDEIDENT -> Qast.Node "PaLab" [Qast.Loc; i; Qast.Option None]
183 | i = a_QUESTIONIDENT; ":"; "("; p = ipatt_tcon; eo = SOPT eq_expr;
186 [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
187 + | i = a_OPTLABEL; "("; p = ipatt_tcon; eo = SOPT eq_expr; ")" ->
189 + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]
190 | i = a_QUESTIONIDENT ->
191 Qast.Node "PaOlb" [Qast.Loc; i; Qast.Option None]
192 | "?"; "("; p = ipatt_tcon; eo = SOPT eq_expr; ")" ->
193 @@ -1086,9 +1098,13 @@
195 [ i = a_TILDEIDENT; ":"; e = SELF ->
196 Qast.Node "ExLab" [Qast.Loc; i; Qast.Option (Some e)]
197 + | i = a_LABEL; e = SELF ->
198 + Qast.Node "ExLab" [Qast.Loc; i; Qast.Option (Some e)]
199 | i = a_TILDEIDENT -> Qast.Node "ExLab" [Qast.Loc; i; Qast.Option None]
200 | i = a_QUESTIONIDENT; ":"; e = SELF ->
201 Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option (Some e)]
202 + | i = a_OPTLABEL; e = SELF ->
203 + Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option (Some e)]
204 | i = a_QUESTIONIDENT ->
205 Qast.Node "ExOlb" [Qast.Loc; i; Qast.Option None] ] ]
207 @@ -1335,9 +1351,15 @@
208 [ [ "~"; a = ANTIQUOT -> antiquot "" loc a
209 | s = TILDEIDENT -> Qast.Str s ] ]
212 + [ [ s = LABEL -> Qast.Str s ] ]
215 [ [ "?"; a = ANTIQUOT -> antiquot "" loc a
216 | s = QUESTIONIDENT -> Qast.Str s ] ]
219 + [ [ s = OPTLABEL -> Qast.Str s ] ]
223 Index: csl/camlp4/ocaml_src/camlp4/ast2pt.ml
224 diff -u csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.24 csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.25
225 --- csl/camlp4/ocaml_src/camlp4/ast2pt.ml:1.24 Thu Jul 24 00:26:18 2003
226 +++ csl/camlp4/ocaml_src/camlp4/ast2pt.ml Tue Sep 30 16:39:38 2003
227 @@ -169,10 +169,10 @@
228 | TyObj (loc, fl, v) -> mktyp loc (Ptyp_object (meth_list loc fl v))
230 mktyp loc (Ptyp_class (long_id_of_string_list loc id, [], []))
231 - | TyLab (loc, _, _) -> error loc "labeled type not allowed here"
232 + | TyLab (loc, _, _) -> error loc "labelled type not allowed here"
233 | TyLid (loc, s) -> mktyp loc (Ptyp_constr (lident s, []))
234 - | TyMan (loc, _, _) -> error loc "type manifest not allowed here"
235 - | TyOlb (loc, lab, _) -> error loc "labeled type not allowed here"
236 + | TyMan (loc, _, _) -> error loc "manifest type not allowed here"
237 + | TyOlb (loc, lab, _) -> error loc "labelled type not allowed here"
238 | TyPol (loc, pl, t) -> mktyp loc (Ptyp_poly (pl, ctyp t))
239 | TyQuo (loc, s) -> mktyp loc (Ptyp_var s)
240 | TyRec (loc, _, _) -> error loc "record type not allowed here"
241 Index: csl/camlp4/ocaml_src/meta/pa_r.ml
242 diff -u csl/camlp4/ocaml_src/meta/pa_r.ml:1.48 csl/camlp4/ocaml_src/meta/pa_r.ml:1.50
243 --- csl/camlp4/ocaml_src/meta/pa_r.ml:1.48 Thu Sep 25 14:05:07 2003
244 +++ csl/camlp4/ocaml_src/meta/pa_r.ml Thu Oct 2 14:33:44 2003
245 @@ -1540,6 +1540,25 @@
247 (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
248 (MLast.TyArr (loc, t1, t2) : 'ctyp))];
249 + Some "label", Some Gramext.NonA,
250 + [[Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],
252 + (fun (t : 'ctyp) (i : string) (loc : int * int) ->
253 + (MLast.TyOlb (loc, i, t) : 'ctyp));
254 + [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
257 + (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
258 + (MLast.TyOlb (loc, i, t) : 'ctyp));
259 + [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
261 + (fun (t : 'ctyp) (i : string) (loc : int * int) ->
262 + (MLast.TyLab (loc, i, t) : 'ctyp));
263 + [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
266 + (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
267 + (MLast.TyLab (loc, i, t) : 'ctyp))];
268 None, Some Gramext.LeftA,
269 [[Gramext.Sself; Gramext.Sself],
271 @@ -2240,27 +2259,6 @@
273 (fun (l : 'class_longident) _ (m : string) (loc : int * int) ->
274 (m :: l : 'class_longident))]];
275 - Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
276 - Some (Gramext.After "arrow"),
277 - [None, Some Gramext.NonA,
278 - [[Gramext.Stoken ("OPTLABEL", ""); Gramext.Sself],
280 - (fun (t : 'ctyp) (i : string) (loc : int * int) ->
281 - (MLast.TyOlb (loc, i, t) : 'ctyp));
282 - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":");
285 - (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
286 - (MLast.TyOlb (loc, i, t) : 'ctyp));
287 - [Gramext.Stoken ("LABEL", ""); Gramext.Sself],
289 - (fun (t : 'ctyp) (i : string) (loc : int * int) ->
290 - (MLast.TyLab (loc, i, t) : 'ctyp));
291 - [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":");
294 - (fun (t : 'ctyp) _ (i : string) (loc : int * int) ->
295 - (MLast.TyLab (loc, i, t) : 'ctyp))]];
296 Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
297 Some (Gramext.Level "simple"),
299 Index: csl/camlp4/ocaml_src/meta/q_MLast.ml
300 diff -u csl/camlp4/ocaml_src/meta/q_MLast.ml:1.56 csl/camlp4/ocaml_src/meta/q_MLast.ml:1.58
301 --- csl/camlp4/ocaml_src/meta/q_MLast.ml:1.56 Thu Jul 24 00:26:19 2003
302 +++ csl/camlp4/ocaml_src/meta/q_MLast.ml Thu Oct 2 14:33:44 2003
304 let a_STRING = Grammar.Entry.create gram "a_STRING";;
305 let a_CHAR = Grammar.Entry.create gram "a_CHAR";;
306 let a_TILDEIDENT = Grammar.Entry.create gram "a_TILDEIDENT";;
307 +let a_LABEL = Grammar.Entry.create gram "a_LABEL";;
308 let a_QUESTIONIDENT = Grammar.Entry.create gram "a_QUESTIONIDENT";;
309 +let a_OPTLABEL = Grammar.Entry.create gram "a_OPTLABEL";;
314 Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3
317 - _ -> raise (Match_failure ("q_MLast.ml", 300, 19))
318 + _ -> raise (Match_failure ("q_MLast.ml", 302, 19))
320 Qast.Node ("StExc", [Qast.Loc; c; tl; b]) :
323 Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3
326 - _ -> raise (Match_failure ("q_MLast.ml", 358, 19))
327 + _ -> raise (Match_failure ("q_MLast.ml", 360, 19))
329 Qast.Node ("SgExc", [Qast.Loc; c; tl]) :
331 @@ -2254,6 +2256,32 @@
333 (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) ->
334 (Qast.Node ("TyArr", [Qast.Loc; t1; t2]) : 'ctyp))];
335 + Some "label", Some Gramext.NonA,
337 + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
340 + (fun (t : 'ctyp) (i : 'a_OPTLABEL) (loc : int * int) ->
341 + (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
344 + (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
345 + Gramext.Stoken ("", ":"); Gramext.Sself],
347 + (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->
348 + (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
350 + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
353 + (fun (t : 'ctyp) (i : 'a_LABEL) (loc : int * int) ->
354 + (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp));
356 + (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
357 + Gramext.Stoken ("", ":"); Gramext.Sself],
359 + (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
360 + (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp))];
361 None, Some Gramext.LeftA,
362 [[Gramext.Sself; Gramext.Sself],
364 @@ -3345,22 +3373,6 @@
365 (fun (l : 'class_longident) _ (m : 'a_UIDENT) (loc : int * int) ->
366 (Qast.Cons (m, l) : 'class_longident))]];
367 Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
368 - Some (Gramext.After "arrow"),
369 - [None, Some Gramext.NonA,
372 - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
373 - Gramext.Stoken ("", ":"); Gramext.Sself],
375 - (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) ->
376 - (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp));
378 - (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
379 - Gramext.Stoken ("", ":"); Gramext.Sself],
381 - (fun (t : 'ctyp) _ (i : 'a_TILDEIDENT) (loc : int * int) ->
382 - (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp))]];
383 - Grammar.Entry.obj (ctyp : 'ctyp Grammar.Entry.e),
384 Some (Gramext.Level "simple"),
386 [[Gramext.Stoken ("", "["); Gramext.Stoken ("", "<");
387 @@ -3518,6 +3530,30 @@
388 (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
389 (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'patt));
391 + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
392 + Gramext.Stoken ("", "(");
394 + (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e));
398 + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
400 + (fun (a : 'eq_expr option) (loc : int * int) ->
401 + (Qast.Option a : 'a_opt));
403 + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
405 + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
406 + Gramext.Stoken ("", ")")],
408 + (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ (i : 'a_OPTLABEL)
409 + (loc : int * int) ->
412 + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
416 (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
417 Gramext.Stoken ("", ":"); Gramext.Stoken ("", "(");
418 @@ -3548,6 +3584,13 @@
419 (fun (i : 'a_TILDEIDENT) (loc : int * int) ->
420 (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'patt));
422 + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
425 + (fun (p : 'patt) (i : 'a_LABEL) (loc : int * int) ->
426 + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
429 (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
430 Gramext.Stoken ("", ":"); Gramext.Sself],
432 @@ -3606,6 +3649,30 @@
433 (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
434 (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'ipatt));
436 + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
437 + Gramext.Stoken ("", "(");
439 + (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e));
443 + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))],
445 + (fun (a : 'eq_expr option) (loc : int * int) ->
446 + (Qast.Option a : 'a_opt));
448 + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))],
450 + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))];
451 + Gramext.Stoken ("", ")")],
453 + (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ (i : 'a_OPTLABEL)
454 + (loc : int * int) ->
457 + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) :
461 (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
462 Gramext.Stoken ("", ":"); Gramext.Stoken ("", "(");
463 @@ -3636,6 +3703,13 @@
464 (fun (i : 'a_TILDEIDENT) (loc : int * int) ->
465 (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option None]) : 'ipatt));
467 + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
470 + (fun (p : 'ipatt) (i : 'a_LABEL) (loc : int * int) ->
471 + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) :
474 (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
475 Gramext.Stoken ("", ":"); Gramext.Sself],
477 @@ -3669,6 +3743,13 @@
478 (fun (i : 'a_QUESTIONIDENT) (loc : int * int) ->
479 (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option None]) : 'expr));
481 + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e));
484 + (fun (e : 'expr) (i : 'a_OPTLABEL) (loc : int * int) ->
485 + (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option (Some e)]) :
489 (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e));
490 Gramext.Stoken ("", ":"); Gramext.Sself],
491 @@ -3682,6 +3763,13 @@
492 (fun (i : 'a_TILDEIDENT) (loc : int * int) ->
493 (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option None]) : 'expr));
495 + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e));
498 + (fun (e : 'expr) (i : 'a_LABEL) (loc : int * int) ->
499 + (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option (Some e)]) :
502 (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e));
503 Gramext.Stoken ("", ":"); Gramext.Sself],
505 @@ -4427,6 +4515,11 @@
507 (fun (a : string) _ (loc : int * int) ->
508 (antiquot "" loc a : 'a_TILDEIDENT))]];
509 + Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e), None,
511 + [[Gramext.Stoken ("LABEL", "")],
513 + (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_LABEL))]];
514 Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e),
517 @@ -4437,7 +4530,12 @@
518 [Gramext.Stoken ("", "?"); Gramext.Stoken ("ANTIQUOT", "")],
520 (fun (a : string) _ (loc : int * int) ->
521 - (antiquot "" loc a : 'a_QUESTIONIDENT))]]];;
522 + (antiquot "" loc a : 'a_QUESTIONIDENT))]];
523 + Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e), None,
525 + [[Gramext.Stoken ("OPTLABEL", "")],
527 + (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_OPTLABEL))]]];;
530 let f s = Grammar.Entry.parse e (Stream.of_string s) in
531 Index: csl/emacs/Makefile
532 diff -u csl/emacs/Makefile:1.15 csl/emacs/Makefile:1.16
533 --- csl/emacs/Makefile:1.15 Fri Aug 29 17:38:28 2003
534 +++ csl/emacs/Makefile Fri Oct 10 15:25:38 2003
536 (byte-compile-file "caml.el") \
537 (byte-compile-file "inf-caml.el") \
538 (byte-compile-file "caml-help.el") \
539 + (byte-compile-file "caml-types.el") \
540 (byte-compile-file "camldebug.el"))
543 Index: csl/emacs/caml-emacs.el
544 diff -u csl/emacs/caml-emacs.el:1.4 csl/emacs/caml-emacs.el:1.5
545 --- csl/emacs/caml-emacs.el:1.4 Mon Aug 25 17:01:20 2003
546 +++ csl/emacs/caml-emacs.el Fri Oct 10 15:25:38 2003
548 (defun caml-event-window (e) (posn-window (event-start e)))
549 (defun caml-event-point-start (e) (posn-point (event-start e)))
550 (defun caml-event-point-end (e) (posn-point (event-end e)))
551 -(defalias 'caml-track-mouse 'track-mouse)
552 (defalias 'caml-read-event 'read-event)
553 +(defmacro caml-track-mouse (&rest body) (cons 'track-mouse body))
555 (provide 'caml-emacs)
556 Index: csl/emacs/caml-types.el
557 diff -u csl/emacs/caml-types.el:1.24 csl/emacs/caml-types.el:1.26
558 --- csl/emacs/caml-types.el:1.24 Fri Sep 5 20:01:46 2003
559 +++ csl/emacs/caml-types.el Sat Oct 11 02:00:14 2003
561 (require 'caml-xemacs)
562 (require 'caml-emacs)))
566 (defvar caml-types-location-re nil "Regexp to parse *.annot files.
568 Annotation files *.annot may be generated with the \"-dtypes\" option
570 (target-file (file-name-nondirectory (buffer-file-name)))
571 (target-date (nth 5 (file-attributes target-file))))
572 (unless (and caml-types-annotation-tree
574 + caml-types-annotation-date
575 (not (caml-types-date< caml-types-annotation-date type-date)))
576 - (if (caml-types-date< type-date target-date)
577 + (if (and type-date target-date (caml-types-date< type-date target-date))
578 (error (format "%s is more recent than %s" target-file type-file)))
579 (message "Reading annotation file...")
580 (let* ((type-buf (caml-types-find-file type-file))
581 @@ -376,10 +380,13 @@
582 (with-current-buffer buf (toggle-read-only 1))
585 - (error "No annotation file. You may compile with \"-dtypes\" option"))
586 + (error "No annotation file. You should compile with option \"-dtypes\"."))
590 +(defun caml-types-mouse-ignore (event)
594 (defun caml-types-explore (event)
595 "Explore type annotations by mouse dragging.
596 @@ -395,58 +402,79 @@
597 (target-line) (target-bol)
599 Left Right limits cnum node mes type
600 - (tree caml-types-annotation-tree)
604 - (caml-types-preprocess type-file)
605 - (unless caml-types-buffer
606 - (setq caml-types-buffer (get-buffer-create caml-types-buffer-name)))
607 - ;; (message "Drag the mouse to explore types")
611 - (caml-types-typed-make-overlay target-buf
612 - (caml-event-point-start event)))
614 - (integer-or-marker-p
615 - (setq cnum (caml-event-point-end event))))
616 - (if (and region (<= (car region) cnum) (<= cnum (cdr region)))
617 - (if (and limits (>= cnum (car limits)) (< cnum (cdr limits)))
620 - (save-excursion (goto-char cnum)
621 - (caml-line-beginning-position)))
623 - (1+ (count-lines (point-min) target-bol)))
624 - (setq target-pos (vector target-file target-line target-bol cnum))
626 - (setq node (caml-types-find-location target-pos () tree))
627 - (set-buffer caml-types-buffer)
631 - (setq Left (caml-types-get-pos target-buf (elt node 0)))
632 - (setq Right (caml-types-get-pos target-buf (elt node 1)))
633 - (move-overlay caml-types-expr-ovl Left Right target-buf)
634 - (setq limits (caml-types-find-interval target-buf target-pos
636 - (setq type (elt node 2))
639 - (delete-overlay caml-types-expr-ovl)
640 - (setq type "*no type information*")
641 - (setq limits (caml-types-find-interval target-buf target-pos
644 - (message (setq mes (format "type: %s" type)))
647 - (setq event (caml-read-event))
648 - (unless (mouse-movement-p event) (setq event nil))
651 - (delete-overlay caml-types-expr-ovl)
652 - (delete-overlay caml-types-typed-ovl)
654 + (caml-types-preprocess type-file)
655 + (setq target-tree caml-types-annotation-tree)
656 + (unless caml-types-buffer
657 + (setq caml-types-buffer
658 + (get-buffer-create caml-types-buffer-name)))
659 + ;; (message "Drag the mouse to explore types")
663 + (caml-types-typed-make-overlay
664 + target-buf (caml-event-point-start event)))
666 + (integer-or-marker-p
667 + (setq cnum (caml-event-point-end event))))
668 + (if (and region (<= (car region) cnum) (< cnum (cdr region)))
670 + (>= cnum (car limits)) (< cnum (cdr limits)))
674 + (goto-char cnum) (caml-line-beginning-position))
675 + target-line (1+ (count-lines (point-min)
678 + (vector target-file target-line target-bol cnum))
680 + (setq node (caml-types-find-location
681 + target-pos () target-tree))
682 + (set-buffer caml-types-buffer)
687 + (caml-types-get-pos target-buf (elt node 0))
689 + (caml-types-get-pos target-buf (elt node 1)))
691 + caml-types-expr-ovl Left Right target-buf)
693 + (caml-types-find-interval target-buf
698 + (delete-overlay caml-types-expr-ovl)
699 + (setq type "*no type information*")
701 + (caml-types-find-interval
702 + target-buf target-pos target-tree))
704 + (message (setq mes (format "type: %s" type)))
707 + (setq event (caml-read-event))
708 + (unless (mouse-movement-p event) (setq event nil))
711 + (delete-overlay caml-types-expr-ovl)
712 + (delete-overlay caml-types-typed-ovl)
714 + ;; the mouse is down. One should prevent against mouse release,
715 + ;; which could do something undesirable.
716 + ;; In most common cases, next event will be mouse release.
717 + ;; However, it could also be a key stroke before mouse release.
718 + ;; Will then execute the action for mouse release (if bound).
719 + ;; Emacs does not allow to test whether mouse is up or down.
720 + ;; Same problem may happen above while exploring
721 + (if (and event (caml-read-event)))
724 (defun caml-types-typed-make-overlay (target-buf pos)
726 (if (and (equal target-buf (current-buffer))
727 (setq left (caml-types-get-pos target-buf (elt node 0))
728 right (caml-types-get-pos target-buf (elt node 1)))
729 - (<= left pos) (>= right pos)
730 + (<= left pos) (> right pos)
732 (setq start (min start left)
734 Index: csl/emacs/caml-xemacs.el
735 diff -u csl/emacs/caml-xemacs.el:1.3 csl/emacs/caml-xemacs.el:1.4
736 --- csl/emacs/caml-xemacs.el:1.3 Tue Jul 29 09:30:03 2003
737 +++ csl/emacs/caml-xemacs.el Fri Oct 10 15:25:38 2003
739 (defun caml-event-window (e) (event-window e))
740 (defun caml-event-point-start (e) (event-closest-point e))
741 (defun caml-event-point-end (e) (event-closest-point e))
742 -(defalias 'caml-track-mouse 'progn)
743 (defalias 'caml-read-event 'next-event)
744 +(defmacro caml-track-mouse (&rest body) (cons 'progn body))
746 (defun mouse-movement-p (e) (equal (event-type e) 'motion))
748 (provide 'caml-xemacs)
749 Index: csl/emacs/caml.el
750 diff -u csl/emacs/caml.el:1.34 csl/emacs/caml.el:1.35
751 --- csl/emacs/caml.el:1.34 Mon Jul 28 20:06:49 2003
752 +++ csl/emacs/caml.el Fri Oct 10 15:25:38 2003
756 (define-key caml-mode-map [?\C-c?\C-t] 'caml-types-show-type)
757 + ;; to prevent misbehavior in case of error during exploration.
758 + (define-key caml-mode-map [mouse-2] 'caml-types-mouse-ignore)
759 (define-key caml-mode-map [down-mouse-2] 'caml-types-explore)
761 (define-key caml-mode-map [?\C-c?i] 'ocaml-add-path)
762 Index: csl/otherlibs/threads/scheduler.c
763 diff -u csl/otherlibs/threads/scheduler.c:1.56 csl/otherlibs/threads/scheduler.c:1.57
764 --- csl/otherlibs/threads/scheduler.c:1.56 Thu Mar 20 17:23:03 2003
765 +++ csl/otherlibs/threads/scheduler.c Fri Oct 10 15:13:21 2003
768 /* The thread descriptors */
770 -struct thread_struct {
771 +struct caml_thread_struct {
772 value ident; /* Unique id (for equality comparisons) */
773 - struct thread_struct * next; /* Double linking of threads */
774 - struct thread_struct * prev;
775 + struct caml_thread_struct * next; /* Double linking of threads */
776 + struct caml_thread_struct * prev;
777 value * stack_low; /* The execution stack for this thread */
779 value * stack_threshold;
781 value retval; /* Value to return when thread resumes */
784 -typedef struct thread_struct * thread_t;
785 +typedef struct caml_thread_struct * caml_thread_t;
787 #define RUNNABLE Val_int(0)
788 #define KILLED Val_int(1)
790 #define DELAY_INFTY 1E30 /* +infty, for this purpose */
792 /* The thread currently active */
793 -static thread_t curr_thread = NULL;
794 +static caml_thread_t curr_thread = NULL;
795 /* Identifier for next thread creation */
796 static value next_ident = Val_int(0);
800 static void thread_scan_roots(scanning_action action)
802 - thread_t th, start;
803 + caml_thread_t th, start;
805 /* Scan all active descriptors */
808 if (curr_thread != NULL) return Val_unit;
809 /* Create a descriptor for the current thread */
811 - (thread_t) alloc_shr(sizeof(struct thread_struct) / sizeof(value), 0);
812 + (caml_thread_t) alloc_shr(sizeof(struct caml_thread_struct)
813 + / sizeof(value), 0);
814 curr_thread->ident = next_ident;
815 next_ident = Val_int(Int_val(next_ident) + 1);
816 curr_thread->next = curr_thread;
817 @@ -218,10 +219,11 @@
819 value thread_new(value clos) /* ML */
823 /* Allocate the thread and its stack */
825 - th = (thread_t) alloc_shr(sizeof(struct thread_struct) / sizeof(value), 0);
826 + th = (caml_thread_t) alloc_shr(sizeof(struct caml_thread_struct)
827 + / sizeof(value), 0);
829 th->ident = next_ident;
830 next_ident = Val_int(Int_val(next_ident) + 1);
833 value thread_id(value th) /* ML */
835 - return ((struct thread_struct *)th)->ident;
836 + return ((caml_thread_t)th)->ident;
839 /* Return the current time as a floating-point number */
842 static value schedule_thread(void)
844 - thread_t run_thread, th;
845 + caml_thread_t run_thread, th;
846 fd_set readfds, writefds, exceptfds;
848 int need_select, need_wait;
852 if (th->status & (BLOCKED_JOIN - 1)) {
853 - if (((thread_t)(th->joining))->status == KILLED) {
854 + if (((caml_thread_t)(th->joining))->status == KILLED) {
855 th->status = RUNNABLE;
856 Assign(th->retval, RESUMED_JOIN);
861 Assert(curr_thread != NULL);
862 - if (((thread_t)th)->status == KILLED) return Val_unit;
863 + if (((caml_thread_t)th)->status == KILLED) return Val_unit;
864 curr_thread->status = BLOCKED_JOIN;
865 Assign(curr_thread->joining, th);
866 return schedule_thread();
869 value thread_wakeup(value thread) /* ML */
871 - thread_t th = (thread_t) thread;
872 + caml_thread_t th = (caml_thread_t) thread;
873 switch (th->status) {
875 th->status = RUNNABLE;
877 value thread_kill(value thread) /* ML */
879 value retval = Val_unit;
880 - thread_t th = (thread_t) thread;
881 + caml_thread_t th = (caml_thread_t) thread;
882 if (th->status == KILLED) failwith("Thread.kill: killed thread");
883 /* Don't paint ourselves in a corner */
884 if (th == th->next) failwith("Thread.kill: cannot kill the last thread");
886 if (th == curr_thread) {
888 retval = schedule_thread();
889 - th = (thread_t) thread;
890 + th = (caml_thread_t) thread;
893 /* Remove thread from the doubly-linked list */
894 Index: csl/stdlib/buffer.mli
895 diff -u csl/stdlib/buffer.mli:1.16 csl/stdlib/buffer.mli:1.17
896 --- csl/stdlib/buffer.mli:1.16 Wed May 14 19:52:19 2003
897 +++ csl/stdlib/buffer.mli Wed Oct 8 15:12:44 2003
899 - a non empty sequence of alphanumeric or [_] characters,
900 - an arbitrary sequence of characters enclosed by a pair of
901 matching parentheses or curly brackets.
902 - An escaped [$] character is a [$] that immediately folows a backslash
903 + An escaped [$] character is a [$] that immediately follows a backslash
904 character; it then stands for a plain [$].
905 Raise [Not_found] if the closing character of a parenthesized variable
907 Index: csl/stdlib/pervasives.mli
908 diff -u csl/stdlib/pervasives.mli:1.93 csl/stdlib/pervasives.mli:1.94
909 --- csl/stdlib/pervasives.mli:1.93 Thu Sep 4 14:44:48 2003
910 +++ csl/stdlib/pervasives.mli Wed Oct 8 15:13:33 2003
913 external string_of_format :
914 ('a, 'b, 'c, 'd) format4 -> string = "%identity"
915 -(** Converts a format string into a string.*)
916 +(** Converts a format string into a string. *)
917 external format_of_string :
918 ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4 = "%identity"
919 (** [format_of_string s] returns a format string read from the string
920 Index: csl/stdlib/sys.ml
921 diff -u csl/stdlib/sys.ml:1.78 csl/stdlib/sys.ml:1.80
922 --- csl/stdlib/sys.ml:1.78 Fri Sep 12 09:46:23 2003
923 +++ csl/stdlib/sys.ml Mon Oct 13 09:39:46 2003
926 (* OCaml version string, must be in the format described in sys.mli. *)
928 -let ocaml_version = "3.07";;
929 +let ocaml_version = "3.07+2";;