playground: make jsoo_main compile

.github/workflows/opam-build.yml

@@ -57,6 +57,11 @@ jobs:
           opam update
           make opam-install-test
 
+      - name: Test playground
+        working-directory: melange
+        run: |
+          make playground-test
+
       - name: Clone melange-opam-template
         run: |
           git clone https://github.com/melange-re/melange-opam-template.git

Makefile

@@ -40,3 +40,19 @@ opam-install-dev: opam-install-test ## Install development dependencies
 
 .PHONY: opam-init
 opam-init: opam-create-switch opam-install-test ## Configure everything to develop this repository in local
+
+.PHONY: playground
+playground:
+	opam exec -- dune build --profile=browser bin/jsoo_main.bc.js
+
+.PHONY: playground-dev
+playground-dev:
+	opam exec -- dune build --profile=browser-dev bin/jsoo_main.bc.js
+
+.PHONY: playground-dev-test
+playground-dev-test:
+	opam exec -- dune build --profile=browser-dev @@test/blackbox-tests/playground
+
+.PHONY: playground-test
+playground-test:
+	opam exec -- dune build --profile=browser @@test/blackbox-tests/playground

bin/dune

@@ -13,3 +13,10 @@
  (package melange)
  (modules melppx)
  (libraries melange.ppx ppxlib))
+
+(executable
+ (name jsoo_main)
+ (flags :standard -open Melange_compiler_libs)
+ (modules jsoo_main jsoo_common)
+ (libraries core melange_compiler_libs melange_ppx)
+ (modes js))

bin/jsoo_common.ml

@@ -32,20 +32,33 @@ module Js = struct
   external to_bytestring : js_string t -> string = "caml_js_to_byte_string"
 end
 
-let mk_js_error (loc : Location.t) (msg : string) =
+let mk_js_error (error : Location.report) =
+  let kind, type_ =
+    match error.kind with
+    | Location.Report_error -> ("Error", "error")
+    | Report_warning w -> (Printf.sprintf "Warning: %s" w, "warning")
+    | Report_warning_as_error w ->
+        (Printf.sprintf "Error: (warning %s)" w, "warning_as_error")
+    | Report_alert w -> (Printf.sprintf "Alert: %s" w, "alert")
+    | Report_alert_as_error w ->
+        (Printf.sprintf "Error: (alert %s)" w, "alert_as_error")
+  in
+  let txt = Format.asprintf "@[%t@]" error.main.txt in
+  let loc = error.main.loc in
   let _file, line, startchar = Location.get_pos_info loc.Location.loc_start in
   let _file, endline, endchar = Location.get_pos_info loc.Location.loc_end in
   Js.Unsafe.(
     obj
       [|
         ( "js_error_msg",
           inject
-          @@ Js.string (Printf.sprintf "Line %d, %d:\n  %s" line startchar msg)
+          @@ Js.string
+               (Printf.sprintf "Line %d, %d:\n  %s %s" line startchar kind txt)
         );
         ("row", inject (line - 1));
         ("column", inject startchar);
         ("endRow", inject (endline - 1));
         ("endColumn", inject endchar);
-        ("text", inject @@ Js.string msg);
-        ("type", inject @@ Js.string "error");
+        ("text", inject @@ Js.string txt);
+        ("type", inject @@ Js.string type_);
       |])

bin/jsoo_common.mli

@@ -35,6 +35,6 @@ module Js : sig
 end
 
 (*
-Creates a Js Error object for given location with and a certain error message
+Creates a Js Error object for given location report
 *)
-val mk_js_error : Location.t -> string -> Js.Unsafe.obj
+val mk_js_error : Location.report -> Js.Unsafe.obj

bin/jsoo_main.ml

@@ -23,7 +23,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 module Js = Jsoo_common.Js
-(** *)
 
 (*
  Error:
@@ -43,7 +42,12 @@ let error_of_exn e =
   | Some (`Ok e) -> Some e
   | Some `Already_displayed | None -> None
 
-let implementation ~use_super_errors impl str : Js.Unsafe.obj =
+module Convert =
+  Ppxlib_ast.Convert
+    (Ppxlib_ast__.Versions.OCaml_414)
+    (Ppxlib_ast__.Versions.OCaml_current)
+
+let compile impl str : Js.Unsafe.obj =
   let modulename = "Test" in
   (* let env = !Toploop.toplevel_env in *)
   (* Res_compmisc.init_path false; *)
@@ -54,52 +58,52 @@ let implementation ~use_super_errors impl str : Js.Unsafe.obj =
   (* Question ?? *)
   (* let finalenv = ref Env.empty in *)
   let types_signature = ref [] in
-  if use_super_errors then (
-    Misc.Color.setup (Some Always);
-    Lazy.force Super_main.setup);
-
   try
-    Js_config.jsx_version := 3;
     (* default *)
     let ast = impl (Lexing.from_string str) in
-    let ast = Ppx_entry.rewrite_implementation ast in
+    let ast : Parsetree.structure =
+      let ppxlib_ast : Ppxlib_ast__.Versions.OCaml_414.Ast.Parsetree.structure =
+        Obj.magic (ast : Parsetree.structure)
+      in
+      let converted =
+        Convert.copy_structure (Ppxlib.Driver.map_structure ppxlib_ast)
+      in
+      (Obj.magic converted : Parsetree.structure)
+    in
     let typed_tree =
-      let a, b, _, signature =
+      let { Typedtree.structure; coercion; shape = _; signature }, _finalenv =
         Typemod.type_implementation_more modulename modulename modulename env
           ast
       in
       (* finalenv := c ; *)
       types_signature := signature;
-      (a, b)
+      (structure, coercion)
     in
     typed_tree |> Translmod.transl_implementation modulename
-    |> (* Printlambda.lambda ppf *) fun { Lambda.code = lam } ->
+    |> (* Printlambda.lambda ppf *) fun { Lambda.code = lam; _ } ->
     let buffer = Buffer.create 1000 in
     let () =
       Js_dump_program.pp_deps_program ~output_prefix:""
-        (* does not matter here *) NodeJS
-        (Lam_compile_main.compile "" lam)
+        ~package_info:Js_packages_info.empty
+        ~output_info:{ Js_packages_info.module_system = NodeJS; suffix = Js }
         (Ext_pp.from_buffer buffer)
+        (Lam_compile_main.compile "" lam)
     in
     let v = Buffer.contents buffer in
     Js.Unsafe.(obj [| ("js_code", inject @@ Js.string v) |])
     (* Format.fprintf output_ppf {| { "js_code" : %S }|} v ) *)
   with e -> (
     match error_of_exn e with
-    | Some error ->
-        Location.report_error Format.err_formatter error;
-        Jsoo_common.mk_js_error error.loc error.msg
+    | Some error -> Jsoo_common.mk_js_error error
     | None ->
         Js.Unsafe.(
           obj [| ("js_error_msg", inject @@ Js.string (Printexc.to_string e)) |]))
 
-let compile impl ~use_super_errors = implementation ~use_super_errors impl
 let export (field : string) v = Js.Unsafe.set Js.Unsafe.global field v
 
 (* To add a directory to the load path *)
 
-let dir_directory d = Config.load_path := d :: !Config.load_path
-let () = dir_directory "/static"
+let () = Load_path.add_dir "/static"
 
 let make_compiler name impl =
   export name
@@ -109,16 +113,8 @@ let make_compiler name impl =
           ( "compile",
             inject
             @@ Js.wrap_meth_callback (fun _ code ->
-                   compile impl ~use_super_errors:false (Js.to_string code)) );
-          ( "compile_super_errors",
-            inject
-            @@ Js.wrap_meth_callback (fun _ code ->
-                   compile impl ~use_super_errors:true (Js.to_string code)) );
-          ("version", Js.Unsafe.inject (Js.string Bs_version.version));
+                   compile impl (Js.to_string code)) );
+          ("version", Js.Unsafe.inject (Js.string Melange_version.version));
         |])
 
 let () = make_compiler "ocaml" Parse.implementation
-
-(* local variables: *)
-(* compile-command: "ocamlbuild -use-ocamlfind -pkg compiler-libs -no-hygiene driver.cmo" *)
-(* end: *)

dune

@@ -8,4 +8,12 @@
   (env-vars
    (CPPO_FLAGS -D=BS_RELEASE_BUILD))
   (ocamlopt_flags
-   (:standard -O3 -unbox-closures))))
+   (:standard -O3 -unbox-closures)))
+ (browser
+  (env-vars
+   (CPPO_FLAGS -D=BS_BROWSER)))
+ (browser-dev
+  (js_of_ocaml
+   (compilation_mode separate))
+  (env-vars
+   (CPPO_FLAGS -D=BS_BROWSER))))

dune-project

@@ -44,6 +44,7 @@
   (cppo :build)
   (ounit :with-test)
   (reason :with-test)
+  (js_of_ocaml :with-test)
   ppxlib
   menhir
   (reactjs-jsx-ppx :with-test)))

jscomp/core/js_dump_program.mli

@@ -32,3 +32,11 @@ val dump_deps_program :
   J.deps_program ->
   out_channel ->
   unit
+
+val pp_deps_program :
+  package_info:Js_packages_info.t ->
+  output_info:Js_packages_info.output_info ->
+  output_prefix:string ->
+  Ext_pp.t ->
+  J.deps_program ->
+  unit

jscomp/core/js_name_of_module_id.ml

@@ -25,6 +25,20 @@
 let (=)  (x : int) (y:float) = assert false
 *)
 
+#ifdef BS_BROWSER
+
+let string_of_module_id_in_browser (x : Lam_module_ident.t) =
+  match x.kind with
+  | External { name } -> name
+  | Runtime | Ml -> "./stdlib/" ^ String.uncapitalize_ascii (Lam_module_ident.name x) ^ ".js"
+
+let string_of_module_id ~package_info:_ ~output_info:_ (id : Lam_module_ident.t)
+    ~output_dir:(_ : string) : string =
+  string_of_module_id_in_browser id
+;;
+
+#else
+
 let ( // ) = Ext_path.( // )
 
 let fix_path_for_windows : string -> string =
@@ -161,17 +175,4 @@ let string_of_module_id ~package_info ~output_info
             | None -> Bs_exception.error (Js_not_found js_file))))
 ;;
 
-(* Override it in browser *)
-#ifdef BS_BROWSER
-
-let string_of_module_id_in_browser (x : Lam_module_ident.t) =
-  match x.kind with
-  | External { name } -> name
-  | Runtime | Ml -> "./stdlib/" ^ String.uncapitalize_ascii x.id.name ^ ".js"
-
-let string_of_module_id ~package_info:_ ~output_info:_ (id : Lam_module_ident.t)
-    ~output_dir:(_ : string) : string =
-  string_of_module_id_in_browser id
-;;
-
 #endif

jscomp/core/lam_util.ml

@@ -213,7 +213,7 @@ let generate_label ?(name="") ()  =
   Printf.sprintf "%s_tailcall_%04d" name !count
 
 #if (defined BS_BROWSER || defined BS_RELEASE_BUILD)
-let dump ext  lam =
+let dump _ext _lam =
   ()
 #else
 let log_counter = ref 0

melange.opam

@@ -15,6 +15,7 @@ depends: [
   "cppo" {build}
   "ounit" {with-test}
   "reason" {with-test}
+  "js_of_ocaml" {with-test}
   "ppxlib"
   "menhir"
   "reactjs-jsx-ppx" {with-test}

test/blackbox-tests/dune

@@ -4,3 +4,11 @@
   (env_var MELANGE_LIB)
   setup.sh
   (package melange)))
+
+(cram
+ (applies_to playground)
+ (enabled_if
+  (or
+   (= %{profile} browser)
+   (= %{profile} browser-dev)))
+ (deps %{bin:js_of_ocaml} ../../bin/jsoo_main.bc.js))

test/blackbox-tests/playground.t

@@ -0,0 +1,96 @@
+Generate runtime cmijs for building against melange libs from the playground
+
+  $ find $DUNE_SOURCEROOT/_build/default/jscomp/stdlib/.stdlib.objs/melange -name "*.cmi" -or -name "*.cmj" | xargs js_of_ocaml build-fs -o stdlib-cmijs.js
+  $ find $DUNE_SOURCEROOT/_build/default/jscomp/runtime/.runtime.objs/melange -name "*.cmi" -or -name "*.cmj" | xargs js_of_ocaml build-fs -o runtime-cmijs.js
+  $ find $DUNE_SOURCEROOT/_build/default/jscomp/others/.belt.objs/melange -name "*.cmi" -or -name "*.cmj" | xargs js_of_ocaml build-fs -o belt-cmijs.js
+
+Prepare an input file to test some snippets to exercise common functionality
+
+  $ cat > input.js <<EOF
+  > require(process.env.DUNE_SOURCEROOT + '/_build/default/bin/jsoo_main.bc.js');
+  > require('./stdlib-cmijs.js');
+  > require('./runtime-cmijs.js');
+  > require('./belt-cmijs.js');
+  > console.log(ocaml.compile("let t = 1"));
+  > console.log(ocaml.compile(\`let john = [%bs.obj { name = "john"; age = 99 }] let t = john##name\`));
+  > console.log(ocaml.compile(\`let foo = Belt.List.map\`));
+  > console.log(ocaml.compile(\`let +foo\`));
+  > console.log(ocaml.compile(\`let foo = "" + 2\`));
+  > console.log(ocaml.compile(\`type person = {
+  >   name: string ;
+  >   age: int
+  > }[@@deriving abstract]
+  > 
+  > let person1: person = person ~name:"joe" ~age:10\`));
+  > EOF
+
+  $ node input.js
+  {
+    js_code: '// Generated by Melange\n' +
+      "'use strict';\n" +
+      '\n' +
+      '\n' +
+      'var t = 1;\n' +
+      '\n' +
+      'exports.t = t;\n' +
+      '/* No side effect */\n'
+  }
+  {
+    js_code: '// Generated by Melange\n' +
+      "'use strict';\n" +
+      '\n' +
+      '\n' +
+      'var john = {\n' +
+      '  name: "john",\n' +
+      '  age: 99\n' +
+      '};\n' +
+      '\n' +
+      'var t = john.name;\n' +
+      '\n' +
+      'exports.john = john;\n' +
+      'exports.t = t;\n' +
+      '/* t Not a pure module */\n'
+  }
+  {
+    js_code: '// Generated by Melange\n' +
+      "'use strict';\n" +
+      '\n' +
+      'var Belt_List = require("./stdlib/belt_List.js");\n' +
+      '\n' +
+      'var foo = Belt_List.map;\n' +
+      '\n' +
+      'exports.foo = foo;\n' +
+      '/* No side effect */\n'
+  }
+  {
+    js_error_msg: 'Line 1, 5:\n  Error Syntax error',
+    row: 0,
+    column: 5,
+    endRow: 0,
+    endColumn: 8,
+    text: 'Syntax error',
+    type: 'error'
+  }
+  {
+    js_error_msg: 'Line 1, 10:\n' +
+      '  Error This expression has type string but an expression was expected of type int',
+    row: 0,
+    column: 10,
+    endRow: 0,
+    endColumn: 12,
+    text: 'This expression has type string but an expression was expected of type int',
+    type: 'error'
+  }
+  {
+    js_code: '// Generated by Melange\n' +
+      "'use strict';\n" +
+      '\n' +
+      '\n' +
+      'var person1 = {\n' +
+      '  name: "joe",\n' +
+      '  age: 10\n' +
+      '};\n' +
+      '\n' +
+      'exports.person1 = person1;\n' +
+      '/* No side effect */\n'
+  }