Skip to content

[5.4] Merge minus-37 #239

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
dkalinichenko-js wants to merge 2 commits into
base: main
Choose a base branch
from
Draft

[5.4] Merge minus-37 #239

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
38f77e9
Import ocaml sources for oxcaml/oxcaml.git@02fe39378b
d-kalinichenko May 5, 2026
9ad0814
Commit conflicts
d-kalinichenko May 5, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 27 additions & 13 deletions src/ocaml/parsing/ast_helper.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,15 +36,21 @@ let with_default_loc l f =
Misc.protect_refs [Misc.R (default_loc, l)] f

module Const = struct
let integer ?suffix i = Pconst_integer (i, suffix)
let int ?suffix i = integer ?suffix (Int.to_string i)
let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i)
let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i)
let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i)
let float ?suffix f = Pconst_float (f, suffix)
let char c = Pconst_char c
let mk ?(loc = !default_loc) d =
{pconst_desc = d;
pconst_loc = loc}

let integer ?loc ?suffix i = mk ?loc (Pconst_integer (i, suffix))
let int ?loc ?suffix i = integer ?loc ?suffix (Int.to_string i)
let int32 ?loc ?(suffix='l') i = integer ?loc ~suffix (Int32.to_string i)
let int64 ?loc ?(suffix='L') i = integer ?loc ~suffix (Int64.to_string i)
let nativeint ?loc ?(suffix='n') i =
integer ?loc ~suffix (Nativeint.to_string i)
let float ?loc ?suffix f = mk ?loc (Pconst_float (f, suffix))
let char ?loc c = mk ?loc (Pconst_char c)
let untagged_char ?loc c = mk ?loc (Pconst_untagged_char c)
let string ?quotation_delimiter ?(loc= !default_loc) s =
Pconst_string (s, loc, quotation_delimiter)
mk ~loc (Pconst_string (s, loc, quotation_delimiter))
end

module Attr = struct
Expand Down Expand Up @@ -76,7 +82,7 @@ module Typ = struct
let alias ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_alias (a, b, c))
let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))
let package ?loc ?attrs a = mk ?loc ?attrs (Ptyp_package a)
let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a)
let open_ ?loc ?attrs mod_ident t = mk ?loc ?attrs (Ptyp_open (mod_ident, t))
let quote ?loc ?attrs t = mk ?loc ?attrs (Ptyp_quote t)
Expand Down Expand Up @@ -138,8 +144,8 @@ module Typ = struct
v, jkind) var_lst
in
Ptyp_poly(var_lst, loop core_type)
| Ptyp_package(longident,lst) ->
Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
| Ptyp_package ptyp ->
Ptyp_package (loop_package_type ptyp)
| Ptyp_open (mod_ident, core_type) ->
Ptyp_open (mod_ident, loop core_type)
| Ptyp_quote core_type ->
Expand Down Expand Up @@ -184,9 +190,17 @@ module Typ = struct
Oinherit (loop t)
in
{ field with pof_desc; }
and loop_package_type ptyp =
{ ptyp with
ppt_cstrs = List.map (fun (n,typ) -> (n,loop typ) ) ptyp.ppt_cstrs }
in
loop t

let package_type ?(loc = !default_loc) ?(attrs = []) p c =
{ppt_loc = loc;
ppt_path = p;
ppt_cstrs = c;
ppt_attrs = attrs}
end

module Pat = struct
Expand Down Expand Up @@ -219,6 +233,7 @@ module Pat = struct
let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a)
let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b))
let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a)
let effect_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_effect(a, b))
let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a)
end

Expand Down Expand Up @@ -274,7 +289,7 @@ module Exp = struct
let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b))
let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a)
let newtype ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_newtype (a, b, c))
let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
let pack ?loc ?attrs a b = mk ?loc ?attrs (Pexp_pack (a, b))
let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b))
let letop ?loc ?attrs let_ ands body =
mk ?loc ?attrs (Pexp_letop {let_; ands; body})
Expand Down Expand Up @@ -704,7 +719,6 @@ module Te = struct
pext_loc = loc;
pext_attributes = add_docs_attrs docs (add_info_attrs info attrs);
}

end

module Csig = struct
Expand Down
37 changes: 23 additions & 14 deletions src/ocaml/parsing/ast_helper.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,15 +46,17 @@ val with_default_loc: loc -> (unit -> 'a) -> 'a
(** {1 Constants} *)

module Const : sig
val char : char -> constant
val mk : ?loc:loc -> constant_desc -> constant
val char : ?loc:loc -> char -> constant
val untagged_char : ?loc:loc -> char -> constant
val string :
?quotation_delimiter:string -> ?loc:Location.t -> string -> constant
val integer : ?suffix:char -> string -> constant
val int : ?suffix:char -> int -> constant
val int32 : ?suffix:char -> int32 -> constant
val int64 : ?suffix:char -> int64 -> constant
val nativeint : ?suffix:char -> nativeint -> constant
val float : ?suffix:char -> string -> constant
val integer : ?loc:loc -> ?suffix:char -> string -> constant
val int : ?loc:loc -> ?suffix:char -> int -> constant
val int32 : ?loc:loc -> ?suffix:char -> int32 -> constant
val int64 : ?loc:loc -> ?suffix:char -> int64 -> constant
val nativeint : ?loc:loc -> ?suffix:char -> nativeint -> constant
val float : ?loc:loc -> ?suffix:char -> string -> constant
end

(** {1 Attributes} *)
Expand All @@ -77,7 +79,8 @@ module Typ :
-> core_type
val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type ->
mode with_loc list -> mode with_loc list -> core_type
val tuple: ?loc:loc -> ?attrs:attrs -> (string option * core_type) list -> core_type
val tuple: ?loc:loc -> ?attrs:attrs -> (string option * core_type) list
-> core_type
val unboxed_tuple: ?loc:loc -> ?attrs:attrs
-> (string option * core_type) list -> core_type
val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
Expand All @@ -91,8 +94,7 @@ module Typ :
-> label list option -> core_type
val poly: ?loc:loc -> ?attrs:attrs ->
(str * jkind_annotation option) list -> core_type -> core_type
val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list
-> core_type
val package: ?loc:loc -> ?attrs:attrs -> package_type -> core_type
val open_ : ?loc:loc -> ?attrs:attrs -> lid -> core_type -> core_type
val quote : ?loc:loc -> ?attrs:attrs -> core_type -> core_type
val splice : ?loc:loc -> ?attrs:attrs -> core_type -> core_type
Expand All @@ -113,6 +115,10 @@ module Typ :
['a. 'a -> 'a] during parsing.
@since 4.05
*)

val package_type: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list
-> package_type
(** @since 5.4 *)
end

(** Patterns *)
Expand All @@ -128,11 +134,11 @@ module Pat:
val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
val unboxed_unit: ?loc:loc -> ?attrs:attrs -> unit -> pattern
val unboxed_bool: ?loc:loc -> ?attrs:attrs -> bool -> pattern
val tuple: ?loc:loc -> ?attrs:attrs -> (string option * pattern) list ->
closed_flag -> pattern
val unboxed_tuple: ?loc:loc -> ?attrs:attrs
-> (string option * pattern) list -> closed_flag
-> pattern
val tuple: ?loc:loc -> ?attrs:attrs -> (string option * pattern) list
-> closed_flag -> pattern
val construct: ?loc:loc -> ?attrs:attrs ->
lid -> ((str * jkind_annotation option) list * pattern) option -> pattern
val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
Expand All @@ -150,6 +156,7 @@ module Pat:
val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern
val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern
val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern
val effect_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern
val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern
end

Expand All @@ -173,9 +180,10 @@ module Exp:
val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
val unboxed_unit: ?loc:loc -> ?attrs:attrs -> unit -> expression
val unboxed_bool: ?loc:loc -> ?attrs:attrs -> bool -> expression
val tuple: ?loc:loc -> ?attrs:attrs -> (string option * expression) list -> expression
val unboxed_tuple: ?loc:loc -> ?attrs:attrs
-> (string option * expression) list -> expression
val tuple: ?loc:loc -> ?attrs:attrs -> (string option * expression) list
-> expression
val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option
-> expression
val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option
Expand Down Expand Up @@ -223,7 +231,8 @@ module Exp:
val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression
val newtype: ?loc:loc -> ?attrs:attrs -> str -> jkind_annotation option ->
expression -> expression
val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression
val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> package_type option
-> expression
val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression
-> expression
val letop: ?loc:loc -> ?attrs:attrs -> binding_op
Expand Down
Loading
Loading