2
0
Эх сурвалжийг харах

unified field accesses (ready for setters handling).

Nicolas Cannasse 19 жил өмнө
parent
commit
b11092ae4c
1 өөрчлөгдсөн 86 нэмэгдсэн , 83 устгасан
  1. 86 83
      typer.ml

+ 86 - 83
typer.ml

@@ -149,17 +149,6 @@ let mk_infos ctx p params =
 			("methodName", (EConst (String ctx.curmethod),p)) :: params
 	) ,p)
 
-let field_get ctx e f acc p =
-	match acc with
-	| NoAccess ->
-		(match follow e.etype with
-		| TInst (c,_) when is_parent c ctx.curclass ->
-			TField (e,f)
-		| _ ->
-			error ("The access to field " ^ f ^ " is restricted") p)
-	| NormalAccess -> TField (e,f)
-	| MethodAccess m -> TCall (mk (TField (e,m)) (mk_mono()) p,[])
-
 let field_access ctx get f t e p =
 	match if get then f.cf_get else f.cf_set with
 	| NoAccess ->
@@ -599,17 +588,8 @@ let type_constant ctx c p =
 	| Int i -> mk (TConst (TInt i)) (t_int ctx) p
 	| Float f -> mk (TConst (TFloat f)) (t_float ctx) p
 	| String s -> mk (TConst (TString s)) (t_string ctx) p
-	| Ident s -> acc_get (type_ident ctx s p true) p
-	| Type s ->
-		try
-			type_local ctx s p
-		with
-			Not_found ->
-		try
-			type_type ctx ([],s) p
-		with
-			Error (Module_not_found ([],s2),_) when s = s2 ->
-				acc_get (type_ident ctx s p true) p
+	| Ident _
+	| Type _ -> assert false
 
 let check_assign ctx e =
 	match e.eexpr with
@@ -661,18 +641,21 @@ let type_matching ctx (enum,params) (e,p) ecases =
 	| _ ->
 		invalid()
 
-let type_field ctx t i p get =
+let type_field ctx e i p get =
 	let no_field() =
-		if ctx.untyped then NormalAccess , mk_mono() else error (s_type (print_context()) t ^ " have no field " ^ i) p
+		if ctx.untyped then 
+			AccExpr (mk (TField (e,i)) (mk_mono()) p)
+		else
+			error (s_type (print_context()) e.etype ^ " have no field " ^ i) p
 	in
-	match follow t with
+	match follow e.etype with
 	| TInst (c,params) ->
 		let priv = is_parent c ctx.curclass in
 		let rec loop c params =
 			try
 				let f = PMap.find i c.cl_fields in
 				if not f.cf_public && not priv && not ctx.untyped then error ("Cannot access to private field " ^ i) p;
-				(if get then f.cf_get else f.cf_set) , apply_params c.cl_types params f.cf_type
+				field_access ctx get f (apply_params c.cl_types params f.cf_type) e p
 			with
 				Not_found ->
 					match c.cl_super with
@@ -682,7 +665,7 @@ let type_field ctx t i p get =
 		let rec loop_dyn c params =
 			match c.cl_dynamic with
 			| Some t ->
-				NormalAccess , apply_params c.cl_types params t
+				AccExpr (mk (TField (e,i)) (apply_params c.cl_types params t) p)
 			| None ->
 				match c.cl_super with
 				| None -> raise Not_found
@@ -695,12 +678,12 @@ let type_field ctx t i p get =
 		with Not_found ->
 			no_field())
 	| TDynamic t ->
-		NormalAccess, t
+		AccExpr (mk (TField (e,i)) t p)
 	| TAnon (fl,_) ->
 		(try
 			let f = PMap.find i fl in
 			if not f.cf_public && not ctx.untyped then error ("Cannot access to private field " ^ i) p;
-			(if get then f.cf_get else f.cf_set) , f.cf_type
+			field_access ctx get f f.cf_type e p
 		with Not_found -> no_field())
 	| t ->
 		no_field()
@@ -917,8 +900,78 @@ and type_switch ctx e cases def need_val p =
 		in
 		mk (TMatch (e,enum,List.map matchs cases,def)) t p
 
+and type_access ctx e p get =
+	match e with
+	| EConst (Ident s) -> 
+		type_ident ctx s p get
+	| EConst (Type s) ->
+		(try
+			let e = type_local ctx s p in
+			AccExpr e
+		with Not_found -> try
+			let e = type_type ctx ([],s) p in
+			AccExpr e
+		with Error (Module_not_found ([],s2),_) when s = s2 ->
+			type_ident ctx s p get)
+	| EField _ 
+	| EType _ ->
+		let fields path e =
+			List.fold_left (fun e (f,_,p) ->
+				let e = acc_get (e true) p in
+				type_field ctx e f p
+			) e path
+		in
+		let type_path path =
+			let rec loop acc path =
+				match path with
+				| [] ->
+					(match List.rev acc with
+					| [] -> assert false
+					| (name,true,p) :: path -> fields path (type_access ctx (EConst (Type name)) p)
+					| (name,false,p) :: path -> fields path (type_access ctx (EConst (Ident name)) p))
+				| (_,false,_) as x :: path ->
+					loop (x :: acc) path
+				| (name,true,p) as x :: path ->
+					let pack = List.rev_map (fun (x,_,_) -> x) acc in
+					try
+						let e = type_type ctx (pack,name) p in
+						fields path (fun _ -> AccExpr e)
+					with
+						Error (Module_not_found m,_) when m = (pack,name) ->
+							loop ((List.rev path) @ x :: acc) []
+			in
+			match path with
+			| [] -> assert false
+			| (name,_,p) :: pnext ->
+				try
+					fields pnext (fun _ -> AccExpr (type_local ctx name p))
+				with
+					Not_found -> loop [] path
+		in
+		let rec loop acc e =
+			match fst e with
+			| EField (e,s) ->
+				loop ((s,false,p) :: acc) e
+			| EType (e,s) ->
+				loop ((s,true,p) :: acc) e
+			| EConst (Ident i) ->
+				type_path ((i,false,p) :: acc)
+			| EConst (Type i) ->
+				type_path ((i,true,p) :: acc)
+			| _ ->
+				fields acc (type_access ctx (fst e) (snd e))
+		in
+		loop [] (e,p) get
+	| _ ->
+		AccExpr (type_expr ctx (e,p))
+
 and type_expr ctx ?(need_val=true) (e,p) =
 	match e with
+	| EField _
+	| EType _ 
+	| EConst (Ident _)
+	| EConst (Type _) ->
+		acc_get (type_access ctx e p true) p
 	| EConst c ->
 		type_constant ctx c p
 	| EArray (e1,e2) ->
@@ -1008,12 +1061,11 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				unify ctx e1.etype t e1.epos;
 				e1
 			with _ ->
-				let acc , it = type_field ctx e1.etype "iterator" e1.epos true in
-				match follow it with
-				| TFun ([],it) as ft ->
+				let acc = acc_get (type_field ctx e1 "iterator" e1.epos true) e1.epos in
+				match follow acc.etype with
+				| TFun ([],it) ->
 					unify ctx it t e1.epos;
-					let fe = mk (field_get ctx e1 "iterator" acc p) ft e1.epos in
-					mk (TCall (fe,[])) t e1.epos
+					mk (TCall (acc,[])) t e1.epos
 				| _ ->
 					error "The field iterator is not a method" e1.epos
 			)
@@ -1182,55 +1234,6 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				error (s_type (print_context()) t ^ " cannot be called") e.epos
 		) in
 		mk (TCall (e,el)) t p
-	| EField _
-	| EType _ ->
-		let fields path e =
-			List.fold_left (fun e (f,_,p) ->
-				let acc , t = type_field ctx e.etype f p true in
-				mk (field_get ctx e f acc p) t p
-			) e path
-		in
-		let type_path path =
-			let rec loop acc path =
-				match path with
-				| [] ->
-					(match List.rev acc with
-					| [] -> assert false
-					| (name,true,p) :: path -> fields path (type_constant ctx (Type name) p)
-					| (name,false,p) :: path -> fields path (type_constant ctx (Ident name) p))
-				| (_,false,_) as x :: path ->
-					loop (x :: acc) path
-				| (name,true,p) as x :: path ->
-					let pack = List.rev_map (fun (x,_,_) -> x) acc in
-					try
-						let e = type_type ctx (pack,name) p in
-						fields path e
-					with
-						Error (Module_not_found m,_) when m = (pack,name) ->
-							loop ((List.rev path) @ x :: acc) []
-			in
-			match path with
-			| [] -> assert false
-			| (name,_,p) :: pnext ->
-				try
-					fields pnext (type_local ctx name p)
-				with
-					Not_found -> loop [] path
-		in
-		let rec loop acc e =
-			match fst e with
-			| EField (e,s) ->
-				loop ((s,false,p) :: acc) e
-			| EType (e,s) ->
-				loop ((s,true,p) :: acc) e
-			| EConst (Ident i) ->
-				type_path ((i,false,p) :: acc)
-			| EConst (Type i) ->
-				type_path ((i,true,p) :: acc)
-			| _ ->
-				fields acc (type_expr ctx e)
-		in
-		loop [] (e,p)
 	| ENew (t,el) ->
 		let name = (match t.tpackage with [] -> t.tname | x :: _ -> x) in
 		if PMap.mem name ctx.locals then error ("Local variable " ^ name ^ " is preventing usage of this class here") p;