Sfoglia il codice sorgente

[typer] add configuration to `type_field` (#8236)

see #8221
Simon Krajewski 6 anni fa
parent
commit
ac79e6deac
5 ha cambiato i file con 49 aggiunte e 19 eliminazioni
  1. 1 1
      src/typing/calls.ml
  2. 32 6
      src/typing/fields.ml
  3. 12 8
      src/typing/forLoop.ml
  4. 1 1
      src/typing/matcher.ml
  5. 3 3
      src/typing/typer.ml

+ 1 - 1
src/typing/calls.ml

@@ -101,7 +101,7 @@ let mk_array_set_call ctx (cf,tf,r,e1,e2o) c ebase p =
 let call_to_string ctx ?(resume=false) e =
 	(* Ignore visibility of the toString field. *)
 	ctx.meta <- (Meta.PrivateAccess,[],e.epos) :: ctx.meta;
-	let acc = type_field ~resume ctx e "toString" e.epos MCall in
+	let acc = type_field (TypeFieldConfig.create resume) ctx e "toString" e.epos MCall in
 	ctx.meta <- List.tl ctx.meta;
 	!build_call_ref ctx acc [] (WithType.with_type ctx.t.tstring) e.epos
 

+ 32 - 6
src/typing/fields.ml

@@ -6,6 +6,29 @@ open TyperBase
 open Error
 open Typecore
 
+module TypeFieldConfig = struct
+	type t = {
+		allow_resolve : bool;
+		do_resume : bool;
+	}
+
+	let allow_resolve cfg = cfg.allow_resolve
+
+	let do_resume cfg = cfg.do_resume
+
+	let default = {
+		allow_resolve = true;
+		do_resume = false;
+	}
+
+	let create resume = {
+		allow_resolve = true;
+		do_resume = resume;
+	}
+
+	let with_resume cfg = {cfg with do_resume = true}
+end
+
 (*
 	temporally remove the constant flag from structures to allow larger unification
 *)
@@ -292,9 +315,9 @@ let rec using_field ctx mode e i p =
 		remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
 
 (* Resolves field [i] on typed expression [e] using the given [mode]. *)
-let rec type_field ?(resume=false) ctx e i p mode =
+let rec type_field cfg ctx e i p mode =
 	let no_field() =
-		if resume then raise Not_found;
+		if TypeFieldConfig.do_resume cfg then raise Not_found;
 		let t = match follow e.etype with
 			| TAnon a -> (match !(a.a_status) with
 				| Statics {cl_kind = KAbstractImpl a} -> TAbstract(a,[])
@@ -393,7 +416,7 @@ let rec type_field ?(resume=false) ctx e i p mode =
 							begin match follow t with
 								| TAbstract({a_impl = Some c},tl) when PMap.mem i c.cl_statics ->
 									let e = mk_cast e t p in
-									type_field ctx e i p mode;
+									type_field cfg ctx e i p mode;
 								| _ ->
 									loop tl
 							end
@@ -442,7 +465,7 @@ let rec type_field ?(resume=false) ctx e i p mode =
 				| Statics {cl_kind = KAbstractImpl a} when does_forward a true ->
 					let mt = try module_type_of_type a.a_this with Exit -> raise Not_found in
 					let et = type_module_type ctx mt None p in
-					type_field ctx et i p mode;
+					type_field cfg ctx et i p mode;
 				| _ ->
 					raise Not_found
 			with Not_found ->
@@ -524,14 +547,14 @@ let rec type_field ?(resume=false) ctx e i p mode =
 				error "This operation is unsupported" p)
 		with Not_found -> try
 			if does_forward a false then
-				type_field ~resume:true ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode
+				type_field (TypeFieldConfig.with_resume cfg) ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode
 			else
 				raise Not_found
 		with Not_found -> try
 			using_field ctx mode e i p
 		with Not_found -> try
 			(match ctx.curfun, e.eexpr with
-			| FunMemberAbstract, TConst (TThis) -> type_field ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode;
+			| FunMemberAbstract, TConst (TThis) -> type_field cfg ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode;
 			| _ -> raise Not_found)
 		with Not_found -> try
 			let get_resolve is_write =
@@ -551,9 +574,12 @@ let rec type_field ?(resume=false) ctx e i p mode =
 				else
 					AKExpr ((!build_call_ref) ctx (AKUsing(ef,c,cf,e,false)) [EConst (String i),p] NoValue p)
 			in
+			if not (TypeFieldConfig.allow_resolve cfg) then raise Not_found;
 			get_resolve (mode = MSet)
 		with Not_found ->
 			if !static_abstract_access_through_instance then error ("Invalid call to static function " ^ i ^ " through abstract instance") p
 			else no_field())
 	| _ ->
 		try using_field ctx mode e i p with Not_found -> no_field()
+
+let type_field_default_cfg = type_field TypeFieldConfig.default

+ 12 - 8
src/typing/forLoop.ml

@@ -45,6 +45,11 @@ module IterationKind = struct
 		it_expr : texpr;
 	}
 
+	let type_field_config = {
+		Fields.TypeFieldConfig.do_resume = true;
+		allow_resolve = false;
+	}
+
 	let get_next_array_element arr iexpr pt p =
 		(mk (TArray (arr,iexpr)) pt p)
 
@@ -53,7 +58,7 @@ module IterationKind = struct
 		let e1 = try
 			AbstractCast.cast_or_unify_raise ctx t e p
 		with Error (Unify _,_) ->
-			let acc = !build_call_ref ctx (type_field ~resume ctx e s e.epos MCall) [] WithType.value e.epos in
+			let acc = !build_call_ref ctx (type_field ({do_resume = resume;allow_resolve = false}) ctx e s e.epos MCall) [] WithType.value e.epos in
 			try
 				unify_raise ctx acc.etype t acc.epos;
 				acc
@@ -128,11 +133,10 @@ module IterationKind = struct
 					let t = match tl with [t] -> t | _ -> raise Not_found in
 					IteratorCustom(get_next_array_element,get_length),e,t
 			end with Not_found -> try
-				if PMap.exists "iterator" c.cl_statics then raise Not_found;
 				let v_tmp = gen_local ctx e.etype e.epos in
 				let e_tmp = make_local v_tmp v_tmp.v_pos in
-				let acc_next = type_field ~resume:true ctx e_tmp "next" p MCall in
-				let acc_hasNext = type_field ~resume:true ctx e_tmp "hasNext" p MCall in
+				let acc_next = type_field type_field_config ctx e_tmp "next" p MCall in
+				let acc_hasNext = type_field type_field_config ctx e_tmp "hasNext" p MCall in
 				let e_next = !build_call_ref ctx acc_next [] WithType.value e.epos in
 				let e_hasNext = !build_call_ref ctx acc_hasNext [] WithType.value e.epos in
 				IteratorAbstract(v_tmp,e_next,e_hasNext),e,e_next.etype
@@ -394,12 +398,12 @@ let type_for_loop ctx handle_display it e2 p =
 		end;
 		let vtmp = gen_local ctx e1.etype e1.epos in
 		let etmp = make_local vtmp vtmp.v_pos in
-		let ehasnext = !build_call_ref ctx (type_field ctx etmp "hasNext" etmp.epos MCall) [] WithType.value etmp.epos in
-		let enext = !build_call_ref ctx (type_field ctx etmp "next" etmp.epos MCall) [] WithType.value etmp.epos in
+		let ehasnext = !build_call_ref ctx (type_field_default_cfg ctx etmp "hasNext" etmp.epos MCall) [] WithType.value etmp.epos in
+		let enext = !build_call_ref ctx (type_field_default_cfg ctx etmp "next" etmp.epos MCall) [] WithType.value etmp.epos in
 		let v = gen_local ctx pt e1.epos in
 		let ev = make_local v v.v_pos in
-		let ekey = Calls.acc_get ctx (type_field ctx ev "key" ev.epos MGet) ev.epos in
-		let evalue = Calls.acc_get ctx (type_field ctx ev "value" ev.epos MGet) ev.epos in
+		let ekey = Calls.acc_get ctx (type_field_default_cfg ctx ev "key" ev.epos MGet) ev.epos in
+		let evalue = Calls.acc_get ctx (type_field_default_cfg ctx ev "value" ev.epos MGet) ev.epos in
 		let vkey = add_local_with_origin ctx TVOForVariable ikey ekey.etype pkey in
 		let vvalue = add_local_with_origin ctx TVOForVariable ivalue evalue.etype pvalue in
 		let e2 = type_expr ctx e2 NoValue in

+ 1 - 1
src/typing/matcher.ml

@@ -39,7 +39,7 @@ let make_offset_list left right middle other =
 	(ExtList.List.make left other) @ [middle] @ (ExtList.List.make right other)
 
 let type_field_access ctx ?(resume=false) e name =
-	Calls.acc_get ctx (Fields.type_field ~resume ctx e name e.epos TyperBase.MGet) e.epos
+	Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos TyperBase.MGet) e.epos
 
 let unapply_type_parameters params monos =
 	List.iter2 (fun (_,t1) t2 -> match t2,follow t2 with TMono m1,TMono m2 when m1 == m2 -> Type.unify t1 t2 | _ -> ()) params monos

+ 3 - 3
src/typing/typer.ml

@@ -411,7 +411,7 @@ let rec type_ident_raise ctx i p mode =
 		let t, name, pi = PMap.find i ctx.m.module_globals in
 		ImportHandling.maybe_mark_import_position ctx pi;
 		let e = type_module_type ctx t None p in
-		type_field ctx e name p mode
+		type_field_default_cfg ctx e name p mode
 
 (*
 	We want to try unifying as an integer and apply side effects.
@@ -689,7 +689,7 @@ and type_binop2 ctx op (e1 : texpr) (e2 : Ast.expr) is_assign_op wt p =
 			| KInt | KFloat | KString -> e
 			| KUnk | KDyn | KParam _ | KOther ->
 				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
+				let acc = acc_get ctx (type_field_default_cfg ctx std "string" e.epos MCall) e.epos in
 				ignore(follow acc.etype);
 				let acc = (match acc.eexpr with TField (e,FClosure (Some (c,tl),f)) -> { acc with eexpr = TField (e,FInstance (c,tl,f)) } | _ -> acc) in
 				make_call ctx acc [e] ctx.t.tstring e.epos
@@ -1187,7 +1187,7 @@ and handle_efield ctx e p mode =
 		let force = ref false in
 		let e = List.fold_left (fun e (f,_,p) ->
 			let e = acc_get ctx (e MGet) p in
-			let f = type_field ~resume:(!resume) ctx e f p in
+			let f = type_field (TypeFieldConfig.create !resume) ctx e f p in
 			force := !resume;
 			resume := false;
 			f