changed TMatch.

git-svn-id: http://haxe.googlecode.com/svn/trunk@295 f16182fa-f095-11de-8f43-4547254af6c6

genneko.ml

@@ -217,37 +217,32 @@ and gen_expr e =
 		(EContinue,p)
 	| TThrow e ->
 		call p (builtin p "throw") [gen_expr e]
-	| TMatch _ ->
-		assert false
-	| TSwitch (e,cases,eo) ->
-		try
-			let l = List.map (fun (e,e2) -> match e.eexpr with TMatch (_,s,vl) -> (s,vl,e2) | _ -> raise Not_found) cases in
-			(ENext (
-				(EVars ["@tmp",Some (gen_expr e)],p),
-				(ESwitch (
-					(EArray (ident p "@tmp",int p 0),p),
-					List.map (fun (s,el,e2) ->
-						let count = ref 0 in
-						let e = match el with
-							| None -> gen_expr e2
-							| Some el ->
-								(EBlock [
-									(EVars (List.map (fun (v,_) -> incr count; v , Some (EArray (ident p "@tmp",int p (!count)),p)) el),p);
-									(gen_expr e2)
-								],p)
-						in
-						str p s , e
-					) l,
-					(match eo with None -> None | Some e -> Some (gen_expr e))
-				),p)
+	| TMatch (e,_,cases,eo) ->
+		(ENext (
+			(EVars ["@tmp",Some (gen_expr e)],p),
+			(ESwitch (
+				(EArray (ident p "@tmp",int p 0),p),
+				List.map (fun (s,el,e2) ->
+					let count = ref 0 in
+					let e = match el with
+						| None -> gen_expr e2
+						| Some el ->
+							(EBlock [
+								(EVars (List.map (fun (v,_) -> incr count; v , Some (EArray (ident p "@tmp",int p (!count)),p)) el),p);
+								(gen_expr e2)
+							],p)
+					in
+					str p s , e
+				) cases,
+				(match eo with None -> None | Some e -> Some (gen_expr e))
 			),p)
-		with
-			Not_found ->
-				(ESwitch (
-					gen_expr e,
-					List.map (fun (e1,e2) -> gen_expr e1, gen_expr e2) cases,
-					(match eo with None -> None | Some e -> Some (gen_expr e))
-				),p)
+		),p)
+	| TSwitch (e,cases,eo) ->
+		(ESwitch (
+			gen_expr e,
+			List.map (fun (e1,e2) -> gen_expr e1, gen_expr e2) cases,
+			(match eo with None -> None | Some e -> Some (gen_expr e))
+		),p)
 
 let gen_method p c acc =
 	match c.cf_expr with

genswf8.ml

@@ -609,27 +609,20 @@ and gen_match ctx retval e cases def =
 	write ctx AObjGet;
 	let rtag = alloc_reg ctx in
 	write ctx (ASetReg rtag);
-	let gen_match e x =
-		match e.eexpr with
-		| TMatch (e,constr,args) ->
-			push ctx [VStr constr];
-			write ctx APhysEqual;
-			args
-		| _ ->
-			assert false
-	in
 	let rec loop = function
 		| [] -> 
 			write ctx APop;
 			[]
-		| [(e,x)] ->
-			let args = gen_match e x in
-			[cjmp ctx,args,x]
-		| (e,x) :: l ->
-			let args = gen_match e x in
+		| [(constr,args,e)] ->
+			push ctx [VStr constr];
+			write ctx APhysEqual;
+			[cjmp ctx,args,e]
+		| (constr,args,e) :: l ->
+			push ctx [VStr constr];
+			write ctx APhysEqual;
 			let j = cjmp ctx in
 			push ctx [VReg rtag];
-			(j,args,x) :: loop l
+			(j,args,e) :: loop l
 	in
 	let dispatch = loop cases in
 	free_reg ctx rtag e.epos;
@@ -935,8 +928,7 @@ and gen_expr_2 ctx retval e =
 		push ctx [VStr (gen_type ctx c.cl_path c.cl_extern)];
 		new_call ctx VarStr nargs
 	| TSwitch (e,cases,def) ->
-		let is_enum = cases <> [] && List.for_all (fun (e,_) -> match e.eexpr with TMatch _ -> true | _ -> false) cases in
-		(if is_enum then gen_match else gen_switch) ctx retval e cases def
+		gen_switch ctx retval e cases def
 	| TThrow e ->
 		gen_expr ctx true e;
 		write ctx AThrow;
@@ -947,9 +939,8 @@ and gen_expr_2 ctx retval e =
 		gen_binop ctx retval op e1 e2
 	| TUnop (op,flag,e) ->
 		gen_unop ctx retval op flag e
-	| TMatch _ ->
-		(* done : only in switch *)
-		assert false
+	| TMatch (e,_,cases,def) ->
+		gen_match ctx retval e cases def
 	| TFor (v,it,e) ->
 		gen_expr ctx true it;
 		let r = alloc_reg ctx in

type.ml

@@ -58,18 +58,18 @@ and texpr_expr =
 	| TCall of texpr * texpr list
 	| TNew of tclass * t list * texpr list
 	| TUnop of Ast.unop * Ast.unop_flag * texpr
-	| TVars of (string * t * texpr option) list
 	| TFunction of tfunc
+	| TVars of (string * t * texpr option) list
 	| TBlock of texpr list
 	| 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 * t list) * (string * (string * t) list option * texpr) list * texpr option
 	| TTry of texpr * (string * t * texpr) list
 	| TReturn of texpr option
 	| TBreak
 	| TContinue
-	| TMatch of tenum * string * (string * t) list option
 	| TThrow of texpr
 
 and texpr = {
@@ -383,7 +383,6 @@ let rec iter f e =
 	| TEnumField _
 	| TBreak
 	| TContinue
-	| TMatch _
 	| TType _ ->
 		()
 	| TArray (e1,e2)
@@ -418,6 +417,10 @@ let rec iter f e =
 		f e;
 		List.iter (fun (e1,e2) -> f e1; f e2) cases;
 		(match def with None -> () | Some e -> f e)
+	| TMatch (e,_,cases,def) ->
+		f e;
+		List.iter (fun (_,_,e) -> f e) cases;
+		(match def with None -> () | Some e -> f e)
 	| TTry (e,catches) ->
 		f e;
 		List.iter (fun (_,_,e) -> f e) catches

typer.ml

@@ -46,6 +46,10 @@ type context = {
 (* ---------------------------------------------------------------------- *)
 (* TOOLS *)
 
+type switch_mode =
+	| CMatch of (string * (string * t) list option)
+	| CExpr of texpr
+
 type error_msg =
 	| Module_not_found of module_path
 	| Cannot_unify of t * t
@@ -479,8 +483,7 @@ let type_matching ctx (enum,params) (e,p) ecases =
 			| TEnum _ -> ()
 			| _ -> assert false
 		);
-		let t = TEnum (enum , params) in
-		mk (TMatch (enum,name,None)) t p 
+		(name,None)
 	| ECall ((EConst (Ident name),_),el) ->
 		let c = constr name in
 		let args = (match c.ef_type with
@@ -497,8 +500,7 @@ let type_matching ctx (enum,params) (e,p) ecases =
 				name , t
 			| _ -> invalid()
 		) el args in
-		let t = TEnum (enum, params) in
-		mk (TMatch (enum,name,Some idents)) t p 
+		(name,Some idents)
 	| _ ->
 		invalid()
 
@@ -664,9 +666,14 @@ and type_switch ctx e cases def need_val p =
 	let ecases = ref PMap.empty in
 	let cases = List.map (fun (e1,e2) ->
 		let locals = ctx.locals in
-		let e1 = (match enum with Some e -> type_matching ctx e e1 ecases | None -> type_expr ctx e1) in
-		(* this inversion is needed *)
-		unify ctx e.etype e1.etype e1.epos; 
+		let e1 = (match enum with 
+		| Some e -> CMatch (type_matching ctx e e1 ecases) 
+		| None -> 
+			let e1 = type_expr ctx e1 in
+			(* this inversion is needed *)
+			unify ctx e.etype e1.etype e1.epos; 
+			CExpr e1
+		) in
 		let e2 = type_expr ctx e2 in
 		ctx.locals <- locals;
 		if need_val then unify ctx e2.etype t e2.epos;
@@ -690,8 +697,21 @@ and type_switch ctx e cases def need_val p =
 			if need_val then unify ctx e.etype t e.epos;
 			Some e
 	) in
-	mk (TSwitch (e,cases,def)) t p
-
+	match enum with
+	| None -> 
+		let exprs (c,e) =
+			match c with
+			| CExpr c -> c , e
+			| _ -> assert false
+		in
+		mk (TSwitch (e,List.map exprs cases,def)) t p
+	| Some enum ->
+		let matchs (c,e) =
+			match c with
+			| CMatch (c,p) -> (c,p,e)
+			| _ -> assert false
+		in
+		mk (TMatch (e,enum,List.map matchs cases,def)) t p
 
 and type_expr ctx ?(need_val=true) (e,p) =
 	match e with
@@ -850,13 +870,13 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				unify ctx e.etype ctx.ret e.epos;
 				Some e , e.etype
 		) in
-		mk (TReturn e) (t_void ctx) p
+		mk (TReturn e) (mk_mono()) p
 	| EBreak ->
 		if not ctx.in_loop then error "Break outside loop" p;
-		mk TBreak (t_void ctx) p
+		mk TBreak (mk_mono()) p
 	| EContinue ->
 		if not ctx.in_loop then error "Continue outside loop" p;
-		mk TContinue (t_void ctx) p
+		mk TContinue (mk_mono()) p
 	| ETry (e1,catches) -> 
 		let e1 = type_expr ctx ~need_val e1 in
 		let catches = List.map (fun (v,t,e) ->
@@ -1393,8 +1413,9 @@ let types ctx main =
 		| TNew (c,_,_) ->
 			iter (walk_expr p) e;
 			loop_class p c
-		| TMatch (e,_,_) ->
-			loop_enum p e
+		| TMatch (_,(enum,_),_,_) ->
+			loop_enum p enum;
+			iter (walk_expr p) e
 		| TCall (f,_) ->
 			iter (walk_expr p) e;
 			(* static call for initializing a variable *)