Pārlūkot izejas kodu

(try to) refactor handle_efield (#9155)

* extract field chain function from handle_efield

* extract dot path resolution into a separate module and clean up some code around it

* raise Not_found instead of calling a fallback function

so it's a bit easier to follow the flow

* clean up comments, rename some variables to make it easier to read
Dan Korostelev 5 gadi atpakaļ
vecāks
revīzija
551ab68049
4 mainītis faili ar 220 papildinājumiem un 203 dzēšanām
  1. 22 1
      src/typing/calls.ml
  2. 53 202
      src/typing/typer.ml
  3. 4 0
      src/typing/typerBase.ml
  4. 141 0
      src/typing/typerDotPath.ml

+ 22 - 1
src/typing/calls.ml

@@ -864,4 +864,25 @@ let array_access ctx e1 e2 mode p =
 				pt
 		in
 		let pt = loop e1.etype in
-		AKExpr (mk (TArray (e1,e2)) pt p)
+		AKExpr (mk (TArray (e1,e2)) pt p)
+
+(*
+	given chain of fields as the `path` argument and an `access_mode->access_kind` getter for some starting expression as `e`,
+	return a new `access_mode->access_kind` getter for the whole field access chain.
+
+	if `resume` is true, `Not_found` will be raised if the first field in chain fails to resolve, in all other
+	cases, normal type errors will be raised if a field can't be accessed.
+*)
+let field_chain ?(resume=false) ctx path e =
+	let resume = ref resume in
+	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 (TypeFieldConfig.create !resume) ctx e f p in
+		force := !resume;
+		resume := false;
+		f
+	) e path in
+	if !force then ignore(e MCall); (* not necessarily a call, but prevent #2602 among others *)
+	e
+

+ 53 - 202
src/typing/typer.ml

@@ -33,10 +33,6 @@ open Calls
 (* ---------------------------------------------------------------------- *)
 (* TOOLS *)
 
-let is_lower_ident s p =
-	try Ast.is_lower_ident s
-	with Invalid_argument msg -> error msg p
-
 let check_assign ctx e =
 	match e.eexpr with
 	| TLocal {v_final = true} ->
@@ -1253,214 +1249,69 @@ and type_ident ctx i p mode =
 				end
 			end
 
-(* MORDOR *)
-and handle_efield ctx e p mode =
-	let p0 = p in
-	(*
-		given chain of fields as the `path` argument and an `access_mode->access_kind` getter for some starting expression as `e`,
-		return a new `access_mode->access_kind` getter for the whole field access chain.
-
-		if `resume` is true, `Not_found` will be raised if the first field in chain fails to resolve, in all other
-		cases, normal type errors will be raised if a field can't be accessed.
-	*)
-	let fields ?(resume=false) path e =
-		let resume = ref resume in
-		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 (TypeFieldConfig.create !resume) ctx e f p in
-			force := !resume;
-			resume := false;
-			f
-		) e path in
-		if !force then ignore(e MCall); (* not necessarily a call, but prevent #2602 among others *)
-		e
-	in
-
-	(*
-		given a chain of identifiers (dot-path) represented as a list of (ident,starts_uppercase,pos) tuples,
-		resolve it into an `access_mode->access_kind` getter for the resolved expression
-	*)
-	let type_path path =
-		(*
-			this is an actual loop for processing a fully-qualified dot-path.
-			it relies on the fact that packages start with a lowercase letter, while modules and types
-			start with upper-case letters, so it processes path parts, accumulating lowercase package parts in `acc`,
-			until it encounters an upper-case part, which can mean either a module access or module's primary type access,
-			so it tries to figure out the type and and calls `fields` on it to resolve the rest of field access chain.
-		*)
-		let rec loop acc path =
-			match path with
-			| (_,false,_) as x :: path ->
-				(* part starts with lowercase - it's a package part, add it the accumulator and proceed *)
-				loop (x :: acc) path
-
-			| (name,true,p) as x :: path ->
-				(* part starts with uppercase - it either points to a module or its main type *)
-
-				(* acc is contains all the package parts now, so extract package from them *)
-				let pack = List.rev_map (fun (x,_,_) -> x) acc in
-
-				(* default behaviour: try loading module's primary type (with the same name as module)
-				   and resolve the rest of the field chain against its statics, or the type itself
-				   if the rest of chain is empty *)
-				let def() =
-					try
-						let e = type_type ctx (pack,name) p in
-						fields path (fun _ -> AKExpr e)
-					with
-						Error (Module_not_found m,_) when m = (pack,name) ->
-							(* if it's not a module path after all, it could be an untyped field access that looks like
-							   a dot-path, e.g. `untyped __global__.String`, add the whole path to the accumulator and
-							   proceed to the untyped identifier resolution *)
-							loop ((List.rev path) @ x :: acc) []
-				in
-
-				(match path with
-				| (sname,true,p) :: path ->
-					(* next part starts with uppercase, meaning it can be either a module sub-type access
-					   or static field access for the primary module type, so we have to do some guessing here
-
-					   In this block, `name` is the first first-uppercase part (possibly a module name),
-					   and `sname` is the second first-uppsercase part (possibly a subtype name). *)
-
-					(* get static field by `sname` from a given type `t`, if `resume` is true - raise Not_found *)
-					let get_static resume t =
-						fields ~resume ((sname,true,p) :: path) (fun _ -> AKExpr (type_module_type ctx t None p))
-					in
-
-					(* try accessing subtype or main class static field by `sname` in given module with path `m` *)
-					let check_module m =
-						try
-							let md = TypeloadModule.load_module ctx m p in
-							(* first look for existing subtype *)
-							(try
-								let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = (fst m,sname)) md.m_types in
-								Some (fields path (fun _ -> AKExpr (type_module_type ctx t None p)))
-							with Not_found -> try
-							(* then look for main type statics *)
-								if fst m = [] then raise Not_found; (* ensure that we use def() to resolve local types first *)
-								let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = m) md.m_types in
-								Some (get_static false t)
-							with Not_found ->
-								None)
-						with Error (Module_not_found m2,_) when m = m2 ->
-							None
-					in
-
-					(match pack with
-					| [] ->
-						(* if there's no package specified... *)
-						(try
-							(* first try getting a type by `name` in current module types and current imports
-							   and try accessing its static field by `sname` *)
-							let path_match t = snd (t_infos t).mt_path = name in
-							let t =
-								try
-									List.find path_match ctx.m.curmod.m_types (* types in this modules *)
-								with Not_found ->
-									let t,p = List.find (fun (t,_) -> path_match t) ctx.m.module_types in (* imported types *)
-									ImportHandling.mark_import_position ctx p;
-									t
-							in
-							get_static true t
-						with Not_found ->
-							(* if the static field (or the type) wasn't not found, look for a subtype instead - #1916
-							   look for subtypes/main-class-statics in modules of current package and its parent packages *)
-							let rec loop pack =
-								match check_module (pack,name) with
-								| Some r -> r
-								| None ->
-									match List.rev pack with
-									| [] -> def()
-									| _ :: l -> loop (List.rev l)
-							in
-							loop (fst ctx.m.curmod.m_path))
-					| _ ->
-						(* if package was specified, treat it as fully-qualified access to either
-						   a module subtype or a static field of module's primary type*)
-						match check_module (pack,name) with
-						| Some r -> r
-						| None -> def());
-				| _ ->
-					(* no more parts or next part starts with lowercase - it's surely not a type name,
-					   so do the default thing: resolve fields against primary module type *)
-					def())
-
-			| [] ->
-				(* If we get to here, it means that either there were no uppercase-first-letter parts,
-				   or we couldn't find the specified module, so it's not a qualified dot-path after all.
-				   And it's not a known identifier too, because otherwise `loop` wouldn't be called at all.
-				   So this must be an untyped access (or a typo). Try resolving the first identifier with support
-				   for untyped and resolve the rest of field chain against it.
+and handle_efield ctx e p0 mode =
+	let open TyperDotPath in 
 
-				   TODO: extract this into a separate function
-				*)
-				(match List.rev acc with
-				| [] -> assert false
-				| (name,flag,p) :: path ->
-					try
-						fields path (type_ident ctx name p)
-					with
-						Error (Unknown_ident _,p2) as e when p = p2 ->
-							try
-								(* try raising a more sensible error if there was an uppercase-first (module name) part *)
-								let path = ref [] in
-								let name , _ , _ = List.find (fun (name,flag,p) ->
-									if flag then
-										true
-									else begin
-										path := name :: !path;
-										false
-									end
-								) (List.rev acc) in
-								raise (Error (Module_not_found (List.rev !path,name),p))
-							with
-								Not_found ->
-									let sl = List.map (fun (n,_,_) -> n) (List.rev acc) in
-									(* if there was no module name part, last guess is that we're trying to get package completion *)
-									if ctx.in_display then begin
-										if is_legacy_completion ctx.com then raise (Parser.TypePath (sl,None,false,p))
-										else DisplayToplevel.collect_and_raise ctx TKType WithType.no_value (CRToplevel None) (String.concat "." sl,p0) p0
-									end;
-									raise e)
-		in
-		match path with
-		| [] -> assert false
-		| (name,_,p) :: pnext ->
+	let dot_path first pnext =
+		let name,_,p = first in
+		try
+			(* first, try to resolve the first ident in the chain and access its fields.
+			   this doesn't support untyped identifiers yet, because we want to check fully-qualified
+			   paths first (even in an untyped block) *)
+			field_chain ctx pnext (type_ident_raise ctx name p)
+		with Not_found ->
+			(* first ident couldn't be resolved, it's probably a fully qualified path - resolve it *)
+			let path = (first :: pnext) in
 			try
-				(*
-					first, try to resolve the first ident in the chain and access its fields.
-					this doesn't support untyped identifiers yet, because we want to check
-					fully-qualified dot paths first even in an untyped block.
-				*)
-				fields pnext (fun _ -> type_ident_raise ctx name p MGet)
+				resolve_dot_path ctx path
 			with Not_found ->
-				(* first ident couldn't be resolved, it's probably a fully qualified path - resolve it *)
-				loop [] path
+				(* dot-path resolution failed, it could be an untyped field access that happens to look like a dot-path, e.g. `untyped __global__.String` *)
+				try
+					field_chain ctx pnext (type_ident ctx name p)
+				with Error (Unknown_ident _,p2) as e when p = p2 ->
+					try
+						(* try raising a more sensible error if there was an uppercase-first (module name) part *)
+						let pack_acc = ref [] in
+						let name , _ , _ = List.find (fun (name,case,p) ->
+							if case = PUppercase then
+								true
+							else begin
+								pack_acc := name :: !pack_acc;
+								false
+							end
+						) path in
+						let pack = List.rev !pack_acc in
+						raise (Error (Module_not_found (pack,name),p))
+					with Not_found ->
+						(* if there was no module name part, last guess is that we're trying to get package completion *)
+						if ctx.in_display then begin
+							let sl = List.map (fun (n,_,_) -> n) path in
+							if is_legacy_completion ctx.com then
+								raise (Parser.TypePath (sl,None,false,p))
+							else
+								DisplayToplevel.collect_and_raise ctx TKType WithType.no_value (CRToplevel None) (String.concat "." sl,p0) p0
+						end;
+						raise e						
 	in
 
-	(*
-		loop through the given EField expression and behave differently depending on whether it's a simple dot-path
-		or a more complex expression, accumulating field access parts in form of (ident,starts_uppercase,pos) tuples.
-
-		if it's a dot-path, then it might be either fully-qualified access (pack.Class.field) or normal field access of
-		a local/global/field identifier. we pass the accumulated path to `type_path` and let it figure out what it is.
-
-		if it's NOT a dot-path (anything other than indentifiers appears in EField chain), then we can be sure it's
-		normal field access, not fully-qualified access, so we pass the non-ident expr along with the accumulated
-		fields chain to the `fields` function and let it type the field access.
-	*)
-	let rec loop acc (e,p) =
+	(* loop through the given EField expression to figure out whether it's a dot-path that we have to resolve,
+	   or a simple field access chain *)
+	let rec loop dot_path_acc (e,p) =
 		match e with
 		| EField (e,s) ->
-			loop ((s,not (is_lower_ident s p),p) :: acc) e
+			(* field access - accumulate and check further *)
+			loop ((mk_dot_path_part s p) :: dot_path_acc) e
 		| EConst (Ident i) ->
-			type_path ((i,not (is_lower_ident i p),p) :: acc)
+			(* it's a dot-path, so it might be either fully-qualified access (pack.Class.field)
+			   or normal field access of a local/global/field identifier, proceed figuring this out *)
+			dot_path (mk_dot_path_part i p) dot_path_acc
 		| _ ->
-			fields acc (type_access ctx e p)
+			(* non-ident expr occured: definitely NOT a fully-qualified access,
+			   resolve the field chain against this expression *)
+			let e = type_access ctx e p in
+			field_chain ctx dot_path_acc e
 	in
-	loop [] (e,p) mode
+	loop [] (e,p0) mode
 
 and type_access ctx e p mode =
 	match e with

+ 4 - 0
src/typing/typerBase.ml

@@ -64,6 +64,10 @@ let rec is_pos_infos = function
 	| _ ->
 		false
 
+let is_lower_ident s p =
+	try Ast.is_lower_ident s
+	with Invalid_argument msg -> error msg p
+
 let get_this ctx p =
 	match ctx.curfun with
 	| FunStatic ->

+ 141 - 0
src/typing/typerDotPath.ml

@@ -0,0 +1,141 @@
+(*
+	The Haxe Compiler
+	Copyright (C) 2005-2020 Haxe Foundation
+
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public License
+	along with this program; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+*)
+open Globals
+open TyperBase
+open Calls
+open TFunctions
+open Error
+
+type dot_path_part_case =
+	| PUppercase
+	| PLowercase
+
+type dot_path_part = (string * dot_path_part_case * pos)
+
+let mk_dot_path_part s p : dot_path_part =
+	let case = if is_lower_ident s p then PLowercase else PUppercase in
+	(s,case,p)
+
+(* given a list of dot path parts, try to resolve it into access getter, raises Not_found on failure *)
+let resolve_dot_path ctx (path_parts : dot_path_part list) =
+	(*
+		we rely on the fact that packages start with a lowercase letter, while modules and types start with uppercase letters,
+		so we processes path parts, accumulating lowercase parts in `pack_acc`, until we encounter an upper-case part,
+		which can mean either a module access or module's primary type access, so we try to figure out the type and
+		resolve the rest of the field access chain against it.
+	*)
+	let rec loop pack_acc path =
+		match path with
+		| (_,PLowercase,_) as x :: path ->
+			(* part starts with lowercase - it's a package part, add it the accumulator and proceed *)
+			loop (x :: pack_acc) path
+
+		| (name,PUppercase,p) :: path ->
+			(* part starts with uppercase - it either points to a module or its main type *)
+
+			let pack = List.rev_map (fun (x,_,_) -> x) pack_acc in
+
+			(* default behaviour: try loading module's primary type (with the same name as module)
+				and resolve the rest of the field chain against its statics (or return the type itself
+				if the rest of chain is empty) *)
+			let def () =
+				try
+					let e = type_type ctx (pack,name) p in
+					field_chain ctx path (fun _ -> AKExpr e)
+				with
+					Error (Module_not_found m,_) when m = (pack,name) ->
+						(* not a module path after all *)
+						raise Not_found
+			in
+
+			(match path with
+			| (sname,PUppercase,p) :: path ->
+				(* next part starts with uppercase, meaning it can be either a module sub-type access
+					or static field access for the primary module type, so we have to do some guessing here
+
+					In this block, `name` is the first first-uppercase part (possibly a module name),
+					and `sname` is the second first-uppsercase part (possibly a subtype name). *)
+
+				(* get static field by `sname` from a given type `t`, if `resume` is true - raise Not_found *)
+				let get_static resume t =
+					field_chain ctx ~resume ((sname,PUppercase,p) :: path) (fun _ -> AKExpr (type_module_type ctx t None p))
+				in
+
+				(* try accessing subtype or main class static field by `sname` in given module with path `m` *)
+				let check_module m =
+					try
+						let md = TypeloadModule.load_module ctx m p in
+						(* first look for existing subtype *)
+						(try
+							let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = (fst m,sname)) md.m_types in
+							Some (field_chain ctx path (fun _ -> AKExpr (type_module_type ctx t None p)))
+						with Not_found -> try
+						(* then look for main type statics *)
+							if fst m = [] then raise Not_found; (* ensure that we use def() to resolve local types first *)
+							let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = m) md.m_types in
+							Some (get_static false t)
+						with Not_found ->
+							None)
+					with Error (Module_not_found m2,_) when m = m2 ->
+						None
+				in
+
+				(match pack with
+				| [] ->
+					(* no package was specified - Unqualified access *)
+					(try
+						(* first try getting a type by `name` in current module types and current imports
+							and try accessing its static field by `sname` *)
+						let path_match t = snd (t_infos t).mt_path = name in
+						let t =
+							try
+								List.find path_match ctx.m.curmod.m_types (* types in this modules *)
+							with Not_found ->
+								let t,p = List.find (fun (t,_) -> path_match t) ctx.m.module_types in (* imported types *)
+								ImportHandling.mark_import_position ctx p;
+								t
+						in
+						get_static true t
+					with Not_found ->
+						(* if the static field (or the type) wasn't not found, look for a subtype instead - #1916
+							look for subtypes/main-class-statics in modules of current package and its parent packages *)
+						let rec loop pack =
+							match check_module (pack,name) with
+							| Some r -> r
+							| None ->
+								match List.rev pack with
+								| [] -> def()
+								| _ :: l -> loop (List.rev l)
+						in
+						loop (fst ctx.m.curmod.m_path))
+				| _ ->
+					(* if package was specified - Qualified access *)
+					(match check_module (pack,name) with
+					| Some r -> r
+					| None -> def ()));
+			| _ ->
+				(* no more parts or next part starts with lowercase - it's surely not a type name, so do the default thing *)
+				def())
+
+		| [] ->
+			(* if we get to here, it means that there was no uppercase parts, so it's not a qualified dot-path *)
+			raise Not_found
+
+	in
+	loop [] path_parts