|
@@ -689,22 +689,28 @@ let init_class ctx c p herits fields =
|
|
| Cpp -> [["cpp"], "Boot"]
|
|
| Cpp -> [["cpp"], "Boot"]
|
|
| _ -> [] in
|
|
| _ -> [] in
|
|
let must_keep_class = (List.exists (fun p -> p = c.cl_path) (must_keep_types ctx.com.platform)) in
|
|
let must_keep_class = (List.exists (fun p -> p = c.cl_path) (must_keep_types ctx.com.platform)) in
|
|
- let keep f stat = core_api || (is_main f.cff_name) || must_keep_class || has_meta ":keep" c.cl_meta || has_meta ":keep" f.cff_meta || (stat && f.cff_name = "__init__") in
|
|
|
|
|
|
+ let keep f stat = core_api || (is_main f.cff_name) || c.cl_extern || must_keep_class || has_meta ":keep" c.cl_meta || has_meta ":keep" f.cff_meta || (stat && f.cff_name = "__init__") in
|
|
let remove_by_cfname item lst = List.filter (fun i -> item <> i.cf_name) lst in
|
|
let remove_by_cfname item lst = List.filter (fun i -> item <> i.cf_name) lst in
|
|
- let remove_untyped_field cf stat = (fun () ->
|
|
|
|
|
|
+ let remove_field cf stat =
|
|
|
|
+ if ctx.com.verbose then print_endline ("Remove field " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name);
|
|
|
|
+ if stat then begin
|
|
|
|
+ c.cl_statics <- PMap.remove cf.cf_name c.cl_statics;
|
|
|
|
+ c.cl_ordered_statics <- remove_by_cfname cf.cf_name c.cl_ordered_statics;
|
|
|
|
+ end else begin
|
|
|
|
+ if cf.cf_name = "new" then c.cl_constructor <- None;
|
|
|
|
+ c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
|
|
|
|
+ c.cl_ordered_fields <- remove_by_cfname cf.cf_name c.cl_ordered_fields;
|
|
|
|
+ end
|
|
|
|
+ in
|
|
|
|
+ let remove_method_if_unreferenced cf stat = (fun () ->
|
|
match cf.cf_expr with
|
|
match cf.cf_expr with
|
|
| None ->
|
|
| None ->
|
|
- if ctx.com.verbose then print_endline ("Removed " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name);
|
|
|
|
- if stat then begin
|
|
|
|
- c.cl_statics <- PMap.remove cf.cf_name c.cl_statics;
|
|
|
|
- c.cl_ordered_statics <- remove_by_cfname cf.cf_name c.cl_ordered_statics;
|
|
|
|
- end else begin
|
|
|
|
- if cf.cf_name = "new" then c.cl_constructor <- None;
|
|
|
|
- c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
|
|
|
|
- c.cl_ordered_fields <- remove_by_cfname cf.cf_name c.cl_ordered_fields;
|
|
|
|
- end
|
|
|
|
|
|
+ remove_field cf stat
|
|
| _ -> ())
|
|
| _ -> ())
|
|
in
|
|
in
|
|
|
|
+ let remove_var_if_unreferenced cf stat = (fun () ->
|
|
|
|
+ ())
|
|
|
|
+ in
|
|
let loop_cf f =
|
|
let loop_cf f =
|
|
let name = f.cff_name in
|
|
let name = f.cff_name in
|
|
let p = f.cff_pos in
|
|
let p = f.cff_pos in
|
|
@@ -738,7 +744,9 @@ let init_class ctx c p herits fields =
|
|
} in
|
|
} in
|
|
let delay = if (ctx.com.dead_code_elimination && not !Common.display) then begin
|
|
let delay = if (ctx.com.dead_code_elimination && not !Common.display) then begin
|
|
(match e with
|
|
(match e with
|
|
- | None -> (fun() -> ())
|
|
|
|
|
|
+ | None -> (fun() ->
|
|
|
|
+ if not (keep f stat) then delay ctx (remove_var_if_unreferenced cf stat);
|
|
|
|
+ ())
|
|
| Some e ->
|
|
| Some e ->
|
|
let ctx = { ctx with curclass = c; tthis = tthis } in
|
|
let ctx = { ctx with curclass = c; tthis = tthis } in
|
|
let r = exc_protect (fun r ->
|
|
let r = exc_protect (fun r ->
|
|
@@ -748,10 +756,11 @@ let init_class ctx c p herits fields =
|
|
t
|
|
t
|
|
) in
|
|
) in
|
|
cf.cf_type <- TLazy r;
|
|
cf.cf_type <- TLazy r;
|
|
- (fun () ->
|
|
|
|
- if not (keep f stat) then begin
|
|
|
|
- delay ctx (remove_untyped_field cf stat)
|
|
|
|
- end else
|
|
|
|
|
|
+ (fun () ->
|
|
|
|
+ if ctx.com.verbose then print_endline ("field " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name);
|
|
|
|
+ if not (keep f stat) then
|
|
|
|
+ delay ctx (remove_var_if_unreferenced cf stat)
|
|
|
|
+ else
|
|
ignore(!r())
|
|
ignore(!r())
|
|
)
|
|
)
|
|
)
|
|
)
|
|
@@ -851,7 +860,7 @@ let init_class ctx c p herits fields =
|
|
cf.cf_type <- TLazy r;
|
|
cf.cf_type <- TLazy r;
|
|
(fun() ->
|
|
(fun() ->
|
|
if not (keep f stat) then begin
|
|
if not (keep f stat) then begin
|
|
- delay ctx (remove_untyped_field cf stat)
|
|
|
|
|
|
+ delay ctx (remove_method_if_unreferenced cf stat)
|
|
end else
|
|
end else
|
|
ignore((!r)())
|
|
ignore((!r)())
|
|
)
|
|
)
|
|
@@ -1245,7 +1254,7 @@ let type_module ctx m tdecls loadp =
|
|
| _ -> assert false);
|
|
| _ -> assert false);
|
|
) tdecls;
|
|
) tdecls;
|
|
(* PASS 3 : type checking, delayed until all modules and types are built *)
|
|
(* PASS 3 : type checking, delayed until all modules and types are built *)
|
|
- List.iter (delay ctx) (List.rev (!delays));
|
|
|
|
|
|
+ List.iter (delay ctx) (List.rev (!delays));
|
|
m
|
|
m
|
|
|
|
|
|
let parse_module ctx m p =
|
|
let parse_module ctx m p =
|