WIP

jscomp/ext_filename.ml

@@ -36,11 +36,31 @@ let node_current = "."
 
 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 (Lazy.force cwd) s 
+       Lazy.force cwd // s 
     else s in
   (* Now simplify . and .. components *)
   let rec aux s =
@@ -49,14 +69,15 @@ let absolute_path s =
     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
+    else aux dir // base
   in
   aux s
 
 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 
 
@@ -103,20 +124,26 @@ 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 file2 = 
+  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
@@ -129,22 +156,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 file2)
+       (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 
@@ -158,9 +185,7 @@ let  resolve ~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
+    if Sys.file_exists (cwd // package_json) then cwd
     else 
       let cwd' = Filename.dirname cwd in 
       if String.length cwd' < String.length cwd then  

jscomp/ext_filename.mli

@@ -31,7 +31,8 @@
     library but rather specific to JS Module name convention. 
 *)
 
-
+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.

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_config.ml

@@ -78,20 +78,20 @@ 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
-      Filename.concat (Lazy.force Ext_filename.cwd) 
-	(Filename.dirname filename)
+      Lazy.force Ext_filename.cwd //
+	Filename.dirname filename
     else 
       Filename.dirname filename
   | Some x -> 
-    (Filename.concat 
-       (Lazy.force Ext_filename.package_dir) x)
+    Lazy.force Ext_filename.package_dir // x
 
 
 

jscomp/js_program_loader.ml

@@ -36,6 +36,8 @@ module S = Js_stmt_make
 
 open Js_output.Ops
 
+let (//) = Filename.concat 
+
 let string_of_module_id (x : Lam_module_ident.t) : string =           
   match x.kind  with 
   | Runtime  
@@ -69,18 +71,15 @@ let string_of_module_id (x : Lam_module_ident.t) : string =
           (* for some primitive files, no cmj support *)
           | exception Not_found ->
             if String_set.mem filename Js_config.runtime_set  then 
-              let path = 
-                (* For the runtime, only [JS] files are needed, and 
+              (* For the runtime, only [JS] files are needed, and 
                    unlike the stdlib, [bsc] have some pre-built knowledge 
                    about where it is, since in general, [runtime] 
                    is *transparent* to the user
-                *)        
-                Filename.concat 
-                  (Filename.dirname (Filename.dirname Sys.executable_name))
-                  "runtime"
-              in
+              *)        
+
               Ext_filename.node_relative_path !Location.input_name
-                (Filename.concat path filename)        
+                (Filename.dirname (Filename.dirname Sys.executable_name) 
+                 // "runtime" // filename)        
             else
               begin 
                 Ext_log.warn __LOC__ "@[%s not found in search path - while compiling %s @] "

jscomp/test/a_filename_test.js

@@ -26,19 +26,27 @@ function eq(loc, x, y) {
   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 10, characters 5-12', /* tuple */[
+      Ext_filename.combine("/tmp", "subdir/file.txt"),
+      Ext_filename.combine("/tmp", "/a/tmp.txt"),
+      Ext_filename.combine("/a/tmp.txt", "subdir/file.txt")
+    ], /* tuple */[
+      "/tmp/subdir/file.txt",
+      "/a/tmp.txt",
+      "/a/tmp.txt/subdir/file.txt"
+    ]);
 
-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", "./a/u/g.c"), "./u/g");
 
-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 27, 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 33, 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/b.c", "xxxghsoghos/ghsoghso/node_modules/./buckle-stdlib/list.js"), "buckle-stdlib/list.js");
 
-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 45, characters 5-12', Ext_filename.node_relative_path("./a/c.js", "./a/b"), "./b");
 
-eq('File "a_filename_test.ml", line 44, characters 5-12', Ext_filename.node_relative_path("./a/", "./a/b.js"), "./b");
+eq('File "a_filename_test.ml", line 50, characters 5-12', Ext_filename.node_relative_path("./a/c", "./a/b.js"), "./b");
 
 Mt.from_pair_suites("a_filename_test.ml", suites[0]);
 

jscomp/test/a_filename_test.ml

@@ -7,7 +7,18 @@ let eq loc x y =
 
 
 let () =
-
+  eq __LOC__ 
+    (let (//) = Ext_filename.combine in 
+     ("/tmp"// "subdir/file.txt",
+      "/tmp"// "/a/tmp.txt",
+      "/a/tmp.txt" // "subdir/file.txt"      
+    ))
+    ("/tmp/subdir/file.txt",
+     "/a/tmp.txt",
+     "/a/tmp.txt/subdir/file.txt"      
+    )
+
+  ;    
   eq __LOC__
     (Ext_filename.node_relative_path 
        "./a/b.c"