fixed handling of ArrayAccess

doc/CHANGES.txt

@@ -7,6 +7,7 @@
 	fixed php.FileSystem.stat
 	added memory related functions to php.Sys
 	added error when trying to extend Array, String, Date and Xml
+	fixed handling of implements ArrayAccess
 
 2008-10-04: 2.01
 	fixed php.Sys

type.ml

@@ -137,6 +137,7 @@ and tclass = {
 	mutable cl_ordered_statics : tclass_field list;
 	mutable cl_ordered_fields : tclass_field list;
 	mutable cl_dynamic : t option;
+	mutable cl_array_access : t option;
 	mutable cl_constructor : tclass_field option;
 	mutable cl_init : texpr option;
 	mutable cl_overrides : string list;
@@ -215,6 +216,7 @@ let mk_class path pos doc priv =
 		cl_ordered_fields = [];
 		cl_statics = PMap.empty;
 		cl_dynamic = None;
+		cl_array_access = None;
 		cl_constructor = None;
 		cl_init = None;
 		cl_overrides = [];

typeload.ml

@@ -238,17 +238,6 @@ let load_core_type ctx name =
 	show();
 	t
 
-let t_array_access ctx =
-	let show = hide_types ctx in
-	match load_type_def ctx null_pos ([],"ArrayAccess") with
-	| TClassDecl c ->
-		show();
-		if List.length c.cl_types <> 1 then assert false;
-		let pt = mk_mono() in
-		TInst (c,[pt]) , pt
-	| _ ->
-		assert false
-
 let t_iterator ctx =
 	let show = hide_types ctx in
 	match load_type_def ctx null_pos ([],"Iterator") with
@@ -423,6 +412,9 @@ let set_heritance ctx c herits p =
 		| HImplements t ->
 			let t = load_normal_type ctx t p false in
 			(match follow t with
+			| TInst ({ cl_path = [],"ArrayAccess"; cl_extern = true; },[t]) ->
+				if c.cl_array_access <> None then error "Duplicate array access" p;
+				c.cl_array_access <- Some t
 			| TInst (cl,params) ->
 				if is_parent c cl then error "Recursive class" p;
 				c.cl_implements <- (cl, params) :: c.cl_implements

typer.ml

@@ -965,13 +965,12 @@ and type_access ctx e p get =
 		let e1 = type_expr ctx e1 in
 		let e2 = type_expr ctx e2 in
 		unify ctx e2.etype ctx.api.tint e2.epos;
-		let pt = (try
+		let pt = (match follow e1.etype with
+		| TInst ({ cl_array_access = Some t; cl_types = pl },tl) ->
+			apply_params pl tl t
+		| _ -> 
 			let pt = mk_mono() in
 			let t = ctx.api.tarray pt in
-			unify_raise ctx e1.etype t e1.epos;
-			pt
-		with Error (Unify _,_) ->
-			let t, pt = Typeload.t_array_access ctx in
 			unify ctx e1.etype t e1.epos;
 			pt
 		) in