diff --git a/Changes.md b/Changes.md index e1ca82f33..efb53d5f6 100644 --- a/Changes.md +++ b/Changes.md @@ -31,6 +31,10 @@ Unreleased - core: remove unnecessary internal code from melange-compiler-libs, slimming down the melange executable and speeding up the build ([#1075](https://github.com/melange-re/melange/pull/1075)) +- core: implement warning 51 in Melange (`wrong-tailcall-expectation`) + - This warning had previously been disabled entirely in the typechecker + version that Melange uses. It becomes more important with TRMC support + added in Melange 2.1.0. 3.0.0 2024-01-28 --------------- diff --git a/flake.lock b/flake.lock index 214bf1527..8417e744f 100644 --- a/flake.lock +++ b/flake.lock @@ -28,11 +28,11 @@ ] }, "locked": { - "lastModified": 1709960241, - "narHash": "sha256-yKG2WRjCd1rjgnWZC2PY9KeuoyXmc4RMsLqJbSbWV9I=", + "lastModified": 1710316337, + "narHash": "sha256-CFQ1GeZKTeCm4LjWT5xy8JSiEzYPFw0iGPulG4LT2oM=", "owner": "melange-re", "repo": "melange-compiler-libs", - "rev": "2bc099fbe050c34d2aa6a9ad9d76bd6a18865b3a", + "rev": "cdd6be821371692104dc270a94f1da369735ae9b", "type": "github" }, "original": { @@ -64,11 +64,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1710203863, - "narHash": "sha256-lAn/kJhD853pGG23y5HNagc9qjLPsDLqLZ/BdrLmxKo=", + "lastModified": 1710451106, + "narHash": "sha256-ldO1qLTiTPTfAvMiQQEkxqlboQYH9KNMcqQGL9xKV9E=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "9c109623b6b6a263a19dfd4cc760347070f00ac1", + "rev": "59d1bb03ddfc5fe6653cdbef4e20315570d9a138", "type": "github" }, "original": { @@ -79,17 +79,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1710171478, - "narHash": "sha256-1AWYcvvsmBj+FkiLagpwvGjVJFhkxu2t2gXPBiKue4U=", + "lastModified": 1710433391, + "narHash": "sha256-w0tmRGIUl7EWWDteJ19qXPIvmeKUQKptAfojNRvpIDU=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "9336998b519fa62fa13ec0e2c770ff0178d6c3d6", + "rev": "f7156e005c93248d684c09bc4cf8b66a4d2ffcbf", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "9336998b519fa62fa13ec0e2c770ff0178d6c3d6", + "rev": "f7156e005c93248d684c09bc4cf8b66a4d2ffcbf", "type": "github" } }, diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index 78f1078e2..24fb70127 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -169,9 +169,10 @@ let after_parsing_impl ppf fname (ast : Parsetree.structure) = let program = Translmod.transl_implementation modulename typedtree_coercion in - Tmc.rewrite program.code + Lambda_simplif.simplify_lambda program.code |> print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda in + Lam_compile_main.compile outputprefix lambda in if not !Js_config.cmj_only then diff --git a/jscomp/core/lambda_simplif.ml b/jscomp/core/lambda_simplif.ml new file mode 100644 index 000000000..0b5ee21e6 --- /dev/null +++ b/jscomp/core/lambda_simplif.ml @@ -0,0 +1,106 @@ +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) + +open Import +open Lambda +open Debuginfo.Scoped_location +(* Tail call info in annotation files *) + +let rec emit_tail_infos is_tail lambda = + match lambda with + | Lvar _ -> () + | Lmutvar _ -> () + | Lconst _ -> () + | Lapply ap -> + (* Note: is_tail does not take backend-specific logic into + account (maximum number of parameters, etc.) so it may + over-approximate tail-callness. + + Trying to do something more fine-grained would result in + different warnings depending on whether the native or + bytecode compiler is used. *) + (let maybe_warn ~is_tail ~expect_tail = + if is_tail <> expect_tail then + Location.prerr_warning (to_location ap.ap_loc) + (Warnings.Wrong_tailcall_expectation expect_tail) + in + match ap.ap_tailcall with + | Default_tailcall -> () + | Tailcall_expectation expect_tail -> maybe_warn ~is_tail ~expect_tail); + emit_tail_infos false ap.ap_func; + list_emit_tail_infos false ap.ap_args + | Lfunction { body = lam; _ } -> emit_tail_infos true lam + | Llet (_, _k, _, lam, body) | Lmutlet (_k, _, lam, body) -> + emit_tail_infos false lam; + emit_tail_infos is_tail body + | Lletrec (bindings, body) -> + List.iter ~f:(fun (_, lam) -> emit_tail_infos false lam) bindings; + emit_tail_infos is_tail body + | Lprim ((Pbytes_to_string | Pbytes_of_string), [ arg ], _) -> + emit_tail_infos is_tail arg + | Lprim (Psequand, [ arg1; arg2 ], _) | Lprim (Psequor, [ arg1; arg2 ], _) -> + emit_tail_infos false arg1; + emit_tail_infos is_tail arg2 + | Lprim (_, l, _) -> list_emit_tail_infos false l + | Lswitch (lam, sw, _loc) -> + emit_tail_infos false lam; + list_emit_tail_infos_fun snd is_tail sw.sw_consts; + list_emit_tail_infos_fun snd is_tail sw.sw_blocks; + Option.iter (emit_tail_infos is_tail) sw.sw_failaction + | Lstringswitch (lam, sw, d, _) -> + emit_tail_infos false lam; + List.iter ~f:(fun (_, lam) -> emit_tail_infos is_tail lam) sw; + Option.iter (emit_tail_infos is_tail) d + | Lstaticraise (_, l) -> list_emit_tail_infos false l + | Lstaticcatch (body, _, handler) -> + emit_tail_infos is_tail body; + emit_tail_infos is_tail handler + | Ltrywith (body, _, handler) -> + emit_tail_infos false body; + emit_tail_infos is_tail handler + | Lifthenelse (cond, ifso, ifno) -> + emit_tail_infos false cond; + emit_tail_infos is_tail ifso; + emit_tail_infos is_tail ifno + | Lsequence (lam1, lam2) -> + emit_tail_infos false lam1; + emit_tail_infos is_tail lam2 + | Lwhile (cond, body) -> + emit_tail_infos false cond; + emit_tail_infos false body + | Lfor (_, low, high, _, body) -> + emit_tail_infos false low; + emit_tail_infos false high; + emit_tail_infos false body + | Lassign (_, lam) -> emit_tail_infos false lam + | Lsend (_, meth, obj, args, _loc) -> + emit_tail_infos false meth; + emit_tail_infos false obj; + list_emit_tail_infos false args + | Levent (lam, _) -> emit_tail_infos is_tail lam + | Lifused (_, lam) -> emit_tail_infos is_tail lam + +and list_emit_tail_infos_fun f is_tail = + List.iter ~f:(fun x -> emit_tail_infos is_tail (f x)) + +and list_emit_tail_infos is_tail = List.iter ~f:(emit_tail_infos is_tail) + +let simplify_lambda lam = + let lam = lam |> Tmc.rewrite in + if + !Clflags.annotations + || Warnings.is_active (Warnings.Wrong_tailcall_expectation true) + then emit_tail_infos true lam; + lam diff --git a/test/blackbox-tests/tailcall-attribute.t b/test/blackbox-tests/tailcall-attribute.t new file mode 100644 index 000000000..f873322f6 --- /dev/null +++ b/test/blackbox-tests/tailcall-attribute.t @@ -0,0 +1,45 @@ +Test that warning 51 (`wrong-tailcall-expectation`) works in Melange + + $ . ./setup.sh + $ cat > x.ml < let rec fact = function + > | 1 -> 1 + > | n -> n * (fact [@tailcall true]) (n-1) + > EOF + $ melc x.ml > /dev/null + File "x.ml", line 3, characters 13-42: + 3 | | n -> n * (fact [@tailcall true]) (n-1) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning 51 [wrong-tailcall-expectation]: expected tailcall + + $ cat > x.ml < let rec fact = function + > | 1 -> 1 + > | n -> n * (fact [@tailcall false]) (n-1) + > EOF + $ melc x.ml > /dev/null + + $ cat > x.ml < let rec fact_tail acc = function + > | 1 -> acc + > | n -> (fact_tail [@tailcall]) (n * acc) (n - 1) + > EOF + $ melc x.ml > /dev/null + + $ cat > x.ml < let rec fact_tail acc = function + > | 1 -> acc + > | n -> (fact_tail [@tailcall true]) (n * acc) (n - 1) + > EOF + $ melc x.ml > /dev/null + + $ cat > x.ml < let rec fact_tail acc = function + > | 1 -> acc + > | n -> (fact_tail [@tailcall false]) (n * acc) (n - 1) + > EOF + $ melc x.ml > /dev/null + File "x.ml", line 3, characters 9-56: + 3 | | n -> (fact_tail [@tailcall false]) (n * acc) (n - 1) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning 51 [wrong-tailcall-expectation]: expected non-tailcall diff --git a/vendor/melange-compiler-libs b/vendor/melange-compiler-libs index 2bc099fbe..cdd6be821 160000 --- a/vendor/melange-compiler-libs +++ b/vendor/melange-compiler-libs @@ -1 +1 @@ -Subproject commit 2bc099fbe050c34d2aa6a9ad9d76bd6a18865b3a +Subproject commit cdd6be821371692104dc270a94f1da369735ae9b