added Extends types {> ... }

added cast with no type

ast.ml

@@ -143,6 +143,7 @@ and type_path =
 	| TPFunction of type_path list * type_path
 	| TPAnonymous of (string * anonymous_field * pos) list
 	| TPParent of type_path
+	| TPExtend of type_path_normal * (string * anonymous_field * pos) list
 
 type func = {
 	f_args : (string * type_path option) list;
@@ -175,7 +176,7 @@ and expr_def =
 	| EContinue
 	| EUntyped of expr
 	| EThrow of expr
-	| ECast of expr * type_path
+	| ECast of expr * type_path option
 
 and expr = expr_def * pos
 

doc/CHANGES.txt

@@ -1,6 +1,8 @@
 2006-06-??: 1.02
 	fixed stack overflow when recursive class <: recursive signature
 	improved a bit commandline : allow several hxml arguments
+	added {> Class, fields... } types declarations
+	added cast without type (less dangerous than untyped)
 
 2006-05-25: 1.01
 	added neko.Utf8

parser.ml

@@ -181,12 +181,13 @@ and parse_type_opt = parser
 and parse_type_path = parser
 	| [< '(POpen,_); t = parse_type_path; '(PClose,_); s >] -> parse_type_path_next (TPParent t) s
 	| [< '(BrOpen,_); s >] ->
-		let l = (match s with parser
-			| [< name = any_ident >] -> parse_type_anonymous_resume name s
-			| [< l = plist parse_signature_field; '(BrClose,_) >] -> l
+		let t = (match s with parser
+			| [< name = any_ident >] -> TPAnonymous (parse_type_anonymous_resume name s)
+			| [< '(Binop OpGt,_); t = parse_type_path_normal; '(Comma,_); l = psep Comma parse_type_anonymous; '(BrClose,_) >] -> TPExtend (t,l)
+			| [< l = plist parse_signature_field; '(BrClose,_) >] -> TPAnonymous l
 			| [< >] -> serror()
 		) in
-		parse_type_path_next (TPAnonymous l) s
+		parse_type_path_next t s
 	| [< t = parse_type_path_normal; s >] -> parse_type_path_next (TPNormal t) s
 
 and parse_type_path_normal s = parse_type_path1 [] s
@@ -358,7 +359,13 @@ and expr = parser
 	| [< '(BrOpen,p1); e = block1; '(BrClose,p2) >] -> (e,punion p1 p2)
 	| [< '(Const c,p); s >] -> expr_next (EConst c,p) s
 	| [< '(Kwd This,p); s >] -> expr_next (EConst (Ident "this"),p) s
-	| [< '(Kwd Cast,p1); '(POpen,_); e = expr; '(Comma,_); t = parse_type_path; '(PClose,p2); s >] -> expr_next (ECast (e,t),punion p1 p2) s
+	| [< '(Kwd Cast,p1); s >] ->
+		(match s with parser
+		| [< '(POpen,_); e = expr; s >] ->
+			(match s with parser
+			| [< '(Comma,_); t = parse_type_path; '(PClose,p2); s >] -> expr_next (ECast (e,Some t),punion p1 p2) s
+			| [< >] -> expr_next (ECast (e,None),punion p1 (pos e)) s)
+		| [< e = expr; s >] -> expr_next (ECast (e,None),punion p1 (pos e)) s)
 	| [< '(Kwd Throw,p); e = expr >] -> (EThrow e,p)
 	| [< '(Kwd New,p1); t = parse_type_path_normal; '(POpen,_); al = psep Comma expr; '(PClose,p2); s >] -> expr_next (ENew (t,al),punion p1 p2) s
 	| [< '(POpen,p1); e = expr; '(PClose,p2); s >] -> expr_next (EParenthesis e, punion p1 p2) s

typer.ml

@@ -306,6 +306,23 @@ and load_type ctx p t =
 	match t with
 	| TPParent t -> 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 ->
+			(match load_normal_type ctx t p false with
+			| TInst (c,pl) ->
+				let t = TAnon (PMap.foldi PMap.add c.cl_fields l) in
+				let s = {
+					s_path = (fst c.cl_path,"+" ^ snd c.cl_path);
+					s_pos = p;
+					s_doc = None;
+					s_private = false;
+					s_types = c.cl_types;
+					s_type = t;
+				} in
+				TSign (s,pl)
+			| _ -> error "Cannot extend not-a-class" p)
+		| _ -> assert false)
 	| TPAnonymous l ->
 		let rec loop acc (n,f,p) =
 			if PMap.mem n acc then error ("Duplicate field declaration : " ^ n) p;
@@ -1577,10 +1594,15 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			epos = e.epos;
 		}
 	| ECast (e,t) ->
-		type_expr ctx (ETry ((EThrow e,p),[
-			("e",t,(EConst (Ident "e"),p));
-			("e",TPNormal { tpackage = []; tname = "Dynamic"; tparams = [] },(EThrow (EConst (String "Class cast error"),p),p))
-		]),p)
+		match t with
+		| None ->
+			let e = type_expr ctx e in
+			{ e with etype = mk_mono() }
+		| Some t ->
+			type_expr ctx (ETry ((EThrow e,p),[
+				("e",t,(EConst (Ident "e"),p));
+				("e",TPNormal { tpackage = []; tname = "Dynamic"; tparams = [] },(EThrow (EConst (String "Class cast error"),p),p))
+			]),p)
 
 and type_function ctx t static constr f p =
 	let locals = save_locals ctx in