Skip to content

Commit

Permalink
not link Translobj/Translclass in BS_ONLY mode
Browse files Browse the repository at this point in the history
  • Loading branch information
bobzhang committed Feb 25, 2021
1 parent bc2625f commit 803c6e6
Show file tree
Hide file tree
Showing 2 changed files with 42 additions and 7 deletions.
19 changes: 18 additions & 1 deletion bytecomp/translcore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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}) ->
Expand Down Expand Up @@ -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
Expand All @@ -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;
Expand All @@ -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;
Expand All @@ -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
Expand Down
30 changes: 24 additions & 6 deletions bytecomp/translmod.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -25,7 +32,7 @@ open Typedtree
open Lambda
open Translobj
open Translcore
open Translclass


type error =
Circular_dependency of Ident.t
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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= {
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 803c6e6

Please sign in to comment.