From 576c9a3df341aece0298d36fed2f80594888621c Mon Sep 17 00:00:00 2001 From: Hugo Heuzard Date: Tue, 3 Dec 2024 12:07:30 +0100 Subject: [PATCH] Misc: ocamlformat.0.27 --- .ocamlformat | 3 +- benchmarks/common.ml | 6 +- benchmarks/report.ml | 10 +- benchmarks/run.ml | 4 +- benchmarks/sources/ml/nucleic.ml | 720 +++++++++--------- benchmarks/sources/ml/raytrace.ml | 12 +- compiler/bin-js_of_ocaml/js_of_ocaml.ml | 4 +- compiler/lib-cmdline/jsoo_cmdline.ml | 7 +- compiler/lib-runtime-files/gen/gen.ml | 8 +- compiler/lib/base64.ml | 16 +- compiler/lib/duplicate.ml | 4 +- compiler/lib/effects.ml | 28 +- compiler/lib/eval.ml | 27 +- compiler/lib/freevars.ml | 6 +- compiler/lib/generate.ml | 41 +- compiler/lib/generate_closure.ml | 4 +- compiler/lib/global_deadcode.ml | 9 +- compiler/lib/inline.ml | 37 +- compiler/lib/javascript.ml | 56 +- compiler/lib/js_output.ml | 39 +- compiler/lib/js_traverse.ml | 172 ++--- compiler/lib/link_js.ml | 41 +- compiler/lib/loc.ml | 7 +- compiler/lib/macro.ml | 8 +- compiler/lib/parse_bytecode.ml | 26 +- compiler/lib/parse_js.ml | 30 +- compiler/lib/source_map.ml | 84 +- compiler/lib/stdlib.ml | 57 +- compiler/lib/targetint.ml | 5 +- compiler/lib/unit_info.ml | 8 +- compiler/ppx/ppx_optcomp_light.ml | 133 ++-- compiler/tests-compiler/gen-rules/gen.ml | 15 +- compiler/tests-compiler/global_deadcode.ml | 4 +- compiler/tests-compiler/util/util.ml | 16 +- compiler/tests-js-parser/run.ml | 8 +- compiler/tests-jsoo/bin/error1.ml | 4 +- compiler/tests-jsoo/test_marshal.ml | 5 +- examples/boulderdash/boulderdash.ml | 23 +- examples/graph_viewer/viewer.ml | 18 +- examples/graph_viewer/viewer_common.ml | 5 +- examples/hyperbolic/hypertree.ml | 19 +- examples/planet/planet.ml | 9 +- lib/js_of_ocaml/cSS.ml | 314 ++++---- lib/js_of_ocaml/dom_html.ml | 25 +- lib/js_of_ocaml/js.ml | 7 +- lib/js_of_ocaml/json.ml | 7 +- lib/js_of_ocaml/regexp.ml | 10 +- lib/js_of_ocaml/webGL.ml | 2 +- lib/lwt/lwt_js_events.ml | 7 +- lib/lwt/lwt_jsonp.ml | 24 +- lib/lwt/lwt_xmlHttpRequest.mli | 21 +- lib/tests/gen-rules/gen.ml | 15 +- lib/tests/test_fun_call.ml | 4 +- lib/tyxml/tyxml_js.ml | 7 +- .../lib/ppx_deriving_json.ml | 6 +- ppx/ppx_js/lib_internal/ppx_js_internal.ml | 18 +- toplevel/bin/jsoo_common.ml | 22 +- toplevel/examples/lwt_toplevel/examples.ml | 8 +- toplevel/examples/lwt_toplevel/toplevel.ml | 5 +- 59 files changed, 1155 insertions(+), 1085 deletions(-) mode change 100755 => 100644 benchmarks/report.ml mode change 100755 => 100644 benchmarks/run.ml diff --git a/.ocamlformat b/.ocamlformat index b880169c2f..6cc402312c 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -10,5 +10,6 @@ break-separators=before dock-collection-brackets=false margin=90 module-item-spacing=sparse -version=0.26.2 +parse-docstrings=false +version=0.27.0 ocaml-version=4.08.0 diff --git a/benchmarks/common.ml b/benchmarks/common.ml index 8d276c0860..cf7d5b52b5 100644 --- a/benchmarks/common.ml +++ b/benchmarks/common.ml @@ -193,9 +193,9 @@ end = struct then fun x -> x else fun x -> - x - |> List.filter ~f:(fun nm -> Filename.check_suffix nm spec.ext) - |> List.map ~f:Filename.chop_extension) + x + |> List.filter ~f:(fun nm -> Filename.check_suffix nm spec.ext) + |> List.map ~f:Filename.chop_extension) |> List.sort ~cmp:compare let ml = create "ml" ".ml" diff --git a/benchmarks/report.ml b/benchmarks/report.ml old mode 100755 new mode 100644 index 84c1c84604..f642310702 --- a/benchmarks/report.ml +++ b/benchmarks/report.ml @@ -160,8 +160,8 @@ let stats (h, t) = let escape_name_for_gnuplot s = let b = Buffer.create (String.length s) in String.iter s ~f:(function - | '_' -> Buffer.add_string b {|\\\_|} - | c -> Buffer.add_char b c); + | '_' -> Buffer.add_string b {|\\\_|} + | c -> Buffer.add_char b c); Buffer.contents b let text_output _no_header (h, t) = @@ -291,9 +291,9 @@ let output_tables r conf = output_table r (List.map conf ~f:(function - | None -> read_blank_column () - | Some (dir1, dir2, color, title, refe) -> - read_column ~title ~color dir1 (Spec.create dir2 "") refe)) + | None -> read_blank_column () + | Some (dir1, dir2, color, title, refe) -> + read_column ~title ~color dir1 (Spec.create dir2 "") refe)) (output_function !no_header); no_header := true); close () diff --git a/benchmarks/run.ml b/benchmarks/run.ml old mode 100755 new mode 100644 index 9b4b6eb851..ab7ee8a6a7 --- a/benchmarks/run.ml +++ b/benchmarks/run.ml @@ -341,5 +341,5 @@ let _ = List.iter compilers ~f:(fun (comp, dir) -> measure param src (Filename.concat times dir) Spec.js comp; List.iter suites ~f:(function - | None -> () - | Some suite -> measure param code (Filename.concat times dir) suite comp)) + | None -> () + | Some suite -> measure param code (Filename.concat times dir) suite comp)) diff --git a/benchmarks/sources/ml/nucleic.ml b/benchmarks/sources/ml/nucleic.ml index 100e7d9c48..e70d73464a 100644 --- a/benchmarks/sources/ml/nucleic.ml +++ b/benchmarks/sources/ml/nucleic.ml @@ -424,410 +424,410 @@ let is_G = function let nuc_C1' (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = c1' let nuc_C2 (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = c2 let nuc_C3' (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = c3' let nuc_C4 (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = c4 let nuc_C4' (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = c4' let nuc_N1 (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = n1 let nuc_O3' (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = o3' let nuc_P (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = p let nuc_dgf_base_tfo (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = dgf_base_tfo let nuc_p_o3'_180_tfo (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = p_o3'_180_tfo let nuc_p_o3'_275_tfo (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = p_o3'_275_tfo let nuc_p_o3'_60_tfo (N - ( dgf_base_tfo - , p_o3'_275_tfo - , p_o3'_180_tfo - , p_o3'_60_tfo - , p - , o1p - , o2p - , o5' - , c5' - , h5' - , h5'' - , c4' - , h4' - , o4' - , c1' - , h1' - , c2' - , h2'' - , o2' - , h2' - , c3' - , h3' - , o3' - , n1 - , n3 - , c2 - , c4 - , c5 - , c6 - , _ )) = + ( dgf_base_tfo + , p_o3'_275_tfo + , p_o3'_180_tfo + , p_o3'_60_tfo + , p + , o1p + , o2p + , o5' + , c5' + , h5' + , h5'' + , c4' + , h4' + , o4' + , c1' + , h1' + , c2' + , h2'' + , o2' + , h2' + , c3' + , h3' + , o3' + , n1 + , n3 + , c2 + , c4 + , c5 + , c6 + , _ )) = p_o3'_60_tfo let rA_N9 = function diff --git a/benchmarks/sources/ml/raytrace.ml b/benchmarks/sources/ml/raytrace.ml index 37d325b132..9b27e2df02 100644 --- a/benchmarks/sources/ml/raytrace.ml +++ b/benchmarks/sources/ml/raytrace.ml @@ -334,8 +334,9 @@ module Engine = struct (Color.multiply_scalar light.Light.color l))); (if depth <= options.ray_depth then - if options.render_reflections - && info.Intersection_info.shape.Shape.material.Material.reflection > 0. + if + options.render_reflections + && info.Intersection_info.shape.Shape.material.Material.reflection > 0. then let reflection_ray = get_reflection_ray @@ -371,9 +372,10 @@ module Engine = struct in color := Color.add_scalar va db | None -> ()); - if options.render_highlights - && !shadow_info <> None - && info.Intersection_info.shape.Shape.material.Material.gloss > 0. + if + options.render_highlights + && !shadow_info <> None + && info.Intersection_info.shape.Shape.material.Material.gloss > 0. then (*XXX This looks wrong! *) let shape_position = Shape.position info.Intersection_info.shape in diff --git a/compiler/bin-js_of_ocaml/js_of_ocaml.ml b/compiler/bin-js_of_ocaml/js_of_ocaml.ml index a80b6ce41d..7d665d927a 100644 --- a/compiler/bin-js_of_ocaml/js_of_ocaml.ml +++ b/compiler/bin-js_of_ocaml/js_of_ocaml.ml @@ -30,8 +30,8 @@ let () = String.length x > 0 && (not (Char.equal x.[0] '-')) && String.for_all x ~f:(function - | 'a' .. 'z' | 'A' .. 'Z' | '-' -> true - | _ -> false) + | 'a' .. 'z' | 'A' .. 'Z' | '-' -> true + | _ -> false) in match Array.to_list argv with | exe :: maybe_command :: rest -> diff --git a/compiler/lib-cmdline/jsoo_cmdline.ml b/compiler/lib-cmdline/jsoo_cmdline.ml index 6db0c98936..9943936bc7 100644 --- a/compiler/lib-cmdline/jsoo_cmdline.ml +++ b/compiler/lib-cmdline/jsoo_cmdline.ml @@ -28,9 +28,10 @@ let normalize_argv ?(warn = fun _ -> ()) a = let size = String.length s in if size <= 2 then s - else if Char.equal s.[0] '-' - && (not (Char.equal s.[1] '-')) - && not (Char.equal s.[2] '=') + else if + Char.equal s.[0] '-' + && (not (Char.equal s.[1] '-')) + && not (Char.equal s.[2] '=') then ( bad := s :: !bad; (* long option with one dash lets double the dash *) diff --git a/compiler/lib-runtime-files/gen/gen.ml b/compiler/lib-runtime-files/gen/gen.ml index 7f920cc953..06845810c7 100644 --- a/compiler/lib-runtime-files/gen/gen.ml +++ b/compiler/lib-runtime-files/gen/gen.ml @@ -33,10 +33,10 @@ let read_file f = let to_ident s = match String.map (String.uncapitalize_ascii s) ~f:(function - | 'a' .. 'z' as c -> c - | 'A' .. 'Z' as c -> c - | '0' .. '9' as c -> c - | _ -> '_') + | 'a' .. 'z' as c -> c + | 'A' .. 'Z' as c -> c + | '0' .. '9' as c -> c + | _ -> '_') with | "effect" -> "effect_" | x -> x diff --git a/compiler/lib/base64.ml b/compiler/lib/base64.ml index 5757bef9bb..9ab30b56a2 100644 --- a/compiler/lib/base64.ml +++ b/compiler/lib/base64.ml @@ -175,13 +175,14 @@ let decode_sub ?(pad = true) { dmap; _ } ?(off = 0) ?len input = let res = Bytes.create n' in let get_uint8_or_padding = if pad - then (fun t i -> - if i >= len then raise Out_of_bounds; - get_uint8 t (off + i)) + then ( + fun t i -> + if i >= len then raise Out_of_bounds; + get_uint8 t (off + i)) else fun t i -> - try if i < len then get_uint8 t (off + i) else padding - with Out_of_bounds -> padding + try if i < len then get_uint8 t (off + i) else padding + with Out_of_bounds -> padding in let set_be_uint16 t off v = (* can not write 2 bytes. *) @@ -214,8 +215,9 @@ let decode_sub ?(pad = true) { dmap; _ } ?(off = 0) ?len input = while !idx + 4 < len do (* use [unsafe_get_uint16] instead [unsafe_get_uint32] to avoid allocation of [int32]. Of course, [3d3d3d3d] is [====]. *) - if unsafe_get_uint16 input (off + !idx) <> 0x3d3d - || unsafe_get_uint16 input (off + !idx + 2) <> 0x3d3d + if + unsafe_get_uint16 input (off + !idx) <> 0x3d3d + || unsafe_get_uint16 input (off + !idx + 2) <> 0x3d3d then raise Not_found; (* We got something bad, should be a valid character according to [alphabet] but outside the scope. *) diff --git a/compiler/lib/duplicate.ml b/compiler/lib/duplicate.ml index e9b52bbe37..c4e6242355 100644 --- a/compiler/lib/duplicate.ml +++ b/compiler/lib/duplicate.ml @@ -34,8 +34,8 @@ let expr s e = Prim ( p , List.map l ~f:(function - | Pv x -> Pv (s x) - | Pc _ as x -> x) ) + | Pv x -> Pv (s x) + | Pc _ as x -> x) ) let instr s i = match i with diff --git a/compiler/lib/effects.ml b/compiler/lib/effects.ml index e7745994fd..5c3438ab00 100644 --- a/compiler/lib/effects.ml +++ b/compiler/lib/effects.ml @@ -201,7 +201,7 @@ let compute_needed_transformations ~cfg ~idom ~cps_needed ~blocks ~start = match last_instr block.body with | Some (Let - (x, (Apply _ | Prim (Extern ("%resume" | "%perform" | "%reperform"), _)))) + (x, (Apply _ | Prim (Extern ("%resume" | "%perform" | "%reperform"), _)))) when Var.Set.mem x cps_needed -> (* The block after a function application that needs to be turned to CPS or an effect primitive needs to be @@ -356,14 +356,15 @@ let allocate_continuation ~st ~alloc_jump_closures ~split_closures pc x cont = other cases, we can just pass the closure corresponding to the next block. *) let pc', args = cont in - if (match args with - | [] -> true - | [ x' ] -> Var.equal x x' - | _ -> false) - && - match Hashtbl.find st.is_continuation pc' with - | `Param _ -> true - | `Loop -> st.live_vars.(Var.idx x) = List.length args + if + (match args with + | [] -> true + | [ x' ] -> Var.equal x x' + | _ -> false) + && + match Hashtbl.find st.is_continuation pc' with + | `Param _ -> true + | `Loop -> st.live_vars.(Var.idx x) = List.length args then alloc_jump_closures, closure_of_pc ~st pc' else let body, branch = cps_branch ~st ~src:pc cont in @@ -718,7 +719,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p = fun pc block -> cps_block ~st ~k pc block) else fun _ block -> - { block with body = List.map block.body ~f:(fun i -> cps_instr ~st i) } + { block with body = List.map block.body ~f:(fun i -> cps_instr ~st i) } in Code.traverse { fold = Code.fold_children } @@ -912,9 +913,10 @@ let remove_empty_blocks ~live_vars (p : Code.program) : Code.program = in (* We can skip an empty block if its parameters are only used as argument to the continuation *) - if List.for_all - ~f:(fun x -> live_vars.(Var.idx x) = 1 && Var.Set.mem x args) - params + if + List.for_all + ~f:(fun x -> live_vars.(Var.idx x) = 1 && Var.Set.mem x args) + params then Hashtbl.add shortcuts pc (params, cont) | _ -> ()) p.blocks; diff --git a/compiler/lib/eval.ml b/compiler/lib/eval.ml index a36e7518dd..eb0ccf0988 100644 --- a/compiler/lib/eval.ml +++ b/compiler/lib/eval.ml @@ -355,15 +355,16 @@ let eval_instr ~target info i = | Let (x, Prim (prim, prim_args)) -> ( let prim_args' = List.map prim_args ~f:(fun x -> the_const_of ~target info x) in let res = - if List.for_all prim_args' ~f:(function - | Some _ -> true - | _ -> false) + if + List.for_all prim_args' ~f:(function + | Some _ -> true + | _ -> false) then eval_prim ( prim , List.map prim_args' ~f:(function - | Some c -> c - | None -> assert false) ) + | Some c -> c + | None -> assert false) ) else None in match res with @@ -407,14 +408,14 @@ let the_cond_of info x = | Some (Constant (Int x)) -> if Targetint.is_zero x then Zero else Non_zero | Some (Constant - ( Int32 _ - | NativeInt _ - | Float _ - | Tuple _ - | String _ - | NativeString _ - | Float_array _ - | Int64 _ )) -> Non_zero + ( Int32 _ + | NativeInt _ + | Float _ + | Tuple _ + | String _ + | NativeString _ + | Float_array _ + | Int64 _ )) -> Non_zero | Some (Block (_, _, _, _)) -> Non_zero | Some (Field _ | Closure _ | Prim _ | Apply _ | Special _) -> Unknown | None -> Unknown) diff --git a/compiler/lib/freevars.ml b/compiler/lib/freevars.ml index d377370d88..6fe65b106a 100644 --- a/compiler/lib/freevars.ml +++ b/compiler/lib/freevars.ml @@ -237,9 +237,9 @@ let f p = iter_block_bound_vars (fun x -> Code.Var.ISet.add bound x) block; iter_block_free_vars using block; List.iter block.body ~f:(function - | Let (_, Closure (_, (pc_clo, _))) -> - Code.Var.Set.iter using (Code.Addr.Map.find pc_clo acc) - | _ -> ()); + | Let (_, Closure (_, (pc_clo, _))) -> + Code.Var.Set.iter using (Code.Addr.Map.find pc_clo acc) + | _ -> ()); Code.fold_children p.blocks pc (fun pc' () -> traverse pc') ()) in List.iter params ~f:(fun x -> Code.Var.ISet.add bound x); diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index 7784206d67..35612ae98c 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -367,19 +367,19 @@ let runtime_fun ctx name = let str_js_byte s = let b = Buffer.create (String.length s) in String.iter s ~f:(function - | '\\' -> Buffer.add_string b "\\\\" - | '\128' .. '\255' as c -> - Buffer.add_string b "\\x"; - Buffer.add_char_hex b c - | c -> Buffer.add_char b c); + | '\\' -> Buffer.add_string b "\\\\" + | '\128' .. '\255' as c -> + Buffer.add_string b "\\x"; + Buffer.add_char_hex b c + | c -> Buffer.add_char b c); let s = Buffer.contents b in J.EStr (Utf8_string.of_string_exn s) let str_js_utf8 s = let b = Buffer.create (String.length s) in String.iter s ~f:(function - | '\\' -> Buffer.add_string b "\\\\" - | c -> Buffer.add_char b c); + | '\\' -> Buffer.add_string b "\\\\" + | c -> Buffer.add_char b c); let s = Buffer.contents b in J.EStr (Utf8_string.of_string_exn s) @@ -738,7 +738,10 @@ module DTree = struct with Not_found -> ( (* do we have to split again ? *) (* we count the number of cases, default/last case count for one *) - let nbcases = ref 1 (* default case *) in + let nbcases = + ref 1 + (* default case *) + in for i = 0 to array_len - 2 do nbcases := !nbcases + List.length (snd array_norm.(i)) done; @@ -827,8 +830,9 @@ let visit_all params args = l let parallel_renaming loc back_edge params args continuation queue = - if back_edge && Config.Flag.es6 () - (* This is likely slower than using explicit temp variable + if + back_edge && Config.Flag.es6 () + (* This is likely slower than using explicit temp variable but let's experiment with es6 a bit *) then let args, params = @@ -1644,11 +1648,13 @@ and translate_instrs (ctx : Ctx.t) loc expr_queue instrs = (* Compile loops. *) and compile_block st loc queue (pc : Addr.t) scope_stack ~fall_through = - if (not (List.is_empty queue)) - && (Structure.is_loop_header st.structure pc - || (* Do not inline expressions across block boundaries when --no-inline is used + if + (not (List.is_empty queue)) + && (Structure.is_loop_header st.structure pc + || + (* Do not inline expressions across block boundaries when --no-inline is used Single-stepping in the debugger should work better this way (fixes #290). *) - not (Config.Flag.inline ())) + not (Config.Flag.inline ())) then let never, code = compile_block st loc [] pc scope_stack ~fall_through in never, flush_all queue loc code @@ -1964,9 +1970,10 @@ and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bo scope_stack in compile_argument_passing st.ctx loc queue cont back_edge (fun queue -> - if match fall_through with - | Block pc' -> pc' = pc - | Return -> false + if + match fall_through with + | Block pc' -> pc' = pc + | Return -> false then false, flush_all queue loc [] else match scope with diff --git a/compiler/lib/generate_closure.ml b/compiler/lib/generate_closure.ml index ec8380c69f..a3b4c0eb72 100644 --- a/compiler/lib/generate_closure.ml +++ b/compiler/lib/generate_closure.ml @@ -299,8 +299,8 @@ let rec rewrite_closures free_pc blocks body : int * _ * _ list = List.flatten closures |> List.sort ~cmp:(fun a b -> compare (pos a) (pos b)) |> List.concat_map ~f:(function - | One { code; _ } -> [ code ] - | Wrapper { code; wrapper; _ } -> [ code; wrapper ]) + | One { code; _ } -> [ code ] + | Wrapper { code; wrapper; _ } -> [ code; wrapper ]) in let free_pc, blocks, rem = rewrite_closures free_pc blocks rem in free_pc, blocks, closures @ rem diff --git a/compiler/lib/global_deadcode.ml b/compiler/lib/global_deadcode.ml index 575d23031f..affc8f689d 100644 --- a/compiler/lib/global_deadcode.ml +++ b/compiler/lib/global_deadcode.ml @@ -393,10 +393,11 @@ let propagate defs scoped_live_vars ~state ~dep:y ~target:x ~action:usage_kind = | _ -> Domain.top)) (* If x is used as an argument for parameter y, then contribution is liveness of y *) | Propagate { scope; src } -> - if List.for_all scope ~f:(fun z -> - match Var.Tbl.get state z with - | Dead -> false - | _ -> true) + if + List.for_all scope ~f:(fun z -> + match Var.Tbl.get state z with + | Dead -> false + | _ -> true) then Var.Tbl.get state src else Domain.bot | Scope -> ( diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml index e3a0fdab53..c3d0a642df 100644 --- a/compiler/lib/inline.ml +++ b/compiler/lib/inline.ml @@ -111,17 +111,16 @@ let optimizable blocks pc = let optimizable = optimizable && List.for_all b.body ~f:(function - | Let (_, Prim (Extern "caml_js_eval_string", _)) -> false - | Let (_, Prim (Extern "debugger", _)) -> false - | Let - ( _ - , Prim - (Extern ("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr"), _) - ) -> - (* TODO: we should be smarter here and look the generated js *) - (* let's consider it this opmiziable *) - true - | _ -> true) + | Let (_, Prim (Extern "caml_js_eval_string", _)) -> false + | Let (_, Prim (Extern "debugger", _)) -> false + | Let + ( _ + , Prim (Extern ("caml_js_var" | "caml_js_expr" | "caml_pure_js_expr"), _) + ) -> + (* TODO: we should be smarter here and look the generated js *) + (* let's consider it this opmiziable *) + true + | _ -> true) in { optimizable; size = size + this_size }) pc @@ -196,11 +195,12 @@ let inline ~first_class_primitives live_vars closures name pc (outer, p) = params args in - if live_vars.(Var.idx f) = 1 - && Bool.equal outer.optimizable f_optimizable - (* Inlining the code of an optimizable function could + if + live_vars.(Var.idx f) = 1 + && Bool.equal outer.optimizable f_optimizable + (* Inlining the code of an optimizable function could make this code unoptimized. (wrt to Jit compilers) *) - && f_size < Config.Param.inlining_limit () + && f_size < Config.Param.inlining_limit () then let blocks, cont_pc, free_pc = match rem, branch with @@ -313,9 +313,10 @@ let inline ~first_class_primitives live_vars closures name pc (outer, p) = ; params = [] } -> let len = List.length l in - if Code.Var.compare y y' = 0 - && Primitive.has_arity prim len - && args_equal l args + if + Code.Var.compare y y' = 0 + && Primitive.has_arity prim len + && args_equal l args then Let (x, Special (Alias_prim prim)) :: rem, state else i :: rem, state | _ -> i :: rem, state) diff --git a/compiler/lib/javascript.ml b/compiler/lib/javascript.ml index ca1c8be266..998341bf72 100644 --- a/compiler/lib/javascript.ml +++ b/compiler/lib/javascript.ml @@ -55,11 +55,12 @@ end = struct let to_string s = s let to_targetint s = - if String.is_prefix s ~prefix:"0" - && String.length s > 1 - && String.for_all s ~f:(function - | '0' .. '7' -> true - | _ -> false) + if + String.is_prefix s ~prefix:"0" + && String.length s > 1 + && String.for_all s ~f:(function + | '0' .. '7' -> true + | _ -> false) then (* legacy octal notation *) Targetint.of_string_exn ("0o" ^ s) else Targetint.of_string_exn s @@ -530,16 +531,16 @@ and bound_idents_of_pattern p = match p with | ObjectBinding { list; rest } -> ( List.concat_map list ~f:(function - | Prop_ident (Prop_and_ident i, _) -> [ i ] - | Prop_binding (_, e) -> bound_idents_of_element e) + | Prop_ident (Prop_and_ident i, _) -> [ i ] + | Prop_binding (_, e) -> bound_idents_of_element e) @ match rest with | None -> [] | Some x -> [ x ]) | ArrayBinding { list; rest } -> ( List.concat_map list ~f:(function - | None -> [] - | Some e -> bound_idents_of_element e) + | None -> [] + | Some e -> bound_idents_of_element e) @ match rest with | None -> [] @@ -587,30 +588,29 @@ let rec assignment_target_of_expr' x = | EObj l -> let list = List.map l ~f:(function - | Property (PNI n, EVar (S { name = n'; _ } as id)) - when Utf8_string.equal n n' -> TargetPropertyId (Prop_and_ident id, None) - | Property (n, e) -> - let e, i = - match e with - | EBin (Eq, e, i) -> e, Some (i, N) - | _ -> e, None - in - TargetProperty (n, assignment_target_of_expr' e, i) - | CoverInitializedName (_, i, (e, loc)) -> - TargetPropertyId - (Prop_and_ident i, Some (assignment_target_of_expr' e, loc)) - | PropertySpread e -> TargetPropertySpread (assignment_target_of_expr' e) - | PropertyMethod (n, m) -> TargetPropertyMethod (n, m)) + | Property (PNI n, EVar (S { name = n'; _ } as id)) when Utf8_string.equal n n' + -> TargetPropertyId (Prop_and_ident id, None) + | Property (n, e) -> + let e, i = + match e with + | EBin (Eq, e, i) -> e, Some (i, N) + | _ -> e, None + in + TargetProperty (n, assignment_target_of_expr' e, i) + | CoverInitializedName (_, i, (e, loc)) -> + TargetPropertyId (Prop_and_ident i, Some (assignment_target_of_expr' e, loc)) + | PropertySpread e -> TargetPropertySpread (assignment_target_of_expr' e) + | PropertyMethod (n, m) -> TargetPropertyMethod (n, m)) in EAssignTarget (ObjectTarget list) | EArr l -> let list = List.map l ~f:(function - | ElementHole -> TargetElementHole - | Element (EVar x) -> TargetElementId (x, None) - | Element (EBin (Eq, EVar x, rhs)) -> TargetElementId (x, Some (rhs, N)) - | Element e -> TargetElement (assignment_target_of_expr' e) - | ElementSpread e -> TargetElementSpread (assignment_target_of_expr' e)) + | ElementHole -> TargetElementHole + | Element (EVar x) -> TargetElementId (x, None) + | Element (EBin (Eq, EVar x, rhs)) -> TargetElementId (x, Some (rhs, N)) + | Element e -> TargetElement (assignment_target_of_expr' e) + | ElementSpread e -> TargetElementSpread (assignment_target_of_expr' e)) in EAssignTarget (ArrayTarget list) | _ -> x diff --git a/compiler/lib/js_output.ml b/compiler/lib/js_output.ml index 94174d2dff..4a8ef9177b 100644 --- a/compiler/lib/js_output.ml +++ b/compiler/lib/js_output.ml @@ -1093,7 +1093,8 @@ struct PP.end_group f; PP.string f ")" (* There MUST be a space between the yield and its - argument. A line return will not work *))) + argument. A line return will not work *)) + ) | EPrivName (Utf8 i) -> PP.string f "#"; PP.string f i @@ -1103,11 +1104,11 @@ struct and template f l = PP.string f "`"; List.iter l ~f:(function - | TStr (Utf8 s) -> PP.string f s - | TExp e -> - PP.string f "${"; - expression AssignementExpression f e; - PP.string f "}"); + | TStr (Utf8 s) -> PP.string f s + | TExp e -> + PP.string f "${"; + expression AssignementExpression f e; + PP.string f "}"); PP.string f "`" and property_name f n = @@ -1656,7 +1657,8 @@ struct PP.end_group f; PP.end_group f (* There MUST be a space between the return and its - argument. A line return will not work *)) + argument. A line return will not work *) + ) | Labelled_statement (i, s) -> let (Utf8 l) = nane_of_label i in PP.string f l; @@ -1790,9 +1792,10 @@ struct f ~force_last_comma:(fun _ -> false) (fun f (s, i) -> - if match i with - | S { name; _ } when Stdlib.Utf8_string.equal name s -> true - | _ -> false + if + match i with + | S { name; _ } when Stdlib.Utf8_string.equal name s -> true + | _ -> false then ident f ~kind:`Binding i else ( pp_ident_or_string_lit f s; @@ -1822,9 +1825,10 @@ struct ~force_last_comma:(fun _ -> false) f (fun f (i, s) -> - if match i with - | S { name; _ } when Stdlib.Utf8_string.equal name s -> true - | _ -> false + if + match i with + | S { name; _ } when Stdlib.Utf8_string.equal name s -> true + | _ -> false then ident f ~kind:`Reference i else ( ident f ~kind:`Reference i; @@ -1916,8 +1920,8 @@ struct PP.string f "}"; PP.end_group f - and function_declaration : - type a. 'pp -> string -> ('pp -> a -> unit) -> a option -> _ -> _ -> _ -> unit = + and function_declaration : type a. + 'pp -> string -> ('pp -> a -> unit) -> a option -> _ -> _ -> _ -> unit = fun f prefix (pp_name : _ -> a -> unit) (name : a option) l body loc -> PP.start_group f 0; PP.start_group f 0; @@ -2125,8 +2129,9 @@ let program ?(accept_unnamed_var = false) ?(source_map = false) f p = (* Firefox assumes that a mapping stops at the end of a line, which is inconvenient. When this happens, we repeat the mapping on the next line. *) - if pos'.PP.p_line = pos.PP.p_line - || (pos'.p_line = pos.p_line - 1 && pos.p_col = 0) + if + pos'.PP.p_line = pos.PP.p_line + || (pos'.p_line = pos.p_line - 1 && pos.p_col = 0) then build_mappings pos' rem (relocate pos' m :: prev_mappings) else if pos.p_col > 0 then diff --git a/compiler/lib/js_traverse.ml b/compiler/lib/js_traverse.ml index 4636d70011..8352f6c5c9 100644 --- a/compiler/lib/js_traverse.ml +++ b/compiler/lib/js_traverse.ml @@ -274,8 +274,8 @@ class map : mapper = method private template l = List.map l ~f:(function - | TStr s -> TStr s - | TExp e -> TExp (m#expression e)) + | TStr s -> TStr s + | TExp e -> TExp (m#expression e)) method expression x = match x with @@ -288,24 +288,23 @@ class map : mapper = EAssignTarget (ArrayTarget (List.map l ~f:(function - | TargetElementHole -> TargetElementHole - | TargetElementId (i, e) -> - TargetElementId (m#ident i, m#initialiser_o e) - | TargetElement e -> TargetElement (m#expression e) - | TargetElementSpread e -> TargetElementSpread (m#expression e)))) + | TargetElementHole -> TargetElementHole + | TargetElementId (i, e) -> + TargetElementId (m#ident i, m#initialiser_o e) + | TargetElement e -> TargetElement (m#expression e) + | TargetElementSpread e -> TargetElementSpread (m#expression e)))) | ObjectTarget l -> EAssignTarget (ObjectTarget (List.map l ~f:(function - | TargetPropertyId (Prop_and_ident i, e) -> - TargetPropertyId (Prop_and_ident (m#ident i), m#initialiser_o e) - | TargetProperty (n, e, i) -> - TargetProperty - (m#property_name n, m#expression e, m#initialiser_o i) - | TargetPropertyMethod (n, x) -> - TargetPropertyMethod (m#property_name n, m#method_ x) - | TargetPropertySpread e -> TargetPropertySpread (m#expression e)))) - ) + | TargetPropertyId (Prop_and_ident i, e) -> + TargetPropertyId (Prop_and_ident (m#ident i), m#initialiser_o e) + | TargetProperty (n, e, i) -> + TargetProperty + (m#property_name n, m#expression e, m#initialiser_o i) + | TargetPropertyMethod (n, x) -> + TargetPropertyMethod (m#property_name n, m#method_ x) + | TargetPropertySpread e -> TargetPropertySpread (m#expression e))))) | EUn (b, e1) -> EUn (b, m#expression e1) | ECallTemplate (e1, t, loc) -> ECallTemplate (m#expression e1, m#template t, m#loc loc) @@ -325,9 +324,9 @@ class map : mapper = | EArr l -> EArr (List.map l ~f:(function - | ElementHole -> ElementHole - | Element e -> Element (m#expression e) - | ElementSpread e -> ElementSpread (m#expression e))) + | ElementHole -> ElementHole + | Element e -> Element (m#expression e) + | ElementSpread e -> ElementSpread (m#expression e))) | EObj l -> EObj (List.map l ~f:(fun p -> @@ -618,8 +617,8 @@ class iter : iterator = method private template l = List.iter l ~f:(function - | TStr _ -> () - | TExp e -> m#expression e) + | TStr _ -> () + | TExp e -> m#expression e) method expression x = match x with @@ -637,25 +636,25 @@ class iter : iterator = match x with | ArrayTarget l -> List.iter l ~f:(function - | TargetElementHole -> () - | TargetElementId (i, e) -> - m#ident i; - m#initialiser_o e - | TargetElement e -> m#expression e - | TargetElementSpread e -> m#expression e) + | TargetElementHole -> () + | TargetElementId (i, e) -> + m#ident i; + m#initialiser_o e + | TargetElement e -> m#expression e + | TargetElementSpread e -> m#expression e) | ObjectTarget l -> List.iter l ~f:(function - | TargetPropertyId (Prop_and_ident i, e) -> - m#ident i; - m#initialiser_o e - | TargetProperty (n, e, i) -> - m#property_name n; - m#expression e; - m#initialiser_o i - | TargetPropertyMethod (n, x) -> - m#property_name n; - m#method_ x - | TargetPropertySpread e -> m#expression e)) + | TargetPropertyId (Prop_and_ident i, e) -> + m#ident i; + m#initialiser_o e + | TargetProperty (n, e, i) -> + m#property_name n; + m#expression e; + m#initialiser_o i + | TargetPropertyMethod (n, x) -> + m#property_name n; + m#method_ x + | TargetPropertySpread e -> m#expression e)) | EUn (_, e1) -> m#expression e1 | ECall (e1, _ak, e2, _) -> m#expression e1; @@ -684,9 +683,9 @@ class iter : iterator = | EArrow (fun_decl, _, _) -> m#fun_decl fun_decl | EArr l -> List.iter l ~f:(function - | ElementHole -> () - | Element e -> m#expression e - | ElementSpread e -> m#expression e) + | ElementHole -> () + | Element e -> m#expression e + | ElementSpread e -> m#expression e) | EObj l -> List.iter l ~f:(fun p -> match p with @@ -1273,10 +1272,11 @@ class rename_variable ~esm = | CoverExportFrom _ -> () method variable_declaration k l = - if match scope, k with - | (Lexical_block | Fun_block _ | Module), (Let | Const) -> depth = 0 - | Lexical_block, Var -> false - | (Fun_block _ | Module), Var -> true + if + match scope, k with + | (Lexical_block | Fun_block _ | Module), (Let | Const) -> depth = 0 + | Lexical_block, Var -> false + | (Fun_block _ | Module), Var -> true then let ids = bound_idents_of_variable_declaration l in List.iter ids ~f:decl_var @@ -1286,10 +1286,11 @@ class rename_variable ~esm = m#statements l method for_binding k p = - if match scope, k with - | (Lexical_block | Fun_block _ | Module), (Let | Const) -> depth = 0 - | Lexical_block, Var -> false - | (Fun_block _ | Module), Var -> true + if + match scope, k with + | (Lexical_block | Fun_block _ | Module), (Let | Const) -> depth = 0 + | Lexical_block, Var -> false + | (Fun_block _ | Module), Var -> true then match p with | BindingIdent i -> decl_var i @@ -1367,11 +1368,11 @@ class rename_variable ~esm = | EAssignTarget (ObjectTarget l) -> let l = List.map l ~f:(function - | TargetPropertyId - (Prop_and_ident (S { name = Utf8 name' as name; _ } as ident), rhs) - when StringMap.mem name' subst -> - TargetProperty (PNI name, EVar ident, rhs) - | b -> b) + | TargetPropertyId + (Prop_and_ident (S { name = Utf8 name' as name; _ } as ident), rhs) + when StringMap.mem name' subst -> + TargetProperty (PNI name, EVar ident, rhs) + | b -> b) in super#expression (EAssignTarget (ObjectTarget l)) | _ -> super#expression e @@ -1463,8 +1464,8 @@ class rename_variable ~esm = let ids = bound_idents_of_binding pat in let l = List.filter ids ~f:(function - | S { name = Utf8 name; _ } -> not (StringSet.mem name decl) - | V _ -> false) + | S { name = Utf8 name; _ } -> not (StringSet.mem name decl) + | V _ -> false) in Some p, l in @@ -1564,13 +1565,13 @@ class compact_vardecl = match s with | Variable_statement (Var, l) -> List.filter_map l ~f:(function - | DeclIdent (x, Some (init, loc)) -> - m#var x; - Some (Expression_statement (expr_eq x init), loc) - | DeclIdent (x, None) -> - m#var x; - None - | DeclPattern _ as x -> Some (Variable_statement (Var, [ x ]), loc)) + | DeclIdent (x, Some (init, loc)) -> + m#var x; + Some (Expression_statement (expr_eq x init), loc) + | DeclIdent (x, None) -> + m#var x; + None + | DeclPattern _ as x -> Some (Variable_statement (Var, [ x ]), loc)) | s -> [ s, loc ]) method program p = @@ -1588,33 +1589,33 @@ class clean = method statements l = let l = super#statements l in List.filter l ~f:(function - | (Empty_statement | Expression_statement (EVar _)), _ -> false - | _ -> true) + | (Empty_statement | Expression_statement (EVar _)), _ -> false + | _ -> true) |> List.group ~f:(fun (x, _) (prev, _) -> match prev, x with | Variable_statement (k1, _), Variable_statement (k2, _) when Poly.(k1 = k2) -> true | _, _ -> false) |> List.map ~f:(function - | (Variable_statement (k1, _), _) :: _ as l -> - let loc = - List.find_map l ~f:(fun (_, loc) -> - match loc with - | N | U -> None - | Pi _ -> Some loc) - |> function - | None -> N - | Some x -> x - in - - ( Variable_statement - ( k1 - , List.concat_map l ~f:(function - | Variable_statement (_, l), _ -> l - | _ -> assert false) ) - , loc ) - | [ x ] -> x - | [] | _ :: _ :: _ -> assert false) + | (Variable_statement (k1, _), _) :: _ as l -> + let loc = + List.find_map l ~f:(fun (_, loc) -> + match loc with + | N | U -> None + | Pi _ -> Some loc) + |> function + | None -> N + | Some x -> x + in + + ( Variable_statement + ( k1 + , List.concat_map l ~f:(function + | Variable_statement (_, l), _ -> l + | _ -> assert false) ) + , loc ) + | [ x ] -> x + | [] | _ :: _ :: _ -> assert false) method statement s = let s = super#statement s in @@ -1757,7 +1758,8 @@ class simpl = ( Some (ECond (cond, e1, e2)) , U (*TODO: it would be better to use the location of the - end of the function, but we can't easily get it. *) ) + end of the function, but we can't easily get it. *) + ) , loc ) :: rem (* if (e1) v1 = e2 else v1 = e3 --> v1 = e1 ? e2 : e3 *) diff --git a/compiler/lib/link_js.ml b/compiler/lib/link_js.ml index 28550099b3..a3e1976dc1 100644 --- a/compiler/lib/link_js.ml +++ b/compiler/lib/link_js.ml @@ -256,12 +256,13 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source ~init:acc ~f:(fun (info : Unit_info.t) (requires, to_link, all) -> let all = StringSet.union all info.provides in - if (not (Config.Flag.auto_link ())) - || mklib - || cmo_file - || linkall - || info.force_link - || not (StringSet.is_empty (StringSet.inter requires info.provides)) + if + (not (Config.Flag.auto_link ())) + || mklib + || cmo_file + || linkall + || info.force_link + || not (StringSet.is_empty (StringSet.inter requires info.provides)) then ( StringSet.diff (StringSet.union info.requires requires) info.provides , StringSet.union to_link info.provides @@ -469,25 +470,23 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source (* select sourcemaps that cover copied section *) let maps = List.concat_map reloc ~f:(function - | `Drop _ -> [] - | `Copy (src, dst, len) -> - List.filter_map - sm - ~f:(fun (first, last, gen_line, gen_column, sm) -> - if first > src + len || last < src - then None - else ( - (* We don't want to deal with overlapping but not included + | `Drop _ -> [] + | `Copy (src, dst, len) -> + List.filter_map sm ~f:(fun (first, last, gen_line, gen_column, sm) -> + if first > src + len || last < src + then None + else ( + (* We don't want to deal with overlapping but not included sourcemap, but we could in theory filter out part of it. *) - assert (src <= first && last <= src + len); - Some (first, last, gen_line + dst - src, gen_column, sm)))) + assert (src <= first && last <= src + len); + Some (first, last, gen_line + dst - src, gen_column, sm)))) in (* Make sure dropped sections are not overlapping selected sourcemap. *) List.iter reloc ~f:(function - | `Copy _ -> () - | `Drop (src, len) -> - List.iter maps ~f:(fun (first, last, _, _, _) -> - if first > src + len || last < src then () else assert false)); + | `Copy _ -> () + | `Drop (src, len) -> + List.iter maps ~f:(fun (first, last, _, _, _) -> + if first > src + len || last < src then () else assert false)); maps) in let sections = List.concat sections in diff --git a/compiler/lib/loc.ml b/compiler/lib/loc.ml index 6ae745a224..fc30e15126 100644 --- a/compiler/lib/loc.ml +++ b/compiler/lib/loc.ml @@ -49,9 +49,10 @@ let create ?(last_line = dummy_line) (p1 : Lexing.position) (p2 : Lexing.positio if p1.pos_fname = p2.pos_fname && p1.pos_lnum = p2.pos_lnum && p1.pos_bol = p2.pos_bol then let line = - if last_line.pos_fname == p1.pos_fname - && last_line.pos_lnum = p1.pos_lnum - && last_line.pos_bol = p1.pos_bol + if + last_line.pos_fname == p1.pos_fname + && last_line.pos_lnum = p1.pos_lnum + && last_line.pos_bol = p1.pos_bol then last_line else { pos_fname = p1.pos_fname; pos_lnum = p1.pos_lnum; pos_bol = p1.pos_bol } in diff --git a/compiler/lib/macro.ml b/compiler/lib/macro.ml index 640f355b22..69e36b6a83 100644 --- a/compiler/lib/macro.ml +++ b/compiler/lib/macro.ml @@ -42,13 +42,13 @@ class macro_mapper ~flags = super#expression x) | "BLOCK", J.Arg (J.ENum tag) :: (_ :: _ as args) when List.for_all args ~f:(function - | J.Arg _ -> true - | J.ArgSpread _ -> false) -> + | J.Arg _ -> true + | J.ArgSpread _ -> false) -> let tag = Targetint.to_int_exn (J.Num.to_targetint tag) in let args = List.map args ~f:(function - | J.Arg e -> J.Element (m#expression e) - | J.ArgSpread _ -> assert false) + | J.Arg e -> J.Element (m#expression e) + | J.ArgSpread _ -> assert false) in Mlvalue.Block.make ~tag ~args | "TAG", [ J.Arg e ] -> Mlvalue.Block.tag (m#expression e) diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml index 667f62c5c5..9c982b6441 100644 --- a/compiler/lib/parse_bytecode.ml +++ b/compiler/lib/parse_bytecode.ml @@ -939,8 +939,9 @@ and compile infos pc state (instrs : instr list) = if pc = infos.limit then - if (* stop if we reach end_of_code (ie when compiling cmo) *) - pc = String.length infos.code / 4 + if + (* stop if we reach end_of_code (ie when compiling cmo) *) + pc = String.length infos.code / 4 then ( if debug_parser () then Format.eprintf "Stop@."; instrs, Stop, state) @@ -2844,9 +2845,9 @@ module Reloc = struct i in List.iter compunit.cu_reloc ~f:(function - | Reloc_literal sc, pos -> gen_patch_int code pos (slot_for_literal sc) - | Reloc_primitive name, pos -> gen_patch_int code pos (num_of_prim name) - | _ -> ()) + | Reloc_literal sc, pos -> gen_patch_int code pos (slot_for_literal sc) + | Reloc_primitive name, pos -> gen_patch_int code pos (num_of_prim name) + | _ -> ()) let step2 t compunit code = t.step2_started <- true; @@ -3002,16 +3003,18 @@ let from_channel ic = | `Pre magic -> ( match Magic_number.kind magic with | `Cmo -> - if Config.Flag.check_magic () - && not (Magic_number.equal magic Magic_number.current_cmo) + if + Config.Flag.check_magic () + && not (Magic_number.equal magic Magic_number.current_cmo) then raise Magic_number.(Bad_magic_version magic); let compunit_pos = input_binary_int ic in seek_in ic compunit_pos; let compunit : Cmo_format.compilation_unit = input_value ic in `Cmo compunit | `Cma -> - if Config.Flag.check_magic () - && not (Magic_number.equal magic Magic_number.current_cma) + if + Config.Flag.check_magic () + && not (Magic_number.equal magic Magic_number.current_cma) then raise Magic_number.(Bad_magic_version magic); let pos_toc = input_binary_int ic in (* Go to table of contents *) @@ -3022,8 +3025,9 @@ let from_channel ic = | `Post magic -> ( match Magic_number.kind magic with | `Exe -> - if Config.Flag.check_magic () - && not (Magic_number.equal magic Magic_number.current_exe) + if + Config.Flag.check_magic () + && not (Magic_number.equal magic Magic_number.current_exe) then raise Magic_number.(Bad_magic_version magic); `Exe | _ -> raise Magic_number.(Bad_magic_number (to_string magic))) diff --git a/compiler/lib/parse_js.ml b/compiler/lib/parse_js.ml index 13c9c4aca3..41bd57a3fc 100644 --- a/compiler/lib/parse_js.ml +++ b/compiler/lib/parse_js.ml @@ -354,15 +354,15 @@ let rec offer_one t (lexbuf : Lexer.t) = let h = State.cursor t in let tok, loc = (* restricted productions - * 7.9.1 - 3 - * When, as the program is parsed from left to right, a token is encountered - * that is allowed by some production of the grammar, but the production - * is a restricted production and the token would be the first token for a - * terminal or nonterminal immediately following the annotation [no LineTerminator here] - * within the restricted production (and therefore such a token is called a restricted token), - * and the restricted token is separated from the previous token by at least - * one LineTerminator, then a semicolon is automatically inserted before the - * restricted token. *) + * 7.9.1 - 3 + * When, as the program is parsed from left to right, a token is encountered + * that is allowed by some production of the grammar, but the production + * is a restricted production and the token would be the first token for a + * terminal or nonterminal immediately following the annotation [no LineTerminator here] + * within the restricted production (and therefore such a token is called a restricted token), + * and the restricted token is separated from the previous token by at least + * one LineTerminator, then a semicolon is automatically inserted before the + * restricted token. *) match State.Cursor.last_token h, tok with | ( Some ((T_RETURN | T_CONTINUE | T_BREAK | T_THROW | T_YIELD | T_ASYNC), _, _) , ((T_SEMICOLON | T_VIRTUAL_SEMICOLON) as tok) ) -> tok, loc @@ -375,10 +375,10 @@ let rec offer_one t (lexbuf : Lexer.t) = Lexer.rollback lexbuf; semicolon, dummy_loc (* The practical effect of these restricted productions is as follows: - * When a ++ or -- token is encountered where the parser would treat it - * as a postfix operator, and at least one LineTerminator occurred between - * the preceding token and the ++ or -- token, then a semicolon is automatically - * inserted before the ++ or -- token. *) + * When a ++ or -- token is encountered where the parser would treat it + * as a postfix operator, and at least one LineTerminator occurred between + * the preceding token and the ++ or -- token, then a semicolon is automatically + * inserted before the ++ or -- token. *) | _, T_DECR when not (nl_separated h loc) -> Js_token.T_DECR_NB, loc | _, T_INCR when not (nl_separated h loc) -> Js_token.T_INCR_NB, loc | _, ((T_DIV | T_DIV_ASSIGN) as tok) -> @@ -558,8 +558,8 @@ let parse' lex = in let p = List.map groups ~f:(function - | [] -> assert false - | (annot, _) :: _ as l -> annot, List.map l ~f:snd) + | [] -> assert false + | (annot, _) :: _ as l -> annot, List.map l ~f:snd) in p, toks diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml index 64576d89dd..bd0002f544 100644 --- a/compiler/lib/source_map.ml +++ b/compiler/lib/source_map.ml @@ -81,8 +81,8 @@ module Mappings = struct | _ -> let c = ref 1 in String.iter s ~f:(function - | ';' -> incr c - | _ -> ()); + | ';' -> incr c + | _ -> ()); !c let first_line (Uninterpreted s) = @@ -122,9 +122,10 @@ module Mappings = struct if i < len then let c = a.(i) in - if i + 1 < len - && gen_line c = gen_line a.(i + 1) - && gen_col c = gen_col a.(i + 1) + if + i + 1 < len + && gen_line c = gen_line a.(i + 1) + && gen_col c = gen_col a.(i + 1) then (* Only keep one source location per generated location *) loop prev (i + 1) @@ -268,10 +269,11 @@ module Mappings = struct let invariant ~names:_ ~sources:_ (Uninterpreted str) = (* We can't check much without decoding (which is expensive) *) (* Just do very simple checks *) - if not - (String.for_all str ~f:(function - | ';' | ',' -> true - | x -> Vlq64.in_alphabet x)) + if + not + (String.for_all str ~f:(function + | ';' | ',' -> true + | x -> Vlq64.in_alphabet x)) then invalid_arg "Mappings.invariant" end @@ -313,8 +315,8 @@ let list_stringlit name rest = | `List l -> Some (List.map l ~f:(function - | `Stringlit _ as s -> s - | _ -> invalid ())) + | `Stringlit _ as s -> s + | _ -> invalid ())) | _ -> invalid () with Not_found -> None @@ -324,9 +326,9 @@ let list_stringlit_opt name rest = | `List l -> Some (List.map l ~f:(function - | `Stringlit _ as s -> Some s - | `Null -> None - | _ -> invalid ())) + | `Stringlit _ as s -> Some s + | `Null -> None + | _ -> invalid ())) | _ -> invalid () with Not_found -> None @@ -336,8 +338,8 @@ let list_intlit name rest = | `List l -> Some (List.map l ~f:(function - | `Intlit _ as s -> s - | _ -> invalid ())) + | `Intlit _ as s -> s + | _ -> invalid ())) | _ -> invalid () with Not_found -> None @@ -487,24 +489,24 @@ module Standard = struct | Some l -> Some (`List - (List.map l ~f:(function - | None -> `Null - | Some x -> Source_content.to_json x))) ) + (List.map l ~f:(function + | None -> `Null + | Some x -> Source_content.to_json x))) ) ; ( "ignoreList" , match t.ignore_list with | [] -> None | _ -> Some (`List - (let s = StringSet.of_list t.ignore_list in - List.filter_map - ~f:(fun x -> x) - (List.mapi - ~f:(fun i nm -> - if StringSet.mem nm s - then Some (`Intlit (string_of_int i)) - else None) - t.sources))) ) + (let s = StringSet.of_list t.ignore_list in + List.filter_map + ~f:(fun x -> x) + (List.mapi + ~f:(fun i nm -> + if StringSet.mem nm s + then Some (`Intlit (string_of_int i)) + else None) + t.sources))) ) ]) let of_json (json : Yojson.Raw.t) = @@ -530,8 +532,8 @@ module Standard = struct | Some l -> Some (List.map l ~f:(function - | None -> None - | Some s -> Some (Source_content.of_stringlit s))) + | None -> None + | Some s -> Some (Source_content.of_stringlit s))) in let mappings = match string "mappings" rest with @@ -622,17 +624,17 @@ module Index = struct ; ( "sections" , Some (`List - (List.map - ~f:(fun { offset = { gen_line; gen_column }; map } -> - `Assoc - [ ( "offset" - , `Assoc - [ "line", `Intlit (string_of_int gen_line) - ; "column", `Intlit (string_of_int gen_column) - ] ) - ; "map", Standard.json map - ]) - t.sections)) ) + (List.map + ~f:(fun { offset = { gen_line; gen_column }; map } -> + `Assoc + [ ( "offset" + , `Assoc + [ "line", `Intlit (string_of_int gen_line) + ; "column", `Intlit (string_of_int gen_column) + ] ) + ; "map", Standard.json map + ]) + t.sections)) ) ]) let intlit ~errmsg name json = diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml index 8cb2de2a4a..923e22a388 100644 --- a/compiler/lib/stdlib.ml +++ b/compiler/lib/stdlib.ml @@ -621,10 +621,11 @@ module String = struct let rec loop i = if i > max_idx_a then true - else if not - (Char.equal - (unsafe_get suffix (len_a - 1 - i)) - (unsafe_get s (len_s - 1 - i))) + else if + not + (Char.equal + (unsafe_get suffix (len_a - 1 - i)) + (unsafe_get s (len_s - 1 - i))) then false else loop (i + 1) in @@ -951,47 +952,53 @@ module String = struct else loop max b (last + 1) | '\xE0' -> let last = i + 2 in - if last > max - || not_in_xA0_to_xBF (get b (i + 1)) - || not_in_x80_to_xBF (get b last) + if + last > max + || not_in_xA0_to_xBF (get b (i + 1)) + || not_in_x80_to_xBF (get b last) then false else loop max b (last + 1) | '\xE1' .. '\xEC' | '\xEE' .. '\xEF' -> let last = i + 2 in - if last > max - || not_in_x80_to_xBF (get b (i + 1)) - || not_in_x80_to_xBF (get b last) + if + last > max + || not_in_x80_to_xBF (get b (i + 1)) + || not_in_x80_to_xBF (get b last) then false else loop max b (last + 1) | '\xED' -> let last = i + 2 in - if last > max - || not_in_x80_to_x9F (get b (i + 1)) - || not_in_x80_to_xBF (get b last) + if + last > max + || not_in_x80_to_x9F (get b (i + 1)) + || not_in_x80_to_xBF (get b last) then false else loop max b (last + 1) | '\xF0' -> let last = i + 3 in - if last > max - || not_in_x90_to_xBF (get b (i + 1)) - || not_in_x80_to_xBF (get b (i + 2)) - || not_in_x80_to_xBF (get b last) + if + last > max + || not_in_x90_to_xBF (get b (i + 1)) + || not_in_x80_to_xBF (get b (i + 2)) + || not_in_x80_to_xBF (get b last) then false else loop max b (last + 1) | '\xF1' .. '\xF3' -> let last = i + 3 in - if last > max - || not_in_x80_to_xBF (get b (i + 1)) - || not_in_x80_to_xBF (get b (i + 2)) - || not_in_x80_to_xBF (get b last) + if + last > max + || not_in_x80_to_xBF (get b (i + 1)) + || not_in_x80_to_xBF (get b (i + 2)) + || not_in_x80_to_xBF (get b last) then false else loop max b (last + 1) | '\xF4' -> let last = i + 3 in - if last > max - || not_in_x80_to_x8F (get b (i + 1)) - || not_in_x80_to_xBF (get b (i + 2)) - || not_in_x80_to_xBF (get b last) + if + last > max + || not_in_x80_to_x8F (get b (i + 1)) + || not_in_x80_to_xBF (get b (i + 2)) + || not_in_x80_to_xBF (get b last) then false else loop max b (last + 1) | _ -> false diff --git a/compiler/lib/targetint.ml b/compiler/lib/targetint.ml index 5a79678e9e..098e7f2fe3 100644 --- a/compiler/lib/targetint.ml +++ b/compiler/lib/targetint.ml @@ -98,8 +98,9 @@ let is_zero x = equal x 0l let of_int_exn (x : int) = let offset = offset () in - if Sys.int_size <= 32 - || (Int32.to_int (min_int_ offset) <= x && x <= Int32.to_int (max_int_ offset)) + if + Sys.int_size <= 32 + || (Int32.to_int (min_int_ offset) <= x && x <= Int32.to_int (max_int_ offset)) then Int32.of_int x else failwith (Printf.sprintf "of_int_exn(%d)" x) diff --git a/compiler/lib/unit_info.ml b/compiler/lib/unit_info.ml index 9449b7f656..a3d3112917 100644 --- a/compiler/lib/unit_info.ml +++ b/compiler/lib/unit_info.ml @@ -55,8 +55,8 @@ let of_cmo (cmo : Cmo_format.compilation_unit) = let effects_without_cps = (not (Config.Flag.effects ())) && List.exists (Cmo_format.primitives cmo) ~f:(function - | "%resume" | "%reperform" | "%perform" -> true - | _ -> false) + | "%resume" | "%reperform" | "%perform" -> true + | _ -> false) in let force_link = Cmo_format.force_link cmo in let crcs = @@ -111,8 +111,8 @@ let to_string t = else [ prefix; "Effects_without_cps:"; string_of_bool t.effects_without_cps ]) ] |> List.filter_map ~f:(function - | [] -> None - | l -> Some (String.concat ~sep:" " l)) + | [] -> None + | l -> Some (String.concat ~sep:" " l)) |> String.concat ~sep:"\n" |> fun x -> x ^ "\n" diff --git a/compiler/ppx/ppx_optcomp_light.ml b/compiler/ppx/ppx_optcomp_light.ml index 47cf3f9112..a7e22b1cbf 100644 --- a/compiler/ppx/ppx_optcomp_light.ml +++ b/compiler/ppx/ppx_optcomp_light.ml @@ -99,73 +99,72 @@ let keep loc (attrs : attributes) = try let keep = List.for_all attrs ~f:(function - | { attr_name = { txt = ("if" | "ifnot") as ifnot; _ }; attr_payload; _ } -> ( - let norm = - match ifnot with - | "if" -> fun x -> x - | "ifnot" -> fun x -> not x - | _ -> assert false - in - match attr_payload with - | PStr - [ { pstr_desc = - Pstr_eval - ( { pexp_desc = Pexp_construct ({ txt = Lident ident; _ }, None) - ; _ - } - , [] ) - ; _ - } - ] -> - let b = - match bool_of_string (get_env ident) with - | true -> true - | false -> false - | exception _ -> false - in - norm b - | PStr - [ { pstr_desc = - Pstr_eval - ( { pexp_desc = Pexp_apply (op, [ (Nolabel, a); (Nolabel, b) ]) - ; _ - } - , [] ) - ; _ - } - ] -> - let get_op = function - | { pexp_desc = Pexp_ident { txt = Lident str; _ }; _ } -> ( - match str with - | "<=" -> ( <= ) - | ">=" -> ( >= ) - | ">" -> ( > ) - | "<" -> ( < ) - | "<>" -> ( <> ) - | "=" -> ( = ) - | _ -> raise Invalid) - | _ -> raise Invalid - in - let eval = function - | { pexp_desc = Pexp_ident { txt = Lident "ocaml_version"; _ }; _ } -> - Version.current - | { pexp_desc = Pexp_tuple l; _ } -> - let l = - List.map l ~f:(function - | { pexp_desc = Pexp_constant (Pconst_integer (d, None)) - ; _ - } -> int_of_string d - | _ -> raise Invalid) - in - Version.of_list l - | _ -> raise Invalid - in - let op = get_op op in - let a = eval a in - let b = eval b in - norm (op (Version.compare a b) 0) - | _ -> raise Invalid) - | _ -> true) + | { attr_name = { txt = ("if" | "ifnot") as ifnot; _ }; attr_payload; _ } -> ( + let norm = + match ifnot with + | "if" -> fun x -> x + | "ifnot" -> fun x -> not x + | _ -> assert false + in + match attr_payload with + | PStr + [ { pstr_desc = + Pstr_eval + ( { pexp_desc = Pexp_construct ({ txt = Lident ident; _ }, None) + ; _ + } + , [] ) + ; _ + } + ] -> + let b = + match bool_of_string (get_env ident) with + | true -> true + | false -> false + | exception _ -> false + in + norm b + | PStr + [ { pstr_desc = + Pstr_eval + ( { pexp_desc = Pexp_apply (op, [ (Nolabel, a); (Nolabel, b) ]) + ; _ + } + , [] ) + ; _ + } + ] -> + let get_op = function + | { pexp_desc = Pexp_ident { txt = Lident str; _ }; _ } -> ( + match str with + | "<=" -> ( <= ) + | ">=" -> ( >= ) + | ">" -> ( > ) + | "<" -> ( < ) + | "<>" -> ( <> ) + | "=" -> ( = ) + | _ -> raise Invalid) + | _ -> raise Invalid + in + let eval = function + | { pexp_desc = Pexp_ident { txt = Lident "ocaml_version"; _ }; _ } -> + Version.current + | { pexp_desc = Pexp_tuple l; _ } -> + let l = + List.map l ~f:(function + | { pexp_desc = Pexp_constant (Pconst_integer (d, None)); _ } -> + int_of_string d + | _ -> raise Invalid) + in + Version.of_list l + | _ -> raise Invalid + in + let op = get_op op in + let a = eval a in + let b = eval b in + norm (op (Version.compare a b) 0) + | _ -> raise Invalid) + | _ -> true) in if false && not keep then diff --git a/compiler/tests-compiler/gen-rules/gen.ml b/compiler/tests-compiler/gen-rules/gen.ml index bbfe0e0925..2595d3adac 100644 --- a/compiler/tests-compiler/gen-rules/gen.ml +++ b/compiler/tests-compiler/gen-rules/gen.ml @@ -6,8 +6,8 @@ let is_implem x = let fname = Filename.chop_extension x in try String.iter fname ~f:(function - | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> () - | _ -> raise Exit); + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> () + | _ -> raise Exit); true with Exit -> false else false @@ -31,9 +31,10 @@ let prefix : string = let rec loop acc rem = let basename = Filename.basename rem in let dirname = Filename.dirname rem in - if String.equal dirname rem - || ends_with ~suffix:"_build" dirname - || Sys.file_exists (Filename.concat rem "dune-project") + if + String.equal dirname rem + || ends_with ~suffix:"_build" dirname + || Sys.file_exists (Filename.concat rem "dune-project") then acc else let acc = Filename.concat basename acc in @@ -42,8 +43,8 @@ let prefix : string = loop "" (Sys.getcwd ()) (* normalizatio for windows *) |> String.map ~f:(function - | '\\' -> '/' - | c -> c) + | '\\' -> '/' + | c -> c) type enabled_if = | GE5 diff --git a/compiler/tests-compiler/global_deadcode.ml b/compiler/tests-compiler/global_deadcode.ml index 72e19e465d..bb38774de0 100644 --- a/compiler/tests-compiler/global_deadcode.ml +++ b/compiler/tests-compiler/global_deadcode.ml @@ -27,8 +27,8 @@ let%expect_test "Eliminates unused functions from functor" = ( Some (EArr (List.filter return ~f:(function - | Javascript.ElementHole -> false - | _ -> true))) + | Javascript.ElementHole -> false + | _ -> true))) , loc ) , loc' ) in diff --git a/compiler/tests-compiler/util/util.ml b/compiler/tests-compiler/util/util.ml index 2a69f3cb81..e19f6f8c46 100644 --- a/compiler/tests-compiler/util/util.ml +++ b/compiler/tests-compiler/util/util.ml @@ -471,14 +471,14 @@ class find_function_declaration r n = (match s with | Variable_statement (_, l) -> List.iter l ~f:(function - | DeclIdent - ( (S { name = Utf8 name; _ } as id) - , Some ((EFun (_, fun_decl) | EArrow (fun_decl, _, _)), _) ) -> ( - let fd = id, fun_decl in - match n with - | None -> r := fd :: !r - | Some n -> if String.equal name n then r := fd :: !r else ()) - | _ -> ()) + | DeclIdent + ( (S { name = Utf8 name; _ } as id) + , Some ((EFun (_, fun_decl) | EArrow (fun_decl, _, _)), _) ) -> ( + let fd = id, fun_decl in + match n with + | None -> r := fd :: !r + | Some n -> if String.equal name n then r := fd :: !r else ()) + | _ -> ()) | Function_declaration (name, fun_decl) -> ( match name, n with | _, None -> r := (name, fun_decl) :: !r diff --git a/compiler/tests-js-parser/run.ml b/compiler/tests-js-parser/run.ml index 9b4430fe8b..f77ef3f21e 100644 --- a/compiler/tests-js-parser/run.ml +++ b/compiler/tests-js-parser/run.ml @@ -38,10 +38,10 @@ let () = if !verbose then Printf.eprintf "Found %d files\n%!" (List.length files let () = List.iter flags ~f:(function - | "--fail" -> failure_expected := true - | "-p" | "--progress" -> progress := true - | "-v" | "--verbose" -> verbose := true - | f -> failwith ("unrecognised flag " ^ f)) + | "--fail" -> failure_expected := true + | "-p" | "--progress" -> progress := true + | "-v" | "--verbose" -> verbose := true + | f -> failwith ("unrecognised flag " ^ f)) type error = | Diff of Javascript.program * Javascript.program diff --git a/compiler/tests-jsoo/bin/error1.ml b/compiler/tests-jsoo/bin/error1.ml index c496260604..2a2e6504ac 100644 --- a/compiler/tests-jsoo/bin/error1.ml +++ b/compiler/tests-jsoo/bin/error1.ml @@ -9,7 +9,7 @@ exception D of int * string * Int64.t let _ = Printexc.register_printer (function - | D _ -> Some "custom printer" - | _ -> None) + | D _ -> Some "custom printer" + | _ -> None) let _ = raise (D (2, "test", 43L)) diff --git a/compiler/tests-jsoo/test_marshal.ml b/compiler/tests-jsoo/test_marshal.ml index 4e9759d649..4d20070e5d 100644 --- a/compiler/tests-jsoo/test_marshal.ml +++ b/compiler/tests-jsoo/test_marshal.ml @@ -57,7 +57,10 @@ let%expect_test _ = let tmp_filename = Filename.temp_file "out" "txt" in let chan = open_out_bin tmp_filename in let v1 = Op (Add, [ Literal (Numeral (SPlus, 5)); Literal (Numeral (SMinus, 7)) ]) in - let v2 = Op (Times, [ v1; v1 ]) (* shared *) in + let v2 = + Op (Times, [ v1; v1 ]) + (* shared *) + in let v1_sz = write_out chan v1 in let v2_sz = write_out chan v2 in let v2_ns_sz = write_out_noshare chan v2 in diff --git a/examples/boulderdash/boulderdash.ml b/examples/boulderdash/boulderdash.ml index f5d0f8b5a0..ac4b0c4e7c 100644 --- a/examples/boulderdash/boulderdash.ml +++ b/examples/boulderdash/boulderdash.ml @@ -127,18 +127,20 @@ let rec fall state = set_cell state x (y - 1) Empty; set_cell state x y Boulder; changed := true); - if state.map.(y).(x) = Empty - && state.map.(y - 1).(x) = Empty - && state.map.(y).(x - 1) = Boulder - && state.map.(y - 1).(x - 1) = Boulder + if + state.map.(y).(x) = Empty + && state.map.(y - 1).(x) = Empty + && state.map.(y).(x - 1) = Boulder + && state.map.(y - 1).(x - 1) = Boulder then ( set_cell state (x - 1) (y - 1) Empty; set_cell state x y Boulder; changed := true); - if state.map.(y).(x) = Empty - && state.map.(y - 1).(x) = Empty - && state.map.(y).(x + 1) = Boulder - && state.map.(y - 1).(x + 1) = Boulder + if + state.map.(y).(x) = Empty + && state.map.(y - 1).(x) = Empty + && state.map.(y).(x + 1) = Boulder + && state.map.(y - 1).(x + 1) = Boulder then ( set_cell state (x + 1) (y - 1) Empty; set_cell state x y Boulder; @@ -237,8 +239,9 @@ let rec build_interaction state show_rem ((_, _, clock_stop) as clock) = let update_push ((x, y) as pos) next img img_guy = let ((x', y') as pos') = next pos in let x'', y'' = next pos' in - if try state.map.(y').(x') = Boulder && state.map.(y'').(x'') = Empty - with Invalid_argument _ -> false + if + try state.map.(y').(x') = Boulder && state.map.(y'').(x'') = Empty + with Invalid_argument _ -> false then ( let over () = state.imgs.(y).(x)##.src := img_guy; diff --git a/examples/graph_viewer/viewer.ml b/examples/graph_viewer/viewer.ml index 1fe492c0e8..c0e32f1f7e 100644 --- a/examples/graph_viewer/viewer.ml +++ b/examples/graph_viewer/viewer.ml @@ -375,9 +375,10 @@ let scroll_view ?width ?height ?packing st = then ( sadj#set_value sadj#upper; true) - else if keyval = GdkKeysyms._plus - || keyval = GdkKeysyms._equal - || keyval = GdkKeysyms._KP_Add + else if + keyval = GdkKeysyms._plus + || keyval = GdkKeysyms._equal + || keyval = GdkKeysyms._KP_Add then let x, y = display#misc#pointer in bump_scale (float x) (float y) 1. @@ -440,11 +441,12 @@ let create ?(full_screen = false) (x1, y1, x2, y2) scene = let keyval = GdkEvent.Key.keyval ev in if keyval = GdkKeysyms._q || keyval = GdkKeysyms._Q then exit 0 - else if keyval = GdkKeysyms._F11 - || keyval = GdkKeysyms._F5 - || (keyval = GdkKeysyms._Escape && !fullscreen) - || keyval = GdkKeysyms._f - || keyval = GdkKeysyms._F + else if + keyval = GdkKeysyms._F11 + || keyval = GdkKeysyms._F5 + || (keyval = GdkKeysyms._Escape && !fullscreen) + || keyval = GdkKeysyms._f + || keyval = GdkKeysyms._F then toggle_fullscreen () else false)); w#show () diff --git a/examples/graph_viewer/viewer_common.ml b/examples/graph_viewer/viewer_common.ml index 9462be4ae1..74b9b55fae 100644 --- a/examples/graph_viewer/viewer_common.ml +++ b/examples/graph_viewer/viewer_common.ml @@ -255,8 +255,9 @@ Format.eprintf "REDRAW %d %d %d %d@." x' y' w h; Firebug.console##log_6 (dx, pm.valid_rect.width, a.width, dy, pm.valid_rect.height, a.height); *) - if (dx > 0 && pm.valid_rect.width + dx < a.width) - || (dy > 0 && pm.valid_rect.height + dy < a.height) + if + (dx > 0 && pm.valid_rect.width + dx < a.width) + || (dy > 0 && pm.valid_rect.height + dy < a.height) then pm.valid_rect <- empty_rectangle else if not (rectangle_is_empty pm.valid_rect) then ( diff --git a/examples/hyperbolic/hypertree.ml b/examples/hyperbolic/hypertree.ml index 6b2e0cc7b4..2bf304e4d5 100644 --- a/examples/hyperbolic/hypertree.ml +++ b/examples/hyperbolic/hypertree.ml @@ -313,8 +313,9 @@ debug_msg (Format.sprintf "Mouse down %d %d" x0 y0); (* debug_msg (Format.sprintf "Mouse move %d %d %d %d" x0 y0 x y); *) - if (not !started) - && (abs_float (x -. x0) > fuzz || abs_float (y -. y0) > fuzz) + if + (not !started) + && (abs_float (x -. x0) > fuzz || abs_float (y -. y0) > fuzz) then ( started := true; element##.style##.cursor := Js.string "move"); @@ -377,9 +378,10 @@ debug_msg (Format.sprintf "Touch start %d %d" x0 y0); (* debug_msg (Format.sprintf "Touch move %d %d %d %d" x0 y0 x y); *) - if (not !started) - && (abs_float (x -. x0) > fuzz - || abs_float (y -. y0) > fuzz) + if + (not !started) + && (abs_float (x -. x0) > fuzz + || abs_float (y -. y0) > fuzz) then ( started := true; element##.style##.cursor := Js.string "move"); @@ -1624,9 +1626,10 @@ debug_msg (Format.sprintf "Resize %d %d" w h); let find_box boxes x y = let p = ref (-1) in for i = 0 to Array.length boxes.bw - 1 do - if Array.unsafe_get boxes.bw i > 0. - && abs_float (x -. Array.unsafe_get boxes.bx i) < Array.unsafe_get boxes.bw i - && abs_float (y -. Array.unsafe_get boxes.by i) < Array.unsafe_get boxes.bh i + if + Array.unsafe_get boxes.bw i > 0. + && abs_float (x -. Array.unsafe_get boxes.bx i) < Array.unsafe_get boxes.bw i + && abs_float (y -. Array.unsafe_get boxes.by i) < Array.unsafe_get boxes.bh i then p := i done; !p diff --git a/examples/planet/planet.ml b/examples/planet/planet.ml index f7d51b8b09..c4c4b8b9e2 100644 --- a/examples/planet/planet.ml +++ b/examples/planet/planet.ml @@ -294,10 +294,11 @@ let _divide all o = let k = ref 0 in for i = 0 to Array.length o.faces - 1 do let { v1; v2; v3 } = o.faces.(i) in - if all - || abs_float o.vertices.(v1).y = 1. - || abs_float o.vertices.(v2).y = 1. - || abs_float o.vertices.(v3).y = 1. + if + all + || abs_float o.vertices.(v1).y = 1. + || abs_float o.vertices.(v2).y = 1. + || abs_float o.vertices.(v3).y = 1. then ( let w1 = midpoint v1 v2 in let w2 = midpoint v2 v3 in diff --git a/lib/js_of_ocaml/cSS.ml b/lib/js_of_ocaml/cSS.ml index 6687d7f3fd..720a74c802 100644 --- a/lib/js_of_ocaml/cSS.ml +++ b/lib/js_of_ocaml/cSS.ml @@ -695,163 +695,165 @@ module Color = struct new%js Js.regExp (Js.bytestring "^hsla\\(\\s*\\d*,\\s*\\d*%,\\s*\\d*%,\\d*\\.?\\d*\\)$") in - if Js.to_bool (rgb_re##test s) - || Js.to_bool (rgba_re##test s) - || Js.to_bool (rgb_pct_re##test s) - || Js.to_bool (rgba_pct_re##test s) - || Js.to_bool (hsl_re##test s) - || Js.to_bool (hsla_re##test s) + if + Js.to_bool (rgb_re##test s) + || Js.to_bool (rgba_re##test s) + || Js.to_bool (rgb_pct_re##test s) + || Js.to_bool (rgba_pct_re##test s) + || Js.to_bool (hsl_re##test s) + || Js.to_bool (hsla_re##test s) then s - else if List.mem - (Js.to_string s) - [ "aliceblue" - ; "antiquewhite" - ; "aqua" - ; "aquamarine" - ; "azure" - ; "beige" - ; "bisque" - ; "black" - ; "blanchedalmond" - ; "blue" - ; "blueviolet" - ; "brown" - ; "burlywood" - ; "cadetblue" - ; "chartreuse" - ; "chocolate" - ; "coral" - ; "cornflowerblue" - ; "cornsilk" - ; "crimson" - ; "cyan" - ; "darkblue" - ; "darkcyan" - ; "darkgoldenrod" - ; "darkgray" - ; "darkgreen" - ; "darkgrey" - ; "darkkhaki" - ; "darkmagenta" - ; "darkolivegreen" - ; "darkorange" - ; "darkorchid" - ; "darkred" - ; "darksalmon" - ; "darkseagreen" - ; "darkslateblue" - ; "darkslategray" - ; "darkslategrey" - ; "darkturquoise" - ; "darkviolet" - ; "deeppink" - ; "deepskyblue" - ; "dimgray" - ; "dimgrey" - ; "dodgerblue" - ; "firebrick" - ; "floralwhite" - ; "forestgreen" - ; "fuchsia" - ; "gainsboro" - ; "ghostwhite" - ; "gold" - ; "goldenrod" - ; "gray" - ; "green" - ; "greenyellow" - ; "grey" - ; "honeydew" - ; "hotpink" - ; "indianred" - ; "indigo" - ; "ivory" - ; "khaki" - ; "lavender" - ; "lavenderblush" - ; "lawngreen" - ; "lemonchiffon" - ; "lightblue" - ; "lightcoral" - ; "lightcyan" - ; "lightgoldenrodyellow" - ; "lightgray" - ; "lightgreen" - ; "lightgrey" - ; "lightpink" - ; "lightsalmon" - ; "lightseagreen" - ; "lightskyblue" - ; "lightslategray" - ; "lightslategrey" - ; "lightsteelblue" - ; "lightyellow" - ; "lime" - ; "limegreen" - ; "linen" - ; "magenta" - ; "maroon" - ; "mediumaquamarine" - ; "mediumblue" - ; "mediumorchid" - ; "mediumpurple" - ; "mediumseagreen" - ; "mediumslateblue" - ; "mediumspringgreen" - ; "mediumturquoise" - ; "mediumvioletred" - ; "midnightblue" - ; "mintcream" - ; "mistyrose" - ; "moccasin" - ; "navajowhite" - ; "navy" - ; "oldlace" - ; "olive" - ; "olivedrab" - ; "orange" - ; "orangered" - ; "orchid" - ; "palegoldenrod" - ; "palegreen" - ; "paleturquoise" - ; "palevioletred" - ; "papayawhip" - ; "peachpuff" - ; "peru" - ; "pink" - ; "plum" - ; "powderblue" - ; "purple" - ; "red" - ; "rosybrown" - ; "royalblue" - ; "saddlebrown" - ; "salmon" - ; "sandybrown" - ; "seagreen" - ; "seashell" - ; "sienna" - ; "silver" - ; "skyblue" - ; "slateblue" - ; "slategray" - ; "slategrey" - ; "snow" - ; "springgreen" - ; "steelblue" - ; "tan" - ; "teal" - ; "thistle" - ; "tomato" - ; "turquoise" - ; "violet" - ; "wheat" - ; "white" - ; "whitesmoke" - ; "yellow" - ; "yellowgreen" - ] + else if + List.mem + (Js.to_string s) + [ "aliceblue" + ; "antiquewhite" + ; "aqua" + ; "aquamarine" + ; "azure" + ; "beige" + ; "bisque" + ; "black" + ; "blanchedalmond" + ; "blue" + ; "blueviolet" + ; "brown" + ; "burlywood" + ; "cadetblue" + ; "chartreuse" + ; "chocolate" + ; "coral" + ; "cornflowerblue" + ; "cornsilk" + ; "crimson" + ; "cyan" + ; "darkblue" + ; "darkcyan" + ; "darkgoldenrod" + ; "darkgray" + ; "darkgreen" + ; "darkgrey" + ; "darkkhaki" + ; "darkmagenta" + ; "darkolivegreen" + ; "darkorange" + ; "darkorchid" + ; "darkred" + ; "darksalmon" + ; "darkseagreen" + ; "darkslateblue" + ; "darkslategray" + ; "darkslategrey" + ; "darkturquoise" + ; "darkviolet" + ; "deeppink" + ; "deepskyblue" + ; "dimgray" + ; "dimgrey" + ; "dodgerblue" + ; "firebrick" + ; "floralwhite" + ; "forestgreen" + ; "fuchsia" + ; "gainsboro" + ; "ghostwhite" + ; "gold" + ; "goldenrod" + ; "gray" + ; "green" + ; "greenyellow" + ; "grey" + ; "honeydew" + ; "hotpink" + ; "indianred" + ; "indigo" + ; "ivory" + ; "khaki" + ; "lavender" + ; "lavenderblush" + ; "lawngreen" + ; "lemonchiffon" + ; "lightblue" + ; "lightcoral" + ; "lightcyan" + ; "lightgoldenrodyellow" + ; "lightgray" + ; "lightgreen" + ; "lightgrey" + ; "lightpink" + ; "lightsalmon" + ; "lightseagreen" + ; "lightskyblue" + ; "lightslategray" + ; "lightslategrey" + ; "lightsteelblue" + ; "lightyellow" + ; "lime" + ; "limegreen" + ; "linen" + ; "magenta" + ; "maroon" + ; "mediumaquamarine" + ; "mediumblue" + ; "mediumorchid" + ; "mediumpurple" + ; "mediumseagreen" + ; "mediumslateblue" + ; "mediumspringgreen" + ; "mediumturquoise" + ; "mediumvioletred" + ; "midnightblue" + ; "mintcream" + ; "mistyrose" + ; "moccasin" + ; "navajowhite" + ; "navy" + ; "oldlace" + ; "olive" + ; "olivedrab" + ; "orange" + ; "orangered" + ; "orchid" + ; "palegoldenrod" + ; "palegreen" + ; "paleturquoise" + ; "palevioletred" + ; "papayawhip" + ; "peachpuff" + ; "peru" + ; "pink" + ; "plum" + ; "powderblue" + ; "purple" + ; "red" + ; "rosybrown" + ; "royalblue" + ; "saddlebrown" + ; "salmon" + ; "sandybrown" + ; "seagreen" + ; "seashell" + ; "sienna" + ; "silver" + ; "skyblue" + ; "slateblue" + ; "slategray" + ; "slategrey" + ; "snow" + ; "springgreen" + ; "steelblue" + ; "tan" + ; "teal" + ; "thistle" + ; "tomato" + ; "turquoise" + ; "violet" + ; "wheat" + ; "white" + ; "whitesmoke" + ; "yellow" + ; "yellowgreen" + ] then s else raise (Invalid_argument (Js.to_string s ^ " is not a valid color")) diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml index 958d91e877..cf9bdf827f 100644 --- a/lib/js_of_ocaml/dom_html.ml +++ b/lib/js_of_ocaml/dom_html.ml @@ -2530,14 +2530,15 @@ let rec unsafeCreateElementEx ?_type ?name doc elt = Js.Unsafe.coerce (doc##createElement (a##join (Js.string ""))) | `Unknown -> createElementSyntax := - if try - let el : inputElement Js.t = - Js.Unsafe.coerce - (document##createElement (Js.string "")) - in - Js.equals el##.tagName##toLowerCase (Js.string "input") - && Js.equals el##.name (Js.string "x") - with _ -> false + if + try + let el : inputElement Js.t = + Js.Unsafe.coerce + (document##createElement (Js.string "")) + in + Js.equals el##.tagName##toLowerCase (Js.string "input") + && Js.equals el##.name (Js.string "x") + with _ -> false then `Extended else `Standard; unsafeCreateElementEx ?_type ?name doc elt @@ -2726,12 +2727,12 @@ module CoerceTo = struct (* ie < 9 does not have HTMLElement: we have to cheat to check that something is an html element *) fun e -> - if not (Js.Optdef.test (def (Js.Unsafe.coerce e)##.innerHTML)) - then Js.null - else Js.some (Js.Unsafe.coerce e) + if not (Js.Optdef.test (def (Js.Unsafe.coerce e)##.innerHTML)) + then Js.null + else Js.some (Js.Unsafe.coerce e) else fun e -> - if Js.instanceof e html_element then Js.some (Js.Unsafe.coerce e) else Js.null + if Js.instanceof e html_element then Js.some (Js.Unsafe.coerce e) else Js.null let unsafeCoerce tag (e : #element t) = if Js.equals e##.tagName##toLowerCase (Js.string tag) diff --git a/lib/js_of_ocaml/js.ml b/lib/js_of_ocaml/js.ml index 9422def2c2..252b51088a 100644 --- a/lib/js_of_ocaml/js.ml +++ b/lib/js_of_ocaml/js.ml @@ -827,9 +827,10 @@ let export_js (field : js_string t) x = Unsafe.set (Unsafe.pure_js_expr "jsoo_exports") field - (if String.equal (Js.to_string (typeof (Obj.magic x))) "function" - (* function with arity/length equal to zero are already wrapped *) - && Unsafe.get (Obj.magic x) (Js.string "length") > 0 + (if + String.equal (Js.to_string (typeof (Obj.magic x))) "function" + (* function with arity/length equal to zero are already wrapped *) + && Unsafe.get (Obj.magic x) (Js.string "length") > 0 then Obj.magic (wrap_callback (Obj.magic x)) else x) diff --git a/lib/js_of_ocaml/json.ml b/lib/js_of_ocaml/json.ml index fb525fb321..bd1ac4201b 100644 --- a/lib/js_of_ocaml/json.ml +++ b/lib/js_of_ocaml/json.ml @@ -125,9 +125,10 @@ let input_reviver = let reviver _this _key (value : Unsafe.any) : Obj.t = if Js.equals (typeof value) (string "string") then Obj.repr (to_bytestring (Unsafe.coerce value)) - else if instanceof value Js.array_empty - && (Unsafe.coerce value)##.length == 4 - && Unsafe.get value 0 == 255 + else if + instanceof value Js.array_empty + && (Unsafe.coerce value)##.length == 4 + && Unsafe.get value 0 == 255 then Obj.repr (Jsoo_runtime.Int64.create_int64_lo_mi_hi diff --git a/lib/js_of_ocaml/regexp.ml b/lib/js_of_ocaml/regexp.ml index e2ce1fcab7..ecc811876b 100644 --- a/lib/js_of_ocaml/regexp.ml +++ b/lib/js_of_ocaml/regexp.ml @@ -59,7 +59,7 @@ let quote_repl s = (Js.bytestring s)##replace quote_repl_re (Js.string "$$$$") let global_replace r s s_by = r##.lastIndex := 0; - Js.to_bytestring (Js.bytestring s) ## (replace r (quote_repl s_by)) + Js.to_bytestring (Js.bytestring s)##(replace r (quote_repl s_by)) let replace_first r s s_by = let flags = @@ -70,7 +70,7 @@ let replace_first r s s_by = | true, true -> Js.string "mi" in let r' = new%js Js.regExp_withFlags r##.source flags in - Js.to_bytestring (Js.bytestring s) ## (replace r' (quote_repl s_by)) + Js.to_bytestring (Js.bytestring s)##(replace r' (quote_repl s_by)) let list_of_js_array a = let rec aux accu idx = @@ -80,17 +80,17 @@ let list_of_js_array a = let split r s = r##.lastIndex := 0; - list_of_js_array (Js.str_array (Js.bytestring s) ## (split_regExp r)) + list_of_js_array (Js.str_array (Js.bytestring s)##(split_regExp r)) let bounded_split r s i = r##.lastIndex := 0; - list_of_js_array (Js.str_array (Js.bytestring s) ## (split_regExpLimited r i)) + list_of_js_array (Js.str_array (Js.bytestring s)##(split_regExpLimited r i)) (* More constructors *) let quote_re = regexp "[\\][()\\\\|+*.?{}^$]" -let quote s = Js.to_bytestring (Js.bytestring s) ## (replace quote_re (Js.string "\\$&")) +let quote s = Js.to_bytestring (Js.bytestring s)##(replace quote_re (Js.string "\\$&")) let regexp_string s = regexp (quote s) diff --git a/lib/js_of_ocaml/webGL.ml b/lib/js_of_ocaml/webGL.ml index bd3412c53f..958c2e4414 100644 --- a/lib/js_of_ocaml/webGL.ml +++ b/lib/js_of_ocaml/webGL.ml @@ -1368,7 +1368,7 @@ end let getContext (c : Dom_html.canvasElement t) = let c : canvasElement t = Js.Unsafe.coerce c in let ctx = c##getContext (Js.string "webgl") in - if Opt.test ctx then ctx else c ## (getContext (Js.string "experimental-webgl")) + if Opt.test ctx then ctx else c##(getContext (Js.string "experimental-webgl")) let getContextWithAttributes (c : Dom_html.canvasElement t) attribs = let c : canvasElement t = Js.Unsafe.coerce c in diff --git a/lib/lwt/lwt_js_events.ml b/lib/lwt/lwt_js_events.ml index b582e0901b..ae00986df2 100644 --- a/lib/lwt/lwt_js_events.ml +++ b/lib/lwt/lwt_js_events.ml @@ -75,8 +75,9 @@ let seq_loop evh ?(cancel_handler = false) ?use_capture ?passive target handler if cancel_handler then Lwt.cancel !cur_handler; cancelled := true); let rec aux () = - if not !cancelled - (* In the case it has been cancelled + if + not !cancelled + (* In the case it has been cancelled during the previous handler, we do not reinstall the event handler *) then ( @@ -333,7 +334,7 @@ let mousewheel ?use_capture ?passive target = cancel (); Lwt.wakeup w (ev, (dx, dy)); Js.bool true) - (* true because we do not want to prevent default -> + (* true because we do not want to prevent default -> the user can use the preventDefault function above. *)); t diff --git a/lib/lwt/lwt_jsonp.ml b/lib/lwt/lwt_jsonp.ml index d71025537a..6e621009e0 100644 --- a/lib/lwt/lwt_jsonp.ml +++ b/lib/lwt/lwt_jsonp.ml @@ -50,20 +50,20 @@ let raw_call name uri error_cb user_cb = script##.async := Js._true; ((Js.Unsafe.coerce script)##.onerror := fun x -> - finalize (); - error_cb x); + finalize (); + error_cb x); ((Js.Unsafe.coerce script)##.onload := fun x -> - Lwt.async (fun () -> - Lwt.bind (Lwt_js.sleep 1.) (fun () -> - if !executed - then Lwt.return_unit - else ( - Firebug.console##warn - (Js.string "Jsonp: script loaded but callback not executed"); - finalize (); - error_cb x; - Lwt.return_unit)))); + Lwt.async (fun () -> + Lwt.bind (Lwt_js.sleep 1.) (fun () -> + if !executed + then Lwt.return_unit + else ( + Firebug.console##warn + (Js.string "Jsonp: script loaded but callback not executed"); + finalize (); + error_cb x; + Lwt.return_unit)))); let init () = ignore (Dom.appendChild Dom_html.document##.body script) in init, finalize diff --git a/lib/lwt/lwt_xmlHttpRequest.mli b/lib/lwt/lwt_xmlHttpRequest.mli index f374178754..9c9694414b 100644 --- a/lib/lwt/lwt_xmlHttpRequest.mli +++ b/lib/lwt/lwt_xmlHttpRequest.mli @@ -46,8 +46,11 @@ val perform_raw : ?headers:(string * string) list -> ?content_type:string -> ?get_args:(string * string) list - -> ?check_headers:((* [] *) - int -> (string -> string option) -> bool) + -> ?check_headers: + ( (* [] *) + int + -> (string -> string option) + -> bool) -> ?progress:(int -> int -> unit) -> ?upload_progress:(int -> int -> unit) -> ?contents: @@ -71,8 +74,11 @@ val perform_raw_url : ?headers:(string * string) list -> ?content_type:string -> ?get_args:(string * string) list - -> ?check_headers:((* [] *) - int -> (string -> string option) -> bool) + -> ?check_headers: + ( (* [] *) + int + -> (string -> string option) + -> bool) -> ?progress:(int -> int -> unit) -> ?upload_progress:(int -> int -> unit) -> ?contents: @@ -101,8 +107,11 @@ val perform : ?headers:(string * string) list -> ?content_type:string -> ?get_args:(string * string) list - -> ?check_headers:((* [] *) - int -> (string -> string option) -> bool) + -> ?check_headers: + ( (* [] *) + int + -> (string -> string option) + -> bool) -> ?progress:(int -> int -> unit) -> ?upload_progress:(int -> int -> unit) -> ?contents: diff --git a/lib/tests/gen-rules/gen.ml b/lib/tests/gen-rules/gen.ml index ac42fddb81..f29ac95feb 100644 --- a/lib/tests/gen-rules/gen.ml +++ b/lib/tests/gen-rules/gen.ml @@ -6,8 +6,8 @@ let is_implem x = let fname = Filename.chop_extension x in try String.iter fname ~f:(function - | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> () - | _ -> raise Exit); + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> () + | _ -> raise Exit); true with Exit -> false else false @@ -31,9 +31,10 @@ let prefix : string = let rec loop acc rem = let basename = Filename.basename rem in let dirname = Filename.dirname rem in - if String.equal dirname rem - || ends_with ~suffix:"_build" dirname - || Sys.file_exists (Filename.concat rem "dune-project") + if + String.equal dirname rem + || ends_with ~suffix:"_build" dirname + || Sys.file_exists (Filename.concat rem "dune-project") then acc else let acc = Filename.concat basename acc in @@ -42,8 +43,8 @@ let prefix : string = loop "" (Sys.getcwd ()) (* normalizatio for windows *) |> String.map ~f:(function - | '\\' -> '/' - | c -> c) + | '\\' -> '/' + | c -> c) type enabled_if = | GE5 diff --git a/lib/tests/test_fun_call.ml b/lib/tests/test_fun_call.ml index 888246dd20..05c4cb9c3f 100644 --- a/lib/tests/test_fun_call.ml +++ b/lib/tests/test_fun_call.ml @@ -86,8 +86,8 @@ let%expect_test "partial application, callback is called when all arguments are got 1, 2, 3, 4, 5, done Result: 0 |}] -let%expect_test "partial application, 0 argument call is treated like 1 argument \ - (undefined)" = +let%expect_test + "partial application, 0 argument call is treated like 1 argument (undefined)" = call_and_log (Js.wrap_callback cb5) {| (function(f){ return f(1)()(3)()(5) }) |}; [%expect {| got 1, undefined, 3, undefined, 5, done diff --git a/lib/tyxml/tyxml_js.ml b/lib/tyxml/tyxml_js.ml index 8989795abd..140212f944 100644 --- a/lib/tyxml/tyxml_js.ml +++ b/lib/tyxml/tyxml_js.ml @@ -160,12 +160,13 @@ module Xml = struct else parse_int ~pos:1 ~base:10 e in Js.string_constr##fromCharCode i - else if string_fold e ~pos:0 ~init:true ~f:(fun acc x -> - (* This is not quite right according to + else if + string_fold e ~pos:0 ~init:true ~f:(fun acc x -> + (* This is not quite right according to https://www.xml.com/axml/target.html#NT-Name. but it seems to cover all html5 entities https://dev.w3.org/html5/html-author/charref *) - acc && is_alpha_num x) + acc && is_alpha_num x) then match e with | "quot" -> Js.string "\"" diff --git a/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml b/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml index 92f053a0d4..ae72fdc72c 100644 --- a/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml +++ b/ppx/ppx_deriving_json/lib/ppx_deriving_json.ml @@ -245,9 +245,9 @@ let seqlist = function let check_record_fields = List.iter ~f:(function - | { pld_type = { ptyp_desc = Ptyp_poly _; _ }; _ } -> - Location.raise_errorf "%s cannot be derived for polymorphic records" deriver - | _ -> ()) + | { pld_type = { ptyp_desc = Ptyp_poly _; _ }; _ } -> + Location.raise_errorf "%s cannot be derived for polymorphic records" deriver + | _ -> ()) let maybe_tuple_type = function | [ y ] -> y diff --git a/ppx/ppx_js/lib_internal/ppx_js_internal.ml b/ppx/ppx_js/lib_internal/ppx_js_internal.ml index f8b873713b..783b1cd10b 100644 --- a/ppx/ppx_js/lib_internal/ppx_js_internal.ml +++ b/ppx/ppx_js/lib_internal/ppx_js_internal.ml @@ -646,8 +646,8 @@ let literal_object self_id (fields : field_desc list) = let extra_types = List.concat (List.map fields ~f:(function - | Val _ -> [] - | Meth (_, _, _, _, l) -> l)) + | Val _ -> [] + | Meth (_, _, _, _, l) -> l)) in let invoker = invoker @@ -691,8 +691,8 @@ let literal_object self_id (fields : field_desc list) = ])) ]) (List.map fields ~f:(function - | Val _ -> Arg.make () - | Meth (_, _, _, _, _fun_ty) -> Arg.make ())) + | Val _ -> Arg.make () + | Meth (_, _, _, _, _fun_ty) -> Arg.make ())) in let self = "self" in let gloc = { !default_loc with Location.loc_ghost = true } in @@ -746,13 +746,13 @@ let transform = let new_expr = match expr with (* obj##.var *) - | [%expr [%e? obj] ##. [%e? meth]] -> + | [%expr [%e? obj]##.[%e? meth]] -> let obj = self#expression obj in let prop = exp_to_string meth in let new_expr = prop_get ~loc:meth.pexp_loc obj prop in self#expression { new_expr with pexp_attributes } (* obj##.var := value *) - | [%expr [%e? [%expr [%e? obj] ##. [%e? meth]] as prop] := [%e? value]] -> + | [%expr [%e? [%expr [%e? obj]##.[%e? meth]] as prop] := [%e? value]] -> let obj = self#expression obj in let value = self#expression value in let prop_loc = prop.pexp_loc in @@ -760,7 +760,7 @@ let transform = let new_expr = prop_set ~loc:meth.pexp_loc ~prop_loc obj prop value in self#expression { new_expr with pexp_attributes } (* obj##(meth arg1 arg2) .. *) - | [%expr [%e? obj] ## [%e? { pexp_desc = Pexp_apply (meth, args); _ }]] -> + | [%expr [%e? obj]##[%e? { pexp_desc = Pexp_apply (meth, args); _ }]] -> let meth_str = exp_to_string meth in let obj = self#expression obj in let args = List.map args ~f:(fun (s, e) -> s, self#expression e) in @@ -774,7 +774,7 @@ let transform = in self#expression { new_expr with pexp_attributes } (* obj##meth arg1 arg2 .. *) - | { pexp_desc = Pexp_apply (([%expr [%e? obj] ## [%e? meth]] as prop), args) + | { pexp_desc = Pexp_apply (([%expr [%e? obj]##[%e? meth]] as prop), args) ; pexp_loc ; _ } -> @@ -791,7 +791,7 @@ let transform = in self#expression { new_expr with pexp_attributes } (* obj##meth *) - | [%expr [%e? obj] ## [%e? meth]] as expr -> + | [%expr [%e? obj]##[%e? meth]] as expr -> let obj = self#expression obj in let meth_str = exp_to_string meth in let new_expr = diff --git a/toplevel/bin/jsoo_common.ml b/toplevel/bin/jsoo_common.ml index 5077067fce..9e79ac7521 100644 --- a/toplevel/bin/jsoo_common.ml +++ b/toplevel/bin/jsoo_common.ml @@ -77,17 +77,17 @@ let cmis_of_package pkg : string list = in let l = String.split_char ~sep:' ' archive in List.iter l ~f:(function - | "" -> () - | x -> - if Filename.check_suffix x ".cmo" - then - let u = Filename.chop_suffix x ".cmo" in - add (read_cmi ~dir (u ^ ".cmi")) - else if Filename.check_suffix x ".cma" - then List.iter (cmis_of_cma ~dir x) ~f:add - else if Filename.check_suffix x ".cmi" - then add (read_cmi ~dir (Filename.chop_suffix x ".cmi")) - else Format.eprintf "Wrong extension for archive %s@." x); + | "" -> () + | x -> + if Filename.check_suffix x ".cmo" + then + let u = Filename.chop_suffix x ".cmo" in + add (read_cmi ~dir (u ^ ".cmi")) + else if Filename.check_suffix x ".cma" + then List.iter (cmis_of_cma ~dir x) ~f:add + else if Filename.check_suffix x ".cmi" + then add (read_cmi ~dir (Filename.chop_suffix x ".cmi")) + else Format.eprintf "Wrong extension for archive %s@." x); !fs with exn -> Format.eprintf "Error for package %s@." pkg; diff --git a/toplevel/examples/lwt_toplevel/examples.ml b/toplevel/examples/lwt_toplevel/examples.ml index 37dbbb2b2e..5f972b30e4 100644 --- a/toplevel/examples/lwt_toplevel/examples.ml +++ b/toplevel/examples/lwt_toplevel/examples.ml @@ -109,10 +109,10 @@ open Graphics_js let () = loop [ Mouse_motion; Key_pressed ] (function - | { key = '\000'; _ } -> () - | { mouse_x = x; mouse_y = y; key } -> - moveto x y; - draw_char key) + | { key = '\000'; _ } -> () + | { mouse_x = x; mouse_y = y; key } -> + moveto x y; + draw_char key) (** Graphics: PingPong *) diff --git a/toplevel/examples/lwt_toplevel/toplevel.ml b/toplevel/examples/lwt_toplevel/toplevel.ml index c3b815ec94..c91ff4ef9d 100644 --- a/toplevel/examples/lwt_toplevel/toplevel.ml +++ b/toplevel/examples/lwt_toplevel/toplevel.ml @@ -365,8 +365,9 @@ let run _ = let content = Js.to_string textbox##.value##trim in let content' = let len = String.length content in - if try content <> "" && content.[len - 1] <> ';' && content.[len - 2] <> ';' - with _ -> true + if + try content <> "" && content.[len - 1] <> ';' && content.[len - 2] <> ';' + with _ -> true then content ^ ";;" else content in