diff --git a/type.ml b/type.ml index 41408ed3f6e..8ed6ec45f5b 100644 --- a/type.ml +++ b/type.ml @@ -636,6 +636,7 @@ let field_type f = | l -> monomorphs l f.cf_type let rec raw_class_field build_type c tl i = + let apply = apply_params c.cl_params tl in try let f = PMap.find i c.cl_fields in Some (c,tl), build_type f , f @@ -646,9 +647,9 @@ let rec raw_class_field build_type c tl i = match c.cl_super with | None -> raise Not_found - | Some (csup,tl2) -> - let c2 , t , f = raw_class_field build_type csup (List.map (apply_params c.cl_params tl) tl2) i in - c2, apply_params csup.cl_params tl2 t , f + | Some (c,tl) -> + let c2 , t , f = raw_class_field build_type c (List.map apply tl) i in + c2, apply_params c.cl_params tl t , f with Not_found -> match c.cl_kind with | KTypeParameter tl -> @@ -663,10 +664,10 @@ let rec raw_class_field build_type c tl i = None, build_type f, f with Not_found -> loop ctl) - | TInst (cp,tl2) -> + | TInst (c,tl) -> (try - let c2, t , f = raw_class_field build_type cp (List.map (apply_params c.cl_params tl) tl2) i in - c2, apply_params cp.cl_params tl2 t, f + let c2, t , f = raw_class_field build_type c (List.map apply tl) i in + c2, apply_params c.cl_params tl t, f with Not_found -> loop ctl) | _ -> @@ -682,10 +683,10 @@ let rec raw_class_field build_type c tl i = let rec loop = function | [] -> raise Not_found - | (ci,tl2) :: l -> + | (c,tl) :: l -> try - let c2, t , f = raw_class_field build_type ci (List.map (apply_params c.cl_params tl) tl2) i in - c2, apply_params ci.cl_params tl2 t, f + let c2, t , f = raw_class_field build_type c (List.map apply tl) i in + c2, apply_params c.cl_params tl t, f with Not_found -> loop l in diff --git a/typer.ml b/typer.ml index 46d3ab28ecd..7df62793d64 100644 --- a/typer.ml +++ b/typer.ml @@ -721,11 +721,11 @@ let unify_field_call ctx fa el args ret p inline = let expand_overloads map cf = (TFun(args,ret),cf) :: (List.map (map_cf map) cf.cf_overloads) in - let candidates,is_overload,mk_fa = match fa with + let candidates,co,cf,mk_fa = match fa with | FStatic(c,cf) -> - expand_overloads (fun t -> t) cf,Meta.has Meta.Overload cf.cf_meta,(fun cf -> FStatic(c,cf)) + expand_overloads (fun t -> t) cf,Some c,cf,(fun cf -> FStatic(c,cf)) | FAnon cf -> - expand_overloads (fun t -> t) cf,Meta.has Meta.Overload cf.cf_meta,(fun cf -> FAnon cf) + expand_overloads (fun t -> t) cf,None,cf,(fun cf -> FAnon cf) | FInstance(c,tl,cf) -> let map = apply_params c.cl_params tl in let cfl = if cf.cf_name = "new" || not (Meta.has Meta.Overload cf.cf_meta && ctx.com.config.pf_overload) then @@ -733,21 +733,22 @@ let unify_field_call ctx fa el args ret p inline = else List.map (fun (t,cf) -> map (monomorphs cf.cf_params t),cf) (Typeload.get_overloads c cf.cf_name) in - (TFun(args,ret),cf) :: cfl,Meta.has Meta.Overload cf.cf_meta,(fun cf -> FInstance(c,tl,cf)) + (TFun(args,ret),cf) :: cfl,None,cf,(fun cf -> FInstance(c,tl,cf)) | _ -> error "Invalid field call" p in - let is_forced_inline = false in + let is_forced_inline = is_forced_inline co cf in + let is_overload = Meta.has Meta.Overload cf.cf_meta in let candidates,failures = List.fold_left (fun (candidates,failures) (t,cf) -> begin try begin match follow t with | TFun(args,ret) -> - let el,tf = unify_call_args' ctx el args ret p inline is_forced_inline in + let el,tf = unify_call_args' ctx el args ret p inline is_forced_inline in let mk_call ethis = let ef = mk (TField(ethis,fa)) tf p in make_call ctx ef (List.map fst el) ret p in - (el,tf,mk_call) :: candidates,failures + (el,tf,mk_call) :: candidates,failures | _ -> assert false end @@ -755,19 +756,18 @@ let unify_field_call ctx fa el args ret p inline = candidates,err :: failures end ) ([],[]) candidates in - let candidates = if is_overload && ctx.com.config.pf_overload then - Codegen.Overloads.reduce_compatible candidates - else - List.rev candidates + let fail () = match List.rev failures with + | err :: _ -> raise err + | _ -> assert false in - match candidates with - | [] -> - begin match List.rev failures with - | err :: _ -> raise err - | _ -> assert false - end - | _ :: _ :: _ when is_overload && ctx.com.config.pf_overload -> error "Ambiguous overload" p + if is_overload && ctx.com.config.pf_overload then begin match Codegen.Overloads.reduce_compatible candidates with + | [] -> fail() + | [el,tf,mk_call] -> List.map fst el,tf,mk_call + | _ -> error "Ambiguous overload" p + end else begin match List.rev candidates with + | [] -> fail() | (el,tf,mk_call) :: _ -> List.map fst el,tf,mk_call + end let fast_enum_field e ef p = let et = mk (TTypeExpr (TEnumDecl e)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics e) }) p in @@ -1716,7 +1716,7 @@ let type_generic_function ctx (e,cf) el ?(using_param=None) with_type p = cf2 in let e = if stat then type_type ctx c.cl_path p else e in - let e = acc_get ctx (field_access ctx MCall cf2 (if stat then FStatic (c,cf2) else FInstance (c,[],cf2)) cf2.cf_type e p) p in (* TODO *) + let e = acc_get ctx (field_access ctx MCall cf2 (if stat then FStatic (c,cf2) else FInstance (c,tl,cf2)) cf2.cf_type e p) p in make_call ctx e el ret p with Codegen.Generic_Exception (msg,p) -> error msg p) @@ -2901,7 +2901,7 @@ and type_expr ctx (e,p) (with_type:with_type) = let el = e1 :: el in let v = gen_local ctx tmap in let ev = mk (TLocal v) tmap p in - let ef = mk (TField(ev,FInstance(c,[],cf))) (tfun [tkey;tval] ctx.t.tvoid) p in (* TODO *) + let ef = mk (TField(ev,FInstance(c,[tkey;tval],cf))) (tfun [tkey;tval] ctx.t.tvoid) p in let el = ev :: List.fold_left (fun acc e -> match fst e with | EBinop(OpArrow,e1,e2) -> let e1,e2 = type_arrow e1 e2 in