Browse Source

syntax changes : parenthesis for while and for, allowed different cases except in types/packages.

Nicolas Cannasse 19 years ago
parent
commit
f7ecf4be73
10 changed files with 101 additions and 61 deletions
  1. 14 12
      parser.ml
  2. 1 1
      std/Hash.hx
  3. 1 1
      std/List.hx
  4. 9 18
      std/Reflect.hx
  5. 3 3
      std/flash/Boot.hx
  6. 1 1
      std/js/Boot.hx
  7. 2 2
      std/neko/NekoArray__.hx
  8. 1 1
      std/neko/NekoNode__.hx
  9. 1 1
      std/tools/haxedoc/Main.hx
  10. 68 21
      typer.ml

+ 14 - 12
parser.ml

@@ -110,6 +110,10 @@ let rec psep sep f = parser
 let ident = parser
 let ident = parser
 	| [< '(Const (Ident i),_) >] -> i
 	| [< '(Const (Ident i),_) >] -> i
 
 
+let any_ident = parser
+	| [< '(Const (Ident i),_) >] -> i
+	| [< '(Const (Type t),_) >] -> t
+
 let log m s =
 let log m s =
 	prerr_endline m
 	prerr_endline m
 
 
@@ -214,7 +218,7 @@ and parse_class_field s =
 	match s with parser
 	match s with parser
 	| [< l = parse_cf_rights []; doc = get_doc; s >] ->
 	| [< l = parse_cf_rights []; doc = get_doc; s >] ->
 		match s with parser
 		match s with parser
-		| [< '(Kwd Var,p1); '(Const (Ident name),_); t = parse_type_opt; s >] ->			
+		| [< '(Kwd Var,p1); name = any_ident; t = parse_type_opt; s >] ->			
 			let e , p2 = (match s with parser
 			let e , p2 = (match s with parser
 			| [< '(Binop OpAssign,_) when List.mem AStatic l; e = expr; p2 = semicolon >] -> Some e , p2
 			| [< '(Binop OpAssign,_) when List.mem AStatic l; e = expr; p2 = semicolon >] -> Some e , p2
 			| [< '(Semicolon,p2) >] -> None , p2
 			| [< '(Semicolon,p2) >] -> None , p2
@@ -243,6 +247,7 @@ and parse_cf_rights l = parser
 
 
 and parse_fun_name = parser
 and parse_fun_name = parser
 	| [< '(Const (Ident name),_) >] -> name
 	| [< '(Const (Ident name),_) >] -> name
+	| [< '(Const (Type name),_) >] -> name
 	| [< '(Kwd New,_) >] -> "new"
 	| [< '(Kwd New,_) >] -> "new"
 
 
 and parse_fun_param = parser
 and parse_fun_param = parser
@@ -276,10 +281,10 @@ and parse_block_elt = parser
 	| [< e = expr; _ = semicolon >] -> e
 	| [< e = expr; _ = semicolon >] -> e
 
 
 and parse_obj_decl = parser
 and parse_obj_decl = parser
-	| [< '(Comma,_); '(Const (Ident name),_); '(DblDot,_); e = expr >] -> (name,e)
+	| [< '(Comma,_); name = any_ident; '(DblDot,_); e = expr >] -> (name,e)
 
 
 and parse_var_decl = parser
 and parse_var_decl = parser
-	| [< '(Const (Ident name),_); t = parse_type_opt; s >] ->
+	| [< name = any_ident; t = parse_type_opt; s >] ->
 		match s with parser
 		match s with parser
 		| [< '(Binop OpAssign,_); e = expr >] -> (name,t,Some e)
 		| [< '(Binop OpAssign,_); e = expr >] -> (name,t,Some e)
 		| [< >] -> (name,t,None)
 		| [< >] -> (name,t,None)
@@ -301,12 +306,9 @@ and expr = parser
 		expr_next (EFunction f, punion p1 (pos e)) s
 		expr_next (EFunction f, punion p1 (pos e)) s
 	| [< '(Unop op,p1) when is_prefix op; e = expr >] -> make_unop op e p1
 	| [< '(Unop op,p1) when is_prefix op; e = expr >] -> make_unop op e p1
 	| [< '(Binop OpSub,p1); e = expr >] -> make_unop Neg e p1
 	| [< '(Binop OpSub,p1); e = expr >] -> make_unop Neg e p1
-	| [< '(Kwd For,p); s >] ->
-		(match s with parser
-		| [< '(POpen,_); '(Const (Ident name),_); '(Kwd In,_); it = expr; '(PClose,_); e = expr; s >] -> expr_next (EFor (name,it,e),punion p (pos e)) s
-		| [< '(Const (Ident name),_); '(Kwd In,_); it = expr; e = expr; s >] -> expr_next (EFor (name,it,e),punion p (pos e)) s
-		| [< >] -> serror())
-	| [< '(Kwd If,p); cond = expr; e1 = expr; s >] ->
+	| [< '(Kwd For,p); '(POpen,_); name = any_ident; '(Kwd In,_); it = expr; '(PClose,_); e = expr; s >] ->
+		expr_next (EFor (name,it,e),punion p (pos e)) s
+	| [< '(Kwd If,p); '(POpen,_); cond = expr; '(PClose,_); e1 = expr; s >] ->
 		let e2 , s = (match s with parser
 		let e2 , s = (match s with parser
 			| [< '(Kwd Else,_); e2 = expr; s >] -> Some e2 , s
 			| [< '(Kwd Else,_); e2 = expr; s >] -> Some e2 , s
 			| [< >] -> 
 			| [< >] -> 
@@ -324,8 +326,8 @@ and expr = parser
 	| [< '(Kwd Return,p); e = popt expr >] -> (EReturn e, match e with None -> p | Some e -> punion p (pos e))
 	| [< '(Kwd Return,p); e = popt expr >] -> (EReturn e, match e with None -> p | Some e -> punion p (pos e))
 	| [< '(Kwd Break,p) >] -> (EBreak,p)
 	| [< '(Kwd Break,p) >] -> (EBreak,p)
 	| [< '(Kwd Continue,p) >] -> (EContinue,p)
 	| [< '(Kwd Continue,p) >] -> (EContinue,p)
-	| [< '(Kwd While,p1); cond = expr; e = expr; s >] -> expr_next (EWhile (cond,e,NormalWhile),punion p1 (pos e)) s
-	| [< '(Kwd Do,p1); e = expr; '(Kwd While,_); cond = expr; s >] -> expr_next (EWhile (cond,e,DoWhile),punion p1 (pos e)) s
+	| [< '(Kwd While,p1); '(POpen,_); cond = expr; '(PClose,_); e = expr; s >] -> expr_next (EWhile (cond,e,NormalWhile),punion p1 (pos e)) s
+	| [< '(Kwd Do,p1); e = expr; '(Kwd While,_); '(POpen,_); cond = expr; '(PClose,_); s >] -> expr_next (EWhile (cond,e,DoWhile),punion p1 (pos e)) s
 	| [< '(Kwd Switch,p1); e = expr; '(BrOpen,_); cases , def = parse_switch_cases; '(BrClose,p2); s >] -> expr_next (ESwitch (e,cases,def),punion p1 p2) s
 	| [< '(Kwd Switch,p1); e = expr; '(BrOpen,_); cases , def = parse_switch_cases; '(BrClose,p2); s >] -> expr_next (ESwitch (e,cases,def),punion p1 p2) s
 	| [< '(Kwd Try,p1); e = expr; cl = plist parse_catch; s >] -> expr_next (ETry (e,cl),p1) s
 	| [< '(Kwd Try,p1); e = expr; cl = plist parse_catch; s >] -> expr_next (ETry (e,cl),p1) s
 	| [< '(IntInterval i,p1); e2 = expr >] -> make_binop OpInterval (EConst (Int i),p1) e2
 	| [< '(IntInterval i,p1); e2 = expr >] -> make_binop OpInterval (EConst (Int i),p1) e2
@@ -376,7 +378,7 @@ and parse_switch_cases = parser
 		[] , None
 		[] , None
 
 
 and parse_catch = parser
 and parse_catch = parser
-	| [< '(Kwd Catch,_); '(POpen,_); '(Const (Ident name),_); '(DblDot,_); t = parse_type_path; '(PClose,_); e = expr >] -> (name,t,e)
+	| [< '(Kwd Catch,_); '(POpen,_); name = any_ident; '(DblDot,_); t = parse_type_path; '(PClose,_); e = expr >] -> (name,t,e)
 
 
 let parse code file =
 let parse code file =
 	let old = Lexer.save() in
 	let old = Lexer.save() in

+ 1 - 1
std/Hash.hx

@@ -109,7 +109,7 @@ class Hash<T> {
 		var s = new StringBuf();
 		var s = new StringBuf();
 		s.add("{");
 		s.add("{");
 		var it = keys();
 		var it = keys();
-		for i in it {
+		for( i in it ) {
 			s.add(i);
 			s.add(i);
 			s.add(" => ");
 			s.add(" => ");
 			s.add(get(i));
 			s.add(get(i));

+ 1 - 1
std/List.hx

@@ -129,7 +129,7 @@ class List<T> {
 		var s = new StringBuf();
 		var s = new StringBuf();
 		var it = iterator();
 		var it = iterator();
 		s.add("{");
 		s.add("{");
-		for i in it {
+		for( i in it ) {
 			s.add(i);
 			s.add(i);
 			if( it.hasNext() )
 			if( it.hasNext() )
 				s.add(", ");
 				s.add(", ");

+ 9 - 18
std/Reflect.hx

@@ -82,28 +82,19 @@ class Reflect {
 	public static function field( o : Dynamic, field : String ) : Dynamic {
 	public static function field( o : Dynamic, field : String ) : Dynamic {
 		untyped
 		untyped
 		#if flash
 		#if flash
-			{
-				var f = o[field];
-				if( f == null && !this.hasOwnProperty.call(o,f) )
-					throw ("No such field : " + field);
-				return f;
-			}
+			return o[field]
 		#else js
 		#else js
-			{
-				var f = o[field];
-				if( f == null && !o.hasOwnProperty(f) )
-					throw ("No such field : " + field);
-				return f;
+			try {
+				return o[field];
+			} catch( e : Dynamic ) {
+				return null;
 			}
 			}
 		#else neko
 		#else neko
 			{
 			{
 				if( __dollar__typeof(o) != __dollar__tobject )
 				if( __dollar__typeof(o) != __dollar__tobject )
-					throw ("No such field : " + field);
+					return null;
 				var fh = __dollar__hash(field.__s);
 				var fh = __dollar__hash(field.__s);
-				var f = __dollar__objget(o,fh);
-				if( f == null && !__dollar__objfield(o,fh) )
-					throw ("No such field : " + field);
-				return f;
+				return __dollar__objget(o,fh);
 			}
 			}
 		#else error
 		#else error
 		#end
 		#end
@@ -163,9 +154,9 @@ class Reflect {
 	public static function isFunction( f : Dynamic ) : Bool {
 	public static function isFunction( f : Dynamic ) : Bool {
 		return untyped
 		return untyped
 		#if flash
 		#if flash
-			f.call == _global["Function"].call
+			f.call == _global["Function"].call && f.__interfaces__ == null
 		#else js
 		#else js
-			f.call == isFunction.call
+			f.call == isFunction.call && f.__interfaces__ == null
 		#else neko
 		#else neko
 			__dollar__typeof(f) == __dollar__tfunction
 			__dollar__typeof(f) == __dollar__tfunction
 		#else error
 		#else error

+ 3 - 3
std/flash/Boot.hx

@@ -44,7 +44,7 @@ class Boot {
 					var i;
 					var i;
 					var str = "[";
 					var str = "[";
 					s += "    ";
 					s += "    ";
-					for i in 0...l
+					for( i in 0...l )
 						str += (if (i > 0) "," else "")+__string_rec(o[i],s);
 						str += (if (i > 0) "," else "")+__string_rec(o[i],s);
 					s = s.substring(4);
 					s = s.substring(4);
 					str += "]";
 					str += "]";
@@ -58,7 +58,7 @@ class Boot {
 				if( typeof(o) == "movieclip" )
 				if( typeof(o) == "movieclip" )
 					str = "MC("+o._name+") "+str;
 					str = "MC("+o._name+") "+str;
 				s += "    ";
 				s += "    ";
-				for k in (__keys__(o)).iterator() {
+				for( k in (__keys__(o)).iterator() ) {
 					if( str.length != 2 )
 					if( str.length != 2 )
 						str += ",\n";
 						str += ",\n";
 					if( k == "__construct__" && __typeof__(o[k]) == "function" )
 					if( k == "__construct__" && __typeof__(o[k]) == "function" )
@@ -176,7 +176,7 @@ class Boot {
 					p : 0,
 					p : 0,
 					a : childNodes,
 					a : childNodes,
 					next : function() {
 					next : function() {
-						while true {
+						while( true ) {
 							var x = this.a[this.p];
 							var x = this.a[this.p];
 							if( x == null )
 							if( x == null )
 								return null;
 								return null;

+ 1 - 1
std/js/Boot.hx

@@ -165,7 +165,7 @@ class Boot {
 					p : 0,
 					p : 0,
 					a : childNodes,
 					a : childNodes,
 					next : function() {
 					next : function() {
-						while true {
+						while( true ) {
 							var x = this.a[this.p];
 							var x = this.a[this.p];
 							if( x == null )
 							if( x == null )
 								return null;
 								return null;

+ 2 - 2
std/neko/NekoArray__.hx

@@ -115,7 +115,7 @@ class NekoArray__<T> implements Array<T> {
 	public function join(delim : String) {
 	public function join(delim : String) {
 		var s = new StringBuf();
 		var s = new StringBuf();
 		var it = iterator();
 		var it = iterator();
-		for i in it {
+		for( i in it ) {
 			s.add(i);
 			s.add(i);
 			if( it.hasNext() )
 			if( it.hasNext() )
 				s.add(delim);
 				s.add(delim);
@@ -127,7 +127,7 @@ class NekoArray__<T> implements Array<T> {
 		var s = new StringBuf();
 		var s = new StringBuf();
 		s.add("[");
 		s.add("[");
 		var it = iterator();
 		var it = iterator();
-		for i in it {
+		for( i in it ) {
 			s.add(i);
 			s.add(i);
 			if( it.hasNext() )
 			if( it.hasNext() )
 				s.add(", ");
 				s.add(", ");

+ 1 - 1
std/neko/NekoNode__.hx

@@ -105,7 +105,7 @@ class NekoNode__ implements Node {
 			p : 0,
 			p : 0,
 			a : childNodes,
 			a : childNodes,
 			next : function() {
 			next : function() {
-				while true {
+				while( true ) {
 					var x = this.a[this.p];
 					var x = this.a[this.p];
 					if( x == null )
 					if( x == null )
 						return null;
 						return null;

+ 1 - 1
std/tools/haxedoc/Main.hx

@@ -174,7 +174,7 @@ private class DocClass {
 		var s = new StringBuf();
 		var s = new StringBuf();
 		var curp = path.split(".");
 		var curp = path.split(".");
 		s.add("<div class=\"classname\">");
 		s.add("<div class=\"classname\">");
-		s.add(if isEnum "enum " else "class ");
+		s.add(if( isEnum ) "enum " else "class ");
 		s.add(path);
 		s.add(path);
 		if( params.length > 0 ) {
 		if( params.length > 0 ) {
 			s.add("&lt;");
 			s.add("&lt;");

+ 68 - 21
typer.ml

@@ -57,6 +57,7 @@ type error_msg =
 	| Cannot_unify of t * t
 	| Cannot_unify of t * t
 	| Custom of string
 	| Custom of string
 	| Protect of error_msg
 	| Protect of error_msg
+	| Unknown_ident of string 
 	| Stack of error_msg * error_msg
 	| Stack of error_msg * error_msg
 
 
 exception Error of error_msg * pos
 exception Error of error_msg * pos
@@ -66,6 +67,7 @@ let rec error_msg = function
 	| Cannot_unify (t1,t2) -> 
 	| Cannot_unify (t1,t2) -> 
 		let ctx = print_context() in
 		let ctx = print_context() in
 		s_type ctx t1 ^ " should be " ^ s_type ctx t2
 		s_type ctx t1 ^ " should be " ^ s_type ctx t2
+	| Unknown_ident s -> "Unknown identifier : " ^ s
 	| Custom s -> s
 	| Custom s -> s
 	| Stack (m1,m2) -> error_msg m1 ^ "\n" ^ error_msg m2
 	| Stack (m1,m2) -> error_msg m1 ^ "\n" ^ error_msg m2
 	| Protect m -> error_msg m
 	| Protect m -> error_msg m
@@ -410,12 +412,15 @@ let rec class_field c i =
 				let t , f = class_field c i in
 				let t , f = class_field c i in
 				apply_params c.cl_types params t , f
 				apply_params c.cl_types params t , f
 
 
+let type_local ctx i p =
+	(* local lookup *)
+	let t = PMap.find i ctx.locals in
+	let i = (try PMap.find i ctx.locals_map with Not_found -> i) in
+	mk (TLocal i) t p	
+
 let type_ident ctx i p =
 let type_ident ctx i p =
 	try
 	try
-		(* local loookup *)
-		let t = PMap.find i ctx.locals in
-		let i = (try PMap.find i ctx.locals_map with Not_found -> i) in
-		mk (TLocal i) t p
+		type_local ctx i p
 	with Not_found -> try
 	with Not_found -> try
 		(* member variable lookup *)
 		(* member variable lookup *)
 		if ctx.in_static then raise Not_found;
 		if ctx.in_static then raise Not_found;
@@ -446,7 +451,7 @@ let type_ident ctx i p =
 	with Not_found ->
 	with Not_found ->
 		if ctx.untyped then mk (TLocal i) (mk_mono()) p else begin
 		if ctx.untyped then mk (TLocal i) (mk_mono()) p else begin
 			if ctx.in_static && PMap.mem i ctx.curclass.cl_fields then error ("Cannot access " ^ i ^ " in static function") p;
 			if ctx.in_static && PMap.mem i ctx.curclass.cl_fields then error ("Cannot access " ^ i ^ " in static function") p;
-			error ("Unknown identifier " ^ i) p 
+			raise (Error (Unknown_ident i,p))
 		end
 		end
 
 
 let type_type ctx tpath p =
 let type_type ctx tpath p =
@@ -498,9 +503,18 @@ let type_constant ctx c p =
 	| Ident "here" ->
 	| Ident "here" ->
 		let infos = mk_infos ctx p [] in
 		let infos = mk_infos ctx p [] in
 		(!type_expr_ref) ctx ~need_val:true infos
 		(!type_expr_ref) ctx ~need_val:true infos
-	| Ident s -> type_ident ctx s p
+	| Ident s ->
+		type_ident ctx s p
 	| Type s ->
 	| Type s ->
-		type_type ctx ([],s) p
+		try
+			type_local ctx s p
+		with
+			Not_found -> 
+		try
+			type_type ctx ([],s) p
+		with
+			Error (Module_not_found ([],s2),_) when s = s2 ->
+				type_ident ctx s p
 
 
 let check_assign ctx e =
 let check_assign ctx e =
 	match e.eexpr with
 	match e.eexpr with
@@ -834,16 +848,6 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			| _ :: l -> loop l
 			| _ :: l -> loop l
 		in
 		in
 		mk (TBlock l) (loop l) p
 		mk (TBlock l) (loop l) p
-	| EType (pack,s) ->
-		let rec loop (e,p) =
-			match e with
-			| EField (e,s) -> s :: loop e
-			| EConst (Ident i) -> [i]
-			| EConst (Type i) -> error ("Invalid package identifier : " ^ i) p
-			| _ -> assert false
-		in
-		let pack = List.rev (loop pack)	in
-		type_type ctx (pack,s) p
 	| EParenthesis e ->
 	| EParenthesis e ->
 		let e = type_expr ctx ~need_val e in
 		let e = type_expr ctx ~need_val e in
 		mk (TParenthesis e) e.etype p
 		mk (TParenthesis e) e.etype p
@@ -1051,11 +1055,54 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				error (s_type (print_context()) t ^ " cannot be called") e.epos
 				error (s_type (print_context()) t ^ " cannot be called") e.epos
 		) in
 		) in
 		mk (TCall (e,el)) t p
 		mk (TCall (e,el)) t p
-	| EField (e,i) ->
-		let e = type_expr ctx e in
-		let t = type_field ctx e.etype i p in
-		mk (TField (e,i)) t p
+	| EField _
+	| EType _ ->
+		let fields path e =
+			List.fold_left (fun e (f,_,p) -> 
+				let t = type_field ctx e.etype f p in
+				mk (TField (e,f)) 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) :: path ->
+					let pack = List.rev_map (fun (x,_,_) -> x) acc in
+					let e = type_type ctx (pack,name) p in
+					fields path e
+			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) ->
 	| 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;
 		let t = load_normal_type ctx t p true in
 		let t = load_normal_type ctx t p true in
 		let el = List.map (type_expr ctx) el in
 		let el = List.map (type_expr ctx) el in
 		let c , params , t = (match t with
 		let c , params , t = (match t with