|
|
@@ -62,6 +62,11 @@ type access_kind =
|
|
|
| AKUsing of texpr * tclass * tclass_field * texpr
|
|
|
| AKAccess of tabstract * tparams * tclass * texpr * texpr
|
|
|
|
|
|
+type object_decl_kind =
|
|
|
+ | ODKWithStructure of tanon
|
|
|
+ | ODKWithClass of tclass * tparams
|
|
|
+ | ODKPlain
|
|
|
+
|
|
|
let build_call_ref : (typer -> access_kind -> expr list -> with_type -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
|
|
|
|
|
|
let mk_infos ctx p params =
|
|
|
@@ -133,6 +138,20 @@ let get_iterable_param t =
|
|
|
raise Not_found)
|
|
|
| _ -> raise Not_found
|
|
|
|
|
|
+let get_abstract_froms a pl =
|
|
|
+ let l = List.map (apply_params a.a_params pl) a.a_from in
|
|
|
+ List.fold_left (fun acc (t,f) ->
|
|
|
+ match follow (field_type f) with
|
|
|
+ | TFun ([_,_,v],t) ->
|
|
|
+ (try
|
|
|
+ ignore(type_eq EqStrict t (TAbstract(a,List.map dup pl))); (* unify fields monomorphs *)
|
|
|
+ v :: acc
|
|
|
+ with Unify_error _ ->
|
|
|
+ acc)
|
|
|
+ | _ ->
|
|
|
+ acc
|
|
|
+ ) l a.a_from_field
|
|
|
+
|
|
|
(*
|
|
|
temporally remove the constant flag from structures to allow larger unification
|
|
|
*)
|
|
|
@@ -3026,52 +3045,39 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
let dynamic_parameter = ref None in
|
|
|
let a = (match with_type with
|
|
|
| WithType t ->
|
|
|
- (match follow t with
|
|
|
- | TAnon a when not (PMap.is_empty a.a_fields) -> Some a
|
|
|
- (* issues with https://github.com/HaxeFoundation/haxe/issues/3437 *)
|
|
|
-(* | TAbstract (a,tl) when not (Meta.has Meta.CoreType a.a_meta) && a.a_from <> [] ->
|
|
|
- begin match follow (Abstract.get_underlying_type a tl) with
|
|
|
- | TAnon a when not (PMap.is_empty a.a_fields) -> Some a
|
|
|
- | _ -> None
|
|
|
- end *)
|
|
|
- | TDynamic t when (follow t != t_dynamic) ->
|
|
|
- dynamic_parameter := Some t;
|
|
|
- Some {
|
|
|
- a_status = ref Closed;
|
|
|
- a_fields = PMap.empty;
|
|
|
- }
|
|
|
- | _ -> None)
|
|
|
- | _ -> None
|
|
|
+ let rec loop t =
|
|
|
+ match follow t with
|
|
|
+ | TAnon a when not (PMap.is_empty a.a_fields) -> ODKWithStructure a
|
|
|
+ | TAbstract (a,pl) when not (Meta.has Meta.CoreType a.a_meta) ->
|
|
|
+ (match List.fold_left (fun acc t -> match loop t with ODKPlain -> acc | t -> t :: acc) [] (get_abstract_froms a pl) with
|
|
|
+ | [t] -> t
|
|
|
+ | _ -> ODKPlain)
|
|
|
+ | TDynamic t when (follow t != t_dynamic) ->
|
|
|
+ dynamic_parameter := Some t;
|
|
|
+ ODKWithStructure {
|
|
|
+ a_status = ref Closed;
|
|
|
+ a_fields = PMap.empty;
|
|
|
+ }
|
|
|
+ | TInst(c,tl) when Meta.has Meta.StructInit c.cl_meta ->
|
|
|
+ ODKWithClass(c,tl)
|
|
|
+ | _ ->
|
|
|
+ ODKPlain
|
|
|
+ in
|
|
|
+ loop t
|
|
|
+ | _ ->
|
|
|
+ ODKPlain
|
|
|
) in
|
|
|
let wrap_quoted_meta e =
|
|
|
mk (TMeta((Meta.QuotedField,[],e.epos),e)) e.etype e.epos
|
|
|
in
|
|
|
- (match a with
|
|
|
- | None ->
|
|
|
- let rec loop (l,acc) (f,e) =
|
|
|
- let f,is_quoted,is_valid = Parser.unquote_ident f in
|
|
|
- if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
|
|
|
- let e = type_expr ctx e Value in
|
|
|
- (match follow e.etype with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
|
|
|
- let cf = mk_field f e.etype e.epos in
|
|
|
- let e = if is_quoted then wrap_quoted_meta e else e in
|
|
|
- ((f,e) :: l, if is_valid then begin
|
|
|
- if String.length f > 0 && f.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
|
|
|
- PMap.add f cf acc
|
|
|
- end else acc)
|
|
|
- in
|
|
|
- let fields , types = List.fold_left loop ([],PMap.empty) fl in
|
|
|
- let x = ref Const in
|
|
|
- ctx.opened <- x :: ctx.opened;
|
|
|
- mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
|
|
|
- | Some a ->
|
|
|
+ let type_fields field_map =
|
|
|
let fields = ref PMap.empty in
|
|
|
let extra_fields = ref [] in
|
|
|
let fl = List.map (fun (n, e) ->
|
|
|
let n,is_quoted,is_valid = Parser.unquote_ident n in
|
|
|
if PMap.mem n !fields then error ("Duplicate field in object declaration : " ^ n) p;
|
|
|
let e = try
|
|
|
- let t = (match !dynamic_parameter with Some t -> t | None -> (PMap.find n a.a_fields).cf_type) in
|
|
|
+ let t = (match !dynamic_parameter with Some t -> t | None -> (PMap.find n field_map).cf_type) in
|
|
|
let e = type_expr ctx e (WithType t) in
|
|
|
let e = Codegen.AbstractCast.cast_or_unify ctx t e p in
|
|
|
(try type_eq EqStrict e.etype t; e with Unify_error _ -> mk (TCast (e,None)) t e.epos)
|
|
|
@@ -3090,7 +3096,7 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
) fl in
|
|
|
let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
|
|
|
if not ctx.untyped then begin
|
|
|
- (match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) a.a_fields [] with
|
|
|
+ (match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
|
|
|
| [] -> ()
|
|
|
| [n] -> raise_or_display ctx [Unify_custom ("Object requires field " ^ n)] p
|
|
|
| nl -> raise_or_display ctx [Unify_custom ("Object requires fields: " ^ (String.concat ", " nl))] p);
|
|
|
@@ -3098,8 +3104,63 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
| [] -> ()
|
|
|
| _ -> raise_or_display ctx (List.map (fun n -> has_extra_field t n) !extra_fields) p);
|
|
|
end;
|
|
|
+ t, fl
|
|
|
+ in
|
|
|
+ (match a with
|
|
|
+ | ODKPlain ->
|
|
|
+ let rec loop (l,acc) (f,e) =
|
|
|
+ let f,is_quoted,is_valid = Parser.unquote_ident f in
|
|
|
+ if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
|
|
|
+ let e = type_expr ctx e Value in
|
|
|
+ (match follow e.etype with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
|
|
|
+ let cf = mk_field f e.etype e.epos in
|
|
|
+ let e = if is_quoted then wrap_quoted_meta e else e in
|
|
|
+ ((f,e) :: l, if is_valid then begin
|
|
|
+ if String.length f > 0 && f.[0] = '$' then error "Field names starting with a dollar are not allowed" p;
|
|
|
+ PMap.add f cf acc
|
|
|
+ end else acc)
|
|
|
+ in
|
|
|
+ let fields , types = List.fold_left loop ([],PMap.empty) fl in
|
|
|
+ let x = ref Const in
|
|
|
+ ctx.opened <- x :: ctx.opened;
|
|
|
+ mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
|
|
|
+ | ODKWithStructure a ->
|
|
|
+ let t, fl = type_fields a.a_fields in
|
|
|
if !(a.a_status) <> Const then a.a_status := Closed;
|
|
|
- mk (TObjectDecl fl) t p)
|
|
|
+ mk (TObjectDecl fl) t p
|
|
|
+ | ODKWithClass (c,tl) ->
|
|
|
+ let _,ctor = get_constructor ctx c tl p in
|
|
|
+ let args = match follow ctor.cf_type with
|
|
|
+ | TFun(args,_) -> args
|
|
|
+ | _ -> assert false
|
|
|
+ in
|
|
|
+ let fields = List.fold_left (fun acc (n,opt,t) ->
|
|
|
+ let f = mk_field n t ctor.cf_pos in
|
|
|
+ if opt then f.cf_meta <- [(Meta.Optional,[],ctor.cf_pos)];
|
|
|
+ PMap.add n f acc
|
|
|
+ ) PMap.empty args in
|
|
|
+ let t,fl = type_fields fields in
|
|
|
+ let evars,fl,_ = List.fold_left (fun (evars,elocs,had_side_effect) (s,e) ->
|
|
|
+ begin match e.eexpr with
|
|
|
+ | TConst _ | TTypeExpr _ | TFunction _ ->
|
|
|
+ evars,(s,e) :: elocs,had_side_effect
|
|
|
+ | _ ->
|
|
|
+ if had_side_effect then begin
|
|
|
+ let v = gen_local ctx e.etype in
|
|
|
+ let ev = mk (TVar(v,Some e)) e.etype e.epos in
|
|
|
+ let eloc = mk (TLocal v) v.v_type e.epos in
|
|
|
+ (ev :: evars),((s,eloc) :: elocs),had_side_effect
|
|
|
+ end else
|
|
|
+ evars,(s,e) :: elocs,Optimizer.has_side_effect e
|
|
|
+ end
|
|
|
+ ) ([],[],false) (List.rev fl) in
|
|
|
+ let el = List.map (fun (n,_,t) ->
|
|
|
+ try List.assoc n fl
|
|
|
+ with Not_found -> mk (TConst TNull) t p
|
|
|
+ ) args in
|
|
|
+ let e = mk (TNew(c,tl,el)) (TInst(c,tl)) p in
|
|
|
+ mk (TBlock (List.rev (e :: (List.rev evars)))) e.etype e.epos
|
|
|
+ )
|
|
|
| EArrayDecl [(EFor _,_) | (EWhile _,_) as e] ->
|
|
|
let v = gen_local ctx (mk_mono()) in
|
|
|
let et = ref (EConst(Ident "null"),p) in
|
|
|
@@ -3197,18 +3258,25 @@ and type_expr ctx (e,p) (with_type:with_type) =
|
|
|
| EArrayDecl el ->
|
|
|
let tp = (match with_type with
|
|
|
| WithType t ->
|
|
|
- (match follow t with
|
|
|
- | TInst ({ cl_path = [],"Array" },[tp]) ->
|
|
|
- (match follow tp with
|
|
|
- | TMono _ -> None
|
|
|
- | _ -> Some tp)
|
|
|
- | TAnon _ ->
|
|
|
- (try
|
|
|
- Some (get_iterable_param t)
|
|
|
- with Not_found ->
|
|
|
- None)
|
|
|
- | t ->
|
|
|
- if t == t_dynamic then Some t else None)
|
|
|
+ let rec loop t =
|
|
|
+ (match follow t with
|
|
|
+ | TInst ({ cl_path = [],"Array" },[tp]) ->
|
|
|
+ (match follow tp with
|
|
|
+ | TMono _ -> None
|
|
|
+ | _ -> Some tp)
|
|
|
+ | TAnon _ ->
|
|
|
+ (try
|
|
|
+ Some (get_iterable_param t)
|
|
|
+ with Not_found ->
|
|
|
+ None)
|
|
|
+ | TAbstract (a,pl) ->
|
|
|
+ (match List.fold_left (fun acc t -> match loop t with None -> acc | Some t -> t :: acc) [] (get_abstract_froms a pl) with
|
|
|
+ | [t] -> Some t
|
|
|
+ | _ -> None)
|
|
|
+ | t ->
|
|
|
+ if t == t_dynamic then Some t else None)
|
|
|
+ in
|
|
|
+ loop t
|
|
|
| _ ->
|
|
|
None
|
|
|
) in
|
|
|
@@ -4410,14 +4478,14 @@ let get_type_patch ctx t sub =
|
|
|
let macro_timer ctx path =
|
|
|
Common.timer (if Common.defined ctx.com Define.MacroTimes then "macro " ^ path else "macro execution")
|
|
|
|
|
|
-let typing_timer ctx f =
|
|
|
+let typing_timer ctx need_type f =
|
|
|
let t = Common.timer "typing" in
|
|
|
let old = ctx.com.error and oldp = ctx.pass in
|
|
|
(*
|
|
|
disable resumable errors... unless we are in display mode (we want to reach point of completion)
|
|
|
*)
|
|
|
if ctx.com.display = DMNone then ctx.com.error <- (fun e p -> raise (Error(Custom e,p)));
|
|
|
- if ctx.pass < PTypeField then ctx.pass <- PTypeField;
|
|
|
+ if need_type && ctx.pass < PTypeField then ctx.pass <- PTypeField;
|
|
|
let exit() =
|
|
|
t();
|
|
|
ctx.com.error <- old;
|
|
|
@@ -4441,13 +4509,13 @@ let load_macro_ref : (typer -> path -> string -> pos -> (typer * ((string * bool
|
|
|
|
|
|
let make_macro_api ctx p =
|
|
|
let parse_expr_string s p inl =
|
|
|
- typing_timer ctx (fun() -> parse_expr_string ctx s p inl)
|
|
|
+ typing_timer ctx false (fun() -> parse_expr_string ctx s p inl)
|
|
|
in
|
|
|
{
|
|
|
Interp.pos = p;
|
|
|
Interp.get_com = (fun() -> ctx.com);
|
|
|
Interp.get_type = (fun s ->
|
|
|
- typing_timer ctx (fun() ->
|
|
|
+ typing_timer ctx false (fun() ->
|
|
|
let path = parse_path s in
|
|
|
let tp = match List.rev (fst path) with
|
|
|
| s :: sl when String.length s > 0 && (match s.[0] with 'A'..'Z' -> true | _ -> false) ->
|
|
|
@@ -4462,8 +4530,11 @@ let make_macro_api ctx p =
|
|
|
None
|
|
|
)
|
|
|
);
|
|
|
+ Interp.resolve_type = (fun t p ->
|
|
|
+ typing_timer ctx false (fun() -> Typeload.load_complex_type ctx p t)
|
|
|
+ );
|
|
|
Interp.get_module = (fun s ->
|
|
|
- typing_timer ctx (fun() ->
|
|
|
+ typing_timer ctx false (fun() ->
|
|
|
let path = parse_path s in
|
|
|
let m = List.map type_of_module_type (Typeload.load_module ctx path p).m_types in
|
|
|
m
|
|
|
@@ -4494,10 +4565,10 @@ let make_macro_api ctx p =
|
|
|
);
|
|
|
Interp.parse_string = parse_expr_string;
|
|
|
Interp.type_expr = (fun e ->
|
|
|
- typing_timer ctx (fun() -> (type_expr ctx e Value))
|
|
|
+ typing_timer ctx true (fun() -> type_expr ctx e Value)
|
|
|
);
|
|
|
Interp.type_macro_expr = (fun e ->
|
|
|
- let e = typing_timer ctx (fun() -> (type_expr ctx e Value)) in
|
|
|
+ let e = typing_timer ctx true (fun() -> type_expr ctx e Value) in
|
|
|
let rec loop e = match e.eexpr with
|
|
|
| TField(_,FStatic(c,({cf_kind = Method _} as cf))) -> ignore(!load_macro_ref ctx c.cl_path cf.cf_name e.epos)
|
|
|
| _ -> Type.iter loop e
|
|
|
@@ -4560,7 +4631,7 @@ let make_macro_api ctx p =
|
|
|
);
|
|
|
Interp.allow_package = (fun v -> Common.allow_package ctx.com v);
|
|
|
Interp.type_patch = (fun t f s v ->
|
|
|
- typing_timer ctx (fun() ->
|
|
|
+ typing_timer ctx false (fun() ->
|
|
|
let v = (match v with None -> None | Some s ->
|
|
|
match parse_string ctx.com ("typedef T = " ^ s) null_pos false with
|
|
|
| _,[ETypedef { d_data = ct },_] -> Some ct
|
|
|
@@ -4712,7 +4783,7 @@ let make_macro_api ctx p =
|
|
|
end
|
|
|
);
|
|
|
Interp.module_dependency = (fun mpath file ismacro ->
|
|
|
- let m = typing_timer ctx (fun() -> Typeload.load_module ctx (parse_path mpath) p) in
|
|
|
+ let m = typing_timer ctx false (fun() -> Typeload.load_module ctx (parse_path mpath) p) in
|
|
|
if ismacro then
|
|
|
m.m_extra.m_macro_calls <- file :: List.filter ((<>) file) m.m_extra.m_macro_calls
|
|
|
else
|
Simon Krajewski