ocaml-4.02.2.patch

   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