Merge pull request #3802 from BuckleScript/simplify_lam_compile_env

simplify get_package_path_from_cmj

Author: bobzhang

jscomp/core/js_cmj_load.ml

@@ -26,33 +26,35 @@
    If not installed, use the distributed [cmj] files, 
    make sure that the distributed files are platform independent
 *)
-let find_cmj file : string * Js_cmj_format.t = 
+
+
+
+#if BS_COMPILER_IN_BROWSER then 
+let find_cmj_exn file : string * Js_cmj_format.t = 
+  let target = Ext_string.uncapitalize_ascii (Filename.basename file) in
+  match String_map.find_exn !Js_cmj_datasets.data_sets target with
+  | v
+    -> 
+    begin match Lazy.force v with
+      | exception _ 
+        -> 
+        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 
+      (* 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 = 
   match Config_util.find_opt file with
   | Some f
     -> 
     f, Js_cmj_format.from_file f             
   | None -> 
     (* ONLY read the stored cmj data in browser environment *)
-#if BS_COMPILER_IN_BROWSER then  
-        "BROWSER", (   
-        let target = Ext_string.uncapitalize_ascii (Filename.basename file) in
-        match String_map.find_exn !Js_cmj_datasets.data_sets target with
-        | v
-          -> 
-          begin match Lazy.force v with
-            | exception _ 
-              -> 
-              Ext_log.warn __LOC__ 
-                "@[%s corrupted in database, when looking %s while compiling %s please update @]"  file target !Location.input_name  ;
-              Js_cmj_format.no_pure_dummy; (* FIXME *)
-            | v ->  v 
-            (* see {!Js_packages_info.string_of_module_id} *)
-          end
-        | exception Not_found 
-          ->     
-          Ext_log.warn __LOC__ "@[%s not found @]" file ;
-          Js_cmj_format.no_pure_dummy )
-#else
-        Bs_exception.error (Cmj_not_found file)
-#end        
+    Bs_exception.error (Cmj_not_found file)
 
+#end

jscomp/core/js_cmj_load.mli

@@ -30,4 +30,4 @@
 
 
 (** return path and meta data *)
-val find_cmj : string -> string * Js_cmj_format.t
+val find_cmj_exn : string -> string * Js_cmj_format.t

jscomp/core/js_name_of_module_id.ml

@@ -113,9 +113,7 @@ let string_of_module_id
           module_system  
       in
       match Lam_compile_env.get_package_path_from_cmj dep_module_id with 
-      | None -> 
-        Bs_exception.error (Missing_ml_dependency dep_module_id.id.name)
-      | Some (cmj_path, dep_package_info, little) -> 
+      | (cmj_path, dep_package_info, little) -> 
         let js_file =  Ext_namespace.js_name_of_modulename dep_module_id.id.name little in 
         let dep_info_query =  
           Js_packages_info.query_package_infos dep_package_info module_system 

jscomp/core/lam_compile_env.ml

@@ -41,7 +41,7 @@ type ml_module_info = {
 
 type env_value = 
   | Visit of ml_module_info
-  | Runtime  of bool * path * Js_cmj_format.t
+  | Runtime  of ml_module_info
   (** 
      [Runtime (pure, path, cmj_format)]
      A built in module probably from our runtime primitives, 
@@ -69,7 +69,10 @@ type ident_info = {
 
 
 
-let cached_tbl  = Lam_module_ident.Hash.create 31
+let cached_tbl  : env_value Lam_module_ident.Hash.t
+   = Lam_module_ident.Hash.create 31
+let (+>) = Lam_module_ident.Hash.add cached_tbl
+
 
 (* For each compilation we need reset to make it re-entrant *)
 let reset () = 
@@ -115,14 +118,14 @@ let add_js_module
 
 
 
-let (+>) = Lam_module_ident.Hash.add cached_tbl
+
 
 let cached_find_ml_id_pos (module_id : Ident.t) name : ident_info =
   let oid  = Lam_module_ident.of_ml module_id in
   match Lam_module_ident.Hash.find_opt cached_tbl oid with 
   | None -> 
     let cmj_path, cmj_table = 
-      Js_cmj_load.find_cmj (module_id.name ^ Literals.suffix_cmj) in
+      Js_cmj_load.find_cmj_exn (module_id.name ^ Literals.suffix_cmj) in
     oid  +> Visit {  cmj_table ; cmj_path  }  ;
     let arity, closed_lambda =        
       Js_cmj_format.query_by_name cmj_table name         
@@ -149,15 +152,13 @@ let cached_find_ml_id_pos (module_id : Ident.t) name : ident_info =
 
 
 
-type module_info = {
-  pure : bool 
-}
+
 (* TODO: it does not make sense to cache
    [Runtime] 
    and [externals]*)
 type _ t = 
   | No_env :  (path * Js_cmj_format.t) t 
-  | Has_env : Env.t  -> module_info t 
+  | Has_env : Env.t  -> bool t (* Indicate it is pure or not *)
 
 
 (* -FIXME: 
@@ -171,25 +172,25 @@ let query_and_add_if_not_exist
     begin match oid.kind with
       | Runtime  -> 
         let (cmj_path, cmj_table) as cmj_info = 
-          Js_cmj_load.find_cmj (Lam_module_ident.name oid ^ Literals.suffix_cmj) in           
-        oid +> Runtime (true,cmj_path,cmj_table) ; 
+          Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) in           
+        oid +> Runtime {cmj_path;cmj_table} ; 
          (match env with 
           | Has_env _ -> 
-            found { pure = true}
+            found true
           | No_env -> 
             found cmj_info)        
       | Ml 
         -> 
         let (cmj_path, cmj_table) as cmj_info = 
-          Js_cmj_load.find_cmj (Lam_module_ident.name oid ^ Literals.suffix_cmj) in           
+          Js_cmj_load.find_cmj_exn (Lam_module_ident.name oid ^ Literals.suffix_cmj) in           
         ( match env with 
           | Has_env env -> 
             begin match 
                 Ocaml_types.find_serializable_signatures_by_path  oid.id env with 
             | None -> not_found () (* actually when [not_found] in the call site, we throw... *)
-            | Some signature -> 
+            | Some _ -> 
               oid +> Visit {cmj_table;cmj_path } ;
-              found  { pure = Js_cmj_format.is_pure cmj_table} 
+              found  (Js_cmj_format.is_pure cmj_table)
             end
           | No_env -> 
             found cmj_info)
@@ -203,7 +204,7 @@ let query_and_add_if_not_exist
         begin match env with 
           | Has_env _ 
             -> 
-            found { pure = false}
+            found false
           | No_env -> 
             found (Ext_string.empty, Js_cmj_format.no_pure_dummy)
             (* FIXME: #154, it come from External, should be okay *)
@@ -213,21 +214,21 @@ let query_and_add_if_not_exist
   | Some (Visit { cmj_table; cmj_path}) -> 
     begin match env with 
       | Has_env _ -> 
-        found   { pure = Js_cmj_format.is_pure cmj_table} 
+        found   (Js_cmj_format.is_pure cmj_table)
       | No_env  -> found (cmj_path,cmj_table)
     end
 
-  | Some (Runtime (pure, cmj_path,cmj_table)) -> 
+  | Some (Runtime {cmj_path; cmj_table}) -> 
     begin match env with 
       | Has_env _ -> 
-        found {pure }
+        found true
       | No_env -> 
         found (cmj_path, cmj_table) 
     end
   | Some External -> 
     begin match env with 
       | Has_env _ -> 
-        found {pure  = false}
+        found false
       | No_env -> 
         found (Ext_string.empty, Js_cmj_format.no_pure_dummy) (* External is okay *)
     end
@@ -237,26 +238,47 @@ let query_and_add_if_not_exist
 
 let get_package_path_from_cmj 
     ( id : Lam_module_ident.t) 
-  : _ option = 
-  query_and_add_if_not_exist id No_env
-    ~not_found:(fun _ ->
-        None
-        (*
-          So after querying, it should return 
-           [Js_packages_info.Package_not_found]
-        *)
-      ) 
-    ~found:(fun (cmj_path,x) -> 
-        Some (cmj_path, 
-              Js_cmj_format.get_npm_package_path x, 
-              Js_cmj_format.get_cmj_case x )
-      )
-
+   = 
+  match Lam_module_ident.Hash.find_opt cached_tbl id with 
+  | Some (Visit {cmj_table ; cmj_path}) -> 
+     (cmj_path, 
+          Js_cmj_format.get_npm_package_path cmj_table, 
+          Js_cmj_format.get_cmj_case cmj_table )
+  | Some (
+   External | 
+   Runtime _ ) -> 
+    assert false  
+      (* called by {!Js_name_of_module_id.string_of_module_id}
+        can not be External
+      *)
+  | None -> 
+    begin match id.kind with 
+    | Runtime 
+    | External _ -> assert false
+    | Ml -> 
+      let (cmj_path, cmj_table) = 
+        Js_cmj_load.find_cmj_exn (Lam_module_ident.name id ^ Literals.suffix_cmj) in           
+      id +> Visit {cmj_table;cmj_path };  
+      (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
 
 
 
+(* let is_pure_module (id : Lam_module_ident.t) = 
+  match id.kind with 
+  | Runtime -> true 
+  | External _ -> false
+  | Ml -> 
+    match Lam_module_ident.Hash.find_opt cached_tbl id with
+    | Some (Visit {cmj_table = {pure}}) -> pure 
+    | Some _ -> assert false 
+    | None ->  *)
+
+
 
 (* Conservative interface *)
 let is_pure_module (id : Lam_module_ident.t)  = 

jscomp/core/lam_compile_env.mli

@@ -37,13 +37,10 @@ type path = string
 
 
 
-type module_info = {
-  pure : bool 
-}
 
 type _ t = 
   | No_env :  (path * Js_cmj_format.t) t 
-  | Has_env : Env.t  -> module_info t 
+  | Has_env : Env.t  -> bool t 
 
 
 type ident_info = {
@@ -109,7 +106,7 @@ val is_pure_module : Lam_module_ident.t -> bool
 
 val get_package_path_from_cmj : 
   Lam_module_ident.t -> 
-  (string * Js_packages_info.t * Js_cmj_format.cmj_case) option
+  (string * Js_packages_info.t * Js_cmj_format.cmj_case) 
 
 
 

jscomp/core/lam_stats_export.ml

@@ -113,7 +113,7 @@ let get_dependent_module_effect
            Lam_compile_env.query_and_add_if_not_exist id 
              (Has_env meta.env )
              ~not_found:(fun _ -> false ) 
-             ~found:(fun {pure} -> pure)
+             ~found:(fun pure -> pure)
         ) in 
     Ext_option.map  non_pure_module (fun x -> Lam_module_ident.name x)
   else