Skip to content

Commit f397cd4

Browse files
committed
not link Translobj/Translclass in BS_ONLY mode
1 parent bc2625f commit f397cd4

File tree

2 files changed

+42
-7
lines changed

2 files changed

+42
-7
lines changed

bytecomp/translcore.ml

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -940,6 +940,9 @@ let try_ids = Hashtbl.create 8
940940

941941
let rec transl_exp e =
942942
List.iter (Translattribute.check_attribute e) e.exp_attributes;
943+
#if BS_ONLY then
944+
transl_exp0 e
945+
#else
943946
let eval_once =
944947
(* Whether classes for immediate objects must be cached *)
945948
match e.exp_desc with
@@ -948,7 +951,7 @@ let rec transl_exp e =
948951
in
949952
if eval_once then transl_exp0 e else
950953
Translobj.oo_wrap e.exp_env true transl_exp0 e
951-
954+
#end
952955
and transl_exp0 e =
953956
match e.exp_desc with
954957
Texp_ident(path, _, {val_kind = Val_prim p}) ->
@@ -1263,6 +1266,15 @@ and transl_exp0 e =
12631266
| Texp_for(param, _, low, high, dir, body) ->
12641267
Lfor(param, transl_exp low, transl_exp high, dir,
12651268
event_before body (transl_exp body))
1269+
#if BS_ONLY then
1270+
| Texp_send(expr,met,_) ->
1271+
let obj = transl_exp expr in
1272+
begin match met with
1273+
| Tmeth_name nm ->
1274+
Lsend(Public(Some nm),Lambda.lambda_unit,obj,[],e.exp_loc)
1275+
| _ -> assert false
1276+
end
1277+
#else
12661278
| Texp_send(_, _, Some exp) -> transl_exp exp
12671279
| Texp_send(expr, met, None) ->
12681280
let obj = transl_exp expr in
@@ -1275,6 +1287,7 @@ and transl_exp0 e =
12751287
Lsend (kind, tag, obj, cache, e.exp_loc)
12761288
in
12771289
event_after e lam
1290+
#end
12781291
| Texp_new (cl, {Location.loc=loc}, _) ->
12791292
Lapply{ap_should_be_tailcall=false;
12801293
ap_loc=loc;
@@ -1288,6 +1301,9 @@ and transl_exp0 e =
12881301
| Texp_setinstvar(path_self, path, _, expr) ->
12891302
transl_setinstvar e.exp_loc (transl_normal_path path_self) path expr
12901303
| Texp_override(path_self, modifs) ->
1304+
#if BS_ONLY then
1305+
assert false
1306+
#else
12911307
let cpy = Ident.create "copy" in
12921308
Llet(Strict, Pgenval, cpy,
12931309
Lapply{ap_should_be_tailcall=false;
@@ -1302,6 +1318,7 @@ and transl_exp0 e =
13021318
(Lvar cpy) path expr, rem))
13031319
modifs
13041320
(Lvar cpy))
1321+
#end
13051322
| Texp_letmodule(id, loc, modl, body) ->
13061323
let defining_expr =
13071324
#if true then

bytecomp/translmod.ml

Lines changed: 24 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,14 @@
1515

1616
(* Translation from typed abstract syntax to lambda terms,
1717
for the module language *)
18-
18+
#if BS_ONLY then
19+
module Translobj = struct
20+
let oo_wrap _env _b f a = f a
21+
let reset_labels () : unit = ()
22+
let transl_store_label_init _ _ _ _ : int * _ = assert false
23+
let transl_label_init _ : _ * 'a = assert false
24+
end
25+
#end
1926
open Misc
2027
open Asttypes
2128
open Longident
@@ -25,7 +32,7 @@ open Typedtree
2532
open Lambda
2633
open Translobj
2734
open Translcore
28-
open Translclass
35+
2936

3037
type error =
3138
Circular_dependency of Ident.t
@@ -364,15 +371,15 @@ let rec bound_value_identifiers = function
364371

365372

366373
(* Code to translate class entries in a structure *)
367-
374+
#if undefined BS_ONLY then
368375
let transl_class_bindings cl_list =
369376
let ids = List.map (fun (ci, _) -> ci.ci_id_class) cl_list in
370377
(ids,
371378
List.map
372379
(fun ({ci_id_class=id; ci_expr=cl; ci_virt=vf}, meths) ->
373-
(id, transl_class ids id meths cl vf))
380+
(id, Translclass.transl_class ids id meths cl vf))
374381
cl_list)
375-
382+
#end
376383
(* Compile one or more functors, merging curried functors to produce
377384
multi-argument functors. Any [@inline] attribute on a functor that is
378385
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
632639
body
633640
in
634641
lam, size
642+
#if undefined BS_ONLY then
635643
| Tstr_class cl_list ->
636644
let (ids, class_bindings) = transl_class_bindings cl_list in
637645
let body, size =
638646
transl_structure loc (List.rev_append ids fields)
639647
cc rootpath final_env rem
640648
in
641649
Lletrec(class_bindings, body), size
650+
#else
651+
| Tstr_class _ -> assert false
652+
#end
642653
| Tstr_include incl ->
643654
let ids = bound_value_identifiers incl.incl_type in
644655
let modl = incl.incl_mod in
@@ -972,14 +983,17 @@ let transl_store_structure glob map prims str =
972983
bindings
973984
(Lsequence(store_idents Location.none ids,
974985
transl_store rootpath (add_idents true ids subst) rem))
986+
#if BS_ONLY then
987+
| Tstr_class _ -> assert false
988+
#else
975989
| Tstr_class cl_list ->
976990
let (ids, class_bindings) = transl_class_bindings cl_list in
977991
let lam =
978992
Lletrec(class_bindings, store_idents Location.none ids)
979993
in
980994
Lsequence(subst_lambda subst lam,
981995
transl_store rootpath (add_idents false ids subst) rem)
982-
996+
#end
983997
| Tstr_include{
984998
incl_loc=loc;
985999
incl_mod= {
@@ -1235,12 +1249,16 @@ let transl_toplevel_item item =
12351249
(fun id modl _loc -> transl_module Tcoerce_none (Some(Pident id)) modl)
12361250
bindings
12371251
(make_sequence toploop_setvalue_id idents)
1252+
#if BS_ONLY then
1253+
| Tstr_class _ -> assert false
1254+
#else
12381255
| Tstr_class cl_list ->
12391256
(* we need to use unique names for the classes because there might
12401257
be a value named identically *)
12411258
let (ids, class_bindings) = transl_class_bindings cl_list in
12421259
List.iter set_toplevel_unique_name ids;
12431260
Lletrec(class_bindings, make_sequence toploop_setvalue_id ids)
1261+
#end
12441262
| Tstr_include incl ->
12451263
let ids = bound_value_identifiers incl.incl_type in
12461264
let modl = incl.incl_mod in

0 commit comments

Comments
 (0)