[feature] make js files relocatble

Author: Hongbo Zhang

.gitignore

@@ -69,5 +69,4 @@ coverage
 dist/
 
 bin/
-lib/
 man/

jscomp/build.sh

@@ -40,7 +40,7 @@ cd ./test/
 # ./build.sh 2>> ../build.compile
 make $TARGET.cmj 2>> ../build.compile
 
-cat $TARGET.js >> ../build.compile
+cat ../../lib/js/test/$TARGET.js >> ../build.compile
 make -j30 all 2>>../build.compile
 make depend 2>>../build.compile
 echo "<<Test finished" >> ../build.compile

jscomp/ext_filename.ml

@@ -34,23 +34,57 @@ let node_sep = "/"
 let node_parent = ".."
 let node_current = "."
 
+type t = 
+  [ `File of string 
+  | `Dir of string ]
+
+let cwd = lazy (Sys.getcwd ())
+
+let (//) = Filename.concat 
+
+let combine path1 path2 =
+  if path1 = "" then
+    path2
+  else if path2 = "" then path1
+  else 
+  if Filename.is_relative path2 then
+     path1// path2 
+  else
+    path2
+
+(* Note that [.//] is the same as [./] *)
+let path_as_directory x =
+  if x = "" then x
+  else
+  if Ext_string.ends_with x  Filename.dir_sep then
+    x 
+  else 
+    x ^ Filename.dir_sep
+
 let absolute_path s = 
-  let s = if Filename.is_relative s then Filename.concat (Sys.getcwd ()) s else s in
-  (* Now simplify . and .. components *)
-  let rec aux s =
-    let base = Filename.basename s in
-    let dir = Filename.dirname s in
-    if dir = s then dir
-    else if base = Filename.current_dir_name then aux dir
-    else if base = Filename.parent_dir_name then Filename.dirname (aux dir)
-    else Filename.concat (aux dir) base
-  in
-  aux s
+  let process s = 
+    let s = 
+      if Filename.is_relative s then
+        Lazy.force cwd // s 
+      else s in
+    (* Now simplify . and .. components *)
+    let rec aux s =
+      let base,dir  = Filename.basename s, Filename.dirname s  in
+      if dir = s then dir
+      else if base = Filename.current_dir_name then aux dir
+      else if base = Filename.parent_dir_name then Filename.dirname (aux dir)
+      else aux dir // base
+    in aux s  in 
+  match s with 
+  | `File x -> `File (process x )
+  | `Dir x -> `Dir (process x)
+
 
 let chop_extension ?(loc="") name =
   try Filename.chop_extension name 
   with Invalid_argument _ -> 
-    invalid_arg ("Filename.chop_extension (" ^ loc ^ ":" ^ name ^ ")")
+    Ext_pervasives.invalid_argf 
+      "Filename.chop_extension ( %s : %s )"  loc name
 
 let try_chop_extension s = try Filename.chop_extension s with _ -> s 
 
@@ -74,9 +108,18 @@ let try_chop_extension s = try Filename.chop_extension s with _ -> s
     /c/d
     ]}
  *)
-let relative_path file1 file2 = 
-  let dir1 = Ext_string.split (Filename.dirname file1) (Filename.dir_sep.[0])  in
-  let dir2 = Ext_string.split (Filename.dirname file2) (Filename.dir_sep.[0])  in
+let relative_path file_or_dir_1 file_or_dir_2 = 
+  let sep_char = Filename.dir_sep.[0] in
+  let relevant_dir1 = 
+    (match file_or_dir_1 with 
+    | `Dir x -> x 
+    | `File file1 ->  Filename.dirname file1) in
+  let relevant_dir2 = 
+    (match file_or_dir_2 with 
+    |`Dir x -> x 
+    |`File file2 -> Filename.dirname file2 ) in
+  let dir1 = Ext_string.split relevant_dir1 sep_char   in
+  let dir2 = Ext_string.split relevant_dir2 sep_char  in
   let rec go (dir1 : string list) (dir2 : string list) = 
     match dir1, dir2 with 
     | x::xs , y :: ys when x = y
@@ -95,20 +138,29 @@ 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 
     TODO: [Filename.concat] with care
+
+    [file1] is currently compilation file 
+    [file2] is the dependency
  *)
-let node_relative_path path1 path2 = 
-  let v = Ext_string.find  path2 ~sub:node_modules in 
-  let len = String.length path2 in 
+let node_relative_path (file1 : t) 
+    (`File file2 as dep_file : [`File of string]) = 
+  let v = Ext_string.find  file2 ~sub:node_modules in 
+  let len = String.length file2 in 
   if v >= 0 then 
     let rec skip  i =       
       if i >= len then
-        failwith ("invalid path: " ^ path2)
+        Ext_pervasives.failwithf "invalid path: %s"  file2
       else 
-        match path2.[i] with 
+        match file2.[i] with 
         | '/'
         | '.' ->  skip (i + 1) 
         | _ -> i
@@ -121,21 +173,22 @@ let node_relative_path path1 path2 =
            This seems weird though
         *)
     in 
-    Ext_string.tail_from path2
+    Ext_string.tail_from file2
       (skip (v + node_modules_length)) 
   else 
-    (relative_path 
-       (try_chop_extension (absolute_path path2))
-       (try_chop_extension (absolute_path path1))
-    ) ^ node_sep ^
-    (try_chop_extension (Filename.basename path2))
+    relative_path 
+       (absolute_path dep_file)
+       (absolute_path file1)
+     ^ node_sep ^
+    try_chop_extension (Filename.basename file2)
+
 
 
 (** [resolve cwd module_name], [cwd] is current working directory, absolute path
 *)
 let  resolve ~cwd module_name = 
   let rec aux origin cwd module_name = 
-    let v = Filename.concat (Filename.concat cwd node_modules) module_name 
+    let v = ( cwd // node_modules) // module_name 
     in 
     if Sys.is_directory v then v 
     else 
@@ -145,3 +198,18 @@ 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  = 
+    if Sys.file_exists (cwd // package_json) 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,8 +26,17 @@
 
 
 
+(* TODO:
+   Change the module name, this code is not really an extension of the standard 
+    library but rather specific to JS Module name convention. 
+*)
 
+type t = 
+  [ `File of string 
+  | `Dir of string ]
 
+val combine : string -> string -> string 
+val path_as_directory : string -> string
 
 (** An extension module to calculate relative path follow node/npm style. 
     TODO : this short name will have to change upon renaming the file.
@@ -41,12 +50,14 @@
     just treat it as a library instead
  *)
 
-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 node_relative_path : t -> [`File of string] -> string
 
 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/ext_pervasives.ml

@@ -62,3 +62,5 @@ let  is_pos_pow n =
   try aux 0 n  with M.E -> -1
 
 let failwithf fmt = Format.ksprintf failwith fmt
+
+let invalid_argf fmt = Format.ksprintf invalid_arg fmt

jscomp/ext_pervasives.mli

@@ -42,3 +42,5 @@ val with_file_as_pp : string -> (Format.formatter -> 'a) -> 'a
 val is_pos_pow : Int32.t -> int
 
 val failwithf : ('a, unit, string, 'b) format4 -> 'a
+
+val invalid_argf : ('a, unit, string, 'b) format4 -> 'a

jscomp/js_cmj_format.ml

@@ -71,9 +71,9 @@ let from_file name : t =
   let ic = open_in_bin name in 
   let buffer = really_input_string ic cmj_magic_number_length in 
   if buffer <> cmj_magic_number then
-    failwith 
-      ("cmj files have incompatible versions, please rebuilt using the new compiler : " 
-       ^ __LOC__)
+    Ext_pervasives.failwithf 
+      "cmj files have incompatible versions, please rebuilt using the new compiler : %s" 
+        __LOC__
   else 
     let v  : t = input_value ic in 
     close_in ic ;

jscomp/js_config.ml

@@ -74,8 +74,36 @@ 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
+
+let (//) = Filename.concat 
+(* 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
+      Lazy.force Ext_filename.cwd //
+      Filename.dirname filename
+    else 
+      Filename.dirname filename
+  | Some x -> 
+    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 [
@@ -88,10 +116,10 @@ let stdlib_set = String_set.of_list [
     "arrayLabels";
     "hashtbl";
     "queue";
-    "buffer";			
+    "buffer"; 
     "int32";
     "random";
-    "bytes";			
+    "bytes"; 
     "int64";
     "scanf";
     "bytesLabels";

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;