Change parsetree layouts to strings

ocaml/compilerlibs/Makefile.compilerlibs

@@ -63,6 +63,7 @@ PARSING = \
   parsing/printast.cmo \
   parsing/syntaxerr.cmo \
   parsing/ast_helper.cmo \
+  parsing/jane_asttypes.cmo \
   parsing/jane_syntax_parsing.cmo parsing/jane_syntax.cmo \
   parsing/pprintast.cmo \
   parsing/ast_iterator.cmo \
@@ -77,7 +78,6 @@ PARSING = \
   parsing/depend.cmo
 PARSING_CMI = \
   parsing/asttypes.cmi \
-  parsing/jane_asttypes.cmi \
   parsing/parsetree.cmi
 
 TYPING = \

ocaml/dune

@@ -51,7 +51,7 @@
  (ocamlopt_flags (:include %{project_root}/ocamlopt_flags.sexp))
  (library_flags -linkall)
  (modules_without_implementation
-   annot asttypes jane_asttypes cmo_format outcometree parsetree debug_event)
+   annot asttypes cmo_format outcometree parsetree debug_event)
  (modules
    ;; UTILS
    config build_path_prefix_map misc identifiable numbers arg_helper clflags

ocaml/otherlibs/dynlink/Makefile

@@ -63,7 +63,6 @@ NATOBJS=dynlink_compilerlibs.cmx dynlink_types.cmx \
 # .mli files from compilerlibs that don't have a corresponding .ml file.
 COMPILERLIBS_INTFS=\
   parsing/asttypes.mli \
-  parsing/jane_asttypes.mli \
   parsing/parsetree.mli \
   typing/outcometree.mli \
   file_formats/cmo_format.mli \
@@ -102,6 +101,7 @@ COMPILERLIBS_SOURCES=\
   parsing/printast.ml \
   parsing/syntaxerr.ml \
   parsing/ast_helper.ml \
+  parsing/jane_asttypes.ml \
   parsing/jane_syntax_parsing.ml \
   parsing/jane_syntax.ml \
   parsing/ast_iterator.ml \

ocaml/otherlibs/dynlink/dune

@@ -45,6 +45,7 @@
     docstrings
     printast
     syntaxerr
+    jane_asttypes
     jane_syntax_parsing
     jane_syntax
     ast_iterator
@@ -77,7 +78,6 @@
     meta
     symtable
     asttypes
-    jane_asttypes
     parsetree
     outcometree
     cmo_format
@@ -89,7 +89,6 @@
     linkage_name)
   (modules_without_implementation
     asttypes
-    jane_asttypes
     parsetree
     outcometree
     cmo_format
@@ -134,6 +133,7 @@
 (copy_files ../../parsing/docstrings.ml)
 (copy_files ../../parsing/printast.ml)
 (copy_files ../../parsing/syntaxerr.ml)
+(copy_files ../../parsing/jane_asttypes.ml)
 (copy_files ../../parsing/jane_syntax_parsing.ml)
 (copy_files ../../parsing/jane_syntax.ml)
 (copy_files ../../parsing/ast_iterator.ml)
@@ -194,6 +194,7 @@
 (copy_files ../../parsing/docstrings.mli)
 (copy_files ../../parsing/printast.mli)
 (copy_files ../../parsing/syntaxerr.mli)
+(copy_files ../../parsing/jane_asttypes.mli)
 (copy_files ../../parsing/jane_syntax_parsing.mli)
 (copy_files ../../parsing/jane_syntax.mli)
 (copy_files ../../parsing/ast_iterator.mli)
@@ -228,7 +229,6 @@
 
 ; .mli-only:
 (copy_files ../../parsing/asttypes.mli)
-(copy_files ../../parsing/jane_asttypes.mli)
 (copy_files ../../parsing/parsetree.mli)
 (copy_files ../../typing/outcometree.mli)
 (copy_files ../../file_formats/cmo_format.mli)
@@ -295,6 +295,7 @@
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Syntaxerr.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Lazy_backtrack.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Ast_helper.cmo
+      .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Jane_asttypes.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Jane_syntax_parsing.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Jane_syntax.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Ast_iterator.cmo
@@ -370,6 +371,7 @@
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Printast.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Syntaxerr.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Ast_helper.cmx
+      .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Jane_asttypes.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Jane_syntax_parsing.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Jane_syntax.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Load_path.cmx

ocaml/parsing/.ocamlformat-enable

@@ -2,4 +2,5 @@ jane_syntax.ml
 jane_syntax.mli
 jane_syntax_parsing.ml
 jane_syntax_parsing.mli
+jane_asttypes.ml
 jane_asttypes.mli

ocaml/parsing/builtin_attributes.ml

@@ -14,7 +14,6 @@
 (**************************************************************************)
 
 open Asttypes
-open Jane_asttypes
 open Parsetree
 open Ast_helper
 
@@ -453,19 +452,45 @@ let warn_on_literal_pattern attrs =
 let explicit_arity attrs =
   has_attribute ["ocaml.explicit_arity"; "explicit_arity"] attrs
 
+type jkind_annotation =
+  | Any
+  | Value
+  | Void
+  | Immediate64
+  | Immediate
+  | Float64
+
+let jkind_of_string = function
+  | "ocaml.any" | "any" -> Some Any
+  | "ocaml.value" | "value" -> Some Value
+  | "ocaml.void" | "void" -> Some Void
+  | "ocaml.immediate64" | "immediate64" -> Some Immediate64
+  | "ocaml.immediate" | "immediate" -> Some Immediate
+  | "ocaml.float64" | "float64" -> Some Float64
+  | _ -> None
+
+let jkind_to_string = function
+  | Any -> "any"
+  | Value -> "value"
+  | Void -> "void"
+  | Immediate64 -> "immediate64"
+  | Immediate -> "immediate"
+  | Float64 -> "float64"
+
+let jkind_of_parsetree x =
+  jkind_of_string (Jane_asttypes.jkind_to_string x)
+
+let jkind_to_parsetree x =
+  Jane_asttypes.jkind_of_string (jkind_to_string x)
+
 let jkind ~legacy_immediate attrs =
   let jkind =
     List.find_map
       (fun a ->
-         match a.attr_name.txt with
-         | "ocaml.void"|"void" -> Some (a, Void)
-         | "ocaml.value"|"value" -> Some (a, Value)
-         | "ocaml.any"|"any" -> Some (a, Any)
-         | "ocaml.immediate"|"immediate" -> Some (a, Immediate)
-         | "ocaml.immediate64"|"immediate64" -> Some (a, Immediate64)
-         | "ocaml.float64"|"float64" -> Some (a, Float64)
-         | _ -> None
-        ) attrs
+         match jkind_of_string a.attr_name.txt with
+         | Some attr -> Some (a, attr)
+         | None -> None
+      ) attrs
   in
   match jkind with
   | None -> Ok None

ocaml/parsing/builtin_attributes.mli

@@ -175,6 +175,17 @@ val has_unique: Parsetree.attributes -> (bool,unit) result
 
 val has_once : Parsetree.attributes -> (bool, unit) result
 
+type jkind_annotation =
+  | Any
+  | Value
+  | Void
+  | Immediate64
+  | Immediate
+  | Float64
+
+val jkind_of_parsetree : Jane_asttypes.const_jkind -> jkind_annotation option
+val jkind_to_parsetree : jkind_annotation -> Jane_asttypes.const_jkind
+
 (* [jkind] gets the jkind in the attributes if one is present.  We always
    allow the [value] annotation, even if the layouts extensions are disabled.
    If [~legacy_immediate] is true, we allow [immediate] and [immediate64]
@@ -207,5 +218,4 @@ val has_once : Parsetree.attributes -> (bool, unit) result
 (* CR layouts: we should eventually be able to delete ~legacy_immediate (after we
    turn on layouts by default). *)
 val jkind : legacy_immediate:bool -> Parsetree.attributes ->
-  (Jane_asttypes.jkind_annotation option,
-   Jane_asttypes.jkind_annotation) result
+  (jkind_annotation Location.loc option, jkind_annotation Location.loc) result

ocaml/parsing/jane_asttypes.ml

@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*               Antal Spector-Zabusky, Jane Street, New York             *)
+(*                                                                        *)
+(*   Copyright 2023 Jane Street Group LLC                                 *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+open! Asttypes
+
+type global_flag =
+  | Global
+  | Nothing
+
+type const_jkind = string
+
+let jkind_of_string x = x
+
+let jkind_to_string x = x
+
+type jkind_annotation = const_jkind Location.loc

ocaml/parsing/jane_asttypes.mli

@@ -25,20 +25,19 @@
 
 *)
 
-open Asttypes
+open! Asttypes
 
 type global_flag =
   | Global
   | Nothing
 
-(* constant jkinds are parsed as jkind annotations, and also used
-   in the type checker as already-inferred (i.e. non-variable) jkinds *)
-type const_jkind =
-  | Any
-  | Value
-  | Void
-  | Immediate64
-  | Immediate
-  | Float64
-
-type jkind_annotation = const_jkind loc
+(** [const_jkind] is private to limit confusion with type variables, which
+    are also strings in the parser.
+*)
+type const_jkind = private string
+
+val jkind_of_string : string -> const_jkind
+
+val jkind_to_string : const_jkind -> string
+
+type jkind_annotation = const_jkind Location.loc

ocaml/parsing/jane_syntax.ml

@@ -324,23 +324,9 @@ module Stringable_const_jkind = struct
 
   let indefinite_article_and_name = "a", "layout"
 
-  let to_string = function
-    | Any -> "any"
-    | Value -> "value"
-    | Void -> "void"
-    | Immediate64 -> "immediate64"
-    | Immediate -> "immediate"
-    | Float64 -> "float64"
-
-  (* CR layouts v1.5: revise when moving jkind recognition away from parser *)
-  let of_string = function
-    | "any" -> Some Any
-    | "value" -> Some Value
-    | "void" -> Some Void
-    | "immediate" -> Some Immediate
-    | "immediate64" -> Some Immediate64
-    | "float64" -> Some Float64
-    | _ -> None
+  let to_string = jkind_to_string
+
+  let of_string t = Some (jkind_of_string t)
 end
 
 module Jkinds_pprint = struct

ocaml/parsing/parser.mly

@@ -912,16 +912,6 @@ let mk_directive ~loc name arg =
       pdir_loc = make_loc loc;
     }
 
-let check_jkind ~loc id : const_jkind =
-  match id with
-  | "any" -> Any
-  | "value" -> Value
-  | "void" -> Void
-  | "immediate64" -> Immediate64
-  | "immediate" -> Immediate
-  | "float64" -> Float64
-  | _ -> expecting_loc loc "layout"
-
 (* Unboxed literals *)
 
 (* CR layouts v2.5: The [unboxed_*] functions will both be improved and lose
@@ -1109,6 +1099,7 @@ let unboxed_float_type sloc tys =
 %token PERCENT                "%"
 %token PLUS                   "+"
 %token PLUSDOT                "+."
+
 %token PLUSEQ                 "+="
 %token <string> PREFIXOP      "!+" (* chosen with care; see above *)
 %token PRIVATE                "private"
@@ -3711,21 +3702,14 @@ type_parameters:
 ;
 
 jkind_annotation: (* : jkind_annotation *)
-  ident { let loc = make_loc $sloc in
-          mkloc (check_jkind ~loc $1) loc }
-;
-
-jkind_string: (* : string with_loc *)
-  (* the [check_jkind] just ensures this is the name of a jkind *)
-  ident { let loc = make_loc $sloc in
-          ignore (check_jkind ~loc $1 : const_jkind);
-          mkloc $1 loc }
+  ident { mkloc (Jane_asttypes.jkind_of_string $1) (make_loc $sloc) }
 ;
 
 jkind_attr:
   COLON
-  jkind=jkind_string
-    { Attr.mk ~loc:jkind.loc jkind (PStr []) }
+  jkind=ident
+  { let jkind = mkloc jkind (make_loc $loc(jkind)) in
+      Attr.mk ~loc:jkind.loc jkind (PStr []) }
 ;
 
 %inline type_param_with_jkind:

ocaml/testsuite/tests/typing-layouts/parsing.compilers.reference

@@ -12,7 +12,7 @@ Error: Layout void is more experimental than allowed by -extension layouts.
 Line 2, characters 11-15:
 2 | type ('a : valu) t0 = 'a list;;
                ^^^^
-Error: Syntax error: layout expected.
+Error: Unknown layout valu
 Line 2, characters 9-15:
 2 | type t = float#;;
              ^^^^^^

ocaml/testsuite/tests/typing-layouts/parsing_alpha.compilers.reference

@@ -8,7 +8,7 @@ Error: This type ('a : value) should be an instance of type ('a0 : void)
 Line 2, characters 11-15:
 2 | type ('a : valu) t0 = 'a list;;
                ^^^^
-Error: Syntax error: layout expected.
+Error: Unknown layout valu
 type t = float#
 Line 2, characters 9-13:
 2 | type t = int#;;

ocaml/testsuite/tests/typing-layouts/parsing_beta.compilers.reference

@@ -8,7 +8,7 @@ Error: Layout void is more experimental than allowed by -extension layouts_beta.
 Line 2, characters 11-15:
 2 | type ('a : valu) t0 = 'a list;;
                ^^^^
-Error: Syntax error: layout expected.
+Error: Unknown layout valu
 type t = float#
 Line 2, characters 9-13:
 2 | type t = int#;;