Merge pull request #4831 from rescript-lang/mark_rescript

relative paths reloaded

Author: bobzhang

jscomp/bsb/bsb_config.ml

@@ -62,7 +62,7 @@ let rev_lib_bs_prefix p = rev_lib_bs // p
 
 let ocaml_bin_install_prefix p = lib_ocaml // p
 
-let proj_rel path = Bsb_ninja_global_vars.lazy_src_root_dir // path
+let proj_rel path = rev_lib_bs // path
 
 (** it may not be a bad idea to hard code the binary path 
     of bsb in configuration time

jscomp/bsb/bsb_ninja_gen.ml

@@ -236,9 +236,9 @@ let output_ninja_and_namespace_map
 
   let oc = open_out_bin (cwd_lib_bs // Literals.build_ninja) in 
   mark_rescript oc;
-  Bsb_ninja_targets.output_kv      
+  (* Bsb_ninja_targets.output_kv      
     Bsb_ninja_global_vars.src_root_dir per_proj_dir                 
-    oc ;
+    oc ; *)
   output_static_resources static_resources rules.copy_resources oc ;
   (** Generate build statement for each file *)        
   Ext_list.iter bs_file_groups 

jscomp/bsb/bsb_ninja_global_vars.ml

@@ -30,9 +30,9 @@
   to be "a" and "$a"
 *)
 
-let src_root_dir = "g_root"
+(* let src_root_dir = "g_root"
 
-let lazy_src_root_dir = "$g_root" 
+let lazy_src_root_dir = "$g_root"  *)
 
 
 

jscomp/bsb/bsb_ninja_rule.ml

@@ -218,7 +218,7 @@ let make_custom_rules
     );
 
     Ext_buffer.add_char_string buf ' ' bsc_flags;
-    Ext_buffer.add_string buf " -bs-ast -o $out $i";   
+    Ext_buffer.add_string buf " -absname -bs-ast -o $out $i";   
     Ext_buffer.contents buf
   in  
   let build_ast =

jscomp/core/config_util.ml

@@ -47,4 +47,12 @@ let find_opt file =  find_in_path_uncap !Config.load_path file
 
 
 
+let output_prefix name =
+  match !Clflags.output_name with
+  | None -> 
+    Ext_namespace_encode.make 
+      (Filename.remove_extension name) 
+      ?ns:!Clflags.dont_record_crc_unit
+  | Some oname -> 
+    Filename.remove_extension oname
 

jscomp/core/config_util.mli

@@ -37,3 +37,16 @@
 val find_opt : string -> string option
 (** [find filename] Input is a file name, output is absolute path *)
 
+
+(** given the input, calculate the output prefix 
+
+    in: src/hello.ast
+    out: src/hello
+
+    with namespace:
+    in: src/hello.ast
+    out: src/hello-Ns
+*)
+val output_prefix : 
+    string -> 
+    string 

jscomp/core/js_implementation.ml

@@ -102,7 +102,11 @@ let after_parsing_sig ppf  outputprefix ast  =
 
 
 
-let interface ~parser ppf fname outputprefix =
+let interface ~parser ppf ?outputprefix fname  =
+  let outputprefix = 
+    match outputprefix with   
+    | None -> Config_util.output_prefix fname 
+    | Some x -> x in   
   Res_compmisc.init_path ();
   parser fname
   |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Mli 
@@ -111,12 +115,12 @@ let interface ~parser ppf fname outputprefix =
   |> print_if_pipe ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf  outputprefix 
 
-let interface_mliast ppf fname outputprefix  setup = 
+let interface_mliast ppf fname  setup = 
   Res_compmisc.init_path ();
   Binary_ast.read_ast_exn ~fname Mli  setup
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface
   |> print_if_pipe ppf Clflags.dump_source Pprintast.signature 
-  |> after_parsing_sig ppf  outputprefix 
+  |> after_parsing_sig ppf  (Config_util.output_prefix fname)
 
 let all_module_alias (ast : Parsetree.structure)= 
   Ext_list.for_all ast (fun {pstr_desc} -> 
@@ -196,7 +200,11 @@ let after_parsing_impl ppf  outputprefix (ast : Parsetree.structure) =
       end;
       process_with_gentype (outputprefix ^ ".cmt")        
     end
-let implementation ~parser ppf fname outputprefix  =
+let implementation ~parser ppf ?outputprefix fname   =
+  let outputprefix = 
+      match outputprefix with   
+      | None -> Config_util.output_prefix fname 
+      | Some x -> x in 
   Res_compmisc.init_path ();  
   parser fname
   |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Ml  
@@ -205,12 +213,13 @@ let implementation ~parser ppf fname outputprefix  =
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf outputprefix 
 
-let implementation_mlast ppf fname outputprefix setup = 
+let implementation_mlast ppf fname  setup = 
+  
   Res_compmisc.init_path ();
   Binary_ast.read_ast_exn ~fname Ml  setup
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
-  |> after_parsing_impl ppf  outputprefix 
+  |> after_parsing_impl ppf  (Config_util.output_prefix fname )
 
 
 
@@ -232,7 +241,7 @@ let make_structure_item ~ns cunit : Parsetree.structure_item =
 (** decoding [.mlmap]
   keep in sync {!Bsb_namespace_map_gen.output}
 *)
-let implementation_map ppf sourcefile outputprefix = 
+let implementation_map ppf sourcefile = 
   let () = Js_config.cmj_only := true in 
   let ichan = open_in_bin sourcefile in 
   seek_in ichan (Ext_digest.length +1);
@@ -247,5 +256,5 @@ let implementation_map ppf sourcefile outputprefix =
   ml_ast
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
-  |> after_parsing_impl ppf outputprefix 
+  |> after_parsing_impl ppf (Config_util.output_prefix sourcefile) 
 

jscomp/core/js_implementation.mli

@@ -38,13 +38,12 @@
 val interface : 
   parser:(string -> Parsetree.signature) ->
   Format.formatter -> 
-  string -> 
+  ?outputprefix:string -> 
   string -> 
   unit
 
 val interface_mliast : 
   Format.formatter -> 
-  string -> 
   string  -> 
   ([`ml | `rescript | `reason ] -> unit) ->
   unit
@@ -64,16 +63,16 @@ val interface_mliast :
 val implementation : 
   parser:(string -> Parsetree.structure) ->
   Format.formatter -> 
-  string -> 
+  ?outputprefix:string -> 
   string -> 
   unit
 (** [implementation ppf sourcefile outprefix] compiles to JS directly *) 
 
 val implementation_mlast : 
   Format.formatter ->
   string -> 
-  string -> 
   ([`ml | `rescript | `reason ]  -> unit) ->
   unit
 
-val implementation_map : Format.formatter -> string -> string -> unit
+val implementation_map : 
+  Format.formatter -> string ->  unit

jscomp/main/js_main.ml

@@ -10,16 +10,14 @@
 (*                                                                     *)
 (***********************************************************************)
 
-let output_prefix name =
-  match !Clflags.output_name with
-  | None -> 
-    Ext_namespace_encode.make 
-      (Filename.remove_extension name) 
-      ?ns:!Clflags.dont_record_crc_unit
-  | Some oname -> 
-    Filename.remove_extension oname
-
 
+let set_abs_input_name sourcefile =     
+  let sourcefile =   
+    if !Location.absname && Filename.is_relative  sourcefile then 
+      Ext_path.absolute_cwd_path sourcefile
+    else sourcefile in 
+  Location.set_input_name sourcefile;
+  sourcefile  
 
 
 let setup_error_printer (syntax_kind : [ `ml | `reason | `rescript ])= 
@@ -36,9 +34,10 @@ let setup_error_printer (syntax_kind : [ `ml | `reason | `rescript ])=
 
 
 
-let handle_reason (type a) (kind : a Ml_binary.kind) sourcefile ppf opref = 
+let handle_reason (type a) (kind : a Ml_binary.kind) sourcefile ppf  = 
   setup_error_printer `reason;
   let tmpfile =  Ast_reason_pp.pp sourcefile in   
+  let outputprefix = Config_util.output_prefix sourcefile in 
   (match kind with 
    | Ml_binary.Ml -> 
      Js_implementation.implementation
@@ -47,7 +46,7 @@ let handle_reason (type a) (kind : a Ml_binary.kind) sourcefile ppf opref =
            let ast = Ml_binary.read_ast Ml in_chan in 
            close_in in_chan; ast 
          )
-       ppf  tmpfile opref    
+       ppf  tmpfile ~outputprefix
 
    | Ml_binary.Mli ->
      Js_implementation.interface 
@@ -56,55 +55,61 @@ let handle_reason (type a) (kind : a Ml_binary.kind) sourcefile ppf opref =
            let ast = Ml_binary.read_ast Mli in_chan in 
            close_in in_chan; ast 
          )
-       ppf  tmpfile opref ;    );
+       ppf  tmpfile ~outputprefix  );
   Ast_reason_pp.clean tmpfile 
 
-  
 
 let process_file sourcefile 
   ?(kind ) ppf = 
   (* This is a better default then "", it will be changed later 
      The {!Location.input_name} relies on that we write the binary ast 
      properly
   *)
-  Location.set_input_name  sourcefile;    
-  let opref = output_prefix sourcefile in 
   let kind =
     match kind with 
     | None -> Ext_file_extensions.classify_input (Ext_filename.get_extension_maybe sourcefile)  
     | Some kind -> kind in 
   match kind with 
-  | Re -> handle_reason Ml sourcefile ppf opref     
+  | Re -> 
+    let sourcefile = set_abs_input_name  sourcefile in 
+    handle_reason Ml sourcefile ppf 
   | Rei ->
-    handle_reason Mli sourcefile ppf opref 
+    let sourcefile = set_abs_input_name  sourcefile in 
+    handle_reason Mli sourcefile ppf  
   | Ml ->
+    let sourcefile = set_abs_input_name  sourcefile in     
     Js_implementation.implementation 
       ~parser:Pparse_driver.parse_implementation
-      ppf sourcefile opref 
+      ppf sourcefile 
   | Mli  ->   
+    let sourcefile = set_abs_input_name  sourcefile in   
     Js_implementation.interface 
       ~parser:Pparse_driver.parse_interface
-      ppf sourcefile opref   
+      ppf sourcefile 
   | Res -> 
+    let sourcefile = set_abs_input_name  sourcefile in     
     setup_error_printer `rescript;
     Js_implementation.implementation 
       ~parser:Res_driver.parse_implementation
-      ppf sourcefile opref 
+      ppf sourcefile 
   | Resi ->   
+    let sourcefile = set_abs_input_name  sourcefile in 
     setup_error_printer `rescript;
     Js_implementation.interface 
       ~parser:Res_driver.parse_interface
-      ppf sourcefile opref     
+      ppf sourcefile      
   | Intf_ast 
     ->     
-    Js_implementation.interface_mliast ppf sourcefile opref   
+    Js_implementation.interface_mliast ppf sourcefile
     setup_error_printer ;
   | Impl_ast 
     -> 
-    Js_implementation.implementation_mlast ppf sourcefile opref
+    Js_implementation.implementation_mlast ppf sourcefile 
     setup_error_printer;  
   | Mlmap 
-    -> Js_implementation.implementation_map ppf sourcefile opref
+    -> 
+    Location.set_input_name  sourcefile;    
+    Js_implementation.implementation_map ppf sourcefile 
   | Cmi
     ->
     let cmi_sign = (Cmi_format.read_cmi sourcefile).cmi_sign in 

jscomp/others/release.ninja

@@ -1,5 +1,5 @@
 
-bsc_flags = -no-keep-locs -absname -no-alias-deps -bs-no-version-header -bs-no-check-div-by-zero -nostdlib  -bs-cross-module-opt -bs-package-name bs-platform -bs-package-output commonjs:lib/js  -bs-package-output es6:lib/es6   -nopervasives  -unsafe  -w +50 -warn-error A  -open Bs_stdlib_mini -I ./runtime
+bsc_flags = -no-keep-locs -no-alias-deps -bs-no-version-header -bs-no-check-div-by-zero -nostdlib  -bs-cross-module-opt -bs-package-name bs-platform -bs-package-output commonjs:lib/js  -bs-package-output es6:lib/es6   -nopervasives  -unsafe  -w +50 -warn-error A  -open Bs_stdlib_mini -I ./runtime
 
 rule cc
     command = $bsc -bs-cmi -bs-cmj $bsc_flags   -I others  $in