|
|
@@ -239,8 +239,8 @@ let field_type ctx c pl f p =
|
|
|
if not (Meta.has Meta.Generic f.cf_meta) then add_constraint_checks ctx c.cl_params pl f monos p;
|
|
|
apply_params l monos f.cf_type
|
|
|
|
|
|
-let class_field ctx c pl name p =
|
|
|
- raw_class_field (fun f -> field_type ctx c pl f p) c name
|
|
|
+let class_field ctx c tl name p =
|
|
|
+ raw_class_field (fun f -> field_type ctx c tl f p) c tl name
|
|
|
|
|
|
(* checks if we can access to a given class field using current context *)
|
|
|
let rec can_access ctx ?(in_overload=false) c cf stat =
|
|
|
@@ -667,155 +667,133 @@ let is_forced_inline c cf =
|
|
|
| _ when Meta.has Meta.Extern cf.cf_meta -> true
|
|
|
| _ -> false
|
|
|
|
|
|
-let rec unify_call_args ctx ?(overloads=None) cf el args r p inline =
|
|
|
- (* 'overloads' will carry a ( return_result ) list, called 'compatible' *)
|
|
|
- (* it's used to correctly support an overload selection algorithm *)
|
|
|
- let overloads, compatible, legacy = match cf, overloads with
|
|
|
- | Some(TInst(c,pl),f), None when ctx.com.config.pf_overload && Meta.has Meta.Overload f.cf_meta ->
|
|
|
- let overloads = List.filter (fun (_,f2) ->
|
|
|
- not (f == f2) && (f2.cf_public || can_access ctx ~in_overload:true c f2 false)
|
|
|
- ) (Typeload.get_overloads c f.cf_name) in
|
|
|
- if overloads = [] then (* is static function *)
|
|
|
- let overloads = List.map (fun f -> f.cf_type, f) f.cf_overloads in
|
|
|
- let is_static = f.cf_name <> "new" in
|
|
|
- List.filter (fun (_,f) -> can_access ctx ~in_overload:true c f is_static) overloads, [], false
|
|
|
- else
|
|
|
- overloads, [], false
|
|
|
- | Some(_,f), None ->
|
|
|
- List.map (fun f -> f.cf_type, f) f.cf_overloads, [], true
|
|
|
- | _, Some s ->
|
|
|
- s
|
|
|
- | _ -> [], [], true
|
|
|
- in
|
|
|
- let next ?retval () =
|
|
|
- let compatible = Option.map_default (fun r -> r :: compatible) compatible retval in
|
|
|
- match cf, overloads with
|
|
|
- | Some (TInst(c,pl),_), (ft,o) :: l ->
|
|
|
- let o = { o with cf_type = ft } in
|
|
|
- let args, ret = (match follow (apply_params c.cl_params 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_args ctx ~overloads:(Some (l,compatible,legacy)) (Some (TInst(c,pl),o)) el args ret p inline)
|
|
|
- | Some (t,_), (ft,o) :: l ->
|
|
|
- let o = { o with cf_type = ft } in
|
|
|
- let args, ret = (match Type.field_type o with
|
|
|
- | TFun (tl,t) -> tl, t
|
|
|
- | _ -> assert false
|
|
|
- ) in
|
|
|
- Some (unify_call_args ctx ~overloads:(Some (l,compatible,legacy)) (Some (t, o)) el args ret p inline)
|
|
|
- | _ ->
|
|
|
- match compatible with
|
|
|
- | [] -> None
|
|
|
- | [acc,t] -> Some (List.map fst acc, t)
|
|
|
- | comp ->
|
|
|
- match Codegen.Overloads.reduce_compatible compatible with
|
|
|
- | [acc,t] -> Some (List.map fst acc, t)
|
|
|
- | (acc,t) :: _ -> (* ambiguous overload *)
|
|
|
- let name = match cf with | Some(_,f) -> "'" ^ f.cf_name ^ "' " | _ -> "" in
|
|
|
- let format_amb = String.concat "\n" (List.map (fun (_,t) ->
|
|
|
- "Function " ^ name ^ "with type " ^ (s_type (print_context()) t)
|
|
|
- ) compatible) in
|
|
|
- display_error ctx ("This call is ambiguous between the following methods:\n" ^ format_amb) p;
|
|
|
- Some (List.map fst acc,t)
|
|
|
- | [] -> None
|
|
|
- in
|
|
|
- let fun_details() =
|
|
|
- let format_arg = (fun (name,opt,_) -> (if opt then "?" else "") ^ name) in
|
|
|
- "Function " ^ (match cf with None -> "" | Some (_,f) -> "'" ^ f.cf_name ^ "' ") ^ "requires " ^ (if args = [] then "no arguments" else "arguments : " ^ String.concat ", " (List.map format_arg args))
|
|
|
- in
|
|
|
- let invalid_skips = ref [] in
|
|
|
- let error acc txt =
|
|
|
- match next() with
|
|
|
- | Some l -> l
|
|
|
- | None ->
|
|
|
- display_error ctx (txt ^ " arguments\n" ^ (fun_details())) p;
|
|
|
- List.rev (List.map fst acc), (TFun(args,r))
|
|
|
+let rec unify_call_args' ctx el args r p inline force_inline =
|
|
|
+ let call_error err p =
|
|
|
+ raise (Error (Call_error err,p))
|
|
|
in
|
|
|
let arg_error ul name opt p =
|
|
|
- match next() with
|
|
|
- | Some l -> l
|
|
|
- | None -> raise (Error (Stack (Unify ul,Custom ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'")), p))
|
|
|
+ let err = Stack (Unify ul,Custom ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'")) in
|
|
|
+ call_error (Could_not_unify err) p
|
|
|
in
|
|
|
- let rec no_opt = function
|
|
|
- | [] -> []
|
|
|
- | ({ eexpr = TConst TNull },true) :: l -> no_opt l
|
|
|
- | l -> l
|
|
|
- in
|
|
|
- let rec default_value t po =
|
|
|
+ let rec default_value name t =
|
|
|
if is_pos_infos t then
|
|
|
let infos = mk_infos ctx p [] in
|
|
|
let e = type_expr ctx infos (WithType t) in
|
|
|
- (e, true)
|
|
|
- else begin
|
|
|
- if not ctx.com.config.pf_can_skip_non_nullable_argument then begin match po with
|
|
|
- | Some (name,p) when not (is_nullable t) -> invalid_skips := (name,p) :: !invalid_skips;
|
|
|
- | _ -> ()
|
|
|
- end;
|
|
|
- (null (ctx.t.tnull t) p, true)
|
|
|
- end
|
|
|
+ e
|
|
|
+ else
|
|
|
+ null (ctx.t.tnull t) p
|
|
|
in
|
|
|
- let force_inline, is_extern = match cf with Some(TInst(c,_),f) -> is_forced_inline (Some c) f, c.cl_extern | _ -> false, false in
|
|
|
- let rec loop acc l l2 skip check_rest =
|
|
|
- match l , l2 with
|
|
|
- | [] , [] ->
|
|
|
- begin match !invalid_skips with
|
|
|
- | [] -> ()
|
|
|
- | skips -> List.iter (fun (name,p) -> display_error ctx ("Cannot skip non-nullable argument " ^ name) p) skips
|
|
|
- end;
|
|
|
- let args,tf = if not (inline && (ctx.g.doinline || force_inline)) && not ctx.com.config.pf_pad_nulls then
|
|
|
- List.rev (no_opt acc), (TFun(args,r))
|
|
|
- else
|
|
|
- List.rev (acc), (TFun(args,r))
|
|
|
- in
|
|
|
- if not legacy && ctx.com.config.pf_overload then
|
|
|
- match next ~retval:(args,tf) () with
|
|
|
- | Some l -> l
|
|
|
- | None ->
|
|
|
- display_error ctx ("No overloaded function matches the arguments. Are the arguments correctly typed?") p;
|
|
|
- List.map fst args, tf
|
|
|
- else
|
|
|
- List.map fst args, tf
|
|
|
- | l , [(name,opt,t)] when check_rest ->
|
|
|
- (match follow t with
|
|
|
+ let skipped = ref [] in
|
|
|
+ let skip name ul t =
|
|
|
+ if not ctx.com.config.pf_can_skip_non_nullable_argument && not (is_nullable t) then
|
|
|
+ call_error (Cannot_skip_non_nullable name) p;
|
|
|
+ skipped := (name,ul) :: !skipped;
|
|
|
+ default_value name t
|
|
|
+ in
|
|
|
+ (* let force_inline, is_extern = match cf with Some(TInst(c,_),f) -> is_forced_inline (Some c) f, c.cl_extern | _ -> false, false in *)
|
|
|
+ let force_inline, is_extern = false, false in
|
|
|
+ let type_against t e =
|
|
|
+ let e = type_expr ctx e (WithTypeResume t) in
|
|
|
+ (try unify_raise ctx e.etype t e.epos with Error (Unify l,p) -> raise (WithTypeError (l,p)));
|
|
|
+ let e = Codegen.AbstractCast.check_cast ctx t e p in
|
|
|
+ e
|
|
|
+ in
|
|
|
+ let rec loop el args = match el,args with
|
|
|
+ | [],[] ->
|
|
|
+ []
|
|
|
+ | _,[name,false,t] when (match follow t with TAbstract({a_path = ["haxe"],"Rest"},_) -> true | _ -> false) ->
|
|
|
+ begin match follow t with
|
|
|
| TAbstract({a_path=(["haxe"],"Rest")},[t]) ->
|
|
|
- let rec process acc el =
|
|
|
- match el with
|
|
|
- | [] -> acc
|
|
|
- | ee :: rest ->
|
|
|
- let e = type_expr ctx ee (WithTypeResume t) in
|
|
|
- begin try
|
|
|
- unify_raise ctx e.etype t e.epos
|
|
|
- with Error (Unify ul,p) ->
|
|
|
- raise (Error (Stack (Unify ul,Custom ("For rest function argument '" ^ name ^ "'")), p))
|
|
|
- end;
|
|
|
- process ((Codegen.AbstractCast.check_cast ctx t e p,false) :: acc) rest
|
|
|
- in
|
|
|
- loop (process acc l) [] [] skip false
|
|
|
+ (try List.map (fun e -> type_against t e,false) el with WithTypeError(ul,p) -> arg_error ul name false p)
|
|
|
| _ ->
|
|
|
- loop acc l l2 skip false)
|
|
|
- | [] , (_,false,_) :: _ ->
|
|
|
- error (List.fold_left (fun acc (_,_,t) -> default_value t None :: acc) acc l2) "Not enough"
|
|
|
- | [] , (name,true,t) :: l ->
|
|
|
- loop (default_value t None :: acc) [] l skip check_rest
|
|
|
- | _ , [] ->
|
|
|
- (match List.rev skip with
|
|
|
- | [] -> error acc "Too many"
|
|
|
- | [name,ul] -> arg_error ul name true p
|
|
|
- | (name,ul) :: _ -> arg_error (Unify_custom ("Invalid arguments\n" ^ fun_details()) :: ul) name true p)
|
|
|
- | ee :: l, (name,opt,t) :: l2 ->
|
|
|
- try
|
|
|
- let e = type_expr ctx ee (WithTypeResume t) in
|
|
|
- (try unify_raise ctx e.etype t e.epos with Error (Unify l,p) -> raise (WithTypeError (l,p)));
|
|
|
- loop ((Codegen.AbstractCast.check_cast ctx t e p,false) :: acc) l l2 skip check_rest
|
|
|
+ assert false
|
|
|
+ end
|
|
|
+ | [],(_,false,_) :: _ ->
|
|
|
+ call_error Not_enough_arguments p
|
|
|
+ | [],(name,true,t) :: args ->
|
|
|
+ begin match loop [] args with
|
|
|
+ | [] when not (inline && (ctx.g.doinline || force_inline)) && not ctx.com.config.pf_pad_nulls -> []
|
|
|
+ | args ->
|
|
|
+ let e_def = default_value name t in
|
|
|
+ (e_def,true) :: args
|
|
|
+ end
|
|
|
+ | (_,p) :: _, [] ->
|
|
|
+ begin match List.rev !skipped with
|
|
|
+ | [] -> call_error Too_many_arguments p
|
|
|
+ | (s,ul) :: _ -> arg_error ul s true p
|
|
|
+ end
|
|
|
+ | e :: el,(name,opt,t) :: args ->
|
|
|
+ begin try
|
|
|
+ let e = type_against t e in
|
|
|
+ (e,opt) :: loop el args
|
|
|
with
|
|
|
WithTypeError (ul,p) ->
|
|
|
if opt then
|
|
|
- loop (default_value t (Some (name,p)) :: acc) (ee :: l) l2 ((name,ul) :: skip) check_rest
|
|
|
+ let e_def = skip name ul t in
|
|
|
+ (e_def,true) :: loop (e :: el) args
|
|
|
else
|
|
|
arg_error ul name false p
|
|
|
+ end
|
|
|
+ in
|
|
|
+ let el = loop el args in
|
|
|
+ el,TFun(args,r)
|
|
|
+
|
|
|
+let unify_call_args ctx el args r p inline force_inline =
|
|
|
+ let el,tf = unify_call_args' ctx el args r p inline force_inline in
|
|
|
+ List.map fst el,tf
|
|
|
+
|
|
|
+let unify_field_call ctx fa el args ret p inline =
|
|
|
+ let map_cf map cf = map (monomorphs cf.cf_params cf.cf_type),cf in
|
|
|
+ let expand_overloads map cf =
|
|
|
+ (TFun(args,ret),cf) :: (List.map (map_cf map) cf.cf_overloads)
|
|
|
+ in
|
|
|
+ let candidates,co,cf,mk_fa = match fa with
|
|
|
+ | 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,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
|
|
|
+ List.map (map_cf map) cf.cf_overloads
|
|
|
+ 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,None,cf,(fun cf -> FInstance(c,tl,cf))
|
|
|
+ | _ ->
|
|
|
+ error "Invalid field call" p
|
|
|
+ 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 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
|
|
|
+ | _ ->
|
|
|
+ assert false
|
|
|
+ end
|
|
|
+ with Error (Call_error _,_) as err ->
|
|
|
+ candidates,err :: failures
|
|
|
+ end
|
|
|
+ ) ([],[]) candidates in
|
|
|
+ let fail () = match List.rev failures with
|
|
|
+ | err :: _ -> raise err
|
|
|
+ | _ -> assert false
|
|
|
in
|
|
|
- loop [] el args [] is_extern
|
|
|
+ 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
|
|
|
@@ -895,7 +873,7 @@ let make_call ctx e params t p =
|
|
|
try
|
|
|
let ethis, fname = (match e.eexpr with TField (ethis,f) -> ethis, field_name f | _ -> raise Exit) in
|
|
|
let f, cl = (match follow ethis.etype with
|
|
|
- | TInst (c,params) -> (try let _,_,f = Type.class_field c fname in f with Not_found -> raise Exit), Some c
|
|
|
+ | TInst (c,params) -> (try let _,_,f = Type.class_field c params fname in f with Not_found -> raise Exit), Some c
|
|
|
| TAnon a -> (try PMap.find fname a.a_fields with Not_found -> raise Exit), (match !(a.a_status) with Statics c -> Some c | _ -> None)
|
|
|
| _ -> raise Exit
|
|
|
) in
|
|
|
@@ -982,7 +960,7 @@ let rec acc_get ctx g p =
|
|
|
| _ -> assert false)
|
|
|
| AKInline (e,f,fmode,t) ->
|
|
|
(* do not create a closure for static calls *)
|
|
|
- let cmode = (match fmode with FStatic _ -> fmode | FInstance (c,f) -> FClosure (Some c,f) | _ -> assert false) in
|
|
|
+ let cmode = (match fmode with FStatic _ -> fmode | FInstance (c,_,f) -> FClosure (Some c,f) | _ -> assert false) in
|
|
|
ignore(follow f.cf_type); (* force computing *)
|
|
|
(match f.cf_expr with
|
|
|
| None ->
|
|
|
@@ -1106,8 +1084,8 @@ let field_access ctx mode f fmode t e p =
|
|
|
| MethMacro, MCall -> AKMacro (e,f)
|
|
|
| _ , MGet ->
|
|
|
let cmode = (match fmode with
|
|
|
- | FInstance(_, cf) | FStatic(_, cf) when Meta.has Meta.Generic cf.cf_meta -> display_error ctx "Cannot create closure on generic function" p; fmode
|
|
|
- | FInstance (c,cf) -> FClosure (Some c,cf)
|
|
|
+ | FInstance(_, _, cf) | FStatic(_, cf) when Meta.has Meta.Generic cf.cf_meta -> display_error ctx "Cannot create closure on generic function" p; fmode
|
|
|
+ | FInstance (c,_,cf) -> FClosure (Some c,cf)
|
|
|
| FStatic _ | FEnum _ -> fmode
|
|
|
| FAnon f -> FClosure (None, f)
|
|
|
| FDynamic _ | FClosure _ -> assert false
|
|
|
@@ -1285,7 +1263,7 @@ let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
|
|
|
let cf = { (mk_field v.v_name v.v_type e.epos) with cf_params = params; cf_expr = Some e; cf_kind = Method MethInline } in
|
|
|
c.cl_extern <- true;
|
|
|
c.cl_fields <- PMap.add cf.cf_name cf PMap.empty;
|
|
|
- AKInline (mk (TConst TNull) (TInst (c,[])) p, cf, FInstance(c,cf), t)
|
|
|
+ AKInline (mk (TConst TNull) (TInst (c,[])) p, cf, FInstance(c,[],cf), t)
|
|
|
| _ ->
|
|
|
AKExpr (mk (TLocal v) t p))
|
|
|
| _ ->
|
|
|
@@ -1293,8 +1271,8 @@ let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
|
|
|
with Not_found -> try
|
|
|
(* member variable lookup *)
|
|
|
if ctx.curfun = FunStatic then raise Not_found;
|
|
|
- let c , t , f = class_field ctx ctx.curclass [] i p in
|
|
|
- field_access ctx mode f (match c with None -> FAnon f | Some c -> FInstance (c,f)) t (get_this ctx p) p
|
|
|
+ let c , t , f = class_field ctx ctx.curclass (List.map snd ctx.curclass.cl_params) i p in
|
|
|
+ field_access ctx mode f (match c with None -> FAnon f | Some (c,tl) -> FInstance (c,tl,f)) t (get_this ctx p) p
|
|
|
with Not_found -> try
|
|
|
(* lookup using on 'this' *)
|
|
|
if ctx.curfun = FunStatic then raise Not_found;
|
|
|
@@ -1398,7 +1376,7 @@ and type_field ?(resume=false) ctx e i p mode =
|
|
|
with Unify_error l ->
|
|
|
display_error ctx "Field resolve has an invalid type" f.cf_pos;
|
|
|
display_error ctx (error_msg (Unify [Cannot_unify(tfield,texpect)])) f.cf_pos);
|
|
|
- AKExpr (make_call ctx (mk (TField (e,FInstance (c,f))) tfield p) [Codegen.type_constant ctx.com (String i) p] t p)
|
|
|
+ AKExpr (make_call ctx (mk (TField (e,FInstance (c,params,f))) tfield p) [Codegen.type_constant ctx.com (String i) p] t p)
|
|
|
end else
|
|
|
AKExpr (mk (TField (e,FDynamic i)) t p)
|
|
|
| None ->
|
|
|
@@ -1418,14 +1396,14 @@ and type_field ?(resume=false) ctx e i p mode =
|
|
|
| MCall, _ ->
|
|
|
()
|
|
|
| MGet,Var _
|
|
|
- | MSet,Var _ when (match c2 with Some { cl_extern = true; cl_path = ("flash" :: _,_) } -> true | _ -> false) ->
|
|
|
+ | MSet,Var _ when (match c2 with Some ({ cl_extern = true; cl_path = ("flash" :: _,_) }, _) -> true | _ -> false) ->
|
|
|
()
|
|
|
| _, Method _ ->
|
|
|
display_error ctx "Cannot create closure on super method" p
|
|
|
| _ ->
|
|
|
display_error ctx "Normal variables cannot be accessed with 'super', use 'this' instead" p);
|
|
|
if not (can_access ctx c f false) && not ctx.untyped then display_error ctx ("Cannot access private field " ^ i) p;
|
|
|
- field_access ctx mode f (match c2 with None -> FAnon f | Some c -> FInstance (c,f)) (apply_params c.cl_params params t) e p
|
|
|
+ field_access ctx mode f (match c2 with None -> FAnon f | Some (c,tl) -> FInstance (c,tl,f)) (apply_params c.cl_params params t) e p
|
|
|
with Not_found -> try
|
|
|
using_field ctx mode e i p
|
|
|
with Not_found -> try
|
|
|
@@ -1655,8 +1633,8 @@ let unify_int ctx e k =
|
|
|
match follow t with
|
|
|
| TAnon a ->
|
|
|
(try is_dynamic (PMap.find f a.a_fields).cf_type with Not_found -> false)
|
|
|
- | TInst (c,pl) ->
|
|
|
- (try is_dynamic (apply_params c.cl_params pl ((let _,t,_ = Type.class_field c f in t))) with Not_found -> false)
|
|
|
+ | TInst (c,tl) ->
|
|
|
+ (try is_dynamic (apply_params c.cl_params tl ((let _,t,_ = Type.class_field c tl f in t))) with Not_found -> false)
|
|
|
| _ ->
|
|
|
true
|
|
|
in
|
|
|
@@ -1718,7 +1696,7 @@ let type_generic_function ctx (e,cf) el ?(using_param=None) with_type p =
|
|
|
| WithTypeResume t -> (try unify_raise ctx ret t p with Error (Unify l,_) -> raise (WithTypeError(l,p)))
|
|
|
| _ -> ()
|
|
|
end;
|
|
|
- let el,_ = unify_call_args ctx None el args ret p false in
|
|
|
+ let el,_ = unify_call_args ctx el args ret p false false in
|
|
|
let el = match using_param with None -> el | Some e -> e :: el in
|
|
|
(try
|
|
|
let gctx = Codegen.make_generic ctx cf.cf_params monos p in
|
|
|
@@ -1764,8 +1742,8 @@ 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
|
|
|
- (el,ret,e)
|
|
|
+ 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)
|
|
|
|
|
|
@@ -1801,7 +1779,7 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
|
|
|
check_assign ctx e1;
|
|
|
(match e1.eexpr , e2.eexpr with
|
|
|
| TLocal i1 , TLocal i2 when i1 == i2 -> error "Assigning a value to itself" p
|
|
|
- | TField ({ eexpr = TConst TThis },FInstance (_,f1)) , TField ({ eexpr = TConst TThis },FInstance (_,f2)) when f1 == f2 ->
|
|
|
+ | TField ({ eexpr = TConst TThis },FInstance (_,_,f1)) , TField ({ eexpr = TConst TThis },FInstance (_,_,f2)) when f1 == f2 ->
|
|
|
error "Assigning a value to itself" p
|
|
|
| _ , _ -> ());
|
|
|
mk (TBinop (op,e1,e2)) e1.etype p
|
|
|
@@ -1949,7 +1927,7 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
|
|
|
let std = type_type ctx ([],"Std") e.epos in
|
|
|
let acc = acc_get ctx (type_field ctx std "string" e.epos MCall) e.epos in
|
|
|
ignore(follow acc.etype);
|
|
|
- let acc = (match acc.eexpr with TField (e,FClosure (Some c,f)) -> { acc with eexpr = TField (e,FInstance (c,f)) } | _ -> acc) in
|
|
|
+ let acc = (match acc.eexpr with TField (e,FClosure (Some c,f)) -> { acc with eexpr = TField (e,FInstance (c,[],f)) } | _ -> acc) in
|
|
|
make_call ctx acc [e] ctx.t.tstring e.epos
|
|
|
| KAbstract (a,tl) ->
|
|
|
loop (Abstract.get_underlying_type a tl)
|
|
|
@@ -2949,7 +2927,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
|
|
|
+ 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
|
|
|
@@ -3045,7 +3023,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
if fhasnext.cf_kind <> Method MethInline then raise Exit;
|
|
|
let tmp = gen_local ctx e1.etype in
|
|
|
let eit = mk (TLocal tmp) e1.etype p in
|
|
|
- let ehasnext = make_call ctx (mk (TField (eit,FInstance (c, fhasnext))) (TFun([],ctx.t.tbool)) p) [] ctx.t.tbool p in
|
|
|
+ let ehasnext = make_call ctx (mk (TField (eit,FInstance (c, pl, fhasnext))) (TFun([],ctx.t.tbool)) p) [] ctx.t.tbool p in
|
|
|
let enext = mk (TVar (i,Some (make_call ctx (mk (TField (eit,FDynamic "next")) (TFun ([],pt)) p) [] pt p))) ctx.t.tvoid p in
|
|
|
let eblock = (match e2.eexpr with
|
|
|
| TBlock el -> { e2 with eexpr = TBlock (enext :: el) }
|
|
|
@@ -3244,7 +3222,8 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
let unify_constructor_call c params f ct = match follow ct with
|
|
|
| TFun (args,r) ->
|
|
|
(try
|
|
|
- fst (unify_call_args ctx (Some (TInst(c,params),f)) el args r p false)
|
|
|
+ let el,_,_ = unify_field_call ctx (FInstance(c,params,f)) el args r p false in
|
|
|
+ el
|
|
|
with Error (e,p) ->
|
|
|
display_error ctx (error_msg e) p;
|
|
|
[])
|
|
|
@@ -3267,14 +3246,16 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
| mt ->
|
|
|
error ((s_type_path (t_infos mt).mt_path) ^ " cannot be constructed") p
|
|
|
in
|
|
|
- let ct = (match t with
|
|
|
- | TAbstract (a,pl) ->
|
|
|
- (match a.a_impl with
|
|
|
- | None -> t
|
|
|
- | Some c -> TInst (c,pl))
|
|
|
- | _ -> t
|
|
|
- ) in
|
|
|
- (match ct with
|
|
|
+ let build_constructor_call c tl =
|
|
|
+ let ct, f = get_constructor ctx c tl p in
|
|
|
+ if not (can_access ctx c f true || is_parent c ctx.curclass) && not ctx.untyped then display_error ctx "Cannot access private constructor" p;
|
|
|
+ (match f.cf_kind with
|
|
|
+ | Var { v_read = AccRequire (r,msg) } -> (match msg with Some msg -> error msg p | None -> error_require r p)
|
|
|
+ | _ -> ());
|
|
|
+ let el = unify_constructor_call c tl f ct in
|
|
|
+ el,f,ct
|
|
|
+ in
|
|
|
+ (match t with
|
|
|
| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
|
|
|
if not (Typeload.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p;
|
|
|
let el = List.map (fun e -> type_expr ctx e Value) el in
|
|
|
@@ -3289,21 +3270,15 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
| _ -> false
|
|
|
) tl) then error (s_type_path c.cl_path ^ " does not have a constructor") p;
|
|
|
mk (TNew (c,params,el)) t p
|
|
|
- | TInst (c,params) ->
|
|
|
- let ct, f = get_constructor ctx c params p in
|
|
|
- if not (can_access ctx c f true || is_parent c ctx.curclass) && not ctx.untyped then display_error ctx "Cannot access private constructor" p;
|
|
|
- (match f.cf_kind with
|
|
|
- | Var { v_read = AccRequire (r,msg) } -> (match msg with Some msg -> error msg p | None -> error_require r p)
|
|
|
- | _ -> ());
|
|
|
- let el = unify_constructor_call c params f ct in
|
|
|
- (match c.cl_kind with
|
|
|
- | KAbstractImpl a when not (Meta.has Meta.MultiType a.a_meta) ->
|
|
|
- let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
|
|
|
- let e = mk (TTypeExpr (TClassDecl c)) ta p in
|
|
|
- let e = mk (TField (e,(FStatic (c,f)))) ct p in
|
|
|
- make_call ctx e el t p
|
|
|
- | _ ->
|
|
|
- mk (TNew (c,params,el)) t p)
|
|
|
+ | TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) ->
|
|
|
+ let el,cf,ct = build_constructor_call c tl in
|
|
|
+ let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
|
|
|
+ let e = mk (TTypeExpr (TClassDecl c)) ta p in
|
|
|
+ let e = mk (TField (e,(FStatic (c,cf)))) ct p in
|
|
|
+ make_call ctx e el t p
|
|
|
+ | TInst (c,params) | TAbstract({a_impl = Some c},params) ->
|
|
|
+ let el,_,_ = build_constructor_call c params in
|
|
|
+ mk (TNew (c,params,el)) t p
|
|
|
| _ ->
|
|
|
error (s_type (print_context()) t ^ " cannot be constructed") p)
|
|
|
| EUnop (op,flag,e) ->
|
|
|
@@ -3510,7 +3485,7 @@ and handle_display ctx e_ast iscall p =
|
|
|
if ctx.com.display = DMPosition then
|
|
|
raise (DisplayPosition [ef.ef_pos]);
|
|
|
ef.ef_meta <- (Meta.Usage,[],p) :: ef.ef_meta;
|
|
|
- | TField(_,(FAnon cf | FInstance (_,cf) | FStatic (_,cf) | FClosure (_,cf))) ->
|
|
|
+ | TField(_,(FAnon cf | FInstance (_,_,cf) | FStatic (_,cf) | FClosure (_,cf))) ->
|
|
|
handle_field cf;
|
|
|
| TLocal v ->
|
|
|
v.v_meta <- (Meta.Usage,[],p) :: v.v_meta;
|
|
|
@@ -3771,9 +3746,10 @@ and type_call ctx e el (with_type:with_type) p =
|
|
|
| None -> error "Current class does not have a super" p
|
|
|
| Some (c,params) ->
|
|
|
let ct, f = get_constructor ctx c params p in
|
|
|
- let el, _ = (match follow ct with
|
|
|
+ let el = (match follow ct with
|
|
|
| TFun (args,r) ->
|
|
|
- unify_call_args ctx (Some (TInst(c,params),f)) el args r p false
|
|
|
+ let el,_,_ = unify_field_call ctx (FInstance(c,params,f)) el args r p false in
|
|
|
+ el
|
|
|
| _ ->
|
|
|
error "Constructor is not a function" p
|
|
|
) in
|
|
|
@@ -3784,11 +3760,6 @@ and type_call ctx e el (with_type:with_type) p =
|
|
|
def ()
|
|
|
|
|
|
and build_call ctx acc el (with_type:with_type) p =
|
|
|
- let fopts t f = match follow t with
|
|
|
- | (TInst (c,pl) as t) -> Some (t,f)
|
|
|
- | (TAnon a) as t -> (match !(a.a_status) with Statics c -> Some (TInst(c,List.map snd c.cl_params),f) | _ -> Some (t,f))
|
|
|
- | _ -> None
|
|
|
- in
|
|
|
let push_this e =
|
|
|
match e.eexpr with
|
|
|
| TConst (TInt _ | TFloat _ | TString _ | TBool _) ->
|
|
|
@@ -3800,19 +3771,19 @@ and build_call ctx acc el (with_type:with_type) p =
|
|
|
in
|
|
|
match acc with
|
|
|
| AKInline (ethis,f,fmode,t) when Meta.has Meta.Generic f.cf_meta ->
|
|
|
- let el,t,e = type_generic_function ctx (ethis,f) el with_type p in
|
|
|
- make_call ctx e el t p
|
|
|
+ type_generic_function ctx (ethis,f) el with_type p
|
|
|
| AKInline (ethis,f,fmode,t) ->
|
|
|
- let params, tfunc = (match follow t with
|
|
|
- | TFun (args,r) -> unify_call_args ctx (fopts ethis.etype f) el args r p true
|
|
|
- | _ -> error (s_type (print_context()) t ^ " cannot be called") p
|
|
|
- ) in
|
|
|
- make_call ctx (mk (TField (ethis,fmode)) t p) params (match tfunc with TFun(_,r) -> r | _ -> assert false) p
|
|
|
+ (match follow t with
|
|
|
+ | TFun (args,r) ->
|
|
|
+ let _,_,mk_call = unify_field_call ctx fmode el args r p true in
|
|
|
+ mk_call ethis
|
|
|
+ | _ ->
|
|
|
+ error (s_type (print_context()) t ^ " cannot be called") p
|
|
|
+ )
|
|
|
| AKUsing (et,cl,ef,eparam) when Meta.has Meta.Generic ef.cf_meta ->
|
|
|
(match et.eexpr with
|
|
|
| TField(ec,_) ->
|
|
|
- let el,t,e = type_generic_function ctx (ec,ef) el ~using_param:(Some eparam) with_type p in
|
|
|
- make_call ctx e el t p
|
|
|
+ type_generic_function ctx (ec,ef) el ~using_param:(Some eparam) with_type p
|
|
|
| _ -> assert false)
|
|
|
| AKUsing (et,cl,ef,eparam) ->
|
|
|
begin match ef.cf_kind with
|
|
|
@@ -3833,7 +3804,7 @@ and build_call ctx acc el (with_type:with_type) p =
|
|
|
| TFun ((_,_,t1) :: args,r) ->
|
|
|
unify ctx tthis t1 eparam.epos;
|
|
|
let ef = prepare_using_field ef in
|
|
|
- begin match unify_call_args ctx (Some (TInst(cl,[]),ef)) el args r p (ef.cf_kind = Method MethInline) with
|
|
|
+ begin match unify_call_args ctx el args r p (ef.cf_kind = Method MethInline) (is_forced_inline (Some cl) ef) with
|
|
|
| el,TFun(args,r) -> el,args,r,(if is_abstract_impl_call then eparam else Codegen.AbstractCast.check_cast ctx t1 eparam eparam.epos)
|
|
|
| _ -> assert false
|
|
|
end
|
|
|
@@ -3898,36 +3869,39 @@ and build_call ctx acc el (with_type:with_type) p =
|
|
|
| AKExpr e ->
|
|
|
let rec loop t = match follow t with
|
|
|
| TFun (args,r) ->
|
|
|
- let fopts = (match acc with
|
|
|
- | AKExpr {eexpr = TField(e, (FStatic (_,f) | FInstance(_,f) | FAnon(f)))} ->
|
|
|
- fopts e.etype f
|
|
|
- | _ ->
|
|
|
- None
|
|
|
- ) in
|
|
|
- (match fopts,acc with
|
|
|
- | Some (_,cf),AKExpr({eexpr = TField(e,_)}) when Meta.has Meta.Generic cf.cf_meta ->
|
|
|
- type_generic_function ctx (e,cf) el with_type p
|
|
|
+ begin match e.eexpr with
|
|
|
+ | TField(e1,fa) when not (match fa with FEnum _ -> true | _ -> false) ->
|
|
|
+ begin match fa with
|
|
|
+ | FInstance(_,_,cf) | FStatic(_,cf) when Meta.has Meta.Generic cf.cf_meta ->
|
|
|
+ type_generic_function ctx (e1,cf) el with_type p
|
|
|
+ | _ ->
|
|
|
+ let _,_,mk_call = unify_field_call ctx fa el args r p false in
|
|
|
+ mk_call e1
|
|
|
+ end
|
|
|
| _ ->
|
|
|
- let el, tfunc = unify_call_args ctx fopts el args r p false in
|
|
|
- el,(match tfunc with TFun(_,r) -> r | _ -> assert false), {e with etype = tfunc})
|
|
|
+ let el, tfunc = unify_call_args ctx el args r p false false in
|
|
|
+ let r = match tfunc with TFun(_,r) -> r | _ -> assert false in
|
|
|
+ mk (TCall ({e with etype = tfunc},el)) r p
|
|
|
+ end
|
|
|
| TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta ->
|
|
|
loop (Abstract.get_underlying_type a tl)
|
|
|
| TMono _ ->
|
|
|
let t = mk_mono() in
|
|
|
let el = List.map (fun e -> type_expr ctx e Value) el in
|
|
|
unify ctx (tfun (List.map (fun e -> e.etype) el) t) e.etype e.epos;
|
|
|
- el, t, e
|
|
|
+ mk (TCall (e,el)) t p
|
|
|
| t ->
|
|
|
let el = List.map (fun e -> type_expr ctx e Value) el in
|
|
|
- el, (if t == t_dynamic then
|
|
|
+ let t = if t == t_dynamic then
|
|
|
t_dynamic
|
|
|
else if ctx.untyped then
|
|
|
mk_mono()
|
|
|
else
|
|
|
- error (s_type (print_context()) e.etype ^ " cannot be called") e.epos), e
|
|
|
+ error (s_type (print_context()) e.etype ^ " cannot be called") e.epos
|
|
|
+ in
|
|
|
+ mk (TCall (e,el)) t p
|
|
|
in
|
|
|
- let el , t, e = loop e.etype in
|
|
|
- mk (TCall (e,el)) t p
|
|
|
+ loop e.etype
|
|
|
|
|
|
(* ---------------------------------------------------------------------- *)
|
|
|
(* FINALIZATION *)
|
|
|
@@ -4609,7 +4583,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
|
|
|
incr index;
|
|
|
(EArray ((EArrayDecl [e],p),(EConst (Int (string_of_int (!index))),p)),p)
|
|
|
) el in
|
|
|
- let elt, _ = unify_call_args mctx (Some (TInst(mclass,[]),mfield)) constants (List.map fst eargs) t_dynamic p false in
|
|
|
+ let elt, _ = unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false in
|
|
|
List.iter (fun f -> f()) (!todo);
|
|
|
List.map2 (fun (_,ise) e ->
|
|
|
let e, et = (match e.eexpr with
|
|
|
@@ -4696,7 +4670,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
|
|
|
|
|
|
let call_macro ctx path meth args p =
|
|
|
let mctx, (margs,_,mclass,mfield), call = load_macro ctx path meth p in
|
|
|
- let el, _ = unify_call_args mctx (Some (TInst(mclass,[]),mfield)) args margs t_dynamic p false in
|
|
|
+ let el, _ = unify_call_args mctx args margs t_dynamic p false false in
|
|
|
call (List.map (fun e -> try Interp.make_const e with Exit -> error "Parameter should be a constant" e.epos) el)
|
|
|
|
|
|
let call_init_macro ctx e =
|
Simon Krajewski