diff --git a/Changes.md b/Changes.md index 7d4160bd9b..2ded335ae7 100644 --- a/Changes.md +++ b/Changes.md @@ -45,6 +45,8 @@ Unreleased - melange: remove the `--bs-jsx ` flag from `melc` now that `reactjs-jsx-ppx` is a separate package ([#525](https://github.com/melange-re/melange/pull/525)) +- melange: add `melpp` executable to preprocess `#if` conditionals with the + melange parser ([#539](https://github.com/melange-re/melange/pull/539)) 0.3.2 2022-11-19 --------------- diff --git a/flake.lock b/flake.lock index 825ce0362b..2a3c07be14 100644 --- a/flake.lock +++ b/flake.lock @@ -2,11 +2,11 @@ "nodes": { "flake-utils": { "locked": { - "lastModified": 1680776469, - "narHash": "sha256-3CXUDK/3q/kieWtdsYpDOBJw3Gw4Af6x+2EiSnIkNQw=", + "lastModified": 1680946745, + "narHash": "sha256-KqGlwg9UTDsFBZZB8wzXgMnc8XQm95LtSbFvBsnqkPI=", "owner": "numtide", "repo": "flake-utils", - "rev": "411e8764155aa9354dbcd6d5faaeb97e9e3dce24", + "rev": "946da791763db1c306b86a8bd3828bf5814a1247", "type": "github" }, "original": { @@ -61,11 +61,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1680780465, - "narHash": "sha256-P87WlxGRWAzm0f7gn7/zRX997w0DVZ5pOv2DoM2Ac7c=", + "lastModified": 1680981190, + "narHash": "sha256-3lpKzwVskEnWyXad85oVBQWbpZnKQIodvtdoZesY3YU=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "57a362f88099eec9a5145885d9be6d15540759fe", + "rev": "14b834a3394ecef30c9687c7361a9538dbc3d1d3", "type": "github" }, "original": { @@ -76,17 +76,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1680725427, - "narHash": "sha256-fx/Tc+7VEuO5VckHg65t+Alp9hh1JubnkNDpV2qyTiY=", + "lastModified": 1680937900, + "narHash": "sha256-dUZdImCkXZWNOxd9sK46nKRtdyFieLAqd0kYh6Iq1n0=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "da7761cacab07eeb08eb69e94063397e8887404e", + "rev": "db63a705b9100696f6d27dfe2c14e7be6e184497", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "da7761cacab07eeb08eb69e94063397e8887404e", + "rev": "db63a705b9100696f6d27dfe2c14e7be6e184497", "type": "github" } }, diff --git a/jscomp/main/dune b/jscomp/main/dune index 2dd8b59a9e..d059a77833 100644 --- a/jscomp/main/dune +++ b/jscomp/main/dune @@ -10,6 +10,14 @@ (action (run cppo %{env:CPPO_FLAGS=} %{input-file})))) +(executable + (public_name melpp) + (package melange) + (modes native) + (modules melpp) + (flags :standard -open Melange_compiler_libs) + (libraries common core cmdliner melange-compiler-libs)) + (executable (public_name mel) (package mel) diff --git a/jscomp/main/melc.ml b/jscomp/main/melc.ml index d529b7766b..ae4de53426 100644 --- a/jscomp/main/melc.ml +++ b/jscomp/main/melc.ml @@ -396,7 +396,7 @@ let file_level_flags_handler (e : Parsetree.expression option) = | Some e -> Location.raise_errorf ~loc:e.pexp_loc "string array expected" -let _ : unit = +let () = Bs_conditional_initial.setup_env (); let flags = "flags" in Ast_config.add_structure diff --git a/jscomp/main/melpp.ml b/jscomp/main/melpp.ml new file mode 100644 index 0000000000..4756ef352a --- /dev/null +++ b/jscomp/main/melpp.ml @@ -0,0 +1,112 @@ +(* Copyright (C) 2023- Authors of Melange + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + +let output_deps_set name set = + output_string stdout name; + output_string stdout ": "; + Depend.String.Set.iter + (fun s -> + if s <> "" && s.[0] <> '*' then ( + output_string stdout s; + output_string stdout " ")) + set; + output_string stdout "\n" + +let after_parsing_sig ast = + Ast_config.iter_on_bs_config_sigi ast; + if !Js_config.modules then + output_deps_set !Location.input_name + (Ast_extract.read_parse_and_extract Mli ast); + output_string stdout Config.ast_intf_magic_number; + output_value stdout (!Location.input_name : string); + output_value stdout ast + +let after_parsing_impl (ast : Parsetree.structure) = + Ast_config.iter_on_bs_config_stru ast; + if !Js_config.modules then + output_deps_set !Location.input_name + (Ast_extract.read_parse_and_extract Ml ast); + output_string stdout Config.ast_impl_magic_number; + output_value stdout (!Location.input_name : string); + output_value stdout ast + +let define_variable s = + let module Pp = Rescript_cpp in + match Ext_string.split ~keep_empty:true s '=' with + | [ key; v ] -> + if not (Pp.define_key_value key v) then + raise (Arg.Bad ("illegal definition: " ^ s)) + | _ -> raise (Arg.Bad ("illegal definition: " ^ s)) + +let main = + let main interface defines unsafe filename = + Ext_list.iter defines define_variable; + if unsafe then Clflags.unsafe := unsafe; + match + ( interface, + Ext_file_extensions.classify_input + (Ext_filename.get_extension_maybe filename) ) + with + | true, _ | _, Mli -> + Pparse_driver.parse_interface filename |> after_parsing_sig + | _, Ml -> Pparse_driver.parse_implementation filename |> after_parsing_impl + | _, _ -> assert false + in + fun interface defines unsafe filename -> + try `Ok (main interface defines unsafe filename) with + | Arg.Bad msg -> `Error (false, msg) + | x -> + Location.report_exception Format.err_formatter x; + exit 2 + +module Cli = struct + open Cmdliner + + let interface = + let docv = "interface" in + Arg.(value & flag & info [ "i"; "interface" ] ~docv) + + let defines = + let doc = "Define conditional variable e.g, -D DEBUG=true" in + Arg.(value & opt_all string [] & info [ "D" ] ~doc) + + let unsafe = + let doc = "Do not compile bounds checking on array and string access" in + Arg.(value & flag & info [ "unsafe" ] ~doc) + + let filename = + let docv = "filename" in + Arg.(required & pos 0 (some' string) None & info [] ~docv) + + let cmd = + let open Cmdliner in + let term = Term.(const main $ interface $ defines $ unsafe $ filename) in + let info = Cmd.info "melpp" in + Cmd.v info (Term.ret term) +end + +let () = + Bs_conditional_initial.setup_env (); + let argv = Ext_cli_args.normalize_argv Sys.argv in + exit (Cmdliner.Cmd.eval ~argv Cli.cmd)