fix cyclic dependencies #528

jscomp/bs_exception.ml → jscomp/common/bs_exception.ml

@@ -25,20 +25,26 @@
 
 type error =
   | Cmj_not_found of string
-
+  | Bs_cyclic_depends of string  list
+
 exception Error of error
 
 let error err = raise (Error err)
 
 let report_error ppf = function
   | Cmj_not_found s ->
     Format.fprintf ppf "%s not found, cmj format is generated by BuckleScript" s
-
+  | Bs_cyclic_depends  str
+    ->
+    Format.fprintf ppf "Cyclic depends : @[%a@]"
+      (Format.pp_print_list ~pp_sep:Format.pp_print_space
+         Format.pp_print_string)
+      str       
 
 let () =
   Location.register_error_of_exn
     (function
-      | Error (Cmj_not_found _ as err)
+      | Error err
         -> Some (Location.error_of_printer_file report_error err)
       | _ -> None
     )

jscomp/bs_exception.mli → jscomp/common/bs_exception.mli

@@ -24,6 +24,6 @@
 
 type error =
   | Cmj_not_found of string
-
+  | Bs_cyclic_depends of string  list
 
 val error : error -> 'a 

jscomp/common/common.mllib

@@ -2,4 +2,5 @@ js_config
 literals
 ext_log
 bs_loc
+bs_exception
 lam_methname

jscomp/core.mllib

@@ -44,7 +44,7 @@ lam_dce
 lam_analysis
 lam_group
 
-bs_exception
+
 
 j
 js_ast_util

jscomp/js_implementation.ml

@@ -26,7 +26,9 @@ let print_if ppf flag printer arg =
   if !flag then fprintf ppf "%a@." printer arg;
   arg
 
-let after_parsing_sig ppf sourcefile outputprefix ast  = 
+let after_parsing_sig ppf sourcefile outputprefix ast  =
+  if Js_config.get_diagnose () then
+    Format.fprintf Format.err_formatter "Building %s@." sourcefile;    
   let modulename = module_of_filename ppf sourcefile outputprefix in
   let initial_env = Compmisc.initial_env () in
   Env.set_unit_name modulename;
@@ -54,6 +56,8 @@ let interface ppf sourcefile outputprefix =
   |> after_parsing_sig ppf sourcefile outputprefix 
 
 let after_parsing_impl ppf sourcefile outputprefix ast =
+  if Js_config.get_diagnose () then
+    Format.fprintf Format.err_formatter "Building %s@." sourcefile;      
   let modulename = Compenv.module_of_filename ppf sourcefile outputprefix in
   let env = Compmisc.initial_env() in
   Env.set_unit_name modulename;

jscomp/syntax/ast_extract.ml

@@ -48,14 +48,6 @@ type  info =
     ast : ast
   }
 
-let file_dependencies (files : (info * Depend.StringSet.t) list ref)
-    source_file ast  =
-  let extracted_deps =
-    read_parse_and_extract ast 
-     (  match ast with
-     | Ml (ast,_) -> fun set _ ->  Depend.add_implementation set ast 
-     | Mli (ast,_) -> fun set _ ->   Depend.add_signature set ast ) in
-  files := ({source_file ; ast }, extracted_deps) :: !files
 
 
 let normalize tbl file  =
@@ -89,47 +81,64 @@ let merge tbl (files : (info * Depend.StringSet.t) list ) :
     ) files  ;
   local_tbl
 
-
+exception Cyclic_dependends of string list
+
 let sort_files_by_dependencies tbl files
-    =
-  let h = merge tbl files in
-  let worklist = Ext_list.create_ref_empty () in
-  let ()= 
-    Hashtbl.iter (fun key _     ->  Ext_list.ref_push key worklist) h in
+  =
+  let h : (string, Depend.StringSet.t) Hashtbl.t = merge tbl files in
+  let next current =
+    Depend.StringSet.elements (Hashtbl.find h current) in    
+  let worklist = 
+    ref (Hashtbl.fold
+           (fun key _  acc ->
+              String_set.add key acc) h String_set.empty) in
+
   let result = Ext_list.create_ref_empty () in
-  let visited = Hashtbl.create 31 in
-  while not @@ Ext_list.ref_empty worklist do 
-    let current = Ext_list.ref_top worklist  in 
+  let visited = Hashtbl.create 31 in (* Temporary mark *)  
+
+  (* only visit nodes that are currently in the domain *)
+  (* https://en.wikipedia.org/wiki/Topological_sorting *)
+  (* dfs   *)
+  let rec visit path current =
     if Hashtbl.mem visited current then
-      ignore (Ext_list.ref_pop worklist)
-    else 
-      match Depend.StringSet.elements (Hashtbl.find h current) with 
-      | depends -> 
-          let really_depends = 
-            List.filter 
-              (fun x ->  (Hashtbl.mem h x && (not (Hashtbl.mem visited x ))))
-              depends in
-          begin match really_depends with 
-          |[] -> 
-            begin
-              let v = Ext_list.ref_pop worklist in 
-              Hashtbl.add visited  v () ;
-              Ext_list.ref_push current result 
-            end
-          | _ -> 
-              List.iter  (fun x -> Ext_list.ref_push x worklist) really_depends
-          end
-      | exception Not_found ->  assert false 
+      Bs_exception.error (Bs_cyclic_depends path)
+    else if String_set.mem current !worklist then
+      begin
+        Hashtbl.add visited current () ;
+        let depends = next current in
+        List.iter
+          (fun node ->
+             if  Hashtbl.mem h node then
+               visit (current::path) node)
+          depends ;
+        worklist := String_set.remove  current !worklist;
+        Ext_list.ref_push current result ;
+        Hashtbl.remove visited current;
+      end in        
+  while not (String_set.is_empty !worklist) do 
+    visit  [] (String_set.choose !worklist)
   done;
-  result
+  if Js_config.get_diagnose () then
+    Format.fprintf Format.err_formatter
+      "Reverse order: @[%a@]@."    
+      (Format.pp_print_list ~pp_sep:Format.pp_print_space Format.pp_print_string)
+      !result ;       
+  !result
 ;;
 
 
 
 let prepare  ast_table = 
-  let tbl = Hashtbl.create 31 in 
-  let files = ref [] in
-  Hashtbl.iter (fun sourcefile ast  -> file_dependencies files sourcefile ast) ast_table;
-  let stack = sort_files_by_dependencies tbl !files in 
-  !stack, tbl 
+  let file_dependencies 
+      source_file ast  acc =
+    let extracted_deps =
+      read_parse_and_extract ast 
+        (  match ast with
+           | Ml (ast,_) -> fun set _ ->  Depend.add_implementation set ast 
+           | Mli (ast,_) -> fun set _ ->   Depend.add_signature set ast ) in
+    ({source_file ; ast }, extracted_deps) :: acc  in
+  let files = Hashtbl.fold file_dependencies ast_table []  in
+  let tbl = Hashtbl.create 31 in   
+  let stack = sort_files_by_dependencies tbl files in 
+  stack, tbl 
 

jscomp/syntax/syntax.mllib

@@ -12,4 +12,4 @@ ast_structure
 ast_derive
 ast_signature
 ast_core_type
-ast_external_attributes
+ast_external_attributes

jscomp/test/.depend

@@ -107,8 +107,6 @@ class7_test.cmj : ../stdlib/oo.cmi mt.cmi
 class7_test.cmx : ../stdlib/oo.cmx mt.cmx
 class8_test.cmj : mt.cmi
 class8_test.cmx : mt.cmx
-class_ffi.cmj :
-class_ffi.cmx :
 class_repr.cmj : ../stdlib/oo.cmi
 class_repr.cmx : ../stdlib/oo.cmx
 class_setter_getter.cmj : ../runtime/js.cmj class_setter_getter.cmi
@@ -845,8 +843,6 @@ class7_test.cmo : ../stdlib/oo.cmi mt.cmi
 class7_test.cmj : ../stdlib/oo.cmj mt.cmj
 class8_test.cmo : mt.cmi
 class8_test.cmj : mt.cmj
-class_ffi.cmo :
-class_ffi.cmj :
 class_repr.cmo : ../stdlib/oo.cmi
 class_repr.cmj : ../stdlib/oo.cmj
 class_setter_getter.cmo : ../runtime/js.cmo class_setter_getter.cmi

jscomp/test/test_case_set.ml

@@ -2,7 +2,7 @@
 
 
 let f x = 
-  x##case 3 #= 3 
+  x##case #= 3 
 
 let g x = 
-  x#.item 3
+  x#item 3