fix #5154

bobzhang · bobzhang · commit 19ac7d47e515 · 2021-05-30T11:36:44.000+08:00
diff --git a/jscomp/bsb/bsb_ninja_check.ml b/jscomp/bsb/bsb_ninja_check.ml
@@ -106,11 +106,7 @@ let record
   let buf = Ext_buffer.create 1_000 in   
   Ext_buffer.add_string_char buf Bs_version.version '\n';  
   Ext_buffer.add_string_char buf per_proj_dir '\n';
-  (match package_kind with 
-   | Toplevel -> Ext_buffer.add_string buf "0\n"
-   | Dependency _ -> Ext_buffer.add_string buf "1\n"
-   | Pinned_dependency _ -> Ext_buffer.add_string buf "2\n"
-  );
+  Ext_buffer.add_string_char buf (Bsb_package_kind.encode_no_nl package_kind) '\n';
   Ext_list.iter file_or_dirs (fun f -> 
       Ext_buffer.add_string_char buf f '\t'; 
       Ext_buffer.add_string_char buf 
@@ -147,12 +143,7 @@ let check
       if per_proj_dir <> source_directory then Bsb_source_directory_changed else
       if forced then Bsb_forced (* No need walk through *)
       else if 
-
-        not (match package_kind, package_kind_str with 
-            | Toplevel, "0" 
-            | Dependency _, "1"
-            | Pinned_dependency _, "2" -> true 
-            | _ -> false ) then 
+         (Bsb_package_kind.encode_no_nl package_kind <> package_kind_str) then 
         Bsb_package_kind_inconsistent
       else
         begin 
diff --git a/jscomp/bsb/bsb_package_kind.ml b/jscomp/bsb/bsb_package_kind.ml
@@ -29,3 +29,16 @@ type t =
   (*  This package specs comes from the toplevel to 
       override the current settings
   *)
+
+
+let encode_no_nl ( x : t) = 
+  match x with 
+  | Toplevel -> "0"
+  | Dependency x -> 
+    "1" ^ 
+    Bsb_package_specs.package_flag_of_package_specs x 
+      ~dirname:"."  
+  | Pinned_dependency x -> 
+    "2" ^ 
+    Bsb_package_specs.package_flag_of_package_specs x 
+      ~dirname:"."  
diff --git a/jscomp/bsb/bsb_package_specs.ml b/jscomp/bsb/bsb_package_specs.ml
@@ -27,20 +27,10 @@ let (//) = Ext_path.combine
 
 
 
-(* TODO: sync up with {!Js_packages_info.module_system}  *)
-type format = Ext_module_system.t = 
-  | NodeJS | Es6 | Es6_global
-
-type spec = {
-  format : format;
-  in_source : bool;
-  suffix : Ext_js_suffix.t 
-}
+
 
 (*FIXME: use assoc list instead *)
-module Spec_set = Set.Make( struct type t = spec 
-    let compare = Pervasives.compare 
-  end)
+module Spec_set = Bsb_spec_set
 
 type t = {
   modules : Spec_set.t;
@@ -59,13 +49,13 @@ let bad_module_format_message_exn ~loc format =
     Literals.es6
     Literals.es6_global
 
-let supported_format (x : string) loc = 
+let supported_format (x : string) loc : Ext_module_system.t = 
   if x = Literals.commonjs then NodeJS
   else if x = Literals.es6 then Es6
   else if x = Literals.es6_global then Es6_global
   else bad_module_format_message_exn ~loc x 
 
-let string_of_format (x : format) =
+let string_of_format (x : Ext_module_system.t) =
   match x with 
   | NodeJS -> Literals.commonjs
   | Es6 -> Literals.es6
@@ -91,7 +81,7 @@ let rec from_array suffix (arr : Ext_json_types.t array) : Spec_set.t =
   !spec
 
 (* TODO: FIXME: better API without mutating *)
-and from_json_single suffix (x : Ext_json_types.t) : spec =
+and from_json_single suffix (x : Ext_json_types.t) : Bsb_spec_set.spec =
   match x with
   | Str {str = format; loc } ->    
     {format = supported_format format loc  ; in_source = false ; suffix }    
@@ -136,7 +126,7 @@ let bs_package_output = "-bs-package-output"
     coordinate with command line flag 
     {[ -bs-package-output commonjs:lib/js/jscomp/test:.js ]}    
 *)
-let package_flag ({format; in_source; suffix } : spec) dir =
+let package_flag ({format; in_source; suffix } : Bsb_spec_set.spec) dir =
   Ext_string.inter2
     bs_package_output 
     (Ext_string.concat5
@@ -151,13 +141,30 @@ let package_flag ({format; in_source; suffix } : spec) dir =
 (* FIXME: we should adapt it *)    
 let package_flag_of_package_specs (package_specs : t) 
     ~(dirname : string ) : string  = 
-  let res = Spec_set.fold (fun format acc ->
-      Ext_string.inter2 acc (package_flag format dirname )
-    ) package_specs.modules Ext_string.empty in 
+  let res =
+    match (package_specs.modules :> Bsb_spec_set.spec list) with 
+    | [] -> Ext_string.empty 
+    | [format] -> 
+      Ext_string.inter2 Ext_string.empty (package_flag format dirname)
+    | [a;b] -> 
+      Ext_string.inter3 Ext_string.empty 
+        (package_flag a dirname) 
+        (package_flag b dirname)
+    | [a;b;c] -> 
+      Ext_string.inter4
+        Ext_string.empty
+        (package_flag a dirname) 
+        (package_flag b dirname)  
+        (package_flag c dirname)
+    | _ ->  
+      Spec_set.fold (fun format acc ->
+          Ext_string.inter2 acc (package_flag format dirname )
+        ) package_specs.modules Ext_string.empty in 
   match package_specs.runtime with 
   | None -> res
   | Some x -> 
-    res ^ " -runtime " ^ x 
+    Ext_string.inter3 res "-runtime" x 
+
 let default_package_specs suffix = 
   Spec_set.singleton 
     { format = NodeJS ; in_source = false; suffix  }
@@ -173,7 +180,7 @@ let get_list_of_output_js
     (output_file_sans_extension : string)
   = 
   Spec_set.fold 
-    (fun (spec : spec) acc ->
+    (fun (spec : Bsb_spec_set.spec) acc ->
        let basename =  
          Ext_namespace.change_ext_ns_suffix
            output_file_sans_extension
@@ -189,7 +196,7 @@ let list_dirs_by
     (package_specs : t)
     (f : string -> unit)
   =  
-  Spec_set.iter (fun (spec : spec)  -> 
+  Spec_set.iter (fun (spec : Bsb_spec_set.spec)  -> 
       if not spec.in_source then     
         f (Bsb_config.top_prefix_of_format spec.format) 
     ) package_specs.modules 
diff --git a/jscomp/bsb/bsb_spec_set.ml b/jscomp/bsb/bsb_spec_set.ml
@@ -0,0 +1,89 @@
+(* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+[@@@warning "+9"] 
+(* TODO: sync up with {!Js_packages_info.module_system}  *)
+type format = Ext_module_system.t = 
+  | NodeJS | Es6 | Es6_global
+
+type spec = {
+  format : format;
+  in_source : bool;
+  suffix : Ext_js_suffix.t 
+}
+type t = spec list 
+
+let cmp (s1 : spec) ({format;in_source;suffix} : spec) = 
+  let v = compare s1.format format in 
+  if v  <> 0 then v 
+  else 
+    let v = compare s1.in_source in_source in 
+    if v <> 0 then v 
+    else 
+      compare s1.suffix suffix 
+
+let empty = []
+
+let rec insert lst piviot = 
+  match lst with 
+  | [] -> [piviot]
+  | x::xs -> 
+    let v = cmp piviot x in 
+    if v = 0 then lst 
+    else if v < 0 then piviot :: lst 
+    else 
+      x :: insert xs piviot
+
+let add spec specs = 
+  match specs with 
+  | [] -> [spec]
+  | [a] -> 
+    let v =  cmp spec a in 
+    if v < 0 then spec :: specs 
+    else if v = 0 then specs 
+    else [a; spec]
+  | [a;b] -> 
+    let v = cmp spec a in 
+    if v < 0 then spec :: specs 
+    else if v = 0 then specs 
+    else 
+      let v1 = cmp spec b in 
+      if v < 0 then [a;spec;b]
+      else if v1 = 0 then specs
+      else 
+        [a;b;spec]
+  | _::_::_::_   -> (* unlikely to happen *)      
+    insert specs spec
+
+let singleton x = [x]
+
+let rec fold f t acc = 
+  match t with 
+  | [] -> acc 
+  | x::xs -> fold f xs (f x acc)
+
+let rec iter f t = 
+  match t with 
+  | [] -> ()
+  | x::xs -> f x ; iter f xs   
diff --git a/jscomp/bsb/bsb_spec_set.mli b/jscomp/bsb/bsb_spec_set.mli
@@ -0,0 +1,36 @@
+(* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript
+ * 
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ * 
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+type format = Ext_module_system.t
+type spec = {
+  format : format;
+  in_source : bool;
+  suffix : Ext_js_suffix.t 
+}
+
+type  t = private spec list 
+val empty : t 
+val add : spec -> t  ->  t
+val singleton : spec -> t 
+val fold : (spec -> 'a -> 'a) -> t -> 'a -> 'a
+val iter : (spec -> unit) ->t -> unit
diff --git a/jscomp/main/rescript_main.ml b/jscomp/main/rescript_main.ml
@@ -141,7 +141,7 @@ let build_subcommand ~start  argv argv_len =
     "-install", unit_set_spec do_install,
     "*internal* Install public interface files for dependencies ";
     (* This should be put in a subcommand
-      previously it works with the implication `bsb && bsb -install`
+       previously it works with the implication `bsb && bsb -install`
     *)
     "-ws", string_set_spec (ref ""),
     "[host]:port set up host & port for WebSocket build notifications";
@@ -183,7 +183,9 @@ let clean_subcommand ~start argv =
   Bsb_arg.parse_exn 
     ~usage:clean_usage ~start ~argv [|
     "-with-deps", unit_set_spec make_world,
-    "Clean dependencies too"
+    "Clean dependencies too";
+    "-verbose", call_spec Bsb_log.verbose,
+    "Set the output to be verbose";
   |] failed_annon;
   if !make_world then 
     Bsb_clean.clean_bs_deps Bsb_global_paths.cwd ; 
