added multiple expressions in 'case'.

ast.ml

@@ -185,7 +185,7 @@ and expr_def =
 	| EFor of string * expr * expr
 	| EIf of expr * expr * expr option
 	| EWhile of expr * expr * while_flag
-	| ESwitch of expr * (expr * expr) list * expr option
+	| ESwitch of expr * (expr list * expr) list * expr option
 	| ETry of expr * (string * type_path * expr) list
 	| EReturn of expr option
 	| EBreak

doc/CHANGES.txt

@@ -8,6 +8,7 @@
 	added neko.net.ProxyDetect
 	bugfix in unify : prevent recursive anonymous objects
 	haxe.Http call "prepare" only if size is known
+	added multiple expressions in "case"
 
 2007-01-01: 1.10
 	fix in haxe.remoting.SocketConnection.readAnswer

genjs.ml

@@ -388,9 +388,11 @@ and gen_expr ctx e =
 		newline ctx;
 		spr ctx "switch( $e[0] ) {";
 		newline ctx;
-		List.iter (fun (constr,params,e) ->
-			print ctx "case \"%s\":" constr;
-			newline ctx;
+		List.iter (fun (cl,params,e) ->
+			List.iter (fun c ->
+				print ctx "case \"%s\":" c;
+				newline ctx;
+			) cl;
 			(match params with
 			| None | Some [] -> ()
 			| Some l ->
@@ -422,10 +424,12 @@ and gen_expr ctx e =
 		gen_value ctx (parent e);
 		spr ctx " {";
 		newline ctx;
-		List.iter (fun (e1,e2) ->
-			spr ctx "case ";
-			gen_value ctx e1;
-			spr ctx ":";
+		List.iter (fun (el,e2) ->
+			List.iter (fun e ->
+				spr ctx "case ";
+				gen_value ctx e;
+				spr ctx ":";
+			) el;
 			gen_expr ctx (block e2);
 			print ctx "break";
 			newline ctx;

genneko.ml

@@ -76,8 +76,8 @@ let add_local ctx v p =
 		| TMatch (e,_,cases,eo) ->
 			loop flag e;
 			(match eo with None -> () | Some e -> loop flag e);
-			List.iter (fun (_,vars,e) ->
-				match vars with
+			List.iter (fun (_,params,e) ->				
+				match params with
 				| Some l when List.exists (fun (a,_) -> a = Some v) l -> ()
 				| _ -> loop flag e
 			) cases
@@ -399,46 +399,93 @@ and gen_expr ctx e =
 	| TThrow e ->
 		call p (builtin p "throw") [gen_expr ctx e]
 	| TMatch (e,_,cases,eo) ->
-		(EBlock [
-			(EVars ["@tmp",Some (gen_expr ctx e)],p);
+		let etmp = (EVars ["@tmp",Some (gen_expr ctx e)],p) in
+		let etag = field p (ident p "@tmp") "tag" in
+		let gen_params params e =
+			match params with
+			| None ->
+				gen_expr ctx e
+			| Some el ->
+				let b = block ctx [e] in
+				let count = ref (-1) in
+				let vars = List.fold_left (fun acc (v,_) ->
+					incr count;
+					match v with
+					| None ->
+						acc
+					| Some v ->
+						let isref = add_local ctx v p in
+						let e = (EArray (ident p "@tmp",int p (!count)),p) in
+						let e = (if isref then call p (builtin p "array") [e] else e) in
+						(v , Some e) :: acc
+				) [] el in
+				let e = gen_expr ctx e in
+				b();
+				(EBlock [
+					(EVars ["@tmp",Some (field p (ident p "@tmp") "args")],p);
+					(match vars with [] -> null p | _ -> EVars vars,p);
+					e
+				],p)
+		in
+		(try
+		  (EBlock [
+			etmp;
 			(ESwitch (
-				field p (ident p "@tmp") "tag",
-				List.map (fun (s,el,e2) ->
-					let count = ref (-1) in
-					let e = match el with
-						| None -> gen_expr ctx e2
-						| Some el ->
-							let b = block ctx [e2] in
-							let vars = List.fold_left (fun acc (v,_) ->
-								incr count;
-								match v with
-								| None ->
-									acc
-								| Some v ->
-									let isref = add_local ctx v p in
-									let e = (EArray (ident p "@tmp",int p (!count)),p) in
-									let e = (if isref then call p (builtin p "array") [e] else e) in
-									(v , Some e) :: acc
-							) [] el in
-							let e2 = gen_expr ctx e2 in
-							b();
-							(EBlock [
-								(EVars ["@tmp",Some (field p (ident p "@tmp") "args")],p);
-								(match vars with [] -> null p | _ -> EVars vars,p);
-								e2
-							],p)
-					in
-					str p s , e
+				etag,
+				List.map (fun (cl,params,e2) ->
+					let cond = match cl with
+						| [s] -> str p s
+						| _ -> raise Exit
+					in					
+					cond , gen_params params e2
 				) cases,
 				(match eo with None -> None | Some e -> Some (gen_expr ctx e))
 			),p)
-		],p)
+		  ],p)
+		with
+			Exit ->
+				(EBlock [
+					etmp;
+					(EVars ["@tag",Some etag],p);
+					List.fold_left (fun acc (cl,params,e2) ->
+						let cond = (match cl with
+							| [] -> assert false
+							| c :: l ->
+								let eq c = (EBinop ("==",ident p "@tag",str p c),p) in
+								List.fold_left (fun acc c -> (EBinop ("||",acc,eq c),p)) (eq c) l
+						) in
+						EIf (cond,gen_params params e2,Some acc),p
+					) (match eo with None -> null p | Some e -> (gen_expr ctx e)) (List.rev cases)
+				],p)
+		)
 	| TSwitch (e,cases,eo) ->
-		(ESwitch (
-			gen_expr ctx e,
-			List.map (fun (e1,e2) -> gen_expr ctx e1, gen_expr ctx e2) cases,
-			(match eo with None -> None | Some e -> Some (gen_expr ctx e))
-		),p)
+		let e = gen_expr ctx e in
+		let eo = (match eo with None -> None | Some e -> Some (gen_expr ctx e)) in
+		try			
+			(ESwitch (
+				e,
+				List.map (fun (el,e2) ->
+					match List.map (gen_expr ctx) el with
+					| [] -> assert false
+					| [e] -> e, gen_expr ctx e2
+					| _ -> raise Exit
+				) cases,
+				eo
+			),p)
+		with
+			Exit ->
+				(EBlock [
+					(EVars ["@tmp",Some e],p);
+					List.fold_left (fun acc (el,e) ->
+						let cond = (match el with
+							| [] -> assert false
+							| e :: l ->
+								let eq e = (EBinop ("==",ident p "@tmp",gen_expr ctx e),p) in
+								List.fold_left (fun acc e -> (EBinop ("||",acc,eq e),p)) (eq e) l
+						) in
+						EIf (cond,gen_expr ctx e,Some acc),p
+					) (match eo with None -> null p | Some e -> e) (List.rev cases)
+				],p)
 
 let gen_method ctx p c acc =
 	ctx.curmethod <- c.cf_name;

genswf8.ml

@@ -583,28 +583,22 @@ and gen_switch ctx retval e cases def =
 	gen_expr ctx true e;
 	let r = alloc_reg ctx in
 	write ctx (ASetReg r);
-	let rec loop = function
-		| [] ->
-			write ctx APop;
-			[]
-		| [(e,x)] ->
-			gen_expr ctx true e;
-			write ctx AEqual;
-			[cjmp ctx,x]
-		| (e,x) :: l ->
+	let first = ref true in
+	let dispatch = List.map (fun (el,x) ->
+		List.map (fun e ->
+			if !first then first := false else push ctx [VReg r];
 			gen_expr ctx true e;
 			write ctx AEqual;
-			let j = cjmp ctx in
-			push ctx [VReg r];
-			(j,x) :: loop l
-	in
-	let dispatch = loop cases in
+			cjmp ctx
+		) el , x
+	) cases in
+	if !first then write ctx APop;
 	(match def with
 	| None -> if retval then push ctx [VNull]
 	| Some e -> gen_expr ctx retval e);
 	let jend = jmp ctx in
-	let jends = List.map (fun (j,e) ->
-		j();
+	let jends = List.map (fun (jl,e) ->
+		List.iter (fun j -> j()) jl;
 		gen_expr ctx retval e;
 		if retval then ctx.stack_size <- ctx.stack_size - 1;
 		jmp ctx;
@@ -621,31 +615,25 @@ and gen_match ctx retval e cases def =
 	write ctx AObjGet;
 	let rtag = alloc_reg ctx in
 	write ctx (ASetReg rtag);
-	let rec loop = function
-		| [] ->
-			write ctx APop;
-			[]
-		| [(constr,args,e)] ->
-			push ctx [VStr (constr,false)];
+	let first = ref true in
+	let dispatch = List.map (fun (cl,params,e) ->
+		List.map (fun c ->
+			if !first then first := false else push ctx [VReg rtag];
+			push ctx [VStr (c,false)];
 			write ctx APhysEqual;
-			[cjmp ctx,args,e]
-		| (constr,args,e) :: l ->
-			push ctx [VStr (constr,false)];
-			write ctx APhysEqual;
-			let j = cjmp ctx in
-			push ctx [VReg rtag];
-			(j,args,e) :: loop l
-	in
-	let dispatch = loop cases in
+			cjmp ctx
+		) cl, params, e
+	) cases in
+	if !first then write ctx APop;
 	free_reg ctx rtag e.epos;
 	(match def with
 	| None -> if retval then push ctx [VNull]
 	| Some e -> gen_expr ctx retval e);
 	let jend = jmp ctx in
-	let jends = List.map (fun (j,args,e) ->
+	let jends = List.map (fun (jl,args,e) ->
 		let regs = ctx.regs in
 		let nregs = ctx.reg_count in
-		j();
+		List.iter (fun j -> j()) jl;
 		let n = ref 0 in
 		List.iter (fun (a,t) ->
 			incr n;

genswf9.ml

@@ -754,11 +754,23 @@ let rec gen_expr_content ctx retval e =
 		gen_expr ctx true e;
 		write ctx (A3SetReg r);
 		let prev = ref (fun () -> ()) in
-		let jend = List.map (fun (v,e) ->
+		let jend = List.map (fun (vl,e) ->
 			(!prev)();
-			write ctx (A3Reg r);
-			gen_expr ctx true v;
-			prev := jump ctx J3Neq;
+			let rec loop = function
+				| [] ->
+					assert false
+				| [v] ->
+					write ctx (A3Reg r);
+					gen_expr ctx true v;
+					prev := jump ctx J3Neq;					
+				| v :: l ->
+					write ctx (A3Reg r);
+					gen_expr ctx true v;
+					let j = jump ctx J3Eq in
+					loop l;
+					j()
+			in
+			loop vl;
 			gen_expr_obj ctx retval e;
 			if retval then ctx.infos.istack <- ctx.infos.istack - 1;
 			jump ctx J3Always
@@ -779,11 +791,23 @@ let rec gen_expr_content ctx retval e =
 		write ctx (A3Get (ident ctx "params"));
 		write ctx (A3SetReg rparams);
 		let prev = ref (fun () -> ()) in
-		let jend = List.map (fun (tag,params,e) ->
+		let jend = List.map (fun (cl,params,e) ->
 			(!prev)();
-			write ctx (A3Reg rtag);
-			write ctx (A3String (lookup tag ctx.strings));
-			prev := jump ctx J3Neq;
+			let rec loop = function
+				| [] ->
+					assert false
+				| [tag] ->
+					write ctx (A3Reg rtag);
+					write ctx (A3String (lookup tag ctx.strings));
+					prev := jump ctx J3Neq;					
+				| tag :: l ->
+					write ctx (A3Reg rtag);
+					write ctx (A3String (lookup tag ctx.strings));
+					let j = jump ctx J3Eq in
+					loop l;
+					j()
+			in
+			loop cl;
 			let b = open_block ctx [e] retval in
 			(match params with
 			| None -> ()

parser.ml

@@ -513,8 +513,8 @@ and parse_switch_cases = parser
 	| [< '(Kwd Default,p1); '(DblDot,_); e = block1; l , def = parse_switch_cases >] ->
 		(match def with None -> () | Some (e,p) -> error Duplicate_default p);
 		l , Some (e , p1)
-	| [< '(Kwd Case,p1); e = expr; '(DblDot,_); b = block1; l , def = parse_switch_cases >] ->
-		(e,(b,p1)) :: l , def
+	| [< '(Kwd Case,p1); el = psep Comma expr; '(DblDot,_); b = block1; l , def = parse_switch_cases >] ->
+		(el,(b,p1)) :: l , def
 	| [< >] ->
 		[] , None
 

transform.ml

@@ -60,9 +60,9 @@ let rec map f e =
 	| TIf (ec,e1,e2) ->
 		{ e with eexpr = TIf (f ec,f e1,match e2 with None -> None | Some e -> Some (f e)) }
 	| TSwitch (e1,cases,def) ->
-		{ e with eexpr = TSwitch (f e1, List.map (fun (e1,e2) -> f e1, f e2) cases, match def with None -> None | Some e -> Some (f e)) }
+		{ e with eexpr = TSwitch (f e1, List.map (fun (el,e2) -> List.map f el, f e2) cases, match def with None -> None | Some e -> Some (f e)) }
 	| TMatch (e1,t,cases,def) ->
-		{ e with eexpr = TMatch (f e1, t, List.map (fun (c,l,e) -> c, l, f e) cases, match def with None -> None | Some e -> Some (f e)) }
+		{ e with eexpr = TMatch (f e1, t, List.map (fun (cl,params,e) -> cl, params, f e) cases, match def with None -> None | Some e -> Some (f e)) }
 	| TTry (e1,catches) ->
 		{ e with eexpr = TTry (f e1, List.map (fun (v,t,e) -> v, t, f e) catches) }
 	| TReturn eo ->
@@ -159,7 +159,7 @@ let block_vars e =
 			{ e with eexpr = TTry (e,cases) }
 		| TMatch (e,t,cases,def) ->
 			let e = in_loop vars e in
-			let cases = List.map (fun (c,params,e) ->
+			let cases = List.map (fun (cl,params,e) ->
 				let e = (match params with
 					| None -> in_loop vars e
 					| Some l ->
@@ -170,7 +170,7 @@ let block_vars e =
 						) (!vars) l in
 						in_loop (ref new_vars) e
 				) in
-				c , params , e
+				cl , params, e
 			) cases in
 			let def = (match def with None -> None | Some e -> Some (in_loop vars e)) in
 			{ e with eexpr = TMatch (e, t, cases, def) }

type.ml

@@ -85,8 +85,8 @@ and texpr_expr =
 	| TFor of string * texpr * texpr
 	| TIf of texpr * texpr * texpr option
 	| TWhile of texpr * texpr * Ast.while_flag
-	| TSwitch of texpr * (texpr * texpr) list * texpr option
-	| TMatch of texpr * (tenum * tparams) * (string * (string option * t) list option * texpr) list * texpr option
+	| TSwitch of texpr * (texpr list * texpr) list * texpr option
+	| TMatch of texpr * (tenum * tparams) * (string list * (string option * t) list option * texpr) list * texpr option
 	| TTry of texpr * (string * t * texpr) list
 	| TReturn of texpr option
 	| TBreak
@@ -708,7 +708,7 @@ let rec iter f e =
 		(match e2 with None -> () | Some e -> f e)
 	| TSwitch (e,cases,def) ->
 		f e;
-		List.iter (fun (e1,e2) -> f e1; f e2) cases;
+		List.iter (fun (el,e2) -> List.iter f el; f e2) cases;
 		(match def with None -> () | Some e -> f e)
 	| TMatch (e,_,cases,def) ->
 		f e;

typer.ml

@@ -963,7 +963,7 @@ let check_assign ctx e =
 	| _ ->
 		error "Invalid assign" e.epos
 
-let type_matching ctx (enum,params) (e,p) ecases =
+let type_matching ctx (enum,params) (e,p) ecases first_case =
 	let invalid() = error "Invalid enum matching" p in
 	let needs n = error ("This constructor needs " ^ string_of_int n ^ " parameters") p in
 	let constr name =
@@ -998,7 +998,7 @@ let type_matching ctx (enum,params) (e,p) ecases =
 			| EConst (Ident "_") ->
 				None , t
 			| EConst (Ident name) | EConst (Type name) ->
-				let name = add_local ctx name t in
+				let name = (if first_case then add_local ctx name t else PMap.find name ctx.locals_map) in
 				Some name , t
 			| _ -> invalid()
 		) el args in
@@ -1322,7 +1322,7 @@ and type_switch ctx e cases def need_val p =
 	in
 	let enum = ref (match follow e.etype with
 		| TEnum (e,params) -> Some (e,params)
-		| TMono _ -> lookup_enum (List.map fst cases)
+		| TMono _ -> lookup_enum (List.concat (List.map fst cases))
 		| _ -> None
 	) in
 	let first = ref true in
@@ -1333,24 +1333,29 @@ and type_switch ctx e cases def need_val p =
 		unify ctx e.etype e1.etype e1.epos;
 		CExpr e1
 	in
-	let cases = List.map (fun (e1,e2) ->
+	let cases = List.map (fun (el,e2) ->
 		let locals = save_locals ctx in
-		let e1 = (match !enum with
-		| Some en -> 
-			(try 
-				CMatch (type_matching ctx en e1 ecases)
-			with
-				Error _ when !first ->
-					enum := None;
-					type_case e e1)
-		| None ->
-			type_case e e1
-		) in
-		first := false;
+		let first_case = ref true in
+		let el = List.map (fun e1 ->
+			let v = (match !enum with
+			| Some en -> 
+				(try 
+					CMatch (type_matching ctx en e1 ecases !first_case)
+				with
+					Error _ when !first ->
+						enum := None;
+						type_case e e1)
+			| None ->
+				type_case e e1
+			) in
+			first_case := false;
+			first := false;
+			v
+		) el in		
 		let e2 = type_expr ctx ~need_val e2 in
 		locals();
 		if need_val then unify ctx e2.etype t e2.epos;
-		(e1,e2)
+		(el,e2)
 	) cases in
 	let def = (match def with
 		| None ->
@@ -1370,26 +1375,48 @@ and type_switch ctx e cases def need_val p =
 			if need_val then unify ctx e.etype t e.epos;
 			Some e
 	) in
+	let same_params p1 p2 =
+		match p1, p2 with
+		| None , None -> true
+		| Some l1, Some l2 when List.length l1 = List.length l2 ->
+			List.for_all2 (fun (n1,t1) (n2,t2) ->
+				let ctx = print_context() in
+				Printf.eprintf "%s %s %s %s\n" (match n1 with None -> "_" | Some s -> s) (s_type ctx t1) (match n2 with None -> "_" | Some s -> s) (s_type ctx t2);
+				n1 = n2 && type_eq false t1 t2
+			) l1 l2
+		| _ ->
+			false
+	in
 	match !enum with
 	| None ->
-		let exprs (c,e) =
-			match c with
-			| CExpr c -> c , e
-			| _ -> assert false
+		let exprs (el,e) =
+			List.map (fun c ->
+				match c with
+				| CExpr c -> c 
+				| _ -> assert false
+			) el , e
 		in
 		mk (TSwitch (e,List.map exprs cases,def)) t p
 	| Some (en,enparams) ->
 		let has_params = ref false in
-		let matchs (c,e) =
-			match c with
-			| CMatch (c,p) ->
-				if p <> None then has_params := true;
-				(c,p,e)
-			| _ -> assert false
+		let matchs (el,e) =
+			match el with
+			| CMatch (c,params) :: l ->
+				let cl = List.map (fun c ->
+					match c with
+					| CMatch (c,p) ->
+						if not (same_params p params) then display_error ctx "Constructors parameters differs : should be same name, same type, and same position" e.epos;
+						c
+					| _ -> assert false
+				) l in
+				if params <> None then has_params := true;
+				(c :: cl) , params, e
+			| _ ->
+				assert false
 		in
-		let constructs (c,_,e) =
-			let c = mk (TField (mk (TTypeExpr (TEnumDecl en)) t_dynamic p , c)) (TEnum (en,enparams)) p in
-			(c,e)
+		let constructs (el,_,e) =
+			let cl = List.map (fun c -> mk (TField (mk (TTypeExpr (TEnumDecl en)) t_dynamic p , c)) (TEnum (en,enparams)) p) el in
+			(cl,e)
 		in
 		let cases = List.map matchs cases in
 		match !has_params with