Merge pull request #594 from bloomberg/bs-main

add an option `-bs-main`

Author: bobzhang

jscomp/common/bs_exception.ml

@@ -26,7 +26,7 @@
 type error =
   | Cmj_not_found of string
   | Bs_cyclic_depends of string  list
-        
+  | Bs_duplicated_module of string * string         
 exception Error of error
 
 let error err = raise (Error err)
@@ -39,7 +39,10 @@ let report_error ppf = function
     Format.fprintf ppf "Cyclic depends : @[%a@]"
       (Format.pp_print_list ~pp_sep:Format.pp_print_space
          Format.pp_print_string)
-      str       
+      str
+  | Bs_duplicated_module (a,b)
+    ->
+    Format.fprintf ppf "The build system does not support two files with same names yet %s, %s" a b    
 
 let () =
   Location.register_error_of_exn

jscomp/common/bs_exception.mli

@@ -25,5 +25,5 @@
 type error =
   | Cmj_not_found of string
   | Bs_cyclic_depends of string  list
-
+  | Bs_duplicated_module of string * string         
 val error : error -> 'a 

jscomp/ext/ext_array.ml

@@ -89,3 +89,12 @@ let map2i f a b =
   else
     Array.mapi (fun i a -> f i  a ( Array.unsafe_get b i )) a 
 
+let to_list_f f a =
+  let rec tolist i res =
+    if i < 0 then res else
+      let v = Array.unsafe_get a i in
+      tolist (i - 1)
+        (match f v with
+         | Some v -> v :: res
+         | None -> res) in
+  tolist (Array.length a - 1) []

jscomp/ext/ext_array.mli

@@ -39,3 +39,4 @@ val range : int -> int -> int array
 
 val map2i : (int -> 'a -> 'b -> 'c ) -> 'a array -> 'b array -> 'c array
 
+val to_list_f : ('a -> 'b option) -> 'a array -> 'b list 

jscomp/js_main.ml

@@ -38,11 +38,13 @@ let intf filename =
   Compenv.readenv ppf Before_compile; process_interface_file ppf filename;;
 
 let batch_files  = ref []
-
+let main_file  = ref ""
+    
 let collect_file name = 
   batch_files := name :: !batch_files
 
-
+let set_main_entry name =
+  main_file := name  
 
 
 
@@ -108,6 +110,10 @@ let buckle_script_flags =
    Arg.Unit set_noassert, 
    " no code containing any assertion"
   )
+  ::
+  ("-bs-main",
+   Arg.String set_main_entry,   
+   " set the Main entry file")
   :: 
   ("-bs-files", 
    Arg.Rest collect_file, 
@@ -128,8 +134,7 @@ let _ =
   try
     Compenv.readenv ppf Before_args;
     Arg.parse buckle_script_flags anonymous usage;
-    Ocaml_batch_compile.batch_compile ppf !batch_files; 
-    exit 0
+    exit (Ocaml_batch_compile.batch_compile ppf !batch_files !main_file) 
   with x ->
     Location.report_exception ppf x;
     exit 2

jscomp/ocaml_batch_compile.ml

@@ -23,62 +23,187 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-let batch_compile ppf files =
+let module_name_of_file file =
+    String.capitalize 
+      (Filename.chop_extension @@ Filename.basename file)  
+
+let build_queue ppf queue (ast_table : _ Ast_extract.t String_map.t) =
+  queue |> Queue.iter (fun modname -> 
+      match String_map.find modname ast_table  with
+      | {ast_info = Ml(source_file,ast, opref)}
+        -> 
+        Js_implementation.after_parsing_impl ppf source_file 
+          opref ast 
+      | {ast_info = Mli (source_file,ast,opref) ; }  
+        ->
+        Js_implementation.after_parsing_sig ppf source_file 
+              opref ast 
+      | {ast_info = Ml_mli(source_file1,impl,opref1,source_file2,intf,opref2)}
+        -> 
+        Js_implementation.after_parsing_sig ppf source_file1 opref1 intf ;
+        Js_implementation.after_parsing_impl ppf source_file2 opref2 impl
+      | exception Not_found -> assert false 
+    )
+
+let build_lazy_queue ppf queue (ast_table : _ Ast_extract.t String_map.t) =
+  queue |> Queue.iter (fun modname -> 
+      match String_map.find modname ast_table  with
+      | {ast_info = Ml(source_file,lazy ast, opref)}
+        -> 
+        Js_implementation.after_parsing_impl ppf source_file 
+          opref ast 
+      | {ast_info = Mli (source_file,lazy ast,opref) ; }  
+        ->
+        Js_implementation.after_parsing_sig ppf source_file 
+              opref ast 
+      | {ast_info = Ml_mli(source_file1,lazy impl,opref1,source_file2,lazy intf,opref2)}
+        -> 
+        Js_implementation.after_parsing_sig ppf source_file1 opref1 intf ;
+        Js_implementation.after_parsing_impl ppf source_file2 opref2 impl
+      | exception Not_found -> assert false 
+    )
+
+let build_ast_table ppf files parse_implementation parse_interface  =
+  List.fold_left
+    (fun (acc : _ Ast_extract.t String_map.t)
+      source_file ->
+      match Ocaml_parse.check_suffix source_file with
+      | `Ml, opref ->
+        let module_name = module_name_of_file source_file in             
+        begin match String_map.find module_name acc with
+          | exception Not_found ->
+            String_map.add module_name
+              {Ast_extract.ast_info =
+                 (Ml (source_file, parse_implementation
+                        ppf source_file, opref));
+               module_name ;                       
+              } acc
+          | {ast_info = (Ml (source_file2, _, _)
+                        | Ml_mli(source_file2, _, _,_,_,_))} ->
+            Bs_exception.error
+              (Bs_duplicated_module (source_file, source_file2))
+          | {ast_info =  Mli (source_file2, intf, opref2)}
+            ->
+            String_map.add module_name
+              {Ast_extract.ast_info =                     
+                 Ml_mli (source_file,
+                         parse_implementation ppf source_file,
+                         opref,
+                         source_file2,
+                         intf,
+                         opref2                        
+                        );
+               module_name} acc                     
+        end                
+      | `Mli, opref ->
+        let module_name = module_name_of_file source_file in
+        begin match String_map.find module_name acc with
+          | exception Not_found ->
+            String_map.add module_name
+              {Ast_extract.ast_info = (Mli (source_file, parse_interface
+                                              ppf source_file, opref));
+               module_name } acc                      
+          | {ast_info =
+               (Mli (source_file2, _, _) |
+                Ml_mli(_,_,_,source_file2,_,_)) } ->
+            Bs_exception.error
+              (Bs_duplicated_module (source_file, source_file2))
+          | {ast_info = Ml (source_file2, impl, opref2)}
+            ->
+            String_map.add module_name
+              {Ast_extract.ast_info =
+                 Ml_mli
+                   (source_file2,
+                    impl,
+                    opref2,
+                    source_file,
+                    parse_interface ppf source_file,
+                    opref
+                   );
+               module_name} acc                      
+        end              
+    ) String_map.empty files 
+
+
+module String_set = Depend.StringSet
+
+
+let handle_main_file ppf main_file =
+  let dirname = Filename.dirname main_file in
+  let files =
+    Sys.readdir dirname
+    |> Ext_array.to_list_f
+      (fun source_file ->
+         if Ext_string.ends_with source_file ".ml" ||
+            Ext_string.ends_with source_file ".mli" then
+           Some (Filename.concat dirname source_file)
+         else None
+      ) in
+  let ast_table =
+    build_ast_table ppf files
+      Ocaml_parse.lazy_parse_implementation
+      Ocaml_parse.lazy_parse_interface in 
+
+  let visited = Hashtbl.create 31 in
+  let result = Queue.create () in  
+  let next module_name =
+    match String_map.find module_name ast_table with
+    | exception _ -> String_set.empty
+    | {ast_info = Ml (_, lazy impl, _)} ->
+      Ast_extract.read_parse_and_extract Ml_kind impl
+    | {ast_info = Mli (_, lazy intf,_)} ->
+      Ast_extract.read_parse_and_extract Mli_kind intf
+    | {ast_info = Ml_mli(_,lazy impl, _, _, lazy intf, _)}
+      -> 
+      String_set.union
+        (Ast_extract.read_parse_and_extract Ml_kind impl)
+        (Ast_extract.read_parse_and_extract Mli_kind intf)
+  in
+  let rec visit visiting path current =
+    if String_set.mem current visiting  then
+      Bs_exception.error (Bs_cyclic_depends (current::path))
+    else
+    if not (Hashtbl.mem visited current)
+    && String_map.mem current ast_table then
+      begin
+        String_set.iter
+          (visit
+             (String_set.add current visiting)
+             (current::path))
+          (next current) ;
+        Queue.push current result;
+        Hashtbl.add visited current ();
+      end in
+  visit (String_set.empty) [] (module_name_of_file main_file) ;
+  if Js_config.get_diagnose () then
+    Format.fprintf Format.err_formatter
+      "Order: @[%a@]@."
+      (Ext_format.pp_print_queue
+         ~pp_sep:Format.pp_print_space
+         Format.pp_print_string)
+      result ;
+  build_lazy_queue ppf result ast_table;
+  if not (!Clflags.compile_only) then
+    Sys.command
+      ("node " ^ Filename.chop_extension main_file ^ ".js")
+  else 0
+
+let batch_compile ppf files main_file =
+  Compenv.readenv ppf Before_compile; 
+  Compmisc.init_path  false;
   if files <> [] then 
-    begin 
-      Compenv.readenv ppf Before_compile; 
-      Compmisc.init_path  false;
-      let batch_files  : (string, Ast_extract.ast) Hashtbl.t =
-        Hashtbl.create 31 in 
-      files |> List.iter begin fun name -> 
-        match Ocaml_parse.check_suffix name with 
-        | `Ml, opref -> 
-          Hashtbl.add batch_files 
-            name
-            (Ml (Ocaml_parse.parse_implementation ppf name, opref) )
-        | `Mli, opref -> 
-          Hashtbl.add batch_files name
-            (Mli (Ocaml_parse.parse_interface ppf name, opref))
+    begin
+      let ast_table =
+        build_ast_table ppf files
+          Ocaml_parse.parse_implementation
+          Ocaml_parse.parse_interface in
+      build_queue ppf (Ast_extract.sort ast_table) ast_table
+    end        
+  ;
+  if String.length main_file <> 0 then
+    handle_main_file ppf main_file
+  else 0
+
 
-      end;
-      let stack, mapping = Ast_extract.prepare batch_files in 
-      stack |> Queue.iter (fun modname -> 
-          match Hashtbl.find_all mapping modname with
-          | [] -> ()
-          | [sourcefile] -> 
-            begin match Hashtbl.find batch_files sourcefile with
-              | exception _ -> assert false 
-              | Ml (ast,opref) 
-                ->
-                Js_implementation.after_parsing_impl ppf sourcefile 
-                  opref ast 
-              | Mli (ast,opref)  
-                ->
-                Js_implementation.after_parsing_sig ppf sourcefile 
-                  opref ast 
-            end
-          | [sourcefile1;sourcefile2] 
-            -> (* TODO: check duplicated names *)
-            begin match Hashtbl.find batch_files sourcefile1 with 
-              | exception _ -> assert false 
-              | Mli (ast,opref) -> 
-                Js_implementation.after_parsing_sig ppf sourcefile1 opref ast ;
-                begin match Hashtbl.find batch_files sourcefile2 with 
-                  | Ml (ast,opref) -> 
-                    Js_implementation.after_parsing_impl ppf sourcefile2 
-                      opref ast ;
-                  | _ -> assert false 
-                end
-              | Ml (ast0,opref0) -> 
-                begin match Hashtbl.find batch_files sourcefile2 with 
-                  | Mli (ast,opref) -> 
-                    Js_implementation.after_parsing_sig ppf sourcefile2 opref ast ;
-                    Js_implementation.after_parsing_impl ppf sourcefile1 
-                      opref0 ast0 ;
 
-                  | _ -> assert false
-                end
-            end
-          | _ -> assert false 
-        )
-    end
+                    

jscomp/ocaml_batch_compile.mli

@@ -22,4 +22,5 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val batch_compile : Format.formatter -> string list -> unit
+(** reutrn value is the error code *)
+val batch_compile : Format.formatter -> string list -> string ->  int

jscomp/ocaml_parse.ml

@@ -26,12 +26,18 @@ let parse_interface ppf sourcefile =
   let ast = Pparse.parse_interface ~tool_name:Js_config.tool_name ppf sourcefile in
   if !Js_config.no_builtin_ppx_mli then ast else  !Ppx_entry.rewrite_signature ast
 
+let lazy_parse_interface ppf sourcefile =
+  lazy (parse_interface ppf sourcefile)
+
 let parse_implementation ppf sourcefile = 
   let ast = 
     Pparse.parse_implementation ~tool_name:Js_config.tool_name ppf sourcefile in 
   if !Js_config.no_builtin_ppx_ml then ast else
     !Ppx_entry.rewrite_implementation ast 
 
+let lazy_parse_implementation ppf sourcefile =
+  lazy (parse_implementation ppf sourcefile)
+    
 let check_suffix  name  = 
   if Filename.check_suffix name ".ml"
   || Filename.check_suffix name ".mlt" then 

jscomp/ocaml_parse.mli

@@ -26,4 +26,8 @@ val parse_interface : Format.formatter -> string -> Parsetree.signature
 
 val parse_implementation : Format.formatter -> string -> Parsetree.structure
 
+val lazy_parse_interface : Format.formatter -> string -> Parsetree.signature lazy_t
+
+val lazy_parse_implementation : Format.formatter -> string -> Parsetree.structure lazy_t
+    
 val check_suffix :  string -> [> `Ml | `Mli ] * string