]>
Commit | Line | Data |
---|---|---|
bcbd92c0 MM |
1 | This patch (against OCaml 3.07) fixes the following issues: |
2 | ||
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. | |
7 | ||
8 | How to apply this patch: | |
9 | ||
10 | * Go to the ocaml-3.07 source directory. | |
11 | ||
12 | * Do "make clean". | |
13 | ||
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 | |
16 | ||
17 | * Run patch -p1 < /path/to/ocaml-3.07-patch2.diffs (this patch) | |
18 | ||
19 | * Compile and install as usual (see file INSTALL). | |
20 | ||
21 | -------------- | |
22 | ||
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 | |
bcbd92c0 MM |
27 | @@ -310,11 +310,12 @@ |
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 | |
32 | compile_recmodule | |
33 | (fun id modl -> | |
34 | transl_module Tcoerce_none (field_path rootpath id) modl) | |
35 | bindings | |
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 | |
bcbd92c0 MM |
45 | @@ -177,10 +177,10 @@ |
46 | | TyObj loc fl v -> mktyp loc (Ptyp_object (meth_list loc fl v)) | |
47 | | TyCls loc id -> | |
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 | |
bcbd92c0 MM |
63 | @@ -1148,16 +1148,16 @@ |
64 | | i = LIDENT -> [i] ] ] | |
65 | ; | |
66 | (* Labels *) | |
67 | - ctyp: AFTER "arrow" | |
68 | - [ NONA | |
69 | + ctyp: LEVEL "arrow" | |
70 | + [ RIGHTA | |
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$ >> ] ] | |
83 | ; | |
84 | ctyp: LEVEL "simple" | |
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 | |
bcbd92c0 MM |
90 | @@ -542,6 +542,11 @@ |
91 | <:ctyp< ! $list:pl$ . $t$ >> ] | |
92 | | "arrow" RIGHTA | |
93 | [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] | |
94 | + | "label" NONA | |
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$ >> ] | |
99 | | LEFTA | |
100 | [ t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >> ] | |
101 | | LEFTA | |
102 | @@ -746,14 +751,6 @@ | |
103 | class_longident: | |
104 | [ [ m = UIDENT; "."; l = SELF -> [m :: l] | |
105 | | i = LIDENT -> [i] ] ] | |
106 | - ; | |
107 | - (* Labels *) | |
108 | - ctyp: AFTER "arrow" | |
109 | - [ NONA | |
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$ >> ] ] | |
114 | ; | |
115 | ctyp: LEVEL "simple" | |
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 | |
bcbd92c0 MM |
121 | @@ -127,7 +127,9 @@ |
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"; | |
128 | ||
129 | value o2b = | |
130 | fun | |
131 | @@ -793,6 +795,13 @@ | |
132 | Qast.Node "TyPol" [Qast.Loc; pl; t] ] | |
133 | | "arrow" RIGHTA | |
134 | [ t1 = SELF; "->"; t2 = SELF -> Qast.Node "TyArr" [Qast.Loc; t1; t2] ] | |
135 | + | "label" NONA | |
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] ] | |
142 | | LEFTA | |
143 | [ t1 = SELF; t2 = SELF -> Qast.Node "TyApp" [Qast.Loc; t1; t2] ] | |
144 | | LEFTA | |
145 | @@ -1006,13 +1015,6 @@ | |
146 | [ [ m = a_UIDENT; "."; l = SELF -> Qast.Cons m l | |
147 | | i = a_LIDENT -> Qast.List [i] ] ] | |
148 | ; | |
149 | - (* Labels *) | |
150 | - ctyp: AFTER "arrow" | |
151 | - [ NONA | |
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] ] ] | |
155 | - ; | |
156 | ctyp: LEVEL "simple" | |
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; | |
167 | ")" -> | |
168 | Qast.Node "PaOlb" | |
169 | [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))] | |
170 | + | i = a_OPTLABEL; "("; p = patt_tcon; eo = SOPT eq_expr; ")" -> | |
171 | + Qast.Node "PaOlb" | |
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 @@ | |
177 | ipatt: | |
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; | |
184 | ")" -> | |
185 | Qast.Node "PaOlb" | |
186 | [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))] | |
187 | + | i = a_OPTLABEL; "("; p = ipatt_tcon; eo = SOPT eq_expr; ")" -> | |
188 | + Qast.Node "PaOlb" | |
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 @@ | |
194 | [ "label" NONA | |
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] ] ] | |
206 | ; | |
207 | @@ -1335,9 +1351,15 @@ | |
208 | [ [ "~"; a = ANTIQUOT -> antiquot "" loc a | |
209 | | s = TILDEIDENT -> Qast.Str s ] ] | |
210 | ; | |
211 | + a_LABEL: | |
212 | + [ [ s = LABEL -> Qast.Str s ] ] | |
213 | + ; | |
214 | a_QUESTIONIDENT: | |
215 | [ [ "?"; a = ANTIQUOT -> antiquot "" loc a | |
216 | | s = QUESTIONIDENT -> Qast.Str s ] ] | |
217 | + ; | |
218 | + a_OPTLABEL: | |
219 | + [ [ s = OPTLABEL -> Qast.Str s ] ] | |
220 | ; | |
221 | END; | |
222 | ||
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)) | |
229 | | TyCls (loc, id) -> | |
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 @@ | |
246 | Gramext.action | |
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], | |
251 | + Gramext.action | |
252 | + (fun (t : 'ctyp) (i : string) (loc : int * int) -> | |
253 | + (MLast.TyOlb (loc, i, t) : 'ctyp)); | |
254 | + [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); | |
255 | + Gramext.Sself], | |
256 | + Gramext.action | |
257 | + (fun (t : 'ctyp) _ (i : string) (loc : int * int) -> | |
258 | + (MLast.TyOlb (loc, i, t) : 'ctyp)); | |
259 | + [Gramext.Stoken ("LABEL", ""); Gramext.Sself], | |
260 | + Gramext.action | |
261 | + (fun (t : 'ctyp) (i : string) (loc : int * int) -> | |
262 | + (MLast.TyLab (loc, i, t) : 'ctyp)); | |
263 | + [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":"); | |
264 | + Gramext.Sself], | |
265 | + Gramext.action | |
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], | |
270 | Gramext.action | |
271 | @@ -2240,27 +2259,6 @@ | |
272 | Gramext.action | |
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], | |
279 | - Gramext.action | |
280 | - (fun (t : 'ctyp) (i : string) (loc : int * int) -> | |
281 | - (MLast.TyOlb (loc, i, t) : 'ctyp)); | |
282 | - [Gramext.Stoken ("QUESTIONIDENT", ""); Gramext.Stoken ("", ":"); | |
283 | - Gramext.Sself], | |
284 | - Gramext.action | |
285 | - (fun (t : 'ctyp) _ (i : string) (loc : int * int) -> | |
286 | - (MLast.TyOlb (loc, i, t) : 'ctyp)); | |
287 | - [Gramext.Stoken ("LABEL", ""); Gramext.Sself], | |
288 | - Gramext.action | |
289 | - (fun (t : 'ctyp) (i : string) (loc : int * int) -> | |
290 | - (MLast.TyLab (loc, i, t) : 'ctyp)); | |
291 | - [Gramext.Stoken ("TILDEIDENT", ""); Gramext.Stoken ("", ":"); | |
292 | - Gramext.Sself], | |
293 | - Gramext.action | |
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"), | |
298 | [None, None, | |
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 | |
303 | @@ -153,7 +153,9 @@ | |
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";; | |
310 | ||
311 | let o2b = | |
312 | function | |
313 | @@ -626,7 +628,7 @@ | |
314 | Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3 | |
315 | | _ -> | |
316 | match () with | |
317 | - _ -> raise (Match_failure ("q_MLast.ml", 300, 19)) | |
318 | + _ -> raise (Match_failure ("q_MLast.ml", 302, 19)) | |
319 | in | |
320 | Qast.Node ("StExc", [Qast.Loc; c; tl; b]) : | |
321 | 'str_item)); | |
322 | @@ -896,7 +898,7 @@ | |
323 | Qast.Tuple [xx1; xx2; xx3] -> xx1, xx2, xx3 | |
324 | | _ -> | |
325 | match () with | |
326 | - _ -> raise (Match_failure ("q_MLast.ml", 358, 19)) | |
327 | + _ -> raise (Match_failure ("q_MLast.ml", 360, 19)) | |
328 | in | |
329 | Qast.Node ("SgExc", [Qast.Loc; c; tl]) : | |
330 | 'sig_item)); | |
331 | @@ -2254,6 +2256,32 @@ | |
332 | Gramext.action | |
333 | (fun (t2 : 'ctyp) _ (t1 : 'ctyp) (loc : int * int) -> | |
334 | (Qast.Node ("TyArr", [Qast.Loc; t1; t2]) : 'ctyp))]; | |
335 | + Some "label", Some Gramext.NonA, | |
336 | + [[Gramext.Snterm | |
337 | + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e)); | |
338 | + Gramext.Sself], | |
339 | + Gramext.action | |
340 | + (fun (t : 'ctyp) (i : 'a_OPTLABEL) (loc : int * int) -> | |
341 | + (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp)); | |
342 | + [Gramext.Snterm | |
343 | + (Grammar.Entry.obj | |
344 | + (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); | |
345 | + Gramext.Stoken ("", ":"); Gramext.Sself], | |
346 | + Gramext.action | |
347 | + (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) -> | |
348 | + (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp)); | |
349 | + [Gramext.Snterm | |
350 | + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e)); | |
351 | + Gramext.Sself], | |
352 | + Gramext.action | |
353 | + (fun (t : 'ctyp) (i : 'a_LABEL) (loc : int * int) -> | |
354 | + (Qast.Node ("TyLab", [Qast.Loc; i; t]) : 'ctyp)); | |
355 | + [Gramext.Snterm | |
356 | + (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); | |
357 | + Gramext.Stoken ("", ":"); Gramext.Sself], | |
358 | + Gramext.action | |
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], | |
363 | Gramext.action | |
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, | |
370 | - [[Gramext.Snterm | |
371 | - (Grammar.Entry.obj | |
372 | - (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e)); | |
373 | - Gramext.Stoken ("", ":"); Gramext.Sself], | |
374 | - Gramext.action | |
375 | - (fun (t : 'ctyp) _ (i : 'a_QUESTIONIDENT) (loc : int * int) -> | |
376 | - (Qast.Node ("TyOlb", [Qast.Loc; i; t]) : 'ctyp)); | |
377 | - [Gramext.Snterm | |
378 | - (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); | |
379 | - Gramext.Stoken ("", ":"); Gramext.Sself], | |
380 | - Gramext.action | |
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"), | |
385 | [None, None, | |
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)); | |
390 | [Gramext.Snterm | |
391 | + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e)); | |
392 | + Gramext.Stoken ("", "("); | |
393 | + Gramext.Snterm | |
394 | + (Grammar.Entry.obj (patt_tcon : 'patt_tcon Grammar.Entry.e)); | |
395 | + Gramext.srules | |
396 | + [[Gramext.Sopt | |
397 | + (Gramext.Snterm | |
398 | + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))], | |
399 | + Gramext.action | |
400 | + (fun (a : 'eq_expr option) (loc : int * int) -> | |
401 | + (Qast.Option a : 'a_opt)); | |
402 | + [Gramext.Snterm | |
403 | + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], | |
404 | + Gramext.action | |
405 | + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; | |
406 | + Gramext.Stoken ("", ")")], | |
407 | + Gramext.action | |
408 | + (fun _ (eo : 'a_opt) (p : 'patt_tcon) _ (i : 'a_OPTLABEL) | |
409 | + (loc : int * int) -> | |
410 | + (Qast.Node | |
411 | + ("PaOlb", | |
412 | + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) : | |
413 | + 'patt)); | |
414 | + [Gramext.Snterm | |
415 | (Grammar.Entry.obj | |
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)); | |
421 | [Gramext.Snterm | |
422 | + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e)); | |
423 | + Gramext.Sself], | |
424 | + Gramext.action | |
425 | + (fun (p : 'patt) (i : 'a_LABEL) (loc : int * int) -> | |
426 | + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) : | |
427 | + 'patt)); | |
428 | + [Gramext.Snterm | |
429 | (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); | |
430 | Gramext.Stoken ("", ":"); Gramext.Sself], | |
431 | Gramext.action | |
432 | @@ -3606,6 +3649,30 @@ | |
433 | (fun (i : 'a_QUESTIONIDENT) (loc : int * int) -> | |
434 | (Qast.Node ("PaOlb", [Qast.Loc; i; Qast.Option None]) : 'ipatt)); | |
435 | [Gramext.Snterm | |
436 | + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e)); | |
437 | + Gramext.Stoken ("", "("); | |
438 | + Gramext.Snterm | |
439 | + (Grammar.Entry.obj (ipatt_tcon : 'ipatt_tcon Grammar.Entry.e)); | |
440 | + Gramext.srules | |
441 | + [[Gramext.Sopt | |
442 | + (Gramext.Snterm | |
443 | + (Grammar.Entry.obj (eq_expr : 'eq_expr Grammar.Entry.e)))], | |
444 | + Gramext.action | |
445 | + (fun (a : 'eq_expr option) (loc : int * int) -> | |
446 | + (Qast.Option a : 'a_opt)); | |
447 | + [Gramext.Snterm | |
448 | + (Grammar.Entry.obj (a_opt : 'a_opt Grammar.Entry.e))], | |
449 | + Gramext.action | |
450 | + (fun (a : 'a_opt) (loc : int * int) -> (a : 'a_opt))]; | |
451 | + Gramext.Stoken ("", ")")], | |
452 | + Gramext.action | |
453 | + (fun _ (eo : 'a_opt) (p : 'ipatt_tcon) _ (i : 'a_OPTLABEL) | |
454 | + (loc : int * int) -> | |
455 | + (Qast.Node | |
456 | + ("PaOlb", | |
457 | + [Qast.Loc; i; Qast.Option (Some (Qast.Tuple [p; eo]))]) : | |
458 | + 'ipatt)); | |
459 | + [Gramext.Snterm | |
460 | (Grammar.Entry.obj | |
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)); | |
466 | [Gramext.Snterm | |
467 | + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e)); | |
468 | + Gramext.Sself], | |
469 | + Gramext.action | |
470 | + (fun (p : 'ipatt) (i : 'a_LABEL) (loc : int * int) -> | |
471 | + (Qast.Node ("PaLab", [Qast.Loc; i; Qast.Option (Some p)]) : | |
472 | + 'ipatt)); | |
473 | + [Gramext.Snterm | |
474 | (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); | |
475 | Gramext.Stoken ("", ":"); Gramext.Sself], | |
476 | Gramext.action | |
477 | @@ -3669,6 +3743,13 @@ | |
478 | (fun (i : 'a_QUESTIONIDENT) (loc : int * int) -> | |
479 | (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option None]) : 'expr)); | |
480 | [Gramext.Snterm | |
481 | + (Grammar.Entry.obj (a_OPTLABEL : 'a_OPTLABEL Grammar.Entry.e)); | |
482 | + Gramext.Sself], | |
483 | + Gramext.action | |
484 | + (fun (e : 'expr) (i : 'a_OPTLABEL) (loc : int * int) -> | |
485 | + (Qast.Node ("ExOlb", [Qast.Loc; i; Qast.Option (Some e)]) : | |
486 | + 'expr)); | |
487 | + [Gramext.Snterm | |
488 | (Grammar.Entry.obj | |
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)); | |
494 | [Gramext.Snterm | |
495 | + (Grammar.Entry.obj (a_LABEL : 'a_LABEL Grammar.Entry.e)); | |
496 | + Gramext.Sself], | |
497 | + Gramext.action | |
498 | + (fun (e : 'expr) (i : 'a_LABEL) (loc : int * int) -> | |
499 | + (Qast.Node ("ExLab", [Qast.Loc; i; Qast.Option (Some e)]) : | |
500 | + 'expr)); | |
501 | + [Gramext.Snterm | |
502 | (Grammar.Entry.obj (a_TILDEIDENT : 'a_TILDEIDENT Grammar.Entry.e)); | |
503 | Gramext.Stoken ("", ":"); Gramext.Sself], | |
504 | Gramext.action | |
505 | @@ -4427,6 +4515,11 @@ | |
506 | Gramext.action | |
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, | |
510 | + [None, None, | |
511 | + [[Gramext.Stoken ("LABEL", "")], | |
512 | + Gramext.action | |
513 | + (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_LABEL))]]; | |
514 | Grammar.Entry.obj (a_QUESTIONIDENT : 'a_QUESTIONIDENT Grammar.Entry.e), | |
515 | None, | |
516 | [None, None, | |
517 | @@ -4437,7 +4530,12 @@ | |
518 | [Gramext.Stoken ("", "?"); Gramext.Stoken ("ANTIQUOT", "")], | |
519 | Gramext.action | |
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, | |
524 | + [None, None, | |
525 | + [[Gramext.Stoken ("OPTLABEL", "")], | |
526 | + Gramext.action | |
527 | + (fun (s : string) (loc : int * int) -> (Qast.Str s : 'a_OPTLABEL))]]];; | |
528 | ||
529 | let apply_entry e = | |
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 | |
bcbd92c0 MM |
535 | @@ -24,6 +24,7 @@ |
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")) | |
541 | ||
542 | install: | |
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 | |
547 | @@ -8,7 +8,7 @@ | |
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)) | |
554 | ||
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 | |
bcbd92c0 MM |
560 | @@ -21,6 +21,8 @@ |
561 | (require 'caml-xemacs) | |
562 | (require 'caml-emacs))) | |
563 | ||
564 | + | |
565 | + | |
566 | (defvar caml-types-location-re nil "Regexp to parse *.annot files. | |
567 | ||
568 | Annotation files *.annot may be generated with the \"-dtypes\" option | |
569 | @@ -160,8 +162,10 @@ | |
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 | |
573 | + type-date | |
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)) | |
583 | ) | |
584 | (t | |
585 | - (error "No annotation file. You may compile with \"-dtypes\" option")) | |
586 | + (error "No annotation file. You should compile with option \"-dtypes\".")) | |
587 | ) | |
588 | buf)) | |
589 | ||
590 | +(defun caml-types-mouse-ignore (event) | |
591 | + (interactive "e") | |
592 | + nil) | |
593 | ||
594 | (defun caml-types-explore (event) | |
595 | "Explore type annotations by mouse dragging. | |
596 | @@ -395,58 +402,79 @@ | |
597 | (target-line) (target-bol) | |
598 | target-pos | |
599 | Left Right limits cnum node mes type | |
600 | - (tree caml-types-annotation-tree) | |
601 | region | |
602 | + target-tree | |
603 | ) | |
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") | |
608 | (unwind-protect | |
609 | - (caml-track-mouse | |
610 | - (setq region | |
611 | - (caml-types-typed-make-overlay target-buf | |
612 | - (caml-event-point-start event))) | |
613 | - (while (and 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))) | |
618 | - (message mes) | |
619 | - (setq target-bol | |
620 | - (save-excursion (goto-char cnum) | |
621 | - (caml-line-beginning-position))) | |
622 | - (setq target-line | |
623 | - (1+ (count-lines (point-min) target-bol))) | |
624 | - (setq target-pos (vector target-file target-line target-bol cnum)) | |
625 | - (save-excursion | |
626 | - (setq node (caml-types-find-location target-pos () tree)) | |
627 | - (set-buffer caml-types-buffer) | |
628 | - (erase-buffer) | |
629 | - (cond | |
630 | - (node | |
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 | |
635 | - node)) | |
636 | - (setq type (elt node 2)) | |
637 | - ) | |
638 | - (t | |
639 | - (delete-overlay caml-types-expr-ovl) | |
640 | - (setq type "*no type information*") | |
641 | - (setq limits (caml-types-find-interval target-buf target-pos | |
642 | - tree)) | |
643 | - )) | |
644 | - (message (setq mes (format "type: %s" type))) | |
645 | - (insert type) | |
646 | - ))) | |
647 | - (setq event (caml-read-event)) | |
648 | - (unless (mouse-movement-p event) (setq event nil)) | |
649 | - ) | |
650 | - ) | |
651 | - (delete-overlay caml-types-expr-ovl) | |
652 | - (delete-overlay caml-types-typed-ovl) | |
653 | + (progn | |
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") | |
660 | + (unwind-protect | |
661 | + (caml-track-mouse | |
662 | + (setq region | |
663 | + (caml-types-typed-make-overlay | |
664 | + target-buf (caml-event-point-start event))) | |
665 | + (while (and event | |
666 | + (integer-or-marker-p | |
667 | + (setq cnum (caml-event-point-end event)))) | |
668 | + (if (and region (<= (car region) cnum) (< cnum (cdr region))) | |
669 | + (if (and limits | |
670 | + (>= cnum (car limits)) (< cnum (cdr limits))) | |
671 | + (message mes) | |
672 | + (setq target-bol | |
673 | + (save-excursion | |
674 | + (goto-char cnum) (caml-line-beginning-position)) | |
675 | + target-line (1+ (count-lines (point-min) | |
676 | + target-bol)) | |
677 | + target-pos | |
678 | + (vector target-file target-line target-bol cnum)) | |
679 | + (save-excursion | |
680 | + (setq node (caml-types-find-location | |
681 | + target-pos () target-tree)) | |
682 | + (set-buffer caml-types-buffer) | |
683 | + (erase-buffer) | |
684 | + (cond | |
685 | + (node | |
686 | + (setq Left | |
687 | + (caml-types-get-pos target-buf (elt node 0)) | |
688 | + Right | |
689 | + (caml-types-get-pos target-buf (elt node 1))) | |
690 | + (move-overlay | |
691 | + caml-types-expr-ovl Left Right target-buf) | |
692 | + (setq limits | |
693 | + (caml-types-find-interval target-buf | |
694 | + target-pos node) | |
695 | + type (elt node 2)) | |
696 | + ) | |
697 | + (t | |
698 | + (delete-overlay caml-types-expr-ovl) | |
699 | + (setq type "*no type information*") | |
700 | + (setq limits | |
701 | + (caml-types-find-interval | |
702 | + target-buf target-pos target-tree)) | |
703 | + )) | |
704 | + (message (setq mes (format "type: %s" type))) | |
705 | + (insert type) | |
706 | + ))) | |
707 | + (setq event (caml-read-event)) | |
708 | + (unless (mouse-movement-p event) (setq event nil)) | |
709 | + ) | |
710 | + ) | |
711 | + (delete-overlay caml-types-expr-ovl) | |
712 | + (delete-overlay caml-types-typed-ovl) | |
713 | + )) | |
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))) | |
722 | ))) | |
723 | ||
724 | (defun caml-types-typed-make-overlay (target-buf pos) | |
725 | @@ -459,7 +487,7 @@ | |
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) | |
731 | ) | |
732 | (setq start (min start left) | |
733 | end (max end right)) | |
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 | |
738 | @@ -12,8 +12,9 @@ | |
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)) | |
745 | + | |
746 | (defun mouse-movement-p (e) (equal (event-type e) 'motion)) | |
747 | ||
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 | |
753 | @@ -283,6 +283,8 @@ | |
754 | ||
755 | ;; caml-types | |
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) | |
760 | ;; caml-help | |
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 | |
bcbd92c0 MM |
766 | @@ -72,10 +72,10 @@ |
767 | ||
768 | /* The thread descriptors */ | |
769 | ||
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 */ | |
778 | value * stack_high; | |
779 | value * stack_threshold; | |
780 | @@ -94,7 +94,7 @@ | |
781 | value retval; /* Value to return when thread resumes */ | |
782 | }; | |
783 | ||
784 | -typedef struct thread_struct * thread_t; | |
785 | +typedef struct caml_thread_struct * caml_thread_t; | |
786 | ||
787 | #define RUNNABLE Val_int(0) | |
788 | #define KILLED Val_int(1) | |
789 | @@ -122,7 +122,7 @@ | |
790 | #define DELAY_INFTY 1E30 /* +infty, for this purpose */ | |
791 | ||
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); | |
797 | ||
798 | @@ -134,7 +134,7 @@ | |
799 | ||
800 | static void thread_scan_roots(scanning_action action) | |
801 | { | |
802 | - thread_t th, start; | |
803 | + caml_thread_t th, start; | |
804 | ||
805 | /* Scan all active descriptors */ | |
806 | start = curr_thread; | |
807 | @@ -161,7 +161,8 @@ | |
808 | if (curr_thread != NULL) return Val_unit; | |
809 | /* Create a descriptor for the current thread */ | |
810 | curr_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 @@ | |
818 | ||
819 | value thread_new(value clos) /* ML */ | |
820 | { | |
821 | - thread_t th; | |
822 | + caml_thread_t th; | |
823 | /* Allocate the thread and its stack */ | |
824 | Begin_root(clos); | |
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); | |
828 | End_roots(); | |
829 | th->ident = next_ident; | |
830 | next_ident = Val_int(Int_val(next_ident) + 1); | |
831 | @@ -268,7 +270,7 @@ | |
832 | ||
833 | value thread_id(value th) /* ML */ | |
834 | { | |
835 | - return ((struct thread_struct *)th)->ident; | |
836 | + return ((caml_thread_t)th)->ident; | |
837 | } | |
838 | ||
839 | /* Return the current time as a floating-point number */ | |
840 | @@ -293,7 +295,7 @@ | |
841 | ||
842 | static value schedule_thread(void) | |
843 | { | |
844 | - thread_t run_thread, th; | |
845 | + caml_thread_t run_thread, th; | |
846 | fd_set readfds, writefds, exceptfds; | |
847 | double delay, now; | |
848 | int need_select, need_wait; | |
849 | @@ -353,7 +355,7 @@ | |
850 | } | |
851 | } | |
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); | |
857 | } | |
858 | @@ -682,7 +684,7 @@ | |
859 | { | |
860 | check_callback(); | |
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(); | |
867 | @@ -703,7 +705,7 @@ | |
868 | ||
869 | value thread_wakeup(value thread) /* ML */ | |
870 | { | |
871 | - thread_t th = (thread_t) thread; | |
872 | + caml_thread_t th = (caml_thread_t) thread; | |
873 | switch (th->status) { | |
874 | case SUSPENDED: | |
875 | th->status = RUNNABLE; | |
876 | @@ -730,7 +732,7 @@ | |
877 | value thread_kill(value thread) /* ML */ | |
878 | { | |
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"); | |
885 | @@ -740,7 +742,7 @@ | |
886 | if (th == curr_thread) { | |
887 | Begin_root(thread); | |
888 | retval = schedule_thread(); | |
889 | - th = (thread_t) thread; | |
890 | + th = (caml_thread_t) thread; | |
891 | End_roots(); | |
892 | } | |
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 | |
898 | @@ -74,7 +74,7 @@ | |
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 | |
906 | cannot be found. *) | |
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 | |
bcbd92c0 MM |
911 | @@ -800,7 +800,7 @@ |
912 | ||
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 | |
bcbd92c0 MM |
924 | @@ -78,4 +78,4 @@ |
925 | ||
926 | (* OCaml version string, must be in the format described in sys.mli. *) | |
927 | ||
928 | -let ocaml_version = "3.07";; | |
929 | +let ocaml_version = "3.07+2";; |