]>
Commit | Line | Data |
---|---|---|
1 | From 7fafc03c599d9286ef7e1470dae94838c8e8806d Mon Sep 17 00:00:00 2001 | |
2 | From: Daniel de-Rauglaudre <deraugla@sysadm-OptiPlex-9020-AIO.(none)> | |
3 | Date: Tue, 12 May 2015 18:37:59 +0200 | |
4 | Subject: [PATCH] updated for ocaml version 4.02.2 | |
5 | ||
6 | --- | |
7 | CHANGES | 2 + | |
8 | ocaml_src/lib/versdep/4.02.2.ml | 661 ++++++++++++++++++++++++ | |
9 | ocaml_stuff/4.02.2/parsing/.depend | 4 + | |
10 | ocaml_stuff/4.02.2/parsing/.gitignore | 1 + | |
11 | ocaml_stuff/4.02.2/parsing/Makefile | 19 + | |
12 | ocaml_stuff/4.02.2/parsing/asttypes.mli | 49 ++ | |
13 | ocaml_stuff/4.02.2/parsing/location.mli | 135 +++++ | |
14 | ocaml_stuff/4.02.2/parsing/longident.mli | 22 + | |
15 | ocaml_stuff/4.02.2/parsing/parsetree.mli | 829 +++++++++++++++++++++++++++++++ | |
16 | ocaml_stuff/4.02.2/utils/.depend | 2 + | |
17 | ocaml_stuff/4.02.2/utils/.gitignore | 1 + | |
18 | ocaml_stuff/4.02.2/utils/Makefile | 27 + | |
19 | ocaml_stuff/4.02.2/utils/pconfig.ml | 4 + | |
20 | ocaml_stuff/4.02.2/utils/pconfig.mli | 4 + | |
21 | ocaml_stuff/4.02.2/utils/warnings.mli | 86 ++++ | |
22 | 15 files changed, 1846 insertions(+) | |
23 | create mode 100644 ocaml_src/lib/versdep/4.02.2.ml | |
24 | create mode 100644 ocaml_stuff/4.02.2/parsing/.depend | |
25 | create mode 100644 ocaml_stuff/4.02.2/parsing/.gitignore | |
26 | create mode 100644 ocaml_stuff/4.02.2/parsing/Makefile | |
27 | create mode 100644 ocaml_stuff/4.02.2/parsing/asttypes.mli | |
28 | create mode 100644 ocaml_stuff/4.02.2/parsing/location.mli | |
29 | create mode 100644 ocaml_stuff/4.02.2/parsing/longident.mli | |
30 | create mode 100644 ocaml_stuff/4.02.2/parsing/parsetree.mli | |
31 | create mode 100644 ocaml_stuff/4.02.2/utils/.depend | |
32 | create mode 100644 ocaml_stuff/4.02.2/utils/.gitignore | |
33 | create mode 100644 ocaml_stuff/4.02.2/utils/Makefile | |
34 | create mode 100644 ocaml_stuff/4.02.2/utils/pconfig.ml | |
35 | create mode 100644 ocaml_stuff/4.02.2/utils/pconfig.mli | |
36 | create mode 100644 ocaml_stuff/4.02.2/utils/warnings.mli | |
37 | ||
38 | #diff --git a/CHANGES b/CHANGES | |
39 | #index ba9243e..db34fd3 100644 | |
40 | #--- a/CHANGES | |
41 | #+++ b/CHANGES | |
42 | #@@ -1,6 +1,8 @@ | |
43 | # Camlp5 Version 6.13: | |
44 | # -------------------- | |
45 | # | |
46 | #+* [12 May 15] Upgraded for ocaml version 4.02.2 | |
47 | #+ | |
48 | # Camlp5 Version 6.12: | |
49 | # -------------------- | |
50 | # | |
51 | diff --git a/ocaml_src/lib/versdep/4.02.2.ml b/ocaml_src/lib/versdep/4.02.2.ml | |
52 | new file mode 100644 | |
53 | index 0000000..cbe5f5b | |
54 | --- /dev/null | |
55 | +++ b/ocaml_src/lib/versdep/4.02.2.ml | |
56 | @@ -0,0 +1,661 @@ | |
57 | +(* camlp5r pa_macro.cmo *) | |
58 | +(* versdep.ml,v *) | |
59 | +(* Copyright (c) INRIA 2007-2014 *) | |
60 | + | |
61 | +open Parsetree;; | |
62 | +open Longident;; | |
63 | +open Asttypes;; | |
64 | + | |
65 | +type ('a, 'b) choice = | |
66 | + Left of 'a | |
67 | + | Right of 'b | |
68 | +;; | |
69 | + | |
70 | +let sys_ocaml_version = Sys.ocaml_version;; | |
71 | + | |
72 | +let ocaml_location (fname, lnum, bolp, lnuml, bolpl, bp, ep) = | |
73 | + let loc_at n lnum bolp = | |
74 | + {Lexing.pos_fname = if lnum = -1 then "" else fname; | |
75 | + Lexing.pos_lnum = lnum; Lexing.pos_bol = bolp; Lexing.pos_cnum = n} | |
76 | + in | |
77 | + {Location.loc_start = loc_at bp lnum bolp; | |
78 | + Location.loc_end = loc_at ep lnuml bolpl; | |
79 | + Location.loc_ghost = bp = 0 && ep = 0} | |
80 | +;; | |
81 | + | |
82 | +let loc_none = | |
83 | + let loc = | |
84 | + {Lexing.pos_fname = "_none_"; Lexing.pos_lnum = 1; Lexing.pos_bol = 0; | |
85 | + Lexing.pos_cnum = -1} | |
86 | + in | |
87 | + {Location.loc_start = loc; Location.loc_end = loc; | |
88 | + Location.loc_ghost = true} | |
89 | +;; | |
90 | + | |
91 | +let mkloc loc txt = {Location.txt = txt; Location.loc = loc};; | |
92 | +let mknoloc txt = mkloc loc_none txt;; | |
93 | + | |
94 | +let ocaml_id_or_li_of_string_list loc sl = | |
95 | + let mkli s = | |
96 | + let rec loop f = | |
97 | + function | |
98 | + i :: il -> loop (fun s -> Ldot (f i, s)) il | |
99 | + | [] -> f s | |
100 | + in | |
101 | + loop (fun s -> Lident s) | |
102 | + in | |
103 | + match List.rev sl with | |
104 | + [] -> None | |
105 | + | s :: sl -> Some (mkli s (List.rev sl)) | |
106 | +;; | |
107 | + | |
108 | +let list_map_check f l = | |
109 | + let rec loop rev_l = | |
110 | + function | |
111 | + x :: l -> | |
112 | + begin match f x with | |
113 | + Some s -> loop (s :: rev_l) l | |
114 | + | None -> None | |
115 | + end | |
116 | + | [] -> Some (List.rev rev_l) | |
117 | + in | |
118 | + loop [] l | |
119 | +;; | |
120 | + | |
121 | +let ocaml_value_description vn t p = | |
122 | + {pval_type = t; pval_prim = p; pval_loc = t.ptyp_loc; | |
123 | + pval_name = mkloc t.ptyp_loc vn; pval_attributes = []} | |
124 | +;; | |
125 | + | |
126 | +let ocaml_class_type_field loc ctfd = | |
127 | + {pctf_desc = ctfd; pctf_loc = loc; pctf_attributes = []} | |
128 | +;; | |
129 | + | |
130 | +let ocaml_class_field loc cfd = | |
131 | + {pcf_desc = cfd; pcf_loc = loc; pcf_attributes = []} | |
132 | +;; | |
133 | + | |
134 | +let ocaml_mktyp loc x = | |
135 | + {ptyp_desc = x; ptyp_loc = loc; ptyp_attributes = []} | |
136 | +;; | |
137 | +let ocaml_mkpat loc x = | |
138 | + {ppat_desc = x; ppat_loc = loc; ppat_attributes = []} | |
139 | +;; | |
140 | +let ocaml_mkexp loc x = | |
141 | + {pexp_desc = x; pexp_loc = loc; pexp_attributes = []} | |
142 | +;; | |
143 | +let ocaml_mkmty loc x = | |
144 | + {pmty_desc = x; pmty_loc = loc; pmty_attributes = []} | |
145 | +;; | |
146 | +let ocaml_mkmod loc x = | |
147 | + {pmod_desc = x; pmod_loc = loc; pmod_attributes = []} | |
148 | +;; | |
149 | +let ocaml_mkfield loc (lab, x) fl = (lab, x) :: fl;; | |
150 | +let ocaml_mkfield_var loc = [];; | |
151 | + | |
152 | +let variance_of_bool_bool = | |
153 | + function | |
154 | + false, true -> Contravariant | |
155 | + | true, false -> Covariant | |
156 | + | _ -> Invariant | |
157 | +;; | |
158 | + | |
159 | +let ocaml_type_declaration tn params cl tk pf tm loc variance = | |
160 | + match list_map_check (fun s_opt -> s_opt) params with | |
161 | + Some params -> | |
162 | + let _ = | |
163 | + if List.length params <> List.length variance then | |
164 | + failwith "internal error: ocaml_type_declaration" | |
165 | + in | |
166 | + let params = | |
167 | + List.map2 | |
168 | + (fun os va -> | |
169 | + ocaml_mktyp loc (Ptyp_var os), variance_of_bool_bool va) | |
170 | + params variance | |
171 | + in | |
172 | + Right | |
173 | + {ptype_params = params; ptype_cstrs = cl; ptype_kind = tk; | |
174 | + ptype_private = pf; ptype_manifest = tm; ptype_loc = loc; | |
175 | + ptype_name = mkloc loc tn; ptype_attributes = []} | |
176 | + | None -> Left "no '_' type param in this ocaml version" | |
177 | +;; | |
178 | + | |
179 | +let ocaml_class_type = | |
180 | + Some (fun d loc -> {pcty_desc = d; pcty_loc = loc; pcty_attributes = []}) | |
181 | +;; | |
182 | + | |
183 | +let ocaml_class_expr = | |
184 | + Some (fun d loc -> {pcl_desc = d; pcl_loc = loc; pcl_attributes = []}) | |
185 | +;; | |
186 | + | |
187 | +let ocaml_class_structure p cil = {pcstr_self = p; pcstr_fields = cil};; | |
188 | + | |
189 | +let ocaml_pmty_ident loc li = Pmty_ident (mkloc loc li);; | |
190 | + | |
191 | +let ocaml_pmty_functor sloc s mt1 mt2 = | |
192 | + Pmty_functor (mkloc sloc s, Some mt1, mt2) | |
193 | +;; | |
194 | + | |
195 | +let ocaml_pmty_typeof = Some (fun me -> Pmty_typeof me);; | |
196 | + | |
197 | +let ocaml_pmty_with mt lcl = | |
198 | + let lcl = List.map snd lcl in Pmty_with (mt, lcl) | |
199 | +;; | |
200 | + | |
201 | +let ocaml_ptype_abstract = Ptype_abstract;; | |
202 | + | |
203 | +let ocaml_ptype_record ltl priv = | |
204 | + Ptype_record | |
205 | + (List.map | |
206 | + (fun (s, mf, ct, loc) -> | |
207 | + {pld_name = mkloc loc s; pld_mutable = mf; pld_type = ct; | |
208 | + pld_loc = loc; pld_attributes = []}) | |
209 | + ltl) | |
210 | +;; | |
211 | + | |
212 | +let ocaml_ptype_variant ctl priv = | |
213 | + try | |
214 | + let ctl = | |
215 | + List.map | |
216 | + (fun (c, tl, rto, loc) -> | |
217 | + if rto <> None then raise Exit | |
218 | + else | |
219 | + {pcd_name = mkloc loc c; pcd_args = tl; pcd_res = None; | |
220 | + pcd_loc = loc; pcd_attributes = []}) | |
221 | + ctl | |
222 | + in | |
223 | + Some (Ptype_variant ctl) | |
224 | + with Exit -> None | |
225 | +;; | |
226 | + | |
227 | +let ocaml_ptyp_arrow lab t1 t2 = Ptyp_arrow (lab, t1, t2);; | |
228 | + | |
229 | +let ocaml_ptyp_class li tl ll = Ptyp_class (mknoloc li, tl);; | |
230 | + | |
231 | +let ocaml_ptyp_constr loc li tl = Ptyp_constr (mkloc loc li, tl);; | |
232 | + | |
233 | +let ocaml_ptyp_object ml = | |
234 | + let ml = List.map (fun (s, t) -> s, [], t) ml in Ptyp_object (ml, Closed) | |
235 | +;; | |
236 | + | |
237 | +let ocaml_ptyp_package = Some (fun pt -> Ptyp_package pt);; | |
238 | + | |
239 | +let ocaml_ptyp_poly = | |
240 | + Some | |
241 | + (fun cl t -> | |
242 | + match cl with | |
243 | + [] -> t.ptyp_desc | |
244 | + | _ -> Ptyp_poly (cl, t)) | |
245 | +;; | |
246 | + | |
247 | +let ocaml_ptyp_variant catl clos sl_opt = | |
248 | + let catl = | |
249 | + List.map | |
250 | + (function | |
251 | + Left (c, a, tl) -> Rtag (c, [], a, tl) | |
252 | + | Right t -> Rinherit t) | |
253 | + catl | |
254 | + in | |
255 | + let clos = if clos then Closed else Open in | |
256 | + Some (Ptyp_variant (catl, clos, sl_opt)) | |
257 | +;; | |
258 | + | |
259 | +let ocaml_package_type li ltl = | |
260 | + mknoloc li, List.map (fun (li, t) -> mkloc t.ptyp_loc li, t) ltl | |
261 | +;; | |
262 | + | |
263 | +let ocaml_const_string s = Const_string (s, None);; | |
264 | + | |
265 | +let ocaml_const_int32 = Some (fun s -> Const_int32 (Int32.of_string s));; | |
266 | + | |
267 | +let ocaml_const_int64 = Some (fun s -> Const_int64 (Int64.of_string s));; | |
268 | + | |
269 | +let ocaml_const_nativeint = | |
270 | + Some (fun s -> Const_nativeint (Nativeint.of_string s)) | |
271 | +;; | |
272 | + | |
273 | +let ocaml_pexp_apply f lel = Pexp_apply (f, lel);; | |
274 | + | |
275 | +let ocaml_pexp_assertfalse fname loc = | |
276 | + Pexp_assert | |
277 | + (ocaml_mkexp loc (Pexp_construct (mkloc loc (Lident "false"), None))) | |
278 | +;; | |
279 | + | |
280 | +let ocaml_pexp_assert fname loc e = Pexp_assert e;; | |
281 | + | |
282 | +let ocaml_pexp_constraint e ot1 ot2 = | |
283 | + match ot2 with | |
284 | + Some t2 -> Pexp_coerce (e, ot1, t2) | |
285 | + | None -> | |
286 | + match ot1 with | |
287 | + Some t1 -> Pexp_constraint (e, t1) | |
288 | + | None -> failwith "internal error: ocaml_pexp_constraint" | |
289 | +;; | |
290 | + | |
291 | +let ocaml_pexp_construct loc li po chk_arity = | |
292 | + Pexp_construct (mkloc loc li, po) | |
293 | +;; | |
294 | + | |
295 | +let ocaml_pexp_construct_args = | |
296 | + function | |
297 | + Pexp_construct (li, po) -> Some (li.txt, li.loc, po, 0) | |
298 | + | _ -> None | |
299 | +;; | |
300 | + | |
301 | +let mkexp_ocaml_pexp_construct_arity loc li_loc li al = | |
302 | + let a = ocaml_mkexp loc (Pexp_tuple al) in | |
303 | + {pexp_desc = ocaml_pexp_construct li_loc li (Some a) true; pexp_loc = loc; | |
304 | + pexp_attributes = [mkloc loc "ocaml.explicit_arity", PStr []]} | |
305 | +;; | |
306 | + | |
307 | +let ocaml_pexp_field loc e li = Pexp_field (e, mkloc loc li);; | |
308 | + | |
309 | +let ocaml_pexp_for i e1 e2 df e = | |
310 | + Pexp_for (ocaml_mkpat loc_none (Ppat_var (mknoloc i)), e1, e2, df, e) | |
311 | +;; | |
312 | + | |
313 | +let ocaml_case (p, wo, loc, e) = {pc_lhs = p; pc_guard = wo; pc_rhs = e};; | |
314 | + | |
315 | +let ocaml_pexp_function lab eo pel = | |
316 | + match pel with | |
317 | + [{pc_lhs = p; pc_guard = None; pc_rhs = e}] -> Pexp_fun (lab, eo, p, e) | |
318 | + | pel -> | |
319 | + if lab = "" && eo = None then Pexp_function pel | |
320 | + else failwith "internal error: bad ast in ocaml_pexp_function" | |
321 | +;; | |
322 | + | |
323 | +let ocaml_pexp_lazy = Some (fun e -> Pexp_lazy e);; | |
324 | + | |
325 | +let ocaml_pexp_ident li = Pexp_ident (mknoloc li);; | |
326 | + | |
327 | +let ocaml_pexp_letmodule = | |
328 | + Some (fun i me e -> Pexp_letmodule (mknoloc i, me, e)) | |
329 | +;; | |
330 | + | |
331 | +let ocaml_pexp_new loc li = Pexp_new (mkloc loc li);; | |
332 | + | |
333 | +let ocaml_pexp_newtype = Some (fun s e -> Pexp_newtype (s, e));; | |
334 | + | |
335 | +let ocaml_pexp_object = Some (fun cs -> Pexp_object cs);; | |
336 | + | |
337 | +let ocaml_pexp_open = Some (fun li e -> Pexp_open (Fresh, mknoloc li, e));; | |
338 | + | |
339 | +let ocaml_pexp_override sel = | |
340 | + let sel = List.map (fun (s, e) -> mknoloc s, e) sel in Pexp_override sel | |
341 | +;; | |
342 | + | |
343 | +let ocaml_pexp_pack : ('a -> 'b -> 'c, 'd) choice option = | |
344 | + Some (Right ((fun me -> Pexp_pack me), (fun pt -> Ptyp_package pt))) | |
345 | +;; | |
346 | + | |
347 | +let ocaml_pexp_poly = Some (fun e t -> Pexp_poly (e, t));; | |
348 | + | |
349 | +let ocaml_pexp_record lel eo = | |
350 | + let lel = List.map (fun (li, loc, e) -> mkloc loc li, e) lel in | |
351 | + Pexp_record (lel, eo) | |
352 | +;; | |
353 | + | |
354 | +let ocaml_pexp_setinstvar s e = Pexp_setinstvar (mknoloc s, e);; | |
355 | + | |
356 | +let ocaml_pexp_variant = | |
357 | + let pexp_variant_pat = | |
358 | + function | |
359 | + Pexp_variant (lab, eo) -> Some (lab, eo) | |
360 | + | _ -> None | |
361 | + in | |
362 | + let pexp_variant (lab, eo) = Pexp_variant (lab, eo) in | |
363 | + Some (pexp_variant_pat, pexp_variant) | |
364 | +;; | |
365 | + | |
366 | +let ocaml_value_binding loc p e = | |
367 | + {pvb_pat = p; pvb_expr = e; pvb_loc = loc; pvb_attributes = []} | |
368 | +;; | |
369 | + | |
370 | +let ocaml_ppat_alias p i iloc = Ppat_alias (p, mkloc iloc i);; | |
371 | + | |
372 | +let ocaml_ppat_array = Some (fun pl -> Ppat_array pl);; | |
373 | + | |
374 | +let ocaml_ppat_construct loc li po chk_arity = | |
375 | + Ppat_construct (mkloc loc li, po) | |
376 | +;; | |
377 | + | |
378 | +let ocaml_ppat_construct_args = | |
379 | + function | |
380 | + Ppat_construct (li, po) -> Some (li.txt, li.loc, po, 0) | |
381 | + | _ -> None | |
382 | +;; | |
383 | + | |
384 | +let mkpat_ocaml_ppat_construct_arity loc li_loc li al = | |
385 | + let a = ocaml_mkpat loc (Ppat_tuple al) in | |
386 | + {ppat_desc = ocaml_ppat_construct li_loc li (Some a) true; ppat_loc = loc; | |
387 | + ppat_attributes = [mkloc loc "ocaml.explicit_arity", PStr []]} | |
388 | +;; | |
389 | + | |
390 | +let ocaml_ppat_lazy = Some (fun p -> Ppat_lazy p);; | |
391 | + | |
392 | +let ocaml_ppat_record lpl is_closed = | |
393 | + let lpl = List.map (fun (li, loc, p) -> mkloc loc li, p) lpl in | |
394 | + Ppat_record (lpl, (if is_closed then Closed else Open)) | |
395 | +;; | |
396 | + | |
397 | +let ocaml_ppat_type = Some (fun loc li -> Ppat_type (mkloc loc li));; | |
398 | + | |
399 | +let ocaml_ppat_unpack = | |
400 | + Some ((fun loc s -> Ppat_unpack (mkloc loc s)), (fun pt -> Ptyp_package pt)) | |
401 | +;; | |
402 | + | |
403 | +let ocaml_ppat_var loc s = Ppat_var (mkloc loc s);; | |
404 | + | |
405 | +let ocaml_ppat_variant = | |
406 | + let ppat_variant_pat = | |
407 | + function | |
408 | + Ppat_variant (lab, po) -> Some (lab, po) | |
409 | + | _ -> None | |
410 | + in | |
411 | + let ppat_variant (lab, po) = Ppat_variant (lab, po) in | |
412 | + Some (ppat_variant_pat, ppat_variant) | |
413 | +;; | |
414 | + | |
415 | +let ocaml_psig_class_type = Some (fun ctl -> Psig_class_type ctl);; | |
416 | + | |
417 | +let ocaml_psig_exception loc s ed = | |
418 | + Psig_exception | |
419 | + {pext_name = mkloc loc s; pext_kind = Pext_decl (ed, None); | |
420 | + pext_loc = loc; pext_attributes = []} | |
421 | +;; | |
422 | + | |
423 | +let ocaml_psig_include loc mt = | |
424 | + Psig_include {pincl_mod = mt; pincl_loc = loc; pincl_attributes = []} | |
425 | +;; | |
426 | + | |
427 | +let ocaml_psig_module loc s mt = | |
428 | + Psig_module | |
429 | + {pmd_name = mkloc loc s; pmd_type = mt; pmd_attributes = []; | |
430 | + pmd_loc = loc} | |
431 | +;; | |
432 | + | |
433 | +let ocaml_psig_modtype loc s mto = | |
434 | + let pmtd = | |
435 | + {pmtd_name = mkloc loc s; pmtd_type = mto; pmtd_attributes = []; | |
436 | + pmtd_loc = loc} | |
437 | + in | |
438 | + Psig_modtype pmtd | |
439 | +;; | |
440 | + | |
441 | +let ocaml_psig_open loc li = | |
442 | + Psig_open | |
443 | + {popen_lid = mknoloc li; popen_override = Fresh; popen_loc = loc; | |
444 | + popen_attributes = []} | |
445 | +;; | |
446 | + | |
447 | +let ocaml_psig_recmodule = | |
448 | + let f ntl = | |
449 | + let ntl = | |
450 | + List.map | |
451 | + (fun (s, mt) -> | |
452 | + {pmd_name = mknoloc s; pmd_type = mt; pmd_attributes = []; | |
453 | + pmd_loc = loc_none}) | |
454 | + ntl | |
455 | + in | |
456 | + Psig_recmodule ntl | |
457 | + in | |
458 | + Some f | |
459 | +;; | |
460 | + | |
461 | +let ocaml_psig_type stl = | |
462 | + let stl = List.map (fun (s, t) -> t) stl in Psig_type stl | |
463 | +;; | |
464 | + | |
465 | +let ocaml_psig_value s vd = Psig_value vd;; | |
466 | + | |
467 | +let ocaml_pstr_class_type = Some (fun ctl -> Pstr_class_type ctl);; | |
468 | + | |
469 | +let ocaml_pstr_eval e = Pstr_eval (e, []);; | |
470 | + | |
471 | +let ocaml_pstr_exception loc s ed = | |
472 | + Pstr_exception | |
473 | + {pext_name = mkloc loc s; pext_kind = Pext_decl (ed, None); | |
474 | + pext_loc = loc; pext_attributes = []} | |
475 | +;; | |
476 | + | |
477 | +let ocaml_pstr_exn_rebind = | |
478 | + Some | |
479 | + (fun loc s li -> | |
480 | + Pstr_exception | |
481 | + {pext_name = mkloc loc s; pext_kind = Pext_rebind (mkloc loc li); | |
482 | + pext_loc = loc; pext_attributes = []}) | |
483 | +;; | |
484 | + | |
485 | +let ocaml_pstr_include = | |
486 | + Some | |
487 | + (fun loc me -> | |
488 | + Pstr_include {pincl_mod = me; pincl_loc = loc; pincl_attributes = []}) | |
489 | +;; | |
490 | + | |
491 | +let ocaml_pstr_modtype loc s mt = | |
492 | + let pmtd = | |
493 | + {pmtd_name = mkloc loc s; pmtd_type = Some mt; pmtd_attributes = []; | |
494 | + pmtd_loc = loc} | |
495 | + in | |
496 | + Pstr_modtype pmtd | |
497 | +;; | |
498 | + | |
499 | +let ocaml_pstr_module loc s me = | |
500 | + let mb = | |
501 | + {pmb_name = mkloc loc s; pmb_expr = me; pmb_attributes = []; | |
502 | + pmb_loc = loc} | |
503 | + in | |
504 | + Pstr_module mb | |
505 | +;; | |
506 | + | |
507 | +let ocaml_pstr_open loc li = | |
508 | + Pstr_open | |
509 | + {popen_lid = mknoloc li; popen_override = Fresh; popen_loc = loc; | |
510 | + popen_attributes = []} | |
511 | +;; | |
512 | + | |
513 | +let ocaml_pstr_primitive s vd = Pstr_primitive vd;; | |
514 | + | |
515 | +let ocaml_pstr_recmodule = | |
516 | + let f nel = | |
517 | + Pstr_recmodule | |
518 | + (List.map | |
519 | + (fun (s, mt, me) -> | |
520 | + {pmb_name = mknoloc s; pmb_expr = me; pmb_attributes = []; | |
521 | + pmb_loc = loc_none}) | |
522 | + nel) | |
523 | + in | |
524 | + Some f | |
525 | +;; | |
526 | + | |
527 | +let ocaml_pstr_type stl = | |
528 | + let stl = List.map (fun (s, t) -> t) stl in Pstr_type stl | |
529 | +;; | |
530 | + | |
531 | +let ocaml_class_infos = | |
532 | + Some | |
533 | + (fun virt (sl, sloc) name expr loc variance -> | |
534 | + let _ = | |
535 | + if List.length sl <> List.length variance then | |
536 | + failwith "internal error: ocaml_class_infos" | |
537 | + in | |
538 | + let params = | |
539 | + List.map2 | |
540 | + (fun os va -> | |
541 | + ocaml_mktyp loc (Ptyp_var os), variance_of_bool_bool va) | |
542 | + sl variance | |
543 | + in | |
544 | + {pci_virt = virt; pci_params = params; pci_name = mkloc loc name; | |
545 | + pci_expr = expr; pci_loc = loc; pci_attributes = []}) | |
546 | +;; | |
547 | + | |
548 | +let ocaml_pmod_ident li = Pmod_ident (mknoloc li);; | |
549 | + | |
550 | +let ocaml_pmod_functor s mt me = Pmod_functor (mknoloc s, Some mt, me);; | |
551 | + | |
552 | +let ocaml_pmod_unpack : ('a -> 'b -> 'c, 'd) choice option = | |
553 | + Some (Right ((fun e -> Pmod_unpack e), (fun pt -> Ptyp_package pt))) | |
554 | +;; | |
555 | + | |
556 | +let ocaml_pcf_cstr = Some (fun (t1, t2, loc) -> Pcf_constraint (t1, t2));; | |
557 | + | |
558 | +let ocaml_pcf_inher ce pb = Pcf_inherit (Fresh, ce, pb);; | |
559 | + | |
560 | +let ocaml_pcf_init = Some (fun e -> Pcf_initializer e);; | |
561 | + | |
562 | +let ocaml_pcf_meth (s, pf, ovf, e, loc) = | |
563 | + let pf = if pf then Private else Public in | |
564 | + let ovf = if ovf then Override else Fresh in | |
565 | + Pcf_method (mkloc loc s, pf, Cfk_concrete (ovf, e)) | |
566 | +;; | |
567 | + | |
568 | +let ocaml_pcf_val (s, mf, ovf, e, loc) = | |
569 | + let mf = if mf then Mutable else Immutable in | |
570 | + let ovf = if ovf then Override else Fresh in | |
571 | + Pcf_val (mkloc loc s, mf, Cfk_concrete (ovf, e)) | |
572 | +;; | |
573 | + | |
574 | +let ocaml_pcf_valvirt = | |
575 | + let ocaml_pcf (s, mf, t, loc) = | |
576 | + let mf = if mf then Mutable else Immutable in | |
577 | + Pcf_val (mkloc loc s, mf, Cfk_virtual t) | |
578 | + in | |
579 | + Some ocaml_pcf | |
580 | +;; | |
581 | + | |
582 | +let ocaml_pcf_virt (s, pf, t, loc) = | |
583 | + Pcf_val (mkloc loc s, Immutable, Cfk_virtual t) | |
584 | +;; | |
585 | + | |
586 | +let ocaml_pcl_apply = Some (fun ce lel -> Pcl_apply (ce, lel));; | |
587 | + | |
588 | +let ocaml_pcl_constr = Some (fun li ctl -> Pcl_constr (mknoloc li, ctl));; | |
589 | + | |
590 | +let ocaml_pcl_constraint = Some (fun ce ct -> Pcl_constraint (ce, ct));; | |
591 | + | |
592 | +let ocaml_pcl_fun = Some (fun lab ceo p ce -> Pcl_fun (lab, ceo, p, ce));; | |
593 | + | |
594 | +let ocaml_pcl_let = Some (fun rf pel ce -> Pcl_let (rf, pel, ce));; | |
595 | + | |
596 | +let ocaml_pcl_structure = Some (fun cs -> Pcl_structure cs);; | |
597 | + | |
598 | +let ocaml_pctf_cstr = Some (fun (t1, t2, loc) -> Pctf_constraint (t1, t2));; | |
599 | + | |
600 | +let ocaml_pctf_inher ct = Pctf_inherit ct;; | |
601 | + | |
602 | +let ocaml_pctf_meth (s, pf, t, loc) = Pctf_method (s, pf, Concrete, t);; | |
603 | + | |
604 | +let ocaml_pctf_val (s, mf, t, loc) = Pctf_val (s, mf, Concrete, t);; | |
605 | + | |
606 | +let ocaml_pctf_virt (s, pf, t, loc) = Pctf_val (s, Immutable, Virtual, t);; | |
607 | + | |
608 | +let ocaml_pcty_constr = Some (fun li ltl -> Pcty_constr (mknoloc li, ltl));; | |
609 | + | |
610 | +let ocaml_pcty_fun = Some (fun lab t ct -> Pcty_arrow (lab, t, ct));; | |
611 | + | |
612 | +let ocaml_pcty_signature = | |
613 | + let f (t, ctfl) = | |
614 | + let cs = {pcsig_self = t; pcsig_fields = ctfl} in Pcty_signature cs | |
615 | + in | |
616 | + Some f | |
617 | +;; | |
618 | + | |
619 | +let ocaml_pdir_bool = Some (fun b -> Pdir_bool b);; | |
620 | + | |
621 | +let ocaml_pwith_modsubst = | |
622 | + Some (fun loc me -> Pwith_modsubst (mkloc loc "", mkloc loc me)) | |
623 | +;; | |
624 | + | |
625 | +let ocaml_pwith_type loc (i, td) = Pwith_type (mkloc loc i, td);; | |
626 | + | |
627 | +let ocaml_pwith_module loc me = | |
628 | + Pwith_module (mkloc loc (Lident ""), mkloc loc me) | |
629 | +;; | |
630 | + | |
631 | +let ocaml_pwith_typesubst = Some (fun td -> Pwith_typesubst td);; | |
632 | + | |
633 | +let module_prefix_can_be_in_first_record_label_only = true;; | |
634 | + | |
635 | +let split_or_patterns_with_bindings = false;; | |
636 | + | |
637 | +let has_records_with_with = true;; | |
638 | + | |
639 | +(* *) | |
640 | + | |
641 | +let jocaml_pstr_def : (_ -> _) option = None;; | |
642 | + | |
643 | +let jocaml_pexp_def : (_ -> _ -> _) option = None;; | |
644 | + | |
645 | +let jocaml_pexp_par : (_ -> _ -> _) option = None;; | |
646 | + | |
647 | +let jocaml_pexp_reply : (_ -> _ -> _ -> _) option = None;; | |
648 | + | |
649 | +let jocaml_pexp_spawn : (_ -> _) option = None;; | |
650 | + | |
651 | +let arg_rest = | |
652 | + function | |
653 | + Arg.Rest r -> Some r | |
654 | + | _ -> None | |
655 | +;; | |
656 | + | |
657 | +let arg_set_string = | |
658 | + function | |
659 | + Arg.Set_string r -> Some r | |
660 | + | _ -> None | |
661 | +;; | |
662 | + | |
663 | +let arg_set_int = | |
664 | + function | |
665 | + Arg.Set_int r -> Some r | |
666 | + | _ -> None | |
667 | +;; | |
668 | + | |
669 | +let arg_set_float = | |
670 | + function | |
671 | + Arg.Set_float r -> Some r | |
672 | + | _ -> None | |
673 | +;; | |
674 | + | |
675 | +let arg_symbol = | |
676 | + function | |
677 | + Arg.Symbol (s, f) -> Some (s, f) | |
678 | + | _ -> None | |
679 | +;; | |
680 | + | |
681 | +let arg_tuple = | |
682 | + function | |
683 | + Arg.Tuple t -> Some t | |
684 | + | _ -> None | |
685 | +;; | |
686 | + | |
687 | +let arg_bool = | |
688 | + function | |
689 | + Arg.Bool f -> Some f | |
690 | + | _ -> None | |
691 | +;; | |
692 | + | |
693 | +let char_escaped = Char.escaped;; | |
694 | + | |
695 | +let hashtbl_mem = Hashtbl.mem;; | |
696 | + | |
697 | +let list_rev_append = List.rev_append;; | |
698 | + | |
699 | +let list_rev_map = List.rev_map;; | |
700 | + | |
701 | +let list_sort = List.sort;; | |
702 | + | |
703 | +let pervasives_set_binary_mode_out = Pervasives.set_binary_mode_out;; | |
704 | + | |
705 | +let printf_ksprintf = Printf.ksprintf;; | |
706 | + | |
707 | +let string_contains = String.contains;; | |
708 | + | |
709 | +let string_copy = Bytes.copy;; | |
710 | + | |
711 | +let string_create = Bytes.create;; | |
712 | + | |
713 | +let string_unsafe_set = Bytes.unsafe_set;; | |
714 | + | |
715 | +let string_set = Bytes.set;; | |
716 | + | |
717 | +let array_create = Array.make;; | |
718 | diff --git a/ocaml_stuff/4.02.2/parsing/.depend b/ocaml_stuff/4.02.2/parsing/.depend | |
719 | new file mode 100644 | |
720 | index 0000000..c589fb6 | |
721 | --- /dev/null | |
722 | +++ b/ocaml_stuff/4.02.2/parsing/.depend | |
723 | @@ -0,0 +1,4 @@ | |
724 | +asttypes.cmi : location.cmi | |
725 | +location.cmi : ../utils/warnings.cmi | |
726 | +longident.cmi : | |
727 | +parsetree.cmi : longident.cmi location.cmi asttypes.cmi | |
728 | diff --git a/ocaml_stuff/4.02.2/parsing/.gitignore b/ocaml_stuff/4.02.2/parsing/.gitignore | |
729 | new file mode 100644 | |
730 | index 0000000..8e6c39c | |
731 | --- /dev/null | |
732 | +++ b/ocaml_stuff/4.02.2/parsing/.gitignore | |
733 | @@ -0,0 +1 @@ | |
734 | +*.cm[oi] | |
735 | diff --git a/ocaml_stuff/4.02.2/parsing/Makefile b/ocaml_stuff/4.02.2/parsing/Makefile | |
736 | new file mode 100644 | |
737 | index 0000000..6d08a19 | |
738 | --- /dev/null | |
739 | +++ b/ocaml_stuff/4.02.2/parsing/Makefile | |
740 | @@ -0,0 +1,19 @@ | |
741 | +# Makefile,v | |
742 | + | |
743 | +FILES=asttypes.cmi location.cmi longident.cmi parsetree.cmi | |
744 | +INCL=-I ../utils | |
745 | + | |
746 | +all: $(FILES) | |
747 | + | |
748 | +clean: | |
749 | + rm -f *.cmi | |
750 | + | |
751 | +depend: | |
752 | + ocamldep $(INCL) *.ml* | sed -e 's/ *$$//' > .depend | |
753 | + | |
754 | +.SUFFIXES: .mli .cmi | |
755 | + | |
756 | +.mli.cmi: | |
757 | + $(OCAMLN)c $(INCL) -c $< | |
758 | + | |
759 | +include .depend | |
760 | diff --git a/ocaml_stuff/4.02.2/parsing/asttypes.mli b/ocaml_stuff/4.02.2/parsing/asttypes.mli | |
761 | new file mode 100644 | |
762 | index 0000000..b212a2b | |
763 | --- /dev/null | |
764 | +++ b/ocaml_stuff/4.02.2/parsing/asttypes.mli | |
765 | @@ -0,0 +1,49 @@ | |
766 | +(***********************************************************************) | |
767 | +(* *) | |
768 | +(* OCaml *) | |
769 | +(* *) | |
770 | +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) | |
771 | +(* *) | |
772 | +(* Copyright 1996 Institut National de Recherche en Informatique et *) | |
773 | +(* en Automatique. All rights reserved. This file is distributed *) | |
774 | +(* under the terms of the Q Public License version 1.0. *) | |
775 | +(* *) | |
776 | +(***********************************************************************) | |
777 | + | |
778 | +(* Auxiliary a.s.t. types used by parsetree and typedtree. *) | |
779 | + | |
780 | +type constant = | |
781 | + Const_int of int | |
782 | + | Const_char of char | |
783 | + | Const_string of string * string option | |
784 | + | Const_float of string | |
785 | + | Const_int32 of int32 | |
786 | + | Const_int64 of int64 | |
787 | + | Const_nativeint of nativeint | |
788 | + | |
789 | +type rec_flag = Nonrecursive | Recursive | |
790 | + | |
791 | +type direction_flag = Upto | Downto | |
792 | + | |
793 | +type private_flag = Private | Public | |
794 | + | |
795 | +type mutable_flag = Immutable | Mutable | |
796 | + | |
797 | +type virtual_flag = Virtual | Concrete | |
798 | + | |
799 | +type override_flag = Override | Fresh | |
800 | + | |
801 | +type closed_flag = Closed | Open | |
802 | + | |
803 | +type label = string | |
804 | + | |
805 | +type 'a loc = 'a Location.loc = { | |
806 | + txt : 'a; | |
807 | + loc : Location.t; | |
808 | +} | |
809 | + | |
810 | + | |
811 | +type variance = | |
812 | + | Covariant | |
813 | + | Contravariant | |
814 | + | Invariant | |
815 | diff --git a/ocaml_stuff/4.02.2/parsing/location.mli b/ocaml_stuff/4.02.2/parsing/location.mli | |
816 | new file mode 100644 | |
817 | index 0000000..77b754f | |
818 | --- /dev/null | |
819 | +++ b/ocaml_stuff/4.02.2/parsing/location.mli | |
820 | @@ -0,0 +1,135 @@ | |
821 | +(***********************************************************************) | |
822 | +(* *) | |
823 | +(* OCaml *) | |
824 | +(* *) | |
825 | +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) | |
826 | +(* *) | |
827 | +(* Copyright 1996 Institut National de Recherche en Informatique et *) | |
828 | +(* en Automatique. All rights reserved. This file is distributed *) | |
829 | +(* under the terms of the Q Public License version 1.0. *) | |
830 | +(* *) | |
831 | +(***********************************************************************) | |
832 | + | |
833 | +(* Source code locations (ranges of positions), used in parsetree. *) | |
834 | + | |
835 | +open Format | |
836 | + | |
837 | +type t = { | |
838 | + loc_start: Lexing.position; | |
839 | + loc_end: Lexing.position; | |
840 | + loc_ghost: bool; | |
841 | +} | |
842 | + | |
843 | +(* Note on the use of Lexing.position in this module. | |
844 | + If [pos_fname = ""], then use [!input_name] instead. | |
845 | + If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and | |
846 | + re-parse the file to get the line and character numbers. | |
847 | + Else all fields are correct. | |
848 | +*) | |
849 | + | |
850 | +val none : t | |
851 | +(** An arbitrary value of type [t]; describes an empty ghost range. *) | |
852 | + | |
853 | +val in_file : string -> t | |
854 | +(** Return an empty ghost range located in a given file. *) | |
855 | + | |
856 | +val init : Lexing.lexbuf -> string -> unit | |
857 | +(** Set the file name and line number of the [lexbuf] to be the start | |
858 | + of the named file. *) | |
859 | + | |
860 | +val curr : Lexing.lexbuf -> t | |
861 | +(** Get the location of the current token from the [lexbuf]. *) | |
862 | + | |
863 | +val symbol_rloc: unit -> t | |
864 | +val symbol_gloc: unit -> t | |
865 | + | |
866 | +(** [rhs_loc n] returns the location of the symbol at position [n], starting | |
867 | + at 1, in the current parser rule. *) | |
868 | +val rhs_loc: int -> t | |
869 | + | |
870 | +val input_name: string ref | |
871 | +val input_lexbuf: Lexing.lexbuf option ref | |
872 | + | |
873 | +val get_pos_info: Lexing.position -> string * int * int (* file, line, char *) | |
874 | +val print_loc: formatter -> t -> unit | |
875 | +val print_error: formatter -> t -> unit | |
876 | +val print_error_cur_file: formatter -> unit | |
877 | +val print_warning: t -> formatter -> Warnings.t -> unit | |
878 | +val formatter_for_warnings : formatter ref | |
879 | +val prerr_warning: t -> Warnings.t -> unit | |
880 | +val echo_eof: unit -> unit | |
881 | +val reset: unit -> unit | |
882 | + | |
883 | +val warning_printer : (t -> formatter -> Warnings.t -> unit) ref | |
884 | +(** Hook for intercepting warnings. *) | |
885 | + | |
886 | +val default_warning_printer : t -> formatter -> Warnings.t -> unit | |
887 | +(** Original warning printer for use in hooks. *) | |
888 | + | |
889 | +val highlight_locations: formatter -> t list -> bool | |
890 | + | |
891 | +type 'a loc = { | |
892 | + txt : 'a; | |
893 | + loc : t; | |
894 | +} | |
895 | + | |
896 | +val mknoloc : 'a -> 'a loc | |
897 | +val mkloc : 'a -> t -> 'a loc | |
898 | + | |
899 | +val print: formatter -> t -> unit | |
900 | +val print_filename: formatter -> string -> unit | |
901 | + | |
902 | +val absolute_path: string -> string | |
903 | + | |
904 | +val show_filename: string -> string | |
905 | + (** In -absname mode, return the absolute path for this filename. | |
906 | + Otherwise, returns the filename unchanged. *) | |
907 | + | |
908 | + | |
909 | +val absname: bool ref | |
910 | + | |
911 | + | |
912 | +(* Support for located errors *) | |
913 | + | |
914 | +type error = | |
915 | + { | |
916 | + loc: t; | |
917 | + msg: string; | |
918 | + sub: error list; | |
919 | + if_highlight: string; (* alternative message if locations are highlighted *) | |
920 | + } | |
921 | + | |
922 | +exception Error of error | |
923 | + | |
924 | +val error: ?loc:t -> ?sub:error list -> ?if_highlight:string -> string -> error | |
925 | + | |
926 | +val errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string | |
927 | + -> ('a, unit, string, error) format4 -> 'a | |
928 | + | |
929 | +val raise_errorf: ?loc:t -> ?sub:error list -> ?if_highlight:string | |
930 | + -> ('a, unit, string, 'b) format4 -> 'a | |
931 | + | |
932 | +val error_of_printer: t -> (formatter -> 'a -> unit) -> 'a -> error | |
933 | + | |
934 | +val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error | |
935 | + | |
936 | +val error_of_exn: exn -> error option | |
937 | + | |
938 | +val register_error_of_exn: (exn -> error option) -> unit | |
939 | + (* Each compiler module which defines a custom type of exception | |
940 | + which can surface as a user-visible error should register | |
941 | + a "printer" for this exception using [register_error_of_exn]. | |
942 | + The result of the printer is an [error] value containing | |
943 | + a location, a message, and optionally sub-messages (each of them | |
944 | + being located as well). *) | |
945 | + | |
946 | +val report_error: formatter -> error -> unit | |
947 | + | |
948 | +val error_reporter : (formatter -> error -> unit) ref | |
949 | +(** Hook for intercepting error reports. *) | |
950 | + | |
951 | +val default_error_reporter : formatter -> error -> unit | |
952 | +(** Original error reporter for use in hooks. *) | |
953 | + | |
954 | +val report_exception: formatter -> exn -> unit | |
955 | + (* Reraise the exception if it is unknown. *) | |
956 | diff --git a/ocaml_stuff/4.02.2/parsing/longident.mli b/ocaml_stuff/4.02.2/parsing/longident.mli | |
957 | new file mode 100644 | |
958 | index 0000000..9e79585 | |
959 | --- /dev/null | |
960 | +++ b/ocaml_stuff/4.02.2/parsing/longident.mli | |
961 | @@ -0,0 +1,22 @@ | |
962 | +(***********************************************************************) | |
963 | +(* *) | |
964 | +(* OCaml *) | |
965 | +(* *) | |
966 | +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) | |
967 | +(* *) | |
968 | +(* Copyright 1996 Institut National de Recherche en Informatique et *) | |
969 | +(* en Automatique. All rights reserved. This file is distributed *) | |
970 | +(* under the terms of the Q Public License version 1.0. *) | |
971 | +(* *) | |
972 | +(***********************************************************************) | |
973 | + | |
974 | +(* Long identifiers, used in parsetree. *) | |
975 | + | |
976 | +type t = | |
977 | + Lident of string | |
978 | + | Ldot of t * string | |
979 | + | Lapply of t * t | |
980 | + | |
981 | +val flatten: t -> string list | |
982 | +val last: t -> string | |
983 | +val parse: string -> t | |
984 | diff --git a/ocaml_stuff/4.02.2/parsing/parsetree.mli b/ocaml_stuff/4.02.2/parsing/parsetree.mli | |
985 | new file mode 100644 | |
986 | index 0000000..295e3ea | |
987 | --- /dev/null | |
988 | +++ b/ocaml_stuff/4.02.2/parsing/parsetree.mli | |
989 | @@ -0,0 +1,829 @@ | |
990 | +(***********************************************************************) | |
991 | +(* *) | |
992 | +(* OCaml *) | |
993 | +(* *) | |
994 | +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) | |
995 | +(* *) | |
996 | +(* Copyright 1996 Institut National de Recherche en Informatique et *) | |
997 | +(* en Automatique. All rights reserved. This file is distributed *) | |
998 | +(* under the terms of the Q Public License version 1.0. *) | |
999 | +(* *) | |
1000 | +(***********************************************************************) | |
1001 | + | |
1002 | +(** Abstract syntax tree produced by parsing *) | |
1003 | + | |
1004 | +open Asttypes | |
1005 | + | |
1006 | +(** {2 Extension points} *) | |
1007 | + | |
1008 | +type attribute = string loc * payload | |
1009 | + (* [@id ARG] | |
1010 | + [@@id ARG] | |
1011 | + | |
1012 | + Metadata containers passed around within the AST. | |
1013 | + The compiler ignores unknown attributes. | |
1014 | + *) | |
1015 | + | |
1016 | +and extension = string loc * payload | |
1017 | + (* [%id ARG] | |
1018 | + [%%id ARG] | |
1019 | + | |
1020 | + Sub-language placeholder -- rejected by the typechecker. | |
1021 | + *) | |
1022 | + | |
1023 | +and attributes = attribute list | |
1024 | + | |
1025 | +and payload = | |
1026 | + | PStr of structure | |
1027 | + | PTyp of core_type (* : T *) | |
1028 | + | PPat of pattern * expression option (* ? P or ? P when E *) | |
1029 | + | |
1030 | +(** {2 Core language} *) | |
1031 | + | |
1032 | +(* Type expressions *) | |
1033 | + | |
1034 | +and core_type = | |
1035 | + { | |
1036 | + ptyp_desc: core_type_desc; | |
1037 | + ptyp_loc: Location.t; | |
1038 | + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) | |
1039 | + } | |
1040 | + | |
1041 | +and core_type_desc = | |
1042 | + | Ptyp_any | |
1043 | + (* _ *) | |
1044 | + | Ptyp_var of string | |
1045 | + (* 'a *) | |
1046 | + | Ptyp_arrow of label * core_type * core_type | |
1047 | + (* T1 -> T2 (label = "") | |
1048 | + ~l:T1 -> T2 (label = "l") | |
1049 | + ?l:T1 -> T2 (label = "?l") | |
1050 | + *) | |
1051 | + | Ptyp_tuple of core_type list | |
1052 | + (* T1 * ... * Tn | |
1053 | + | |
1054 | + Invariant: n >= 2 | |
1055 | + *) | |
1056 | + | Ptyp_constr of Longident.t loc * core_type list | |
1057 | + (* tconstr | |
1058 | + T tconstr | |
1059 | + (T1, ..., Tn) tconstr | |
1060 | + *) | |
1061 | + | Ptyp_object of (string * attributes * core_type) list * closed_flag | |
1062 | + (* < l1:T1; ...; ln:Tn > (flag = Closed) | |
1063 | + < l1:T1; ...; ln:Tn; .. > (flag = Open) | |
1064 | + *) | |
1065 | + | Ptyp_class of Longident.t loc * core_type list | |
1066 | + (* #tconstr | |
1067 | + T #tconstr | |
1068 | + (T1, ..., Tn) #tconstr | |
1069 | + *) | |
1070 | + | Ptyp_alias of core_type * string | |
1071 | + (* T as 'a *) | |
1072 | + | Ptyp_variant of row_field list * closed_flag * label list option | |
1073 | + (* [ `A|`B ] (flag = Closed; labels = None) | |
1074 | + [> `A|`B ] (flag = Open; labels = None) | |
1075 | + [< `A|`B ] (flag = Closed; labels = Some []) | |
1076 | + [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) | |
1077 | + *) | |
1078 | + | Ptyp_poly of string list * core_type | |
1079 | + (* 'a1 ... 'an. T | |
1080 | + | |
1081 | + Can only appear in the following context: | |
1082 | + | |
1083 | + - As the core_type of a Ppat_constraint node corresponding | |
1084 | + to a constraint on a let-binding: let x : 'a1 ... 'an. T | |
1085 | + = e ... | |
1086 | + | |
1087 | + - Under Cfk_virtual for methods (not values). | |
1088 | + | |
1089 | + - As the core_type of a Pctf_method node. | |
1090 | + | |
1091 | + - As the core_type of a Pexp_poly node. | |
1092 | + | |
1093 | + - As the pld_type field of a label_declaration. | |
1094 | + | |
1095 | + - As a core_type of a Ptyp_object node. | |
1096 | + *) | |
1097 | + | |
1098 | + | Ptyp_package of package_type | |
1099 | + (* (module S) *) | |
1100 | + | Ptyp_extension of extension | |
1101 | + (* [%id] *) | |
1102 | + | |
1103 | +and package_type = Longident.t loc * (Longident.t loc * core_type) list | |
1104 | + (* | |
1105 | + (module S) | |
1106 | + (module S with type t1 = T1 and ... and tn = Tn) | |
1107 | + *) | |
1108 | + | |
1109 | +and row_field = | |
1110 | + | Rtag of label * attributes * bool * core_type list | |
1111 | + (* [`A] ( true, [] ) | |
1112 | + [`A of T] ( false, [T] ) | |
1113 | + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) | |
1114 | + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) | |
1115 | + | |
1116 | + - The 2nd field is true if the tag contains a | |
1117 | + constant (empty) constructor. | |
1118 | + - '&' occurs when several types are used for the same constructor | |
1119 | + (see 4.2 in the manual) | |
1120 | + | |
1121 | + - TODO: switch to a record representation, and keep location | |
1122 | + *) | |
1123 | + | Rinherit of core_type | |
1124 | + (* [ T ] *) | |
1125 | + | |
1126 | +(* Patterns *) | |
1127 | + | |
1128 | +and pattern = | |
1129 | + { | |
1130 | + ppat_desc: pattern_desc; | |
1131 | + ppat_loc: Location.t; | |
1132 | + ppat_attributes: attributes; (* ... [@id1] [@id2] *) | |
1133 | + } | |
1134 | + | |
1135 | +and pattern_desc = | |
1136 | + | Ppat_any | |
1137 | + (* _ *) | |
1138 | + | Ppat_var of string loc | |
1139 | + (* x *) | |
1140 | + | Ppat_alias of pattern * string loc | |
1141 | + (* P as 'a *) | |
1142 | + | Ppat_constant of constant | |
1143 | + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | |
1144 | + | Ppat_interval of constant * constant | |
1145 | + (* 'a'..'z' | |
1146 | + | |
1147 | + Other forms of interval are recognized by the parser | |
1148 | + but rejected by the type-checker. *) | |
1149 | + | Ppat_tuple of pattern list | |
1150 | + (* (P1, ..., Pn) | |
1151 | + | |
1152 | + Invariant: n >= 2 | |
1153 | + *) | |
1154 | + | Ppat_construct of Longident.t loc * pattern option | |
1155 | + (* C None | |
1156 | + C P Some P | |
1157 | + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) | |
1158 | + *) | |
1159 | + | Ppat_variant of label * pattern option | |
1160 | + (* `A (None) | |
1161 | + `A P (Some P) | |
1162 | + *) | |
1163 | + | Ppat_record of (Longident.t loc * pattern) list * closed_flag | |
1164 | + (* { l1=P1; ...; ln=Pn } (flag = Closed) | |
1165 | + { l1=P1; ...; ln=Pn; _} (flag = Open) | |
1166 | + | |
1167 | + Invariant: n > 0 | |
1168 | + *) | |
1169 | + | Ppat_array of pattern list | |
1170 | + (* [| P1; ...; Pn |] *) | |
1171 | + | Ppat_or of pattern * pattern | |
1172 | + (* P1 | P2 *) | |
1173 | + | Ppat_constraint of pattern * core_type | |
1174 | + (* (P : T) *) | |
1175 | + | Ppat_type of Longident.t loc | |
1176 | + (* #tconst *) | |
1177 | + | Ppat_lazy of pattern | |
1178 | + (* lazy P *) | |
1179 | + | Ppat_unpack of string loc | |
1180 | + (* (module P) | |
1181 | + Note: (module P : S) is represented as | |
1182 | + Ppat_constraint(Ppat_unpack, Ptyp_package) | |
1183 | + *) | |
1184 | + | Ppat_exception of pattern | |
1185 | + (* exception P *) | |
1186 | + | Ppat_extension of extension | |
1187 | + (* [%id] *) | |
1188 | + | |
1189 | +(* Value expressions *) | |
1190 | + | |
1191 | +and expression = | |
1192 | + { | |
1193 | + pexp_desc: expression_desc; | |
1194 | + pexp_loc: Location.t; | |
1195 | + pexp_attributes: attributes; (* ... [@id1] [@id2] *) | |
1196 | + } | |
1197 | + | |
1198 | +and expression_desc = | |
1199 | + | Pexp_ident of Longident.t loc | |
1200 | + (* x | |
1201 | + M.x | |
1202 | + *) | |
1203 | + | Pexp_constant of constant | |
1204 | + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | |
1205 | + | Pexp_let of rec_flag * value_binding list * expression | |
1206 | + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) | |
1207 | + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) | |
1208 | + *) | |
1209 | + | Pexp_function of case list | |
1210 | + (* function P1 -> E1 | ... | Pn -> En *) | |
1211 | + | Pexp_fun of label * expression option * pattern * expression | |
1212 | + (* fun P -> E1 (lab = "", None) | |
1213 | + fun ~l:P -> E1 (lab = "l", None) | |
1214 | + fun ?l:P -> E1 (lab = "?l", None) | |
1215 | + fun ?l:(P = E0) -> E1 (lab = "?l", Some E0) | |
1216 | + | |
1217 | + Notes: | |
1218 | + - If E0 is provided, lab must start with '?'. | |
1219 | + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. | |
1220 | + - "let f P = E" is represented using Pexp_fun. | |
1221 | + *) | |
1222 | + | Pexp_apply of expression * (label * expression) list | |
1223 | + (* E0 ~l1:E1 ... ~ln:En | |
1224 | + li can be empty (non labeled argument) or start with '?' | |
1225 | + (optional argument). | |
1226 | + | |
1227 | + Invariant: n > 0 | |
1228 | + *) | |
1229 | + | Pexp_match of expression * case list | |
1230 | + (* match E0 with P1 -> E1 | ... | Pn -> En *) | |
1231 | + | Pexp_try of expression * case list | |
1232 | + (* try E0 with P1 -> E1 | ... | Pn -> En *) | |
1233 | + | Pexp_tuple of expression list | |
1234 | + (* (E1, ..., En) | |
1235 | + | |
1236 | + Invariant: n >= 2 | |
1237 | + *) | |
1238 | + | Pexp_construct of Longident.t loc * expression option | |
1239 | + (* C None | |
1240 | + C E Some E | |
1241 | + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) | |
1242 | + *) | |
1243 | + | Pexp_variant of label * expression option | |
1244 | + (* `A (None) | |
1245 | + `A E (Some E) | |
1246 | + *) | |
1247 | + | Pexp_record of (Longident.t loc * expression) list * expression option | |
1248 | + (* { l1=P1; ...; ln=Pn } (None) | |
1249 | + { E0 with l1=P1; ...; ln=Pn } (Some E0) | |
1250 | + | |
1251 | + Invariant: n > 0 | |
1252 | + *) | |
1253 | + | Pexp_field of expression * Longident.t loc | |
1254 | + (* E.l *) | |
1255 | + | Pexp_setfield of expression * Longident.t loc * expression | |
1256 | + (* E1.l <- E2 *) | |
1257 | + | Pexp_array of expression list | |
1258 | + (* [| E1; ...; En |] *) | |
1259 | + | Pexp_ifthenelse of expression * expression * expression option | |
1260 | + (* if E1 then E2 else E3 *) | |
1261 | + | Pexp_sequence of expression * expression | |
1262 | + (* E1; E2 *) | |
1263 | + | Pexp_while of expression * expression | |
1264 | + (* while E1 do E2 done *) | |
1265 | + | Pexp_for of | |
1266 | + pattern * expression * expression * direction_flag * expression | |
1267 | + (* for i = E1 to E2 do E3 done (flag = Upto) | |
1268 | + for i = E1 downto E2 do E3 done (flag = Downto) | |
1269 | + *) | |
1270 | + | Pexp_constraint of expression * core_type | |
1271 | + (* (E : T) *) | |
1272 | + | Pexp_coerce of expression * core_type option * core_type | |
1273 | + (* (E :> T) (None, T) | |
1274 | + (E : T0 :> T) (Some T0, T) | |
1275 | + *) | |
1276 | + | Pexp_send of expression * string | |
1277 | + (* E # m *) | |
1278 | + | Pexp_new of Longident.t loc | |
1279 | + (* new M.c *) | |
1280 | + | Pexp_setinstvar of string loc * expression | |
1281 | + (* x <- 2 *) | |
1282 | + | Pexp_override of (string loc * expression) list | |
1283 | + (* {< x1 = E1; ...; Xn = En >} *) | |
1284 | + | Pexp_letmodule of string loc * module_expr * expression | |
1285 | + (* let module M = ME in E *) | |
1286 | + | Pexp_assert of expression | |
1287 | + (* assert E | |
1288 | + Note: "assert false" is treated in a special way by the | |
1289 | + type-checker. *) | |
1290 | + | Pexp_lazy of expression | |
1291 | + (* lazy E *) | |
1292 | + | Pexp_poly of expression * core_type option | |
1293 | + (* Used for method bodies. | |
1294 | + | |
1295 | + Can only be used as the expression under Cfk_concrete | |
1296 | + for methods (not values). *) | |
1297 | + | Pexp_object of class_structure | |
1298 | + (* object ... end *) | |
1299 | + | Pexp_newtype of string * expression | |
1300 | + (* fun (type t) -> E *) | |
1301 | + | Pexp_pack of module_expr | |
1302 | + (* (module ME) | |
1303 | + | |
1304 | + (module ME : S) is represented as | |
1305 | + Pexp_constraint(Pexp_pack, Ptyp_package S) *) | |
1306 | + | Pexp_open of override_flag * Longident.t loc * expression | |
1307 | + (* let open M in E | |
1308 | + let! open M in E | |
1309 | + *) | |
1310 | + | Pexp_extension of extension | |
1311 | + (* [%id] *) | |
1312 | + | |
1313 | +and case = (* (P -> E) or (P when E0 -> E) *) | |
1314 | + { | |
1315 | + pc_lhs: pattern; | |
1316 | + pc_guard: expression option; | |
1317 | + pc_rhs: expression; | |
1318 | + } | |
1319 | + | |
1320 | +(* Value descriptions *) | |
1321 | + | |
1322 | +and value_description = | |
1323 | + { | |
1324 | + pval_name: string loc; | |
1325 | + pval_type: core_type; | |
1326 | + pval_prim: string list; | |
1327 | + pval_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1328 | + pval_loc: Location.t; | |
1329 | + } | |
1330 | + | |
1331 | +(* | |
1332 | + val x: T (prim = []) | |
1333 | + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) | |
1334 | + | |
1335 | + Note: when used under Pstr_primitive, prim cannot be empty | |
1336 | +*) | |
1337 | + | |
1338 | +(* Type declarations *) | |
1339 | + | |
1340 | +and type_declaration = | |
1341 | + { | |
1342 | + ptype_name: string loc; | |
1343 | + ptype_params: (core_type * variance) list; | |
1344 | + (* ('a1,...'an) t; None represents _*) | |
1345 | + ptype_cstrs: (core_type * core_type * Location.t) list; | |
1346 | + (* ... constraint T1=T1' ... constraint Tn=Tn' *) | |
1347 | + ptype_kind: type_kind; | |
1348 | + ptype_private: private_flag; (* = private ... *) | |
1349 | + ptype_manifest: core_type option; (* = T *) | |
1350 | + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1351 | + ptype_loc: Location.t; | |
1352 | + } | |
1353 | + | |
1354 | +(* | |
1355 | + type t (abstract, no manifest) | |
1356 | + type t = T0 (abstract, manifest=T0) | |
1357 | + type t = C of T | ... (variant, no manifest) | |
1358 | + type t = T0 = C of T | ... (variant, manifest=T0) | |
1359 | + type t = {l: T; ...} (record, no manifest) | |
1360 | + type t = T0 = {l : T; ...} (record, manifest=T0) | |
1361 | + type t = .. (open, no manifest) | |
1362 | +*) | |
1363 | + | |
1364 | +and type_kind = | |
1365 | + | Ptype_abstract | |
1366 | + | Ptype_variant of constructor_declaration list | |
1367 | + (* Invariant: non-empty list *) | |
1368 | + | Ptype_record of label_declaration list | |
1369 | + (* Invariant: non-empty list *) | |
1370 | + | Ptype_open | |
1371 | + | |
1372 | +and label_declaration = | |
1373 | + { | |
1374 | + pld_name: string loc; | |
1375 | + pld_mutable: mutable_flag; | |
1376 | + pld_type: core_type; | |
1377 | + pld_loc: Location.t; | |
1378 | + pld_attributes: attributes; (* l [@id1] [@id2] : T *) | |
1379 | + } | |
1380 | + | |
1381 | +(* { ...; l: T; ... } (mutable=Immutable) | |
1382 | + { ...; mutable l: T; ... } (mutable=Mutable) | |
1383 | + | |
1384 | + Note: T can be a Ptyp_poly. | |
1385 | +*) | |
1386 | + | |
1387 | +and constructor_declaration = | |
1388 | + { | |
1389 | + pcd_name: string loc; | |
1390 | + pcd_args: core_type list; | |
1391 | + pcd_res: core_type option; | |
1392 | + pcd_loc: Location.t; | |
1393 | + pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) | |
1394 | + } | |
1395 | +(* | |
1396 | + | C of T1 * ... * Tn (res = None) | |
1397 | + | C: T0 (args = [], res = Some T0) | |
1398 | + | C: T1 * ... * Tn -> T0 (res = Some T0) | |
1399 | +*) | |
1400 | + | |
1401 | +and type_extension = | |
1402 | + { | |
1403 | + ptyext_path: Longident.t loc; | |
1404 | + ptyext_params: (core_type * variance) list; | |
1405 | + ptyext_constructors: extension_constructor list; | |
1406 | + ptyext_private: private_flag; | |
1407 | + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1408 | + } | |
1409 | +(* | |
1410 | + type t += ... | |
1411 | +*) | |
1412 | + | |
1413 | +and extension_constructor = | |
1414 | + { | |
1415 | + pext_name: string loc; | |
1416 | + pext_kind : extension_constructor_kind; | |
1417 | + pext_loc : Location.t; | |
1418 | + pext_attributes: attributes; (* C [@id1] [@id2] of ... *) | |
1419 | + } | |
1420 | + | |
1421 | +and extension_constructor_kind = | |
1422 | + Pext_decl of core_type list * core_type option | |
1423 | + (* | |
1424 | + | C of T1 * ... * Tn ([T1; ...; Tn], None) | |
1425 | + | C: T0 ([], Some T0) | |
1426 | + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) | |
1427 | + *) | |
1428 | + | Pext_rebind of Longident.t loc | |
1429 | + (* | |
1430 | + | C = D | |
1431 | + *) | |
1432 | + | |
1433 | +(** {2 Class language} *) | |
1434 | + | |
1435 | +(* Type expressions for the class language *) | |
1436 | + | |
1437 | +and class_type = | |
1438 | + { | |
1439 | + pcty_desc: class_type_desc; | |
1440 | + pcty_loc: Location.t; | |
1441 | + pcty_attributes: attributes; (* ... [@id1] [@id2] *) | |
1442 | + } | |
1443 | + | |
1444 | +and class_type_desc = | |
1445 | + | Pcty_constr of Longident.t loc * core_type list | |
1446 | + (* c | |
1447 | + ['a1, ..., 'an] c *) | |
1448 | + | Pcty_signature of class_signature | |
1449 | + (* object ... end *) | |
1450 | + | Pcty_arrow of label * core_type * class_type | |
1451 | + (* T -> CT (label = "") | |
1452 | + ~l:T -> CT (label = "l") | |
1453 | + ?l:T -> CT (label = "?l") | |
1454 | + *) | |
1455 | + | Pcty_extension of extension | |
1456 | + (* [%id] *) | |
1457 | + | |
1458 | +and class_signature = | |
1459 | + { | |
1460 | + pcsig_self: core_type; | |
1461 | + pcsig_fields: class_type_field list; | |
1462 | + } | |
1463 | +(* object('selfpat) ... end | |
1464 | + object ... end (self = Ptyp_any) | |
1465 | + *) | |
1466 | + | |
1467 | +and class_type_field = | |
1468 | + { | |
1469 | + pctf_desc: class_type_field_desc; | |
1470 | + pctf_loc: Location.t; | |
1471 | + pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1472 | + } | |
1473 | + | |
1474 | +and class_type_field_desc = | |
1475 | + | Pctf_inherit of class_type | |
1476 | + (* inherit CT *) | |
1477 | + | Pctf_val of (string * mutable_flag * virtual_flag * core_type) | |
1478 | + (* val x: T *) | |
1479 | + | Pctf_method of (string * private_flag * virtual_flag * core_type) | |
1480 | + (* method x: T | |
1481 | + | |
1482 | + Note: T can be a Ptyp_poly. | |
1483 | + *) | |
1484 | + | Pctf_constraint of (core_type * core_type) | |
1485 | + (* constraint T1 = T2 *) | |
1486 | + | Pctf_attribute of attribute | |
1487 | + (* [@@@id] *) | |
1488 | + | Pctf_extension of extension | |
1489 | + (* [%%id] *) | |
1490 | + | |
1491 | +and 'a class_infos = | |
1492 | + { | |
1493 | + pci_virt: virtual_flag; | |
1494 | + pci_params: (core_type * variance) list; | |
1495 | + pci_name: string loc; | |
1496 | + pci_expr: 'a; | |
1497 | + pci_loc: Location.t; | |
1498 | + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1499 | + } | |
1500 | +(* class c = ... | |
1501 | + class ['a1,...,'an] c = ... | |
1502 | + class virtual c = ... | |
1503 | + | |
1504 | + Also used for "class type" declaration. | |
1505 | +*) | |
1506 | + | |
1507 | +and class_description = class_type class_infos | |
1508 | + | |
1509 | +and class_type_declaration = class_type class_infos | |
1510 | + | |
1511 | +(* Value expressions for the class language *) | |
1512 | + | |
1513 | +and class_expr = | |
1514 | + { | |
1515 | + pcl_desc: class_expr_desc; | |
1516 | + pcl_loc: Location.t; | |
1517 | + pcl_attributes: attributes; (* ... [@id1] [@id2] *) | |
1518 | + } | |
1519 | + | |
1520 | +and class_expr_desc = | |
1521 | + | Pcl_constr of Longident.t loc * core_type list | |
1522 | + (* c | |
1523 | + ['a1, ..., 'an] c *) | |
1524 | + | Pcl_structure of class_structure | |
1525 | + (* object ... end *) | |
1526 | + | Pcl_fun of label * expression option * pattern * class_expr | |
1527 | + (* fun P -> CE (lab = "", None) | |
1528 | + fun ~l:P -> CE (lab = "l", None) | |
1529 | + fun ?l:P -> CE (lab = "?l", None) | |
1530 | + fun ?l:(P = E0) -> CE (lab = "?l", Some E0) | |
1531 | + *) | |
1532 | + | Pcl_apply of class_expr * (label * expression) list | |
1533 | + (* CE ~l1:E1 ... ~ln:En | |
1534 | + li can be empty (non labeled argument) or start with '?' | |
1535 | + (optional argument). | |
1536 | + | |
1537 | + Invariant: n > 0 | |
1538 | + *) | |
1539 | + | Pcl_let of rec_flag * value_binding list * class_expr | |
1540 | + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) | |
1541 | + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) | |
1542 | + *) | |
1543 | + | Pcl_constraint of class_expr * class_type | |
1544 | + (* (CE : CT) *) | |
1545 | + | Pcl_extension of extension | |
1546 | + (* [%id] *) | |
1547 | + | |
1548 | +and class_structure = | |
1549 | + { | |
1550 | + pcstr_self: pattern; | |
1551 | + pcstr_fields: class_field list; | |
1552 | + } | |
1553 | +(* object(selfpat) ... end | |
1554 | + object ... end (self = Ppat_any) | |
1555 | + *) | |
1556 | + | |
1557 | +and class_field = | |
1558 | + { | |
1559 | + pcf_desc: class_field_desc; | |
1560 | + pcf_loc: Location.t; | |
1561 | + pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1562 | + } | |
1563 | + | |
1564 | +and class_field_desc = | |
1565 | + | Pcf_inherit of override_flag * class_expr * string option | |
1566 | + (* inherit CE | |
1567 | + inherit CE as x | |
1568 | + inherit! CE | |
1569 | + inherit! CE as x | |
1570 | + *) | |
1571 | + | Pcf_val of (string loc * mutable_flag * class_field_kind) | |
1572 | + (* val x = E | |
1573 | + val virtual x: T | |
1574 | + *) | |
1575 | + | Pcf_method of (string loc * private_flag * class_field_kind) | |
1576 | + (* method x = E (E can be a Pexp_poly) | |
1577 | + method virtual x: T (T can be a Ptyp_poly) | |
1578 | + *) | |
1579 | + | Pcf_constraint of (core_type * core_type) | |
1580 | + (* constraint T1 = T2 *) | |
1581 | + | Pcf_initializer of expression | |
1582 | + (* initializer E *) | |
1583 | + | Pcf_attribute of attribute | |
1584 | + (* [@@@id] *) | |
1585 | + | Pcf_extension of extension | |
1586 | + (* [%%id] *) | |
1587 | + | |
1588 | +and class_field_kind = | |
1589 | + | Cfk_virtual of core_type | |
1590 | + | Cfk_concrete of override_flag * expression | |
1591 | + | |
1592 | +and class_declaration = class_expr class_infos | |
1593 | + | |
1594 | +(** {2 Module language} *) | |
1595 | + | |
1596 | +(* Type expressions for the module language *) | |
1597 | + | |
1598 | +and module_type = | |
1599 | + { | |
1600 | + pmty_desc: module_type_desc; | |
1601 | + pmty_loc: Location.t; | |
1602 | + pmty_attributes: attributes; (* ... [@id1] [@id2] *) | |
1603 | + } | |
1604 | + | |
1605 | +and module_type_desc = | |
1606 | + | Pmty_ident of Longident.t loc | |
1607 | + (* S *) | |
1608 | + | Pmty_signature of signature | |
1609 | + (* sig ... end *) | |
1610 | + | Pmty_functor of string loc * module_type option * module_type | |
1611 | + (* functor(X : MT1) -> MT2 *) | |
1612 | + | Pmty_with of module_type * with_constraint list | |
1613 | + (* MT with ... *) | |
1614 | + | Pmty_typeof of module_expr | |
1615 | + (* module type of ME *) | |
1616 | + | Pmty_extension of extension | |
1617 | + (* [%id] *) | |
1618 | + | Pmty_alias of Longident.t loc | |
1619 | + (* (module M) *) | |
1620 | + | |
1621 | +and signature = signature_item list | |
1622 | + | |
1623 | +and signature_item = | |
1624 | + { | |
1625 | + psig_desc: signature_item_desc; | |
1626 | + psig_loc: Location.t; | |
1627 | + } | |
1628 | + | |
1629 | +and signature_item_desc = | |
1630 | + | Psig_value of value_description | |
1631 | + (* | |
1632 | + val x: T | |
1633 | + external x: T = "s1" ... "sn" | |
1634 | + *) | |
1635 | + | Psig_type of type_declaration list | |
1636 | + (* type t1 = ... and ... and tn = ... *) | |
1637 | + | Psig_typext of type_extension | |
1638 | + (* type t1 += ... *) | |
1639 | + | Psig_exception of extension_constructor | |
1640 | + (* exception C of T *) | |
1641 | + | Psig_module of module_declaration | |
1642 | + (* module X : MT *) | |
1643 | + | Psig_recmodule of module_declaration list | |
1644 | + (* module rec X1 : MT1 and ... and Xn : MTn *) | |
1645 | + | Psig_modtype of module_type_declaration | |
1646 | + (* module type S = MT | |
1647 | + module type S *) | |
1648 | + | Psig_open of open_description | |
1649 | + (* open X *) | |
1650 | + | Psig_include of include_description | |
1651 | + (* include MT *) | |
1652 | + | Psig_class of class_description list | |
1653 | + (* class c1 : ... and ... and cn : ... *) | |
1654 | + | Psig_class_type of class_type_declaration list | |
1655 | + (* class type ct1 = ... and ... and ctn = ... *) | |
1656 | + | Psig_attribute of attribute | |
1657 | + (* [@@@id] *) | |
1658 | + | Psig_extension of extension * attributes | |
1659 | + (* [%%id] *) | |
1660 | + | |
1661 | +and module_declaration = | |
1662 | + { | |
1663 | + pmd_name: string loc; | |
1664 | + pmd_type: module_type; | |
1665 | + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1666 | + pmd_loc: Location.t; | |
1667 | + } | |
1668 | +(* S : MT *) | |
1669 | + | |
1670 | +and module_type_declaration = | |
1671 | + { | |
1672 | + pmtd_name: string loc; | |
1673 | + pmtd_type: module_type option; | |
1674 | + pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) | |
1675 | + pmtd_loc: Location.t; | |
1676 | + } | |
1677 | +(* S = MT | |
1678 | + S (abstract module type declaration, pmtd_type = None) | |
1679 | +*) | |
1680 | + | |
1681 | +and open_description = | |
1682 | + { | |
1683 | + popen_lid: Longident.t loc; | |
1684 | + popen_override: override_flag; | |
1685 | + popen_loc: Location.t; | |
1686 | + popen_attributes: attributes; | |
1687 | + } | |
1688 | +(* open! X - popen_override = Override (silences the 'used identifier | |
1689 | + shadowing' warning) | |
1690 | + open X - popen_override = Fresh | |
1691 | + *) | |
1692 | + | |
1693 | +and 'a include_infos = | |
1694 | + { | |
1695 | + pincl_mod: 'a; | |
1696 | + pincl_loc: Location.t; | |
1697 | + pincl_attributes: attributes; | |
1698 | + } | |
1699 | + | |
1700 | +and include_description = module_type include_infos | |
1701 | +(* include MT *) | |
1702 | + | |
1703 | +and include_declaration = module_expr include_infos | |
1704 | +(* include ME *) | |
1705 | + | |
1706 | +and with_constraint = | |
1707 | + | Pwith_type of Longident.t loc * type_declaration | |
1708 | + (* with type X.t = ... | |
1709 | + | |
1710 | + Note: the last component of the longident must match | |
1711 | + the name of the type_declaration. *) | |
1712 | + | Pwith_module of Longident.t loc * Longident.t loc | |
1713 | + (* with module X.Y = Z *) | |
1714 | + | Pwith_typesubst of type_declaration | |
1715 | + (* with type t := ... *) | |
1716 | + | Pwith_modsubst of string loc * Longident.t loc | |
1717 | + (* with module X := Z *) | |
1718 | + | |
1719 | +(* Value expressions for the module language *) | |
1720 | + | |
1721 | +and module_expr = | |
1722 | + { | |
1723 | + pmod_desc: module_expr_desc; | |
1724 | + pmod_loc: Location.t; | |
1725 | + pmod_attributes: attributes; (* ... [@id1] [@id2] *) | |
1726 | + } | |
1727 | + | |
1728 | +and module_expr_desc = | |
1729 | + | Pmod_ident of Longident.t loc | |
1730 | + (* X *) | |
1731 | + | Pmod_structure of structure | |
1732 | + (* struct ... end *) | |
1733 | + | Pmod_functor of string loc * module_type option * module_expr | |
1734 | + (* functor(X : MT1) -> ME *) | |
1735 | + | Pmod_apply of module_expr * module_expr | |
1736 | + (* ME1(ME2) *) | |
1737 | + | Pmod_constraint of module_expr * module_type | |
1738 | + (* (ME : MT) *) | |
1739 | + | Pmod_unpack of expression | |
1740 | + (* (val E) *) | |
1741 | + | Pmod_extension of extension | |
1742 | + (* [%id] *) | |
1743 | + | |
1744 | +and structure = structure_item list | |
1745 | + | |
1746 | +and structure_item = | |
1747 | + { | |
1748 | + pstr_desc: structure_item_desc; | |
1749 | + pstr_loc: Location.t; | |
1750 | + } | |
1751 | + | |
1752 | +and structure_item_desc = | |
1753 | + | Pstr_eval of expression * attributes | |
1754 | + (* E *) | |
1755 | + | Pstr_value of rec_flag * value_binding list | |
1756 | + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) | |
1757 | + let rec P1 = E1 and ... and Pn = EN (flag = Recursive) | |
1758 | + *) | |
1759 | + | Pstr_primitive of value_description | |
1760 | + (* external x: T = "s1" ... "sn" *) | |
1761 | + | Pstr_type of type_declaration list | |
1762 | + (* type t1 = ... and ... and tn = ... *) | |
1763 | + | Pstr_typext of type_extension | |
1764 | + (* type t1 += ... *) | |
1765 | + | Pstr_exception of extension_constructor | |
1766 | + (* exception C of T | |
1767 | + exception C = M.X *) | |
1768 | + | Pstr_module of module_binding | |
1769 | + (* module X = ME *) | |
1770 | + | Pstr_recmodule of module_binding list | |
1771 | + (* module rec X1 = ME1 and ... and Xn = MEn *) | |
1772 | + | Pstr_modtype of module_type_declaration | |
1773 | + (* module type S = MT *) | |
1774 | + | Pstr_open of open_description | |
1775 | + (* open X *) | |
1776 | + | Pstr_class of class_declaration list | |
1777 | + (* class c1 = ... and ... and cn = ... *) | |
1778 | + | Pstr_class_type of class_type_declaration list | |
1779 | + (* class type ct1 = ... and ... and ctn = ... *) | |
1780 | + | Pstr_include of include_declaration | |
1781 | + (* include ME *) | |
1782 | + | Pstr_attribute of attribute | |
1783 | + (* [@@@id] *) | |
1784 | + | Pstr_extension of extension * attributes | |
1785 | + (* [%%id] *) | |
1786 | + | |
1787 | +and value_binding = | |
1788 | + { | |
1789 | + pvb_pat: pattern; | |
1790 | + pvb_expr: expression; | |
1791 | + pvb_attributes: attributes; | |
1792 | + pvb_loc: Location.t; | |
1793 | + } | |
1794 | + | |
1795 | +and module_binding = | |
1796 | + { | |
1797 | + pmb_name: string loc; | |
1798 | + pmb_expr: module_expr; | |
1799 | + pmb_attributes: attributes; | |
1800 | + pmb_loc: Location.t; | |
1801 | + } | |
1802 | +(* X = ME *) | |
1803 | + | |
1804 | +(** {2 Toplevel} *) | |
1805 | + | |
1806 | +(* Toplevel phrases *) | |
1807 | + | |
1808 | +type toplevel_phrase = | |
1809 | + | Ptop_def of structure | |
1810 | + | Ptop_dir of string * directive_argument | |
1811 | + (* #use, #load ... *) | |
1812 | + | |
1813 | +and directive_argument = | |
1814 | + | Pdir_none | |
1815 | + | Pdir_string of string | |
1816 | + | Pdir_int of int | |
1817 | + | Pdir_ident of Longident.t | |
1818 | + | Pdir_bool of bool | |
1819 | diff --git a/ocaml_stuff/4.02.2/utils/.depend b/ocaml_stuff/4.02.2/utils/.depend | |
1820 | new file mode 100644 | |
1821 | index 0000000..b261ffe | |
1822 | --- /dev/null | |
1823 | +++ b/ocaml_stuff/4.02.2/utils/.depend | |
1824 | @@ -0,0 +1,2 @@ | |
1825 | +pconfig.cmo: pconfig.cmi | |
1826 | +pconfig.cmx: pconfig.cmi | |
1827 | diff --git a/ocaml_stuff/4.02.2/utils/.gitignore b/ocaml_stuff/4.02.2/utils/.gitignore | |
1828 | new file mode 100644 | |
1829 | index 0000000..23e90de | |
1830 | --- /dev/null | |
1831 | +++ b/ocaml_stuff/4.02.2/utils/.gitignore | |
1832 | @@ -0,0 +1 @@ | |
1833 | +*.cm[oix] | |
1834 | diff --git a/ocaml_stuff/4.02.2/utils/Makefile b/ocaml_stuff/4.02.2/utils/Makefile | |
1835 | new file mode 100644 | |
1836 | index 0000000..f4ea281 | |
1837 | --- /dev/null | |
1838 | +++ b/ocaml_stuff/4.02.2/utils/Makefile | |
1839 | @@ -0,0 +1,27 @@ | |
1840 | +# Makefile,v | |
1841 | + | |
1842 | +FILES=warnings.cmi pconfig.cmo | |
1843 | +INCL= | |
1844 | + | |
1845 | +all: $(FILES) | |
1846 | + | |
1847 | +opt: pconfig.cmx | |
1848 | + | |
1849 | +clean: | |
1850 | + rm -f *.cm[oix] *.o | |
1851 | + | |
1852 | +depend: | |
1853 | + ocamldep $(INCL) *.ml* | sed -e 's/ *$$//' > .depend | |
1854 | + | |
1855 | +.SUFFIXES: .mli .cmi .ml .cmo .cmx | |
1856 | + | |
1857 | +.mli.cmi: | |
1858 | + $(OCAMLN)c $(INCL) -c $< | |
1859 | + | |
1860 | +.ml.cmo: | |
1861 | + $(OCAMLN)c $(INCL) -c $< | |
1862 | + | |
1863 | +.ml.cmx: | |
1864 | + $(OCAMLN)opt $(INCL) -c $< | |
1865 | + | |
1866 | +include .depend | |
1867 | diff --git a/ocaml_stuff/4.02.2/utils/pconfig.ml b/ocaml_stuff/4.02.2/utils/pconfig.ml | |
1868 | new file mode 100644 | |
1869 | index 0000000..e35511d | |
1870 | --- /dev/null | |
1871 | +++ b/ocaml_stuff/4.02.2/utils/pconfig.ml | |
1872 | @@ -0,0 +1,4 @@ | |
1873 | +let ocaml_version = "4.02.2" | |
1874 | +let ocaml_name = "ocaml" | |
1875 | +let ast_impl_magic_number = "Caml1999M016" | |
1876 | +let ast_intf_magic_number = "Caml1999N015" | |
1877 | diff --git a/ocaml_stuff/4.02.2/utils/pconfig.mli b/ocaml_stuff/4.02.2/utils/pconfig.mli | |
1878 | new file mode 100644 | |
1879 | index 0000000..f6382d3 | |
1880 | --- /dev/null | |
1881 | +++ b/ocaml_stuff/4.02.2/utils/pconfig.mli | |
1882 | @@ -0,0 +1,4 @@ | |
1883 | +val ocaml_version : string | |
1884 | +val ocaml_name : string | |
1885 | +val ast_impl_magic_number : string | |
1886 | +val ast_intf_magic_number : string | |
1887 | diff --git a/ocaml_stuff/4.02.2/utils/warnings.mli b/ocaml_stuff/4.02.2/utils/warnings.mli | |
1888 | new file mode 100644 | |
1889 | index 0000000..ffd943f | |
1890 | --- /dev/null | |
1891 | +++ b/ocaml_stuff/4.02.2/utils/warnings.mli | |
1892 | @@ -0,0 +1,86 @@ | |
1893 | +(***********************************************************************) | |
1894 | +(* *) | |
1895 | +(* OCaml *) | |
1896 | +(* *) | |
1897 | +(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *) | |
1898 | +(* *) | |
1899 | +(* Copyright 1998 Institut National de Recherche en Informatique et *) | |
1900 | +(* en Automatique. All rights reserved. This file is distributed *) | |
1901 | +(* under the terms of the Q Public License version 1.0. *) | |
1902 | +(* *) | |
1903 | +(***********************************************************************) | |
1904 | + | |
1905 | +open Format | |
1906 | + | |
1907 | +type t = | |
1908 | + | Comment_start (* 1 *) | |
1909 | + | Comment_not_end (* 2 *) | |
1910 | + | Deprecated of string (* 3 *) | |
1911 | + | Fragile_match of string (* 4 *) | |
1912 | + | Partial_application (* 5 *) | |
1913 | + | Labels_omitted (* 6 *) | |
1914 | + | Method_override of string list (* 7 *) | |
1915 | + | Partial_match of string (* 8 *) | |
1916 | + | Non_closed_record_pattern of string (* 9 *) | |
1917 | + | Statement_type (* 10 *) | |
1918 | + | Unused_match (* 11 *) | |
1919 | + | Unused_pat (* 12 *) | |
1920 | + | Instance_variable_override of string list (* 13 *) | |
1921 | + | Illegal_backslash (* 14 *) | |
1922 | + | Implicit_public_methods of string list (* 15 *) | |
1923 | + | Unerasable_optional_argument (* 16 *) | |
1924 | + | Undeclared_virtual_method of string (* 17 *) | |
1925 | + | Not_principal of string (* 18 *) | |
1926 | + | Without_principality of string (* 19 *) | |
1927 | + | Unused_argument (* 20 *) | |
1928 | + | Nonreturning_statement (* 21 *) | |
1929 | + | Preprocessor of string (* 22 *) | |
1930 | + | Useless_record_with (* 23 *) | |
1931 | + | Bad_module_name of string (* 24 *) | |
1932 | + | All_clauses_guarded (* 25 *) | |
1933 | + | Unused_var of string (* 26 *) | |
1934 | + | Unused_var_strict of string (* 27 *) | |
1935 | + | Wildcard_arg_to_constant_constr (* 28 *) | |
1936 | + | Eol_in_string (* 29 *) | |
1937 | + | Duplicate_definitions of string * string * string * string (* 30 *) | |
1938 | + | Multiple_definition of string * string * string (* 31 *) | |
1939 | + | Unused_value_declaration of string (* 32 *) | |
1940 | + | Unused_open of string (* 33 *) | |
1941 | + | Unused_type_declaration of string (* 34 *) | |
1942 | + | Unused_for_index of string (* 35 *) | |
1943 | + | Unused_ancestor of string (* 36 *) | |
1944 | + | Unused_constructor of string * bool * bool (* 37 *) | |
1945 | + | Unused_extension of string * bool * bool (* 38 *) | |
1946 | + | Unused_rec_flag (* 39 *) | |
1947 | + | Name_out_of_scope of string * string list * bool (* 40 *) | |
1948 | + | Ambiguous_name of string list * string list * bool (* 41 *) | |
1949 | + | Disambiguated_name of string (* 42 *) | |
1950 | + | Nonoptional_label of string (* 43 *) | |
1951 | + | Open_shadow_identifier of string * string (* 44 *) | |
1952 | + | Open_shadow_label_constructor of string * string (* 45 *) | |
1953 | + | Bad_env_variable of string * string (* 46 *) | |
1954 | + | Attribute_payload of string * string (* 47 *) | |
1955 | + | Eliminated_optional_arguments of string list (* 48 *) | |
1956 | + | No_cmi_file of string (* 49 *) | |
1957 | + | Bad_docstring of bool (* 50 *) | |
1958 | +;; | |
1959 | + | |
1960 | +val parse_options : bool -> string -> unit;; | |
1961 | + | |
1962 | +val is_active : t -> bool;; | |
1963 | +val is_error : t -> bool;; | |
1964 | + | |
1965 | +val defaults_w : string;; | |
1966 | +val defaults_warn_error : string;; | |
1967 | + | |
1968 | +val print : formatter -> t -> unit;; | |
1969 | + | |
1970 | +exception Errors of int;; | |
1971 | + | |
1972 | +val check_fatal : unit -> unit;; | |
1973 | + | |
1974 | +val help_warnings: unit -> unit | |
1975 | + | |
1976 | +type state | |
1977 | +val backup: unit -> state | |
1978 | +val restore: state -> unit | |
1979 | -- | |
1980 | 2.4.6 | |
1981 |