ocamlformat 0.27.0

Author: cknitt

.ocamlformat

@@ -1,5 +1,5 @@
 profile = default
-version = 0.26.2
+version = 0.27.0
 
 field-space = tight-decl
 break-cases = toplevel
@@ -9,3 +9,4 @@ space-around-arrays = false
 space-around-lists = false
 space-around-records = false
 space-around-variants = false
+parse-docstrings = false

analysis/reanalyze/src/DeadCommon.ml

@@ -555,7 +555,8 @@ module Decl = struct
         let refIsBelow (pos : Lexing.position) =
           decl.pos.pos_fname <> pos.pos_fname
           || decl.pos.pos_cnum < pos.pos_cnum
-             && (* not a function defined inside a function, e.g. not a callback *)
+             &&
+             (* not a function defined inside a function, e.g. not a callback *)
              decl.posEnd.pos_cnum < pos.pos_cnum
         in
         refs |> PosSet.exists refIsBelow

analysis/src/SignatureHelp.ml

@@ -553,44 +553,44 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
                 let offset = ref 0 in
                 Some
                   (`InlineRecord
-                    (fields
-                    |> List.map (fun (field : field) ->
-                           let startOffset = !offset in
-                           let argText =
-                             Printf.sprintf "%s%s: %s" field.fname.txt
-                               (if field.optional then "?" else "")
-                               (Shared.typeToString
-                                  (if field.optional then
-                                     Utils.unwrapIfOption field.typ
-                                   else field.typ))
-                           in
-                           let endOffset =
-                             startOffset + String.length argText
-                           in
-                           offset := endOffset + String.length ", ";
-                           (argText, field, (startOffset, endOffset)))))
+                     (fields
+                     |> List.map (fun (field : field) ->
+                            let startOffset = !offset in
+                            let argText =
+                              Printf.sprintf "%s%s: %s" field.fname.txt
+                                (if field.optional then "?" else "")
+                                (Shared.typeToString
+                                   (if field.optional then
+                                      Utils.unwrapIfOption field.typ
+                                    else field.typ))
+                            in
+                            let endOffset =
+                              startOffset + String.length argText
+                            in
+                            offset := endOffset + String.length ", ";
+                            (argText, field, (startOffset, endOffset)))))
               | Args [(typ, _)] ->
                 Some
                   (`SingleArg
-                    ( typ |> Shared.typeToString,
-                      docsForLabel ~file:full.file ~package:full.package
-                        ~supportsMarkdownLinks typ ))
+                     ( typ |> Shared.typeToString,
+                       docsForLabel ~file:full.file ~package:full.package
+                         ~supportsMarkdownLinks typ ))
               | Args args ->
                 let offset = ref 0 in
                 Some
                   (`TupleArg
-                    (args
-                    |> List.map (fun (typ, _) ->
-                           let startOffset = !offset in
-                           let argText = typ |> Shared.typeToString in
-                           let endOffset =
-                             startOffset + String.length argText
-                           in
-                           offset := endOffset + String.length ", ";
-                           ( argText,
-                             docsForLabel ~file:full.file ~package:full.package
-                               ~supportsMarkdownLinks typ,
-                             (startOffset, endOffset) ))))
+                     (args
+                     |> List.map (fun (typ, _) ->
+                            let startOffset = !offset in
+                            let argText = typ |> Shared.typeToString in
+                            let endOffset =
+                              startOffset + String.length argText
+                            in
+                            offset := endOffset + String.length ", ";
+                            ( argText,
+                              docsForLabel ~file:full.file ~package:full.package
+                                ~supportsMarkdownLinks typ,
+                              (startOffset, endOffset) ))))
             in
             let label =
               constructor.name ^ "("

compiler/bsb/bsb_exception.ml

@@ -40,7 +40,8 @@ let print (fmt : Format.formatter) (x : error) =
   | Conflict_module (modname, dir1, dir2) ->
     Format.fprintf fmt
       "@{<error>Error:@} %s found in two directories: (%s, %s)\n\
-       File names must be unique per project" modname dir1 dir2
+       File names must be unique per project"
+      modname dir1 dir2
   | No_implementation modname ->
     Format.fprintf fmt "@{<error>Error:@} %s does not have implementation file"
       modname
@@ -51,12 +52,14 @@ let print (fmt : Format.formatter) (x : error) =
         "File \"bsconfig.json\", line 1\n\
          @{<error>Error:@} package @{<error>%s@} is not found\n\
          It's the basic, required package. If you have it installed globally,\n\
-         Please run `npm link rescript` to make it available" name
+         Please run `npm link rescript` to make it available"
+        name
     else
       Format.fprintf fmt
         "File \"bsconfig.json\", line 1\n\
          @{<error>Error:@} package @{<error>%s@} not found or built\n\
-         - Did you install it?" name
+         - Did you install it?"
+        name
   | Json_config (pos, s) ->
     Format.fprintf fmt
       "File %S, line %d:\n\

compiler/bsb/bsb_ninja_check.ml

@@ -114,8 +114,9 @@ let record ~(package_kind : Bsb_package_kind.t) ~per_proj_dir ~file
   record_global_atime buf Sys.executable_name;
   Ext_list.iter config.ppx_files (fun {name; args = _} ->
       try record_global_atime buf name
-      with _ -> (* record the ppx files as a best effort *)
-                ());
+      with _ ->
+        (* record the ppx files as a best effort *)
+        ());
   let oc = open_out_bin file in
   Ext_buffer.output_buffer oc buf;
   close_out oc

compiler/bsb/bsb_ninja_gen.ml

@@ -40,7 +40,8 @@ let emit_bsc_lib_includes (bs_dependencies : Bsb_config_types.dependencies)
   let all_includes source_dirs =
     source_dirs
     @ Ext_list.map bs_dependencies (fun x -> x.package_install_path)
-    @ (* for external includes, if it is absolute path, leave it as is
+    @
+    (* for external includes, if it is absolute path, leave it as is
          for relative path './xx', we need '../.././x' since we are in
          [lib/bs], [build] is different from merlin though
       *)

compiler/bsb/bsb_parse_sources.ml

@@ -322,8 +322,9 @@ and parse_sources (cxt : cxt) (sources : Ext_json_types.t) =
   | Arr file_groups -> parsing_arr_sources cxt file_groups.content
   | _ -> parsing_single_source cxt sources
 
-let scan ~package_kind ~root ~cut_generators ~(* ~namespace  *)
-                                              ignored_dirs x : t =
+let scan ~package_kind ~root ~cut_generators
+    ~(* ~namespace  *)
+     ignored_dirs x : t =
   parse_sources
     {
       ignored_dirs;

compiler/bsb_helper/bsb_db_decode.ml

@@ -51,7 +51,10 @@ and decode_single (x : string) (offset : cursor) : group =
     let modules = decode_modules x offset module_number in
     let dir_info_offset = !offset in
     let module_info_offset = String.index_from x dir_info_offset '\n' + 1 in
-    let dir_length = Char.code x.[module_info_offset] - 48 (* Char.code '0'*) in
+    let dir_length =
+      Char.code x.[module_info_offset] - 48
+      (* Char.code '0'*)
+    in
     offset := module_info_offset + 1 + (dir_length * module_number) + 1;
     Group {modules; dir_info_offset; module_info_offset; dir_length})
   else Dummy

compiler/core/js_analyzer.ml

@@ -58,7 +58,8 @@ let free_variables (stats : idents_stats) =
         | Fun {env}
         (* a optimization to avoid walking into function again
             if it's already comuted
-        *) ->
+        *)
+          ->
           stats.used_idents <-
             Set_ident.union (Js_fun_env.get_unbounded env) stats.used_idents
         | _ -> super.expression self exp);

compiler/core/js_cmj_format.ml

@@ -113,7 +113,7 @@ let get_result mid_val =
   match mid_val.persistent_closed_lambda with
   | Some
       (Lconst
-        (Const_js_null | Const_js_undefined _ | Const_js_true | Const_js_false))
+         (Const_js_null | Const_js_undefined _ | Const_js_true | Const_js_false))
   | None ->
     mid_val
   | Some _ ->
@@ -131,8 +131,10 @@ let rec binary_search_aux arr lo hi (key : string) =
       let lo_val = Array.unsafe_get arr lo in
       if lo_val.name = key then get_result lo_val else not_found key
     else binary_search_aux arr lo mid key
-  else if (*  a[lo] =< a[mid] < key <= a[hi] *)
-          lo = mid then
+  else if
+    (*  a[lo] =< a[mid] < key <= a[hi] *)
+    lo = mid
+  then
     let hi_val = Array.unsafe_get arr hi in
     if hi_val.name = key then get_result hi_val else not_found key
   else binary_search_aux arr mid hi key

compiler/core/js_dump.ml

@@ -436,7 +436,7 @@ and pp_function ~return_unit ~async ~is_method ?directive cxt (f : P.t)
     since it can be either [int] or [string]
 *)
 and pp_one_case_clause :
-      'a. _ -> P.t -> (P.t -> 'a -> unit) -> 'a * J.case_clause -> _ =
+    'a. _ -> P.t -> (P.t -> 'a -> unit) -> 'a * J.case_clause -> _ =
  fun cxt f pp_cond
      (switch_case, ({switch_body; should_break; comment} : J.case_clause)) ->
   P.newline f;
@@ -467,8 +467,7 @@ and pp_one_case_clause :
   cxt
 
 and loop_case_clauses :
-      'a. cxt -> P.t -> (P.t -> 'a -> unit) -> ('a * J.case_clause) list -> cxt
-    =
+    'a. cxt -> P.t -> (P.t -> 'a -> unit) -> ('a * J.case_clause) list -> cxt =
  fun cxt f pp_cond cases ->
   Ext_list.fold_left cases cxt (fun acc x -> pp_one_case_clause acc f pp_cond x)
 
@@ -693,7 +692,8 @@ and expression_desc cxt ~(level : int) f x : cxt =
      {[ 0. - x ]}
      {[ 0.00 - x ]}
      {[ 0.000 - x ]}
-  *) ->
+  *)
+    ->
     P.cond_paren_group f (level > 13) (fun _ ->
         P.string f
           (match desc with
@@ -1214,7 +1214,8 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
           semi f;
           cxt)
       (* There MUST be a space between the return and its
-         argument. A line return will not work *))
+         argument. A line return will not work *)
+    )
   | Int_switch (e, cc, def) ->
     P.string f L.switch;
     P.space f;

compiler/core/js_exp_make.mli

@@ -76,16 +76,22 @@ val external_var :
 val ml_module_as_var : ?comment:string -> ?dynamic_import:bool -> Ident.t -> t
 
 val runtime_call :
-  string -> (* module_name *)
-            string -> (* fn_name *)
-                      t list -> (* args *)
-                                t
+  string ->
+  (* module_name *)
+  string ->
+  (* fn_name *)
+  t list ->
+  (* args *)
+  t
 
 val pure_runtime_call :
-  string -> (* module_name *)
-            string -> (* fn_name *)
-                      t list -> (* args *)
-                                t
+  string ->
+  (* module_name *)
+  string ->
+  (* fn_name *)
+  t list ->
+  (* args *)
+  t
 
 val runtime_ref : string -> string -> t
 

compiler/core/js_pass_scope.ml

@@ -198,7 +198,8 @@ let record_scope_pass =
                   since it's in the loop
 
                   TODO: we should also
-              *) -> (
+              *)
+                -> (
                 match value with
                 | None ->
                   add_loop_mutable_variable state ident

compiler/core/lam_compile.ml

@@ -509,26 +509,22 @@ let compile output_prefix =
         Ext_list.fold_left rest acc (fun acc x ->
             Js_output.append_output acc (compile_recursive_lets_aux cxt x)))
   and compile_general_cases :
-        'a.
-        make_exp:('a -> J.expression) ->
-        eq_exp:
-          ('a option ->
-          J.expression ->
-          'a option ->
-          J.expression ->
-          J.expression) ->
-        cxt:Lam_compile_context.t ->
-        switch:
-          (?default:J.block ->
-          ?declaration:Lam_compat.let_kind * Ident.t ->
-          _ ->
-          ('a * J.case_clause) list ->
-          J.statement) ->
-        switch_exp:J.expression ->
-        default:default_case ->
-        ?merge_cases:('a -> 'a -> bool) ->
-        ('a * Lam.t) list ->
-        J.block =
+      'a.
+      make_exp:('a -> J.expression) ->
+      eq_exp:
+        ('a option -> J.expression -> 'a option -> J.expression -> J.expression) ->
+      cxt:Lam_compile_context.t ->
+      switch:
+        (?default:J.block ->
+        ?declaration:Lam_compat.let_kind * Ident.t ->
+        _ ->
+        ('a * J.case_clause) list ->
+        J.statement) ->
+      switch_exp:J.expression ->
+      default:default_case ->
+      ?merge_cases:('a -> 'a -> bool) ->
+      ('a * Lam.t) list ->
+      J.block =
    fun (type a) ~(make_exp : a -> J.expression)
        ~(eq_exp :
           a option -> J.expression -> a option -> J.expression -> J.expression)

compiler/core/lam_compile_primitive.ml

@@ -612,5 +612,6 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
   (* let parm = Ident.create "prim" in
      Lfunction(Curried, [parm],
                Matching.inline_lazy_force (Lvar parm) Location.none)
-     It is inlined, this should not appear here *) ->
+     It is inlined, this should not appear here *)
+    ->
     assert false

compiler/core/lam_pass_lets_dce.ml

@@ -59,7 +59,8 @@ let lets_helper (count_var : Ident.t -> Lam_pass_count.used_info) lam : Lam.t =
          Note for some constant which is not
          inlined, we can still record it and
          do constant folding independently
-      *) ->
+      *)
+        ->
         Hash_ident.add subst v (simplif l1);
         simplif l2
       | _, Lconst (Const_string {s; unicode = false}) ->

compiler/core/lam_pass_remove_alias.ml

@@ -156,12 +156,12 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
       match Hash_ident.find_opt meta.ident_tbl v with
       | Some
           (FunctionId
-            {
-              lambda =
-                Some
-                  ( Lfunction ({params; body; attr = {is_a_functor}} as m),
-                    rec_flag );
-            })
+             {
+               lambda =
+                 Some
+                   ( Lfunction ({params; body; attr = {is_a_functor}} as m),
+                     rec_flag );
+             })
         when Lam_analysis.lfunction_can_be_inlined m ->
         if Ext_list.same_length ap_args params then
           if is_a_functor (* && (Set_ident.mem v meta.export_idents) && false *)
@@ -170,7 +170,6 @@ let simplify_alias (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
                if so, maybe not since in that case,
                we are going to have two copy?
             *)
-
             (* Check: recursive applying may result in non-termination *)
             (* Ext_log.dwarn __LOC__ "beta .. %s/%d" v.name v.stamp ; *)
             simpl

compiler/core/lam_stats_export.ml

@@ -55,8 +55,8 @@ let values_of_export (meta : Lam_stats.t) (export_map : Lam.t Map_ident.t) :
         match optlam with
         | Some
             (Lconst
-              ( Const_js_null | Const_js_undefined _ | Const_js_true
-              | Const_js_false ))
+               ( Const_js_null | Const_js_undefined _ | Const_js_true
+               | Const_js_false ))
         | None ->
           optlam
         | Some lambda ->