not link Translobj/Translclass in BS_ONLY mode

Author: bobzhang

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 then        

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 _ : _ * 'a = assert false
+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