[feature] wip: complete npm module support

jscomp/ext_filename.ml

@@ -34,8 +34,14 @@ let node_sep = "/"
 let node_parent = ".."
 let node_current = "."
 
+let cwd = lazy (Sys.getcwd ())
+
+
 let absolute_path s = 
-  let s = if Filename.is_relative s then Filename.concat (Sys.getcwd ()) s else s in
+  let s = 
+    if Filename.is_relative s then
+      Filename.concat (Lazy.force cwd) s 
+    else s in
   (* Now simplify . and .. components *)
   let rec aux s =
     let base = Filename.basename s in
@@ -95,6 +101,8 @@ let relative_path file1 file2 =
 
 let node_modules = "node_modules"
 let node_modules_length = String.length "node_modules"
+let package_json = "package.json"
+
 (** path2: a/b 
     path1: a 
     result:  ./b 
@@ -131,6 +139,7 @@ let node_relative_path path1 path2 =
     (try_chop_extension (Filename.basename path2))
 
 
+
 (** [resolve cwd module_name], [cwd] is current working directory, absolute path
 *)
 let  resolve ~cwd module_name = 
@@ -145,3 +154,20 @@ let  resolve ~cwd module_name =
       else Ext_pervasives.failwithf "%s not found in %s" module_name origin 
   in
   aux cwd cwd module_name
+
+
+let resolve_package cwd  = 
+  let rec aux cwd  = 
+    let v =  Filename.concat cwd package_json
+    in 
+    if Sys.file_exists v then cwd
+    else 
+      let cwd' = Filename.dirname cwd in 
+      if String.length cwd' < String.length cwd then  
+        aux cwd'
+      else 
+	Ext_pervasives.failwithf "package.json not found from %s" cwd
+  in
+  aux cwd 
+
+let package_dir = lazy (resolve_package (Lazy.force cwd))

jscomp/ext_filename.mli

@@ -26,6 +26,10 @@
 
 
 
+(* TODO:
+   Change the module name, this code is not really an extension of the standard 
+    library but rather specific to JS Module name convention. 
+*)
 
 
 
@@ -42,11 +46,13 @@
  *)
 
 val node_relative_path : string -> string -> string
-(** TODO Change the module name, this code is not really an extension of the standard 
-    library but rather specific to JS Module name convention. 
-  *)
 
 val chop_extension : ?loc:string -> string -> string
 
 
 val resolve : cwd:string -> string -> string
+
+val resolve_package : string -> string 
+
+val cwd : string Lazy.t
+val package_dir : string Lazy.t

jscomp/js_config.ml

@@ -74,8 +74,37 @@ let get_goog_package_name () =
   | AmdJS
   | NodeJS -> None
 
-let get_npm_package_path () = None
-
+let npm_package_path = ref None 
+let set_npm_package_path s = npm_package_path := Some s
+let get_npm_package_path () = !npm_package_path
+
+(* for a single pass compilation, [output_dir] 
+   can be cached 
+*)
+let get_output_dir filename =
+  match get_npm_package_path () with 
+  | None -> 
+    if Filename.is_relative filename then
+      Filename.concat (Lazy.force Ext_filename.cwd) 
+	(Filename.dirname filename)
+    else 
+      Filename.dirname filename
+  | Some x -> 
+    (Filename.concat 
+       (Lazy.force Ext_filename.package_dir) x)
+
+
+
+(* Note that we can have different [basename] when passed 
+   to many files
+*)
+let get_output_file filename = 
+  let basename = Filename.basename filename in  
+  Filename.concat (get_output_dir filename)
+    (Ext_filename.chop_extension ~loc:__LOC__
+	 basename ^  get_ext())
+
+
 let default_gen_tds = ref false
 
 let stdlib_set = String_set.of_list [

jscomp/js_config.mli

@@ -36,7 +36,11 @@ type env =
 val get_env : unit -> env
 val get_ext : unit -> string
 
+val get_output_dir : string -> string 
+val get_output_file : string -> string
 val get_goog_package_name : unit -> string option
+
+val set_npm_package_path : string -> unit 
 val get_npm_package_path : unit -> string option
 
 val set_env : env -> unit

jscomp/js_main.ml

@@ -34,25 +34,10 @@ let process_file ppf name =
     Js_implementation.interface ppf name opref;
     if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
   end
-  (* else if Filename.check_suffix name ".cmo"  *)
-  (*      || Filename.check_suffix name ".cma" then *)
-  (*   objfiles := name :: !objfiles *)
-  (* else if Filename.check_suffix name ".cmi" && !make_package then *)
-  (*   objfiles := name :: !objfiles *)
-  (* else if Filename.check_suffix name ext_obj *)
-  (*      || Filename.check_suffix name ext_lib then *)
-  (*   ccobjs := name :: !ccobjs *)
-  (* else if Filename.check_suffix name ext_dll then *)
-  (*   dllibs := name :: !dllibs *)
-  (* else if Filename.check_suffix name ".c" then begin *)
-  (*   Compile.c_file name; *)
-  (*   ccobjs := (Filename.chop_suffix (Filename.basename name) ".c" ^ ext_obj) *)
-  (*             :: !ccobjs *)
-  (* end *)
   else
     raise(Arg.Bad("don't know what to do with " ^ name))
 
-let usage = "Usage: ocamlc <options> <files>\nOptions are:"
+let usage = "Usage: bsc <options> <files>\nOptions are:"
 
 let ppf = Format.err_formatter
 
@@ -145,10 +130,15 @@ module Options = Main_args.Make_bytecomp_options (struct
 end)
 
 let add_include_path s = 
-  let path = Ext_filename.resolve (Sys.getcwd ()) s  in 
+  let path = 
+    Ext_filename.resolve 
+      (Lazy.force Ext_filename.cwd) s  in 
   Clflags.include_dirs := path :: ! Clflags.include_dirs
 
 let buckle_script_flags = 
+  ("-js-npm-output-path", Arg.String Js_config.set_npm_package_path, 
+   " set npm-output-path, for example `lib/js`")
+  ::
   ("-npm-package", Arg.String add_include_path, 
    " set package names, for example bs-platform "  )
   :: ("-js-module", Arg.String Js_config.cmd_set_module, 
@@ -165,16 +155,6 @@ let main () =
   try
     readenv ppf Before_args;
     Arg.parse buckle_script_flags anonymous usage;
-    readenv ppf Before_link;
-    if
-      List.length (List.filter (fun x -> !x)
-                      [make_archive;make_package;compile_only;output_c_object])
-        > 1
-    then
-      if !print_types then
-        fatal "Option -i is incompatible with -pack, -a, -output-obj"
-      else
-        fatal "Please specify at most one of -pack, -a, -c, -output-obj";
     exit 0
   with x ->
     Location.report_exception ppf x;

jscomp/js_program_loader.ml

@@ -97,7 +97,8 @@ let string_of_module_id (x : Lam_module_ident.t) : string =
              so we just always general litte_case.js
           *)
           | path ->
-            Ext_filename.node_relative_path !Location.input_name path
+            Ext_filename.node_relative_path 
+	      ((* Js_config.get_output_dir *) !Location.input_name) path
         end
     end
   | External name -> name

jscomp/lam_compile_group.ml

@@ -420,8 +420,9 @@ let lambda_as_module
     Lam_current_unit.set_file filename ;  
     Lam_current_unit.iset_debug_file "tuple_alloc.ml";
     Ext_pervasives.with_file_as_chan 
-      (Ext_filename.chop_extension ~loc:__LOC__ filename ^  Js_config.get_ext())
-      (fun chan -> Js_dump.dump_deps_program (compile ~filename false env sigs lam) chan)
+      (Js_config.get_output_file filename)
+      (fun chan -> Js_dump.dump_deps_program 
+	  (compile ~filename false env sigs lam) chan)
   end
 (* We can use {!Env.current_unit = "Pervasives"} to tell if it is some specific module, 
     We need handle some definitions in standard libraries in a special way, most are io specific, 

jscomp/lam_current_unit.ml

@@ -40,5 +40,6 @@ let iset_debug_file _ = ()
 let set_debug_file  f = debug_file := f
 let get_debug_file  () = !debug_file
 
+
 let is_same_file () = 
   !debug_file <> "" &&  !debug_file = !file

jscomp/lam_current_unit.mli

@@ -36,3 +36,4 @@ val set_debug_file : string -> unit
 val get_debug_file : unit -> string
 
 val is_same_file : unit -> bool 
+

jscomp/lam_dispatch_primitive.ml

@@ -464,6 +464,7 @@ let query (prim : Lam_compile_env.primitive_description)
   | "caml_sys_system_command" 
   | "caml_sys_getcwd" (* check browser or nodejs *)
   | "caml_sys_is_directory"
+  | "caml_sys_file_exists"
     -> 
     call Js_config.sys
   | "caml_lex_engine"

jscomp/runtime/caml_sys.js

@@ -55,6 +55,13 @@ function caml_sys_is_directory() {
       ];
 }
 
+function caml_sys_file_exists() {
+  throw [
+        Caml_builtin_exceptions.failure,
+        "caml_sys_file_exists not implemented"
+      ];
+}
+
 function caml_sys_getenv(prim) {
   return $$caml_sys_getenv(prim);
 }
@@ -66,4 +73,5 @@ exports.caml_sys_random_seed    = caml_sys_random_seed;
 exports.caml_sys_system_command = caml_sys_system_command;
 exports.caml_sys_getcwd         = caml_sys_getcwd;
 exports.caml_sys_is_directory   = caml_sys_is_directory;
+exports.caml_sys_file_exists    = caml_sys_file_exists;
 /*  Not a pure module */

jscomp/runtime/caml_sys.ml

@@ -72,3 +72,6 @@ let caml_sys_getcwd () = "/"
 
 let caml_sys_is_directory _s = 
   raise @@ Failure "caml_sys_is_directory not implemented"
+
+let caml_sys_file_exists _s = 
+  raise @@ Failure "caml_sys_file_exists not implemented"

jscomp/runtime/caml_sys.mli

@@ -40,3 +40,4 @@ val caml_sys_system_command : unit -> int
 val caml_sys_getcwd : unit -> string 
 
 val caml_sys_is_directory : string -> bool 
+val caml_sys_file_exists : string -> bool 

jscomp/test/.depend

@@ -148,9 +148,11 @@ ext_array.cmx : ../stdlib/list.cmx ../stdlib/array.cmx
 ext_bytes.cmj : ../stdlib/bytes.cmi
 ext_bytes.cmx : ../stdlib/bytes.cmx
 ext_filename.cmj : ../stdlib/sys.cmi ../stdlib/string.cmi ../stdlib/list.cmi \
-    ../stdlib/filename.cmi ext_string.cmj ext_pervasives.cmi
+    ../stdlib/lazy.cmi ../stdlib/filename.cmi ext_string.cmj \
+    ext_pervasives.cmi
 ext_filename.cmx : ../stdlib/sys.cmx ../stdlib/string.cmx ../stdlib/list.cmx \
-    ../stdlib/filename.cmx ext_string.cmx ext_pervasives.cmx
+    ../stdlib/lazy.cmx ../stdlib/filename.cmx ext_string.cmx \
+    ext_pervasives.cmx
 ext_list.cmj : ../stdlib/list.cmi ../stdlib/array.cmi
 ext_list.cmx : ../stdlib/list.cmx ../stdlib/array.cmx
 ext_log.cmj : lam_current_unit.cmj ../stdlib/format.cmi
@@ -760,9 +762,11 @@ ext_array.cmj : ../stdlib/list.cmj ../stdlib/array.cmj
 ext_bytes.cmo : ../stdlib/bytes.cmi
 ext_bytes.cmj : ../stdlib/bytes.cmj
 ext_filename.cmo : ../stdlib/sys.cmi ../stdlib/string.cmi ../stdlib/list.cmi \
-    ../stdlib/filename.cmi ext_string.cmo ext_pervasives.cmi
+    ../stdlib/lazy.cmi ../stdlib/filename.cmi ext_string.cmo \
+    ext_pervasives.cmi
 ext_filename.cmj : ../stdlib/sys.cmj ../stdlib/string.cmj ../stdlib/list.cmj \
-    ../stdlib/filename.cmj ext_string.cmj ext_pervasives.cmj
+    ../stdlib/lazy.cmj ../stdlib/filename.cmj ext_string.cmj \
+    ext_pervasives.cmj
 ext_list.cmo : ../stdlib/list.cmi ../stdlib/array.cmi
 ext_list.cmj : ../stdlib/list.cmj ../stdlib/array.cmj
 ext_log.cmo : lam_current_unit.cmo ../stdlib/format.cmi

jscomp/test/Makefile

@@ -8,6 +8,7 @@ SOURCE_LIST := $(shell cat test.mllib)
 TESTS := $(addsuffix .cmj, $(SOURCE_LIST) )
 
 COMPFLAGS+=  $(MODULE_FLAGS) -w -40 
+# -js-npm-output-path lib/js/test/
 
 
 $(TESTS): $(CAMLC)

jscomp/test/a_filename_test.js

@@ -5,57 +5,44 @@ var Mt           = require("./mt");
 var Block        = require("../runtime/block");
 var Ext_filename = require("./ext_filename");
 
-var suites_000 = /* tuple */[
-  "basic",
-  function () {
-    return /* Eq */Block.__(0, [
-              Ext_filename.node_relative_path("./a/b.c", "./a/u/g.c"),
-              "./u/g"
-            ]);
-  }
-];
-
-var suites_001 = /* :: */[
-  /* tuple */[
-    "node",
-    function () {
-      return /* Eq */Block.__(0, [
-                Ext_filename.node_relative_path("./a/b.c", "xxxghsoghos/ghsoghso/node_modules/buckle-stdlib/list.js"),
-                "buckle-stdlib/list.js"
-              ]);
-    }
-  ],
-  /* :: */[
+var suites = [/* [] */0];
+
+var test_id = [0];
+
+function eq(loc, x, y) {
+  test_id[0] = test_id[0] + 1 | 0;
+  suites[0] = /* :: */[
     /* tuple */[
-      "node2",
+      loc + (" id " + test_id[0]),
       function () {
         return /* Eq */Block.__(0, [
-                  Ext_filename.node_relative_path("./a/b.c", "xxxghsoghos/ghsoghso/node_modules//buckle-stdlib/list.js"),
-                  "buckle-stdlib/list.js"
+                  x,
+                  y
                 ]);
       }
     ],
-    /* :: */[
-      /* tuple */[
-        "node3",
-        function () {
-          return /* Eq */Block.__(0, [
-                    Ext_filename.node_relative_path("./a/b.c", "xxxghsoghos/ghsoghso/node_modules/./buckle-stdlib/list.js"),
-                    "buckle-stdlib/list.js"
-                  ]);
-        }
-      ],
-      /* [] */0
-    ]
-  ]
-];
-
-var suites = /* :: */[
-  suites_000,
-  suites_001
-];
-
-Mt.from_pair_suites("a_filename_test.ml", suites);
-
-exports.suites = suites;
+    suites[0]
+  ];
+  return /* () */0;
+}
+
+eq('File "a_filename_test.ml", line 11, characters 5-12', Ext_filename.node_relative_path("./a/b.c", "./a/u/g.c"), "./u/g");
+
+eq('File "a_filename_test.ml", line 16, characters 5-12', Ext_filename.node_relative_path("./a/b.c", "xxxghsoghos/ghsoghso/node_modules/buckle-stdlib/list.js"), "buckle-stdlib/list.js");
+
+eq('File "a_filename_test.ml", line 22, characters 5-12', Ext_filename.node_relative_path("./a/b.c", "xxxghsoghos/ghsoghso/node_modules//buckle-stdlib/list.js"), "buckle-stdlib/list.js");
+
+eq('File "a_filename_test.ml", line 28, characters 5-12', Ext_filename.node_relative_path("./a/b.c", "xxxghsoghos/ghsoghso/node_modules/./buckle-stdlib/list.js"), "buckle-stdlib/list.js");
+
+eq('File "a_filename_test.ml", line 34, characters 5-12', Ext_filename.node_relative_path("./a/c.js", "./a/b"), "./b");
+
+eq('File "a_filename_test.ml", line 39, characters 5-12', Ext_filename.node_relative_path("./a/c", "./a/b.js"), "./b");
+
+eq('File "a_filename_test.ml", line 44, characters 5-12', Ext_filename.node_relative_path("./a/", "./a/b.js"), "./b");
+
+Mt.from_pair_suites("a_filename_test.ml", suites[0]);
+
+exports.suites  = suites;
+exports.test_id = test_id;
+exports.eq      = eq;
 /*  Not a pure module */