added guard syntax

ast.ml

@@ -182,7 +182,7 @@ and expr_def =
 	| EIn of expr * expr
 	| EIf of expr * expr * expr option
 	| EWhile of expr * expr * while_flag
-	| ESwitch of expr * (expr list * expr) list * expr option
+	| ESwitch of expr * (expr list * expr option * expr) list * expr option
 	| ETry of expr * (string * complex_type * expr) list
 	| EReturn of expr option
 	| EBreak
@@ -533,7 +533,7 @@ let map_expr loop (e,p) =
 	| EIn (e1,e2) -> EIn (loop e1, loop e2)
 	| EIf (e,e1,e2) -> EIf (loop e, loop e1, opt loop e2)
 	| EWhile (econd,e,f) -> EWhile (loop econd, loop e, f)
-	| ESwitch (e,cases,def) -> ESwitch (loop e, List.map (fun (el,e) -> List.map loop el, loop e) cases, opt loop def)
+	| ESwitch (e,cases,def) -> ESwitch (loop e, List.map (fun (el,eg,e) -> List.map loop el, opt loop eg, loop e) cases, opt loop def)
 	| ETry (e, catches) -> ETry (loop e, List.map (fun (n,t,e) -> n,ctype t,loop e) catches)
 	| EReturn e -> EReturn (opt loop e)
 	| EBreak -> EBreak
@@ -777,8 +777,8 @@ let reify in_macro =
 		| EWhile (e1,e2,flag) ->
 			expr "EWhile" [loop e1;loop e2;to_bool (flag = NormalWhile) p]
 		| ESwitch (e1,cases,def) ->
-			let scase (el,e) p =
-				to_obj [("values",to_expr_array el p);"expr",loop e] p
+			let scase (el,eg,e) p =
+				to_obj [("values",to_expr_array el p);"guard",to_opt to_expr eg p;"expr",loop e] p
 			in
 			expr "ESwitch" [loop e1;to_array scase cases p;to_opt to_expr def p]
 		| ETry (e1,catches) ->

interp.ml

@@ -3639,9 +3639,10 @@ and encode_expr e =
 			| EWhile (econd,e,flag) ->
 				16, [loop econd;loop e;VBool (match flag with NormalWhile -> true | DoWhile -> false)]
 			| ESwitch (e,cases,eopt) ->
-				17, [loop e;enc_array (List.map (fun (ecl,e) ->
+				17, [loop e;enc_array (List.map (fun (ecl,eg,e) ->
 					enc_obj [
 						"values",enc_array (List.map loop ecl);
+						"guard",null loop eg;
 						"expr",loop e
 					]
 				) cases);null loop eopt]
@@ -3899,7 +3900,7 @@ let decode_expr v =
 			EWhile (loop e1,loop e2,if flag then NormalWhile else DoWhile)
 		| 17, [e;cases;eo] ->
 			let cases = List.map (fun c ->
-				(List.map loop (dec_array (field c "values")),loop (field c "expr"))
+				(List.map loop (dec_array (field c "values")),opt loop (field c "guard"),loop (field c "expr"))
 			) (dec_array cases) in
 			ESwitch (loop e,cases,opt loop eo)
 		| 18, [e;catches] ->
@@ -4378,7 +4379,7 @@ let rec make_ast e =
 		EFor (ein,make_ast e)
 	| TIf (e,e1,e2) -> EIf (make_ast e,make_ast e1,eopt e2)
 	| TWhile (e1,e2,flag) -> EWhile (make_ast e1, make_ast e2, flag)
-	| TSwitch (e,cases,def) -> ESwitch (make_ast e,List.map (fun (vl,e) -> List.map make_ast vl, make_ast e) cases,eopt def)
+	| TSwitch (e,cases,def) -> ESwitch (make_ast e,List.map (fun (vl,e) -> List.map make_ast vl, None,make_ast e) cases,eopt def)
 	| TMatch (e,(en,_),cases,def) ->
 		let scases (idx,args,e) =
 			let p = e.epos in
@@ -4398,7 +4399,7 @@ let rec make_ast e =
 				let cfield = (try PMap.find c en.e_constrs with Not_found -> assert false) in
 				let c = (EConst (Ident c),p) in
 				(match follow cfield.ef_type with TFun (eargs,_) -> (ECall (c,mk_args (List.length eargs)),p) | _ -> c)
-			) idx, make_ast e
+			) idx, None, make_ast e
 		in
 		ESwitch (make_ast e,List.map scases cases,eopt def)
 	| TTry (e,catches) -> ETry (make_ast e,List.map (fun (v,e) -> v.v_name, (try make_type v.v_type with Exit -> assert false), make_ast e) catches)

matcher.ml

@@ -832,7 +832,7 @@ and to_typed_ast ctx need_val (dt : decision_tree) : texpr =
 let match_expr ctx e cases def need_val with_type p =
 	let cases = match cases,def with
 		| [],None -> error "Empty switch" p
-		| cases,Some def -> cases @ [[(EConst(Ident "_")),pos def],def]
+		| cases,Some def -> cases @ [[(EConst(Ident "_")),pos def],None,def]
 		| _ -> cases
 	in
 	let evals = match fst e with
@@ -864,12 +864,8 @@ let match_expr ctx e cases def need_val with_type p =
 	} in
 	let v_evals = List.map (fun e -> gen_local ctx e.etype) evals in
 	(* 1. turn case expressions to patterns *)
-	let patterns = List.map (fun (el,e) ->
+	let patterns = List.map (fun (el,eg,e) ->
 		let epat = collapse_case el in
-		let epat,guard = match fst epat with
-			| EIn(e1,e2) -> e1, Some e2
-			| _ -> epat,None
-		in
 		let save = save_locals ctx in
 		let pat = match fst epat,evals with
 			| EArrayDecl el,[eval] when (match follow eval.etype with TInst({cl_path=[],"Array"},[_]) -> true | _ -> false) ->
@@ -882,7 +878,7 @@ let match_expr ctx e cases def need_val with_type p =
 			| _,_ -> [to_pattern ctx epat (List.hd evals).etype]
 		in		
 		let e = type_expr ctx e need_val in
-		let guard = match guard with
+		let eg = match eg with
 			| None -> None
 			| Some e ->
 				let e = type_expr ctx e need_val in
@@ -890,7 +886,7 @@ let match_expr ctx e cases def need_val with_type p =
 				Some e
 		in
 		save();
-		let out = mk_outcome mctx e guard pat in
+		let out = mk_outcome mctx e eg pat in
 		(pat,out)
 	) cases in
 	if Common.defined ctx.com Common.Define.MatchDebug then print_endline (s_pattern_matrix patterns);

optimizer.ml

@@ -977,7 +977,7 @@ let optimize_completion_expr e =
 			map e
 		| ESwitch (e,cases,def) ->
 			let e = loop e in
-			let cases = List.map (fun (el,e) ->
+			let cases = List.map (fun (el,eg,e) ->
 				let el = List.map loop el in
 				let old = save() in
 				List.iter (fun e ->
@@ -992,7 +992,7 @@ let optimize_completion_expr e =
 				) el;
 				let e = loop e in
 				old();
-				el, e
+				el, eg, e
 			) cases in
 			let def = (match def with None -> None | Some e -> Some (loop e)) in
 			(ESwitch (e,cases,def),p)

parser.ml

@@ -858,15 +858,19 @@ and expr_next e1 = parser
 		(EIn (e1,e2), punion (pos e1) (pos e2))
 	| [< >] -> e1
 
+and parse_guard = parser
+	| [< '(Kwd If,p1); '(POpen,_); e = expr; '(PClose,_); >] ->
+		e
+
 and parse_switch_cases eswitch cases = parser
 	| [< '(Kwd Default,p1); '(DblDot,_); s >] ->
 		let b = EBlock (try block [] s with Display e -> display (ESwitch (eswitch,cases,Some e),punion (pos eswitch) (pos e))) in
 		let l , def = parse_switch_cases eswitch cases s in
 		(match def with None -> () | Some (e,p) -> error Duplicate_default p);
 		l , Some (b,p1)
-	| [< '(Kwd Case,p1); el = psep Comma expr; '(DblDot,_); s >] ->
-		let b = EBlock (try block [] s with Display e -> display (ESwitch (eswitch,List.rev ((el,e) :: cases),None),punion (pos eswitch) (pos e))) in
-		parse_switch_cases eswitch ((el,(b,p1)) :: cases) s
+	| [< '(Kwd Case,p1); el = psep Comma expr; eg = popt parse_guard; '(DblDot,_); s >] ->
+		let b = EBlock (try block [] s with Display e -> display (ESwitch (eswitch,List.rev ((el,eg,e) :: cases),None),punion (pos eswitch) (pos e))) in
+		parse_switch_cases eswitch ((el,eg,(b,p1)) :: cases) s
 	| [< >] ->
 		List.rev cases , None
 

std/haxe/macro/Expr.hx

@@ -88,6 +88,12 @@ typedef ExprRequire<T> = Expr;
 
 typedef ExprOf<T> = Expr;
 
+typedef Case = {
+	var values : Array<Expr>;
+	@:optional var guard : Null<Expr>;
+	var expr: Expr;
+}
+
 enum ExprDef {
 	EConst( c : Constant );
 	EArray( e1 : Expr, e2 : Expr );
@@ -106,7 +112,7 @@ enum ExprDef {
 	EIn( e1 : Expr, e2 : Expr );
 	EIf( econd : Expr, eif : Expr, eelse : Null<Expr> );
 	EWhile( econd : Expr, e : Expr, normalWhile : Bool );
-	ESwitch( e : Expr, cases : Array<{ values : Array<Expr>, expr : Expr }>, edef : Null<Expr> );
+	ESwitch( e : Expr, cases : Array<Case>, edef : Null<Expr> );
 	ETry( e : Expr, catches : Array<{ name : String, type : ComplexType, expr : Expr }> );
 	EReturn( ?e : Null<Expr> );
 	EBreak;

tests/unit/Test.hx

@@ -227,7 +227,7 @@ package unit;
 			new TestType(),
 			new TestOrder(),
 			new TestStringTools(),
-			#if pattern_matching
+			#if !no_pattern_matching
 			new TestMatch(),
 			#end
 			#if cs

tests/unit/TestMatch.hx

@@ -72,7 +72,7 @@ class TestMatch extends Test {
 			case ["b"]: "2";
 			case [a]: "3:" + a;
 			case [a, b]: "4:" + a + "," +b;
-			case a in a.length == 3: "5:" + a.length;
+			case a if (a.length == 3): "5:" + a.length;
 			case []: "6";
 			case _: "7";
 		}		
@@ -98,11 +98,11 @@ class TestMatch extends Test {
 	
 	static function switchGuard(e:Expr):String {
 		return switch(e.expr) {
-			case EConst(CString(s)) in StringTools.startsWith(s, "foo"):
+			case EConst(CString(s)) if (StringTools.startsWith(s, "foo")):
 				"1";
-			case EConst(CString(s)) in StringTools.startsWith(s, "bar"):
+			case EConst(CString(s)) if (StringTools.startsWith(s, "bar")):
 				"2";
-			case EConst(CInt(i)) in switch(Std.parseInt(i) * 2) { case 4: true; case _: false; } :
+			case EConst(CInt(i)) if (switch(Std.parseInt(i) * 2) { case 4: true; case _: false; }):
 				"3";
 			case EConst(_):
 				"4";
@@ -203,8 +203,8 @@ class TestMatch extends Test {
 	
 	public static function toStringX<Z>(x1:X<Z>) {
 		return switch (x1) {
-			case U1(x) in x > 1: ">1";
-			case U1(x) in x <= 1: "<=1";
+			case U1(x) if (x > 1): ">1";
+			case U1(x) if (x <= 1): "<=1";
 			case U1(_): throw "this is impossible to reach actually";
 			case U2: "U2";
 		}
@@ -237,7 +237,7 @@ class TestMatch extends Test {
 		}));
 		eq("This match is not exhaustive, these patterns are not matched: Leaf(_)", getErrorMessage(switch(Leaf("foo")) {
 			case Node(_, _):
-			case Leaf(_) in false:
+			case Leaf(_) if (false):
 		}));
 	}
 	

typecore.ml

@@ -123,7 +123,7 @@ exception Error of error_msg * pos
 let type_expr_ref : (typer -> Ast.expr -> bool -> texpr) ref = ref (fun _ _ _ -> assert false)
 let unify_min_ref : (typer -> texpr list -> t) ref = ref (fun _ _ -> assert false)
 let type_expr_with_type_ref : (typer -> Ast.expr -> t option -> bool -> texpr) ref = ref (fun _ _ _ -> assert false)
-let match_expr_ref : (typer -> Ast.expr -> (Ast.expr list * Ast.expr) list -> Ast.expr option -> bool -> t option -> Ast.pos -> texpr) ref = ref (fun _ _ _ _ _ _ _ -> assert false)
+let match_expr_ref : (typer -> Ast.expr -> (Ast.expr list * Ast.expr option * Ast.expr) list -> Ast.expr option -> bool -> t option -> Ast.pos -> texpr) ref = ref (fun _ _ _ _ _ _ _ -> assert false)
 
 let short_type ctx t =
 	let tstr = s_type ctx t in

typer.ml

@@ -1600,7 +1600,7 @@ and type_switch ctx e cases def need_val with_type p =
 		if (Common.defined ctx.com Common.Define.NoPatternMatching) then raise Exit;
 		match_expr ctx e cases def need_val with_type p
 	with Exit ->
-		type_switch_old ctx e cases def need_val with_type p
+		type_switch_old ctx e (List.map (fun (cl,_,e) -> cl,e) cases) def need_val with_type p
 
 and type_ident ctx i p mode =
 	try