Forráskód Böngészése

change signature of `find_array_access` to accept expressions instead of types

Simon Krajewski 11 éve
szülő
commit
9899cc841e
4 módosított fájl, 47 hozzáadás és 46 törlés
  1. 38 0
      codegen.ml
  2. 4 2
      optimizer.ml
  3. 0 39
      typecore.ml
  4. 5 5
      typer.ml

+ 38 - 0
codegen.ml

@@ -705,6 +705,44 @@ module AbstractCast = struct
 			if not ctx.untyped then display_error ctx (error_msg err) p;
 			eright
 
+	let find_array_access_raise ctx a pl e1 e2o p =
+		let is_set = e2o <> None in
+		let ta = apply_params a.a_params pl a.a_this in
+		let rec loop cfl = match cfl with
+			| [] -> raise Not_found
+			| cf :: cfl when not (Ast.Meta.has Ast.Meta.ArrayAccess cf.cf_meta) ->
+				loop cfl
+			| cf :: cfl ->
+				match follow (apply_params a.a_params pl (monomorphs cf.cf_params cf.cf_type)) with
+				| TFun([(_,_,tab);(_,_,ta1);(_,_,ta2)],r) as tf when is_set ->
+					begin try
+						Type.unify tab ta;
+						cast_or_unify ctx ta1 e1 p;
+						(match e2o with None -> None | Some e2 -> Some (cast_or_unify ctx ta2 e2 p));
+						cf,tf,r
+					with Unify_error _ ->
+						loop cfl
+					end
+				| TFun([(_,_,tab);(_,_,ta1)],r) as tf when not is_set ->
+					begin try
+						Type.unify tab ta;
+						cast_or_unify ctx ta1 e1 p;
+						cf,tf,r
+					with Unify_error _ ->
+						loop cfl
+					end
+				| _ -> loop cfl
+		in
+		loop a.a_array
+
+	let find_array_access ctx a tl e1 e2o p =
+		try find_array_access_raise ctx a tl e1 e2o p
+		with Not_found -> match e2o with
+			| None ->
+				error (Printf.sprintf "No @:arrayAccess function accepts argument of %s" (s_type (print_context()) e1.etype)) p
+			| Some e2 ->
+				error (Printf.sprintf "No @:arrayAccess function accepts arguments of %s and %s" (s_type (print_context()) e1.etype) (s_type (print_context()) e2.etype)) p
+
 	let find_multitype_specialization com a pl p =
 		let m = mk_mono() in
 		let tl = match Meta.get Meta.MultiType a.a_meta with

+ 4 - 2
optimizer.ml

@@ -682,11 +682,13 @@ let rec optimize_for_loop ctx i e1 e2 p =
 			end;
 			begin try
 				(* first try: do we have an @:arrayAccess getter field? *)
-				let cf,_,r = find_array_access ctx a tl ctx.com.basic.tint None p in
+(* 				let todo = mk (TConst TNull) ctx.t.tint p in
+				let cf,_,r = Codegen.AbstractCast.find_array_access ctx a tl todo None p in
 				let get_next e_base e_index t p =
 					make_static_call ctx c cf (apply_params a.a_params tl) [e_base;e_index] r p
 				in
-				gen_int_iter r get_next get_length
+				gen_int_iter r get_next get_length *)
+				raise Not_found (* TODO *)
 			with Not_found ->
 				(* second try: do we have @:arrayAccess on the abstract itself? *)
 				if not (Meta.has Meta.ArrayAccess a.a_meta) then raise Not_found;

+ 0 - 39
typecore.ml

@@ -393,45 +393,6 @@ let create_fake_module ctx file =
 	Hashtbl.replace ctx.g.modules mdep.m_path mdep;
 	mdep
 
-let find_array_access_raise ctx a pl t1 t2o p =
-	let is_set = t2o <> None in
-	let ta = apply_params a.a_params pl a.a_this in
-	let rec loop cfl = match cfl with
-		| [] -> raise Not_found
-		| cf :: cfl when not (Ast.Meta.has Ast.Meta.ArrayAccess cf.cf_meta) ->
-			loop cfl
-		| cf :: cfl ->
-			match follow (apply_params a.a_params pl (monomorphs cf.cf_params cf.cf_type)) with
-			| TFun([(_,_,tab);(_,_,ta1);(_,_,ta2)],r) as tf when is_set ->
-				begin try
-					Type.unify tab ta;
-					Type.unify t1 ta1;
-					(match t2o with None -> () | Some t2 -> Type.unify t2 ta2);
-					cf,tf,r
-				with Unify_error _ ->
-					loop cfl
-				end
-			| TFun([(_,_,tab);(_,_,ta1)],r) as tf when not is_set ->
-				begin try
-					Type.unify tab ta;
-					Type.unify t1 ta1;
-					cf,tf,r
-				with Unify_error _ ->
-					loop cfl
-				end
-			| _ -> loop cfl
-	in
-	loop a.a_array
-
-let find_array_access ctx a tl t1 t2o p =
-	try find_array_access_raise ctx a tl t1 t2o p
-	with Not_found -> match t2o with
-		| None ->
-			error (Printf.sprintf "No @:arrayAccess function accepts argument of %s" (s_type (print_context()) t1)) p
-		| Some t2 ->
-			error (Printf.sprintf "No @:arrayAccess function accepts arguments of %s and %s" (s_type (print_context()) t1) (s_type (print_context()) t2)) p
-
-
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)
 (*/*
 

+ 5 - 5
typer.ml

@@ -1796,7 +1796,7 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
 			let e2 = Codegen.AbstractCast.cast_or_unify ctx t e2 p in
 			make_call ctx (mk (TField (e,quick_field_dynamic e.etype ("set_" ^ cf.cf_name))) (tfun [t] t) p) [e2] t p
 		| AKAccess(a,tl,c,ebase,ekey) ->
-			let cf,tf,r = find_array_access ctx a tl ekey.etype (Some e2.etype) p in
+			let cf,tf,r = Codegen.AbstractCast.find_array_access ctx a tl ekey (Some e2) p in
 			begin match cf.cf_expr with
 				| None ->
 					let ea = mk (TArray(ebase,ekey)) r p in
@@ -1871,7 +1871,7 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
 			else
 				e_call
 		| AKAccess(a,tl,c,ebase,ekey) ->
-			let cf_get,tf_get,r_get = find_array_access ctx a tl ekey.etype None p in
+			let cf_get,tf_get,r_get = Codegen.AbstractCast.find_array_access ctx a tl ekey None p in
 			(* bind complex keys to a variable so they do not make it into the output twice *)
 			let ekey,l = match Optimizer.make_constant_expression ctx ekey with
 				| Some e -> e, fun () -> None
@@ -1885,7 +1885,7 @@ let rec type_binop ctx op e1 e2 is_assign_op with_type p =
 			let ast_call = (EMeta((Meta.PrivateAccess,[],pos ast_call),ast_call),pos ast_call) in
 			let eget = type_binop ctx op ast_call e2 true with_type p in
 			unify ctx eget.etype r_get p;
-			let cf_set,tf_set,r_set = find_array_access ctx a tl ekey.etype (Some eget.etype) p in
+			let cf_set,tf_set,r_set = Codegen.AbstractCast.find_array_access ctx a tl ekey (Some eget) p in
 			let et = type_module_type ctx (TClassDecl c) None p in
 			begin match cf_set.cf_expr,cf_get.cf_expr with
 				| None,None ->
@@ -2272,7 +2272,7 @@ and type_unop ctx op flag e p =
 		| AKNo s ->
 			error ("The field or identifier " ^ s ^ " is not accessible for " ^ (if set then "writing" else "reading")) p
 		| AKAccess(a,tl,c,ebase,ekey) ->
-			let cf,tf,r = find_array_access ctx a tl ekey.etype None p in
+			let cf,tf,r = Codegen.AbstractCast.find_array_access ctx a tl ekey None p in
 			let e = match cf.cf_expr with
 				| None ->
 					mk (TArray(ebase,ekey)) r p
@@ -2547,7 +2547,7 @@ and type_access ctx e p mode =
 				AKAccess (a,pl,c,e1,e2)
 			| _ ->
 				has_abstract_array_access := true;
-				let cf,tf,r = find_array_access ctx a pl e2.etype None p in
+				let cf,tf,r = Codegen.AbstractCast.find_array_access ctx a pl e2 None p in
 				let e = match cf.cf_expr with
 					| None ->
 						mk (TArray(e1,e2)) r p