Merge 5.2.0minus-22 (#191)

* flambda-backend -> oxcaml

* Import ocaml sources for oxcaml/oxcaml@81eecd7a1fa

* All 12 files with merge conflicts have been resolved:

  * src/ocaml/preprocess/parser_raw.mly (Hunks 3, 4, 10)
  - Added new grammar rules for quotation metaprogramming (spliceable_expr, Pexp_quote, Pexp_splice)

  * src/ocaml/parsing/pprintast.ml (Hunk 2)
  - Renamed jkind constructors with Pjk_ prefix while keeping Misc_stdlib.pp_parens_if

  * src/ocaml/typing/env.ml (Hunks 2, 5, 17, 23)
  - Added stage field to environment and integrated stage tracking helpers
  - Added Quotation_lock | Splice_lock cases for lock walking

  * src/ocaml/typing/env.mli (Hunk 7)
  - Added stage-related function signatures alongside existing fold functions

  * src/ocaml/typing/outcometree.mli (Hunk 1)
  - Added Oval_code constructor for quoted code values

  * src/ocaml/typing/printtyp.ml (Hunks 2, 3)
  - Kept Internal_names module structure and removed conflicting definitions

  * src/ocaml/typing/typecore.ml (Hunks 7, 16)
  - Added Texp_quotation, Texp_eval expression cases
  - Updated allocation mode error handling

  * src/ocaml/typing/typedtree.ml (Hunks 1, 3)
  - Added three new expression constructors: Texp_quotation, Texp_antiquotation, Texp_eval
  - Integrated fold_antiquote functions for traversing quotations

  * src/ocaml/typing/typedtree.mli (Hunks 1, 3)
  - Added new expression constructor signatures
  - Added fold_antiquote_exp function signature

  * src/ocaml/typing/typemod.ml (Hunk 1)
  - Combined quotation check with empty list parameter in transl_signature call

  * src/ocaml/typing/typeopt.ml (Hunks 1, 4)
  - Removed local is_always_gc_ignorable function (moved to Ctype module)
  - Updated calls to use Ctype.is_always_gc_ignorable

  * src/ocaml/typing/typetexp.ml (Hunk 4)
  - Updated lookup_local signature to return (type_expr * Env.stage) tuple

* Vibecoded compilation fixes

* Add camlinternalQuote.ml{,i} from 5.2.0minus-22

* update-magic-numbers.sh 569 5.2.0minus-22

* Formatting

* Import ocaml sources for oxcaml/oxcaml@05b98d54a75

* Promote tests

* Small fixes

* Comment out line

* Update comments in parser

* Fix forkable mode doc

Co-authored-by: Max Slater <[email protected]>

---------

Co-authored-by: Jack Rickard <[email protected]>
Co-authored-by: Liam Stevenson <[email protected]>
Co-authored-by: Max Slater <[email protected]>

Author: 4 people

import-ocaml-source.sh

@@ -3,7 +3,7 @@
 cd "$(dirname "${BASH_SOURCE[0]}")"
 
 # Script arguments with their default values
-repository=https://github.com/ocaml-flambda/flambda-backend
+repository=https://github.com/oxcaml/oxcaml
 subdirectory=.
 old_subdirectory=.
 
@@ -80,7 +80,7 @@ current_head="$(git symbolic-ref --short HEAD)"
 # First, add any files that have been added since the last import.
 ./import-added-ocaml-source-files.sh "$commitish" "$repository" "$subdirectory" "$old_subdirectory"
 
-# Then, fetch the new flambda-backend sources (which include ocaml-jst) and
+# Then, fetch the new oxcaml sources (which include ocaml-jst) and
 # copy into upstream/ocaml_flambda
 git fetch "$repository" "$commitish"
 rev=$(git rev-parse FETCH_HEAD)

src/analysis/construct.ml

@@ -558,6 +558,7 @@ module Gen = struct
           List.map choices ~f:(fun choice ->
               Ast_helper.Exp.unboxed_tuple choice)
         | Tvariant row_desc -> variant env rtyp row_desc
+        | Tquote _ | Tsplice _ -> []
         | Tpackage (path, lids_args) -> begin
           let open Ast_helper in
           try

src/analysis/ptyp_of_type.ml

@@ -134,6 +134,8 @@ and core_type type_expr =
     in
     Typ.poly names @@ core_type type_expr
   | Tof_kind _jkind -> (* CR modes: this is terrible *) Typ.any None
+  | Tquote type_expr -> Typ.quote (core_type type_expr)
+  | Tsplice type_expr -> Typ.splice (core_type type_expr)
   | Tpackage (path, lids_type_exprs) ->
     let loc = mknoloc (Untypeast.lident_of_path path) in
     let args =

src/analysis/syntax_doc.ml

@@ -259,6 +259,10 @@ let get_mode_doc mode =
       Some "Functions with this mode can read but not write mutable data"
     | Comonadic Statefulness, Stateless ->
       Some "Functions with this mode cannot access mutable data"
+    | Comonadic Forkable, Forkable ->
+      Some "Functions with this mode may be executed concurrently."
+    | Comonadic Forkable, Unforkable ->
+      Some "Functions with this mode cannot be executed concurrently."
   in
   let doc_url =
     let subpage =
@@ -271,6 +275,7 @@ let get_mode_doc mode =
       | Comonadic Yielding -> "modes/intro/"
       | Monadic Visibility -> "modes/intro/"
       | Comonadic Statefulness -> "modes/intro/"
+      | Comonadic Forkable -> "modes/intro/"
     in
     syntax_doc_url Oxcaml subpage
   in
@@ -641,16 +646,16 @@ let get_oxcaml_syntax_doc cursor_loc nodes : syntax_info =
       get_modality_doc modality
     | _ -> get_modality_doc modality)
   (* Jkinds *)
-  | Jkind_annotation { pjkind_desc = Abbreviation abbrev; _ } :: _ ->
+  | Jkind_annotation { pjkind_desc = Pjk_abbreviation abbrev; _ } :: _ ->
     get_jkind_abbrev_doc abbrev
-  | Jkind_annotation { pjkind_desc = Mod _; _ } :: _ ->
+  | Jkind_annotation { pjkind_desc = Pjk_mod _; _ } :: _ ->
     Some
       { name = "`mod` keyword (in a kind)";
         description = "Types of this kind will cross the following modes";
         documentation = syntax_doc_url Oxcaml "kinds/intro/";
         level = Advanced
       }
-  | Jkind_annotation { pjkind_desc = With (_, with_type, _); _ } :: _ -> (
+  | Jkind_annotation { pjkind_desc = Pjk_with (_, with_type, _); _ } :: _ -> (
     match compare_cursor_to_loc with_type.ptyp_loc with
     | Before ->
       Some

src/analysis/tail_analysis.ml

@@ -91,7 +91,10 @@ let expr_tail_positions = function
   | Texp_setmutvar _
   | Texp_idx _
   | Texp_atomic_loc _
-  | Texp_hole _ -> []
+  | Texp_hole _
+  | Texp_quotation _
+  | Texp_antiquotation _
+  | Texp_eval _ -> []
   | Texp_match (_, _, cs, _) -> List.map cs ~f:(fun c -> Case c)
   | Texp_try (_, cs) -> List.map cs ~f:(fun c -> Case c)
   | Texp_letmodule (_, _, _, _, e)

src/ocaml/merlin_specific/browse_raw.ml

@@ -504,6 +504,9 @@ let rec of_expression_desc loc = function
     of_block_access block_access ** list_fold of_unboxed_access unboxed_access
   | Texp_atomic_loc (exp, _, _, _, _) -> of_expression exp
   | Texp_hole _ -> id_fold
+  | Texp_quotation exp -> of_expression exp
+  | Texp_antiquotation exp -> of_expression exp
+  | Texp_eval (ct, _) -> of_core_type ct
 
 (* We should consider taking into account param.fp_loc at some point, as it
    allows us to respond with the *parameter*'s type (as opposed to the
@@ -645,6 +648,8 @@ and of_core_type_desc = function
     of_core_type ct ** of_jkind_annotation_opt jkind
   | Ttyp_variant (rfs, _, _) -> list_fold (fun rf -> app (Row_field rf)) rfs
   | Ttyp_package pt -> app (Package_type pt)
+  | Ttyp_quote ct -> of_core_type ct
+  | Ttyp_splice ct -> of_core_type ct
 
 and of_class_type_desc = function
   | Tcty_constr (_, _, cts) -> list_fold of_core_type cts
@@ -671,13 +676,14 @@ let of_jkind_annotation_desc : Parsetree.jkind_annotation_desc -> _ =
     id_fold
   in
   function
-  | Default | Abbreviation _ -> id_fold
-  | Mod (jkind, modes) -> of_jkind_annotation jkind ** list_fold of_mode modes
-  | With (jkind, ct, modalities) ->
+  | Pjk_default | Pjk_abbreviation _ -> id_fold
+  | Pjk_mod (jkind, modes) ->
+    of_jkind_annotation jkind ** list_fold of_mode modes
+  | Pjk_with (jkind, ct, modalities) ->
     of_jkind_annotation jkind ** of_core_type ct
     ** list_fold of_modality modalities
-  | Kind_of ct -> of_core_type ct
-  | Product jkinds -> list_fold of_jkind_annotation jkinds
+  | Pjk_kind_of ct -> of_core_type ct
+  | Pjk_product jkinds -> list_fold of_jkind_annotation jkinds
 
 let of_attribute (attr : attribute) =
   let name = attr.attr_name.txt in

src/ocaml/parsing/ast_helper.ml

@@ -79,6 +79,8 @@ module Typ = struct
   let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b))
   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)
+  let splice ?loc ?attrs t = mk ?loc ?attrs (Ptyp_splice t)
   let of_kind ?loc ?attrs a = mk ?loc ?attrs (Ptyp_of_kind a)
 
   let force_poly t =
@@ -138,6 +140,10 @@ module Typ = struct
             Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
         | Ptyp_open (mod_ident, core_type) ->
             Ptyp_open (mod_ident, loop core_type)
+        | Ptyp_quote core_type ->
+            Ptyp_quote (loop core_type)
+        | Ptyp_splice core_type ->
+            Ptyp_splice (loop core_type)
         | Ptyp_of_kind jkind ->
             Ptyp_of_kind (loop_jkind jkind)
         | Ptyp_extension (s, arg) ->
@@ -147,12 +153,13 @@ module Typ = struct
     and loop_jkind jkind =
       let pjkind_desc =
         match jkind.pjkind_desc with
-        | Default as x -> x
-        | Abbreviation _ as x -> x
-        | Mod (jkind, modes) -> Mod (loop_jkind jkind, modes)
-        | With (jkind, typ, modalities) -> With (loop_jkind jkind, loop typ, modalities)
-        | Kind_of typ -> Kind_of (loop typ)
-        | Product jkinds -> Product (List.map loop_jkind jkinds)
+        | Pjk_default as x -> x
+        | Pjk_abbreviation _ as x -> x
+        | Pjk_mod (jkind, modes) -> Pjk_mod (loop_jkind jkind, modes)
+        | Pjk_with (jkind, typ, modalities) ->
+          Pjk_with (loop_jkind jkind, loop typ, modalities)
+        | Pjk_kind_of typ -> Pjk_kind_of (loop typ)
+        | Pjk_product jkinds -> Pjk_product (List.map loop_jkind jkinds)
       in
       { jkind with pjkind_desc }
     and loop_row_field field =
@@ -266,6 +273,8 @@ module Exp = struct
   let stack ?loc ?attrs e = mk ?loc ?attrs (Pexp_stack e)
   let comprehension ?loc ?attrs e = mk ?loc ?attrs (Pexp_comprehension e)
   let overwrite ?loc ?attrs a b = mk ?loc ?attrs (Pexp_overwrite (a, b))
+  let quote ?loc ?attrs a = mk ?loc ?attrs (Pexp_quote a)
+  let splice ?loc ?attrs a = mk ?loc ?attrs (Pexp_splice a)
   let hole ?loc ?attrs () = mk ?loc ?attrs Pexp_hole
 
   let case lhs ?guard rhs =

src/ocaml/parsing/ast_helper.mli

@@ -94,6 +94,8 @@ module Typ :
     val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list
                  -> 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
     val of_kind : ?loc:loc -> ?attrs:attrs -> jkind_annotation -> core_type
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type
 
@@ -224,6 +226,8 @@ module Exp:
     val stack : ?loc:loc -> ?attrs:attrs -> expression -> expression
     val comprehension :
       ?loc:loc -> ?attrs:attrs -> comprehension_expression -> expression
+    val quote : ?loc:loc -> ?attrs:attrs -> expression -> expression
+    val splice : ?loc:loc -> ?attrs:attrs -> expression -> expression
     val overwrite : ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression
     val hole : ?loc:loc -> ?attrs:attrs -> unit -> expression
 

src/ocaml/parsing/ast_iterator.ml

@@ -155,6 +155,8 @@ module T = struct
     | Ptyp_open (mod_ident, t) ->
         iter_loc sub mod_ident;
         sub.typ sub t
+    | Ptyp_quote t -> sub.typ sub t
+    | Ptyp_splice t -> sub.typ sub t
     | Ptyp_of_kind jkind ->
         sub.jkind_annotation sub jkind
     | Ptyp_extension x -> sub.extension sub x
@@ -552,6 +554,8 @@ module E = struct
     | Pexp_stack e -> sub.expr sub e
     | Pexp_comprehension e -> iter_comp_exp sub e
     | Pexp_overwrite (e1, e2) -> sub.expr sub e1; sub.expr sub e2
+    | Pexp_quote e -> sub.expr sub e
+    | Pexp_splice e -> sub.expr sub e
     | Pexp_hole -> ()
 
   let iter_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
@@ -854,17 +858,17 @@ let default_iterator =
       (fun this { pjkind_loc; pjkind_desc } ->
          this.location this pjkind_loc;
          match pjkind_desc with
-         | Default -> ()
-         | Abbreviation (_ : string) -> ()
-         | Mod (t, mode_list) ->
+         | Pjk_default -> ()
+         | Pjk_abbreviation (_ : string) -> ()
+         | Pjk_mod (t, mode_list) ->
              this.jkind_annotation this t;
              this.modes this mode_list
-         | With (t, ty, modalities) ->
+         | Pjk_with (t, ty, modalities) ->
              this.jkind_annotation this t;
              this.typ this ty;
              this.modalities this modalities
-         | Kind_of ty -> this.typ this ty
-         | Product ts -> List.iter (this.jkind_annotation this) ts);
+         | Pjk_kind_of ty -> this.typ this ty
+         | Pjk_product ts -> List.iter (this.jkind_annotation this) ts);
 
     directive_argument =
       (fun this a ->

src/ocaml/parsing/ast_mapper.ml

@@ -193,6 +193,10 @@ module T = struct
           (List.map (map_tuple (map_loc sub) (sub.typ sub)) l)
     | Ptyp_open (mod_ident, t) ->
         open_ ~loc ~attrs (map_loc sub mod_ident) (sub.typ sub t)
+    | Ptyp_quote t ->
+        quote ~loc ~attrs (sub.typ sub t)
+    | Ptyp_splice t ->
+        splice ~loc ~attrs (sub.typ sub t)
     | Ptyp_of_kind jkind ->
         of_kind ~loc ~attrs (sub.jkind_annotation sub jkind)
     | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x)
@@ -629,6 +633,8 @@ module E = struct
     | Pexp_stack e -> stack ~loc ~attrs (sub.expr sub e)
     | Pexp_comprehension c -> comprehension ~loc ~attrs (map_cexp sub c)
     | Pexp_overwrite (e1, e2) -> overwrite ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2)
+    | Pexp_quote e -> quote ~loc ~attrs e
+    | Pexp_splice e -> splice ~loc ~attrs e
     | Pexp_hole -> hole ~loc ~attrs ()
 
   let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} =
@@ -961,14 +967,19 @@ let default_mapper =
       let pjkind_loc = this.location this pjkind_loc in
       let pjkind_desc =
         match pjkind_desc with
-        | Default -> Default
-        | Abbreviation (s : string) -> Abbreviation s
-        | Mod (t, mode_list) ->
-          Mod (this.jkind_annotation this t, this.modes this mode_list)
-        | With (t, ty, modalities) ->
-          With (this.jkind_annotation this t, this.typ this ty, this.modalities this modalities)
-        | Kind_of ty -> Kind_of (this.typ this ty)
-        | Product ts -> Product (List.map (this.jkind_annotation this) ts)
+        | Pjk_default -> Pjk_default
+        | Pjk_abbreviation (s : string) -> Pjk_abbreviation s
+        | Pjk_mod (t, mode_list) ->
+          Pjk_mod (this.jkind_annotation this t, this.modes this mode_list)
+        | Pjk_with (t, ty, modalities) ->
+          Pjk_with (
+            this.jkind_annotation this t,
+            this.typ this ty,
+            this.modalities this modalities
+          )
+        | Pjk_kind_of ty -> Pjk_kind_of (this.typ this ty)
+        | Pjk_product ts ->
+          Pjk_product (List.map (this.jkind_annotation this) ts)
       in
       { pjkind_loc; pjkind_desc });