Merge pull request #4583 from BuckleScript/ffi_cleanup_3

WIP: fix #4582, #4463

Author: bobzhang

jscomp/core/js_dump.ml

@@ -650,7 +650,7 @@ and expression_desc cxt ~(level:int) f x : cxt  =
      | Exp exp_info ->
        let raw_paren =
           not (match exp_info with  
-            | Js_literal _ | Js_raw_json -> true 
+            | Js_literal _  -> true 
             | Js_function _ | Js_exp_unknown -> false || raw_snippet_exp_simple_enough s) in 
        if raw_paren then P.string f L.lparen;
        P.string f s ;       

jscomp/core/js_raw_info.ml

@@ -40,7 +40,6 @@ type exp =
     | RegExp of RegExp.t
   ]}
   *)
-  | Js_raw_json
   | Js_exp_unknown
 
 

jscomp/core/lam_compile_const.ml

@@ -130,9 +130,5 @@ let translate_arg_cst (cst : External_arg_spec.cst) =
      E.int (Int32.of_int i)
    | Arg_string_lit i -> 
      E.str i
-   | Arg_js_null  -> E.nil
-   | Arg_js_json s 
-     -> E.raw_js_code (Exp Js_raw_json) s
-
-   | Arg_js_true  -> E.bool true
-   | Arg_js_false -> E.bool false 
+   | Arg_js_literal s 
+     -> E.raw_js_code (Exp (Js_literal {comment = None})) s

jscomp/main/builtin_cmi_datasets.ml

@@ -148,7 +148,7 @@ external ff :
       type t
       external mk : int -> (_ [@bs.as {json| { x : 3 } |json}]) ->  t = "mk" [@@bs.val]
       |} in
-      OUnit.assert_bool __LOC__ (Ext_string.contain_substring should_err.stderr "Invalid json literal")
+      OUnit.assert_bool __LOC__ (Ext_string.is_empty should_err.stderr)
     end
     ;
     __LOC__ >:: begin fun _ ->

jscomp/ounit_tests/ounit_cmd_tests.ml

@@ -265,8 +265,7 @@ let iter_process_bs_int_as  (attrs : t) =
 type as_const_payload = 
   | Int of int
   | Str of string
-  | Json_str of string  
-
+  | Js_literal_str of string
 let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
   let st = ref None in
   Ext_list.iter attrs
@@ -279,16 +278,31 @@ let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) =
           (Bs_ast_invariant.mark_used_bs_attribute attr ;
            match Ast_payload.is_single_int payload with
            | None ->
-             begin match Ast_payload.is_single_string payload with
-               | Some (s,None) ->
-                 st := Some (Str (s))
-               | Some (s, Some "json") ->
-                 st := Some (Json_str s )
-               | None | Some (_, Some _) ->
+             begin match  payload with
+               | PStr [ {
+                   pstr_desc =  
+                     Pstr_eval (
+                       {pexp_desc = 
+                          Pexp_constant 
+                            (Pconst_string(s, (None | Some "json" as dec)))
+                       ; pexp_loc ;
+                         _},_);
+                   _}] -> 
+                 if dec = None then
+                   st := Some (Str (s))
+                 else
+                 begin 
+                   (match Classify_function.classify ~check:(pexp_loc, Bs_flow_ast_utils.flow_deli_offset dec)
+                            s with 
+                   | Js_literal _ -> ()
+                   | _ -> 
+                    Location.raise_errorf ~loc:pexp_loc "an object literal expected");
+                   st := Some (Js_literal_str s )
+                 end
+               | _ -> 
                  Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal
-
              end
-           | Some   v->
+           | Some v->
              st := (Some (Int v))
           )
         else

jscomp/syntax/ast_attributes.ml

@@ -82,8 +82,7 @@ val iter_process_bs_int_as :
 type as_const_payload = 
   | Int of int
   | Str of string
-  | Json_str of string  
-
+  | Js_literal_str of string
 
 val iter_process_bs_string_or_int_as :
     t ->

jscomp/syntax/ast_attributes.mli

@@ -112,10 +112,9 @@ let refine_arg_type ~(nolabel:bool) (ptyp : Ast_core_type.t)
        (* This type is used in bs.obj only to construct obj type*)
        Arg_cst(External_arg_spec.cst_int i)
      | Some (Str i)->
-       Arg_cst (External_arg_spec.cst_string i)
-     | Some (Json_str s) ->
-       (* FIXME: This seems to be wrong in bs.obj, we should disable such payload in bs.obj *)
-       Arg_cst (External_arg_spec.cst_json ptyp.ptyp_loc s)
+       Arg_cst (External_arg_spec.cst_string i)     
+     | Some (Js_literal_str s) ->
+       Arg_cst (External_arg_spec.cst_obj_literal  s)
    else (* ([`a|`b] [@bs.string]) *)
      spec_of_ptyp nolabel ptyp   
   )
@@ -138,7 +137,7 @@ let refine_obj_arg_type ~(nolabel:bool) (ptyp : Ast_core_type.t)
       Ast_literal.type_int ~loc:ptyp.ptyp_loc (), Arg_cst(External_arg_spec.cst_int i)
     | Some (Str i)->
       Ast_literal.type_string ~loc:ptyp.ptyp_loc (), Arg_cst (External_arg_spec.cst_string i)
-    | Some (Json_str _) ->
+    | Some (Js_literal_str _ ) ->
       Location.raise_errorf ~loc:ptyp.ptyp_loc "json payload is not supported in bs.obj since its type can not be inferred"
   else (* ([`a|`b] [@bs.string]) *)
     ptyp, spec_of_ptyp nolabel ptyp      

jscomp/syntax/ast_external_process.ml

@@ -66,38 +66,9 @@ let is_single_int (x : t ) : int option =
   | _  -> None
 
 
-let offset_pos 
-  ({pos_lnum; pos_bol; pos_cnum} as loc : Lexing.position) 
-    ({line; column} : Loc.position) first_line_offset : Lexing.position = 
-  if line = 1 then 
-    {loc with pos_cnum = pos_cnum + column + first_line_offset }
-  else {
-    loc with 
-    pos_lnum = pos_lnum + line - 1;
-    pos_cnum =  pos_bol + column
-  }
 
-let flow_deli_off_set deli = 
-  (match deli with 
-  | None -> 1  (* length of '"'*)
-  | Some deli ->
-     String.length deli + 2 (* length of "{|"*)
-  )
-(* Here the loc is  the payload loc *)
-let check_flow_errors ~(loc : Location.t)
-  ~offset(errors : (Loc.t * Parse_error.t) list) = 
-  match errors with 
-  | [] ->  ()
-  | ({start ;
-     _end },first_error) :: _ -> 
-  
-    Location.raise_errorf ~loc:{loc with 
-      loc_start = offset_pos loc.loc_start start 
-        offset ;
-      loc_end = offset_pos loc.loc_start _end 
-        offset } "%s"
-      (Parse_error.PP.error first_error)  
-;;      
+
+
 let raw_as_string_exp_exn 
   ~(kind: Js_raw_info.raw_kind)
   (x : t ) : _ option = 
@@ -111,7 +82,7 @@ let raw_as_string_exp_exn
                ;
            pexp_loc = loc} as e ,_);
       _}] -> 
-    check_flow_errors ~loc ~offset:(flow_deli_off_set deli) (match kind with 
+    Bs_flow_ast_utils.check_flow_errors ~loc ~offset:(Bs_flow_ast_utils.flow_deli_offset deli) (match kind with 
         | Raw_re 
         | Raw_exp ->  
           let (_loc,e),errors =  (Parser_flow.parse_expression (Parser_env.init_env None str) false) in 

jscomp/syntax/ast_payload.ml

@@ -0,0 +1,64 @@
+(* Copyright (C) 2020 - Authors of BuckleScript 
+ *
+ * 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. *)
+
+
+ let offset_pos 
+  ({pos_lnum; pos_bol; pos_cnum} as loc : Lexing.position) 
+  ({line; column} : Loc.position) 
+  first_line_offset : Lexing.position = 
+ if line = 1 then 
+   {loc with pos_cnum = pos_cnum + column + first_line_offset }
+ else {
+   loc with 
+   pos_lnum = pos_lnum + line - 1;
+   pos_cnum =  pos_bol + column
+ } 
+
+
+let flow_deli_offset deli = 
+  (match deli with 
+   | None -> 1  (* length of '"'*)
+   | Some deli ->
+     String.length deli + 2 (* length of "{|"*)
+  )
+
+;;      
+
+
+(* Here the loc is  the payload loc *)
+let check_flow_errors ~(loc : Location.t)
+    ~offset
+    (errors : (Loc.t * Parse_error.t) list) = 
+  match errors with 
+  | [] ->  ()
+  | ({start ;
+      _end },first_error) :: _ -> 
+    let loc_start = loc.loc_start in     
+    Location.raise_errorf 
+      ~loc:{loc with 
+            loc_start = offset_pos loc_start start 
+                offset ;
+            loc_end = offset_pos loc_start _end 
+                offset } "%s"
+      (Parse_error.PP.error first_error)