Separate into melange.ppx and melange.ppx-lib

.github/workflows/esy-build.yml

@@ -59,7 +59,7 @@ jobs:
         if: ${{ matrix.system == 'ubuntu' }}
         working-directory: melange-basic-template
         run: |
-          sed -i 's@"installConfig"@"resolutions": { "\@opam/dune": "ocaml/dune:dune.opam#258058c6803525261df9d330d9eca2a4b0a8adc2", "\@opam/melange-compiler-libs": "melange-re/melange-compiler-libs:melange-compiler-libs.opam#7263bea2285499f5da857f2bb374345a5178791e", "\@opam/reactjs-jsx-ppx": "melange-re/melange:reactjs-jsx-ppx.opam#'"$GITHUB_SHA"'","\@opam/melange": "melange-re/melange:melange.opam#'"$GITHUB_SHA"'", "\@opam/mel": "melange-re/melange:mel.opam#'"$GITHUB_SHA"'"},"installConfig"@' esy.json
+          sed -i 's@"installConfig"@"resolutions": { "\@opam/dune": "ocaml/dune:dune.opam#d2580fda2b1cc30b18f0fff437ddfd0d956cc90b", "\@opam/melange-compiler-libs": "melange-re/melange-compiler-libs:melange-compiler-libs.opam#7263bea2285499f5da857f2bb374345a5178791e", "\@opam/reactjs-jsx-ppx": "melange-re/melange:reactjs-jsx-ppx.opam#'"$GITHUB_SHA"'","\@opam/melange": "melange-re/melange:melange.opam#'"$GITHUB_SHA"'", "\@opam/mel": "melange-re/melange:mel.opam#'"$GITHUB_SHA"'"},"installConfig"@' esy.json
 
       - name: Build basic template
         if: ${{ matrix.system == 'ubuntu' }}

.github/workflows/opam-build.yml

@@ -59,7 +59,7 @@ jobs:
       - name: Clone melange-opam-template
         run: |
           git clone https://github.com/melange-re/melange-opam-template.git
-          cd melange-opam-template
+          cd melange-opam-template && git checkout anmonteiro/melange-ppx
 
       - name: Install all deps
         working-directory: melange-opam-template

Makefile

@@ -29,7 +29,7 @@ opam-create-switch: ## Create opam switch
 
 .PHONY: opam-install-test
 opam-install-test: ## Install test dependencies
-	opam pin -y add dune.dev https://github.com/ocaml/dune.git#258058c6803525261df9d330d9eca2a4b0a8adc2
+	opam pin -y add dune.dev https://github.com/ocaml/dune.git#d2580fda2b1cc30b18f0fff437ddfd0d956cc90b
 	opam pin -y add melange-compiler-libs.dev https://github.com/melange-re/melange-compiler-libs.git#7263bea2285499f5da857f2bb374345a5178791e
 	opam pin add reactjs-jsx-ppx.dev . --with-test -y
 	opam pin add melange.dev . --with-test -y

dune-project

@@ -1,4 +1,4 @@
-(lang dune 3.7)
+(lang dune 3.8)
 
 (using experimental_building_ocaml_compiler_with_dune 0.1)
 
@@ -47,6 +47,7 @@
   (cppo :build)
   (ounit :with-test)
   (reason :with-test)
+  ppxlib
   (reactjs-jsx-ppx :with-test)))
 
 (package
@@ -71,8 +72,8 @@
   ocaml
   (melange
    (= :version))
-  (ocaml-migrate-parsetree
-   (>= "2.3.0"))))
+  (ppxlib
+   (>= "0.28.0"))))
 
 (package
  (name reactjs-jsx-ppx)

flake.nix

@@ -26,7 +26,16 @@
         pkgs = nixpkgs.legacyPackages."${system}".appendOverlays [
           (self: super: {
             ocamlPackages = super.ocaml-ng.ocamlPackages_4_14.overrideScope' (oself: osuper:
-              { });
+              {
+                dune_3 = osuper.dune_3.overrideAttrs (_: {
+                  src = super.fetchFromGitHub {
+                    owner = "ocaml";
+                    repo = "dune";
+                    rev = "d2580fda2b1cc30b18f0fff437ddfd0d956cc90b";
+                    hash = "sha256-MXQURDuqN4TRsFcfKyQCbd5IaZON543JeHgK7Aeph9U=";
+                  };
+                });
+              });
           })
           melange-compiler-libs.overlays.default
         ];

jscomp/frontend/ast_derive_js_mapper.ml → jscomp/ast_derive/ast_derive_js_mapper.ml

@@ -210,23 +210,14 @@ let init () =
               | Ptype_record label_declarations ->
                   let exp =
                     coerceResultToNewType
-                      (Exp.extension
-                         ( { Asttypes.loc; txt = "bs.obj" },
-                           PStr
-                             [
-                               Str.eval
-                                 (Exp.record
-                                    (Ext_list.map label_declarations
-                                       (fun { pld_name = { loc; txt } } ->
-                                         let label =
-                                           {
-                                             Asttypes.loc;
-                                             txt = Longident.Lident txt;
-                                           }
-                                         in
-                                         (label, Exp.field exp_param label)))
-                                    None);
-                             ] ))
+                      (Exp.mk ~loc
+                         (Ast_extensions.Make.record_as_js_object loc
+                            (Ext_list.map label_declarations
+                               (fun { pld_name = { loc; txt } } ->
+                                 let label =
+                                   { Asttypes.loc; txt = Longident.Lident txt }
+                                 in
+                                 (label, Exp.field exp_param label)))))
                   in
                   let toJs = toJsBody exp in
                   let obj_exp =
@@ -266,21 +257,19 @@ let init () =
                           eraseTypeStr;
                           unsafeIndexGet;
                           Ast_comb.single_non_rec_value { loc; txt = map }
-                            (Exp.extension
-                               ( { txt = "raw"; loc },
-                                 PStr
-                                   [
-                                     Str.eval (Exp.constant (Const.string data));
-                                   ] ));
+                            (Ast_extensions.handle_raw ~kind:Raw_exp loc
+                               (Parsetree.PStr
+                                  [
+                                    Str.eval (Exp.constant (Const.string data));
+                                  ]));
                           Ast_comb.single_non_rec_value { loc; txt = revMap }
                             (if has_bs_as then
-                               Exp.extension
-                                 ( { txt = "raw"; loc },
-                                   PStr
-                                     [
-                                       Str.eval
-                                         (Exp.constant (Const.string revData));
-                                     ] )
+                               Ast_extensions.handle_raw ~kind:Raw_exp loc
+                                 (PStr
+                                    [
+                                      Str.eval
+                                        (Exp.constant (Const.string revData));
+                                    ])
                              else expMap);
                           toJsBody
                             (if has_bs_as then

jscomp/ast_derive/dune

@@ -0,0 +1,6 @@
+(library
+ (name ast_derive)
+ (package melange)
+ (wrapped false)
+ (flags :standard -w -9 -open Melange_compiler_libs)
+ (libraries common astlib ast_extensions melange-compiler-libs melange.ext))

jscomp/frontend/ast_exp_handle_external.ml → jscomp/ast_extensions/ast_extensions.ml

@@ -100,3 +100,5 @@ let handle_raw_structure loc payload =
               [ exp ];
         }
   | None -> Location.raise_errorf ~loc "bs.raw can only be applied to a string"
+
+module Make = Ast_external_mk

jscomp/frontend/ast_exp_handle_external.mli → jscomp/ast_extensions/ast_extensions.mli

@@ -1,5 +1,5 @@
 (* Copyright (C) 2020 Authors of ReScript
- * 
+ *
  * 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
@@ -17,7 +17,7 @@
  * 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. *)
@@ -33,3 +33,51 @@ val handle_raw :
 
 val handle_raw_structure :
   Location.t -> Ast_payload.t -> Parsetree.structure_item
+
+module Make : sig
+  val local_external_apply :
+    Location.t ->
+    ?pval_attributes:Parsetree.attributes ->
+    pval_prim:string list ->
+    pval_type:Parsetree.core_type ->
+    ?local_module_name:string ->
+    ?local_fun_name:string ->
+    Parsetree.expression list ->
+    Parsetree.expression_desc
+  (**
+  [local_module loc ~pval_prim ~pval_type args]
+  generate such code
+  {[
+    let module J = struct
+       external unsafe_expr : pval_type = pval_prim
+    end in
+    J.unssafe_expr args
+  ]}
+*)
+
+  val local_external_obj :
+    Location.t ->
+    ?pval_attributes:Parsetree.attributes ->
+    pval_prim:string list ->
+    pval_type:Parsetree.core_type ->
+    ?local_module_name:string ->
+    ?local_fun_name:string ->
+    (string * Parsetree.expression) list ->
+    (* [ (label, exp )]*)
+    Parsetree.expression_desc
+
+  val local_extern_cont_to_obj :
+    Location.t ->
+    ?pval_attributes:Parsetree.attributes ->
+    pval_prim:string list ->
+    pval_type:Parsetree.core_type ->
+    ?local_module_name:string ->
+    ?local_fun_name:string ->
+    (Parsetree.expression -> Parsetree.expression) ->
+    Parsetree.expression_desc
+
+  type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
+
+  val record_as_js_object :
+    Location.t -> label_exprs -> Parsetree.expression_desc
+end

jscomp/frontend/ast_external_mk.ml → jscomp/ast_extensions/ast_external_mk.ml

@@ -131,3 +131,20 @@ let local_extern_cont_to_obj loc ?(pval_attributes = []) ~pval_prim ~pval_type
           pexp_loc = loc;
           pexp_loc_stack = [ loc ];
         } )
+
+type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
+
+let record_as_js_object loc (label_exprs : label_exprs) :
+    Parsetree.expression_desc =
+  let labels, args, arity =
+    Ext_list.fold_right label_exprs ([], [], 0)
+      (fun ({ txt; loc }, e) (labels, args, i) ->
+        match txt with
+        | Lident x ->
+            ({ Asttypes.loc; txt = x } :: labels, (x, e) :: args, i + 1)
+        | Ldot _ | Lapply _ -> Location.raise_errorf ~loc "invalid js label ")
+  in
+  local_external_obj loc
+    ~pval_prim:(Ast_external_process.pval_prim_of_labels labels)
+    ~pval_type:(Ast_core_type.from_labels ~loc arity labels)
+    args

jscomp/frontend/ast_external_mk.mli → jscomp/ast_extensions/ast_external_mk.mli

@@ -17,7 +17,7 @@
  * 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. *)
@@ -33,11 +33,11 @@ val local_external_apply :
   Parsetree.expression_desc
 (**
   [local_module loc ~pval_prim ~pval_type args]
-  generate such code 
+  generate such code
   {[
-    let module J = struct 
-       external unsafe_expr : pval_type = pval_prim 
-    end in 
+    let module J = struct
+       external unsafe_expr : pval_type = pval_prim
+    end in
     J.unssafe_expr args
   ]}
 *)
@@ -62,3 +62,7 @@ val local_extern_cont_to_obj :
   ?local_fun_name:string ->
   (Parsetree.expression -> Parsetree.expression) ->
   Parsetree.expression_desc
+
+type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
+
+val record_as_js_object : Location.t -> label_exprs -> Parsetree.expression_desc

jscomp/ast_extensions/dune

@@ -0,0 +1,5 @@
+(library
+ (name ast_extensions)
+ (package melange)
+ (flags :standard -open Melange_compiler_libs)
+ (libraries common astlib melange-compiler-libs melange.ext))

jscomp/astlib/dune

@@ -0,0 +1,6 @@
+(library
+ (name astlib)
+ (package melange)
+ (wrapped false)
+ (flags :standard -w -9 -open Melange_compiler_libs)
+ (libraries common melange-compiler-libs melange.ext))

jscomp/common/ast_config.ml

@@ -42,7 +42,7 @@ let rec iter_on_bs_config_stru (x : Parsetree.structure) =
   match x with
   | [] -> ()
   | {
-      pstr_desc =
+      Parsetree.pstr_desc =
         Pstr_attribute
           ({
              attr_name = { txt = "bs.config" | "config"; loc };
@@ -54,6 +54,28 @@ let rec iter_on_bs_config_stru (x : Parsetree.structure) =
       Ext_list.iter (Ast_payload.ident_or_record_as_config loc payload)
         (fun x ->
           Ast_payload.table_dispatch !structural_config_table x |> ignore)
+  (* [ppxlib] adds a wrapper like:
+
+     [@@@ocaml.ppx.context ...]
+     include (struct
+       [@@@bs.config ..]
+     end)
+  *)
+  | { pstr_desc = Pstr_attribute _ }
+    :: {
+         pstr_desc =
+           Pstr_include
+             {
+               pincl_mod =
+                 {
+                   pmod_desc =
+                     Pmod_constraint ({ pmod_desc = Pmod_structure stru }, _);
+                 };
+               _;
+             };
+       }
+    :: _ ->
+      iter_on_bs_config_stru stru
   | { pstr_desc = Pstr_attribute _ } :: rest -> iter_on_bs_config_stru rest
   | _ :: _ -> ()
 

jscomp/core/dune

@@ -7,7 +7,7 @@
   (action
    (run cppo %{env:CPPO_FLAGS=} %{input-file})))
  (modules_without_implementation lam_pass_unused_params lam_runtime)
- (libraries ext common melange.ppx melange-compiler-libs))
+ (libraries ext common ast_derive melange-compiler-libs melange.ppx-lib))
 
 (rule
  (targets js_fold.ml)

jscomp/core/js_implementation.ml

@@ -101,11 +101,10 @@ let after_parsing_sig ppf outputprefix ast =
 
 let interface ~parser ppf fname =
   Res_compmisc.init_path ();
-  let sig_ = parser fname |> Melange_ppx.Ast_deriving_compat.signature in
-  sig_
+  parser fname |> Ast_deriving_compat.signature
   |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name
        Mli
-  |> Melange_ppx.Ppx_entry.rewrite_signature
+  |> Melange_ppx_lib.Ppx_entry.rewrite_signature
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface
   |> print_if_pipe ppf Clflags.dump_source Pprintast.signature
   |> after_parsing_sig ppf (Config_util.output_prefix fname)
@@ -194,10 +193,10 @@ let after_parsing_impl ppf fname (ast : Parsetree.structure) =
 
 let implementation ~parser ppf fname =
   Res_compmisc.init_path ();
-  parser fname |> Melange_ppx.Ast_deriving_compat.structure
+  parser fname |> Ast_deriving_compat.structure
   |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name
        Ml
-  |> Melange_ppx.Ppx_entry.rewrite_implementation
+  |> Melange_ppx_lib.Ppx_entry.rewrite_implementation
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf fname