Indent deprecation warning's userland message

.gitignore

@@ -413,5 +413,3 @@ _ocamltest
 lib/ocaml/
 man/
 
-_esy
-esy.lock

asmcomp/cmmgen.ml

@@ -1447,7 +1447,7 @@ struct
   let make_isout h arg = Cop (Ccmpa Clt, [h ; arg], Debuginfo.none)
   let make_isin h arg = Cop (Ccmpa Cge, [h ; arg], Debuginfo.none)
   let make_if cond ifso ifnot = Cifthenelse (cond, ifso, ifnot)
-  let make_switch loc arg cases actions _names =
+  let make_switch loc arg cases actions ~offset:_ _names =
     make_switch arg cases actions (Debuginfo.from_location loc)
   let bind arg body = bind "switcher" arg body
 

bytecomp/matching.ml

@@ -1954,10 +1954,10 @@ module SArg = struct
   let make_isout h arg = Lprim (Pisout, [h ; arg],Location.none)
   let make_isin h arg = Lprim (Pnot,[make_isout h arg],Location.none)
   let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
-  let make_switch loc arg cases acts sw_names =
+  let make_switch loc arg cases acts ~offset sw_names =
     let l = ref [] in
     for i = Array.length cases-1 downto 0 do
-      l := (i,acts.(cases.(i))) ::  !l
+      l := (offset + i,acts.(cases.(i))) ::  !l
     done ;
     Lswitch(arg,
             {sw_numconsts = Array.length cases ; sw_consts = !l ;
@@ -2500,6 +2500,11 @@ let make_test_sequence_variant_constant :
     ref
   = ref make_test_sequence_variant_constant        
 
+let is_poly_var_constant : Lambda.primitive lazy_t = lazy (
+  if !Config.bs_only then  
+    Pccall (Primitive.simple ~name:"#is_poly_var_const" ~arity:1 ~alloc:false)
+  else Pisint ) 
+
 let combine_variant names loc row arg partial ctx def
                     (tag_lambda_list, total1, _pats) =
   let row = Btype.row_repr row in
@@ -2514,9 +2519,9 @@ 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 =
-    Lifthenelse(Lprim (Pisint, [arg], loc), if_int, if_block) in
+    Lifthenelse(Lprim (Lazy.force is_poly_var_constant, [arg], loc), if_int, if_block) in
   let sig_complete =  List.length tag_lambda_list = !num_constr
-  and one_action = same_actions tag_lambda_list in
+  and one_action = same_actions tag_lambda_list in (* reduandant work under bs context *)
   let fail, local_jumps =
     if
       sig_complete  || (match partial with Total -> true | _ -> false)

bytecomp/switch.ml

@@ -106,7 +106,7 @@ module type S =
    val make_isout : act -> act -> act
    val make_isin : act -> act -> act
    val make_if : act -> act -> act -> act
-   val make_switch : Location.t -> act -> int array -> act array -> Lambda.switch_names option -> act
+   val make_switch : Location.t -> act -> int array -> act array -> offset:int -> Lambda.switch_names option -> act
    val make_catch : act -> int * (act -> act)
    val make_exit : int -> act
  end
@@ -560,6 +560,9 @@ 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 ->
@@ -575,6 +578,9 @@ 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 ->
@@ -750,12 +756,15 @@ 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
+    | 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))
+          (fun arg -> Arg.make_switch loc arg tbl acts sw_names ~offset:0))
 
 
 let make_clusters loc ({cases=cases ; actions=actions} as s) n_clusters k sw_names =

bytecomp/switch.mli

@@ -79,7 +79,7 @@ module type S =
       make_switch arg cases acts
       NB:  cases is in the value form *)
     val make_switch :
-        Location.t -> act -> int array -> act array -> Lambda.switch_names option -> act
+        Location.t -> act -> int array -> act array -> offset:int -> Lambda.switch_names option -> act
    (* Build last minute sharing of action stuff *)
    val make_catch : act -> int * (act -> act)
    val make_exit : int -> act

bytecomp/translcore.ml

@@ -940,6 +940,9 @@ let try_ids = Hashtbl.create 8
 
 let rec transl_exp e =
   List.iter (Translattribute.check_attribute e) e.exp_attributes;
+#if BS_ONLY then
+  transl_exp0 e
+#else
   let eval_once =
     (* Whether classes for immediate objects must be cached *)
     match e.exp_desc with
@@ -948,7 +951,7 @@ let rec transl_exp e =
   in
   if eval_once then transl_exp0 e else
   Translobj.oo_wrap e.exp_env true transl_exp0 e
-
+#end
 and transl_exp0 e =
   match e.exp_desc with
     Texp_ident(path, _, {val_kind = Val_prim p}) ->
@@ -1263,6 +1266,15 @@ and transl_exp0 e =
   | Texp_for(param, _, low, high, dir, body) ->
       Lfor(param, transl_exp low, transl_exp high, dir,
            event_before body (transl_exp body))
+#if BS_ONLY then           
+  | Texp_send(expr,met,_) -> 
+    let obj = transl_exp expr in   
+    begin match met with 
+    | Tmeth_name nm -> 
+      Lsend(Public(Some nm),Lambda.lambda_unit,obj,[],e.exp_loc)
+    | _ -> assert false    
+    end
+#else
   | Texp_send(_, _, Some exp) -> transl_exp exp
   | Texp_send(expr, met, None) ->
       let obj = transl_exp expr in
@@ -1275,6 +1287,7 @@ and transl_exp0 e =
             Lsend (kind, tag, obj, cache, e.exp_loc)
       in
       event_after e lam
+#end      
   | Texp_new (cl, {Location.loc=loc}, _) ->
       Lapply{ap_should_be_tailcall=false;
              ap_loc=loc;
@@ -1288,6 +1301,9 @@ and transl_exp0 e =
   | Texp_setinstvar(path_self, path, _, expr) ->
       transl_setinstvar e.exp_loc (transl_normal_path path_self) path expr
   | Texp_override(path_self, modifs) ->
+#if BS_ONLY then 
+      assert false
+#else  
       let cpy = Ident.create "copy" in
       Llet(Strict, Pgenval, cpy,
            Lapply{ap_should_be_tailcall=false;
@@ -1302,6 +1318,7 @@ and transl_exp0 e =
                             (Lvar cpy) path expr, rem))
              modifs
              (Lvar cpy))
+#end             
   | Texp_letmodule(id, loc, modl, body) ->
       let defining_expr =
 #if true        

bytecomp/translmod.ml

@@ -15,7 +15,14 @@
 
 (* Translation from typed abstract syntax to lambda terms,
    for the module language *)
-
+#if BS_ONLY then 
+module Translobj = struct 
+  let oo_wrap _env _b f a = f a 
+  let reset_labels () : unit = () 
+  let transl_store_label_init _ _ _ _ : int * _  =   assert false
+  let transl_label_init f = f ()      
+end  
+#end
 open Misc
 open Asttypes
 open Longident
@@ -25,7 +32,7 @@ open Typedtree
 open Lambda
 open Translobj
 open Translcore
-open Translclass
+
 
 type error =
   Circular_dependency of Ident.t
@@ -364,15 +371,15 @@ let rec bound_value_identifiers = function
 
 
 (* Code to translate class entries in a structure *)
-
+#if undefined BS_ONLY then
 let transl_class_bindings cl_list =
   let ids = List.map (fun (ci, _) -> ci.ci_id_class) cl_list in
   (ids,
    List.map
      (fun ({ci_id_class=id; ci_expr=cl; ci_virt=vf}, meths) ->
-       (id, transl_class ids id meths cl vf))
+       (id, Translclass.transl_class ids id meths cl vf))
      cl_list)
-
+#end
 (* Compile one or more functors, merging curried functors to produce
    multi-argument functors.  Any [@inline] attribute on a functor that is
    merged must be consistent with any other [@inline] attribute(s) on the
@@ -632,13 +639,17 @@ and transl_structure loc fields cc rootpath final_env = function
               body
           in
           lam, size
+#if undefined BS_ONLY then          
       | Tstr_class cl_list ->
           let (ids, class_bindings) = transl_class_bindings cl_list in
           let body, size =
             transl_structure loc (List.rev_append ids fields)
               cc rootpath final_env rem
           in
           Lletrec(class_bindings, body), size
+#else 
+      | Tstr_class _ -> assert false      
+#end          
       | Tstr_include incl ->
           let ids = bound_value_identifiers incl.incl_type in
           let modl = incl.incl_mod in
@@ -972,14 +983,17 @@ let transl_store_structure glob map prims str =
               bindings
               (Lsequence(store_idents Location.none ids,
                          transl_store rootpath (add_idents true ids subst) rem))
+#if BS_ONLY then 
+        | Tstr_class _ -> assert false                         
+#else        
         | Tstr_class cl_list ->
             let (ids, class_bindings) = transl_class_bindings cl_list in
             let lam =
               Lletrec(class_bindings, store_idents Location.none ids)
             in
             Lsequence(subst_lambda subst lam,
                       transl_store rootpath (add_idents false ids subst) rem)
-
+#end
         | Tstr_include{
             incl_loc=loc;
             incl_mod= {
@@ -1235,12 +1249,16 @@ let transl_toplevel_item item =
         (fun id modl _loc -> transl_module Tcoerce_none (Some(Pident id)) modl)
         bindings
         (make_sequence toploop_setvalue_id idents)
+#if BS_ONLY then 
+  | Tstr_class _ -> assert false         
+#else  
   | Tstr_class cl_list ->
       (* we need to use unique names for the classes because there might
          be a value named identically *)
       let (ids, class_bindings) = transl_class_bindings cl_list in
       List.iter set_toplevel_unique_name ids;
       Lletrec(class_bindings, make_sequence toploop_setvalue_id ids)
+#end      
   | Tstr_include incl ->
       let ids = bound_value_identifiers incl.incl_type in
       let modl = incl.incl_mod in

parsing/builtin_attributes.ml

@@ -63,7 +63,8 @@ let cat s1 s2 =
   if s2 = "" then s1 else
 #if undefined BS_NO_COMPILER_PATCH then 
     if Clflags.bs_vscode then s1 ^ " " ^ s2
-    else s1 ^ "\n" ^ s2 
+    (* 2 spaces indentation for the next line *)
+    else s1 ^ "\n  " ^ s2 
 #else    
     s1 ^ "\n" ^ s2
 #end