Apply changes from PR 2676 as on 6/21/24

ocaml-flambda · goldfirere · Jun 25, 2024 · Jun 21, 2024 · Jun 21, 2024 · Jun 21, 2024
commit 02a9777f454f129520c22a97b87028ceb80241f4
diff --git a/chamelon/compat.jst.ml b/chamelon/compat.jst.ml
@@ -2,7 +2,7 @@ open Typedtree
 open Types
 open Mode
 
-let dummy_jkind = Jkind.value ~why:(Unknown "dummy_layout")
+let dummy_jkind = Jkind.Primitive.value ~why:(Unknown "dummy_layout")
 let dummy_value_mode = Value.disallow_right Value.legacy
 let mkTvar name = Tvar { name; jkind = dummy_jkind }
 
@@ -102,7 +102,7 @@ let texp_function_cases_identifier_defaults =
     last_arg_exp_extra = None;
     last_arg_attributes = [];
     env = Env.empty;
-    ret_type = Ctype.newvar (Jkind.any ~why:Dummy_jkind);
+    ret_type = Ctype.newvar (Jkind.Primitive.any ~why:Dummy_jkind);
   }
 
 let texp_function_param_identifier_defaults =

diff --git a/native_toplevel/opttopdirs.ml b/native_toplevel/opttopdirs.ml
@@ -138,7 +138,7 @@ let match_printer_type ppf desc typename =
         raise Exit
   in
   Ctype.with_local_level ~post:Ctype.generalize (fun () ->
-    let ty_arg = Ctype.newvar (Jkind.value ~why:Debug_printer_argument) in
+    let ty_arg = Ctype.newvar (Jkind.Primitive.value ~why:Debug_printer_argument) in
     Ctype.unify !toplevel_env
       (Ctype.newconstr printer_type [ty_arg])
       (Ctype.instance desc.val_type);

diff --git a/ocaml/debugger/loadprinter.ml b/ocaml/debugger/loadprinter.ml
@@ -93,7 +93,7 @@ let eval_value_path env path =
 
 let match_printer_type desc make_printer_type =
   Ctype.with_local_level ~post:Ctype.generalize begin fun () ->
-    let ty_arg = Ctype.newvar Jkind.(value ~why:Debug_printer_argument) in
+    let ty_arg = Ctype.newvar (Jkind.Primitive.value ~why:Debug_printer_argument) in
     Ctype.unify (Lazy.force Env.initial)
       (make_printer_type ty_arg)
       (Ctype.instance desc.val_type);

diff --git a/ocaml/debugger4/loadprinter.ml b/ocaml/debugger4/loadprinter.ml
@@ -93,7 +93,7 @@ let eval_value_path env path =
 
 let match_printer_type desc make_printer_type =
   Ctype.with_local_level ~post:Ctype.generalize begin fun () ->
-    let ty_arg = Ctype.newvar Jkind.(value ~why:Debug_printer_argument) in
+    let ty_arg = Ctype.newvar Jkind.Primitive.(value ~why:Debug_printer_argument) in
     Ctype.unify (Lazy.force Env.initial)
       (make_printer_type ty_arg)
       (Ctype.instance desc.val_type);

diff --git a/ocaml/lambda/matching.ml b/ocaml/lambda/matching.ml
@@ -106,8 +106,10 @@ exception Error of Location.t * error
 let dbg = false
 
 let jkind_layout_default_to_value_and_check_not_void loc jkind =
-  match Jkind.get_default_value jkind with
-  | Void -> raise (Error (loc, Void_layout))
+  let const = Jkind.default_to_value_and_get jkind in
+  let layout = Jkind.Const.get_layout const in
+  match layout with
+  | Sort Void -> raise (Error (loc, Void_layout))
   | _ -> ()
 ;;
 

diff --git a/ocaml/lambda/translcore.ml b/ocaml/lambda/translcore.ml
@@ -54,7 +54,7 @@ let layout_exp sort e = layout e.exp_env e.exp_loc sort e.exp_type
 let layout_pat sort p = layout p.pat_env p.pat_loc sort p.pat_type
 
 let check_record_field_sort loc sort =
-  match Jkind.Sort.get_default_value sort with
+  match Jkind.Sort.default_to_value_and_get sort with
   | Value | Float64 | Float32 | Bits32 | Bits64 | Word -> ()
   | Void -> raise (Error (loc, Illegal_void_record_field))
 
@@ -1022,7 +1022,7 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
             match
               Ctype.check_type_jkind
                 e.exp_env (Ctype.correct_levels val_type)
-                (Jkind.value ~why:Probe)
+                (Jkind.Primitive.value ~why:Probe)
             with
             | Ok _ -> ()
             | Error _ -> raise (Error (e.exp_loc, Bad_probe_layout id))

diff --git a/ocaml/lambda/translmod.ml b/ocaml/lambda/translmod.ml
@@ -300,7 +300,7 @@ let init_shape id modl =
             Tarrow(_,ty_arg,_,_) -> begin
               (* CR layouts: We should allow any representable layout here. It
                  will require reworking [camlinternalMod.init_mod]. *)
-              let jkind = Jkind.value ~why:Recmod_fun_arg in
+              let jkind = Jkind.Primitive.value ~why:Recmod_fun_arg in
               let ty_arg = Ctype.correct_levels ty_arg in
               match Ctype.check_type_jkind env ty_arg jkind with
               | Ok _ -> const_int 0 (* camlinternalMod.Function *)

diff --git a/ocaml/lambda/translprim.ml b/ocaml/lambda/translprim.ml
@@ -143,7 +143,7 @@ let to_modify_mode ~poly = function
 let extern_repr_of_native_repr:
   poly_sort:Jkind.Sort.t option -> Primitive.native_repr -> Lambda.extern_repr
   = fun ~poly_sort r -> match r, poly_sort with
-  | Repr_poly, Some s -> Same_as_ocaml_repr (Jkind.Sort.get_default_value s)
+  | Repr_poly, Some s -> Same_as_ocaml_repr (Jkind.Sort.default_to_value_and_get s)
   | Repr_poly, None -> Misc.fatal_error "Unexpected Repr_poly"
   | Same_as_ocaml_repr s, _ -> Same_as_ocaml_repr s
   | Unboxed_float f, _ -> Unboxed_float f

diff --git a/ocaml/ocamldoc/odoc_sig.ml b/ocaml/ocamldoc/odoc_sig.ml
@@ -493,7 +493,7 @@ module Analyser =
           { Typedtree.ld_id; ld_mutable; ld_type; ld_loc; ld_attributes } =
         get_field env comments @@
         {Types.ld_id; ld_mutable; ld_modalities = Mode.Modality.Value.id;
-         ld_jkind=Jkind.any ~why:Dummy_jkind (* ignored *);
+         ld_jkind=Jkind.Primitive.any ~why:Dummy_jkind (* ignored *);
          ld_type=ld_type.Typedtree.ctyp_type;
          ld_loc; ld_attributes; ld_uid=Types.Uid.internal_not_actually_unique} in
       let open Typedtree in

diff --git a/ocaml/parsing/ast_iterator.ml b/ocaml/parsing/ast_iterator.ml
@@ -1009,7 +1009,7 @@ let default_iterator =
     jkind_annotation =
       (fun this -> function
         | Default -> ()
-        | Primitive_layout_or_abbreviation s ->
+        | Abbreviation s ->
           iter_loc this (s : Jane_syntax.Jkind.Const.t :> _ loc)
         | Mod (t, mode_list) ->
           this.jkind_annotation this t;

diff --git a/ocaml/parsing/ast_mapper.ml b/ocaml/parsing/ast_mapper.ml
@@ -1129,11 +1129,11 @@ let default_mapper =
       let open Jane_syntax in
       function
       | Default -> Default
-      | Primitive_layout_or_abbreviation s ->
+      | Abbreviation s ->
         let {txt; loc} =
           map_loc this (s : Jkind.Const.t :> _ loc)
         in
-        Primitive_layout_or_abbreviation (Jkind.Const.mk txt loc)
+        Abbreviation (Jkind.Const.mk txt loc)
       | Mod (t, mode_list) ->
         Mod (this.jkind_annotation this t, this.modes this mode_list)
       | With (t, ty) ->

diff --git a/ocaml/parsing/jane_syntax.ml b/ocaml/parsing/jane_syntax.ml
@@ -514,7 +514,7 @@ module Jkind = struct
 
   type t =
     | Default
-    | Primitive_layout_or_abbreviation of Const.t
+    | Abbreviation of Const.t
     | Mod of t * Mode_expr.t
     | With of t * core_type
     | Kind_of of core_type
@@ -571,8 +571,8 @@ module Jkind = struct
     let to_structure_item t = to_structure_item (Location.mknoloc t) in
     match t_loc.txt with
     | Default -> struct_item_of_list "default" [] t_loc.loc
-    | Primitive_layout_or_abbreviation c ->
-      struct_item_of_list "prim" [Const.to_structure_item c] t_loc.loc
+    | Abbreviation c ->
+      struct_item_of_list "abbrev" [Const.to_structure_item c] t_loc.loc
     | Mod (t, mode_list) ->
       let mode_list_item =
         struct_item_of_attr
@@ -607,9 +607,8 @@ module Jkind = struct
               ret loc (With (t, ty))))
     | Some ("kind_of", [item_of_ty], loc) ->
       bind (struct_item_to_type item_of_ty) (fun ty -> ret loc (Kind_of ty))
-    | Some ("prim", [item], loc) ->
-      bind (Const.of_structure_item item) (fun c ->
-          ret loc (Primitive_layout_or_abbreviation c))
+    | Some ("abbrev", [item], loc) ->
+      bind (Const.of_structure_item item) (fun c -> ret loc (Abbreviation c))
     | Some _ | None -> None
 end
 

diff --git a/ocaml/parsing/jane_syntax.mli b/ocaml/parsing/jane_syntax.mli
@@ -199,7 +199,7 @@ module Jkind : sig
 
   type t =
     | Default
-    | Primitive_layout_or_abbreviation of Const.t
+    | Abbreviation of Const.t
     | Mod of t * Mode_expr.t
     | With of t * Parsetree.core_type
     | Kind_of of Parsetree.core_type

diff --git a/ocaml/parsing/parser.mly b/ocaml/parsing/parser.mly
@@ -3879,8 +3879,7 @@ jkind:
     }
   | mkrhs(ident) {
       let {txt; loc} = $1 in
-      Jane_syntax.Jkind.(Primitive_layout_or_abbreviation
-        (Const.mk txt loc))
+      Jane_syntax.Jkind.(Abbreviation (Const.mk txt loc))
     }
   | KIND_OF ty=core_type {
       Jane_syntax.Jkind.Kind_of ty

diff --git a/ocaml/parsing/pprintast.ml b/ocaml/parsing/pprintast.ml
@@ -375,7 +375,7 @@ and type_with_label ctxt f (label, c) =
 
 and jkind ctxt f k = match (k : Jane_syntax.Jkind.t) with
   | Default -> pp f "_"
-  | Primitive_layout_or_abbreviation s ->
+  | Abbreviation s ->
     pp f "%s" (s : Jane_syntax.Jkind.Const.t :> _ loc).txt
   | Mod (t, { txt = mode_list }) ->
     begin match mode_list with

diff --git a/ocaml/parsing/pprintast.mli b/ocaml/parsing/pprintast.mli
@@ -59,3 +59,4 @@ val tyvar: Format.formatter -> string -> unit
       position, or for keywords by escaping them with \#. No-op on "_". *)
 
 val jkind : Format.formatter -> Jane_syntax.Jkind.t -> unit
+val mode : Format.formatter -> Jane_syntax.Mode_expr.Const.t -> unit
diff --git a/ocaml/testsuite/tests/language-extensions/pprintast_unconditional.ml b/ocaml/testsuite/tests/language-extensions/pprintast_unconditional.ml
@@ -120,10 +120,12 @@ module Example = struct
   let tyvar            = "no_tyvars_require_extensions"
   let jkind            = Jane_syntax.Jkind.(
                             With (
-                              Primitive_layout_or_abbreviation
+                              Abbreviation
                                 (Const.mk "value" loc),
                               core_type
                             ))
+
+  let mode = Jane_syntax.Mode_expr.Const.mk "global" loc
 end
 
 let print_test_header name =
@@ -205,6 +207,7 @@ end = struct
 
   let tyvar = test "tyvar" tyvar Example.tyvar
   let jkind = test "jkind" jkind Example.jkind
+  let mode = test "mode" mode Example.mode
 end
 
 

diff --git a/ocaml/testsuite/tests/language-extensions/pprintast_unconditional.reference b/ocaml/testsuite/tests/language-extensions/pprintast_unconditional.reference
@@ -95,6 +95,8 @@ tyvar: 'no_tyvars_require_extensions
 
 jkind: value with local_ ('a : value) -> unit
 
+mode: global
+
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 ##### Extensions disallowed
@@ -194,6 +196,8 @@ tyvar: 'no_tyvars_require_extensions
 
 jkind: value with local_ ('a : value) -> unit
 
+mode: global
+
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 
 ##### Calling [Language_extension.For_pprintast.make_printer_exporter ()]

diff --git a/ocaml/testsuite/tests/typing-layouts-arrays/basics.ml b/ocaml/testsuite/tests/typing-layouts-arrays/basics.ml
@@ -278,7 +278,7 @@ end
 Line 9, characters 24-35:
 9 |   let f2 idx : int32# = get arr idx
                             ^^^^^^^^^^^
-Error: This expression has type ('a : float64)
+Error: This expression has type ('a : layout_float64)
        but an expression was expected of type int32#
        The layout of int32# is bits32, because
          it is the primitive bits32 type int32#.