Merge pull request #2671 from BuckleScript/fix_2664

address #2664

Author: bobzhang

jscomp/Makefile

@@ -257,10 +257,10 @@ SYNTAX_SRCS= \
 	ast_util\
 	ast_tdcls\
 	ast_primitive\
+	ast_tuple_pattern_flatten\
 	ast_exp_apply\
 	ast_exp_extension\
 	ast_core_type_class_type\
-	ast_tuple_pattern_flatten\
 	ppx_entry\
 # not a good name ast_util
 SYNTAX_CMXS=$(addprefix syntax/, $(addsuffix .cmx, $(SYNTAX_SRCS)))

jscomp/all.depend

@@ -246,9 +246,13 @@ syntax/ast_tdcls.cmx : ext/ext_list.cmx syntax/bs_ast_mapper.cmx \
     syntax/ast_attributes.cmx syntax/ast_tdcls.cmi
 syntax/ast_primitive.cmx : syntax/external_process.cmx \
     syntax/bs_ast_mapper.cmx syntax/ast_primitive.cmi
+syntax/ast_tuple_pattern_flatten.cmx : ext/ext_list.cmx \
+    syntax/bs_ast_mapper.cmx syntax/bs_ast_invariant.cmx \
+    syntax/ast_tuple_pattern_flatten.cmi
 syntax/ast_exp_apply.cmx : ext/literals.cmx ext/ext_list.cmx \
     syntax/bs_ast_mapper.cmx syntax/bs_ast_invariant.cmx syntax/ast_util.cmx \
-    syntax/ast_literal.cmx syntax/ast_attributes.cmx syntax/ast_exp_apply.cmi
+    syntax/ast_tuple_pattern_flatten.cmx syntax/ast_literal.cmx \
+    syntax/ast_attributes.cmx syntax/ast_exp_apply.cmi
 syntax/ast_exp_extension.cmx : ext/literals.cmx ext/ext_string.cmx \
     ext/ext_ref.cmx syntax/bs_ast_mapper.cmx syntax/ast_util.cmx \
     syntax/ast_payload.cmx syntax/ast_literal.cmx syntax/ast_derive.cmx \
@@ -257,8 +261,6 @@ syntax/ast_core_type_class_type.cmx : ext/literals.cmx ext/ext_ref.cmx \
     ext/ext_list.cmx syntax/bs_ast_mapper.cmx syntax/ast_util.cmx \
     syntax/ast_literal.cmx syntax/ast_comb.cmx syntax/ast_attributes.cmx \
     syntax/ast_core_type_class_type.cmi
-syntax/ast_tuple_pattern_flatten.cmx : ext/ext_list.cmx \
-    syntax/bs_ast_mapper.cmx syntax/ast_tuple_pattern_flatten.cmi
 syntax/ppx_entry.cmx : ext/string_map.cmx ext/literals.cmx \
     ext/ext_string.cmx syntax/bs_ast_mapper.cmx syntax/bs_ast_invariant.cmx \
     syntax/ast_util.cmx syntax/ast_utf8_string_interp.cmx \
@@ -301,10 +303,10 @@ syntax/ast_util.cmi : syntax/bs_ast_mapper.cmi syntax/ast_payload.cmi
 syntax/ast_tdcls.cmi : syntax/bs_ast_mapper.cmi syntax/ast_structure.cmi \
     syntax/ast_signature.cmi
 syntax/ast_primitive.cmi : syntax/bs_ast_mapper.cmi
+syntax/ast_tuple_pattern_flatten.cmi : syntax/bs_ast_mapper.cmi
 syntax/ast_exp_apply.cmi : syntax/bs_ast_mapper.cmi
 syntax/ast_exp_extension.cmi : syntax/bs_ast_mapper.cmi
 syntax/ast_core_type_class_type.cmi : syntax/bs_ast_mapper.cmi
-syntax/ast_tuple_pattern_flatten.cmi : syntax/bs_ast_mapper.cmi
 syntax/ppx_entry.cmi :
 depends/bs_exception.cmi :
 depends/ast_extract.cmi : ext/string_map.cmi ext/string_hashtbl.cmi \

jscomp/core/bs_conditional_initial.ml

@@ -25,7 +25,7 @@
 
 let setup_env () =
 #if BS_DEBUG then
-    Js_config.set_debug_file "tuple_alloc.ml";
+    Js_config.set_debug_file "pipe_syntax.ml";
 #end
   Lexer.replace_directive_bool "BS" true;
   Lexer.replace_directive_string "BS_VERSION"  Bs_version.version

jscomp/core/lam.ml

@@ -1102,6 +1102,10 @@ let apply fn args loc status : t =
       | exception _ ->
         Lapply { fn; args;  loc;    status }
     end
+  (* | Lfunction {params;body} when Ext_list.same_length params args ->
+      Ext_list.fold_right2 (fun p arg acc ->
+        Llet(Strict,p,arg,acc)
+      ) params args body *) (* TODO: more rigirous analysis on [let_kind] *)
   | _ ->
     Lapply { fn; args;  loc  ; status }
 

jscomp/core/lam_pass_deep_flatten.ml

@@ -157,7 +157,7 @@ let deep_flatten
       *)
       let (res,l) = flatten acc arg  in
       begin match id.name, str, res with
-        | ("match" | "include"),
+        | ("match" | "include"| "param"),
           (Alias | Strict | StrictOpt),
           Lprim {primitive = Pmakeblock(_,_, Immutable); args} ->
           begin match eliminate_tuple id body Int_map.empty with

jscomp/others/belt_Map.ml

@@ -17,154 +17,154 @@
 *)
 module Int = Belt_MapInt
 (** specalized when key type is [string], more efficient
-    than the gerneic type *)  
+    than the gerneic type *)
 module String = Belt_MapString
 
 (** seprate function from data, a more verbsoe but slightly
     more efficient
-*)  
+*)
 module Dict = Belt_MapDict
 
 module N = Belt_MapDict
 module A = Belt_Array
 
 type ('key, 'id ) id = ('key, 'id) Belt_Id.comparable
 type ('key, 'id ) cmp = ('key, 'id) Belt_Id.cmp
-module S = struct 
+module S = struct
   type ('k,'v,'id) t = {
     cmp: ('k,'id) cmp;
     data: ('k,'v, 'id) Dict.t
   }
   [@@bs.deriving abstract]
 end
 
-type ('k, 'v, 'id ) t = ('k, 'v, 'id) S.t 
+type ('k, 'v, 'id ) t = ('k, 'v, 'id) S.t
 
 let fromArray (type k) (type idx) data ~(id : (k,idx) id)  =
   let module M = (val id) in
-  let cmp = M.cmp in 
-  S.t ~cmp ~data:(Dict.fromArray ~cmp data) 
+  let cmp = M.cmp in
+  S.t ~cmp ~data:(Dict.fromArray ~cmp data)
 
-let ofArray = fromArray 
+let ofArray = fromArray
 
-let remove m x  =   
-  let cmp, odata = S.cmp m, S.data m in 
+let remove m x  =
+  let cmp, odata = m |. S.(cmp, data) in
   let newData = Dict.remove odata x ~cmp  in
   if newData == odata then m
-  else S.t ~cmp ~data:newData 
+  else S.t ~cmp ~data:newData
 
-let removeMany m x =     
-  let cmp, odata = S.cmp m,  S.data m in
+let removeMany m x =
+  let cmp, odata = m |. (S.cmp,  S.data) in
   let newData = Dict.removeMany odata x ~cmp in
   S.t ~cmp  ~data:newData
 
-let set m key d  = 
-  let cmp = S.cmp m in 
-  S.t ~cmp  ~data:(Dict.set ~cmp (S.data m) key d) 
+let set m key d  =
+  let cmp = S.cmp m in
+  S.t ~cmp  ~data:(Dict.set ~cmp (S.data m) key d)
 
-let mergeMany m e = 
-  let cmp = S.cmp m in 
+let mergeMany m e =
+  let cmp = S.cmp m in
   S.t ~cmp  ~data:(Dict.mergeMany ~cmp (S.data m) e)
 
-let updateU m key f  = 
-  let cmp = S.cmp m in 
+let updateU m key f  =
+  let cmp = S.cmp m in
   S.t ~cmp ~data:(Dict.updateU ~cmp (S.data m) key f )
 let update m key f = updateU m key (fun [@bs] a  -> f a )
-let split m x =   
-  let cmp = S.cmp m in 
-  let (l,r),b = Dict.split ~cmp (S.data m) x in 
-  (S.t ~cmp ~data:l, S.t ~cmp  ~data:r), b  
+let split m x =
+  let cmp = S.cmp m in
+  let (l,r),b = Dict.split ~cmp (S.data m) x in
+  (S.t ~cmp ~data:l, S.t ~cmp  ~data:r), b
 
-let mergeU s1 s2 f = 
-  let cmp = S.cmp s1 in 
+let mergeU s1 s2 f =
+  let cmp = S.cmp s1 in
   S.t ~cmp ~data:(Dict.mergeU ~cmp  (S.data s1) (S.data s2) f)
 
-let merge s1 s2 f = 
+let merge s1 s2 f =
   mergeU s1 s2 (fun [@bs] a b c -> f a b c)
 
 let make (type key) (type idx) ~(id: (key, idx) id) =
-  let module M = (val id) in 
+  let module M = (val id) in
   S.t  ~cmp:M.cmp  ~data:Dict.empty
 
-let isEmpty map = 
+let isEmpty map =
   Dict.isEmpty (S.data map)
 
 
 let forEachU m f = Dict.forEachU (S.data m) f
 let forEach m f = forEachU m (fun [@bs] a b -> f a b)
-let reduceU m acc f = Dict.reduceU (S.data m) acc f  
+let reduceU m acc f = Dict.reduceU (S.data m) acc f
 let reduce m acc f = reduceU m acc (fun[@bs] a b c -> f a b c )
-let everyU m f = Dict.everyU (S.data m) f  
+let everyU m f = Dict.everyU (S.data m) f
 let every m f = everyU m (fun [@bs] a b -> f a b)
 let someU m f = Dict.someU (S.data m) f
 let some m f = someU m (fun[@bs] a b -> f a b)
 let keepU m f =
   S.t ~cmp:(S.cmp m) ~data:(Dict.keepU (S.data m) f)
 let keep m f = keepU m (fun [@bs] a b -> f a b)
-    
-let partitionU m p =   
-  let cmp = S.cmp m in 
-  let l,r = Dict.partitionU (S.data m) p in 
-  S.t ~cmp ~data:l, S.t ~cmp ~data:r 
+
+let partitionU m p =
+  let cmp = S.cmp m in
+  let l,r = m |. S.data |. Dict.partitionU  p in
+  S.t ~cmp ~data:l, S.t ~cmp ~data:r
 let partition m p = partitionU m (fun [@bs] a b -> p a b)
 
-let mapU m f = 
+let mapU m f =
   S.t ~cmp:(S.cmp m) ~data:(Dict.mapU (S.data m) f)
-let map m f = mapU m (fun [@bs] a  -> f a)    
-let mapWithKeyU m  f = 
+let map m f = mapU m (fun [@bs] a  -> f a)
+let mapWithKeyU m  f =
   S.t ~cmp:(S.cmp m) ~data:(Dict.mapWithKeyU (S.data m) f)
 let mapWithKey m f = mapWithKeyU m (fun [@bs] a b -> f a b)
-let size map = Dict.size (S.data map)   
-let toList map = Dict.toList (S.data map) 
+let size map = Dict.size (S.data map)
+let toList map = Dict.toList (S.data map)
 let toArray m = Dict.toArray (S.data m)
 let keysToArray m = Dict.keysToArray (S.data m)
 let valuesToArray m = Dict.valuesToArray (S.data m)
 let minKey m = Dict.minKey (S.data m)
 let minKeyUndefined m = Dict.minKeyUndefined (S.data m)
 let maxKey m = Dict.maxKey (S.data m)
-let maxKeyUndefined m = Dict.maxKeyUndefined (S.data m)    
+let maxKeyUndefined m = Dict.maxKeyUndefined (S.data m)
 let minimum m = Dict.minimum (S.data m)
-let minUndefined m = Dict.minUndefined (S.data m) 
+let minUndefined m = Dict.minUndefined (S.data m)
 let maximum m = Dict.maximum (S.data m)
 let maxUndefined m = Dict.maxUndefined (S.data m)
 
 let get map x  =
-  Dict.get ~cmp:(S.cmp map)  (S.data map) x 
+  Dict.get ~cmp:(S.cmp map)  (S.data map) x
 
-let getUndefined map x = 
+let getUndefined map x =
   Dict.getUndefined ~cmp:(S.cmp map) (S.data map) x
 
-let getWithDefault map x def = 
+let getWithDefault map x def =
   Dict.getWithDefault ~cmp:(S.cmp map) (S.data map) x  def
 
-let getExn map x = 
-  Dict.getExn ~cmp:(S.cmp map) (S.data map) x 
+let getExn map x =
+  Dict.getExn ~cmp:(S.cmp map) (S.data map) x
 
-let has map x = 
+let has map x =
   Dict.has ~cmp:(S.cmp map) (S.data map) x
 
 let checkInvariantInternal m  =
   Dict.checkInvariantInternal (S.data m)
 
-let eqU m1 m2 veq = 
+let eqU m1 m2 veq =
   Dict.eqU ~kcmp:(S.cmp m1) ~veq (S.data m1) (S.data m2)
 let eq m1 m2 veq = eqU m1 m2 (fun[@bs] a b -> veq a b)
 
 let cmpU m1 m2 vcmp =
   Dict.cmpU ~kcmp:(S.cmp m1)  ~vcmp (S.data m1) (S.data m2)
 let cmp m1 m2 vcmp = cmpU m1 m2 (fun [@bs] a b -> vcmp a b)
-    
+
 let getData = S.data
-  
+
 let getId (type key) (type identity) (m : (key,_,identity) t) : (key, identity) id =
   let module T = struct
     type nonrec identity = identity
     type nonrec t = key
     let cmp =  S.cmp m
   end in
   (module T )
-  
+
 let packIdData (type key) (type idx) ~(id : (key, idx) id) ~data  =
-  let module M = (val id) in 
+  let module M = (val id) in
   S.t ~cmp:M.cmp ~data