generalize raw (#5125)

* generalize raw

* fix CI

Author: bobzhang

Diff for: jscomp/frontend/ast_attributes.ml

@@ -354,7 +354,8 @@ let bs_get_arity : attr
 
 let bs_set : attr
   =  {txt = "bs.set"; loc = locg}, Ast_payload.empty
-
+let internal_expansive : attr 
+  =  {txt = "internal.expansive"; loc = locg}, Ast_payload.empty  
 let bs_return_undefined : attr
   =
   {txt = "bs.return"; loc = locg },

Diff for: jscomp/frontend/ast_attributes.mli

@@ -105,5 +105,5 @@ val bs_get_index : attr
 val bs_get_arity : attr 
 val bs_set : attr
 val bs_return_undefined : attr
-
+val internal_expansive : attr 
 (* val deprecated : string -> attr *)

Diff for: jscomp/frontend/ast_exp_handle_external.ml

@@ -75,16 +75,21 @@ let handle_debugger loc (payload : Ast_payload.t) =
 
 
 let handle_raw ~kind loc payload =
+  let is_function = ref false in   
   begin match Ast_payload.raw_as_string_exp_exn 
-                ~kind payload with
+                ~kind ~is_function payload with
   | None ->
     Location.raise_errorf ~loc
       "bs.raw can only be applied to a string"
   | Some exp ->
     { exp with pexp_desc = Ast_external_mk.local_external_apply
                    loc ~pval_prim:["#raw_expr"]
                    ~pval_type:(Typ.arrow Nolabel (Typ.any ()) (Typ.any ()))
-                   [exp]}
+                   [exp];
+                   pexp_attributes = if !is_function then 
+                    Ast_attributes.internal_expansive :: exp.pexp_attributes 
+                    else exp.pexp_attributes
+    }
   end
 let handle_raw_structure loc payload = 
   begin match Ast_payload.raw_as_string_exp_exn 

Diff for: jscomp/frontend/ast_external_mk.ml

@@ -1,5 +1,5 @@
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+ * 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
@@ -82,7 +82,7 @@ let local_external_obj loc
          pexp_loc = loc} : Parsetree.expression) args ~loc
     )    
 
-let local_extern_cont loc 
+let local_extern_cont_to_obj loc 
     ?(pval_attributes=[])
     ~pval_prim
     ~pval_type 
@@ -109,4 +109,4 @@ let local_extern_cont loc
                                  loc};
          pexp_attributes = [] ;
          pexp_loc = loc}
-    )
+    ) 

Diff for: jscomp/frontend/ast_external_mk.mli

@@ -1,5 +1,5 @@
-(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+(* Copyright (C) 2015 - 2016 Bloomberg Finance L.P.
+ * 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
@@ -55,7 +55,7 @@ val local_external_obj :
 
 
 
-val local_extern_cont : 
+val local_extern_cont_to_obj : 
   Location.t ->
   ?pval_attributes:Parsetree.attributes ->
   pval_prim:string list ->

Diff for: jscomp/frontend/ast_payload.ml

@@ -70,8 +70,8 @@ let is_single_int (x : t ) : int option =
 
 
 let raw_as_string_exp_exn 
-    ~(kind: Js_raw_info.raw_kind)
-    (x : t ) : _ option = 
+    ~(kind: Js_raw_info.raw_kind) ?(is_function)
+    (x : t ) : Parsetree.expression option = 
   match x with  (** TODO also need detect empty phrase case *)
   | PStr [ {
       pstr_desc =  
@@ -82,15 +82,23 @@ let raw_as_string_exp_exn
           ;
             pexp_loc = loc} as e ,_);
       _}] -> 
+
     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 
+          let ((_loc,e) as prog),errors =  Parser_flow.parse_expression (Parser_env.init_env None str) false in 
           if kind = Raw_re then 
             (match e with 
              | Literal {value = RegExp _} -> ()
              | _ -> Location.raise_errorf ~loc "Syntax error: a valid JS regex literal expected"
             );
+          (match is_function with 
+           | Some is_function ->   
+             begin match Classify_function.classify_exp prog with 
+               | Js_function {arity= _;  _} -> is_function := true
+               | _ -> ()
+             end 
+           | None -> ());
           errors
         | Raw_program ->  
           snd (Parser_flow.parse_program false None str)

Diff for: jscomp/frontend/ast_payload.mli

@@ -45,6 +45,7 @@ val is_single_int : t -> int option
 (** Convert %raw into expression *)
 val raw_as_string_exp_exn :
   kind: Js_raw_info.raw_kind ->
+  ?is_function:bool ref -> 
   t ->
   Parsetree.expression option
 

Diff for: jscomp/frontend/ast_util.ml

@@ -225,7 +225,7 @@ let ocaml_obj_as_js_object
            label.Asttypes.txt
            label_type acc           
       ) in
-  Ast_external_mk.local_extern_cont
+  Ast_external_mk.local_extern_cont_to_obj
     loc
     ~pval_prim:(Ast_external_process.pval_prim_of_labels labels)
     (fun e ->

Diff for: jscomp/frontend/classify_function.mli

@@ -28,5 +28,7 @@ val classify :
   string -> 
   Js_raw_info.exp 
 
+val classify_exp : 
+  (Loc.t, Loc.t) Flow_ast.Expression.t -> Js_raw_info.exp 
 val classify_stmt :  
   string -> Js_raw_info.stmt

Diff for: jscomp/snapshot.ninja

@@ -15,7 +15,7 @@ OCAML_SRC_TOOLS=$native_ocaml_path/tools
 includes = -I js_parser -I stubs -I ext -I common -I frontend -I depends -I core -I super_errors -I outcome_printer -I bsb -I ounit -I ounit_tests -I napkin -I main
 SNAP=../lib/$snapshot_path
 
-o snapshot: phony  $SNAP/whole_compiler.ml   $SNAP/bsb_helper.ml $SNAP/bsb.ml $SNAP/unstable/all_ounit_tests.ml
+o snapshot: phony  $SNAP/whole_compiler.ml   $SNAP/bsb_helper.ml  $SNAP/unstable/all_ounit_tests.ml
 # $SNAP/bspp.ml
 o $SNAP/whole_compiler.ml: bspack | ./bin/bspack.exe $LTO
     flags = ${releaseMode} -D BS_ONLY=true -bs-MD -module-alias Config=Config_whole_compiler -bs-exclude-I config  -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I $OCAML_SRC_TYPING -I $OCAML_SRC_BYTECOMP -I $OCAML_SRC_DRIVER   $includes
@@ -26,9 +26,9 @@ o $SNAP/bsb_helper.ml: bspack | ./bin/bspack.exe $LTO
      flags = -bs-MD ${releaseMode}   -I stubs -I common -I ext -I frontend -I depends -I bsb_helper  -I main 
      main = Bsb_helper_main 
 
-o $SNAP/bsb.ml: bspack | ./bin/bspack.exe $LTO
-     flags =   -D BS_MIN_LEX_DEPS=true -bs-MD ${releaseMode} -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I stubs -I common -I ext -I frontend -I depends -I bsb -I ext -I main 
-     main = Bsb_main 
+# o $SNAP/bsb.ml: bspack | ./bin/bspack.exe $LTO
+#     flags =   -D BS_MIN_LEX_DEPS=true -bs-MD ${releaseMode} -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I stubs -I common -I ext -I frontend -I depends -I bsb -I ext -I main 
+#     main = Bsb_main 
 
 o $SNAP/rescript.ml: bspack | ./bin/bspack.exe $LTO
      flags =   -D BS_MIN_LEX_DEPS=true -bs-MD ${releaseMode} -I $OCAML_SRC_UTILS -I $OCAML_SRC_PARSING -I stubs -I common -I ext -I frontend -I depends -I bsb -I ext -I main 

Diff for: jscomp/test/build.ninja

@@ -480,6 +480,7 @@ o test/poly_empty_array.cmi test/poly_empty_array.cmj : cc test/poly_empty_array
 o test/poly_type.cmi test/poly_type.cmj : cc test/poly_type.ml | $stdlib
 o test/poly_variant_test.cmj : cc_cmi test/poly_variant_test.ml | test/mt.cmj test/poly_variant_test.cmi $stdlib
 o test/poly_variant_test.cmi : cc test/poly_variant_test.mli | $stdlib
+o test/polymorphic_raw_test.cmi test/polymorphic_raw_test.cmj : cc test/polymorphic_raw_test.ml | test/mt.cmj $stdlib
 o test/polymorphism_test.cmj : cc_cmi test/polymorphism_test.ml | test/polymorphism_test.cmi $stdlib
 o test/polymorphism_test.cmi : cc test/polymorphism_test.mli | $stdlib
 o test/polyvar_convert.cmi test/polyvar_convert.cmj : cc test/polyvar_convert.ml | $stdlib

Diff for: jscomp/test/polymorphic_raw_test.js

@@ -0,0 +1,49 @@
+'use strict';
+
+var Mt = require("./mt.js");
+
+var suites = {
+  contents: /* [] */0
+};
+
+var test_id = {
+  contents: 0
+};
+
+function eq(loc, x, y) {
+  test_id.contents = test_id.contents + 1 | 0;
+  suites.contents = {
+    hd: [
+      loc + (" id " + String(test_id.contents)),
+      (function (param) {
+          return {
+                  TAG: /* Eq */0,
+                  _0: x,
+                  _1: y
+                };
+        })
+    ],
+    tl: suites.contents
+  };
+  
+}
+
+var f = ((a) => typeof a);
+
+var a = f(3);
+
+var b = f("3");
+
+eq("File \"polymorphic_raw_test.ml\", line 22, characters 6-13", a, "number");
+
+eq("File \"polymorphic_raw_test.ml\", line 23, characters 6-13", b, "string");
+
+Mt.from_pair_suites("polymorphic_raw_test.ml", suites.contents);
+
+exports.suites = suites;
+exports.test_id = test_id;
+exports.eq = eq;
+exports.f = f;
+exports.a = a;
+exports.b = b;
+/* a Not a pure module */

Diff for: jscomp/test/polymorphic_raw_test.ml

@@ -0,0 +1,24 @@
+[@@@config {
+  flags = [|
+   
+  |]
+}]
+
+let suites :  Mt.pair_suites ref  = ref []
+let test_id = ref 0
+let eq loc x y = 
+  incr test_id ; 
+  suites := 
+    (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites
+
+
+
+
+let f :  _ -> string = [%raw{| (a) => typeof a  |}] 
+
+let a = f 3 
+let b = f "3"
+
+;; eq __LOC__ a "number"
+;; eq __LOC__ b "string"
+;; Mt.from_pair_suites __FILE__ !suites