Remove unused non-bs code

Author: DZakh

jscomp/ext/config.ml

@@ -7,8 +7,6 @@ let standard_library =
 
 let standard_library_default = standard_library
 
-let bs_only = ref true
-
 let unsafe_empty_array = ref false
 
 let cmi_magic_number = "Caml1999I022"

jscomp/ext/config.mli

@@ -21,8 +21,6 @@ val version : string
 val standard_library : string
 (* The directory containing the standard libraries *)
 
-val bs_only : bool ref
-
 val unsafe_empty_array : bool ref
 
 val load_path : string list ref

jscomp/ml/cmt_format.ml

@@ -174,9 +174,7 @@ open Cmi_format
 
 let save_cmt filename modname binary_annots sourcefile initial_env cmi =
   if !Clflags.binary_annotations then begin
-    (if !Config.bs_only then Misc.output_to_bin_file_directly else 
-    Misc.output_to_file_via_temporary
-       ~mode:[Open_binary] ) filename
+    Misc.output_to_bin_file_directly filename
        (fun temp_file_name oc ->
          let this_crc =
            match cmi with

jscomp/ml/ctype.ml

@@ -2534,16 +2534,6 @@ and unify_row env row1 row2 =
   let rm1 = row_more row1 and rm2 = row_more row2 in
   if unify_eq rm1 rm2 then () else
   let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
-  if not !Config.bs_only && (r1 <> [] && r2 <> []) then begin
-    (* pairs are the intersection, r1 , r2 should be disjoint *)
-    let ht = Hashtbl.create (List.length r1) in
-    List.iter (fun (l,_) -> Hashtbl.add ht (hash_variant l) l) r1;
-    List.iter
-      (fun (l,_) ->
-        try raise (Tags(l, Hashtbl.find ht (hash_variant l)))
-        with Not_found -> ())
-      r2
-  end;
   let fixed1 = row_fixed row1 and fixed2 = row_fixed row2 in
   let more =
     if fixed1 then rm1 else
@@ -3712,7 +3702,6 @@ let rec subtype_rec env trace t1 t2 cstrs =
           (trace, t1, t2, !univar_pairs)::cstrs
         end
     | Tvariant v, _ when 
-        !Config.bs_only &&
         !variant_is_subtype env (row_repr v) t2 
       -> 
         cstrs

jscomp/ml/env.ml

@@ -1117,7 +1117,7 @@ and lookup_module ~load ?loc lid env : Path.t =
           (* see #5965 *)
           raise Recmodule
         | Mty_alias (_, Path.Pident id) ->   
-          if !Config.bs_only && not !Clflags.transparent_modules && Ident.persistent id then 
+          if not !Clflags.transparent_modules && Ident.persistent id then 
             find_pers_struct (Ident.name id) |> ignore 
         | _ -> ()
         end;

jscomp/ml/matching.ml

@@ -1335,7 +1335,6 @@ let make_constr_matching p def ctx = function
           (arg, Alias) :: argl
         else match cstr.cstr_tag with
         | Cstr_block _ when
-            !Config.bs_only &&
             Datarepr.constructor_has_optional_shape cstr
           ->
             begin
@@ -2280,7 +2279,6 @@ let split_extension_cases tag_lambda_list =
     | (cstr, act) :: rem ->
         let (consts, nonconsts) = split_rec rem in
         match cstr with
-          Cstr_extension(path, true) when not !Config.bs_only -> ((path, act) :: consts, nonconsts)
         | Cstr_extension(path, _) -> (consts, (path, act) :: nonconsts)
         | _ -> assert false in
   split_rec tag_lambda_list
@@ -2309,17 +2307,13 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
         match nonconsts with
           [] -> default
         | _ ->
-            let tag = Ident.create "tag" in
-            let tests =
-              List.fold_right
-                (fun (path, act) rem ->
-                   let ext = transl_extension_path ex_pat.pat_env path in
-                   Lifthenelse(Lprim(extension_slot_eq , [Lvar tag; ext], loc),
-                               act, rem))
-                nonconsts
-                default
-            in
-              Llet(Alias, Pgenval,tag,  arg, tests)
+          List.fold_right
+            (fun (path, act) rem ->
+                let ext = transl_extension_path ex_pat.pat_env path in
+                Lifthenelse(Lprim(extension_slot_eq , [arg; ext], loc),
+                            act, rem))
+            nonconsts
+            default 
       in
         List.fold_right
           (fun (path, act) rem ->
@@ -2355,7 +2349,7 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
               (* Typically, match on lists, will avoid isint primitive in that
                 case *)
               let arg = 
-                if !Config.bs_only && Datarepr.constructor_has_optional_shape cstr then
+                if Datarepr.constructor_has_optional_shape cstr then
                   Lprim(is_not_none_bs_primitve , [arg], loc)
                 else arg
               in 
@@ -2452,10 +2446,7 @@ let combine_variant names loc row arg partial ctx def
   else
     num_constr := max_int;
   let test_int_or_block arg if_int if_block =
-    if !Config.bs_only then 
-      Lifthenelse(Lprim (Pccall(Primitive.simple ~name:"#is_poly_var_block" ~arity:1 ~alloc:false), [arg], loc), if_block, if_int)
-    else   
-      Lifthenelse(Lprim (Pisint, [arg], loc), if_int, if_block) in
+    Lifthenelse(Lprim (Pccall(Primitive.simple ~name:"#is_poly_var_block" ~arity:1 ~alloc:false), [arg], loc), if_block, if_int) in
   let sig_complete =  List.length tag_lambda_list = !num_constr
   and one_action = same_actions tag_lambda_list in (* reduandant work under bs context *)
   let fail, local_jumps =
@@ -3001,67 +2992,6 @@ let simple_for_let loc param pat body =
    catch/exit.
 *)
 
-let rec map_return f = function
-  | Llet (str, k, id, l1, l2) -> Llet (str, k, id, l1, map_return f l2)
-  | Lletrec (l1, l2) -> Lletrec (l1, map_return f l2)
-  | Lifthenelse (lcond, lthen, lelse) ->
-      Lifthenelse (lcond, map_return f lthen, map_return f lelse)
-  | Lsequence (l1, l2) -> Lsequence (l1, map_return f l2)
-  | Ltrywith (l1, id, l2) -> Ltrywith (map_return f l1, id, map_return f l2)
-  | Lstaticcatch (l1, b, l2) ->
-      Lstaticcatch (map_return f l1, b, map_return f l2)
-  | Lstaticraise _ | Lprim(Praise _, _, _) as l -> l
-  | l -> f l
-
-(* The 'opt' reference indicates if the optimization is worthy.
-
-   It is shared by the different calls to 'assign_pat' performed from
-   'map_return'. For example with the code
-     let (x, y) = if foo then z else (1,2)
-   the else-branch will activate the optimization for both branches.
-
-   That means that the optimization is activated if *there exists* an
-   interesting tuple in one hole of the let-rhs context. We could
-   choose to activate it only if *all* holes are interesting. We made
-   that choice because being optimistic is extremely cheap (one static
-   exit/catch overhead in the "wrong cases"), while being pessimistic
-   can be costly (one unnecessary tuple allocation).
-*)
-
-let assign_pat opt nraise catch_ids loc pat lam =
-  let rec collect acc pat lam = match pat.pat_desc, lam with
-  | Tpat_tuple patl, Lprim(Pmakeblock _, lams, _) ->
-      opt := true;
-      List.fold_left2 collect acc patl lams
-  | Tpat_tuple patl, Lconst(Const_block( _, scl)) ->
-      opt := true;
-      let collect_const acc pat sc = collect acc pat (Lconst sc) in
-      List.fold_left2 collect_const acc patl scl
-  | _ ->
-    (* pattern idents will be bound in staticcatch (let body), so we
-       refresh them here to guarantee binders  uniqueness *)
-    let pat_ids = pat_bound_idents pat in
-    let fresh_ids = List.map (fun id -> id, Ident.rename id) pat_ids in
-    (fresh_ids, alpha_pat fresh_ids pat, lam) :: acc
-  in
-
-  (* sublets were accumulated by 'collect' with the leftmost tuple
-     pattern at the bottom of the list; to respect right-to-left
-     evaluation order for tuples, we must evaluate sublets
-     top-to-bottom. To preserve tail-rec, we will fold_left the
-     reversed list. *)
-  let rev_sublets = List.rev (collect [] pat lam) in
-  let exit =
-    (* build an Ident.tbl to avoid quadratic refreshing costs *)
-    let add t (id, fresh_id) = Ident.add id fresh_id t in
-    let add_ids acc (ids, _pat, _lam) = List.fold_left add acc ids in
-    let tbl = List.fold_left add_ids Ident.empty rev_sublets in
-    let fresh_var id = Lvar (Ident.find_same id tbl) in
-    Lstaticraise(nraise, List.map fresh_var catch_ids)
-  in
-  let push_sublet code (_ids, pat, lam) = simple_for_let loc lam pat code in
-  List.fold_left push_sublet exit rev_sublets
-
 let for_let loc param pat body =
   match pat.pat_desc with
   | Tpat_any ->
@@ -3072,15 +3002,7 @@ let for_let loc param pat body =
       (* fast path, and keep track of simple bindings to unboxable numbers *)
       Llet(Strict, Pgenval, id, param, body)
   | _ ->
-      (* Turn off such optimization to reduce diff in the beginning - FIXME*)
-      if !Config.bs_only then simple_for_let loc param pat body 
-      else
-      let opt = ref false in
-      let nraise = next_raise_count () in
-      let catch_ids = pat_bound_idents pat in
-      let bind = map_return (assign_pat opt nraise catch_ids loc pat) param in
-      if !opt then Lstaticcatch(bind, (nraise, catch_ids), body)
-      else simple_for_let loc param pat body
+      simple_for_let loc param pat body
 
 (* Handling of tupled functions and matchings *)
 

jscomp/ml/predef.ml

@@ -140,18 +140,6 @@ and ident_assert_failure = ident_create_predef_exn "Assert_failure"
 and ident_undefined_recursive_module =
         ident_create_predef_exn "Undefined_recursive_module"
 
-let all_predef_exns = [
-  ident_match_failure;
-  ident_invalid_argument;
-  ident_failure;
-  ident_js_error;
-  ident_not_found;
-  ident_end_of_file;
-  ident_division_by_zero;
-  ident_assert_failure;
-  ident_undefined_recursive_module;
-]
-
 let path_match_failure = Pident ident_match_failure
 and path_assert_failure = Pident ident_assert_failure
 and path_undefined_recursive_module = Pident ident_undefined_recursive_module

jscomp/ml/predef.mli

@@ -77,13 +77,6 @@ val build_initial_env:
 val builtin_values: (string * Ident.t) list
 val builtin_idents: (string * Ident.t) list
 
-(** All predefined exceptions, exposed as [Ident.t] for flambda (for
-    building value approximations).
-    The [Ident.t] for division by zero is also exported explicitly
-    so flambda can generate code to raise it. *)
-val ident_division_by_zero: Ident.t
-val all_predef_exns : Ident.t list
-
 type test =
   | For_sure_yes
   | For_sure_no 

jscomp/ml/switch.ml

@@ -560,15 +560,8 @@ and enum top cases =
         do_make_if_out
           (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
     | _ ->
-        if (*true || *)!Config.bs_only then 
-          do_make_if_out
-            (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx) else
-        Arg.bind
-          (Arg.make_offset ctx.arg (-l))
-          (fun arg ->
-            let ctx = {off= (-l+ctx.off) ; arg=arg} in
-            do_make_if_out
-              (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
+      do_make_if_out
+        (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx)
 
     let do_make_if_in h arg ifso ifno =
       Arg.make_if (Arg.make_isin h arg) ifso ifno
@@ -578,15 +571,8 @@ and enum top cases =
         do_make_if_in
           (Arg.make_const d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
     | _ ->
-        if (*true || *) !Config.bs_only then
-          do_make_if_in
-            (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx) else
-        Arg.bind
-          (Arg.make_offset ctx.arg (-l))
-          (fun arg ->
-            let ctx = {off= (-l+ctx.off) ; arg=arg} in
-            do_make_if_in
-              (Arg.make_const d) arg (mk_ifso ctx) (mk_ifno ctx))
+        do_make_if_in
+          (Arg.make_const d) (Arg.make_offset ctx.arg (-l)) (mk_ifso ctx) (mk_ifno ctx)
 
     let rec c_test ctx ({cases=cases ; actions=actions} as s) =
       let lcases = Array.length cases in
@@ -756,15 +742,7 @@ let make_switch loc {cases=cases ; actions=actions} i j sw_names =
     (fun act i -> acts.(i) <- actions.(act))
     t ;
   (fun ctx ->
-  if !Config.bs_only then
-  Arg.make_switch ~offset:(ll+ctx.off) loc ctx.arg tbl acts sw_names
-  else 
-    match -ll-ctx.off with
-    | 0 -> Arg.make_switch loc ctx.arg tbl acts sw_names ~offset:0
-    | _ ->
-        Arg.bind
-          (Arg.make_offset ctx.arg (-ll-ctx.off))
-          (fun arg -> Arg.make_switch loc arg tbl acts sw_names ~offset:0))
+    Arg.make_switch ~offset:(ll+ctx.off) loc ctx.arg tbl acts sw_names)
 
 
 let make_clusters loc ({cases=cases ; actions=actions} as s) n_clusters k sw_names =

jscomp/ml/typedecl.ml

@@ -208,18 +208,9 @@ let make_params env params =
     List.map make_param params
 
 let transl_labels ?record_name env closed lbls =
-  if !Config.bs_only then 
-    match !Builtin_attributes.check_duplicated_labels lbls with 
+  (match !Builtin_attributes.check_duplicated_labels lbls with 
     | None -> ()
-    | Some {loc;txt=name} -> raise (Error(loc,Duplicate_label (name, record_name)))
-  else (
-  let all_labels = ref StringSet.empty in
-  List.iter
-    (fun {pld_name = {txt=name; loc}} ->
-       if StringSet.mem name !all_labels then
-         raise(Error(loc, Duplicate_label (name, record_name)));
-       all_labels := StringSet.add name !all_labels)
-    lbls);
+    | Some {loc;txt=name} -> raise (Error(loc,Duplicate_label (name, record_name))));
   let mk {pld_name=name;pld_mutable=mut;pld_type=arg;pld_loc=loc;
           pld_attributes=attrs} =
     Builtin_attributes.warning_scope attrs

jscomp/ml/typetexp.ml

@@ -411,16 +411,7 @@ and transl_type_aux env policy styp =
                          row_bound=(); row_closed=true;
                          row_fixed=false; row_name=None}) in
       let hfields = Hashtbl.create 17 in
-      let collection_detect = Hashtbl.create 17 in 
       let add_typed_field loc l f =
-        if not !Config.bs_only  then begin 
-          let h = Btype.hash_variant l in
-          if Hashtbl.mem collection_detect h then 
-            let l' = Hashtbl.find collection_detect h  in 
-            (* Check for tag conflicts *)
-            if l <> l' then raise(Error(styp.ptyp_loc, env, Variant_tags(l, l')));
-          else Hashtbl.add collection_detect h l 
-        end ;
         try
           let (_,f') = Hashtbl.find hfields l in
           let ty = mkfield l f and ty' = mkfield l f' in