Merge pull request #3816 from BuckleScript/clean_up

bobzhang · web-flow · commit 12e13dc85ac0 · 2019-09-12T13:19:41.000+08:00
clean up &amp;&amp; make is_pure_module forgiving when not found
diff --git a/jscomp/core/js_cmj_format.ml b/jscomp/core/js_cmj_format.ml
@@ -67,21 +67,7 @@ let cmj_magic_number =  "BUCKLE20171012"
 let cmj_magic_number_length = 
   String.length cmj_magic_number
 
-let pure_dummy = 
-  {
-    values = empty_values;
-    pure = true;
-    npm_package_path = Js_packages_info.empty;
-    cmj_case = Little_js;
-  }
 
-let no_pure_dummy = 
-  {
-    values = empty_values;
-    pure = false;
-    npm_package_path = Js_packages_info.empty;  
-    cmj_case = Little_js; (** TODO: consistent with Js_config.bs_suffix default *)
-  }
 
 let digest_length = 16 (*16 chars *)
 
diff --git a/jscomp/core/js_cmj_format.mli b/jscomp/core/js_cmj_format.mli
@@ -93,8 +93,7 @@ val get_cmj_case :
   cmj_case 
 
 val single_na : arity
-val pure_dummy : t
-val no_pure_dummy : t
+
 
 
 val from_file : string -> t
diff --git a/jscomp/core/js_cmj_load.ml b/jscomp/core/js_cmj_load.ml
@@ -28,9 +28,14 @@
 *)
 
 
+type path = string  
+type cmj_load_info = {
+  cmj_table : Js_cmj_format.t ; 
+  cmj_path : path ;
+}
 
 #if BS_COMPILER_IN_BROWSER then 
-let find_cmj_exn file : string * Js_cmj_format.t = 
+let find_cmj_exn file : cmj_load_info = 
   let target = Ext_string.uncapitalize_ascii (Filename.basename file) in
   match String_map.find_exn !Js_cmj_datasets.data_sets target with
   | v
@@ -41,18 +46,18 @@ let find_cmj_exn file : string * Js_cmj_format.t =
         Ext_log.warn __LOC__ 
           "@[%s corrupted in database, when looking %s while compiling %s please update @]"  file target !Location.input_name  ;
         Bs_exception.error (Cmj_not_found file)
-      | v ->  "BROWSER", v 
+      | v ->  {cmj_path = "BROWSER"; cmj_table = v} 
       (* see {!Js_packages_info.string_of_module_id} *)
     end
   | exception Not_found 
     ->     
     Bs_exception.error (Cmj_not_found file)
 #else    
-let find_cmj_exn file : string * Js_cmj_format.t = 
+let find_cmj_exn file : cmj_load_info = 
   match Config_util.find_opt file with
   | Some f
     -> 
-    f, Js_cmj_format.from_file f             
+    {cmj_path = f; cmj_table =  Js_cmj_format.from_file f}
   | None -> 
     (* ONLY read the stored cmj data in browser environment *)
     Bs_exception.error (Cmj_not_found file)
diff --git a/jscomp/core/js_cmj_load.mli b/jscomp/core/js_cmj_load.mli
@@ -27,7 +27,13 @@
     it depends on {!Js_cmj_datasets}, for non-browser environment, it fails
  *)
 
-
+type path = string  
+type cmj_load_info = {
+  cmj_table : Js_cmj_format.t ; 
+  cmj_path : path ;
+}
 
 (** return path and meta data *)
-val find_cmj_exn : string -> string * Js_cmj_format.t
+val find_cmj_exn : 
+   string -> 
+   cmj_load_info
diff --git a/jscomp/core/js_fold.ml b/jscomp/core/js_fold.ml
@@ -400,10 +400,17 @@ class virtual fold =
     {[ goto : label option ; ]}
   *)
         'a. ('self_type -> 'a -> 'self_type) -> 'a case_clause -> 'self_type =
-      fun _f_a { switch_case = _x; switch_body = _x_i1; should_break = _x_i2
+      fun _f_a
+        {
+          switch_case = _x;
+          switch_body = _x_i1;
+          should_break = _x_i2;
+          comment = _x_i3
         } ->
         let o = _f_a o _x in
-        let o = o#block _x_i1 in let o = o#bool _x_i2 in o
+        let o = o#block _x_i1 in
+        let o = o#bool _x_i2 in
+        let o = o#option (fun o -> o#string) _x_i3 in o
     method block : block -> 'self_type = (* true means break *)
       (* TODO: For efficency: block should not be a list, it should be able to 
    be concatenated in both ways 
diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml
@@ -22,10 +22,14 @@ let fprintf = Format.fprintf
 
 
 
-let print_if ppf flag printer arg =
+let print_if_pipe ppf flag printer arg =
   if !flag then fprintf ppf "%a@." printer arg;
   arg
 
+let print_if ppf flag printer arg =
+  if !flag then fprintf ppf "%a@." printer arg
+  
+
 
 let process_with_gentype filename =    
   match !Clflags.bs_gentype with
@@ -103,15 +107,15 @@ let interface ppf fname outputprefix =
   Compmisc.init_path false;
   Pparse.parse_interface ~tool_name:Js_config.tool_name ppf fname
   |> Ppx_entry.rewrite_signature
-  |> print_if ppf Clflags.dump_parsetree Printast.interface
-  |> print_if ppf Clflags.dump_source Pprintast.signature 
+  |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface
+  |> print_if_pipe ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf  outputprefix 
 
 let interface_mliast ppf fname outputprefix  = 
   Compmisc.init_path false;
   Binary_ast.read_ast Mli fname 
-  |> print_if ppf Clflags.dump_parsetree Printast.interface
-  |> print_if ppf Clflags.dump_source Pprintast.signature 
+  |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface
+  |> print_if_pipe ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf  outputprefix 
 
 
@@ -140,43 +144,41 @@ let after_parsing_impl ppf  outputprefix ast =
       Lam_compile_env.reset () ;
       let env = Compmisc.initial_env() in
       Env.set_unit_name modulename;
-
       let (typedtree, coercion, _, _) =
-        ast 
-        |> Typemod.type_implementation_more ?check_exists:(if !Js_config.force_cmi then None else Some ()) !Location.input_name outputprefix modulename env 
-        |> print_if ppf Clflags.dump_typedtree
-          (fun fmt (ty,co,_,_) -> Printtyped.implementation_with_coercion fmt  (ty,co))
-      in
+        Typemod.type_implementation_more 
+          ?check_exists:(if !Js_config.force_cmi then None else Some ()) 
+          !Location.input_name outputprefix modulename env ast  in 
+      let typedtree_coercion = (typedtree, coercion) in        
+      print_if ppf Clflags.dump_typedtree
+        Printtyped.implementation_with_coercion  typedtree_coercion ;
       if !Clflags.print_types || !Js_config.cmi_only then begin
         Warnings.check_fatal ();
       end else begin
-        (typedtree, coercion)
-        |> Translmod.transl_implementation modulename
-        |> (fun lambda -> 
-            let js_program =  
-            print_if ppf Clflags.dump_rawlambda Printlambda.lambda (get_lambda lambda)
-            |> Lam_compile_main.compile outputprefix in 
-            if not !Js_config.cmj_only then 
-              Lam_compile_main.lambda_as_module
-                js_program
-                outputprefix 
-          );
+        let lambda = Translmod.transl_implementation modulename typedtree_coercion in 
+        let js_program =  
+          print_if_pipe ppf Clflags.dump_rawlambda Printlambda.lambda (get_lambda lambda)
+          |> Lam_compile_main.compile outputprefix in 
+        if not !Js_config.cmj_only then 
+          Lam_compile_main.lambda_as_module
+            js_program
+            outputprefix 
+        ;
       end;
       process_with_gentype (outputprefix ^ ".cmt")        
     end
 let implementation ppf fname outputprefix =
   Compmisc.init_path false;
   Pparse.parse_implementation ~tool_name:Js_config.tool_name ppf fname
   |> Ppx_entry.rewrite_implementation
-  |> print_if ppf Clflags.dump_parsetree Printast.implementation
-  |> print_if ppf Clflags.dump_source Pprintast.structure
+  |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
+  |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf outputprefix 
 
 let implementation_mlast ppf fname outputprefix = 
   Compmisc.init_path false;
   Binary_ast.read_ast Ml fname
-  |> print_if ppf Clflags.dump_parsetree Printast.implementation
-  |> print_if ppf Clflags.dump_source Pprintast.structure
+  |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
+  |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf  outputprefix 
 
 
@@ -212,7 +214,7 @@ let implementation_map ppf sourcefile outputprefix =
     )  in 
   Compmisc.init_path false;
   ml_ast
-  |> print_if ppf Clflags.dump_parsetree Printast.implementation
-  |> print_if ppf Clflags.dump_source Pprintast.structure
+  |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
+  |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf outputprefix 
 
diff --git a/jscomp/core/lam_compile_env.ml b/jscomp/core/lam_compile_env.ml
@@ -32,16 +32,10 @@
 module E = Js_exp_make  
 module S = Js_stmt_make
 
-type path = string 
-
-type ml_module_info = { 
-  cmj_table : Js_cmj_format.t ;
-  cmj_path : path;
-}
 
 type env_value = 
-  | Ml of ml_module_info
-  | Runtime  of ml_module_info
+  | Ml of Js_cmj_load.cmj_load_info
+  | Runtime  of Js_cmj_load.cmj_load_info
   (** 
      [Runtime (pure, path, cmj_format)]
      A built in module probably from our runtime primitives, 
@@ -124,10 +118,10 @@ let query_external_id_info (module_id : Ident.t) (name : string) : ident_info =
   let cmj_table = 
     match Lam_module_ident.Hash.find_opt cached_tbl oid with 
     | None -> 
-      let cmj_path, cmj_table = 
+      let cmj_load_info = 
         Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) in
-      oid  +> Ml {  cmj_table ; cmj_path  }  ;
-      cmj_table
+      oid  +> Ml cmj_load_info  ;
+      cmj_load_info.cmj_table
     | Some (Ml { cmj_table } )
       -> cmj_table
     | Some (Runtime _) -> assert false
@@ -145,50 +139,9 @@ let query_external_id_info (module_id : Ident.t) (name : string) : ident_info =
 
 
 
-(* TODO: it does not make sense to cache
-   [Runtime] 
-   and [externals]*)
-type _ t = 
-  | No_env :  bool t 
-  | Has_env : Env.t  -> bool t (* Indicate it is pure or not *)
 
 
-(* 
-  FIXME: 
-  Here [not_found] only means cmi not found, not cmj not found
-  We do need handle cases when [not_found] hit in a graceful way
-*)
-let query_and_add_if_not_exist 
-    (type u)
-    (oid : Lam_module_ident.t) 
-     =
-  match Lam_module_ident.Hash.find_opt cached_tbl oid with 
-  | None -> 
-    begin match oid.kind with
-      | Runtime  -> 
-        let (cmj_path, cmj_table) as cmj_info = 
-          Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) in           
-        oid +> Runtime {cmj_path;cmj_table} ; 
-        Js_cmj_format.is_pure cmj_table
-      | Ml 
-        -> 
-        let (cmj_path, cmj_table) as cmj_info = 
-          Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) in           
-        oid +> Ml {cmj_table;cmj_path } ;
-        Js_cmj_format.is_pure cmj_table
-      | External _  -> 
-        oid +> External;
-        (** This might be wrong, if we happen to expand  an js module
-            we should assert false (but this in general should not happen)
-            FIXME: #154, it come from External, should be okay
-        *)
-        false
-    end
-  | Some (Ml { cmj_table }) 
-  | Some (Runtime {cmj_table}) -> 
-    Js_cmj_format.is_pure cmj_table
-  | Some External -> false
-  
+
 
 
 
@@ -213,21 +166,37 @@ let get_package_path_from_cmj
     | Runtime 
     | External _ -> assert false
     | Ml -> 
-      let (cmj_path, cmj_table) = 
+      let ({Js_cmj_load.cmj_table} as cmj_load_info) = 
         Js_cmj_load.find_cmj_exn (Lam_module_ident.name id ^ Literals.suffix_cmj) in           
-      id +> Ml {cmj_table;cmj_path };  
-      (cmj_path, 
+      id +> Ml cmj_load_info;  
+      (cmj_load_info.cmj_path, 
        Js_cmj_format.get_npm_package_path cmj_table, 
        Js_cmj_format.get_cmj_case cmj_table )              
     end 
 
 let add = Lam_module_ident.Hash_set.add
 
 
+
 (* Conservative interface *)
-let is_pure_module (id : Lam_module_ident.t)  = 
-  id.kind = Runtime ||
-  query_and_add_if_not_exist id 
+let is_pure_module (oid : Lam_module_ident.t)  = 
+  match oid.kind with 
+  | Runtime -> true 
+  | External _ -> false
+  | Ml  -> 
+    begin match Lam_module_ident.Hash.find_opt cached_tbl oid with 
+    | None -> 
+      begin 
+        match Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) with
+        | cmj_load_info -> 
+          oid +> Ml cmj_load_info ;
+          Js_cmj_format.is_pure cmj_load_info.cmj_table
+        | exception _ -> false 
+      end 
+    | Some (Ml{cmj_table}|Runtime {cmj_table}) ->
+       Js_cmj_format.is_pure cmj_table
+    | Some External ->  false
+    end 
     
 
 let get_required_modules 
diff --git a/jscomp/core/lam_compile_env.mli b/jscomp/core/lam_compile_env.mli
@@ -24,23 +24,10 @@
 
 
 
-
-
-
-
-
 (** Helper for global Ocaml module index into meaningful names  *) 
 
 
 
-type path = string 
-
-
-
-
-type _ t = 
-  | No_env  : bool t 
-  | Has_env : Env.t  -> bool t 
 
 
 type ident_info = {
diff --git a/lib/4.02.3/unstable/js_compiler.ml b/lib/4.02.3/unstable/js_compiler.ml
diff --git a/lib/4.02.3/whole_compiler.ml b/lib/4.02.3/whole_compiler.ml
