Merge pull request #4428 from BuckleScript/fix_4426

bobzhang · web-flow · commit fef665e49659 · 2020-06-01T10:10:51.000+08:00
fix #4426
diff --git a/jscomp/syntax/ast_literal.ml b/jscomp/syntax/ast_literal.ml
@@ -134,6 +134,10 @@ let type_int64 =
   Ast_helper.Typ.mk   
     (Ptyp_constr ({ txt = Lident "int64"; loc = Location.none}, []))  
 
+let type_float =     
+  Ast_helper.Typ.mk   
+    (Ptyp_constr ({ txt = Lident "float"; loc = Location.none}, []))  
+
 let type_any ?loc () =
   match loc with
   | None -> No_loc.type_any
diff --git a/jscomp/syntax/ast_literal.mli b/jscomp/syntax/ast_literal.mli
@@ -62,6 +62,7 @@ val type_string : core_type_lit
 val type_bool : core_type_lit
 val type_int : core_type_lit 
 val type_int64 : Parsetree.core_type
+val type_float : Parsetree.core_type
 val type_any : core_type_lit
 
 val pat_unit : pattern_lit
diff --git a/jscomp/syntax/bs_builtin_ppx.ml b/jscomp/syntax/bs_builtin_ppx.ml
@@ -259,7 +259,14 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) =
                     value_desc with 
                     pval_prim = External_ffi_types.inline_int64_primitive s;
                     pval_attributes = [];
-                  } }  
+                  } }
+              | Pexp_constant (Pconst_float(s,None)) -> 
+                Bs_ast_invariant.warn_discarded_unused_attributes pval_attributes; 
+                {sigi with psig_desc = Psig_value  {
+                    value_desc with 
+                    pval_prim = External_ffi_types.inline_float_primitive s;
+                    pval_attributes = [];
+                  } }
               | Pexp_construct ({txt = Lident ("true" | "false" as txt)}, None)       
                 -> 
                 Bs_ast_invariant.warn_discarded_unused_attributes pval_attributes;
@@ -338,6 +345,16 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) =
                pval_attributes = [];
                pval_prim = External_ffi_types.inline_int64_primitive s
              } }             
+        | Pexp_constant(Pconst_float (s, None))
+          ->
+          Bs_ast_invariant.warn_discarded_unused_attributes pvb_attributes; 
+          {str with pstr_desc = Pstr_primitive  {
+               pval_name = pval_name ;
+               pval_type = Ast_literal.type_float; 
+               pval_loc = pvb_loc;
+               pval_attributes = [];
+               pval_prim = External_ffi_types.inline_float_primitive s
+             } }                 
         | Pexp_construct ({txt = Lident ("true" | "false" as txt) },None) -> 
           Bs_ast_invariant.warn_discarded_unused_attributes pvb_attributes; 
           {str with pstr_desc = Pstr_primitive  {
diff --git a/jscomp/syntax/external_ffi_types.ml b/jscomp/syntax/external_ffi_types.ml
@@ -316,6 +316,11 @@ let inline_int64_primitive (i : int64) : string list =
         (Const_int64 i))
   ]
 
+let inline_float_primitive (i : string) : string list =
+  ["";
+    to_string 
+      (Ffi_inline_const (Const_float i))
+  ]    
 let rec ffi_bs_aux acc (params : External_arg_spec.params) = 
   match params with 
   | {arg_type = Nothing; arg_label = Arg_empty} 
diff --git a/jscomp/syntax/external_ffi_types.mli b/jscomp/syntax/external_ffi_types.mli
@@ -141,6 +141,9 @@ val inline_int64_primitive :
   int64 -> 
   string list   
 
+val inline_float_primitive : 
+  string -> string list
+
 val ffi_bs:
   External_arg_spec.params ->
   return_wrapper -> 
diff --git a/jscomp/test/inline_const.js b/jscomp/test/inline_const.js
@@ -3,12 +3,17 @@
 
 var N = {};
 
-function N1($star) {
-  return {};
-}
+console.log([
+      3e-6,
+      3e-6
+    ]);
 
 var x = true;
 
+function N1(funarg) {
+  return {};
+}
+
 var h = "hello";
 
 var hh = "hellohello";
@@ -18,4 +23,4 @@ exports.N = N;
 exports.N1 = N1;
 exports.h = h;
 exports.hh = hh;
-/* No side effect */
+/*  Not a pure module */
diff --git a/jscomp/test/inline_const.ml b/jscomp/test/inline_const.ml
@@ -19,6 +19,8 @@ end
 
 module N1 = functor () -> struct 
   let f4 = {j|中文|j} [@@bs.inline]
+  let xx = 3e-6 [@@bs.inline]
+  let xx0 = 3e-6
 end 
 let h = f 
 
@@ -41,3 +43,5 @@ let f9 = 100L [@@bs.inline]
 
 let v = 100L [@@bs.inline]
 let u = 1L [@@bs.inline] 
+
+let () = Js.log (xx,xx0)
diff --git a/jscomp/test/inline_const.mli b/jscomp/test/inline_const.mli
@@ -18,6 +18,7 @@ end
 module N1 : functor () -> sig 
   val f4 : string 
   [@@bs.inline {j|中文|j}]
+  val xx : float [@@bs.inline 3e-6]
 end 
 
 val h : string
diff --git a/jscomp/test/inline_const_test.js b/jscomp/test/inline_const_test.js
@@ -3,6 +3,7 @@
 var Mt = require("./mt.js");
 var Int64 = require("../../lib/js/int64.js");
 var Caml_int64 = require("../../lib/js/caml_int64.js");
+var Inline_const = require("./inline_const.js");
 
 var suites = {
   contents: /* [] */0
@@ -28,28 +29,32 @@ var f3 = "中文";
 
 var f4 = "中文";
 
-eq("File \"inline_const_test.ml\", line 27, characters 5-12", f, "hello");
+eq("File \"inline_const_test.ml\", line 29, characters 5-12", f, "hello");
 
-eq("File \"inline_const_test.ml\", line 28, characters 5-12", f1, "a");
+eq("File \"inline_const_test.ml\", line 30, characters 5-12", f1, "a");
 
-eq("File \"inline_const_test.ml\", line 29, characters 5-12", f2, "中文");
+eq("File \"inline_const_test.ml\", line 31, characters 5-12", f2, "中文");
 
-eq("File \"inline_const_test.ml\", line 30, characters 5-12", f3, "中文");
+eq("File \"inline_const_test.ml\", line 32, characters 5-12", f3, "中文");
 
-eq("File \"inline_const_test.ml\", line 31, characters 5-12", f4, "中文");
+eq("File \"inline_const_test.ml\", line 33, characters 5-12", f4, "中文");
 
-eq("File \"inline_const_test.ml\", line 32, characters 5-12", true, true);
+eq("File \"inline_const_test.ml\", line 34, characters 5-12", true, true);
 
-eq("File \"inline_const_test.ml\", line 33, characters 5-12", 1, 1);
+eq("File \"inline_const_test.ml\", line 35, characters 5-12", 1, 1);
+
+eq("File \"inline_const_test.ml\", line 36, characters 5-12", 3e-6, 0.000003);
 
 var h = Caml_int64.add(Caml_int64.add(Caml_int64.mk(100, 0), Int64.one), Caml_int64.one);
 
-Mt.from_pair_suites("File \"inline_const_test.ml\", line 41, characters 22-29", suites.contents);
+Mt.from_pair_suites("File \"inline_const_test.ml\", line 43, characters 22-29", suites.contents);
 
 var f5 = true;
 
 var f6 = 1;
 
+var f7 = 3e-6;
+
 exports.suites = suites;
 exports.test_id = test_id;
 exports.eq = eq;
@@ -61,5 +66,6 @@ exports.f3 = f3;
 exports.f4 = f4;
 exports.f5 = f5;
 exports.f6 = f6;
+exports.f7 = f7;
 exports.h = h;
 /*  Not a pure module */
diff --git a/jscomp/test/inline_const_test.ml b/jscomp/test/inline_const_test.ml
@@ -10,7 +10,8 @@ let f ,
     f3,
     f4,
     f5,
-    f6
+    f6,
+    f7
     = 
 
   Inline_const.(
@@ -20,7 +21,8 @@ let f ,
     N.f3,
     H.f4,
     f5,
-    f6
+    f6,
+    H.xx
   )
 
 let () =   
@@ -30,8 +32,8 @@ let () =
   eq __LOC__ f3 {j|中文|j};
   eq __LOC__ f4 {j|中文|j};
   eq __LOC__ f5 true;
-  eq __LOC__ f6 1 
-
+  eq __LOC__ f6 1 ;
+  eq __LOC__ f7 0.000003
 
 let h = 
   let open Inline_const in
diff --git a/lib/4.06.1/bsb.ml b/lib/4.06.1/bsb.ml
@@ -10623,12 +10623,12 @@ let collect_pub_modules
         set := Set_string.add !set str
       else 
         Bsb_log.warn
-          "@{<warning>IGNORED@} %S in public is ignored since it is not\
-           an existing module@." str
+          "@{<warning>IGNORED@}: %S in public is not an existing module \
+          and has been ignored@." str
     | _ -> 
       Bsb_exception.errorf 
         ~loc:(Ext_json.loc_of v)
-        "public excpect a list of strings"
+        "public expects a list of strings"
   done  ;
   !set
 
@@ -11055,6 +11055,7 @@ let clean_re_js root =
   | _  -> () 
   | exception _ -> ()    
   
+
 end
 module Bsb_unix : sig 
 #1 "bsb_unix.mli"
diff --git a/lib/4.06.1/unstable/bsb_native.ml b/lib/4.06.1/unstable/bsb_native.ml
@@ -10655,12 +10655,12 @@ let collect_pub_modules
         set := Set_string.add !set str
       else 
         Bsb_log.warn
-          "@{<warning>IGNORED@} %S in public is ignored since it is not\
-           an existing module@." str
+          "@{<warning>IGNORED@}: %S in public is not an existing module \
+          and has been ignored@." str
     | _ -> 
       Bsb_exception.errorf 
         ~loc:(Ext_json.loc_of v)
-        "public excpect a list of strings"
+        "public expects a list of strings"
   done  ;
   !set
 
@@ -11087,6 +11087,7 @@ let clean_re_js root =
   | _  -> () 
   | exception _ -> ()    
   
+
 end
 module Bsb_unix : sig 
 #1 "bsb_unix.mli"
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
@@ -93854,6 +93854,9 @@ val inline_int64_primitive :
   int64 -> 
   string list   
 
+val inline_float_primitive : 
+  string -> string list
+
 val ffi_bs:
   External_arg_spec.params ->
   return_wrapper -> 
@@ -94191,6 +94194,11 @@ let inline_int64_primitive (i : int64) : string list =
         (Const_int64 i))
   ]
 
+let inline_float_primitive (i : string) : string list =
+  ["";
+    to_string 
+      (Ffi_inline_const (Const_float i))
+  ]    
 let rec ffi_bs_aux acc (params : External_arg_spec.params) = 
   match params with 
   | {arg_type = Nothing; arg_label = Arg_empty} 
@@ -400636,6 +400644,7 @@ val type_string : core_type_lit
 val type_bool : core_type_lit
 val type_int : core_type_lit 
 val type_int64 : Parsetree.core_type
+val type_float : Parsetree.core_type
 val type_any : core_type_lit
 
 val pat_unit : pattern_lit
@@ -400778,6 +400787,10 @@ let type_int64 =
   Ast_helper.Typ.mk   
     (Ptyp_constr ({ txt = Lident "int64"; loc = Location.none}, []))  
 
+let type_float =     
+  Ast_helper.Typ.mk   
+    (Ptyp_constr ({ txt = Lident "float"; loc = Location.none}, []))  
+
 let type_any ?loc () =
   match loc with
   | None -> No_loc.type_any
@@ -409406,7 +409419,14 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) =
                     value_desc with 
                     pval_prim = External_ffi_types.inline_int64_primitive s;
                     pval_attributes = [];
-                  } }  
+                  } }
+              | Pexp_constant (Pconst_float(s,None)) -> 
+                Bs_ast_invariant.warn_discarded_unused_attributes pval_attributes; 
+                {sigi with psig_desc = Psig_value  {
+                    value_desc with 
+                    pval_prim = External_ffi_types.inline_float_primitive s;
+                    pval_attributes = [];
+                  } }
               | Pexp_construct ({txt = Lident ("true" | "false" as txt)}, None)       
                 -> 
                 Bs_ast_invariant.warn_discarded_unused_attributes pval_attributes;
@@ -409485,6 +409505,16 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) =
                pval_attributes = [];
                pval_prim = External_ffi_types.inline_int64_primitive s
              } }             
+        | Pexp_constant(Pconst_float (s, None))
+          ->
+          Bs_ast_invariant.warn_discarded_unused_attributes pvb_attributes; 
+          {str with pstr_desc = Pstr_primitive  {
+               pval_name = pval_name ;
+               pval_type = Ast_literal.type_float; 
+               pval_loc = pvb_loc;
+               pval_attributes = [];
+               pval_prim = External_ffi_types.inline_float_primitive s
+             } }                 
         | Pexp_construct ({txt = Lident ("true" | "false" as txt) },None) -> 
           Bs_ast_invariant.warn_discarded_unused_attributes pvb_attributes; 
           {str with pstr_desc = Pstr_primitive  {
diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml
diff --git a/lib/4.06.1/unstable/native_ppx.ml b/lib/4.06.1/unstable/native_ppx.ml
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
