diff --git a/src/codegen/javaModern.ml b/src/codegen/javaModern.ml index 5372227b843..3f7e07a0b58 100644 --- a/src/codegen/javaModern.ml +++ b/src/codegen/javaModern.ml @@ -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 diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 535e08f74b7..a3c2d6cb925 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -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 @@ -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 @@ -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) @@ -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? *) @@ -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) -> @@ -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 @@ -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 -> @@ -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] <> ':' -> @@ -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 *) diff --git a/src/generators/jvm/jvmFunctions.ml b/src/generators/jvm/jvmFunctions.ml index a29e83956a8..8b716254580 100644 --- a/src/generators/jvm/jvmFunctions.ml +++ b/src/generators/jvm/jvmFunctions.ml @@ -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 @@ -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 @@ -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 @@ -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;