[java/cs] Added overload support

common.ml

@@ -80,6 +80,8 @@ type platform_config = {
 	pf_pad_nulls : bool;
 	(** add a final return to methods not having one already - prevent some compiler warnings *)
 	pf_add_final_return : bool;
+	(** does the platform natively support overloaded functions *)
+	pf_overload : bool;
 }
 
 type context = {
@@ -270,6 +272,7 @@ let default_config =
 		pf_capture_policy = CPNone;
 		pf_pad_nulls = false;
 		pf_add_final_return = false;
+		pf_overload = false;
 	}
 
 let get_config com =
@@ -288,6 +291,7 @@ let get_config com =
 			pf_capture_policy = CPLoopVars;
 			pf_pad_nulls = false;
 			pf_add_final_return = false;
+			pf_overload = false;
 		}
 	| Js ->
 		{
@@ -300,6 +304,7 @@ let get_config com =
 			pf_capture_policy = CPLoopVars;
 			pf_pad_nulls = false;
 			pf_add_final_return = false;
+			pf_overload = false;
 		}
 	| Neko ->
 		{
@@ -312,6 +317,7 @@ let get_config com =
 			pf_capture_policy = CPNone;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
+			pf_overload = false;
 		}
 	| Flash when defined Define.As3 ->
 		{
@@ -324,6 +330,7 @@ let get_config com =
 			pf_capture_policy = CPLoopVars;
 			pf_pad_nulls = false;
 			pf_add_final_return = true;
+			pf_overload = false;
 		}
 	| Flash ->
 		{
@@ -336,6 +343,7 @@ let get_config com =
 			pf_capture_policy = CPLoopVars;
 			pf_pad_nulls = false;
 			pf_add_final_return = false;
+			pf_overload = false;
 		}
 	| Php ->
 		{
@@ -346,13 +354,14 @@ let get_config com =
 			pf_unique_locals = false;
 			pf_can_init_member = (fun cf ->
 				match cf.cf_kind, cf.cf_expr with
-				| Var { v_write = AccCall _ },  _ -> false
+				| Var { v_write = AccCall _ },	_ -> false
 				| _, Some { eexpr = TTypeExpr _ } -> false
 				| _ -> true
 			);
 			pf_capture_policy = CPNone;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
+			pf_overload = false;
 		}
 	| Cpp ->
 		{
@@ -365,6 +374,7 @@ let get_config com =
 			pf_capture_policy = CPWrapRef;
 			pf_pad_nulls = true;
 			pf_add_final_return = true;
+			pf_overload = false;
 		}
 	| Cs ->
 		{
@@ -377,6 +387,7 @@ let get_config com =
 			pf_capture_policy = CPWrapRef;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
+			pf_overload = true;
 		}
 	| Java ->
 		{
@@ -389,6 +400,7 @@ let get_config com =
 			pf_capture_policy = CPWrapRef;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
+			pf_overload = true;
 		}
 
 let create v args =

dce.ml

@@ -391,7 +391,10 @@ let run com main full =
 				mark_t dce cf.cf_type
 			) cfl;
 			(* follow expressions to new types/fields *)
-			List.iter (fun (_,cf,_) -> opt (expr dce) cf.cf_expr) cfl;
+			List.iter (fun (_,cf,_) ->
+				opt (expr dce) cf.cf_expr;
+				List.iter (fun cf -> if cf.cf_expr <> None then opt (expr dce) cf.cf_expr) cf.cf_overloads
+			) cfl;
 			loop ()
 	in
 	loop ();

gencommon.ml

@@ -1125,6 +1125,28 @@ let mk_paren e =
 let rec get_last_ctor cl =
   Option.map_default (fun (super,_) -> if is_some super.cl_constructor then Some(get super.cl_constructor) else get_last_ctor super) None cl.cl_super
 
+let add_constructor cl cf =
+  match cl.cl_constructor with
+  | None -> cl.cl_constructor <- Some cf
+  | Some ctor ->
+      if ctor != cf && not (List.memq cf ctor.cf_overloads) then
+        ctor.cf_overloads <- cf :: ctor.cf_overloads
+
+(* replace open TMonos with TDynamic *)
+let rec replace_mono t =
+  match follow t with
+  | TMono t -> t := Some t_dynamic
+  | TEnum (_,p) | TInst (_,p) | TType (_,p) | TAbstract (_,p) ->
+      List.iter replace_mono p
+  | TFun (args,ret) ->
+      List.iter (fun (_,_,t) -> replace_mono t) args;
+      replace_mono ret
+  | TAnon a ->
+      PMap.iter (fun _ f -> replace_mono f.cf_type) a.a_fields
+  | TDynamic _ -> ()
+  | _ -> assert false
+
+
 (* helper *)
 let mk_class_field name t public pos kind params =
   {
@@ -1451,15 +1473,20 @@ struct
         | _ -> ()
       );
 
-      let rec get_last_static_ctor cl params =
+      let rec get_last_static_ctor cl params mayt =
         match cl.cl_super with
           | None -> None
           | Some (super,tl) ->
             let params = List.map (apply_params cl.cl_types params) tl in
-            if PMap.mem static_ctor_name super.cl_statics then
-              Some(mk_static_field_access_infer super static_ctor_name super.cl_pos params)
-            else
-              get_last_static_ctor super params
+            try
+              let cf = PMap.find static_ctor_name super.cl_statics in
+              (match mayt with
+                | None -> Some (cf, super, tl)
+                | Some argst ->
+                    let chosen_cf = List.find (fun cf -> try unify (apply_params cf.cf_params tl cf.cf_type) argst; true with | Unify_error _ -> false) (cf :: cf.cf_overloads) in
+                    Some(chosen_cf, super, tl))
+            with | Not_found ->
+              get_last_static_ctor super params mayt
       in
 
       let rec prev_ctor cl =
@@ -1479,7 +1506,7 @@ struct
 
       (* check if we have a constructor right now *)
       let do_empty_only and_no_args_too =
-        let super = match get_last_static_ctor cl (List.map snd cl.cl_types) with
+        let super = match get_last_static_ctor cl (List.map snd cl.cl_types) None with
           | None ->
             { eexpr = TCall({ eexpr = TConst(TSuper); etype = TInst(cl, List.map snd cl.cl_types); epos = cl.cl_pos }, []); etype = basic.tvoid; epos = cl.cl_pos }
           | Some _ ->
@@ -1495,9 +1522,8 @@ struct
           etype = empty_ctor.cf_type;
           epos = empty_ctor.cf_pos
         };
+        empty_ctor.cf_meta <- [Meta.SkipCtor, [], empty_ctor.cf_pos];
 
-        cl.cl_ordered_fields <- empty_ctor :: cl.cl_ordered_fields;
-        cl.cl_fields <- PMap.add "new" empty_ctor cl.cl_fields;
         if and_no_args_too then begin
           let noargs_ctor = mk_class_field "new" (TFun([],basic.tvoid)) false cl.cl_pos (Method MethNormal) [] in
           noargs_ctor.cf_expr <- Some {
@@ -1509,9 +1535,10 @@ struct
           etype = noargs_ctor.cf_type;
           epos = noargs_ctor.cf_pos
         };
+        add_constructor cl noargs_ctor
+        end;
 
-        cl.cl_constructor <- Some noargs_ctor
-        end
+        add_constructor cl empty_ctor
       in
 
       let cur_ctor =
@@ -1528,38 +1555,43 @@ struct
               | Some ctor when not supports_ctor_inheritance ->
                 (* if there are and not supports_ctor_inheritance, we need to create the constructors anyway *)
                 (* create a constructor that only receives its arguments and calls super with them *)
-                let new_ctor = mk_class_field "new" ctor.cf_type ctor.cf_public cl.cl_pos (Method MethNormal) [] in
-                let args, _ = get_fun ctor.cf_type in
-                let tf_args = List.map (fun (name,_,t) ->
-                  (* the constructor will have no optional arguments, as presumably this will be handled by the underlying expr *)
-                  (alloc_var name t, None)
-                ) args in
-                let super_call =
-                {
-                  eexpr = TCall(
-                    { eexpr = TConst(TSuper); etype = TInst(cl, List.map snd cl.cl_types); epos = ctor.cf_pos },
-                    List.map (fun (v,_) -> mk_local v ctor.cf_pos) tf_args);
-                  etype = basic.tvoid;
-                  epos = ctor.cf_pos
-                } in
-                new_ctor.cf_expr <- Some ({
-                  eexpr = TFunction({
-                    tf_args = tf_args;
-                    tf_type = basic.tvoid;
-                    tf_expr = mk_block super_call
+                List.iter (function
+                  | ctor when not (type_iseq (TFun(["empty",false,empty_ctor_type], gen.gcon.basic.tvoid)) ctor.cf_type) ->
+                  let new_ctor = mk_class_field "new" ctor.cf_type ctor.cf_public cl.cl_pos (Method MethNormal) [] in
+                  let args, _ = get_fun ctor.cf_type in
+                  let tf_args = List.map (fun (name,_,t) ->
+                    (* the constructor will have no optional arguments, as presumably this will be handled by the underlying expr *)
+                    (alloc_var name t, None)
+                  ) args in
+                  let super_call =
+                  {
+                    eexpr = TCall(
+                      { eexpr = TConst(TSuper); etype = TInst(cl, List.map snd cl.cl_types); epos = ctor.cf_pos },
+                      List.map (fun (v,_) -> mk_local v ctor.cf_pos) tf_args);
+                    etype = basic.tvoid;
+                    epos = ctor.cf_pos
+                  } in
+                  new_ctor.cf_expr <- Some ({
+                    eexpr = TFunction({
+                      tf_args = tf_args;
+                      tf_type = basic.tvoid;
+                      tf_expr = mk_block super_call
+                    });
+                    etype = ctor.cf_type;
+                    epos = ctor.cf_pos
                   });
-                  etype = ctor.cf_type;
-                  epos = ctor.cf_pos
-                });
-                cl.cl_constructor <- Some new_ctor;
-
-                Some new_ctor
+                  add_constructor cl new_ctor;
+                | _ -> ()) (ctor :: ctor.cf_overloads);
+                cl.cl_constructor
               | _ ->
                 do_empty_only true;
                 None
       in
+
+      let rec create_static_ctor cur_ctor is_overload =
       match cur_ctor with
         | None -> ()
+        | Some ctor when Meta.has Meta.SkipCtor ctor.cf_meta -> ()
         | Some ctor ->
           (* now that we are sure to have a constructor:
               change its contents to reference 'me' var whenever 'this' is referenced
@@ -1605,16 +1637,21 @@ struct
 
           let super_call = ref None in
           let change_super_to, mk_supers =
-            let last_static_ctor = get_last_static_ctor cl (List.map snd ctor_types) in
             let change_super_to scall params =
+              let argst = TFun(("me",false,me.v_type) :: List.map (fun e -> replace_mono e.etype; "arg",false,e.etype) params, gen.gcon.basic.tvoid) in
+              let last_static_ctor = get_last_static_ctor cl (List.map snd ctor_types) (Some argst) in
               super_call := Some scall;
               match last_static_ctor with
                 | None ->
                   if is_super_first then
-                    { eexpr = TConst(TNull); etype = t_dynamic; epos = scall.epos }
+                    { eexpr = TBlock []; etype = t_dynamic; epos = scall.epos }
                   else
                     ( gen.gcon.error "Super call must be the first call when extending native types." scall.epos; assert false )
-                | Some e -> { scall with eexpr = TCall(e, [mk_local me scall.epos] @ params) }
+                | Some (chosen_cf, csup, tlsup) ->
+                    { scall with eexpr = TCall(
+                      { eexpr = TField(mk_classtype_access csup scall.epos, FStatic(csup, chosen_cf)); etype = apply_params csup.cl_types tlsup chosen_cf.cf_type; epos = scall.epos },
+                      (mk_local me scall.epos) :: params
+                    )}
             in
 
             (*
@@ -1634,7 +1671,7 @@ struct
                     epos = cl.cl_pos
                   } in
 
-                  let ret = match last_static_ctor, !super_call with
+                  let ret = match get_last_static_ctor cl (List.map snd cl.cl_types) None, !super_call with
                     | None, Some super ->
                       (* it has an empty constructor, but we cannot call an out of placed super *)
                       super
@@ -1687,8 +1724,12 @@ struct
           static_ctor.cf_expr <- Some { eexpr = TFunction(mapped); etype = static_ctor.cf_type; epos = ctor.cf_pos };
           let normal_super, empty_super = mk_supers () in
 
-          cl.cl_ordered_statics <- static_ctor :: cl.cl_ordered_statics;
-          cl.cl_statics <- PMap.add static_ctor_name static_ctor cl.cl_statics;
+          (try
+            let sc = PMap.find static_ctor.cf_name cl.cl_statics in
+            sc.cf_overloads <- static_ctor :: sc.cf_overloads
+          with | Not_found ->
+            cl.cl_ordered_statics <- static_ctor :: cl.cl_ordered_statics;
+            cl.cl_statics <- PMap.add static_ctor_name static_ctor cl.cl_statics);
 
           let normal_super =
           {
@@ -1696,7 +1737,7 @@ struct
               normal_super;
               {
                 eexpr = TCall(
-                  mk_static_field_access cl static_ctor_name (apply_params ctor_types (List.map snd cl.cl_types) fn_type) ctor.cf_pos,
+                  { eexpr = TField(mk_classtype_access cl ctor.cf_pos, FStatic(cl,static_ctor)); etype = apply_params ctor_types (List.map snd cl.cl_types) fn_type; epos = ctor.cf_pos },
                   [ { eexpr = TConst(TThis); etype = TInst(cl, List.map snd cl.cl_types); epos = cl.cl_pos } ] @ List.map (fun (v,_) -> mk_local v ctor.cf_pos) changed_tf_args
                 );
                 etype = basic.tvoid;
@@ -1713,21 +1754,31 @@ struct
             epos = ctor.cf_pos;
           };
 
-          let empty_ctor = mk_class_field "new" (TFun(["empty",false,empty_ctor_type],basic.tvoid)) false cl.cl_pos (Method MethNormal) [] in
-          empty_ctor.cf_expr <- Some {
-            eexpr = TFunction {
-              tf_type = basic.tvoid;
-              tf_args = [alloc_var "empty" empty_ctor_type, None];
-              tf_expr = mk_block empty_super
+          List.iter (fun cf -> create_static_ctor (Some cf) true) ctor.cf_overloads;
+          if not is_overload then begin
+            let empty_ctor = mk_class_field "new" (TFun(["empty",false,empty_ctor_type],basic.tvoid)) false cl.cl_pos (Method MethNormal) [] in
+            empty_ctor.cf_meta <- [Meta.SkipCtor,[],empty_ctor.cf_pos];
+            empty_ctor.cf_expr <- Some {
+              eexpr = TFunction {
+                tf_type = basic.tvoid;
+                tf_args = [alloc_var "empty" empty_ctor_type, None];
+                tf_expr = mk_block empty_super
+              };
+              etype = empty_ctor.cf_type;
+              epos = empty_ctor.cf_pos
             };
-            etype = empty_ctor.cf_type;
-            epos = empty_ctor.cf_pos
-          };
 
-          cl.cl_ordered_fields <- empty_ctor :: cl.cl_ordered_fields;
-          cl.cl_fields <- PMap.add "new" empty_ctor cl.cl_fields;
+            add_constructor cl empty_ctor
+          end;
 
-          ()
+          ctor.cf_meta <- (Meta.SkipCtor,[],ctor.cf_pos) :: ctor.cf_meta;
+          (match cl.cl_constructor with
+          | None -> ()
+          | Some cf ->
+              (* since all constructors are overloaded, make sure no TMonos are left open *)
+              List.iter (fun cf -> replace_mono cf.cf_type) (cf :: cf.cf_overloads))
+      in
+      create_static_ctor cur_ctor false
     in
 
     let module_filter md = match md with
@@ -4819,6 +4870,19 @@ struct
 
     let in_value = ref false in
 
+    let rec get_ctor_p cl p =
+      match cl.cl_constructor with
+        | Some c -> follow (apply_params cl.cl_types p c.cf_type), cl, p
+        | None -> match cl.cl_super with
+          | Some (cls,tl) ->
+            get_ctor_p cls (List.map (apply_params cls.cl_types p) tl)
+          | None -> TFun([],gen.gcon.basic.tvoid), cl, p
+    in
+
+    let get_f t =
+      match follow t with | TFun(p,_) -> List.map (fun (_,_,t) -> t) p | _ -> assert false
+    in
+
     let rec run ?(just_type = false) e =
       let handle = if not just_type then handle else fun e t1 t2 -> { e with etype = gen.greal_type t2 } in
       let was_in_value = !in_value in
@@ -4860,6 +4924,32 @@ struct
         | TCall( ({ eexpr = TField(ef, f) }) as e1, elist ) ->
           handle_type_parameter gen (Some e) (e1) (run ef) f (List.map run elist) impossible_tparam_is_dynamic
 
+        | TCall( { eexpr = TConst TSuper } as ef, [ maybe_empty ]) when is_some maybe_empty_t && type_iseq gen (get maybe_empty_t) maybe_empty.etype ->
+          { e with eexpr = TCall(ef, [ run maybe_empty ]); }
+        | TCall( { eexpr = TConst TSuper } as ef, eparams ) ->
+          (* handle special distinction between EmptyConstructor vs one argument contructor *)
+          let handle = if gen.gcon.platform = Java && List.length eparams = 1 then
+            (fun e t1 t2 -> mk_cast (gen.greal_type t1) e)
+          else
+            handle
+          in
+          let cl,tparams = match follow ef.etype with | TInst(c,p) -> c,p | _ -> assert false in
+          let t, c, p = get_ctor_p cl tparams in
+          let called_t = TFun(List.map (fun e -> "arg",false,e.etype) eparams, gen.gcon.basic.tvoid) in
+          (match c.cl_constructor with
+          | None ->
+            { e with eexpr = TCall(ef, List.map run eparams); }
+          | Some cf when cf.cf_overloads <> [] ->
+            (try
+              (* TODO use the same sorting algorithm as in typer *)
+              let cf = List.find (fun cf -> try unify cf.cf_type called_t; true with | Unify_error _ -> false) (cf :: cf.cf_overloads) in
+              let t = apply_params c.cl_types p cf.cf_type in
+              { e with eexpr = TCall(ef, List.map2 (fun e t -> handle (run e) t e.etype) eparams (get_f t)); }
+            with | Not_found ->
+              { e with eexpr = TCall(ef, List.map run eparams); })
+          | _ ->
+            { e with eexpr = TCall(ef, List.map2 (fun e t -> handle (run e) t e.etype) eparams (get_f t)); }
+          )
         | TCall (ef, eparams) ->
           (match ef.etype with
             | TFun(p, ret) ->
@@ -4869,34 +4959,29 @@ struct
         | TNew (cl, tparams, [ maybe_empty ]) when is_some maybe_empty_t && type_iseq gen (get maybe_empty_t) maybe_empty.etype ->
           { e with eexpr = TNew(cl, tparams, [ maybe_empty ]); etype = TInst(cl, tparams) }
         | TNew (cl, tparams, eparams) ->
-          let get_f t =
-            match t with | TFun(p,_) -> List.map (fun (_,_,t) -> t) p | _ -> assert false
-          in
-
-          let rec get_ctor_p cl p =
-            match cl.cl_constructor with
-              | Some c -> follow (apply_params cl.cl_types p c.cf_type)
-              | None -> match cl.cl_super with
-                | Some (cls,tl) ->
-                  get_ctor_p cls (List.map (apply_params cls.cl_types p) tl)
-                | None -> TFun([],gen.gcon.basic.tvoid)
-          in
-
+          (* handle special distinction between EmptyConstructor vs one argument contructor *)
           let handle = if gen.gcon.platform = Java && List.length eparams = 1 then
             (fun e t1 t2 -> mk_cast (gen.greal_type t1) e)
           else
             handle
           in
-
-          (* try / with because TNew might be overloaded *)
-          (
-          try
-            { e with eexpr = TNew(cl, tparams, List.map2 (fun e t -> handle (run e) t e.etype) eparams (get_f (get_ctor_p cl tparams))) }
-          with
-            | Invalid_argument(_) ->
-              { e with eexpr = TNew(cl, tparams, List.map run eparams); etype = TInst(cl, tparams) }
+          (* choose best overload *)
+          let t, c, p = get_ctor_p cl tparams in
+          let called_t = TFun(List.map (fun e -> "arg",false,e.etype) eparams, gen.gcon.basic.tvoid) in
+          (match c.cl_constructor with
+          | None ->
+            { e with eexpr = TNew(cl, tparams, List.map run eparams); etype = TInst(cl, tparams) }
+          | Some cf when cf.cf_overloads <> [] ->
+            (try
+              (* TODO use the same sorting algorithm as in typer *)
+              let cf = List.find (fun cf -> try unify cf.cf_type called_t; true with | Unify_error _ -> false) (cf :: cf.cf_overloads) in
+              let t = apply_params c.cl_types p cf.cf_type in
+              { e with eexpr = TNew(cl, tparams, List.map2 (fun e t -> handle (run e) t e.etype) eparams (get_f t)) }
+            with | Not_found ->
+              { e with eexpr = TNew(cl, tparams, List.map run eparams); etype = TInst(cl, tparams) })
+          | _ ->
+            { e with eexpr = TNew(cl, tparams, List.map2 (fun e t -> handle (run e) t e.etype) eparams (get_f t)) }
           )
-
         | TArray(arr, idx) ->
           (* get underlying class (if it's a class *)
           (match follow arr.etype with
@@ -6313,7 +6398,7 @@ struct
       epos = pos
     });
 
-    cl.cl_ordered_fields <- ctor :: cl.cl_ordered_fields;
+    add_constructor cl ctor;
     (* and finally we will return a function that transforms a TObjectDecl into a new DynamicObject() call *)
     let rec loop objdecl acc acc_f =
       match objdecl with

gencs.ml

@@ -1248,7 +1248,7 @@ let configure gen =
         (params, String.concat " " params_extends)
   in
 
-  let gen_class_field w is_static cl is_final cf =
+  let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf =
     let is_interface = cl.cl_interface in
     let name, is_new, is_explicit_iface = match cf.cf_name with
       | "new" -> snd cl.cl_path, true, false
@@ -1276,6 +1276,8 @@ let configure gen =
     (match cf.cf_kind with
       | Var _
       | Method (MethDynamic) ->
+        (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then
+          gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos);
         if not is_interface then begin
           let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in
           let modifiers = modifiers @ modf in
@@ -1289,6 +1291,10 @@ let configure gen =
           )
         end (* TODO see how (get,set) variable handle when they are interfaces *)
       | Method mkind ->
+        List.iter (fun cf ->
+          if cl.cl_interface || cf.cf_expr <> None then
+            gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
+        ) cf.cf_overloads;
         let is_virtual = not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false in
         let is_virtual = if not is_virtual || Meta.has Meta.Final cf.cf_meta then false else is_virtual in
         let is_override = List.memq cf cl.cl_overrides in

genjava.ml

@@ -1362,7 +1362,7 @@ let configure gen =
         (params, String.concat " " params_extends)
   in
 
-  let gen_class_field w is_static cl is_final cf =
+  let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf =
     let is_interface = cl.cl_interface in
     let name, is_new, is_explicit_iface = match cf.cf_name with
       | "new" -> snd cl.cl_path, true, false
@@ -1374,6 +1374,8 @@ let configure gen =
     (match cf.cf_kind with
       | Var _
       | Method (MethDynamic) ->
+        (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then
+          gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos);
         if not is_interface then begin
           let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in
           print w "%s %s%s %s %s" access (if is_static then "static " else "") (String.concat " " modifiers) (t_s cf.cf_pos (run_follow gen cf.cf_type)) (change_field name);
@@ -1386,6 +1388,10 @@ let configure gen =
           )
         end (* TODO see how (get,set) variable handle when they are interfaces *)
       | Method mkind ->
+        List.iter (fun cf ->
+          if cl.cl_interface || cf.cf_expr <> None then
+            gen_class_field w ~is_overload:true is_static cl (Meta.has Meta.Final cf.cf_meta) cf
+        ) cf.cf_overloads;
         let is_virtual = is_new || (not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false) in
         let is_override = match cf.cf_name with
           | "equals" when not is_static ->
@@ -1426,7 +1432,7 @@ let configure gen =
         let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in
         let visibility, is_virtual = if is_explicit_iface then "",false else visibility, is_virtual in
         let v_n = if is_static then "static " else if is_override && not is_interface then "" else if not is_virtual then "final " else "" in
-        let cf_type = if is_override then match field_access gen (TInst(cl, List.map snd cl.cl_types)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t) -> actual_t | _ -> assert false else cf.cf_type in
+        let cf_type = if is_override && not is_overload && not (Meta.has Meta.Overload cf.cf_meta) then match field_access gen (TInst(cl, List.map snd cl.cl_types)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t) -> actual_t | _ -> assert false else cf.cf_type in
 
         let params = List.map snd cl.cl_types in
         let ret_type, args = match follow cf_type, follow cf.cf_type with

tests/unit/TestJava.hx

@@ -1,46 +1,207 @@
 package unit;
+import haxe.io.Bytes;
 
-class TestJava extends Test
+#if java
+class BaseJava implements NormalInterface
 {
-	#if java
+	public var i:Int;
+	public var s:String;
+	public var f:Float;
+
+	@:overload public function new(i:Int):Void
+	{
+		this.i = i;
+	}
+
+	@:overload public function new(s:String):Void
+	{
+		this.s = s;
+	}
+
+	@:overload public function new(f:Float):Void
+	{
+		this.f = f;
+	}
 
-	function textException()
+	@:overload public function someField(b:haxe.io.Bytes):Int
 	{
-		var native = new NativeClass();
-		var hx:NativeClass = new HxClass();
+		return 0;
+	}
 
-		exc(function() try native.excTest() catch (e:Dynamic) throw e);
-		var dyn:Dynamic = native;
-		exc(dyn.excTest);
+	@:overload public function someField(i:Int):Int
+	{
+		return 1;
+	}
 
-		try
-			hx.excTest()
-		catch(e:Dynamic) throw e; //shouldn't throw any exception
+	@:overload public function someField(s:String):Int
+	{
+		return 2;
 	}
 
-	#end
+	@:overload public function someField(s:Bool):Int
+	{
+		return -1;
+	}
 }
 
-@:nativeGen private class NativeClass
+class ChildJava extends BaseJava implements OverloadedInterface
 {
-	public function new()
+	@:overload public function new(b:haxe.io.Bytes)
 	{
+		super(b.toString());
+	}
 
+	@:overload public function new(i:Int)
+	{
+		super(i + 1);
 	}
 
-	@:throws("java.lang.Throwable")
-	public function excTest():Void
+	@:overload public function someField(f:Float):Int
 	{
-		throw new java.lang.Throwable("test", null);
+		return 3;
+	}
+
+	@:overload override public function someField(b:haxe.io.Bytes)
+	{
+		return 2;
 	}
 }
 
-private class HxClass extends NativeClass
+class ChildJava2<T> extends ChildJava
 {
+	@:overload public function new(x:Float)
+	{
+		super(Std.int(x));
+	}
+	@:overload private function new(b:haxe.io.Bytes)
+	{
+		super(b);
+	}
 
-	@:throws("java.lang.Throwable")
-	override public function excTest():Void
+	@:overload override public function someField(f:Float):Int
 	{
+		return 50;
+	}
 
+	@:overload public function someField(t:T):T
+	{
+		return t;
 	}
-}
+
+	@:overload public function someField(c:Class<T>):Int
+	{
+		return 51;
+	}
+}
+
+class ChildJava3<A, T : BaseJava> extends ChildJava2<T>
+{
+	@:overload override public function someField(t:T):T
+	{
+		return null;
+	}
+
+	@:overload public function someField<Z>(a:A, t:T, z:Z):Z
+	{
+		return z;
+	}
+
+	@:overload public function someField(a:A, c:Int):Int
+	{
+		return 52;
+	}
+}
+
+interface NormalInterface
+{
+	function someField(i:Bool):Int;
+}
+
+interface OverloadedInterface extends NormalInterface
+{
+	@:overload function someField(s:String):Int;
+	@:overload function someField(f:Float):Int;
+}
+
+class TestJava extends Test
+{
+  function textException()
+  {
+    var native = new NativeClass();
+    var hx:NativeClass = new HxClass();
+
+    exc(function() try native.excTest() catch (e:Dynamic) throw e);
+    var dyn:Dynamic = native;
+    exc(dyn.excTest);
+
+    try
+      hx.excTest()
+    catch(e:Dynamic) throw e; //shouldn't throw any exception
+  }
+
+	function testOverload()
+	{
+		var base = new BaseJava(1);
+		eq(base.i, 1);
+		eq(new BaseJava("test").s, "test");
+		eq(base.someField(Bytes.ofString("test")), 0);
+		eq(base.someField(0), 1);
+		eq(base.someField("test"), 2);
+		eq(base.someField(true), -1);
+
+		eq(new ChildJava(4).i, 5);
+		var child = new ChildJava(Bytes.ofString("a"));
+		eq(child.s, "a");
+		eq(child.someField("test") , 2);
+		eq(child.someField(Bytes.ofString("a")), 2);
+		eq(child.someField(22.2), 3);
+		eq(new ChildJava(25).i, 25);
+
+		var child:OverloadedInterface = child;
+		eq(child.someField("test"), 2);
+		eq(child.someField(22.2), 3);
+		eq(child.someField(true), -1);
+
+		var child:NormalInterface = child;
+		eq(child.someField(true), -1);
+
+		var child:ChildJava2<ChildJava2<Dynamic>> = new ChildJava2(22.5);
+		eq(child.i, 22);
+		eq(child.someField(22.5), 50);
+		eq(child.someField(child), child);
+		eq(child.someField(ChildJava2), 51);
+		eq(child.someField(true), -1);
+
+		var child:ChildJava3<Bool, BaseJava> = new ChildJava3(Bytes.ofString("test"));
+		eq(child.s, "test");
+		eq(child.someField(base), null);
+		eq(child.someField(true, child, 99), 99);
+		eq(child.someField(true, 10), 52);
+	}
+}
+
+@:nativeGen private class NativeClass
+{
+  public function new()
+  {
+
+  }
+
+  @:throws("java.lang.Throwable")
+  public function excTest():Void
+  {
+    throw new java.lang.Throwable("test", null);
+  }
+}
+
+private class HxClass extends NativeClass
+{
+
+  @:throws("java.lang.Throwable")
+  override public function excTest():Void
+  {
+
+  }
+}
+
+#end

tests/unit/compile.hxml

@@ -68,3 +68,12 @@ unit.Test
 -main unit.Test
 -cpp cpp
 -D NO_PRECOMPILED_HEADERS
+
+#java native build
+#-cmd "haxelib run hxjava native_java/hxjava_build.txt --out native_java/native"
+
+#java
+--next
+-main unit.Test
+-java java
+#-java-lib native_java/native.jar

typeload.ml

@@ -95,7 +95,7 @@ let make_module ctx mpath file tdecls loadp =
 			} in
 			decls := (TTypeDecl t, decl) :: !decls;
 			acc
-	   | EAbstract d ->
+		 | EAbstract d ->
 			let priv = List.mem APrivAbstract d.d_flags in
 			let path = make_path d.d_name priv in
 			let a = {
@@ -287,7 +287,7 @@ let rec load_type_def ctx p t =
 				Exit -> next()
 
 let check_param_constraints ctx types t pl c p =
- 	match follow t with
+	match follow t with
 	| TMono _ -> ()
 	| _ ->
 		let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in
@@ -477,7 +477,7 @@ and load_complex_type ctx p t =
 				cf_params = !params;
 				cf_expr = None;
 				cf_doc = f.cff_doc;
-				cf_meta = f.cff_meta;
+			cf_meta = f.cff_meta;
 				cf_overloads = [];
 			} in
 			init_meta_overloads ctx cf;
@@ -512,6 +512,16 @@ and init_meta_overloads ctx cf =
 			overloads := (args,topt f.f_type, params) :: !overloads;
 			ctx.type_params <- old;
 			false
+		| (Meta.Overload,[],_) when ctx.com.config.pf_overload ->
+			let topt (n,_,t) = match t with | TMono t when !t = None -> error ("Explicit type required for overload functions\nFor function argument '" ^ n ^ "'") cf.cf_pos | _ -> () in
+			(match follow cf.cf_type with
+			| TFun (args,_) -> List.iter topt args
+			| _ -> () (* could be a variable *));
+			true
+		| (Meta.Overload,[],p) ->
+				error "This platform does not support this kind of overload declaration. Try @:overload(function()... {}) instead" p
+		| (Meta.Overload,_,p) ->
+				error "Invalid @:overload metadata format" p
 		| _ ->
 			true
 	) cf.cf_meta;
@@ -622,6 +632,23 @@ let copy_meta meta_src meta_target sl =
 	) meta_src;
 	!meta
 
+(** retrieves all overloads from class c and field i, as (Type.t * tclass_field) list *)
+let rec get_overloads c i =
+	let ret = try
+		let f = PMap.find i c.cl_fields in
+			(f.cf_type, f) :: (List.map (fun f -> f.cf_type, f) f.cf_overloads)
+		with | Not_found -> []
+	in
+	match c.cl_super with
+	| None when c.cl_interface ->
+			let ifaces = List.concat (List.map (fun (c,tl) ->
+				List.map (fun (t,f) -> apply_params c.cl_types tl t, f) (get_overloads c i)
+			) c.cl_implements) in
+			ret @ ifaces
+	| None -> ret
+	| Some (c,tl) ->
+			ret @ ( List.map (fun (t,f) -> apply_params c.cl_types tl t, f) (get_overloads c i) )
+
 let check_overriding ctx c =
 	let p = c.cl_pos in
 	match c.cl_super with
@@ -632,14 +659,18 @@ let check_overriding ctx c =
 			display_error ctx ("Field " ^ i.cf_name ^ " is declared 'override' but doesn't override any field") p)
 	| Some (csup,params) ->
 		PMap.iter (fun i f ->
-			let p = f.cf_pos in
-			try
-				let _, t , f2 = raw_class_field (fun f -> f.cf_type) csup i in
+			let check_field f get_super_field is_overload = try
+				let p = f.cf_pos in
+				(if is_overload && not (Meta.has Meta.Overload f.cf_meta) then
+					display_error ctx ("Missing @:overload declaration for field " ^ i) p);
+				let t, f2 = get_super_field csup i in
 				(* allow to define fields that are not defined for this platform version in superclass *)
 				(match f2.cf_kind with
 				| Var { v_read = AccRequire _ } -> raise Not_found;
 				| _ -> ());
-				if not (List.memq f c.cl_overrides) then
+				if ctx.com.config.pf_overload && (Meta.has Meta.Overload f2.cf_meta && not (Meta.has Meta.Overload f.cf_meta)) then
+					display_error ctx ("Field " ^ i ^ " should be declared with @:overload since it was already declared as @:overload in superclass") p
+				else if not (List.memq f c.cl_overrides) then
 					display_error ctx ("Field " ^ i ^ " should be declared with 'override' since it is inherited from superclass") p
 				else if not f.cf_public && f2.cf_public then
 					display_error ctx ("Field " ^ i ^ " has less visibility (public/private) than superclass one") p
@@ -660,7 +691,35 @@ let check_overriding ctx c =
 						display_error ctx (error_msg (Unify l)) p;
 			with
 				Not_found ->
-					if List.memq f c.cl_overrides then display_error ctx ("Field " ^ i ^ " is declared 'override' but doesn't override any field") p
+					if List.memq f c.cl_overrides then
+						let msg = if is_overload then
+							("Field " ^ i ^ " is declared 'override' but no compatible overload was found")
+						else
+							("Field " ^ i ^ " is declared 'override' but doesn't override any field")
+						in
+						display_error ctx msg p
+			in
+			if ctx.com.config.pf_overload && Meta.has Meta.Overload f.cf_meta then begin
+				(* check if field with same signature was declared more than once *)
+				List.iter (fun f2 ->
+					try
+						ignore (List.find (fun f3 -> f3 != f2 && type_iseq f2.cf_type f3.cf_type) (f :: f.cf_overloads));
+						display_error ctx ("Another overloaded field of same signature was already declared : " ^ f2.cf_name) f2.cf_pos
+					with | Not_found -> ()
+				) (f :: f.cf_overloads);
+				let overloads = get_overloads csup i in
+				List.iter (fun f ->
+					(* find the exact field being overridden *)
+					check_field f (fun csup i ->
+						List.find (fun (t,f2) ->
+							type_iseq f.cf_type (apply_params csup.cl_types params t)
+						) overloads
+					) true
+				) f.cf_overloads
+      end else
+				check_field f (fun csup i ->
+					let _, t, f2 = raw_class_field (fun f -> f.cf_type) csup i in
+					t, f2) false
 		) c.cl_fields
 
 let class_field_no_interf c i =
@@ -678,9 +737,25 @@ let class_field_no_interf c i =
 
 let rec check_interface ctx c intf params =
 	let p = c.cl_pos in
-	PMap.iter (fun i f ->
+	let rec check_field i f =
+		(if ctx.com.config.pf_overload then
+			List.iter (function
+				| f2 when f != f2 ->
+						check_field i f2
+				| _ -> ()) f.cf_overloads);
+		let is_overload = ref false in
 		try
 			let t2, f2 = class_field_no_interf c i in
+			let t2, f2 =
+				if ctx.com.config.pf_overload && (f2.cf_overloads <> [] || Meta.has Meta.Overload f2.cf_meta) then
+					let overloads = get_overloads c i in
+					is_overload := true;
+					let t = (apply_params intf.cl_types params f.cf_type) in
+					List.find (fun (t1,f1) -> type_iseq t t1) overloads
+				else
+					t2, f2
+			in
+
 			ignore(follow f2.cf_type); (* force evaluation *)
 			let p = (match f2.cf_expr with None -> p | Some e -> e.epos) in
 			let mkind = function
@@ -699,9 +774,18 @@ let rec check_interface ctx c intf params =
 					display_error ctx ("Field " ^ i ^ " has different type than in " ^ s_type_path intf.cl_path) p;
 					display_error ctx (error_msg (Unify l)) p;
 		with
-			Not_found ->
-				if not c.cl_interface then display_error ctx ("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing") p
-	) intf.cl_fields;
+			| Not_found when not c.cl_interface ->
+				let msg = if !is_overload then
+					let ctx = print_context() in
+					let args = match follow f.cf_type with | TFun(args,_) -> String.concat ", " (List.map (fun (n,o,t) -> (if o then "?" else "") ^ n ^ " : " ^ (s_type ctx t)) args) | _ -> assert false in
+					"No suitable overload for " ^ i ^ "( " ^ args ^ " ), as needed by " ^ s_type_path intf.cl_path ^ " was found"
+				else
+					("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing")
+				in
+				display_error ctx msg p
+			| Not_found -> ()
+	in
+	PMap.iter check_field intf.cl_fields;
 	List.iter (fun (i2,p2) ->
 		check_interface ctx c i2 (List.map (apply_params intf.cl_types params) p2)
 	) intf.cl_implements
@@ -1468,7 +1552,7 @@ let init_class ctx c p context_init herits fields =
 			let set = (match set with
 				| "null" ->
 					(* standard flash library read-only variables can't be accessed for writing, even in subclasses *)
-					if c.cl_extern && (match c.cl_path with "flash" :: _  , _ -> true | _ -> false) && ctx.com.platform = Flash then
+					if c.cl_extern && (match c.cl_path with "flash" :: _	, _ -> true | _ -> false) && ctx.com.platform = Flash then
 						AccNever
 					else
 						AccNo
@@ -1527,21 +1611,34 @@ let init_class ctx c p context_init herits fields =
 			| None -> ()
 			| Some r -> f.cf_kind <- Var { v_read = AccRequire (fst r, snd r); v_write = AccRequire (fst r, snd r) });
 			if constr then begin
-				if c.cl_constructor <> None then error "Duplicate constructor" p;
-				c.cl_constructor <- Some f;
+				match c.cl_constructor with
+					| None ->
+							c.cl_constructor <- Some f
+					| Some ctor when ctx.com.config.pf_overload ->
+              if Meta.has Meta.Overload f.cf_meta && Meta.has Meta.Overload ctor.cf_meta then
+  							ctor.cf_overloads <- f :: ctor.cf_overloads
+              else if Meta.has Meta.Overload f.cf_meta <> Meta.has Meta.Overload ctor.cf_meta then
+								display_error ctx ("If using overloaded constructors, all constructors must be declared with @:overload") (if Meta.has Meta.Overload f.cf_meta then ctor.cf_pos else f.cf_pos)
+					| Some ctor ->
+								display_error ctx "Duplicate constructor" p
 			end else if not is_static || f.cf_name <> "__init__" then begin
-				if PMap.mem f.cf_name (if is_static then c.cl_statics else c.cl_fields) then
-					display_error ctx ("Duplicate class field declaration : " ^ f.cf_name) p
-				else
 				let dup = if is_static then PMap.exists f.cf_name c.cl_fields || has_field f.cf_name c.cl_super else PMap.exists f.cf_name c.cl_statics in
 				if dup then error ("Same field name can't be use for both static and instance : " ^ f.cf_name) p;
+				if List.mem AOverride fd.cff_access then c.cl_overrides <- f :: c.cl_overrides;
+				if PMap.mem f.cf_name (if is_static then c.cl_statics else c.cl_fields) then
+					if ctx.com.config.pf_overload && Meta.has Meta.Overload f.cf_meta then
+						let mainf = PMap.find f.cf_name (if is_static then c.cl_statics else c.cl_fields) in
+						(if not (Meta.has Meta.Overload mainf.cf_meta) then display_error ctx ("Overloaded methods must have @:overload metadata") mainf.cf_pos);
+						mainf.cf_overloads <- f :: mainf.cf_overloads
+					else
+						display_error ctx ("Duplicate class field declaration : " ^ f.cf_name) p
+				else
 				if is_static then begin
 					c.cl_statics <- PMap.add f.cf_name f c.cl_statics;
 					c.cl_ordered_statics <- f :: c.cl_ordered_statics;
 				end else begin
 					c.cl_fields <- PMap.add f.cf_name f c.cl_fields;
 					c.cl_ordered_fields <- f :: c.cl_ordered_fields;
-					if List.mem AOverride fd.cff_access then c.cl_overrides <- f :: c.cl_overrides;
 				end;
 			end
 		with Error (Custom str,p) ->
@@ -1576,6 +1673,7 @@ let init_class ctx c p context_init herits fields =
 					pass = PTypeField;
 				} in
 				ignore (follow cfsup.cf_type); (* make sure it's typed *)
+				(if ctx.com.config.pf_overload then List.iter (fun cf -> ignore (follow cf.cf_type)) cf.cf_overloads);
 				let args = (match cfsup.cf_expr with
 					| Some { eexpr = TFunction f } ->
 						List.map (fun (v,def) ->
@@ -1616,6 +1714,17 @@ let init_class ctx c p context_init herits fields =
 			()
 	in
 	add_constructor c;
+	(* check overloaded constructors *)
+	(if ctx.com.config.pf_overload then match c.cl_constructor with
+	| Some ctor ->
+		List.iter (fun f ->
+			try
+				(* TODO: consider making a broader check, and treat some types, like TAnon and type parameters as Dynamic *)
+				ignore(List.find (fun f2 -> f != f2 && type_iseq f.cf_type f2.cf_type) (ctor :: ctor.cf_overloads));
+				display_error ctx ("Another overloaded field of same signature was already declared : " ^ f.cf_name) f.cf_pos;
+			with Not_found -> ()
+		) (ctor :: ctor.cf_overloads)
+	| _ -> ());
 	(* push delays in reverse order so they will be run in correct order *)
 	List.iter (fun (ctx,r) ->
 		ctx.pass <- PTypeField;
@@ -1986,7 +2095,7 @@ let type_module ctx m file tdecls p =
 		vthis = None;
 	} in
 	(* here is an additional PASS 1 phase, which define the type parameters for all module types.
-	   Constraints are handled lazily (no other type is loaded) because they might be recursive anyway *)
+		 Constraints are handled lazily (no other type is loaded) because they might be recursive anyway *)
 	List.iter (fun d ->
 		match d with
 		| (TClassDecl c, (EClass d, p)) ->
@@ -2122,4 +2231,4 @@ let load_module ctx m p =
 	m2
 
 ;;
-type_function_params_rec := type_function_params
+type_function_params_rec := type_function_params

typer.ml

@@ -399,21 +399,34 @@ let unify_min ctx el =
 		if not ctx.untyped then display_error ctx (error_msg (Unify l)) p;
 		(List.hd el).etype
 
-let rec unify_call_params ctx cf el args r p inline =
+let rec unify_call_params ctx ?(overloads=None) cf el args r p inline =
+	let overloads = match cf, overloads with
+		| Some(TInst(c,pl),f), None when ctx.com.config.pf_overload ->
+				let overloads = Typeload.get_overloads c f.cf_name in
+				if overloads = [] then (* is static function *)
+					List.map (fun f -> f.cf_type, f) f.cf_overloads
+				else
+					overloads
+		| Some(_,f), None ->
+				List.map (fun f -> f.cf_type, f) f.cf_overloads
+		| _, Some s ->
+				s
+		| _ -> []
+	in
 	let next() =
-		match cf with
-		| Some (TInst(c,pl),{ cf_overloads = o :: l }) ->
-			let args, ret = (match field_type ctx c pl o p with
+		match cf, overloads with
+		| Some (TInst(c,pl),_), (ft,o) :: l ->
+			let args, ret = (match follow (apply_params c.cl_types pl (field_type ctx c pl o p)) with (* I'm getting non-followed types here. Should it happen? *)
 				| TFun (tl,t) -> tl, t
 				| _ -> assert false
 			) in
-			Some (unify_call_params ctx (Some (TInst(c,pl),{ o with cf_overloads = l })) el args ret p inline)
-		| Some (t,{ cf_overloads = o :: l }) ->
+			Some (unify_call_params ctx ~overloads:(Some l) (Some (TInst(c,pl),{ o with cf_type = ft })) el args ret p inline)
+		| Some (t,_), (_,o) :: l ->
 			let args, ret = (match Type.field_type o with
 				| TFun (tl,t) -> tl, t
 				| _ -> assert false
 			) in
-			Some (unify_call_params ctx (Some (t, { o with cf_overloads = l })) el args ret p inline)
+			Some (unify_call_params ctx ~overloads:(Some l) (Some (t, o)) el args ret p inline)
 		| _ ->
 			None
 	in