Initial commit with merge conflicts

janestreet · Nov 13, 2023 · 273af7e · 273af7e
1 parent 5f78748
commit 273af7e
Show file tree

Hide file tree

Showing 89 changed files with 17,686 additions and 1,368 deletions.
diff --git a/src/ocaml/parsing/.ocamlformat-enable b/src/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
diff --git a/src/ocaml/parsing/ast_helper.ml b/src/ocaml/parsing/ast_helper.ml
@@ -513,7 +513,12 @@ module Vb = struct
         ?(text = []) ?value_constraint pat expr =
     {
      pvb_pat = pat;
+<<<<<<< janestreet/merlin-jst:merge-flambda-backend-501
      pvb_expr = expr;
+||||||| ocaml-flambda/flambda-backend:0c8a400e403b8f888315d92b4a01883a3f971435
+=======
+     pvb_constraint=value_constraint;
+>>>>>>> ocaml-flambda/flambda-backend:main
      pvb_constraint=value_constraint;
      pvb_attributes =
        add_text_attrs text (add_docs_attrs docs attrs);
@@ -540,22 +545,19 @@ module Type = struct
   let mk ?(loc = !default_loc) ?(attrs = [])
         ?(docs = empty_docs) ?(text = [])
       ?(params = [])
-      ?jkind
       ?(cstrs = [])
       ?(kind = Ptype_abstract)
       ?(priv = Public)
       ?manifest
       name =
-    let jkind_attrs = Option.to_list jkind in
     {
      ptype_name = name;
      ptype_params = params;
      ptype_cstrs = cstrs;
      ptype_kind = kind;
      ptype_private = priv;
      ptype_manifest = manifest;
-     ptype_attributes =
-       jkind_attrs @ add_text_attrs text (add_docs_attrs docs attrs);
+     ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs);
      ptype_loc = loc;
     }
 

diff --git a/src/ocaml/parsing/ast_helper.mli b/src/ocaml/parsing/ast_helper.mli
@@ -225,7 +225,6 @@ module Type:
   sig
     val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text ->
       ?params:(core_type * (variance * injectivity)) list ->
-      ?jkind:attribute ->
       ?cstrs:(core_type * core_type * loc) list ->
       ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str ->
       type_declaration

diff --git a/src/ocaml/parsing/ast_iterator.ml b/src/ocaml/parsing/ast_iterator.ml
@@ -384,6 +384,21 @@ module M = struct
         iter_functor_param sub param;
         sub.module_expr sub body
     | Pmod_apply (m1, m2) ->
+<<<<<<< janestreet/merlin-jst:merge-flambda-backend-501
+||||||| ocaml-flambda/flambda-backend:0c8a400e403b8f888315d92b4a01883a3f971435
+        sub.module_expr sub m1; sub.module_expr sub m2
+    | Pmod_constraint (m, mty) ->
+        sub.module_expr sub m; sub.module_type sub mty
+    | Pmod_unpack e -> sub.expr sub e
+=======
+        sub.module_expr sub m1;
+        sub.module_expr sub m2
+    | Pmod_apply_unit m1 ->
+        sub.module_expr sub m1
+    | Pmod_constraint (m, mty) ->
+        sub.module_expr sub m; sub.module_type sub mty
+    | Pmod_unpack e -> sub.expr sub e
+>>>>>>> ocaml-flambda/flambda-backend:main
         sub.module_expr sub m1;
         sub.module_expr sub m2
     | Pmod_apply_unit m1 ->
@@ -834,6 +849,24 @@ let default_iterator =
     value_binding =
       (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc; pvb_constraint} ->
          this.pat this pvb_pat;
+<<<<<<< janestreet/merlin-jst:merge-flambda-backend-501
+||||||| ocaml-flambda/flambda-backend:0c8a400e403b8f888315d92b4a01883a3f971435
+         this.location this pvb_loc;
+         this.attributes this pvb_attributes
+      );
+=======
+         Option.iter (function
+             | Parsetree.Pvc_constraint {locally_abstract_univars=vars; typ} ->
+                 List.iter (iter_loc this) vars;
+                 this.typ this typ
+             | Pvc_coercion { ground; coercion } ->
+                 Option.iter (this.typ this) ground;
+                 this.typ this coercion;
+           ) pvb_constraint;
+         this.location this pvb_loc;
+         this.attributes this pvb_attributes
+      );
+>>>>>>> ocaml-flambda/flambda-backend:main
          this.expr this pvb_expr;
          Option.iter (function
              | Parsetree.Pvc_constraint {locally_abstract_univars=vars; typ} ->

diff --git a/src/ocaml/parsing/ast_mapper.ml b/src/ocaml/parsing/ast_mapper.ml
@@ -965,9 +965,33 @@ let default_mapper =
       | Pvc_coercion { ground; coercion } ->
           Pvc_coercion {
             ground = Option.map (this.typ this) ground;
+<<<<<<< janestreet/merlin-jst:merge-flambda-backend-501
             coercion = this.typ this coercion
           }
          in
+||||||| ocaml-flambda/flambda-backend:0c8a400e403b8f888315d92b4a01883a3f971435
+
+
+    value_binding =
+      (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} ->
+=======
+
+
+    value_binding =
+      (fun this {pvb_pat; pvb_expr; pvb_constraint; pvb_attributes; pvb_loc} ->
+         let map_ct (ct:Parsetree.value_constraint) = match ct with
+           | Pvc_constraint {locally_abstract_univars=vars; typ} ->
+               Pvc_constraint
+                 { locally_abstract_univars = List.map (map_loc this) vars;
+                   typ = this.typ this typ
+                 }
+           | Pvc_coercion { ground; coercion } ->
+               Pvc_coercion {
+                 ground = Option.map (this.typ this) ground;
+                 coercion = this.typ this coercion
+               }
+         in
+>>>>>>> ocaml-flambda/flambda-backend:main
          Vb.mk
            (this.pat this pvb_pat)
            (this.expr this pvb_expr)
@@ -1198,6 +1222,27 @@ module PpxContext = struct
       | "include_dirs" ->
           Clflags.include_dirs := get_list get_string payload
       | "load_path" ->
+<<<<<<< janestreet/merlin-jst:merge-flambda-backend-501
+||||||| ocaml-flambda/flambda-backend:0c8a400e403b8f888315d92b4a01883a3f971435
+          Load_path.init (get_list get_string payload)
+      | "open_modules" ->
+          Clflags.open_modules := get_list get_string payload
+      | "for_package" ->
+=======
+          (* Duplicates Compmisc.auto_include, since we can't reference Compmisc
+             from this module. *)
+          let auto_include find_in_dir fn =
+            if !Clflags.no_auto_include_otherlibs || !Clflags.no_std_include then
+              raise Not_found
+            else
+              let alert = Location.auto_include_alert in
+              Load_path.auto_include_otherlibs alert find_in_dir fn
+          in
+          Load_path.init ~auto_include (get_list get_string payload)
+      | "open_modules" ->
+          Clflags.open_modules := get_list get_string payload
+      | "for_package" ->
+>>>>>>> ocaml-flambda/flambda-backend:main
           (* Duplicates Compmisc.auto_include, since we can't reference Compmisc
              from this module. *)
           (* let auto_include find_in_dir fn =

diff --git a/src/ocaml/parsing/attr_helper.ml b/src/ocaml/parsing/attr_helper.ml
@@ -23,7 +23,11 @@ type error =
 exception Error of Location.t * error
 
 let get_no_payload_attribute alt_names attrs =
-  match Builtin_attributes.filter_attributes [alt_names,true] attrs with
+  match
+    Builtin_attributes.filter_attributes
+      (Builtin_attributes.Attributes_filter.create [alt_names,true])
+      attrs
+  with
   | [] -> None
   | [ {attr_name = name; attr_payload = PStr []; attr_loc = _} ] -> Some name
   | [ {attr_name = name; _} ] ->

diff --git a/src/ocaml/parsing/builtin_attributes.ml b/src/ocaml/parsing/builtin_attributes.ml
@@ -14,7 +14,6 @@
 (**************************************************************************)
 
 open Asttypes
-open Jane_asttypes
 open Parsetree
 open Ast_helper
 
@@ -77,12 +76,8 @@ let builtin_attrs =
   ; "ppwarning"; "ocaml.ppwarning"
   ; "explicit_arity"; "ocaml.explicit_arity"
   ; "warn_on_literal_pattern"; "ocaml.warn_on_literal_pattern"
-  ; "float64"; "ocaml.float64"
   ; "immediate"; "ocaml.immediate"
   ; "immediate64"; "ocaml.immediate64"
-  ; "void"; "ocaml.void"
-  ; "value"; "ocaml.value"
-  ; "any"; "ocaml.any"
   ; "boxed"; "ocaml.boxed"
   ; "unboxed"; "ocaml.unboxed"
   ; "principal"; "ocaml.principal"
@@ -431,7 +426,13 @@ let has_attribute nms attrs =
        else false)
     attrs
 
-let filter_attributes nms_and_conds attrs =
+module Attributes_filter = struct
+  type t = (string list * bool) list
+
+  let create (t : t) = t
+end
+
+let filter_attributes (nms_and_conds : Attributes_filter.t) attrs =
   List.filter (fun a ->
     List.exists (fun (nms, cond) ->
       if List.mem a.attr_name.txt nms
@@ -453,39 +454,33 @@ let warn_on_literal_pattern attrs =
 let explicit_arity attrs =
   has_attribute ["ocaml.explicit_arity"; "explicit_arity"] attrs
 
-let jkind ~legacy_immediate attrs =
+type jkind_attribute =
+  | Immediate64
+  | Immediate
+
+let jkind_attribute_of_string = function
+  | "ocaml.immediate64" | "immediate64" -> Some Immediate64
+  | "ocaml.immediate" | "immediate" -> Some Immediate
+  | _ -> None
+
+let jkind_attribute_to_string = function
+  | Immediate64 -> "immediate64"
+  | Immediate -> "immediate"
+
+let jkind 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_attribute_of_string a.attr_name.txt with
+         | Some attr -> Some (a, attr)
+         | None -> None
+      ) attrs
   in
   match jkind with
-  | None -> Ok None
+  | None -> None
   | Some (a, l) ->
      mark_used a.attr_name;
-     let l_loc = Location.mkloc l a.attr_loc in
-     let check b =
-       if b
-       then Ok (Some l_loc)
-       else Error l_loc
-     in
-     match l with
-     | Value -> check true
-     | Immediate | Immediate64 ->
-        check  (legacy_immediate
-             || Language_extension.(is_at_least Layouts Stable))
-     | Any | Float64 ->
-        check Language_extension.(is_at_least Layouts Stable)
-     | Void ->
-        check Language_extension.(is_at_least Layouts Alpha)
+     Some (Location.mkloc l a.attr_loc)
 
 (* The "ocaml.boxed (default)" and "ocaml.unboxed (default)"
    attributes cannot be input by the user, they are added by the
@@ -634,39 +629,63 @@ let has_local_opt attrs =
 let has_curry attrs =
   has_attribute ["extension.curry"; "ocaml.curry"; "curry"] attrs
 
-(* extension.* is generated by the parser and not usually written directly,
-   so does not have a short form. An error is reported if it is seen when
-   the extension is disabled *)
-
-let check_local ext_names other_names attr =
-  if has_attribute ext_names attr then
-    if not (Language_extension.is_enabled Local) then
-      Error ()
-    else
-      Ok true
-  else
-    Ok (has_attribute other_names attr)
-
-let has_local attr =
-  check_local ["extension.local"] ["ocaml.local"; "local"] attr
-
-let has_global attrs =
-  check_local ["extension.global"] ["ocaml.global"; "global"] attrs
-
-let check_unique ext_names other_names attr =
-  if has_attribute ext_names attr then
-    if not (Language_extension.is_enabled Unique) then
-      Error ()
+(* Mode annotation attributes are handled fairly uniformly, so we have
+   a dedicated submodule for them.
+*)
+module Mode_annotation_attribute = struct
+
+  (* When you add a constructor here, be sure to add it to [all]. *)
+  type t =
+    | Local
+    | Global
+    | Unique
+    | Once
+
+  let all = [ Local; Global; Unique; Once; ]
+
+  (* extension.* is generated by the parser and not usually written directly,
+     so does not have a short form. An error is reported if it is seen when
+     the extension is disabled *)
+  let name = function
+    | Local -> "extension.local"
+    | Global -> "extension.global"
+    | Unique -> "extension.unique"
+    | Once -> "extension.once"
+
+  let extra_user_written_names = function
+    | Local -> [ "ocaml.local"; "local" ]
+    | Global -> [ "ocaml.global"; "global" ]
+    | Unique -> [ "ocaml.unique"; "unique" ]
+    | Once -> [ "ocaml.once"; "once" ]
+
+  let is_language_extension_enabled = function
+    | Local | Global -> Language_extension.is_enabled Local
+    | Unique | Once -> Language_extension.is_enabled Unique
+
+  let check t attr =
+    if has_attribute [ name t ] attr then
+      if not (is_language_extension_enabled t) then
+        Error ()
+      else
+        Ok true
     else
-      Ok true
-  else
-    Ok (has_attribute other_names attr)
-
-let has_unique attrs =
-  check_unique ["extension.unique"] ["ocaml.unique"; "unique"] attrs
-
-let has_once attr =
-  check_unique ["extension.once"] ["ocaml.once"; "once"] attr
+      Ok (has_attribute (extra_user_written_names t) attr)
+end
+
+let has_local attr = Mode_annotation_attribute.check Local attr
+let has_global attr = Mode_annotation_attribute.check Global attr
+let has_unique attr = Mode_annotation_attribute.check Unique attr
+let has_once attr = Mode_annotation_attribute.check Once attr
+
+let mode_annotation_attributes_filter =
+  List.map
+    (fun attr ->
+      let names =
+        Mode_annotation_attribute.name attr
+        :: Mode_annotation_attribute.extra_user_written_names attr
+      in
+      names, true)
+    Mode_annotation_attribute.all
 
 let tailcall attr =
   let has_nontail = has_attribute ["ocaml.nontail"; "nontail"] attr in