Remove unused non-bs code

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
@@ -2274,14 +2273,13 @@ let split_variant_cases tag_lambda_list =
   sort_int_lambda_list const,
   sort_int_lambda_list nonconst  
 
-let split_extension_cases tag_lambda_list =
+let get_extension_cases tag_lambda_list =
   let rec split_rec = function
-      [] -> ([], [])
+      [] -> []
     | (cstr, act) :: rem ->
-        let (consts, nonconsts) = split_rec rem in
+        let 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)
+        | Cstr_extension(path, _) -> ((path, act) :: nonconsts)
         | _ -> assert false in
   split_rec tag_lambda_list
 
@@ -2295,39 +2293,29 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
     let fail, local_jumps =
       mk_failaction_neg partial ctx def in
     let lambda1 =
-      let consts, nonconsts = split_extension_cases tag_lambda_list in
-      let default, consts, nonconsts =
+      let extension_cases = get_extension_cases tag_lambda_list in
+      let default, extension_cases =
         match fail with
         | None ->
-            begin match consts, nonconsts with
-            | _, (_, act)::rem -> act, consts, rem
-            | (_, act)::rem, _ -> act, rem, nonconsts
+            begin match extension_cases with
+            | (_, act)::rem -> act, rem
             | _ -> assert false
             end
-        | Some fail -> fail, consts, nonconsts in
-      let nonconst_lambda =
-        match nonconsts with
-          [] -> default
+        | Some fail -> fail, extension_cases in
+      match extension_cases 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)
-      in
-        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))
-          consts
-          nonconst_lambda
+          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))
+              extension_cases
+              default
+          in
+            Llet(Alias, Pgenval,tag,  arg, tests)
     in
     lambda1, jumps_union local_jumps total1
   end else begin
@@ -2355,7 +2343,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 +2440,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 +2986,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 +2996,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/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