Skip to content

Commit

Permalink
[jvm] deal with functional interfaces
Browse files Browse the repository at this point in the history 
see #9576
  • Loading branch information
@Simn
Simn committed Dec 1, 2021
1 parent 2810be1 commit b48cc43
Show file tree
Hide file tree
Showing 3 changed files with 94 additions and 77 deletions.
49 changes: 25 additions & 24 deletions src/codegen/javaModern.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -196,33 +196,34 @@ module JReaderHoldovers = struct

let parse_formal_type_params s = match s.[0] with
| '<' ->
let rec read_id i =
match s.[i] with
| ':' | '>' -> i
| _ -> read_id (i + 1)
let rec read_id i = match s.[i] with
| ':' | '>' -> i
| _ -> read_id (i + 1)
in
let len = String.length s in
let rec parse_params idx acc =
let idi = read_id (idx + 1) in
let id = String.sub s (idx + 1) (idi - idx - 1) in
(* next must be a : *)
(match s.[idi] with | ':' -> () | _ -> failwith ("Invalid formal type signature character: " ^ Char.escaped s.[idi] ^ " ; from " ^ s));
let ext, l = match s.[idi + 1] with
| ':' | '>' -> None, idi + 1
| _ ->
let sgn, l = parse_signature_part (String.sub s (idi + 1) (len - idi - 1)) in
Some sgn, l + idi + 1
in
let rec loop idx acc =
match s.[idx] with
| ':' ->
let ifacesig, ifacei = parse_signature_part (String.sub s (idx + 1) (len - idx - 1)) in
loop (idx + ifacei + 1) (ifacesig :: acc)
| _ -> acc, idx
in
let ifaces, idx = loop l [] in
let acc = (id, ext, ifaces) :: acc in
if s.[idx] = '>' then List.rev acc, idx + 1 else parse_params (idx - 1) acc
let idi = read_id (idx + 1) in
let id = String.sub s (idx + 1) (idi - idx - 1) in
(* next must be a : *)
(match s.[idi] with | ':' -> () | _ -> failwith ("Invalid formal type signature character: " ^ Char.escaped s.[idi] ^ " ; from " ^ s));
let ext, l = match s.[idi + 1] with
| ':' | '>' ->
None, idi + 1
| _ ->
let sgn, l = parse_signature_part (String.sub s (idi + 1) (len - idi - 1)) in
Some sgn, l + idi + 1
in
let rec loop idx acc =
match s.[idx] with
| ':' ->
let ifacesig, ifacei = parse_signature_part (String.sub s (idx + 1) (len - idx - 1)) in
loop (idx + ifacei + 1) (ifacesig :: acc)
| _ ->
acc, idx
in
let ifaces, idx = loop l [] in
let acc = (id, ext, ifaces) :: acc in
if s.[idx] = '>' then List.rev acc, idx + 1 else parse_params (idx - 1) acc
in
parse_params 0 []
| _ -> [], 0
Expand Down
40 changes: 34 additions & 6 deletions src/generators/genjvm.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,7 @@ let rec jsignature_of_type gctx stack t =
TObject((["haxe";"root"],"Array"),[TType(WNone,t)])
| TInst({cl_path = (["java"],"NativeArray")},[t]) ->
TArray(jsignature_of_type t,None)
| TInst({cl_kind = KTypeParameter [t]},_) -> jsignature_of_type t
| TInst({cl_kind = KTypeParameter [t]},_) when t != t_dynamic -> jsignature_of_type t
| TInst({cl_kind = KTypeParameter _; cl_path = (_,name)},_) -> TTypeParameter name
| TInst({cl_path = ["_Class"],"Class_Impl_"},_) -> java_class_sig
| TInst({cl_path = ["_Enum"],"Enum_Impl_"},_) -> java_class_sig
Expand Down Expand Up @@ -383,7 +383,7 @@ let create_field_closure gctx jc path_this jm name jsig =
| _ ->
die "" __LOC__
in
let jm_invoke = wf#generate_invoke args ret in
let jm_invoke = wf#generate_invoke args ret [] in
let vars = List.map (fun (name,jsig) ->
jm_invoke#add_local name jsig VarArgument
) args in
Expand Down Expand Up @@ -512,7 +512,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
jm_init#construct ConstructInit jc_closure#get_this_path (fun () -> []);
jm_init#putstatic jc_closure#get_this_path jf_closure#get_name jf_closure#get_jsig;

method tfunction e tf =
method tfunction ret e tf =
let outside,accesses_this = Texpr.collect_captured_vars e in
let env = List.map (fun v ->
v.v_id,(v.v_name,self#vtype v.v_type)
Expand All @@ -522,6 +522,10 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
let wf = new JvmFunctions.typed_function gctx.typed_functions FuncLocal jc jm context in
let jc_closure = wf#get_class in
ignore(wf#generate_constructor (env <> []));
let filter = match ret with
| RValue (Some (TObject(path,_))) -> [path]
| _ -> []
in
let args,ret =
let args = List.map (fun (v,eo) ->
(* TODO: Can we do this differently? *)
Expand All @@ -530,7 +534,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
) tf.tf_args in
args,(return_of_type gctx tf.tf_type)
in
let jm_invoke = wf#generate_invoke args ret in
let jm_invoke = wf#generate_invoke args ret filter in
let handler = new texpr_to_jvm gctx jc_closure jm_invoke ret in
handler#set_env env;
let args = List.map (fun (v,eo) ->
Expand Down Expand Up @@ -607,7 +611,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
let wf = new JvmFunctions.typed_function gctx.typed_functions (FuncStatic(path,name)) jc jm [] in
let jc_closure = wf#get_class in
ignore(wf#generate_constructor false);
let jm_invoke = wf#generate_invoke args ret in
let jm_invoke = wf#generate_invoke args ret [] in
let vars = List.map (fun (name,jsig) ->
jm_invoke#add_local name jsig VarArgument
) args in
Expand Down Expand Up @@ -1943,7 +1947,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return
self#emit_block_exits false;
jm#return;
| TFunction tf ->
self#tfunction e tf
self#tfunction ret e tf
| TArrayDecl el when not (need_val ret) ->
List.iter (self#texpr ret) el
| TArrayDecl el ->
Expand Down Expand Up @@ -2843,6 +2847,29 @@ module Preprocessor = struct
end else if fst mt.mt_path = [] then
mt.mt_path <- make_root mt.mt_path

let check_single_method_interface gctx c =
let rec loop m l = match l with
| [] ->
m
| cf :: l ->
if not (has_class_field_flag cf CfDefault) then begin match m with
| None ->
loop (Some cf) l
| Some _ ->
None
end else
loop m l
in
match loop None c.cl_ordered_fields with
| None ->
()
| Some cf ->
match jsignature_of_type gctx cf.cf_type with
| TMethod(args,ret) ->
JvmFunctions.JavaFunctionalInterfaces.add args ret c.cl_path cf.cf_name (List.map fst (c.cl_params @ cf.cf_params));
| _ ->
()

let preprocess gctx =
let rec has_runtime_meta = function
| (Meta.Custom s,_,_) :: _ when String.length s > 0 && s.[0] <> ':' ->
Expand Down Expand Up @@ -2872,6 +2899,7 @@ module Preprocessor = struct
match mt with
| TClassDecl c ->
if not (has_class_flag c CInterface) then gctx.preprocessor#preprocess_class c
else check_single_method_interface gctx c;
| _ -> ()
) gctx.com.types;
(* find typedef-interface implementations *)
Expand Down
82 changes: 35 additions & 47 deletions src/generators/jvm/jvmFunctions.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -294,39 +294,17 @@ module JavaFunctionalInterfaces = struct
jparams : string list;
}

let java_functional_interfaces =
let juf = ["java";"util";"function"] in
let tp name = TTypeParameter name in
[
{
jargs = [];
jret = None;
jpath = ["java";"lang"],"Runnable";
jname = "run";
jparams = []
};
{
jargs = [tp "T"];
jret = None;
jpath = juf,"Consumer";
jname = "accept";
jparams = ["T"]
};
{
jargs = [tp "T";tp "U"];
jret = None;
jpath = juf,"BiConsumer";
jname = "accept";
jparams = ["T";"U"]
};
{
jargs = [tp "T"];
jret = Some (tp "R");
jpath = juf,"Function";
jname = "apply";
jparams = ["T";"R"]
};
]
let java_functional_interfaces = DynArray.create ()

let add args ret path name params =
let jfi = {
jargs = args;
jret = ret;
jpath = path;
jname = name;
jparams = params;
} in
DynArray.add java_functional_interfaces jfi

let unify jfi args ret =
let rec loop params want have = match want,have with
Expand Down Expand Up @@ -357,15 +335,22 @@ module JavaFunctionalInterfaces = struct
None


let find_compatible args ret =
ExtList.List.filter_map (fun jfi ->
if jfi.jparams = [] then begin
if jfi.jargs = args && jfi.jret = ret then
Some (jfi,[])
else None
let find_compatible args ret filter =
DynArray.fold_left (fun acc jfi ->
if filter = [] || List.mem jfi.jpath filter then begin
if jfi.jparams = [] then begin
if jfi.jargs = args && jfi.jret = ret then
(jfi,[]) :: acc
else
acc
end else match unify jfi args ret with
| Some x ->
x :: acc
| None ->
acc
end else
unify jfi args ret
) java_functional_interfaces
acc
) [] java_functional_interfaces
end

open JavaFunctionalInterfaces
Expand Down Expand Up @@ -406,7 +391,7 @@ class typed_function
jm_ctor#return;
jm_ctor

method generate_invoke (args : (string * jsignature) list) (ret : jsignature option)=
method generate_invoke (args : (string * jsignature) list) (ret : jsignature option) (functional_interface_filter : jpath list) =
let arg_sigs = List.map snd args in
let meth = functions#register_signature arg_sigs ret in
let jsig_invoke = method_sig arg_sigs ret in
Expand All @@ -419,14 +404,17 @@ class typed_function
end
in
let spawn_forward_function meth_from meth_to is_bridge =
let flags = [MPublic] in
let flags = if is_bridge then MBridge :: MSynthetic :: flags else flags in
let jm_invoke_next = jc_closure#spawn_method meth_from.name (method_sig meth_from.dargs meth_from.dret) flags in
functions#make_forward_method jc_closure jm_invoke_next meth_from meth_to;
let msig = method_sig meth_from.dargs meth_from.dret in
if not (jc_closure#has_method meth_from.name msig) then begin
let flags = [MPublic] in
let flags = if is_bridge then MBridge :: MSynthetic :: flags else flags in
let jm_invoke_next = jc_closure#spawn_method meth_from.name msig flags in
functions#make_forward_method jc_closure jm_invoke_next meth_from meth_to;
end
in
let check_functional_interfaces meth =
try
let l = JavaFunctionalInterfaces.find_compatible meth.dargs meth.dret in
let l = JavaFunctionalInterfaces.find_compatible meth.dargs meth.dret functional_interface_filter in
List.iter (fun (jfi,params) ->
add_interface jfi.jpath params;
spawn_forward_function {meth with name=jfi.jname} meth false;
Expand Down

0 comments on commit b48cc43

Please sign in to comment.