Format compiler sources with ocamlformat

.github/workflows/ci.yml

@@ -186,7 +186,7 @@ jobs:
 
  - name: Install OPAM dependencies
  if: steps.cache-opam-env.outputs.cache-hit != 'true'
- run: opam install . --deps-only
+ run: opam install . --deps-only --with-test
 
  - name: Cache OPAM environment
  if: steps.cache-opam-env.outputs.cache-hit != 'true'

.ocamlformat-ignore

@@ -0,0 +1,19 @@
+compiler/js_parser/**
+compiler/ml/cmt_format.ml
+compiler/ml/pprintast.ml
+compiler/core/js_name_of_module_id.ml
+compiler/core/js_pass_debug.ml
+compiler/core/lam_util.ml
+compiler/core/lam_compile_main.ml
+compiler/ext/bs_hash_stubs.ml
+compiler/ext/js_reserved_map.ml
+compiler/ext/ext_string.ml
+compiler/ext/ext_string.mli
+compiler/ext/ext_sys.ml
+compiler/ext/hash.cppo.ml
+compiler/ext/hash_set.cppo.ml
+compiler/ext/map.cppo.ml
+compiler/ext/ordered_hash_map.cppo.ml
+compiler/ext/set.cppo.ml
+compiler/ext/vec.cppo.ml
+compiler/syntax/compiler-libs-406/*

CONTRIBUTING.md

@@ -17,7 +17,7 @@ Happy hacking!
 - [NodeJS v18](https://nodejs.org/)
 - C compiler toolchain (usually installed with `xcode` on Mac)
 - Rust toolchain (required to build rewatch; follow the instructions at https://www.rust-lang.org/tools/install)
-- `opam` (OCaml Package Manager)
+- `opam` (OCaml Package Manager) v2.2.0
 - VSCode (+ [OCaml Platform Extension](https://marketplace.visualstudio.com/items?itemName=ocamllabs.ocaml-platform))
 
 ## Cloning the Git Repo
@@ -49,10 +49,7 @@ opam init
 opam switch create 5.2.0 # can also create local switch with opam switch create
 
 # Install dev dependencies from OPAM
-opam install . --deps-only
-
-# For IDE support, install the OCaml language server
-opam install ocaml-lsp-server
+opam install . --deps-only --with-test --with-dev-setup -y
 ```
 
 #### npm install

compiler/bsb/bsb_arg.ml

@@ -63,29 +63,29 @@ let usage_b (buf : Ext_buffer.t) ~usage (speclist : t) =
  buf +> String.make (!max_col + 4) ' ');
  match String.index_from_opt doc !cur '\n' with
  | None ->
-  buf +> String.sub doc !cur (String.length doc - !cur);
-  cur := doc_length
+ buf +> String.sub doc !cur (String.length doc - !cur);
+ cur := doc_length
  | Some new_line_pos ->
-  buf +> String.sub doc !cur (new_line_pos - !cur);
-  cur := new_line_pos + 1
+ buf +> String.sub doc !cur (new_line_pos - !cur);
+ cur := new_line_pos + 1
  done;
  buf +> "\n")))
 
 let stop_raise ~usage ~(error : error) (speclist : t) =
  let b = Ext_buffer.create 200 in
  (match error with
  | Unknown ("-help" | "--help" | "-h") ->
-  usage_b b ~usage speclist;
-  Ext_buffer.output_buffer stdout b;
-  exit 0
+ usage_b b ~usage speclist;
+ Ext_buffer.output_buffer stdout b;
+ exit 0
  | Unknown s ->
-  b +> "Unknown option \"";
-  b +> s;
-  b +> "\".\n"
+ b +> "Unknown option \"";
+ b +> s;
+ b +> "\".\n"
  | Missing s ->
-  b +> "Option \"";
-  b +> s;
-  b +> "\" needs an argument.\n");
+ b +> "Option \"";
+ b +> s;
+ b +> "\" needs an argument.\n");
  usage_b b ~usage speclist;
  bad_arg (Ext_buffer.contents b)
 
@@ -99,20 +99,20 @@ let parse_exn ~usage ~argv ?(start = 1) ?(finish = Array.length argv)
  if s <> "" && s.[0] = '-' then
  match Ext_spec.assoc3 speclist s with
  | Some action -> (
-  match action with
-  | Unit r -> (
-  match r with
-  | Unit_set r -> r.contents <- true
-  | Unit_call f -> f ())
-  | String f -> (
-  if !current >= finish then
-  stop_raise ~usage ~error:(Missing s) speclist
-  else
-  let arg = argv.(!current) in
-  incr current;
-  match f with
-  | String_call f -> f arg
-  | String_set u -> u.contents <- arg))
+ match action with
+ | Unit r -> (
+ match r with
+ | Unit_set r -> r.contents <- true
+ | Unit_call f -> f ())
+ | String f -> (
+ if !current >= finish then
+ stop_raise ~usage ~error:(Missing s) speclist
+ else
+ let arg = argv.(!current) in
+ incr current;
+ match f with
+ | String_call f -> f arg
+ | String_set u -> u.contents <- arg))
  | None -> stop_raise ~usage ~error:(Unknown s) speclist
  else rev_list := s :: !rev_list
  done;

compiler/bsb/bsb_build_util.ml

@@ -24,7 +24,7 @@
 
 let flag_concat flag xs =
  String.concat Ext_string.single_space
- (Ext_list.flat_map xs (fun x -> [ flag; x ]))
+ (Ext_list.flat_map xs (fun x -> [flag; x]))
 
 let ( // ) = Ext_path.combine
 
@@ -42,11 +42,11 @@ let pp_flag (xs : string) = "-pp " ^ Ext_filename.maybe_quote xs
 
 let include_dirs dirs =
  String.concat Ext_string.single_space
- (Ext_list.flat_map dirs (fun x -> [ "-I"; Ext_filename.maybe_quote x ]))
+ (Ext_list.flat_map dirs (fun x -> ["-I"; Ext_filename.maybe_quote x]))
 
 let include_dirs_by dirs fn =
  String.concat Ext_string.single_space
- (Ext_list.flat_map dirs (fun x -> [ "-I"; Ext_filename.maybe_quote (fn x) ]))
+ (Ext_list.flat_map dirs (fun x -> ["-I"; Ext_filename.maybe_quote (fn x)]))
 
 (* we use lazy $src_root_dir *)
 
@@ -64,7 +64,7 @@ let convert_and_resolve_path : string -> string -> string =
  else failwith ("Unknown OS :" ^ Sys.os_type)
 (* we only need convert the path in the beginning *)
 
-type result = { path : string; checked : bool }
+type result = {path: string; checked: bool}
 
 (* Magic path resolution:
  foo => foo
@@ -78,7 +78,7 @@ let resolve_bsb_magic_file ~cwd ~desc p : result =
  let no_slash = Ext_string.no_slash_idx p in
  if no_slash < 0 then
  (* Single file FIXME: better error message for "" input *)
- { path = p; checked = false }
+ {path = p; checked = false}
  else
  let first_char = String.unsafe_get p 0 in
  if Filename.is_relative p && first_char <> '.' then
@@ -91,13 +91,13 @@ let resolve_bsb_magic_file ~cwd ~desc p : result =
  (* let p = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_slash_backward p else p in *)
  let package_dir = Bsb_pkg.resolve_bs_package ~cwd package_name in
  let path = package_dir // relative_path in
- if Sys.file_exists path then { path; checked = true }
+ if Sys.file_exists path then {path; checked = true}
  else (
  Bsb_log.error "@{<error>Could not resolve @} %s in %s@." p cwd;
  failwith (p ^ " not found when resolving " ^ desc))
  else
  (* relative path [./x/y]*)
- { path = convert_and_resolve_path cwd p; checked = true }
+ {path = convert_and_resolve_path cwd p; checked = true}
 
 (** converting a file from Linux path format to Windows *)
 
@@ -121,7 +121,9 @@ let rec mkp dir =
 
 let get_list_string_acc (s : Ext_json_types.t array) acc =
  Ext_array.to_list_map_acc s acc (fun x ->
- match x with Str x -> Some x.str | _ -> None)
+ match x with
+ | Str x -> Some x.str
+ | _ -> None)
 
 let get_list_string s = get_list_string_acc s []
 
@@ -130,7 +132,7 @@ let ( |? ) m (key, cb) = m |> Ext_json.test key cb
 
 type top = Expect_none | Expect_name of string
 
-type package_context = { proj_dir : string; top : top; is_pinned: bool }
+type package_context = {proj_dir: string; top: top; is_pinned: bool}
 
 (**
  TODO: check duplicate package name
@@ -146,79 +148,82 @@ type package_context = { proj_dir : string; top : top; is_pinned: bool }
 let pp_packages_rev ppf lst =
  Ext_list.rev_iter lst (fun s -> Format.fprintf ppf "%s " s)
 
-let extract_pinned_dependencies (map : Ext_json_types.t Map_string.t) : Set_string.t =
+let extract_pinned_dependencies (map : Ext_json_types.t Map_string.t) :
+ Set_string.t =
  match Map_string.find_opt map Bsb_build_schemas.pinned_dependencies with
  | None -> Set_string.empty
- | Some (Arr { content }) ->
- Set_string.of_list (get_list_string content)
+ | Some (Arr {content}) -> Set_string.of_list (get_list_string content)
  | Some config -> Bsb_exception.config_error config "expect an array of string"
 
 let rec walk_all_deps_aux (visited : string Hash_string.t) (paths : string list)
  ~(top : top) (dir : string) (queue : _ Queue.t) ~pinned_dependencies =
- match Bsb_config_load.load_json ~per_proj_dir:dir ~warn_legacy_config:false with
- | _, Obj { map; loc } ->
- let cur_package_name =
- match Map_string.find_opt map Bsb_build_schemas.name with
- | Some (Str { str; loc }) ->
- (match top with
- | Expect_none -> ()
- | Expect_name s ->
- if s <> str then
- Bsb_exception.errorf ~loc
- "package name is expected to be %s but got %s" s str);
- str
- | Some _ | None ->
- Bsb_exception.errorf ~loc "package name missing in %s/bsconfig.json"
- dir
+ match
+ Bsb_config_load.load_json ~per_proj_dir:dir ~warn_legacy_config:false
+ with
+ | _, Obj {map; loc} ->
+ let cur_package_name =
+ match Map_string.find_opt map Bsb_build_schemas.name with
+ | Some (Str {str; loc}) ->
+ (match top with
+ | Expect_none -> ()
+ | Expect_name s ->
+ if s <> str then
+ Bsb_exception.errorf ~loc
+ "package name is expected to be %s but got %s" s str);
+ str
+ | Some _ | None ->
+ Bsb_exception.errorf ~loc "package name missing in %s/bsconfig.json" dir
+ in
+ if Ext_list.mem_string paths cur_package_name then (
+ Bsb_log.error "@{<error>Cyclic dependencies in package stack@}@.";
+ exit 2);
+ let package_stacks = cur_package_name :: paths in
+ Bsb_log.info "@{<info>Package stack:@} %a @." pp_packages_rev package_stacks;
+ if Hash_string.mem visited cur_package_name then
+ Bsb_log.info "@{<info>Visited before@} %s@." cur_package_name
+ else
+ let explore_deps (deps : string) pinned_dependencies =
+ map
+ |? ( deps,
+ `Arr
+ (fun (new_packages : Ext_json_types.t array) ->
+ Ext_array.iter new_packages (fun js ->
+ match js with
+ | Str {str = new_package} ->
+ let package_dir =
+ Bsb_pkg.resolve_bs_package ~cwd:dir
+ (Bsb_pkg_types.string_as_package new_package)
+ in
+ walk_all_deps_aux visited package_stacks
+ ~top:(Expect_name new_package) package_dir queue
+ ~pinned_dependencies
+ | _ -> Bsb_exception.errorf ~loc "%s expect an array" deps))
+ )
+ |> ignore
  in
- if Ext_list.mem_string paths cur_package_name then (
- Bsb_log.error "@{<error>Cyclic dependencies in package stack@}@.";
- exit 2);
- let package_stacks = cur_package_name :: paths in
- Bsb_log.info "@{<info>Package stack:@} %a @." pp_packages_rev
- package_stacks;
- if Hash_string.mem visited cur_package_name then
- Bsb_log.info "@{<info>Visited before@} %s@." cur_package_name
- else
- let explore_deps (deps : string) pinned_dependencies =
- map
- |? ( deps,
- `Arr
- (fun (new_packages : Ext_json_types.t array) ->
- Ext_array.iter new_packages (fun js ->
- match js with
- | Str { str = new_package } ->
- let package_dir =
- Bsb_pkg.resolve_bs_package ~cwd:dir
- (Bsb_pkg_types.string_as_package new_package)
- in
- walk_all_deps_aux visited package_stacks
- ~top:(Expect_name new_package) package_dir queue
- ~pinned_dependencies
- | _ ->
- Bsb_exception.errorf ~loc "%s expect an array" deps))
- )
- |> ignore
- in
- let is_pinned = match top with
+ let is_pinned =
+ match top with
  | Expect_name n when Set_string.mem pinned_dependencies n -> true
  | _ -> false
- in
- let pinned_dependencies = match is_pinned with
+ in
+ let pinned_dependencies =
+ match is_pinned with
  | true ->
- let transitive_pinned_dependencies = extract_pinned_dependencies map
+ let transitive_pinned_dependencies =
+ extract_pinned_dependencies map
  in
  Set_string.union transitive_pinned_dependencies pinned_dependencies
  | false -> pinned_dependencies
- in
- explore_deps Bsb_build_schemas.bs_dependencies pinned_dependencies;
- (match top with
- | Expect_none -> explore_deps Bsb_build_schemas.bs_dev_dependencies pinned_dependencies
- | Expect_name _ when is_pinned ->
- explore_deps Bsb_build_schemas.bs_dev_dependencies pinned_dependencies
- | Expect_name _ -> ());
- Queue.add { top; proj_dir = dir; is_pinned } queue;
- Hash_string.add visited cur_package_name dir
+ in
+ explore_deps Bsb_build_schemas.bs_dependencies pinned_dependencies;
+ (match top with
+ | Expect_none ->
+ explore_deps Bsb_build_schemas.bs_dev_dependencies pinned_dependencies
+ | Expect_name _ when is_pinned ->
+ explore_deps Bsb_build_schemas.bs_dev_dependencies pinned_dependencies
+ | Expect_name _ -> ());
+ Queue.add {top; proj_dir = dir; is_pinned} queue;
+ Hash_string.add visited cur_package_name dir
  | _ -> ()
 
 let walk_all_deps dir ~pinned_dependencies : package_context Queue.t =

compiler/bsb/bsb_build_util.mli

@@ -74,17 +74,17 @@ val get_list_string : Ext_json_types.t array -> string list
 
 type top = Expect_none | Expect_name of string
 
-type result = { path : string; checked : bool }
+type result = {path: string; checked: bool}
 
 (* [resolve_bsb_magic_file]
  returns a tuple (path,checked)
  when checked is true, it means such file should exist without depending on env
 *)
 val resolve_bsb_magic_file : cwd:string -> desc:string -> string -> result
 
-type package_context = { proj_dir : string; top : top; is_pinned: bool }
+type package_context = {proj_dir: string; top: top; is_pinned: bool}
 
-val extract_pinned_dependencies: Ext_json_types.t Map_string.t -> Set_string.t
+val extract_pinned_dependencies : Ext_json_types.t Map_string.t -> Set_string.t
 
 val walk_all_deps :
  string -> pinned_dependencies:Set_string.t -> package_context Queue.t

compiler/bsb/bsb_clean.ml

@@ -31,7 +31,7 @@ let ninja_clean proj_dir =
  let cwd = proj_dir // lib_artifacts_dir in
  if Sys.file_exists cwd then
  let eid =
- Bsb_unix.run_command_execv { cmd; args = [| cmd; "-t"; "clean" |]; cwd }
+ Bsb_unix.run_command_execv {cmd; args = [|cmd; "-t"; "clean"|]; cwd}
  in
  if eid <> 0 then Bsb_log.warn "@{<warning>Failed@}@."
  with e -> Bsb_log.warn "@{<warning>Failed@}: %s @." (Printexc.to_string e)