opened anonymous types.

doc/CHANGES.txt

@@ -12,6 +12,7 @@
 	fixed very tricky bug with constraint parameters used together with polymorphic methods
 	added selective import (import x.y.Class.InnerType)
 	added optional enum constructor parameters
+	added opened anonymous types (no more Unknown has no field...)
 	
 2006-06-08: 1.02
 	fixed stack overflow when recursive class <: recursive signature

genxml.ml

@@ -55,7 +55,7 @@ let rec gen_type t =
 	| TInst (c,params) -> node "c" [gen_path c.cl_path c.cl_private] (List.map gen_type params)
 	| TSign (s,params) -> node "s" [gen_path s.s_path s.s_private] (List.map gen_type params)
 	| TFun (args,r) -> node "f" ["a",String.concat ":" (List.map gen_arg_name args)] (List.map gen_type (List.map (fun (_,_,t) -> t) args @ [r]))
-	| TAnon fields -> node "a" [] (pmap (fun f -> node f.cf_name [] [gen_type f.cf_type]) fields)
+	| TAnon a -> node "a" [] (pmap (fun f -> node f.cf_name [] [gen_type f.cf_type]) a.a_fields)
 	| TDynamic t2 -> node "d" [] (if t == t2 then [] else [gen_type t2])
 	| TLazy f -> gen_type (!f())
 

std/neko/NekoArray__.hx

@@ -46,7 +46,7 @@ class NekoArray__<T> implements Array<T> {
 		}
 	}
 
-	public function concat(arr) {
+	public function concat(arr : Array<T>) : Array<T> {
 		untyped {
 			var a1 = this.__a;
 			var a2 = arr.__a;

std/neko/NekoString__.hx

@@ -57,7 +57,7 @@ class NekoString__ implements String {
 		}
 	}
 
-	public function indexOf( str, ?pos ) {
+	public function indexOf( str : String, ?pos ) {
 		untyped {
 			var p = try __dollar__sfind(this.__s,if( pos == null ) 0 else pos,str.__s) catch( e : Dynamic ) null;
 			if( p == null )
@@ -66,7 +66,7 @@ class NekoString__ implements String {
 		}
 	}
 
-	public function lastIndexOf( str, pos ) {
+	public function lastIndexOf( str : String, pos ) {
 		untyped {
 			var last = -1;
 			if( pos == null )
@@ -81,7 +81,7 @@ class NekoString__ implements String {
 		}
 	}
 
-	public function split( delim ) {
+	public function split( delim : String ) {
 		untyped {
 			var l = __split(this.__s,delim.__s);
 			var a = new Array<String>();

std/neko/Socket.hx

@@ -126,7 +126,7 @@ class Socket {
 	// STATICS
 	public static function select(read : Array<Socket>, write : Array<Socket>, others : Array<Socket>, timeout : Float) : {read: Array<Socket>,write: Array<Socket>,others: Array<Socket>} {
 		var c = untyped __dollar__hnew( 1 );
-		var f = function( a ){
+		var f = function( a : Array<Socket> ){
 			if( a == null ) return null;
 			untyped {
 				var r = __dollar__amake(a.length);

type.ml

@@ -30,7 +30,7 @@ type t =
 	| TInst of tclass * t list
 	| TSign of tsignature * t list
 	| TFun of (string * bool * t) list * t
-	| TAnon of (string, tclass_field) PMap.t
+	| TAnon of tanon
 	| TDynamic of t
 	| TLazy of (unit -> t) ref
 
@@ -49,6 +49,11 @@ and tfunc = {
 	tf_expr : texpr;
 }
 
+and tanon = {
+	mutable a_fields : (string, tclass_field) PMap.t;
+	a_open : bool ref;
+}
+
 and texpr_expr =
 	| TConst of tconstant
 	| TLocal of string
@@ -151,6 +156,21 @@ type module_def = {
 
 let mk e t p = { eexpr = e; etype = t; epos = p }
 
+let not_opened = ref false
+
+let mk_anon fl = TAnon { a_fields = fl; a_open = not_opened; }
+
+let mk_field name t = {
+	cf_name = name;
+	cf_type = t;
+	cf_doc = None;
+	cf_public = true;
+	cf_get = NormalAccess;
+	cf_set = NormalAccess;
+	cf_expr = None;
+	cf_params = [];
+}
+
 let mk_mono() = TMono (ref None)
 
 let rec t_dynamic = TDynamic t_dynamic
@@ -208,9 +228,9 @@ let rec s_type ctx t =
 		String.concat " -> " (List.map (fun (s,b,t) ->
 			(if b then "?" else "") ^ (if s = "" then "" else s ^ " : ") ^ s_fun ctx t true
 		) l) ^ " -> " ^ s_fun ctx t false
-	| TAnon fl ->
-		let fl = PMap.fold (fun f acc -> (" " ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) fl [] in
-		"{" ^ String.concat "," fl ^ " }"
+	| TAnon a ->
+		let fl = PMap.fold (fun f acc -> (" " ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) a.a_fields [] in
+		"{" ^ (if !(a.a_open) then "+" else "") ^  String.concat "," fl ^ " }"
 	| TDynamic t2 ->
 		"Dynamic" ^ s_type_params ctx (if t == t2 then [] else [t2])
 	| TLazy f ->
@@ -248,9 +268,9 @@ let rec link e a b =
 				loop t2
 		| TLazy f ->
 			loop (!f())
-		| TAnon fl ->
+		| TAnon a ->
 			try
-				PMap.iter (fun _ f -> if loop f.cf_type then raise Exit) fl;
+				PMap.iter (fun _ f -> if loop f.cf_type then raise Exit) a.a_fields;
 				false
 			with
 				Exit -> true
@@ -308,8 +328,11 @@ let apply_params cparams params t =
 				TInst (c,List.map loop tl))
 		| TFun (tl,r) ->
 			TFun (List.map (fun (s,o,t) -> s, o, loop t) tl,loop r)
-		| TAnon fl ->
-			TAnon (PMap.map (fun f -> { f with cf_type = loop f.cf_type }) fl)
+		| TAnon a ->
+			TAnon {
+				a_fields = PMap.map (fun f -> { f with cf_type = loop f.cf_type }) a.a_fields;
+				a_open = a.a_open;
+			}
 		| TLazy f ->
 			let ft = !f() in
 			let ft2 = loop ft in
@@ -367,17 +390,27 @@ let rec type_eq param a b =
 		type_eq param r1 r2 && List.for_all2 (fun (_,o1,t1) (_,o2,t2) -> o1 = o2 && type_eq param t1 t2) l1 l2
 	| TDynamic a , TDynamic b ->
 		type_eq param a b
-	| TAnon fl1, TAnon fl2 ->
-		let keys1 = PMap.fold (fun f acc -> f :: acc) fl1 [] in
-		let keys2 = PMap.fold (fun f acc -> f :: acc) fl2 [] in
+	| TAnon a1, TAnon a2 ->
 		(try
-			List.iter2 (fun f1 f2 ->
-				if f1.cf_name <> f2.cf_name || not (type_eq param f1.cf_type f2.cf_type) then raise Not_found;
-				if f1.cf_get <> f2.cf_get || f1.cf_set <> f2.cf_set then raise Not_found;
-			) keys1 keys2;
+			PMap.iter (fun _ f1 ->
+				try
+					let f2 = PMap.find f1.cf_name a2.a_fields in
+					if not (type_eq param f1.cf_type f2.cf_type) then raise Exit;
+					if f1.cf_get <> f2.cf_get || f1.cf_set <> f2.cf_set then raise Exit;	
+				with
+					Not_found ->
+						if not !(a2.a_open) then raise Exit;
+						a2.a_fields <- PMap.add f1.cf_name f1 a2.a_fields
+			) a1.a_fields;
+			PMap.iter (fun _ f2 ->
+				if not (PMap.mem f2.cf_name a1.a_fields) then begin
+					if not !(a1.a_open) then raise Exit;
+					a1.a_fields <- PMap.add f2.cf_name f2 a1.a_fields
+				end;
+			) a2.a_fields;
 			true
 		with
-			_ -> false)
+			Exit -> false)
 	| _ , _ ->
 		false
 
@@ -469,7 +502,7 @@ let rec unify a b =
 			) l2 l1 (* contravariance *)
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
-	| TInst (c,tl) , TAnon fl ->
+	| TInst (c,tl) , TAnon an ->
 		(try
 			PMap.iter (fun n f2 ->
 				let f1 = (try PMap.find n c.cl_fields with Not_found -> error [has_no_field a n]) in
@@ -480,13 +513,15 @@ let rec unify a b =
 					unify (apply_params c.cl_types tl f1.cf_type) f2.cf_type
 				with
 					Unify_error l -> error (invalid_field n :: l)
-			) fl
+			) an.a_fields;
+			an.a_open := false;
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
-	| TAnon fl1, TAnon fl2 ->
+	| TAnon a1, TAnon a2 ->
 		(try
 			PMap.iter (fun n f2 ->
-				let f1 = (try PMap.find n fl1 with Not_found -> error [has_no_field a n]) in
+			try
+				let f1 = PMap.find n a1.a_fields in
 				if not (unify_access f1.cf_get f2.cf_get) then error [invalid_access n true];
 				if not (unify_access f1.cf_set f2.cf_set) then error [invalid_access n false];
 				if f2.cf_public && not f1.cf_public then error [invalid_visibility n];
@@ -494,7 +529,13 @@ let rec unify a b =
 					unify f1.cf_type f2.cf_type;
 				with
 					Unify_error l -> error (invalid_field n :: l)
-			) fl2;
+			with
+				Not_found ->
+					if not !(a1.a_open) then error [has_no_field a n];
+					a1.a_fields <- PMap.add n f2 a1.a_fields
+			) a2.a_fields;
+			a1.a_open := false;
+			a2.a_open := false;
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
 	| TDynamic t , _ ->

typer.ml

@@ -54,6 +54,7 @@ type context = {
 	mutable locals : (string, t) PMap.t;
 	mutable locals_map : (string, string) PMap.t;
 	mutable locals_map_inv : (string, string) PMap.t;
+	mutable opened : bool ref list;
 }
 
 (* ---------------------------------------------------------------------- *)
@@ -136,6 +137,7 @@ let context err warn =
 		tthis = mk_mono();
 		current = empty;
 		std = empty;
+		opened = [];
 	} in
 	ctx.std <- (try
 		load ctx ([],"StdTypes") null_pos
@@ -336,7 +338,7 @@ and load_type ctx p t =
 	| TPNormal t -> load_normal_type ctx t p false
 	| TPExtend (t,l) ->
 		(match load_type ctx p (TPAnonymous l) with
-		| TAnon l ->
+		| TAnon a ->
 			let rec loop t =
 				match follow t with
 				| TInst (c,tl) ->
@@ -347,17 +349,17 @@ and load_type ctx p t =
 							error ("Cannot redefine field " ^ f) p
 						with
 							Not_found -> ()
-					) l;
+					) a.a_fields;
 					c2.cl_super <- Some (c,tl);
-					c2.cl_fields <- l;
+					c2.cl_fields <- a.a_fields;
 					TInst (c2,[])
 				| TMono _ ->
 					error "Please ensure correct initialization of cascading signatures" p
-				| TAnon fields ->
+				| TAnon a2 ->
 					PMap.iter (fun f _ ->
-						if PMap.mem f fields then error ("Cannot redefine field " ^ f) p
-					) l;
-					TAnon (PMap.foldi PMap.add l fields)
+						if PMap.mem f a2.a_fields then error ("Cannot redefine field " ^ f) p
+					) a.a_fields;
+					mk_anon (PMap.foldi PMap.add a.a_fields a2.a_fields)
 				| _ -> error "Cannot only extend classes and anonymous" p
 			in
 			loop (load_normal_type ctx t p false)
@@ -393,7 +395,7 @@ and load_type ctx p t =
 				cf_doc = None;
 			} acc
 		in
-		TAnon (List.fold_left loop PMap.empty l)
+		mk_anon (List.fold_left loop PMap.empty l)
 	| TPFunction (args,r) ->
 		match args with
 		| [TPNormal { tpackage = []; tparams = []; tname = "Void" }] ->
@@ -416,10 +418,10 @@ let rec reverse_type t =
 		TPNormal { tpackage = fst s.s_path; tname = snd s.s_path; tparams = List.map reverse_type params }
 	| TFun (params,ret) ->
 		TPFunction (List.map (fun (_,_,t) -> reverse_type t) params,reverse_type ret)
-	| TAnon fields ->
+	| TAnon a ->
 		TPAnonymous (PMap.fold (fun f acc ->
 			(f.cf_name , AFVar (reverse_type f.cf_type), null_pos) :: acc
-		) fields [])
+		) a.a_fields [])
 	| TDynamic t2 ->
 		TPNormal { tpackage = []; tname = "Dynamic"; tparams = if t == t2 then [] else [reverse_type t2] }
 	| _ ->
@@ -848,7 +850,7 @@ let type_type ctx tpath p =
 			s_path = fst c.cl_path, "#" ^ snd c.cl_path;
 			s_doc = None;
 			s_pos = c.cl_pos;
-			s_type = TAnon (if pub then PMap.map (fun f -> { f with cf_public = true }) c.cl_statics else c.cl_statics);
+			s_type = mk_anon (if pub then PMap.map (fun f -> { f with cf_public = true }) c.cl_statics else c.cl_statics);
 			s_private = true;
 			s_static = Some c;
 			s_types = c.cl_types;
@@ -872,7 +874,7 @@ let type_type ctx tpath p =
 			s_path = fst e.e_path, "#" ^ snd e.e_path;
 			s_doc = None;
 			s_pos = e.e_pos;
-			s_type = TAnon fl;
+			s_type = mk_anon fl;
 			s_private = true;
 			s_static = None;
 			s_types = e.e_types;
@@ -980,12 +982,26 @@ let type_field ctx e i p get =
 			no_field())
 	| TDynamic t ->
 		AccExpr (mk (TField (e,i)) t p)
-	| TAnon fl ->
+	| TAnon a ->
 		(try
-			let f = PMap.find i fl in
+			let f = PMap.find i a.a_fields in
 			if not f.cf_public && not ctx.untyped then display_error ctx ("Cannot access to private field " ^ i) p;
 			field_access ctx get f (field_type f) e p
-		with Not_found -> no_field())
+		with Not_found ->
+			if not !(a.a_open) then
+				no_field()
+			else
+			let f = mk_field i (mk_mono()) in
+			a.a_fields <- PMap.add i f a.a_fields;
+			field_access ctx get f (field_type f) e p
+		)
+	| TMono r ->
+		let f = mk_field i (mk_mono()) in
+		let x = ref true in
+		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_open = x } in
+		ctx.opened <- x :: ctx.opened;
+		r := Some t;
+		field_access ctx get f (field_type f) e p
 	| t ->
 		no_field()
 
@@ -1381,20 +1397,11 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let rec loop (l,acc) (f,e) =
 			if PMap.mem f acc then error ("Duplicate field in object declaration : " ^ f) p;
 			let e = type_expr ctx e in
-			let cf = {
-				cf_name = f;
-				cf_type = e.etype;
-				cf_public = true;
-				cf_get = NormalAccess;
-				cf_set = NormalAccess;
-				cf_expr = None;
-				cf_doc = None;
-				cf_params = [];
-			} in
+			let cf = mk_field f e.etype in
 			((f,e) :: l, PMap.add f cf acc)
 		in
 		let fields , types = List.fold_left loop ([],PMap.empty) fl in
-		mk (TObjectDecl fields) (TAnon types) p
+		mk (TObjectDecl fields) (mk_anon types) p
 	| EArrayDecl el ->
 		let t , pt = t_array ctx in
 		let dyn = ref ctx.untyped in
@@ -1682,7 +1689,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			]),p)
 
 and type_function ctx t static constr f p =
-	let locals = save_locals ctx in
+	let locals = save_locals ctx in	
 	let fargs , r = (match t with
 		| TFun (args,r) -> List.map (fun (n,opt,t) -> add_local ctx n t, opt, t) args, r
 		| _ -> assert false
@@ -1690,9 +1697,11 @@ and type_function ctx t static constr f p =
 	let old_ret = ctx.ret in
 	let old_static = ctx.in_static in
 	let old_constr = ctx.in_constructor in
+	let old_opened = ctx.opened in
 	ctx.in_static <- static;
 	ctx.in_constructor <- constr;
 	ctx.ret <- r;
+	ctx.opened <- [];
 	let e = type_expr ~need_val:false ctx f.f_expr in
 	let rec loop e =
 		match e.eexpr with
@@ -1718,9 +1727,11 @@ and type_function ctx t static constr f p =
 		with
 			Exit -> ());
 	locals();
+	List.iter (fun r -> r := false) ctx.opened;
 	ctx.ret <- old_ret;
 	ctx.in_static <- old_static;
 	ctx.in_constructor <- old_constr;
+	ctx.opened <- old_opened;
 	e , fargs
 
 let type_static_var ctx t e p =
@@ -1750,7 +1761,7 @@ let check_overloading ctx c p () =
 let rec check_interface ctx c p intf params =
 	PMap.iter (fun i f ->
 		try
-			let t , f2 = class_field c i in
+			let t , f2 = class_field c i in			
 			if f.cf_public && not f2.cf_public then
 				display_error ctx ("Field " ^ i ^ " should be public as requested by " ^ s_type_path intf.cl_path) p
 			else if not(unify_access f2.cf_get f.cf_get) then
@@ -2049,6 +2060,7 @@ let type_module ctx m tdecls loadp =
 		in_static = false;
 		in_loop = false;
 		untyped = false;
+		opened = [];
 	} in
 	let delays = ref [] in
 	let get_class name =