support let%local which is not exported by default

In the future, we can fusing the let%local if compilation perf is the concern

Author: bobzhang

jscomp/syntax/bs_builtin_ppx.ml

@@ -270,19 +270,16 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) =
           )
       | _ -> default_mapper.signature_item self sigi
 
-
+let local_module_name =     
+  let v = ref 0 in       
+  fun  () -> 
+    incr v ;
+  "local_" ^ (string_of_int !v) 
 
 let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) =
   match str.pstr_desc with
-  | Pstr_extension ( ({txt = ("bs.raw"| "raw") ; loc}, payload), _attrs)
-    ->
-    Ast_exp_handle_external.handle_raw_structure loc payload
-  | Pstr_extension (({txt = ("bs.debugger.chrome" | "debugger.chrome") ;loc}, payload),_)
-    ->          
-    Location.prerr_warning loc (Preprocessor "this extension can be safely removed");
-    Ast_structure.dummy_item loc
   | Pstr_type (
-          _rf, 
+          _rf, (* FIXME *)
           (_ :: _ as tdcls )) (* [ {ptype_attributes} as tdcl ] *)->
           Ast_tdcls.handleTdclsInStru self str tdcls
    | Pstr_primitive prim when Ast_attributes.external_needs_to_be_encoded prim.pval_attributes
@@ -341,15 +338,60 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) =
   | _ -> default_mapper.structure_item self str
 
 
-    
+let rec 
+  structure_mapper (self : mapper) stru =     
+  match stru with 
+  | [] -> []  
+  | item::rest -> 
+    let new_x = self.structure_item self item in 
+    match new_x.pstr_desc with 
+    | Pstr_extension (({txt = ("bs.debugger.chrome" | "debugger.chrome") ;loc}, _),_)
+      -> 
+      Location.prerr_warning loc (Preprocessor "this extension can be safely removed");
+      (structure_mapper self rest)
+    | Pstr_extension ( ({txt = ("bs.raw"| "raw") ; loc}, payload), _attrs)
+      ->
+      Ast_exp_handle_external.handle_raw_structure loc payload :: (structure_mapper self rest)     
+    | Pstr_extension (({txt = "local"; loc}, payload),_)
+      -> 
+      begin match payload with 
+        | PStr stru -> 
+          (* check no module, no type allowed *)
+          (* let stru = self.structure self stru in  *)
+          Ext_list.iter stru Typemod_hide.check; 
+          let local_module_name = local_module_name () in 
+          let open Ast_helper in 
+            Str.module_         
+              ~loc
+              { pmb_name = {txt = local_module_name; loc}; 
+                pmb_expr = {
+                  pmod_desc= Pmod_structure stru;
+                  pmod_loc = loc; 
+                  pmod_attributes = [] };
+                pmb_attributes = Typemod_hide.attrs; pmb_loc = loc} ::
+            Str.open_ ~loc {
+              popen_lid = {txt = Lident local_module_name; loc};
+              popen_override = Override;
+              popen_loc = loc;
+              popen_attributes = []
+            } :: structure_mapper self rest          
+        | PSig _ 
+        | PTyp _
+        | PPat _ ->
+          Location.raise_errorf ~loc "local extension is not support"
+      end  
+    | _ ->    
+      new_x :: (structure_mapper self rest)
+  
 let  unsafe_mapper : mapper =
   { default_mapper with
     expr = expr_mapper;
     typ = typ_mapper ;
     class_type = class_type_mapper;      
     signature_item =  signature_item_mapper ;
     value_bindings = Ast_tuple_pattern_flatten.value_bindings_mapper;
-    structure_item = structure_item_mapper
+    structure_item = structure_item_mapper;
+    structure = structure_mapper
   }
 
 

jscomp/test/build.ninja

@@ -364,6 +364,7 @@ build test/int_hashtbl_test.cmi test/int_hashtbl_test.cmj : cc test/int_hashtbl_
 build test/int_map.cmi test/int_map.cmj : cc test/int_map.ml | $stdlib
 build test/int_overflow_test.cmi test/int_overflow_test.cmj : cc test/int_overflow_test.ml | test/mt.cmj $stdlib
 build test/int_switch_test.cmi test/int_switch_test.cmj : cc test/int_switch_test.ml | test/mt.cmj $stdlib
+build test/internal_unused_test.cmi test/internal_unused_test.cmj : cc test/internal_unused_test.ml | $stdlib
 build test/io_test.cmi test/io_test.cmj : cc test/io_test.ml | $stdlib
 build test/js_array_test.cmi test/js_array_test.cmj : cc test/js_array_test.ml | test/mt.cmj $stdlib
 build test/js_bool_test.cmi test/js_bool_test.cmj : cc test/js_bool_test.ml | test/mt.cmj $stdlib

jscomp/test/internal_unused_test.js

@@ -0,0 +1,24 @@
+'use strict';
+
+var Caml_exceptions = require("../../lib/js/caml_exceptions.js");
+
+console.log(3);
+
+var A = Caml_exceptions.create("Internal_unused_test.P1.A");
+
+function f(param) {
+  throw A;
+}
+
+var c = 5;
+
+function h(a, b) {
+  return a + b | 0;
+}
+
+console.log(c);
+
+console.log(h(1, 2));
+
+exports.f = f;
+/*  Not a pure module */

jscomp/test/internal_unused_test.ml

@@ -0,0 +1,33 @@
+[@@@warning "A"]
+[@@@warnerror "a"]
+;; module [@internal.local] P0 = struct 
+  let a = 3 in 
+  Js.log a ; a + 2
+end  
+open! P0
+
+;; module [@internal.local] P1 = struct 
+  exception A
+  let _a = 2
+end  
+open! P1
+
+let f () = raise A
+
+let%local b = 3
+
+let%local c = b + 2
+
+[%%local
+let d = c 
+let f = d 
+let h = fun[@bs] a b -> a + b
+]
+
+
+
+;; Js.log f 
+
+;; Js.log (h 1 2 [@bs])
+
+(* [%%debugger.chrome] *)