diff -Nru camlp5-8.00.03/CHANGES camlp5-8.00.04/CHANGES --- camlp5-8.00.03/CHANGES 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/CHANGES 2022-12-05 20:34:55.000000000 +0000 @@ -1,4 +1,10 @@ +Camlp5 Version 8.00.04: +-------------------- + +* [02 Dec 2022] (exceedingly modest) updates to support OCaml 5.0.0~beta2: + basically just changes to Makefile and opam + Camlp5 Version 8.00.03: -------------------- diff -Nru camlp5-8.00.03/debian/changelog camlp5-8.00.04/debian/changelog --- camlp5-8.00.03/debian/changelog 2022-03-03 10:12:46.000000000 +0000 +++ camlp5-8.00.04/debian/changelog 2023-01-20 11:45:20.000000000 +0000 @@ -1,3 +1,13 @@ +camlp5 (8.00.04-1) unstable; urgency=medium + + [ Stéphane Glondu ] + * New upstream release + + [ Debian Janitor ] + * Set upstream metadata fields + + -- Stéphane Glondu Fri, 20 Jan 2023 12:45:20 +0100 + camlp5 (8.00.03-1) unstable; urgency=medium * New upstream release diff -Nru camlp5-8.00.03/debian/upstream/metadata camlp5-8.00.04/debian/upstream/metadata --- camlp5-8.00.03/debian/upstream/metadata 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/debian/upstream/metadata 2023-01-20 11:45:20.000000000 +0000 @@ -0,0 +1,3 @@ +--- +Bug-Database: https://github.com/camlp5/camlp5/issues +Bug-Submit: https://github.com/camlp5/camlp5/issues/new diff -Nru camlp5-8.00.03/etc/META.pl camlp5-8.00.04/etc/META.pl --- camlp5-8.00.03/etc/META.pl 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/etc/META.pl 2022-12-05 20:34:55.000000000 +0000 @@ -9,6 +9,7 @@ } else { $requires .= ",camlp-streams" ; + $streams_requires = "camlp-streams" } print <<"EOF"; @@ -487,4 +488,10 @@ archive(byte,toploop) = "camlp5_top.cma" ) + +package "streams" ( + requires = "${streams_requires}" + description = "proxy package for Streams so users don't need to know whether it's provided by ocaml or camlp-streams" +) + EOF diff -Nru camlp5-8.00.03/etc/pr_o.ml camlp5-8.00.04/etc/pr_o.ml --- camlp5-8.00.03/etc/pr_o.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/etc/pr_o.ml 2022-12-05 20:34:55.000000000 +0000 @@ -584,7 +584,8 @@ in let asgn = if Pcaml.unvala is_decl then "=" else ":=" in match te with - [ <:ctyp:< '$s$ >> when not (mem_tvar s (Pcaml.unvala tp)) && Pcaml.unvala cl = [] -> + [ <:ctyp:< '$s$ >> when not (mem_tvar s (Pcaml.unvala tp)) + && not (List.exists (fun [ (t1, t2) -> Ast2pt.ctyp_mentions s t1 || Ast2pt.ctyp_mentions s t2 ]) (Pcaml.unvala cl)) -> pprintf pc "%p%p%p%p" type_params (loc, Pcaml.unvala tp) var_escaped (loc, Pcaml.unvala tn) (hlist type_constraint) (Pcaml.unvala cl) diff -Nru camlp5-8.00.03/lib/ploc.ml camlp5-8.00.04/lib/ploc.ml --- camlp5-8.00.03/lib/ploc.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/lib/ploc.ml 2022-12-05 20:34:55.000000000 +0000 @@ -64,6 +64,9 @@ {(loc) with bp = loc.ep + sh; ep = loc.ep + sh + len} ; value with_comment loc comm = {(loc) with comm = comm}; +value with_comment_last loc ecomm = {(loc) with ecomm = ecomm}; +value with_line_nb_last loc n = {(loc) with line_nb_last = n}; +value with_bol_pos_last loc n = {(loc) with bol_pos_last = n}; value name = ref "loc"; diff -Nru camlp5-8.00.03/lib/ploc.mli camlp5-8.00.04/lib/ploc.mli --- camlp5-8.00.03/lib/ploc.mli 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/lib/ploc.mli 2022-12-05 20:34:55.000000000 +0000 @@ -84,6 +84,9 @@ [len]. *) value with_comment : t -> string -> t; (** Change the comment part of the given location *) +value with_comment_last : t -> string -> t; +value with_line_nb_last : t -> int -> t; +value with_bol_pos_last : t -> int -> t; (* miscellaneous *) diff -Nru camlp5-8.00.03/main/ast2pt.ml camlp5-8.00.04/main/ast2pt.ml --- camlp5-8.00.03/main/ast2pt.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/main/ast2pt.ml 2022-12-05 20:34:55.000000000 +0000 @@ -386,6 +386,17 @@ | p → error (MLast.loc_of_patt p) "label_of_patt; case not impl" ] ; +value ctyp_mentions s cty = + let rec crec = fun [ + <:ctyp< '$s2$ >> -> s = s2 + | <:ctyp< $t1$ $t2$ >> -> crec t1 || crec t2 + | <:ctyp< $t1$ -> $t2$ >> -> crec t1 || crec t2 + | <:ctyp< ($list:tl$) >> -> List.exists crec tl + | _ -> False + ] in + crec cty +; + value rec type_decl_of_with_type loc tn tpl pf ct = let (params, variance) = List.split (uv tpl) in let params = List.map uv params in @@ -610,7 +621,7 @@ let li = module_type_long_id mt in ocaml_package_type li with_con -and type_decl ?{item_attributes=[]} tn tl priv cl = +and type_decl ?{item_attributes=[]} tn tl priv (cl,tdCon) = fun [ TyMan loc t pf <:ctyp< { $list:ltl$ } >> → let priv = if uv pf then Private else Public in @@ -632,7 +643,7 @@ | t → let m = match t with - [ <:ctyp< '$s$ >> when cl = [] → + [ <:ctyp< '$s$ >> when not (List.exists (fun [ (t1, t2) -> ctyp_mentions s t1 || ctyp_mentions s t2 ]) tdCon) → if List.exists (fun (t, _) → Some s = uv t) tl then Some (ctyp t) else None | _ → Some (ctyp t) ] @@ -1233,7 +1244,7 @@ (uv td.tdCon) in let tn = uv (snd (uv td.tdNam)) in - (tn, type_decl ~{item_attributes=uv_item_attributes td.tdAttributes} tn (uv td.tdPrm) priv cl td.tdDef) + (tn, type_decl ~{item_attributes=uv_item_attributes td.tdAttributes} tn (uv td.tdPrm) priv (cl,uv td.tdCon) td.tdDef) and module_type = fun [ MtAtt loc e a -> diff -Nru camlp5-8.00.03/main/ast2pt.mli camlp5-8.00.04/main/ast2pt.mli --- camlp5-8.00.03/main/ast2pt.mli 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/main/ast2pt.mli 2022-12-05 20:34:55.000000000 +0000 @@ -18,6 +18,7 @@ (** Convert a Camlp5 location into an OCaml location. *) value fast : ref bool; (** Flag to generate fast (unsafe) access to arrays. Default: False. *) +value ctyp_mentions : string -> MLast.ctyp -> bool ; value ctyp : MLast.ctyp -> Parsetree.core_type ; value expr : MLast.expr -> Parsetree.expression ; value patt : MLast.patt -> Parsetree.pattern ; diff -Nru camlp5-8.00.03/main/pcaml.ml camlp5-8.00.04/main/pcaml.ml --- camlp5-8.00.03/main/pcaml.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/main/pcaml.ml 2022-12-05 20:34:55.000000000 +0000 @@ -7,7 +7,7 @@ open Printf; -value version = "8.00.03"; +value version = "8.00.04"; value syntax_name = ref ""; value ocaml_version = diff -Nru camlp5-8.00.03/ocaml_src/lib/ploc.ml camlp5-8.00.04/ocaml_src/lib/ploc.ml --- camlp5-8.00.03/ocaml_src/lib/ploc.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/lib/ploc.ml 2022-12-05 20:34:55.000000000 +0000 @@ -59,6 +59,9 @@ let sub loc sh len = {loc with bp = loc.bp + sh; ep = loc.bp + sh + len};; let after loc sh len = {loc with bp = loc.ep + sh; ep = loc.ep + sh + len};; let with_comment loc comm = {loc with comm = comm};; +let with_comment_last loc ecomm = {loc with ecomm = ecomm};; +let with_line_nb_last loc n = {loc with line_nb_last = n};; +let with_bol_pos_last loc n = {loc with bol_pos_last = n};; let name = ref "loc";; diff -Nru camlp5-8.00.03/ocaml_src/lib/ploc.mli camlp5-8.00.04/ocaml_src/lib/ploc.mli --- camlp5-8.00.03/ocaml_src/lib/ploc.mli 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/lib/ploc.mli 2022-12-05 20:34:55.000000000 +0000 @@ -84,6 +84,9 @@ [len]. *) val with_comment : t -> string -> t;; (** Change the comment part of the given location *) +val with_comment_last : t -> string -> t;; +val with_line_nb_last : t -> int -> t;; +val with_bol_pos_last : t -> int -> t;; (* miscellaneous *) diff -Nru camlp5-8.00.03/ocaml_src/lib/versdep/5.0.0.ml camlp5-8.00.04/ocaml_src/lib/versdep/5.0.0.ml --- camlp5-8.00.03/ocaml_src/lib/versdep/5.0.0.ml 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/lib/versdep/5.0.0.ml 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,1051 @@ +(* camlp5r pa_macro.cmo *) +(* versdep.ml,v *) +(* Copyright (c) INRIA 2007-2017 *) + +open Parsetree;; +open Longident;; +open Asttypes;; + +type ('a, 'b) choice = + Left of 'a + | Right of 'b +;; + +let option_map f x = + match x with + Some x -> Some (f x) + | None -> None +;; +let mustSome symbol = + function + Some x -> x + | None -> failwith ("Some: " ^ symbol) +;; + +let mustLeft symbol = + function + Left x -> x + | Right _ -> failwith ("choice: " ^ symbol) +;; + +let mustRight symbol = + function + Left _ -> failwith ("choice: " ^ symbol) + | Right x -> x +;; + +let ocaml_name = "ocaml";; + +let sys_ocaml_version = Sys.ocaml_version;; + +let to_ghost_loc loc = {loc with Location.loc_ghost = true};; + +let ocaml_location (fname, lnum, bolp, lnuml, bolpl, bp, ep) = + let loc_at n lnum bolp = + {Lexing.pos_fname = if lnum = -1 then "" else fname; + Lexing.pos_lnum = lnum; Lexing.pos_bol = bolp; Lexing.pos_cnum = n} + in + {Location.loc_start = loc_at bp lnum bolp; + Location.loc_end = loc_at ep lnuml bolpl; + Location.loc_ghost = bp = 0 && ep = 0} +;; + +let loc_none = + let loc = + {Lexing.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; pos_cnum = -1} + in + {Location.loc_start = loc; Location.loc_end = loc; + Location.loc_ghost = true} +;; + +let mkloc loc txt = {Location.txt = txt; loc = loc};; +let mknoloc txt = mkloc loc_none txt;; + +let ocaml_id_or_li_of_string_list loc sl = + let mkli s = + let rec loop f = + function + i :: il -> loop (fun s -> Ldot (f i, s)) il + | [] -> f s + in + loop (fun s -> Lident s) + in + match List.rev sl with + [] -> None + | s :: sl -> Some (mkli s (List.rev sl)) +;; + +let not_extended_longident = + let rec not_extended = + function + Lident _ -> true + | Ldot (li, _) -> not_extended li + | Lapply (_, _) -> false + in + not_extended +;; + +let list_map_check f l = + let rec loop rev_l = + function + x :: l -> + begin match f x with + Some s -> loop (s :: rev_l) l + | None -> None + end + | [] -> Some (List.rev rev_l) + in + loop [] l +;; + +let split_on_char = String.split_on_char;; + +let labelled lab = + if lab = "" then Nolabel + else if lab.[0] = '?' then + Optional (String.sub lab 1 (String.length lab - 1)) + else Labelled lab +;; + +(* *) + +let ocaml_value_description ?(item_attributes = []) vn t p = + {pval_type = t; pval_prim = p; pval_loc = t.ptyp_loc; + pval_name = mkloc t.ptyp_loc vn; pval_attributes = item_attributes} +;; + +let ocaml_class_type_field ?(item_attributes = []) loc ctfd = + {pctf_desc = ctfd; pctf_loc = loc; pctf_attributes = item_attributes} +;; + +let ocaml_class_field ?(item_attributes = []) loc cfd = + {pcf_desc = cfd; pcf_loc = loc; pcf_attributes = item_attributes} +;; + +let ocaml_mktyp ?(alg_attributes = []) loc x = + {ptyp_desc = x; ptyp_loc = loc; ptyp_loc_stack = []; + ptyp_attributes = alg_attributes} +;; +let ocaml_mkpat loc x = + {ppat_desc = x; ppat_loc = loc; ppat_loc_stack = []; ppat_attributes = []} +;; + +let ocaml_attribute_implem loc (nameloc, name) sl = + Parsetree. + {attr_name = mkloc nameloc name; attr_payload = PStr sl; attr_loc = loc} +;; +let ocaml_attribute_interf loc (nameloc, name) si = + Parsetree. + {attr_name = mkloc nameloc name; attr_payload = PSig si; attr_loc = loc} +;; +let ocaml_attribute_type loc (nameloc, name) ty = + Parsetree. + {attr_name = mkloc nameloc name; attr_payload = PTyp ty; attr_loc = loc} +;; +let ocaml_attribute_patt loc (nameloc, name) p eopt = + Parsetree. + {attr_name = mkloc nameloc name; attr_payload = PPat (p, eopt); + attr_loc = loc} +;; +let ocaml_expr_addattr attr + {pexp_desc = pexp_desc; pexp_loc = pexp_loc; + pexp_loc_stack = pexp_loc_stack; pexp_attributes = pexp_attributes} = + {pexp_desc = pexp_desc; pexp_loc = pexp_loc; + pexp_loc_stack = pexp_loc_stack; + pexp_attributes = pexp_attributes @ [attr]} +;; +let ocaml_coretype_addattr attr + {ptyp_desc = ptyp_desc; ptyp_loc = ptyp_loc; + ptyp_loc_stack = ptyp_loc_stack; ptyp_attributes = ptyp_attributes} = + {ptyp_desc = ptyp_desc; ptyp_loc = ptyp_loc; + ptyp_loc_stack = ptyp_loc_stack; + ptyp_attributes = ptyp_attributes @ [attr]} +;; +let ocaml_patt_addattr attr + {ppat_desc = ppat_desc; ppat_loc = ppat_loc; + ppat_loc_stack = ppat_loc_stack; ppat_attributes = ppat_attributes} = + {ppat_desc = ppat_desc; ppat_loc = ppat_loc; + ppat_loc_stack = ppat_loc_stack; + ppat_attributes = ppat_attributes @ [attr]} +;; +let ocaml_pmty_addattr attr + {pmty_desc = pmty_desc; pmty_loc = pmty_loc; + pmty_attributes = pmty_attributes} = + {pmty_desc = pmty_desc; pmty_loc = pmty_loc; + pmty_attributes = pmty_attributes @ [attr]} +;; +let ocaml_pmod_addattr attr + {pmod_desc = module_expr_desc; pmod_loc = pmod_loc; + pmod_attributes = pmod_attributes} = + {pmod_desc = module_expr_desc; pmod_loc = pmod_loc; + pmod_attributes = pmod_attributes @ [attr]} +;; +let ocaml_pcty_addattr attr + {pcty_desc = pcty_desc; pcty_loc = pcty_loc; + pcty_attributes = pcty_attributes} = + {pcty_desc = pcty_desc; pcty_loc = pcty_loc; + pcty_attributes = pcty_attributes @ [attr]} +;; +let ocaml_pcl_addattrs attrs + {pcl_desc = pcl_desc; pcl_loc = pcl_loc; + pcl_attributes = pcl_attributes} = + {pcl_desc = pcl_desc; pcl_loc = pcl_loc; + pcl_attributes = pcl_attributes @ attrs} +;; +let ocaml_psig_attribute attr = Psig_attribute attr;; +let ocaml_pstr_attribute attr = Pstr_attribute attr;; +let ocaml_pctf_attribute attr = Pctf_attribute attr;; +let ocaml_pcf_attribute attr = Pcf_attribute attr;; +let ocaml_extension_implem (idloc, id) pay = mkloc idloc id, PStr pay;; +let ocaml_extension_interf (idloc, id) pay = mkloc idloc id, PSig pay;; +let ocaml_extension_type (idloc, id) pay = mkloc idloc id, PTyp pay;; +let ocaml_extension_patt (idloc, id) p eopt = mkloc idloc id, PPat (p, eopt);; +let ocaml_ptyp_extension e = Ptyp_extension e;; +let ocaml_pexp_extension e = Pexp_extension e;; +let ocaml_ppat_extension e = Ppat_extension e;; +let ocaml_pmty_extension e = Pmty_extension e;; +let ocaml_pmod_extension e = Pmod_extension e;; +let ocaml_psig_extension ?(item_attributes = []) e = + Psig_extension (e, item_attributes) +;; +let ocaml_pstr_extension ?(item_attributes = []) e = + Pstr_extension (e, item_attributes) +;; +let ocaml_pcl_extension e = Pcl_extension e;; +let ocaml_pcty_extension e = Pcty_extension e;; +let ocaml_pctf_extension e = Pctf_extension e;; +let ocaml_pcf_extension e = Pcf_extension e;; +let ocaml_extension_exception loc s ed alg_attributes = + {pext_name = mkloc loc s; pext_kind = Pext_decl ([], Pcstr_tuple ed, None); + pext_loc = loc; pext_attributes = alg_attributes} +;; +let ocaml_pexp_unreachable () = Pexp_unreachable;; +let ocaml_ptype_open () = Ptype_open;; +let ocaml_pstr_typext ext = Pstr_typext ext;; +let ocaml_psig_typext ext = Psig_typext ext;; +let ocaml_pexp_letexception exdef body = Pexp_letexception (exdef, body);; +let ocaml_ppat_exception p = Ppat_exception p;; + +let ocaml_mkexp loc x = + {pexp_desc = x; pexp_loc = loc; pexp_loc_stack = []; pexp_attributes = []} +;; +let ocaml_mkmty loc x = + {pmty_desc = x; pmty_loc = loc; pmty_attributes = []} +;; +let ocaml_mkmod loc x = + {pmod_desc = x; pmod_loc = loc; pmod_attributes = []} +;; + +let ocaml_mkfield_inh ?(alg_attributes = []) loc x fl = + {pof_desc = Oinherit x; pof_loc = loc; pof_attributes = alg_attributes} :: + fl +;; + +let ocaml_mkfield_tag ?(alg_attributes = []) loc (lab, x) fl = + {pof_desc = Otag (mkloc loc lab, x); pof_loc = loc; + pof_attributes = alg_attributes} :: + fl +;; +let ocaml_mkfield_var loc = [];; + +let convert_camlp5_variance (va, inj) = + let va = + match va with + Some false -> Contravariant + | Some true -> Covariant + | _ -> NoVariance + in + let inj = + match inj with + true -> Injective + | false -> NoInjectivity + in + va, inj +;; + +let ocaml_ec_tuple ?(alg_attributes = []) loc s tyvars (x, rto) = + let tyvars = List.map (mkloc loc) tyvars in + {pext_name = mkloc loc s; + pext_kind = Pext_decl (tyvars, Pcstr_tuple x, rto); pext_loc = loc; + pext_attributes = alg_attributes} +;; + +let ocaml_ec_record ?(alg_attributes = []) loc s (x, rto) = + let x = + match x with + Ptype_record x -> Pcstr_record x + | _ -> assert false + in + {pext_name = mkloc loc s; pext_kind = Pext_decl ([], x, rto); + pext_loc = loc; pext_attributes = alg_attributes} +;; +let ocaml_ec_rebind loc s li = + {pext_name = mkloc loc s; pext_kind = Pext_rebind (mkloc loc li); + pext_loc = loc; pext_attributes = []} +;; +let ocaml_type_extension ?(item_attributes = []) loc pathlid params priv + ecstrs = + let params = + List.map + (fun (os, va) -> + match os with + None -> ocaml_mktyp loc Ptyp_any, convert_camlp5_variance va + | Some s -> ocaml_mktyp loc (Ptyp_var s), convert_camlp5_variance va) + params + in + {ptyext_path = mkloc loc pathlid; ptyext_params = params; + ptyext_constructors = ecstrs; ptyext_private = priv; ptyext_loc = loc; + ptyext_attributes = item_attributes} +;; +let ocaml_type_declaration tn params cl tk pf tm loc variance attrs = + let _ = + if List.length params <> List.length variance then + failwith "internal error: ocaml_type_declaration" + in + let params = + List.map2 + (fun os va -> + match os with + None -> ocaml_mktyp loc Ptyp_any, convert_camlp5_variance va + | Some os -> + ocaml_mktyp loc (Ptyp_var os), convert_camlp5_variance va) + params variance + in + Right + {ptype_params = params; ptype_cstrs = cl; ptype_kind = tk; + ptype_private = pf; ptype_manifest = tm; ptype_loc = loc; + ptype_name = mkloc loc tn; ptype_attributes = attrs} +;; + +let ocaml_class_type = + Some (fun d loc -> {pcty_desc = d; pcty_loc = loc; pcty_attributes = []}) +;; + +let ocaml_class_expr = + Some + (fun ?(alg_attributes = []) d loc -> + {pcl_desc = d; pcl_loc = loc; pcl_attributes = alg_attributes}) +;; + +let ocaml_class_structure p cil = {pcstr_self = p; pcstr_fields = cil};; + +let ocaml_pmty_ident loc li = Pmty_ident (mkloc loc li);; + +let ocaml_pmty_alias loc li = Pmty_alias (mkloc loc li);; + +let ocaml_pmty_functor sloc mt1 mt2 = + let mt1 = + match mt1 with + None -> Unit + | Some (idopt, mt) -> Named (mknoloc idopt, mt) + in + Pmty_functor (mt1, mt2) +;; + +let ocaml_pmty_typeof = Some (fun me -> Pmty_typeof me);; + +let ocaml_pmty_with mt lcl = + let lcl = List.map snd lcl in Pmty_with (mt, lcl) +;; + +let ocaml_ptype_abstract = Ptype_abstract;; + +let ocaml_ptype_record ltl priv = + Ptype_record + (List.map + (fun (s, mf, ct, loc, attrs) -> + {pld_name = mkloc loc s; pld_mutable = mf; pld_type = ct; + pld_loc = loc; pld_attributes = attrs}) + ltl) +;; + +let ocaml_ptype_variant ctl priv = + try + let ctl = + List.map + (fun (c, tl, loc, attrs) -> + let (tyvars, tl, rto) = + match tl with + Left (tyvars, x), rto -> tyvars, Pcstr_tuple x, rto + | Right (Ptype_record x), rto -> [], Pcstr_record x, rto + | _ -> assert false + in + {pcd_name = mkloc loc c; pcd_vars = List.map (mkloc loc) tyvars; + pcd_args = tl; pcd_res = rto; pcd_loc = loc; + pcd_attributes = attrs}) + ctl + in + Some (Ptype_variant ctl) + with Exit -> None +;; + +let ocaml_ptyp_arrow lab t1 t2 = Ptyp_arrow (labelled lab, t1, t2);; + +let ocaml_ptyp_class li tl ll = Ptyp_class (mknoloc li, tl);; + +let ocaml_ptyp_constr loc li tl = Ptyp_constr (mkloc loc li, tl);; + +let ocaml_ptyp_object loc ml is_open = + Ptyp_object (ml, (if is_open then Open else Closed)) +;; + +let ocaml_ptyp_package = Some (fun pt -> Ptyp_package pt);; + +let ocaml_ptyp_poly = + Some + (fun loc cl t -> + match cl with + [] -> t.ptyp_desc, t.ptyp_attributes + | _ -> Ptyp_poly (List.map (mkloc loc) cl, t), []) +;; + +let ocaml_ptyp_variant loc catl clos sl_opt = + let catl = + List.map + (fun c -> + let (d, attrs) = + match c with + Left (c, a, tl, attrs) -> Rtag (mkloc loc c, a, tl), attrs + | Right t -> Rinherit t, [] + in + {prf_desc = d; prf_loc = loc; prf_attributes = attrs}) + catl + in + let clos = if clos then Closed else Open in + Some (Ptyp_variant (catl, clos, sl_opt)) +;; + +let ocaml_package_type li ltl = + mknoloc li, List.map (fun (li, t) -> mkloc t.ptyp_loc li, t) ltl +;; + +let ocaml_pconst_char c = Pconst_char c;; +let ocaml_pconst_int i = Pconst_integer (string_of_int i, None);; +let ocaml_pconst_float s = Pconst_float (s, None);; + +let ocaml_const_string s loc = Const_string (s, loc, None);; +let ocaml_pconst_string s loc so = Pconst_string (s, loc, so);; + +let pconst_of_const = + function + Const_int i -> ocaml_pconst_int i + | Const_char c -> ocaml_pconst_char c + | Const_string (s, loc, so) -> ocaml_pconst_string s loc so + | Const_float s -> ocaml_pconst_float s + | Const_int32 i32 -> Pconst_integer (Int32.to_string i32, Some 'l') + | Const_int64 i64 -> Pconst_integer (Int64.to_string i64, Some 'L') + | Const_nativeint ni -> Pconst_integer (Nativeint.to_string ni, Some 'n') +;; + +let ocaml_const_int32 = Some (fun s -> Const_int32 (Int32.of_string s));; + +let ocaml_const_int64 = Some (fun s -> Const_int64 (Int64.of_string s));; + +let ocaml_const_nativeint = + Some (fun s -> Const_nativeint (Nativeint.of_string s)) +;; + +let ocaml_pexp_apply f lel = + Pexp_apply (f, List.map (fun (l, e) -> labelled l, e) lel) +;; + +let ocaml_pexp_assertfalse fname loc = + Pexp_assert + (ocaml_mkexp loc (Pexp_construct (mkloc loc (Lident "false"), None))) +;; + +let ocaml_pexp_assert fname loc e = Pexp_assert e;; + +let ocaml_pexp_constraint e ot1 ot2 = + match ot2 with + Some t2 -> Pexp_coerce (e, ot1, t2) + | None -> + match ot1 with + Some t1 -> Pexp_constraint (e, t1) + | None -> failwith "internal error: ocaml_pexp_constraint" +;; + +let ocaml_pexp_construct loc li po chk_arity = + Pexp_construct (mkloc loc li, po) +;; + +let ocaml_pexp_construct_args = + function + Pexp_construct (li, po) -> Some (li.txt, li.loc, po, 0) + | _ -> None +;; + +let mkexp_ocaml_pexp_construct_arity loc li_loc li al = + let a = ocaml_mkexp loc (Pexp_tuple al) in + {pexp_desc = ocaml_pexp_construct li_loc li (Some a) true; pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = + [{attr_name = mkloc loc "ocaml.explicit_arity"; attr_payload = PStr []; + attr_loc = loc}]} +;; + +let ocaml_pexp_field loc e li = Pexp_field (e, mkloc loc li);; + +let ocaml_pexp_for i e1 e2 df e = Pexp_for (i, e1, e2, df, e);; + +let ocaml_case (p, wo, loc, e) = + let e = + match e with + {pexp_desc = Pexp_unreachable; pexp_attributes = _ :: _} -> + failwith + "Internal error: Pexp_unreachable (parsed as '.') must not have attributes" + | e -> e + in + {pc_lhs = p; pc_guard = wo; pc_rhs = e} +;; + +let ocaml_pexp_function lab eo pel = + match pel with + [{pc_lhs = p; pc_guard = None; pc_rhs = {pexp_desc = Pexp_unreachable}}] + when lab = "" && eo = None -> + Pexp_function pel + | [{pc_lhs = p; pc_guard = None; pc_rhs = e}] -> + Pexp_fun (labelled lab, eo, p, e) + | pel -> + if lab = "" && eo = None then Pexp_function pel + else failwith "internal error: bad ast in ocaml_pexp_function" +;; + +let ocaml_pexp_lazy = Some (fun e -> Pexp_lazy e);; + +let ocaml_pexp_ident loc li = Pexp_ident (mkloc loc li);; + +let ocaml_pexp_letmodule = + Some (fun i me e -> Pexp_letmodule (mknoloc i, me, e)) +;; + +let ocaml_pexp_new loc li = Pexp_new (mkloc loc li);; + +let ocaml_pexp_newtype = Some (fun loc s e -> Pexp_newtype (mkloc loc s, e));; + +let ocaml_pexp_object = Some (fun cs -> Pexp_object cs);; + +let ocaml_pexp_open = + Some + (fun ovf me e -> + Pexp_open + ({popen_expr = me; popen_override = ovf; popen_loc = loc_none; + popen_attributes = []}, + e)) +;; + +let ocaml_pexp_override sel = + let sel = List.map (fun (s, e) -> mknoloc s, e) sel in Pexp_override sel +;; + +let ocaml_pexp_pack : ('a -> 'b -> 'c, 'd) choice option = + Some (Right ((fun me -> Pexp_pack me), (fun pt -> Ptyp_package pt))) +;; + +let ocaml_pexp_poly = Some (fun e t -> Pexp_poly (e, t));; + +let ocaml_pexp_record lel eo = + let lel = List.map (fun (li, loc, e) -> mkloc loc li, e) lel in + Pexp_record (lel, eo) +;; + +let ocaml_pexp_send loc e s = Pexp_send (e, mkloc loc s);; + +let ocaml_pexp_setinstvar s e = Pexp_setinstvar (mknoloc s, e);; + +let ocaml_pexp_variant = + let pexp_variant_pat = + function + Pexp_variant (lab, eo) -> Some (lab, eo) + | _ -> None + in + let pexp_variant (lab, eo) = Pexp_variant (lab, eo) in + Some (pexp_variant_pat, pexp_variant) +;; + +let ocaml_value_binding ?(item_attributes = []) loc p e = + let p = + match p with + {ppat_desc = Ppat_constraint (_, {ptyp_desc = Ptyp_poly (_, _)})} -> p + | {ppat_desc = Ppat_constraint ({ppat_desc = Ppat_extension _}, _)} -> p + | {ppat_desc = Ppat_constraint (p1, t)} as p0 -> + let t = + {ptyp_desc = Ptyp_poly ([], t); ptyp_loc = to_ghost_loc t.ptyp_loc; + ptyp_loc_stack = []; ptyp_attributes = []} + in + {p0 with ppat_desc = Ppat_constraint (p1, t)} + | p -> p + in + {pvb_pat = p; pvb_expr = e; pvb_loc = loc; pvb_attributes = item_attributes} +;; + +let ocaml_ppat_open loc li p = Ppat_open (mkloc loc li, p);; + +let ocaml_ppat_alias p i iloc = Ppat_alias (p, mkloc iloc i);; + +let ocaml_ppat_array = Some (fun pl -> Ppat_array pl);; + +let ocaml_ppat_construct loc li po chk_arity = + Ppat_construct (mkloc loc li, po) +;; + +let ocaml_ppat_construct_args = + function + Ppat_construct (li, po) -> Some (li.txt, li.loc, po, 0) + | _ -> None +;; + +let mkpat_ocaml_ppat_construct_arity loc li_loc li tyvl al = + let a = ocaml_mkpat loc (Ppat_tuple al) in + {ppat_desc = ocaml_ppat_construct li_loc li (Some (tyvl, a)) true; + ppat_loc = loc; ppat_loc_stack = []; + ppat_attributes = + [{attr_name = mkloc loc "ocaml.explicit_arity"; attr_payload = PStr []; + attr_loc = loc}]} +;; + +let ocaml_ppat_lazy = Some (fun p -> Ppat_lazy p);; + +let ocaml_ppat_record lpl is_closed = + let lpl = List.map (fun (li, loc, p) -> mkloc loc li, p) lpl in + Ppat_record (lpl, (if is_closed then Closed else Open)) +;; + +let ocaml_ppat_type = Some (fun loc li -> Ppat_type (mkloc loc li));; + +let ocaml_ppat_unpack = + Some ((fun loc s -> Ppat_unpack (mkloc loc s)), (fun pt -> Ptyp_package pt)) +;; + +let ocaml_ppat_var loc s = Ppat_var (mkloc loc s);; + +let ocaml_ppat_variant = + let ppat_variant_pat = + function + Ppat_variant (lab, po) -> Some (lab, po) + | _ -> None + in + let ppat_variant (lab, po) = Ppat_variant (lab, po) in + Some (ppat_variant_pat, ppat_variant) +;; + +let ocaml_psig_class_type = Some (fun ctl -> Psig_class_type ctl);; + +let ocaml_psig_exception ?(alg_attributes = []) ?(item_attributes = []) loc s + (ed, rto) = + let ec = + match ed with + Left (tyvars, x) -> + ocaml_ec_tuple ~alg_attributes:alg_attributes loc s tyvars (x, rto) + | Right x -> ocaml_ec_record ~alg_attributes:alg_attributes loc s (x, rto) + in + Psig_exception + {ptyexn_constructor = ec; ptyexn_attributes = item_attributes; + ptyexn_loc = loc} +;; + +let ocaml_psig_include ?(item_attributes = []) loc mt = + Psig_include + {pincl_mod = mt; pincl_loc = loc; pincl_attributes = item_attributes} +;; + +let ocaml_psig_module ?(item_attributes = []) loc (s : string option) mt = + Psig_module + {pmd_name = mkloc loc s; pmd_type = mt; pmd_attributes = item_attributes; + pmd_loc = loc} +;; + +let ocaml_psig_modsubst ?(item_attributes = []) loc s li = + Psig_modsubst + {pms_name = mkloc loc s; pms_manifest = mkloc loc li; + pms_attributes = item_attributes; + (* ... [@@id1] [@@id2] *) + pms_loc = loc} +;; + +let ocaml_psig_modtype ?(item_attributes = []) loc s mto = + let pmtd = + {pmtd_name = mkloc loc s; pmtd_type = mto; + pmtd_attributes = item_attributes; pmtd_loc = loc} + in + Psig_modtype pmtd +;; + +let ocaml_psig_modtypesubst ?(item_attributes = []) loc s mto = + let pmtd = + {pmtd_name = mkloc loc s; pmtd_type = mto; + pmtd_attributes = item_attributes; pmtd_loc = loc} + in + Psig_modtypesubst pmtd +;; + +let ocaml_psig_open ?(item_attributes = []) loc li = + Psig_open + {popen_expr = mknoloc li; popen_override = Fresh; popen_loc = loc; + popen_attributes = item_attributes} +;; + +let ocaml_psig_recmodule = + let f ntl = + let ntl = + List.map + (fun (s, mt, attrs) -> + {pmd_name = mknoloc s; pmd_type = mt; pmd_attributes = attrs; + pmd_loc = loc_none}) + ntl + in + Psig_recmodule ntl + in + Some f +;; + +let ocaml_psig_type is_nonrec stl = + let stl = List.map (fun (s, t) -> t) stl in + Psig_type ((if is_nonrec then Nonrecursive else Recursive), stl) +;; + +let ocaml_psig_typesubst stl = + let stl = List.map (fun (s, t) -> t) stl in Psig_typesubst stl +;; + +let ocaml_psig_value s vd = Psig_value vd;; + +let ocaml_pstr_class_type = Some (fun ctl -> Pstr_class_type ctl);; + +let ocaml_pstr_eval ?(item_attributes = []) e = + Pstr_eval (e, item_attributes) +;; + +let ocaml_pstr_exception ?(alg_attributes = []) ?(item_attributes = []) loc s + (ed, rto) = + let ec = + match ed with + Left (tyvars, x) -> + ocaml_ec_tuple ~alg_attributes:alg_attributes loc s tyvars (x, rto) + | Right x -> ocaml_ec_record ~alg_attributes:alg_attributes loc s (x, rto) + in + Pstr_exception + {ptyexn_constructor = ec; ptyexn_attributes = item_attributes; + ptyexn_loc = loc} +;; + +let ocaml_pstr_exn_rebind = + Some + (fun loc s li -> + Pstr_exception + {ptyexn_constructor = ocaml_ec_rebind loc s li; + ptyexn_attributes = []; ptyexn_loc = loc}) +;; + +let ocaml_pstr_include = + Some + (fun ?(item_attributes = []) loc me -> + Pstr_include + {pincl_mod = me; pincl_loc = loc; + pincl_attributes = item_attributes}) +;; + +let ocaml_pstr_modtype ?(item_attributes = []) loc s mto = + let pmtd = + {pmtd_name = mkloc loc s; pmtd_type = mto; + pmtd_attributes = item_attributes; pmtd_loc = loc} + in + Pstr_modtype pmtd +;; + +let ocaml_pstr_module ?(item_attributes = []) loc (s : string option) me = + let mb = + {pmb_name = mkloc loc s; pmb_expr = me; pmb_attributes = item_attributes; + pmb_loc = loc} + in + Pstr_module mb +;; + +let ocaml_pstr_open ?(item_attributes = []) ovflag loc me = + Pstr_open + {popen_expr = me; popen_override = ovflag; popen_loc = loc; + popen_attributes = item_attributes} +;; + +let ocaml_pstr_primitive s vd = Pstr_primitive vd;; + +let ocaml_pstr_recmodule = + let f mel = + Pstr_recmodule + (List.map + (fun ((s : string option), mt, me, attrs) -> + {pmb_name = mknoloc s; pmb_expr = me; pmb_attributes = attrs; + pmb_loc = loc_none}) + mel) + in + Some f +;; + +let ocaml_pstr_type is_nonrec stl = + let stl = List.map (fun (s, t) -> t) stl in + Pstr_type ((if is_nonrec then Nonrecursive else Recursive), stl) +;; + +let ocaml_class_infos = + Some + (fun ?(item_attributes = []) virt (sl, sloc) name expr loc variance -> + let _ = + if List.length sl <> List.length variance then + failwith "internal error: ocaml_class_infos" + in + let params = + List.map2 + (fun os va -> + ocaml_mktyp loc (Ptyp_var os), convert_camlp5_variance va) + sl variance + in + {pci_virt = virt; pci_params = params; pci_name = mkloc loc name; + pci_expr = expr; pci_loc = loc; pci_attributes = item_attributes}) +;; + +let ocaml_pmod_constraint loc me mt = + ocaml_mkmod loc (Pmod_constraint (me, mt)) +;; + +let ocaml_pmod_ident li = Pmod_ident (mknoloc li);; + +let ocaml_pmod_functor mt me = + let mt = + match mt with + None -> Unit + | Some (idopt, mt) -> Named (mknoloc idopt, mt) + in + Pmod_functor (mt, me) +;; + +let ocaml_pmod_unpack : ('a -> 'b -> 'c, 'd) choice option = + Some (Right ((fun e -> Pmod_unpack e), (fun pt -> Ptyp_package pt))) +;; + +let ocaml_pcf_cstr = Some (fun (t1, t2, loc) -> Pcf_constraint (t1, t2));; + +let ocaml_pcf_inher loc ovflag ce pb = + Pcf_inherit (ovflag, ce, option_map (mkloc loc) pb) +;; + +let ocaml_pcf_init = Some (fun e -> Pcf_initializer e);; + +let ocaml_pcf_meth (s, pf, ovf, e, loc) = + let pf = if pf then Private else Public in + let ovf = if ovf then Override else Fresh in + Pcf_method (mkloc loc s, pf, Cfk_concrete (ovf, e)) +;; + +let ocaml_pcf_val (s, mf, ovf, e, loc) = + let mf = if mf then Mutable else Immutable in + let ovf = if ovf then Override else Fresh in + Pcf_val (mkloc loc s, mf, Cfk_concrete (ovf, e)) +;; + +let ocaml_pcf_valvirt = + let ocaml_pcf (s, mf, t, loc) = + let mf = if mf then Mutable else Immutable in + Pcf_val (mkloc loc s, mf, Cfk_virtual t) + in + Some ocaml_pcf +;; + +let ocaml_pcf_virt (s, pf, t, loc) = + Pcf_method (mkloc loc s, pf, Cfk_virtual t) +;; + +let ocaml_pcl_apply = + Some + (fun ce lel -> Pcl_apply (ce, List.map (fun (l, e) -> labelled l, e) lel)) +;; + +let ocaml_pcl_constr = Some (fun li ctl -> Pcl_constr (mknoloc li, ctl));; + +let ocaml_pcl_constraint = Some (fun ce ct -> Pcl_constraint (ce, ct));; + +let ocaml_pcl_fun = + Some (fun lab ceo p ce -> Pcl_fun (labelled lab, ceo, p, ce)) +;; + +let ocaml_pcl_let = Some (fun rf pel ce -> Pcl_let (rf, pel, ce));; + +let ocaml_pcl_open loc li ovf ce = + Pcl_open + ({popen_expr = mknoloc li; popen_override = ovf; popen_loc = loc; + popen_attributes = []}, + ce) +;; +let ocaml_pcty_open loc li ovf ct = + Pcty_open + ({popen_expr = mknoloc li; popen_override = ovf; popen_loc = loc; + popen_attributes = []}, + ct) +;; + +let ocaml_pcl_structure = Some (fun cs -> Pcl_structure cs);; + +let ocaml_pctf_cstr = Some (fun (t1, t2, loc) -> Pctf_constraint (t1, t2));; + +let ocaml_pctf_inher ct = Pctf_inherit ct;; + +let ocaml_pctf_meth (s, pf, t, loc) = + Pctf_method (mkloc loc s, pf, Concrete, t) +;; + +let ocaml_pctf_val (s, mf, vf, t, loc) = Pctf_val (mkloc loc s, mf, vf, t);; + +let ocaml_pctf_virt (s, pf, t, loc) = + Pctf_method (mkloc loc s, pf, Virtual, t) +;; + +let ocaml_pcty_constr = Some (fun li ltl -> Pcty_constr (mknoloc li, ltl));; + +let ocaml_pcty_fun = + Some (fun lab t ot ct -> Pcty_arrow (labelled lab, t, ct)) +;; + +let ocaml_pcty_signature = + let f (t, ctfl) = + let cs = {pcsig_self = t; pcsig_fields = ctfl} in Pcty_signature cs + in + Some f +;; + +let ocaml_pdir_bool = Some (fun b -> Pdir_bool b);; +let ocaml_pdir_int i s = Pdir_int (i, None);; +let ocaml_pdir_some x = Some x;; +let ocaml_pdir_none = None;; +let ocaml_ptop_dir loc s da = + Ptop_dir + {pdir_name = mkloc loc s; + pdir_arg = + begin match da with + Some da -> Some {pdira_desc = da; pdira_loc = loc} + | None -> None + end; + pdir_loc = loc} +;; + + let (ocaml_pwith_modtype : + (Location.t -> Longident.t -> module_type -> with_constraint) option) = + Some (fun loc li mt -> Pwith_modtype (mkloc loc li, mt)) +;; + +let (ocaml_pwith_modtypesubst : + (Location.t -> Longident.t -> module_type -> with_constraint) option) = + Some (fun loc li mt -> Pwith_modtypesubst (mkloc loc li, mt)) +;; + +let ocaml_pwith_modsubst = + Some (fun loc li me -> Pwith_modsubst (mkloc loc li, mkloc loc me)) +;; + +let ocaml_pwith_type loc (i, td) = Pwith_type (mkloc loc i, td);; + +let ocaml_pwith_module loc mname me = + Pwith_module (mkloc loc mname, mkloc loc me) +;; + +let ocaml_pwith_typesubst = + Some (fun loc lid td -> Pwith_typesubst (mkloc loc lid, td)) +;; + +let module_prefix_can_be_in_first_record_label_only = true;; + +let split_or_patterns_with_bindings = false;; + +let has_records_with_with = true;; + +let arg_rest = + function + Arg.Rest r -> Some r + | _ -> None +;; + +let arg_set_string = + function + Arg.Set_string r -> Some r + | _ -> None +;; + +let arg_set_int = + function + Arg.Set_int r -> Some r + | _ -> None +;; + +let arg_set_float = + function + Arg.Set_float r -> Some r + | _ -> None +;; + +let arg_symbol = + function + Arg.Symbol (s, f) -> Some (s, f) + | _ -> None +;; + +let arg_tuple = + function + Arg.Tuple t -> Some t + | _ -> None +;; + +let arg_bool = + function + Arg.Bool f -> Some f + | _ -> None +;; + +let char_escaped = Char.escaped;; + +let hashtbl_mem = Hashtbl.mem;; + +let list_rev_append = List.rev_append;; + +let list_rev_map = List.rev_map;; + +let list_sort = List.sort;; + +let pervasives_set_binary_mode_out = set_binary_mode_out;; + +let printf_ksprintf = Printf.ksprintf;; + +let char_uppercase = Char.uppercase_ascii;; + +let bytes_modname = "Bytes";; + +let bytes_of_string s = Bytes.of_string s;; + +let bytes_to_string s = Bytes.to_string s;; + +let string_capitalize = String.capitalize_ascii;; + +let string_contains = String.contains;; + +let string_cat s1 s2 = Bytes.cat s1 s2;; + +let string_copy = Bytes.copy;; + +let string_create = Bytes.create;; + +let string_get = Bytes.get;; + +let string_index = Bytes.index;; + +let string_length = Bytes.length;; + +let string_lowercase = String.lowercase_ascii;; + +let string_unsafe_set = Bytes.unsafe_set;; + +let string_uncapitalize = String.uncapitalize_ascii;; + +let string_uppercase = String.uppercase_ascii;; + +let string_set = Bytes.set;; + +let string_sub = Bytes.sub;; + +let array_create = Array.make;; diff -Nru camlp5-8.00.03/ocaml_src/main/ast2pt.ml camlp5-8.00.04/ocaml_src/main/ast2pt.ml --- camlp5-8.00.03/ocaml_src/main/ast2pt.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/main/ast2pt.ml 2022-12-05 20:34:55.000000000 +0000 @@ -550,6 +550,18 @@ | p -> error (MLast.loc_of_patt p) "label_of_patt; case not impl" ;; +let ctyp_mentions s cty = + let rec crec = + function + MLast.TyQuo (_, s2) -> s = s2 + | MLast.TyApp (_, t1, t2) -> crec t1 || crec t2 + | MLast.TyArr (_, t1, t2) -> crec t1 || crec t2 + | MLast.TyTup (_, tl) -> List.exists crec tl + | _ -> false + in + crec cty +;; + let rec type_decl_of_with_type loc tn tpl pf ct = let (params, variance) = List.split (uv tpl) in let params = List.map uv params in @@ -766,7 +778,7 @@ | _ -> mt, [] in let li = module_type_long_id mt in ocaml_package_type li with_con -and type_decl ?(item_attributes = []) tn tl priv cl = +and type_decl ?(item_attributes = []) tn tl priv (cl, tdCon) = function TyMan (loc, t, pf, MLast.TyRec (_, ltl)) -> let priv = if uv pf then Private else Public in @@ -792,7 +804,12 @@ | t -> let m = match t with - MLast.TyQuo (_, s) when cl = [] -> + MLast.TyQuo (_, s) + when + not + (List.exists + (fun (t1, t2) -> ctyp_mentions s t1 || ctyp_mentions s t2) + tdCon) -> if List.exists (fun (t, _) -> Some s = uv t) tl then Some (ctyp t) else None | _ -> Some (ctyp t) @@ -1465,7 +1482,7 @@ let tn = uv (snd (uv td.tdNam)) in tn, type_decl ~item_attributes:(uv_item_attributes td.tdAttributes) tn - (uv td.tdPrm) priv cl td.tdDef + (uv td.tdPrm) priv (cl, uv td.tdCon) td.tdDef and module_type = function MtAtt (loc, e, a) -> ocaml_pmty_addattr (attr (uv a)) (module_type e) diff -Nru camlp5-8.00.03/ocaml_src/main/ast2pt.mli camlp5-8.00.04/ocaml_src/main/ast2pt.mli --- camlp5-8.00.03/ocaml_src/main/ast2pt.mli 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/main/ast2pt.mli 2022-12-05 20:34:55.000000000 +0000 @@ -18,6 +18,7 @@ (** Convert a Camlp5 location into an OCaml location. *) val fast : bool ref;; (** Flag to generate fast (unsafe) access to arrays. Default: False. *) +val ctyp_mentions : string -> MLast.ctyp -> bool;; val ctyp : MLast.ctyp -> Parsetree.core_type;; val expr : MLast.expr -> Parsetree.expression;; val patt : MLast.patt -> Parsetree.pattern;; diff -Nru camlp5-8.00.03/ocaml_src/main/pcaml.ml camlp5-8.00.04/ocaml_src/main/pcaml.ml --- camlp5-8.00.03/ocaml_src/main/pcaml.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/main/pcaml.ml 2022-12-05 20:34:55.000000000 +0000 @@ -7,7 +7,7 @@ open Printf;; -let version = "8.00.03";; +let version = "8.00.04";; let syntax_name = ref "";; let ocaml_version = diff -Nru camlp5-8.00.03/ocaml_src/meta/pa_r.ml camlp5-8.00.04/ocaml_src/meta/pa_r.ml --- camlp5-8.00.03/ocaml_src/meta/pa_r.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/meta/pa_r.ml 2022-12-05 20:34:55.000000000 +0000 @@ -1124,6 +1124,12 @@ [None, None, [Grammar.production (Grammar.r_next + (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "("))) + (Grammar.s_token ("", ")")), + "194fe98d", + (fun _ _ (loc : Ploc.t) -> (None : 'functor_parameter))); + Grammar.production + (Grammar.r_next (Grammar.r_next (Grammar.r_next (Grammar.r_next @@ -1642,6 +1648,15 @@ (fun (mt : 'module_type) _ (arg : 'functor_parameter) _ (loc : Ploc.t) -> (MLast.MtFun (loc, arg, mt) : 'module_type)))]; + Some "->", Some Gramext.RightA, + [Grammar.production + (Grammar.r_next + (Grammar.r_next (Grammar.r_next Grammar.r_stop Grammar.s_self) + (Grammar.s_token ("", "->"))) + Grammar.s_self, + "194fe98d", + (fun (mt2 : 'module_type) _ (mt1 : 'module_type) (loc : Ploc.t) -> + (MLast.MtFun (loc, Some (None, mt1), mt2) : 'module_type)))]; Some "alg_attribute", Some Gramext.LeftA, [Grammar.production (Grammar.r_next @@ -2253,6 +2268,9 @@ Grammar.extension (uidopt : 'uidopt Grammar.Entry.e) None [None, None, [Grammar.production + (Grammar.r_next Grammar.r_stop (Grammar.s_token ("", "_")), + "194fe98d", (fun _ (loc : Ploc.t) -> (None : 'uidopt))); + Grammar.production (Grammar.r_next Grammar.r_stop (Grammar.s_token ("UIDENT", "")), "194fe98d", (fun (m : string) (loc : Ploc.t) -> (Some m : 'uidopt)))]]; diff -Nru camlp5-8.00.03/ocaml_src/odyl/Makefile camlp5-8.00.04/ocaml_src/odyl/Makefile --- camlp5-8.00.03/ocaml_src/odyl/Makefile 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/odyl/Makefile 2022-12-05 20:34:55.000000000 +0000 @@ -5,7 +5,7 @@ SHELL=/bin/sh -INCLUDES= +INCLUDES=-I +dynlink OCAMLCFLAGS=$(DEBUG) $(WARNERR) $(INCLUDES) LINKFLAGS=$(DEBUG) $(INCLUDES) diff -Nru camlp5-8.00.03/ocaml_src/odyl/odyl.ml camlp5-8.00.04/ocaml_src/odyl/odyl.ml --- camlp5-8.00.03/ocaml_src/odyl/odyl.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_src/odyl/odyl.ml 2022-12-05 20:34:55.000000000 +0000 @@ -37,4 +37,4 @@ exit 2 ;; -Printexc.catch main ();; +main ();; diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/asttypes.mli camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/asttypes.mli --- camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/asttypes.mli 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/asttypes.mli 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,67 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Auxiliary AST types used by parsetree and typedtree. + + {b Warning:} this module is unstable and part of + {{!Compiler_libs}compiler-libs}. + +*) + +type constant = + Const_int of int + | Const_char of char + | Const_string of string * Location.t * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint + +type rec_flag = Nonrecursive | Recursive + +type direction_flag = Upto | Downto + +(* Order matters, used in polymorphic comparison *) +type private_flag = Private | Public + +type mutable_flag = Immutable | Mutable + +type virtual_flag = Virtual | Concrete + +type override_flag = Override | Fresh + +type closed_flag = Closed | Open + +type label = string + +type arg_label = + Nolabel + | Labelled of string (** [label:T -> ...] *) + | Optional of string (** [?label:T -> ...] *) + +type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; +} + + +type variance = + | Covariant + | Contravariant + | NoVariance + +type injectivity = + | Injective + | NoInjectivity diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/.depend camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/.depend --- camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/.depend 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/.depend 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,4 @@ +asttypes.cmi : location.cmi +location.cmi : ../utils/warnings.cmi +longident.cmi : +parsetree.cmi : longident.cmi location.cmi asttypes.cmi diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/.gitignore camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/.gitignore --- camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/.gitignore 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1 @@ +*.cm[oi] diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/location.mli camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/location.mli --- camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/location.mli 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/location.mli 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,294 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Source code locations (ranges of positions), used in parsetree. + + {b Warning:} this module is unstable and part of + {{!Compiler_libs}compiler-libs}. + +*) + +open Format + +type t = Warnings.loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +(** Note on the use of Lexing.position in this module. + If [pos_fname = ""], then use [!input_name] instead. + If [pos_lnum = -1], then [pos_bol = 0]. Use [pos_cnum] and + re-parse the file to get the line and character numbers. + Else all fields are correct. +*) + +val none : t +(** An arbitrary value of type [t]; describes an empty ghost range. *) + +val is_none : t -> bool +(** True for [Location.none], false any other location *) + +val in_file : string -> t +(** Return an empty ghost range located in a given file. *) + +val init : Lexing.lexbuf -> string -> unit +(** Set the file name and line number of the [lexbuf] to be the start + of the named file. *) + +val curr : Lexing.lexbuf -> t +(** Get the location of the current token from the [lexbuf]. *) + +val symbol_rloc: unit -> t +val symbol_gloc: unit -> t + +(** [rhs_loc n] returns the location of the symbol at position [n], starting + at 1, in the current parser rule. *) +val rhs_loc: int -> t + +val rhs_interval: int -> int -> t + +val get_pos_info: Lexing.position -> string * int * int +(** file, line, char *) + +type 'a loc = { + txt : 'a; + loc : t; +} + +val mknoloc : 'a -> 'a loc +val mkloc : 'a -> t -> 'a loc + + +(** {1 Input info} *) + +val input_name: string ref +val input_lexbuf: Lexing.lexbuf option ref + +(* This is used for reporting errors coming from the toplevel. + + When running a toplevel session (i.e. when [!input_name] is "//toplevel//"), + [!input_phrase_buffer] should be [Some buf] where [buf] contains the last + toplevel phrase. *) +val input_phrase_buffer: Buffer.t option ref + + +(** {1 Toplevel-specific functions} *) + +val echo_eof: unit -> unit +val reset: unit -> unit + + +(** {1 Printing locations} *) + +val rewrite_absolute_path: string -> string + (** rewrite absolute path to honor the BUILD_PATH_PREFIX_MAP + variable (https://reproducible-builds.org/specs/build-path-prefix-map/) + if it is set. *) + +val absolute_path: string -> string + +val show_filename: string -> string + (** In -absname mode, return the absolute path for this filename. + Otherwise, returns the filename unchanged. *) + +val print_filename: formatter -> string -> unit + +val print_loc: formatter -> t -> unit +val print_locs: formatter -> t list -> unit + + +(** {1 Toplevel-specific location highlighting} *) + +val highlight_terminfo: + Lexing.lexbuf -> formatter -> t list -> unit + + +(** {1 Reporting errors and warnings} *) + +(** {2 The type of reports and report printers} *) + +type msg = (Format.formatter -> unit) loc + +val msg: ?loc:t -> ('a, Format.formatter, unit, msg) format4 -> 'a + +type report_kind = + | Report_error + | Report_warning of string + | Report_warning_as_error of string + | Report_alert of string + | Report_alert_as_error of string + +type report = { + kind : report_kind; + main : msg; + sub : msg list; +} + +type report_printer = { + (* The entry point *) + pp : report_printer -> + Format.formatter -> report -> unit; + + pp_report_kind : report_printer -> report -> + Format.formatter -> report_kind -> unit; + pp_main_loc : report_printer -> report -> + Format.formatter -> t -> unit; + pp_main_txt : report_printer -> report -> + Format.formatter -> (Format.formatter -> unit) -> unit; + pp_submsgs : report_printer -> report -> + Format.formatter -> msg list -> unit; + pp_submsg : report_printer -> report -> + Format.formatter -> msg -> unit; + pp_submsg_loc : report_printer -> report -> + Format.formatter -> t -> unit; + pp_submsg_txt : report_printer -> report -> + Format.formatter -> (Format.formatter -> unit) -> unit; +} +(** A printer for [report]s, defined using open-recursion. + The goal is to make it easy to define new printers by re-using code from + existing ones. +*) + +(** {2 Report printers used in the compiler} *) + +val batch_mode_printer: report_printer + +val terminfo_toplevel_printer: Lexing.lexbuf -> report_printer + +val best_toplevel_printer: unit -> report_printer +(** Detects the terminal capabilities and selects an adequate printer *) + +(** {2 Printing a [report]} *) + +val print_report: formatter -> report -> unit +(** Display an error or warning report. *) + +val report_printer: (unit -> report_printer) ref +(** Hook for redefining the printer of reports. + + The hook is a [unit -> report_printer] and not simply a [report_printer]: + this is useful so that it can detect the type of the output (a file, a + terminal, ...) and select a printer accordingly. *) + +val default_report_printer: unit -> report_printer +(** Original report printer for use in hooks. *) + + +(** {1 Reporting warnings} *) + +(** {2 Converting a [Warnings.t] into a [report]} *) + +val report_warning: t -> Warnings.t -> report option +(** [report_warning loc w] produces a report for the given warning [w], or + [None] if the warning is not to be printed. *) + +val warning_reporter: (t -> Warnings.t -> report option) ref +(** Hook for intercepting warnings. *) + +val default_warning_reporter: t -> Warnings.t -> report option +(** Original warning reporter for use in hooks. *) + +(** {2 Printing warnings} *) + +val formatter_for_warnings : formatter ref + +val print_warning: t -> formatter -> Warnings.t -> unit +(** Prints a warning. This is simply the composition of [report_warning] and + [print_report]. *) + +val prerr_warning: t -> Warnings.t -> unit +(** Same as [print_warning], but uses [!formatter_for_warnings] as output + formatter. *) + +(** {1 Reporting alerts} *) + +(** {2 Converting an [Alert.t] into a [report]} *) + +val report_alert: t -> Warnings.alert -> report option +(** [report_alert loc w] produces a report for the given alert [w], or + [None] if the alert is not to be printed. *) + +val alert_reporter: (t -> Warnings.alert -> report option) ref +(** Hook for intercepting alerts. *) + +val default_alert_reporter: t -> Warnings.alert -> report option +(** Original alert reporter for use in hooks. *) + +(** {2 Printing alerts} *) + +val print_alert: t -> formatter -> Warnings.alert -> unit +(** Prints an alert. This is simply the composition of [report_alert] and + [print_report]. *) + +val prerr_alert: t -> Warnings.alert -> unit +(** Same as [print_alert], but uses [!formatter_for_warnings] as output + formatter. *) + +val deprecated: ?def:t -> ?use:t -> t -> string -> unit +(** Prints a deprecation alert. *) + +val alert: ?def:t -> ?use:t -> kind:string -> t -> string -> unit +(** Prints an arbitrary alert. *) + +val auto_include_alert: string -> unit +(** Prints an alert that -I +lib has been automatically added to the load + path *) + +val deprecated_script_alert: string -> unit +(** [deprecated_script_alert command] prints an alert that [command foo] has + been deprecated in favour of [command ./foo] *) + +(** {1 Reporting errors} *) + +type error = report +(** An [error] is a [report] which [report_kind] must be [Report_error]. *) + +val error: ?loc:t -> ?sub:msg list -> string -> error + +val errorf: ?loc:t -> ?sub:msg list -> + ('a, Format.formatter, unit, error) format4 -> 'a + +val error_of_printer: ?loc:t -> ?sub:msg list -> + (formatter -> 'a -> unit) -> 'a -> error + +val error_of_printer_file: (formatter -> 'a -> unit) -> 'a -> error + + +(** {1 Automatically reporting errors for raised exceptions} *) + +val register_error_of_exn: (exn -> error option) -> unit +(** Each compiler module which defines a custom type of exception + which can surface as a user-visible error should register + a "printer" for this exception using [register_error_of_exn]. + The result of the printer is an [error] value containing + a location, a message, and optionally sub-messages (each of them + being located as well). *) + +val error_of_exn: exn -> [ `Ok of error | `Already_displayed ] option + +exception Error of error +(** Raising [Error e] signals an error [e]; the exception will be caught and the + error will be printed. *) + +exception Already_displayed_error +(** Raising [Already_displayed_error] signals an error which has already been + printed. The exception will be caught, but nothing will be printed *) + +val raise_errorf: ?loc:t -> ?sub:msg list -> + ('a, Format.formatter, unit, 'b) format4 -> 'a + +val report_exception: formatter -> exn -> unit +(** Reraise the exception if it is unknown. *) diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/longident.mli camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/longident.mli --- camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/longident.mli 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/longident.mli 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,58 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Long identifiers, used in parsetree. + + {b Warning:} this module is unstable and part of + {{!Compiler_libs}compiler-libs}. + + To print a longident, see {!Pprintast.longident}, using + {!Format.asprintf} to convert to a string. + +*) + +type t = + Lident of string + | Ldot of t * string + | Lapply of t * t + +val flatten: t -> string list +val unflatten: string list -> t option +(** For a non-empty list [l], [unflatten l] is [Some lid] where [lid] is + the long identifier created by concatenating the elements of [l] + with [Ldot]. + [unflatten []] is [None]. +*) + +val last: t -> string +val parse: string -> t +[@@deprecated "this function may misparse its input,\n\ +use \"Parse.longident\" or \"Longident.unflatten\""] +(** + + This function is broken on identifiers that are not just "Word.Word.word"; + for example, it returns incorrect results on infix operators + and extended module paths. + + If you want to generate long identifiers that are a list of + dot-separated identifiers, the function {!unflatten} is safer and faster. + {!unflatten} is available since OCaml 4.06.0. + + If you want to parse any identifier correctly, use the long-identifiers + functions from the {!Parse} module, in particular {!Parse.longident}. + They are available since OCaml 4.11, and also provide proper + input-location support. + +*) diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/Makefile camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/Makefile --- camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/Makefile 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/Makefile 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,19 @@ +# Makefile,v + +FILES=asttypes.cmi location.cmi longident.cmi parsetree.cmi +INCL=-I ../utils + +all: $(FILES) + +clean: + rm -f *.cmi + +depend: + ocamldep $(INCL) *.ml* | sed -e 's/ *$$//' > .depend + +.SUFFIXES: .mli .cmi + +.mli.cmi: + $(OCAMLN)c $(INCL) -c $< + +include .depend diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/parsetree.mli camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/parsetree.mli --- camlp5-8.00.03/ocaml_stuff/5.0.0/parsing/parsetree.mli 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/parsing/parsetree.mli 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,1049 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Abstract syntax tree produced by parsing + + {b Warning:} this module is unstable and part of + {{!Compiler_libs}compiler-libs}. + +*) + +open Asttypes + +type constant = + | Pconst_integer of string * char option + (** Integer constants such as [3] [3l] [3L] [3n]. + + Suffixes [[g-z][G-Z]] are accepted by the parser. + Suffixes except ['l'], ['L'] and ['n'] are rejected by the typechecker + *) + | Pconst_char of char (** Character such as ['c']. *) + | Pconst_string of string * Location.t * string option + (** Constant string such as ["constant"] or + [{delim|other constant|delim}]. + + The location span the content of the string, without the delimiters. + *) + | Pconst_float of string * char option + (** Float constant such as [3.4], [2e5] or [1.4e-4]. + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + +type location_stack = Location.t list + +(** {1 Extension points} *) + +type attribute = { + attr_name : string loc; + attr_payload : payload; + attr_loc : Location.t; + } +(** Attributes such as [[\@id ARG]] and [[\@\@id ARG]]. + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + +and extension = string loc * payload +(** Extension points such as [[%id ARG] and [%%id ARG]]. + + Sub-language placeholder -- rejected by the typechecker. + *) + +and attributes = attribute list + +and payload = + | PStr of structure + | PSig of signature (** [: SIG] in an attribute or an extension point *) + | PTyp of core_type (** [: T] in an attribute or an extension point *) + | PPat of pattern * expression option + (** [? P] or [? P when E], in an attribute or an extension point *) + +(** {1 Core language} *) +(** {2 Type expressions} *) + +and core_type = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_loc_stack: location_stack; + ptyp_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + +and core_type_desc = + | Ptyp_any (** [_] *) + | Ptyp_var of string (** A type variable such as ['a] *) + | Ptyp_arrow of arg_label * core_type * core_type + (** [Ptyp_arrow(lbl, T1, T2)] represents: + - [T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Nolabel}[Nolabel]}, + - [~l:T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Labelled}[Labelled]}, + - [?l:T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Optional}[Optional]}. + *) + | Ptyp_tuple of core_type list + (** [Ptyp_tuple([T1 ; ... ; Tn])] + represents a product type [T1 * ... * Tn]. + + Invariant: [n >= 2]. + *) + | Ptyp_constr of Longident.t loc * core_type list + (** [Ptyp_constr(lident, l)] represents: + - [tconstr] when [l=[]], + - [T tconstr] when [l=[T]], + - [(T1, ..., Tn) tconstr] when [l=[T1 ; ... ; Tn]]. + *) + | Ptyp_object of object_field list * closed_flag + (** [Ptyp_object([ l1:T1; ...; ln:Tn ], flag)] represents: + - [< l1:T1; ...; ln:Tn >] when [flag] is + {{!Asttypes.closed_flag.Closed}[Closed]}, + - [< l1:T1; ...; ln:Tn; .. >] when [flag] is + {{!Asttypes.closed_flag.Open}[Open]}. + *) + | Ptyp_class of Longident.t loc * core_type list + (** [Ptyp_class(tconstr, l)] represents: + - [#tconstr] when [l=[]], + - [T #tconstr] when [l=[T]], + - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]]. + *) + | Ptyp_alias of core_type * string (** [T as 'a]. *) + | Ptyp_variant of row_field list * closed_flag * label list option + (** [Ptyp_variant([`A;`B], flag, labels)] represents: + - [[ `A|`B ]] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}, + and [labels] is [None], + - [[> `A|`B ]] + when [flag] is {{!Asttypes.closed_flag.Open}[Open]}, + and [labels] is [None], + - [[< `A|`B ]] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}, + and [labels] is [Some []], + - [[< `A|`B > `X `Y ]] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}, + and [labels] is [Some ["X";"Y"]]. + *) + | Ptyp_poly of string loc list * core_type + (** ['a1 ... 'an. T] + + Can only appear in the following context: + + - As the {!core_type} of a + {{!pattern_desc.Ppat_constraint}[Ppat_constraint]} node corresponding + to a constraint on a let-binding: + {[let x : 'a1 ... 'an. T = e ...]} + + - Under {{!class_field_kind.Cfk_virtual}[Cfk_virtual]} for methods + (not values). + + - As the {!core_type} of a + {{!class_type_field_desc.Pctf_method}[Pctf_method]} node. + + - As the {!core_type} of a {{!expression_desc.Pexp_poly}[Pexp_poly]} + node. + + - As the {{!label_declaration.pld_type}[pld_type]} field of a + {!label_declaration}. + + - As a {!core_type} of a {{!core_type_desc.Ptyp_object}[Ptyp_object]} + node. + + - As the {{!value_description.pval_type}[pval_type]} field of a + {!value_description}. + *) + | Ptyp_package of package_type (** [(module S)]. *) + | Ptyp_extension of extension (** [[%id]]. *) + +and package_type = Longident.t loc * (Longident.t loc * core_type) list +(** As {!package_type} typed values: + - [(S, [])] represents [(module S)], + - [(S, [(t1, T1) ; ... ; (tn, Tn)])] + represents [(module S with type t1 = T1 and ... and tn = Tn)]. + *) + +and row_field = { + prf_desc : row_field_desc; + prf_loc : Location.t; + prf_attributes : attributes; +} + +and row_field_desc = + | Rtag of label loc * bool * core_type list + (** [Rtag(`A, b, l)] represents: + - [`A] when [b] is [true] and [l] is [[]], + - [`A of T] when [b] is [false] and [l] is [[T]], + - [`A of T1 & .. & Tn] when [b] is [false] and [l] is [[T1;...Tn]], + - [`A of & T1 & .. & Tn] when [b] is [true] and [l] is [[T1;...Tn]]. + + - The [bool] field is true if the tag contains a + constant (empty) constructor. + - [&] occurs when several types are used for the same constructor + (see 4.2 in the manual) + *) + | Rinherit of core_type (** [[ | t ]] *) + +and object_field = { + pof_desc : object_field_desc; + pof_loc : Location.t; + pof_attributes : attributes; +} + +and object_field_desc = + | Otag of label loc * core_type + | Oinherit of core_type + +(** {2 Patterns} *) + +and pattern = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_loc_stack: location_stack; + ppat_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + +and pattern_desc = + | Ppat_any (** The pattern [_]. *) + | Ppat_var of string loc (** A variable pattern such as [x] *) + | Ppat_alias of pattern * string loc + (** An alias pattern such as [P as 'a] *) + | Ppat_constant of constant + (** Patterns such as [1], ['a'], ["true"], [1.0], [1l], [1L], [1n] *) + | Ppat_interval of constant * constant + (** Patterns such as ['a'..'z']. + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (** Patterns [(P1, ..., Pn)]. + + Invariant: [n >= 2] + *) + | Ppat_construct of Longident.t loc * (string loc list * pattern) option + (** [Ppat_construct(C, args)] represents: + - [C] when [args] is [None], + - [C P] when [args] is [Some ([], P)] + - [C (P1, ..., Pn)] when [args] is + [Some ([], Ppat_tuple [P1; ...; Pn])] + - [C (type a b) P] when [args] is [Some ([a; b], P)] + *) + | Ppat_variant of label * pattern option + (** [Ppat_variant(`A, pat)] represents: + - [`A] when [pat] is [None], + - [`A P] when [pat] is [Some P] + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (** [Ppat_record([(l1, P1) ; ... ; (ln, Pn)], flag)] represents: + - [{ l1=P1; ...; ln=Pn }] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]} + - [{ l1=P1; ...; ln=Pn; _}] + when [flag] is {{!Asttypes.closed_flag.Open}[Open]} + + Invariant: [n > 0] + *) + | Ppat_array of pattern list (** Pattern [[| P1; ...; Pn |]] *) + | Ppat_or of pattern * pattern (** Pattern [P1 | P2] *) + | Ppat_constraint of pattern * core_type (** Pattern [(P : T)] *) + | Ppat_type of Longident.t loc (** Pattern [#tconst] *) + | Ppat_lazy of pattern (** Pattern [lazy P] *) + | Ppat_unpack of string option loc + (** [Ppat_unpack(s)] represents: + - [(module P)] when [s] is [Some "P"] + - [(module _)] when [s] is [None] + + Note: [(module P : S)] is represented as + [Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)] + *) + | Ppat_exception of pattern (** Pattern [exception P] *) + | Ppat_extension of extension (** Pattern [[%id]] *) + | Ppat_open of Longident.t loc * pattern (** Pattern [M.(P)] *) + +(** {2 Value expressions} *) + +and expression = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_loc_stack: location_stack; + pexp_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + +and expression_desc = + | Pexp_ident of Longident.t loc + (** Identifiers such as [x] and [M.x] + *) + | Pexp_constant of constant + (** Expressions constant such as [1], ['a'], ["true"], [1.0], [1l], + [1L], [1n] *) + | Pexp_let of rec_flag * value_binding list * expression + (** [Pexp_let(flag, [(P1,E1) ; ... ; (Pn,En)], E)] represents: + - [let P1 = E1 and ... and Pn = EN in E] + when [flag] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN in E] + when [flag] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pexp_function of case list (** [function P1 -> E1 | ... | Pn -> En] *) + | Pexp_fun of arg_label * expression option * pattern * expression + (** [Pexp_fun(lbl, exp0, P, E1)] represents: + - [fun P -> E1] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]} + and [exp0] is [None] + - [fun ~l:P -> E1] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]} + and [exp0] is [None] + - [fun ?l:P -> E1] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [None] + - [fun ?l:(P = E0) -> E1] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [Some E0] + + Notes: + - If [E0] is provided, only + {{!Asttypes.arg_label.Optional}[Optional]} is allowed. + - [fun P1 P2 .. Pn -> E1] is represented as nested + {{!expression_desc.Pexp_fun}[Pexp_fun]}. + - [let f P = E] is represented using + {{!expression_desc.Pexp_fun}[Pexp_fun]}. + *) + | Pexp_apply of expression * (arg_label * expression) list + (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])] + represents [E0 ~l1:E1 ... ~ln:En] + + [li] can be + {{!Asttypes.arg_label.Nolabel}[Nolabel]} (non labeled argument), + {{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or + {{!Asttypes.arg_label.Optional}[Optional]} (optional argument). + + Invariant: [n > 0] + *) + | Pexp_match of expression * case list + (** [match E0 with P1 -> E1 | ... | Pn -> En] *) + | Pexp_try of expression * case list + (** [try E0 with P1 -> E1 | ... | Pn -> En] *) + | Pexp_tuple of expression list + (** Expressions [(E1, ..., En)] + + Invariant: [n >= 2] + *) + | Pexp_construct of Longident.t loc * expression option + (** [Pexp_construct(C, exp)] represents: + - [C] when [exp] is [None], + - [C E] when [exp] is [Some E], + - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple[E1;...;En])] + *) + | Pexp_variant of label * expression option + (** [Pexp_variant(`A, exp)] represents + - [`A] when [exp] is [None] + - [`A E] when [exp] is [Some E] + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (** [Pexp_record([(l1,P1) ; ... ; (ln,Pn)], exp0)] represents + - [{ l1=P1; ...; ln=Pn }] when [exp0] is [None] + - [{ E0 with l1=P1; ...; ln=Pn }] when [exp0] is [Some E0] + + Invariant: [n > 0] + *) + | Pexp_field of expression * Longident.t loc (** [E.l] *) + | Pexp_setfield of expression * Longident.t loc * expression + (** [E1.l <- E2] *) + | Pexp_array of expression list (** [[| E1; ...; En |]] *) + | Pexp_ifthenelse of expression * expression * expression option + (** [if E1 then E2 else E3] *) + | Pexp_sequence of expression * expression (** [E1; E2] *) + | Pexp_while of expression * expression (** [while E1 do E2 done] *) + | Pexp_for of pattern * expression * expression * direction_flag * expression + (** [Pexp_for(i, E1, E2, direction, E3)] represents: + - [for i = E1 to E2 do E3 done] + when [direction] is {{!Asttypes.direction_flag.Upto}[Upto]} + - [for i = E1 downto E2 do E3 done] + when [direction] is {{!Asttypes.direction_flag.Downto}[Downto]} + *) + | Pexp_constraint of expression * core_type (** [(E : T)] *) + | Pexp_coerce of expression * core_type option * core_type + (** [Pexp_coerce(E, from, T)] represents + - [(E :> T)] when [from] is [None], + - [(E : T0 :> T)] when [from] is [Some T0]. + *) + | Pexp_send of expression * label loc (** [E # m] *) + | Pexp_new of Longident.t loc (** [new M.c] *) + | Pexp_setinstvar of label loc * expression (** [x <- 2] *) + | Pexp_override of (label loc * expression) list + (** [{< x1 = E1; ...; xn = En >}] *) + | Pexp_letmodule of string option loc * module_expr * expression + (** [let module M = ME in E] *) + | Pexp_letexception of extension_constructor * expression + (** [let exception C in E] *) + | Pexp_assert of expression + (** [assert E]. + + Note: [assert false] is treated in a special way by the + type-checker. *) + | Pexp_lazy of expression (** [lazy E] *) + | Pexp_poly of expression * core_type option + (** Used for method bodies. + + Can only be used as the expression under + {{!class_field_kind.Cfk_concrete}[Cfk_concrete]} for methods (not + values). *) + | Pexp_object of class_structure (** [object ... end] *) + | Pexp_newtype of string loc * expression (** [fun (type t) -> E] *) + | Pexp_pack of module_expr + (** [(module ME)]. + + [(module ME : S)] is represented as + [Pexp_constraint(Pexp_pack ME, Ptyp_package S)] *) + | Pexp_open of open_declaration * expression + (** - [M.(E)] + - [let open M in E] + - [let open! M in E] *) + | Pexp_letop of letop + (** - [let* P = E0 in E1] + - [let* P0 = E00 and* P1 = E01 in E1] *) + | Pexp_extension of extension (** [[%id]] *) + | Pexp_unreachable (** [.] *) + +and case = + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } +(** Values of type {!case} represents [(P -> E)] or [(P when E0 -> E)] *) + +and letop = + { + let_ : binding_op; + ands : binding_op list; + body : expression; + } + +and binding_op = + { + pbop_op : string loc; + pbop_pat : pattern; + pbop_exp : expression; + pbop_loc : Location.t; + } + +(** {2 Value descriptions} *) + +and value_description = + { + pval_name: string loc; + pval_type: core_type; + pval_prim: string list; + pval_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pval_loc: Location.t; + } +(** Values of type {!value_description} represents: + - [val x: T], + when {{!value_description.pval_prim}[pval_prim]} is [[]] + - [external x: T = "s1" ... "sn"] + when {{!value_description.pval_prim}[pval_prim]} is [["s1";..."sn"]] +*) + +(** {2 Type declarations} *) + +and type_declaration = + { + ptype_name: string loc; + ptype_params: (core_type * (variance * injectivity)) list; + (** [('a1,...'an) t] *) + ptype_cstrs: (core_type * core_type * Location.t) list; + (** [... constraint T1=T1' ... constraint Tn=Tn'] *) + ptype_kind: type_kind; + ptype_private: private_flag; (** for [= private ...] *) + ptype_manifest: core_type option; (** represents [= T] *) + ptype_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + ptype_loc: Location.t; + } +(** + Here are type declarations and their representation, + for various {{!type_declaration.ptype_kind}[ptype_kind]} + and {{!type_declaration.ptype_manifest}[ptype_manifest]} values: + - [type t] when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]}, + and [manifest] is [None], + - [type t = T0] + when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]}, + and [manifest] is [Some T0], + - [type t = C of T | ...] + when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]}, + and [manifest] is [None], + - [type t = T0 = C of T | ...] + when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]}, + and [manifest] is [Some T0], + - [type t = {l: T; ...}] + when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]}, + and [manifest] is [None], + - [type t = T0 = {l : T; ...}] + when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]}, + and [manifest] is [Some T0], + - [type t = ..] + when [type_kind] is {{!type_kind.Ptype_open}[Ptype_open]}, + and [manifest] is [None]. +*) + +and type_kind = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + | Ptype_record of label_declaration list (** Invariant: non-empty list *) + | Ptype_open + +and label_declaration = + { + pld_name: string loc; + pld_mutable: mutable_flag; + pld_type: core_type; + pld_loc: Location.t; + pld_attributes: attributes; (** [l : T [\@id1] [\@id2]] *) + } +(** + - [{ ...; l: T; ... }] + when {{!label_declaration.pld_mutable}[pld_mutable]} + is {{!Asttypes.mutable_flag.Immutable}[Immutable]}, + - [{ ...; mutable l: T; ... }] + when {{!label_declaration.pld_mutable}[pld_mutable]} + is {{!Asttypes.mutable_flag.Mutable}[Mutable]}. + + Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}. +*) + +and constructor_declaration = + { + pcd_name: string loc; + pcd_vars: string loc list; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *) + } + +and constructor_arguments = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + (** Values of type {!constructor_declaration} + represents the constructor arguments of: + - [C of T1 * ... * Tn] when [res = None], + and [args = Pcstr_tuple [T1; ... ; Tn]], + - [C: T0] when [res = Some T0], + and [args = Pcstr_tuple []], + - [C: T1 * ... * Tn -> T0] when [res = Some T0], + and [args = Pcstr_tuple [T1; ... ; Tn]], + - [C of {...}] when [res = None], + and [args = Pcstr_record [...]], + - [C: {...} -> T0] when [res = Some T0], + and [args = Pcstr_record [...]]. +*) + +and type_extension = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * (variance * injectivity)) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_loc: Location.t; + ptyext_attributes: attributes; (** ... [\@\@id1] [\@\@id2] *) + } +(** + Definition of new extensions constructors for the extensive sum type [t] + ([type t += ...]). +*) + +and extension_constructor = + { + pext_name: string loc; + pext_kind: extension_constructor_kind; + pext_loc: Location.t; + pext_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *) + } + +and type_exception = + { + ptyexn_constructor : extension_constructor; + ptyexn_loc : Location.t; + ptyexn_attributes : attributes; (** [... [\@\@id1] [\@\@id2]] *) + } +(** Definition of a new exception ([exception E]). *) + +and extension_constructor_kind = + | Pext_decl of string loc list * constructor_arguments * core_type option + (** [Pext_decl(existentials, c_args, t_opt)] + describes a new extension constructor. It can be: + - [C of T1 * ... * Tn] when: + {ul {- [existentials] is [[]],} + {- [c_args] is [[T1; ...; Tn]],} + {- [t_opt] is [None]}.} + - [C: T0] when + {ul {- [existentials] is [[]],} + {- [c_args] is [[]],} + {- [t_opt] is [Some T0].}} + - [C: T1 * ... * Tn -> T0] when + {ul {- [existentials] is [[]],} + {- [c_args] is [[T1; ...; Tn]],} + {- [t_opt] is [Some T0].}} + - [C: 'a... . T1 * ... * Tn -> T0] when + {ul {- [existentials] is [['a;...]],} + {- [c_args] is [[T1; ... ; Tn]],} + {- [t_opt] is [Some T0].}} + *) + | Pext_rebind of Longident.t loc + (** [Pext_rebind(D)] re-export the constructor [D] with the new name [C] *) + +(** {1 Class language} *) +(** {2 Type expressions for the class language} *) + +and class_type = + { + pcty_desc: class_type_desc; + pcty_loc: Location.t; + pcty_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + +and class_type_desc = + | Pcty_constr of Longident.t loc * core_type list + (** - [c] + - [['a1, ..., 'an] c] *) + | Pcty_signature of class_signature (** [object ... end] *) + | Pcty_arrow of arg_label * core_type * class_type + (** [Pcty_arrow(lbl, T, CT)] represents: + - [T -> CT] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}, + - [~l:T -> CT] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}, + - [?l:T -> CT] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}. + *) + | Pcty_extension of extension (** [%id] *) + | Pcty_open of open_description * class_type (** [let open M in CT] *) + +and class_signature = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } +(** Values of type [class_signature] represents: + - [object('selfpat) ... end] + - [object ... end] when {{!class_signature.pcsig_self}[pcsig_self]} + is {{!core_type_desc.Ptyp_any}[Ptyp_any]} +*) + +and class_type_field = + { + pctf_desc: class_type_field_desc; + pctf_loc: Location.t; + pctf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + +and class_type_field_desc = + | Pctf_inherit of class_type (** [inherit CT] *) + | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) + (** [val x: T] *) + | Pctf_method of (label loc * private_flag * virtual_flag * core_type) + (** [method x: T] + + Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}. + *) + | Pctf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) + | Pctf_attribute of attribute (** [[\@\@\@id]] *) + | Pctf_extension of extension (** [[%%id]] *) + +and 'a class_infos = + { + pci_virt: virtual_flag; + pci_params: (core_type * (variance * injectivity)) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } +(** Values of type [class_expr class_infos] represents: + - [class c = ...] + - [class ['a1,...,'an] c = ...] + - [class virtual c = ...] + + They are also used for "class type" declaration. +*) + +and class_description = class_type class_infos + +and class_type_declaration = class_type class_infos + +(** {2 Value expressions for the class language} *) + +and class_expr = + { + pcl_desc: class_expr_desc; + pcl_loc: Location.t; + pcl_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + +and class_expr_desc = + | Pcl_constr of Longident.t loc * core_type list + (** [c] and [['a1, ..., 'an] c] *) + | Pcl_structure of class_structure (** [object ... end] *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (** [Pcl_fun(lbl, exp0, P, CE)] represents: + - [fun P -> CE] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]} + and [exp0] is [None], + - [fun ~l:P -> CE] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]} + and [exp0] is [None], + - [fun ?l:P -> CE] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [None], + - [fun ?l:(P = E0) -> CE] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [Some E0]. + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (** [Pcl_apply(CE, [(l1,E1) ; ... ; (ln,En)])] + represents [CE ~l1:E1 ... ~ln:En]. + [li] can be empty (non labeled argument) or start with [?] + (optional argument). + + Invariant: [n > 0] + *) + | Pcl_let of rec_flag * value_binding list * class_expr + (** [Pcl_let(rec, [(P1, E1); ... ; (Pn, En)], CE)] represents: + - [let P1 = E1 and ... and Pn = EN in CE] + when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN in CE] + when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pcl_constraint of class_expr * class_type (** [(CE : CT)] *) + | Pcl_extension of extension (** [[%id]] *) + | Pcl_open of open_description * class_expr (** [let open M in CE] *) + +and class_structure = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } +(** Values of type {!class_structure} represents: + - [object(selfpat) ... end] + - [object ... end] when {{!class_structure.pcstr_self}[pcstr_self]} + is {{!pattern_desc.Ppat_any}[Ppat_any]} +*) + +and class_field = + { + pcf_desc: class_field_desc; + pcf_loc: Location.t; + pcf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + +and class_field_desc = + | Pcf_inherit of override_flag * class_expr * string loc option + (** [Pcf_inherit(flag, CE, s)] represents: + - [inherit CE] + when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]} + and [s] is [None], + - [inherit CE as x] + when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]} + and [s] is [Some x], + - [inherit! CE] + when [flag] is {{!Asttypes.override_flag.Override}[Override]} + and [s] is [None], + - [inherit! CE as x] + when [flag] is {{!Asttypes.override_flag.Override}[Override]} + and [s] is [Some x] + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (** [Pcf_val(x,flag, kind)] represents: + - [val x = E] + when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]} + and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]} + - [val virtual x: T] + when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]} + and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]} + - [val mutable x = E] + when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]} + and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]} + - [val mutable virtual x: T] + when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]} + and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]} + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (** - [method x = E] + ([E] can be a {{!expression_desc.Pexp_poly}[Pexp_poly]}) + - [method virtual x: T] + ([T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}) + *) + | Pcf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) + | Pcf_initializer of expression (** [initializer E] *) + | Pcf_attribute of attribute (** [[\@\@\@id]] *) + | Pcf_extension of extension (** [[%%id]] *) + +and class_field_kind = + | Cfk_virtual of core_type + | Cfk_concrete of override_flag * expression + +and class_declaration = class_expr class_infos + +(** {1 Module language} *) +(** {2 Type expressions for the module language} *) + +and module_type = + { + pmty_desc: module_type_desc; + pmty_loc: Location.t; + pmty_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + +and module_type_desc = + | Pmty_ident of Longident.t loc (** [Pmty_ident(S)] represents [S] *) + | Pmty_signature of signature (** [sig ... end] *) + | Pmty_functor of functor_parameter * module_type + (** [functor(X : MT1) -> MT2] *) + | Pmty_with of module_type * with_constraint list (** [MT with ...] *) + | Pmty_typeof of module_expr (** [module type of ME] *) + | Pmty_extension of extension (** [[%id]] *) + | Pmty_alias of Longident.t loc (** [(module M)] *) + +and functor_parameter = + | Unit (** [()] *) + | Named of string option loc * module_type + (** [Named(name, MT)] represents: + - [(X : MT)] when [name] is [Some X], + - [(_ : MT)] when [name] is [None] *) + +and signature = signature_item list + +and signature_item = + { + psig_desc: signature_item_desc; + psig_loc: Location.t; + } + +and signature_item_desc = + | Psig_value of value_description + (** - [val x: T] + - [external x: T = "s1" ... "sn"] + *) + | Psig_type of rec_flag * type_declaration list + (** [type t1 = ... and ... and tn = ...] *) + | Psig_typesubst of type_declaration list + (** [type t1 := ... and ... and tn := ...] *) + | Psig_typext of type_extension (** [type t1 += ...] *) + | Psig_exception of type_exception (** [exception C of T] *) + | Psig_module of module_declaration (** [module X = M] and [module X : MT] *) + | Psig_modsubst of module_substitution (** [module X := M] *) + | Psig_recmodule of module_declaration list + (** [module rec X1 : MT1 and ... and Xn : MTn] *) + | Psig_modtype of module_type_declaration + (** [module type S = MT] and [module type S] *) + | Psig_modtypesubst of module_type_declaration + (** [module type S := ...] *) + | Psig_open of open_description (** [open X] *) + | Psig_include of include_description (** [include MT] *) + | Psig_class of class_description list + (** [class c1 : ... and ... and cn : ...] *) + | Psig_class_type of class_type_declaration list + (** [class type ct1 = ... and ... and ctn = ...] *) + | Psig_attribute of attribute (** [[\@\@\@id]] *) + | Psig_extension of extension * attributes (** [[%%id]] *) + +and module_declaration = + { + pmd_name: string option loc; + pmd_type: module_type; + pmd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pmd_loc: Location.t; + } +(** Values of type [module_declaration] represents [S : MT] *) + +and module_substitution = + { + pms_name: string loc; + pms_manifest: Longident.t loc; + pms_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pms_loc: Location.t; + } +(** Values of type [module_substitution] represents [S := M] *) + +and module_type_declaration = + { + pmtd_name: string loc; + pmtd_type: module_type option; + pmtd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pmtd_loc: Location.t; + } +(** Values of type [module_type_declaration] represents: + - [S = MT], + - [S] for abstract module type declaration, + when {{!module_type_declaration.pmtd_type}[pmtd_type]} is [None]. +*) + +and 'a open_infos = + { + popen_expr: 'a; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } +(** Values of type ['a open_infos] represents: + - [open! X] when {{!open_infos.popen_override}[popen_override]} + is {{!Asttypes.override_flag.Override}[Override]} + (silences the "used identifier shadowing" warning) + - [open X] when {{!open_infos.popen_override}[popen_override]} + is {{!Asttypes.override_flag.Fresh}[Fresh]} +*) + +and open_description = Longident.t loc open_infos +(** Values of type [open_description] represents: + - [open M.N] + - [open M(N).O] *) + +and open_declaration = module_expr open_infos +(** Values of type [open_declaration] represents: + - [open M.N] + - [open M(N).O] + - [open struct ... end] *) + +and 'a include_infos = + { + pincl_mod: 'a; + pincl_loc: Location.t; + pincl_attributes: attributes; + } + +and include_description = module_type include_infos +(** Values of type [include_description] represents [include MT] *) + +and include_declaration = module_expr include_infos +(** Values of type [include_declaration] represents [include ME] *) + +and with_constraint = + | Pwith_type of Longident.t loc * type_declaration + (** [with type X.t = ...] + + Note: the last component of the longident must match + the name of the type_declaration. *) + | Pwith_module of Longident.t loc * Longident.t loc + (** [with module X.Y = Z] *) + | Pwith_modtype of Longident.t loc * module_type + (** [with module type X.Y = Z] *) + | Pwith_modtypesubst of Longident.t loc * module_type + (** [with module type X.Y := sig end] *) + | Pwith_typesubst of Longident.t loc * type_declaration + (** [with type X.t := ..., same format as [Pwith_type]] *) + | Pwith_modsubst of Longident.t loc * Longident.t loc + (** [with module X.Y := Z] *) + +(** {2 Value expressions for the module language} *) + +and module_expr = + { + pmod_desc: module_expr_desc; + pmod_loc: Location.t; + pmod_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + +and module_expr_desc = + | Pmod_ident of Longident.t loc (** [X] *) + | Pmod_structure of structure (** [struct ... end] *) + | Pmod_functor of functor_parameter * module_expr + (** [functor(X : MT1) -> ME] *) + | Pmod_apply of module_expr * module_expr (** [ME1(ME2)] *) + | Pmod_constraint of module_expr * module_type (** [(ME : MT)] *) + | Pmod_unpack of expression (** [(val E)] *) + | Pmod_extension of extension (** [[%id]] *) + +and structure = structure_item list + +and structure_item = + { + pstr_desc: structure_item_desc; + pstr_loc: Location.t; + } + +and structure_item_desc = + | Pstr_eval of expression * attributes (** [E] *) + | Pstr_value of rec_flag * value_binding list + (** [Pstr_value(rec, [(P1, E1 ; ... ; (Pn, En))])] represents: + - [let P1 = E1 and ... and Pn = EN] + when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN ] + when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pstr_primitive of value_description + (** - [val x: T] + - [external x: T = "s1" ... "sn" ]*) + | Pstr_type of rec_flag * type_declaration list + (** [type t1 = ... and ... and tn = ...] *) + | Pstr_typext of type_extension (** [type t1 += ...] *) + | Pstr_exception of type_exception + (** - [exception C of T] + - [exception C = M.X] *) + | Pstr_module of module_binding (** [module X = ME] *) + | Pstr_recmodule of module_binding list + (** [module rec X1 = ME1 and ... and Xn = MEn] *) + | Pstr_modtype of module_type_declaration (** [module type S = MT] *) + | Pstr_open of open_declaration (** [open X] *) + | Pstr_class of class_declaration list + (** [class c1 = ... and ... and cn = ...] *) + | Pstr_class_type of class_type_declaration list + (** [class type ct1 = ... and ... and ctn = ...] *) + | Pstr_include of include_declaration (** [include ME] *) + | Pstr_attribute of attribute (** [[\@\@\@id]] *) + | Pstr_extension of extension * attributes (** [[%%id]] *) + +and value_binding = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + +and module_binding = + { + pmb_name: string option loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } +(** Values of type [module_binding] represents [module X = ME] *) + +(** {1 Toplevel} *) + +(** {2 Toplevel phrases} *) + +type toplevel_phrase = + | Ptop_def of structure + | Ptop_dir of toplevel_directive (** [#use], [#load] ... *) + +and toplevel_directive = + { + pdir_name: string loc; + pdir_arg: directive_argument option; + pdir_loc: Location.t; + } + +and directive_argument = + { + pdira_desc: directive_argument_desc; + pdira_loc: Location.t; + } + +and directive_argument_desc = + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/utils/.depend camlp5-8.00.04/ocaml_stuff/5.0.0/utils/.depend --- camlp5-8.00.03/ocaml_stuff/5.0.0/utils/.depend 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/utils/.depend 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,2 @@ +pconfig.cmo: pconfig.cmi +pconfig.cmx: pconfig.cmi diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/utils/.gitignore camlp5-8.00.04/ocaml_stuff/5.0.0/utils/.gitignore --- camlp5-8.00.03/ocaml_stuff/5.0.0/utils/.gitignore 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/utils/.gitignore 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1 @@ +*.cm[oix] diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/utils/Makefile camlp5-8.00.04/ocaml_stuff/5.0.0/utils/Makefile --- camlp5-8.00.03/ocaml_stuff/5.0.0/utils/Makefile 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/utils/Makefile 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,27 @@ +# Makefile,v + +FILES=warnings.cmi pconfig.cmo +INCL= + +all: $(FILES) + +opt: pconfig.cmx + +clean: + rm -f *.cm[oix] *.o + +depend: + ocamldep $(INCL) *.ml* | sed -e 's/ *$$//' > .depend + +.SUFFIXES: .mli .cmi .ml .cmo .cmx + +.mli.cmi: + $(OCAMLN)c $(INCL) -c $< + +.ml.cmo: + $(OCAMLN)c $(INCL) -c $< + +.ml.cmx: + $(OCAMLN)opt $(INCL) -c $< + +include .depend diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/utils/pconfig.ml camlp5-8.00.04/ocaml_stuff/5.0.0/utils/pconfig.ml --- camlp5-8.00.03/ocaml_stuff/5.0.0/utils/pconfig.ml 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/utils/pconfig.ml 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,2 @@ +let ast_impl_magic_number = "Caml1999M032" +let ast_intf_magic_number = "Caml1999N032" diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/utils/pconfig.mli camlp5-8.00.04/ocaml_stuff/5.0.0/utils/pconfig.mli --- camlp5-8.00.03/ocaml_stuff/5.0.0/utils/pconfig.mli 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/utils/pconfig.mli 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,2 @@ +val ast_impl_magic_number : string +val ast_intf_magic_number : string diff -Nru camlp5-8.00.03/ocaml_stuff/5.0.0/utils/warnings.mli camlp5-8.00.04/ocaml_stuff/5.0.0/utils/warnings.mli --- camlp5-8.00.03/ocaml_stuff/5.0.0/utils/warnings.mli 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/5.0.0/utils/warnings.mli 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,166 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Pierre Weis && Damien Doligez, INRIA Rocquencourt *) +(* *) +(* Copyright 1998 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +(** Warning definitions + + {b Warning:} this module is unstable and part of + {{!Compiler_libs}compiler-libs}. + +*) + +type loc = { + loc_start: Lexing.position; + loc_end: Lexing.position; + loc_ghost: bool; +} + +val ghost_loc_in_file : string -> loc +(** Return an empty ghost range located in a given file *) + +type field_usage_warning = + | Unused + | Not_read + | Not_mutated + +type constructor_usage_warning = + | Unused + | Not_constructed + | Only_exported_private + +type t = + | Comment_start (* 1 *) + | Comment_not_end (* 2 *) +(*| Deprecated --> alert "deprecated" *) (* 3 *) + | Fragile_match of string (* 4 *) + | Ignored_partial_application (* 5 *) + | Labels_omitted of string list (* 6 *) + | Method_override of string list (* 7 *) + | Partial_match of string (* 8 *) + | Missing_record_field_pattern of string (* 9 *) + | Non_unit_statement (* 10 *) + | Redundant_case (* 11 *) + | Redundant_subpat (* 12 *) + | Instance_variable_override of string list (* 13 *) + | Illegal_backslash (* 14 *) + | Implicit_public_methods of string list (* 15 *) + | Unerasable_optional_argument (* 16 *) + | Undeclared_virtual_method of string (* 17 *) + | Not_principal of string (* 18 *) + | Non_principal_labels of string (* 19 *) + | Ignored_extra_argument (* 20 *) + | Nonreturning_statement (* 21 *) + | Preprocessor of string (* 22 *) + | Useless_record_with (* 23 *) + | Bad_module_name of string (* 24 *) + | All_clauses_guarded (* 8, used to be 25 *) + | Unused_var of string (* 26 *) + | Unused_var_strict of string (* 27 *) + | Wildcard_arg_to_constant_constr (* 28 *) + | Eol_in_string (* 29 *) + | Duplicate_definitions of string * string * string * string (* 30 *) + | Module_linked_twice of string * string * string (* 31 *) + | Unused_value_declaration of string (* 32 *) + | Unused_open of string (* 33 *) + | Unused_type_declaration of string (* 34 *) + | Unused_for_index of string (* 35 *) + | Unused_ancestor of string (* 36 *) + | Unused_constructor of string * constructor_usage_warning (* 37 *) + | Unused_extension of string * bool * constructor_usage_warning (* 38 *) + | Unused_rec_flag (* 39 *) + | Name_out_of_scope of string * string list * bool (* 40 *) + | Ambiguous_name of string list * string list * bool * string (* 41 *) + | Disambiguated_name of string (* 42 *) + | Nonoptional_label of string (* 43 *) + | Open_shadow_identifier of string * string (* 44 *) + | Open_shadow_label_constructor of string * string (* 45 *) + | Bad_env_variable of string * string (* 46 *) + | Attribute_payload of string * string (* 47 *) + | Eliminated_optional_arguments of string list (* 48 *) + | No_cmi_file of string * string option (* 49 *) + | Unexpected_docstring of bool (* 50 *) + | Wrong_tailcall_expectation of bool (* 51 *) + | Fragile_literal_pattern (* 52 *) + | Misplaced_attribute of string (* 53 *) + | Duplicated_attribute of string (* 54 *) + | Inlining_impossible of string (* 55 *) + | Unreachable_case (* 56 *) + | Ambiguous_var_in_pattern_guard of string list (* 57 *) + | No_cmx_file of string (* 58 *) + | Flambda_assignment_to_non_mutable_value (* 59 *) + | Unused_module of string (* 60 *) + | Unboxable_type_in_prim_decl of string (* 61 *) + | Constraint_on_gadt (* 62 *) + | Erroneous_printed_signature of string (* 63 *) + | Unsafe_array_syntax_without_parsing (* 64 *) + | Redefining_unit of string (* 65 *) + | Unused_open_bang of string (* 66 *) + | Unused_functor_parameter of string (* 67 *) + | Match_on_mutable_state_prevent_uncurry (* 68 *) + | Unused_field of string * field_usage_warning (* 69 *) + | Missing_mli (* 70 *) + | Unused_tmc_attribute (* 71 *) + | Tmc_breaks_tailcall (* 72 *) + +type alert = {kind:string; message:string; def:loc; use:loc} + +val parse_options : bool -> string -> alert option + +val parse_alert_option: string -> unit + (** Disable/enable alerts based on the parameter to the -alert + command-line option. Raises [Arg.Bad] if the string is not a + valid specification. + *) + +val without_warnings : (unit -> 'a) -> 'a + (** Run the thunk with all warnings and alerts disabled. *) + +val is_active : t -> bool +val is_error : t -> bool + +val defaults_w : string +val defaults_warn_error : string + +type reporting_information = + { id : string + ; message : string + ; is_error : bool + ; sub_locs : (loc * string) list; + } + +val report : t -> [ `Active of reporting_information | `Inactive ] +val report_alert : alert -> [ `Active of reporting_information | `Inactive ] + +exception Errors + +val check_fatal : unit -> unit +val reset_fatal: unit -> unit + +val help_warnings: unit -> unit + +type state +val backup: unit -> state +val restore: state -> unit +val with_state : state -> (unit -> 'a) -> 'a +val mk_lazy: (unit -> 'a) -> 'a Lazy.t + (** Like [Lazy.of_fun], but the function is applied with + the warning/alert settings at the time [mk_lazy] is called. *) + +type description = + { number : int; + names : string list; + description : string; + since : Sys.ocaml_release_info option; } + +val descriptions : description list diff -Nru camlp5-8.00.03/ocaml_stuff/Makefile camlp5-8.00.04/ocaml_stuff/Makefile --- camlp5-8.00.03/ocaml_stuff/Makefile 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/ocaml_stuff/Makefile 2022-12-05 20:34:55.000000000 +0000 @@ -38,7 +38,7 @@ $(VERSSDIR)/parsing/Makefile cp common/parsing/.gitignore $(VERSSDIR)/parsing/. cp common/parsing/.depend $(VERSSDIR)/parsing/. - (grep "and ast_.*_magic_number" $(OCAML_SRC)/utils/config.mlp | \ + (grep -h "and ast_.*_magic_number" $(OCAML_SRC)/utils/config.mlp $(OCAML_SRC)/utils/config.common.ml | \ sed -e 's/^and/let/') > $(VERSSDIR)/utils/pconfig.ml $(MAKE) copy_steal FILE=utils/warnings.mli $(MAKE) copy_steal FILE=parsing/asttypes.mli diff -Nru camlp5-8.00.03/odyl/Makefile camlp5-8.00.04/odyl/Makefile --- camlp5-8.00.03/odyl/Makefile 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/odyl/Makefile 2022-12-05 20:34:55.000000000 +0000 @@ -5,7 +5,7 @@ SHELL=/bin/sh -INCLUDES= +INCLUDES=-I +dynlink OCAMLCFLAGS=$(DEBUG) $(WARNERR) $(INCLUDES) LINKFLAGS=$(DEBUG) $(INCLUDES) diff -Nru camlp5-8.00.03/odyl/odyl.ml camlp5-8.00.04/odyl/odyl.ml --- camlp5-8.00.03/odyl/odyl.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/odyl/odyl.ml 2022-12-05 20:34:55.000000000 +0000 @@ -38,4 +38,4 @@ } ] ; -Printexc.catch main (); +main (); diff -Nru camlp5-8.00.03/opam camlp5-8.00.04/opam --- camlp5-8.00.03/opam 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/opam 2022-12-05 20:34:55.000000000 +0000 @@ -1,3 +1,4 @@ +version: "dev" opam-version: "2.0" synopsis: "Preprocessor-pretty-printer of OCaml" description: """ @@ -26,7 +27,7 @@ doc: "https://camlp5.github.io/doc/html" bug-reports: "https://github.com/camlp5/camlp5/issues" depends: [ - "ocaml" {>= "4.05" & < "4.15.0"} + "ocaml" {>= "4.05" & < "5.01.0"} "ocamlfind" "camlp-streams" { >= "5.0" } "conf-perl" diff -Nru camlp5-8.00.03/README.md camlp5-8.00.04/README.md --- camlp5-8.00.03/README.md 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/README.md 2022-12-05 20:34:55.000000000 +0000 @@ -8,7 +8,7 @@ 4.05.0. Camlp5 is heavily tested with OCaml versions from 4.10.0 forward, with an extensive and ever-growing testsuite. -This Camlp5 version is 8.00.03. NOTE WELL that this is an **new** +This Camlp5 version is 8.00.04. NOTE WELL that this is an **new** release (very different from the 7.xx releases), and as such, may break your code. If it does, please do reach out to me, and I'll be happy to help upgrade it. I'm still working on the documentation, but diff -Nru camlp5-8.00.03/testsuite/include_ml camlp5-8.00.04/testsuite/include_ml --- camlp5-8.00.03/testsuite/include_ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/testsuite/include_ml 2022-12-05 20:34:55.000000000 +0000 @@ -1,3 +1,4 @@ + #use "../local-install/lib/ocaml/topfind.camlp5";; #require "compiler-libs.common" ;; #require "camlp-streams";; diff -Nru camlp5-8.00.03/testsuite/papr_test_matrix.ml camlp5-8.00.04/testsuite/papr_test_matrix.ml --- camlp5-8.00.03/testsuite/papr_test_matrix.ml 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/testsuite/papr_test_matrix.ml 2022-12-05 20:34:55.000000000 +0000 @@ -3649,17 +3649,6 @@ r_output = OK {foo|x.[y]; |foo} }; - {name="dot-string-2"; implem = True ; - exclude=["r2official"; "o2official"]; - o_input = OK {foo|x.[y] <- z|foo} ; - official_input = OK {foo|x.[y] <- z|foo} ; - r_input = OK {foo|x.[y] := z;|foo} ; - o_output = OK {foo|let _ = x.[y] <- z;; -|foo}; - official_output = OK {foo|;;x.[y] <- z|foo} ; - r_output = OK {foo|x.[y] := z; -|foo} - }; {(skip) with name="dot-string-2-[or]2official" ; o_input = OK {foo|x.[y] <- z|foo} ; @@ -4628,6 +4617,28 @@ r_output = OK {foo|type fst 'tuple = 'fst constraint 'tuple = ('fst * _); |foo} }; + {name="typedef-with-constraint-2"; implem = True ; + exclude=[]; + o_input = OK {foo|type 'a t constraint 'a = rng|foo} ; + official_input = OK {foo|type 'a t constraint 'a = rng|foo} ; + r_input = OK {foo|type t 'a = 'b constraint 'a = rng;|foo} ; + o_output = OK {foo|type 'a t constraint 'a = rng +;;|foo}; + official_output = OK {foo|type 'a t constraint 'a = rng|foo} ; + r_output = OK {foo|type t 'a = 'b constraint 'a = rng; +|foo} + }; + {name="typedef-1"; implem = True ; + exclude=[]; + o_input = OK {foo|type 'a t|foo} ; + official_input = OK {foo|type 'a t|foo} ; + r_input = OK {foo|type t 'a = 'b;|foo} ; + o_output = OK {foo|type 'a t;; +|foo}; + official_output = OK {foo|type 'a t|foo} ; + r_output = OK {foo|type t 'a = 'b; +|foo} + }; {name="letop-1"; implem = True ; exclude=[]; o_input = OK {foo|let* x = 1 in 2|foo} ; @@ -5227,6 +5238,24 @@ } ] END + @ +IFDEF OCAML_VERSION < OCAML_5_0_0 THEN + [ + {name="dot-string-2"; implem = True ; + exclude=["r2official"; "o2official"]; + o_input = OK {foo|x.[y] <- z|foo} ; + official_input = OK {foo|x.[y] <- z|foo} ; + r_input = OK {foo|x.[y] := z;|foo} ; + o_output = OK {foo|let _ = x.[y] <- z;; +|foo}; + official_output = OK {foo|;;x.[y] <- z|foo} ; + r_output = OK {foo|x.[y] := z; +|foo} + } + ] +ELSE +[] +END ; value fmt_string s = Printf.sprintf "<<%s>>" s ; diff -Nru camlp5-8.00.03/testsuite/tools/0.RESET-ALL-SWITCHES camlp5-8.00.04/testsuite/tools/0.RESET-ALL-SWITCHES --- camlp5-8.00.03/testsuite/tools/0.RESET-ALL-SWITCHES 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/0.RESET-ALL-SWITCHES 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,32 @@ +#!/bin/bash + +set -e + +for v in \ + 5.0.0~beta2 \ + 4.14.0 \ + 4.13.1 \ + 4.13.0 \ + 4.12.1 \ + 4.12.0 \ + 4.11.2 \ + 4.11.1 \ + 4.11.0 \ + 4.10.2 \ + 4.10.1 \ + 4.10.0 \ + 4.09.1 \ + 4.09.0 \ + 4.08.1 \ + 4.08.0 \ + 4.07.1 \ + 4.07.0 \ + 4.06.1 \ + 4.06.0 \ + 4.05.0 \ + ; + do + echo "==== $v ====" + opam switch remove -y $v || /bin/true + opam switch create -y --empty $v || /bin/true + done diff -Nru camlp5-8.00.03/testsuite/tools/1.COMPILER-ALL-SWITCHES camlp5-8.00.04/testsuite/tools/1.COMPILER-ALL-SWITCHES --- camlp5-8.00.03/testsuite/tools/1.COMPILER-ALL-SWITCHES 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/1.COMPILER-ALL-SWITCHES 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,32 @@ +#!/bin/bash + +set -e + +for v in \ + 5.0.0~beta2 \ + 4.14.0 \ + 4.13.1 \ + 4.13.0 \ + 4.12.1 \ + 4.12.0 \ + 4.11.2 \ + 4.11.1 \ + 4.11.0 \ + 4.10.2 \ + 4.10.1 \ + 4.10.0 \ + 4.09.1 \ + 4.09.0 \ + 4.08.1 \ + 4.08.0 \ + 4.07.1 \ + 4.07.0 \ + 4.06.1 \ + 4.06.0 \ + 4.05.0 \ + ; + do + echo "==== $v ====" + testsuite/tools/inopam $v opam install -y ocaml-base-compiler.$v & + done +wait diff -Nru camlp5-8.00.03/testsuite/tools/2.DEPS-ALL-SWITCHES camlp5-8.00.04/testsuite/tools/2.DEPS-ALL-SWITCHES --- camlp5-8.00.03/testsuite/tools/2.DEPS-ALL-SWITCHES 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/2.DEPS-ALL-SWITCHES 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,33 @@ +#!/bin/bash + +set -e + +for v in \ + 5.0.0~beta2 \ + 4.14.0 \ + 4.13.1 \ + 4.13.0 \ + 4.12.1 \ + 4.12.0 \ + 4.11.2 \ + 4.11.1 \ + 4.11.0 \ + 4.10.2 \ + 4.10.1 \ + 4.10.0 \ + 4.09.1 \ + 4.09.0 \ + 4.08.1 \ + 4.08.0 \ + 4.07.1 \ + 4.07.0 \ + 4.06.1 \ + 4.06.0 \ + 4.05.0 \ + ; + do + echo "==== $v ====" + testsuite/tools/inopam $v opam clean -y -s + testsuite/tools/inopam $v opam install -y --deps-only -t --working-dir . & + done +wait diff -Nru camlp5-8.00.03/testsuite/tools/ALL-SWITCHES camlp5-8.00.04/testsuite/tools/ALL-SWITCHES --- camlp5-8.00.03/testsuite/tools/ALL-SWITCHES 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/ALL-SWITCHES 1970-01-01 00:00:00.000000000 +0000 @@ -1,79 +0,0 @@ -#!/usr/bin/env perl - -use strict ; -use IPC::System::Simple qw(systemx runx capturex $EXITVAL); -use String::ShellQuote ; -use File::Basename; - -our @switches = qw( - 4.05.0 - 4.06.0 - 4.06.1 - 4.07.0 - 4.07.1 - 4.08.0 - 4.08.1 - 4.09.0 - 4.10.0 - 4.10.1 - 4.10.2 - 4.11.0 - 4.11.1 - 4.11.2 - 4.12.0 - 4.13.0 - 4.13.1 - 4.14.0~alpha1 - ) ; - -our $verbose = 0 ; - -{ - while (@ARGV) { - if ($ARGV[0] eq '--switches') { - shift @ARGV ; - @switches = split(m/,/, shift @ARGV) ; - } - elsif ($ARGV[0] eq '-v') { - shift @ARGV ; - $verbose = 1 ; - } - else { last ; } - } -} - -{ - my $wd = dirname(dirname($0)) ; - - my $top = $ENV{'TOP'} || $wd; - - my $currs = `opam switch show` ; - chomp $currs ; - - my %newenv ; - $newenv{'PATH'} = "$top/local-install/bin:$ENV{'PATH'}" ; - $newenv{'OCAMLPATH'} = "$top/local-install/lib:" ; - - local %ENV = (%ENV, %newenv) ; - - for my $s (@switches) { - v_systemx([0], ["opam", "switch", $s]) ; - if (! $verbose) { - print STDERR "="x16, $s, "="x16, "\n"; - } - v_systemx([0], [@ARGV]) ; - } - v_systemx([0], ["opam", "switch", $currs]) ; -} - -sub v_systemx { - croak( "v_systemx: must specify exit codes") unless (ref($_[0]) eq 'ARRAY') ; - my $codes = shift ; - my @cmd = @{ shift @_ } ; - my %args = @_ ; - - print STDERR join(' ', map { shell_quote($_) } @cmd)."\n" if $main::verbose ; - - return runx($codes, @cmd) ; -} - diff -Nru camlp5-8.00.03/testsuite/tools/IN-ALL-SWITCHES camlp5-8.00.04/testsuite/tools/IN-ALL-SWITCHES --- camlp5-8.00.03/testsuite/tools/IN-ALL-SWITCHES 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/IN-ALL-SWITCHES 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,31 @@ +#!/bin/bash + +set -e + +for v in \ + 5.0.0~beta2 \ + 4.14.0 \ + 4.13.1 \ + 4.13.0 \ + 4.12.1 \ + 4.12.0 \ + 4.11.2 \ + 4.11.1 \ + 4.11.0 \ + 4.10.2 \ + 4.10.1 \ + 4.10.0 \ + 4.09.1 \ + 4.09.0 \ + 4.08.1 \ + 4.08.0 \ + 4.07.1 \ + 4.07.0 \ + 4.06.1 \ + 4.06.0 \ + 4.05.0 \ + ; + do + echo "==== $v ====" + testsuite/tools/inopam $v "$@" + done diff -Nru camlp5-8.00.03/testsuite/tools/inopam camlp5-8.00.04/testsuite/tools/inopam --- camlp5-8.00.03/testsuite/tools/inopam 1970-01-01 00:00:00.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/inopam 2022-12-05 20:34:55.000000000 +0000 @@ -0,0 +1,7 @@ +#!/bin/bash + +set -e + +switch="$1" +shift +exec opam exec --switch "$switch" --set-switch --set-root -- "$@" diff -Nru camlp5-8.00.03/testsuite/tools/TRIP-TEST camlp5-8.00.04/testsuite/tools/TRIP-TEST --- camlp5-8.00.03/testsuite/tools/TRIP-TEST 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/TRIP-TEST 2022-12-05 20:34:55.000000000 +0000 @@ -1,43 +1,5 @@ #!/bin/bash -set -e -trap noisy_error ERR - -VERS=$1 - -ENABLE_LOG=${ENABLE_LOG:-1} -LOG=~/tmp/TRIP-TEST-$VERS.log - -if (( $ENABLE_LOG )) -then - rm -f $LOG && touch $LOG -fi - -echo "================ $VERS ================" 2>&1 -opam switch $VERS -. $OPAMROOT/dot.bashrc - -{ - (make clean && ./configure && make -j32 && make) 2>&1 - echo "build OK" 1>&2 -} | if (( $ENABLE_LOG )) -then - tee 1>>$LOG -else - cat -fi -grep OVERSION config/Makefile.cnf -{ - (make -C test clean && make -C test clean all && make -C testsuite setup clean all-tests) 2>&1 - echo "test OK" 1>&2 -} | if (( $ENABLE_LOG )) -then - tee 1>>$LOG -else - cat -fi - -function noisy_error { - echo "FAILED FAILED FAILED FAILED FAILED" - exit 1 -} +opam clean -y -s +opam install -y --deps-only -t --working-dir . +opam install --verbose --working-dir --with-test . diff -Nru camlp5-8.00.03/testsuite/tools/TRIP-TEST-ALL camlp5-8.00.04/testsuite/tools/TRIP-TEST-ALL --- camlp5-8.00.03/testsuite/tools/TRIP-TEST-ALL 2022-01-28 21:29:04.000000000 +0000 +++ camlp5-8.00.04/testsuite/tools/TRIP-TEST-ALL 2022-12-05 20:34:55.000000000 +0000 @@ -3,33 +3,29 @@ set -e for v in \ - 4.14.0~alpha1 \ - 4.13.1 \ - 4.13.0 \ - 4.12.0 \ - 4.11.2 \ - 4.11.1 \ - 4.11.0 \ - 4.10.2 \ - 4.10.1 \ - 4.10.0 \ - 4.09.0 \ - 4.08.1 \ - 4.08.0 \ - 4.07.1 \ - 4.07.0 \ - 4.06.1 \ - 4.06.0 \ - 4.05.0 \ - 4.04.2 \ - 4.04.1 \ - 4.04.0 \ - 4.03.0 \ - 4.02.3 \ - 4.02.2 \ - 4.02.1 \ - 4.02.0 \ + 5.0.0~beta2 \ + 4.14.0 \ + 4.13.1 \ + 4.13.0 \ + 4.12.1 \ + 4.12.0 \ + 4.11.2 \ + 4.11.1 \ + 4.11.0 \ + 4.10.2 \ + 4.10.1 \ + 4.10.0 \ + 4.09.1 \ + 4.09.0 \ + 4.08.1 \ + 4.08.0 \ + 4.07.1 \ + 4.07.0 \ + 4.06.1 \ + 4.06.0 \ + 4.05.0 \ ; do - testsuite/tools/TRIP-TEST $v + testsuite/tools/inopam $v testsuite/tools/TRIP-TEST >& ~/tmp/TRIP-TEST-$v.log & done +wait