perform dt -> ast conversion earlier

codegen.ml

@@ -1542,39 +1542,12 @@ module PatternMatchConversion = struct
 
  	type cctx = {
 		ctx : typer;
-		mutable eval_stack : ((tvar * pos) * st) list list;
+		mutable eval_stack : ((tvar * pos) * texpr) list list;
 		dt_lookup : dt array;
 		ttype : tclass;
 	}
 
-	let mk_const ctx p = function
-		| TString s -> mk (TConst (TString s)) ctx.com.basic.tstring p
-		| TInt i -> mk (TConst (TInt i)) ctx.com.basic.tint p
-		| TFloat f -> mk (TConst (TFloat f)) ctx.com.basic.tfloat p
-		| TBool b -> mk (TConst (TBool b)) ctx.com.basic.tbool p
-		| TNull -> mk (TConst TNull) (ctx.com.basic.tnull (mk_mono())) p
-		| _ -> error "Unsupported constant" p
-
-	let rec convert_st cctx st = match st.st_def with
-		| SVar v -> mk (TLocal v) v.v_type st.st_pos
-		| SField (sts,f) ->
-			let e = convert_st cctx sts in
-			let fa = try quick_field e.etype f with Not_found -> FDynamic f in
-			mk (TField(e,fa)) st.st_type st.st_pos
-		| SArray (sts,i) -> mk (TArray(convert_st cctx sts,mk_const cctx.ctx st.st_pos (TInt (Int32.of_int i)))) st.st_type st.st_pos
-		| STuple (st,_,_) -> convert_st cctx st
-		| SEnum(sts,ef,i) -> mk (TField(convert_st cctx sts, FEnumParameter(ef,i))) st.st_type st.st_pos
-
-	let convert_con cctx con = match con.c_def with
-		| CConst c -> mk_const cctx.ctx con.c_pos c
-		| CType mt -> mk (TTypeExpr mt) t_dynamic con.c_pos
-		| CExpr e -> e
-		| CEnum(e,ef) -> mk_const cctx.ctx con.c_pos (TInt (Int32.of_int ef.ef_index))
-		| CArray i -> mk_const cctx.ctx con.c_pos (TInt (Int32.of_int i))
-		| CAny -> assert false
-		| CFields _ -> assert false
-
-	let replace_locals stack f e =
+	let replace_locals stack e =
 		let replace v =
 			let rec loop vl = match vl with
 				| vl :: vll -> (try snd (List.find (fun ((v2,_),st) -> v2 == v) vl) with Not_found -> loop vll)
@@ -1585,9 +1558,9 @@ module PatternMatchConversion = struct
 		let rec loop e = match e.eexpr with
 			| TLocal v ->
 				begin try
-					let st = replace v in
-					Type.unify e.etype st.st_type;
-					f st;
+					let e2 = replace v in
+					Type.unify e.etype e2.etype;
+					e2
 				with Not_found -> e end
 			| _ -> Type.map_expr loop e
 		in
@@ -1595,7 +1568,7 @@ module PatternMatchConversion = struct
 
 	let group_cases cases =
 		let dt_eq dt1 dt2 = match dt1,dt2 with
-			| Goto i1, Goto i2 when i1 = i2 -> true
+			| DTGoto i1, DTGoto i2 when i1 = i2 -> true
 			(* TODO equal bindings *)
 			| _ -> false
 		in
@@ -1615,21 +1588,20 @@ module PatternMatchConversion = struct
 
 	let rec convert_dt cctx dt =
 		match dt with
-		| Bind (bl,dt) ->
+		| DTBind (bl,dt) ->
 			cctx.eval_stack <- bl :: cctx.eval_stack;
 			let e = convert_dt cctx dt in
 			cctx.eval_stack <- List.tl cctx.eval_stack;
 			e
-		| Goto i ->
+		| DTGoto i ->
 			convert_dt cctx (cctx.dt_lookup.(i))
-		| Expr e ->
-			replace_locals cctx.eval_stack (convert_st cctx) e
-		| Guard(e,dt1,dt2) ->
+		| DTExpr e ->
+			replace_locals cctx.eval_stack e
+		| DTGuard(e,dt1,dt2) ->
 			let ethen = convert_dt cctx dt1 in
-			mk (TIf(replace_locals cctx.eval_stack (convert_st cctx) e,ethen,match dt2 with None -> None | Some dt -> Some (convert_dt cctx dt))) ethen.etype (punion e.epos ethen.epos)
-		| Switch(st,cl) ->
-			let p = st.st_pos in
-			let e_st = convert_st cctx st in
+			mk (TIf(replace_locals cctx.eval_stack e,ethen,match dt2 with None -> None | Some dt -> Some (convert_dt cctx dt))) ethen.etype (punion e.epos ethen.epos)
+		| DTSwitch(e_st,cl) ->
+			let p = e_st.epos in
 			let mk_index_call () =
 				let cf = PMap.find "enumIndex" cctx.ttype.cl_statics in
 				let ec = (!type_module_type_ref) cctx.ctx (TClassDecl cctx.ttype) None p in
@@ -1637,7 +1609,7 @@ module PatternMatchConversion = struct
 				(* make_call cctx.ctx ef [e_st] cctx.ctx.t.tint p,true *)
 				mk (TCall (ef,[e_st])) cctx.ctx.t.tint p,true
 			in
-			let e_subject,exh = match follow st.st_type with
+			let e_subject,exh = match follow e_st.etype with
 				| TEnum(_) ->
 					mk_index_call ()
 				| TAbstract(a,pl) when (match Abstract.get_underlying_type a pl with TEnum(_) -> true | _ -> false) ->
@@ -1649,19 +1621,19 @@ module PatternMatchConversion = struct
 			in
 			let def = ref None in
 			let null = ref None in
-			let cases = List.filter (fun (con,dt) ->
-				match con.c_def with
-				| CAny ->
+			let cases = List.filter (fun (e,dt) ->
+ 				match e.eexpr with
+ 				| TConst (TString "_") ->
 					def := Some (convert_dt cctx dt);
 					false
-				| CConst (TNull) ->
+				| TConst (TNull) ->
 					null := Some (convert_dt cctx dt);
 					false
 				| _ ->
 					true
 			) cl in
 			let cases = group_cases cases in
-			let cases = List.map (fun (cl,dt) -> List.map (convert_con cctx) cl,convert_dt cctx dt) cases in
+			let cases = List.map (fun (cl,dt) -> cl,convert_dt cctx dt) cases in
 			let e_subject = if exh then mk (TMeta((Meta.Exhaustive,[],p), e_subject)) e_subject.etype e_subject.epos else e_subject in
 			let e = mk (TSwitch(e_subject,cases,!def)) (mk_mono()) (p) in
 			match !null with

common.ml

@@ -483,7 +483,7 @@ let get_config com =
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
 			pf_overload = false;
-			pf_pattern_matching = true;
+			pf_pattern_matching = false;
 		}
 	| Flash when defined Define.As3 ->
 		{

genneko.ml

@@ -422,7 +422,7 @@ and gen_expr ctx e =
 					) (match eo with None -> null p | Some e -> (gen_expr ctx e)) (List.rev cases)
 				],p)
 		)
-	| TPatMatch dt ->
+(* 	| TPatMatch dt ->
 		let num_labels = Array.length dt.dt_dt_lookup in
 		let lc = ctx.label_count in
 		ctx.label_count <- ctx.label_count + num_labels + 1;
@@ -528,7 +528,7 @@ and gen_expr ctx e =
 			| el, vl -> ("@state",Some (EObject vl,p)) :: el
 		in
 		let el = match init with [] -> (goto dt.dt_first) :: el | _ -> (EVars init,p) :: (goto dt.dt_first) :: el in
-		EBlock el,p
+		EBlock el,p *)
 	| TSwitch (e,cases,eo) ->
 		let e = gen_expr ctx e in
 		let eo = (match eo with None -> None | Some e -> Some (gen_expr ctx e)) in

matcher.ml

@@ -27,6 +27,41 @@ open Typecore
 
 type pvar = tvar * pos
 
+type con_def =
+	| CEnum of tenum * tenum_field
+	| CConst of tconstant
+	| CAny
+	| CType of module_type
+	| CArray of int
+	| CFields of int * (string * tclass_field) list
+	| CExpr of texpr
+
+and con = {
+	c_def : con_def;
+	c_type : t;
+	c_pos : pos;
+}
+
+and st_def =
+	| SVar of tvar
+	| SField of st * string
+	| SEnum of st * tenum_field * int
+	| SArray of st * int
+	| STuple of st * int * int
+
+and st = {
+	st_def : st_def;
+	st_type : t;
+	st_pos : pos;
+}
+
+and dt =
+	| Switch of st * (con * dt) list
+	| Bind of ((tvar * pos) * st) list * dt
+	| Goto of int
+	| Expr of texpr
+	| Guard of texpr * dt * dt option
+
 (* Pattern *)
 
 type pat_def =
@@ -173,6 +208,15 @@ let get_tuple_types t = match t with
 
 let s_type = s_type (print_context())
 
+let rec s_con con = match con.c_def with
+	| CEnum(_,ef) -> ef.ef_name
+	| CAny -> "_"
+	| CConst c -> s_const c
+	| CType mt -> s_type_path (t_path mt)
+	| CArray i -> "[" ^(string_of_int i) ^ "]"
+	| CFields (_,fl) -> String.concat "," (List.map (fun (s,_) -> s) fl)
+	| CExpr e -> s_expr s_type e
+
 let rec s_pat pat = match pat.p_def with
 	| PVar (v,_) -> v.v_name
 	| PCon (c,[]) -> s_con c
@@ -188,6 +232,19 @@ let rec s_pat_vec pl =
 let rec s_pat_matrix pmat =
 	String.concat "\n" (List.map (fun (pl,out) -> (s_pat_vec pl) ^ "->" ^ "") pmat)
 
+let st_args l r v =
+	(if l > 0 then (String.concat "," (ExtList.List.make l "_")) ^ "," else "")
+	^ v ^
+	(if r > 0 then "," ^ (String.concat "," (ExtList.List.make r "_")) else "")
+
+let rec s_st st =
+	(match st.st_def with
+	| SVar v -> v.v_name
+	| SEnum (st,ef,i) -> s_st st ^ "." ^ ef.ef_name ^ "." ^ (string_of_int i)
+	| SArray (st,i) -> s_st st ^ "[" ^ (string_of_int i) ^ "]"
+	| STuple (st,i,a) -> "(" ^ (st_args i (a - i - 1) (s_st st)) ^ ")"
+	| SField (st,n) -> s_st st ^ "." ^ n)
+
 (* Pattern parsing *)
 
 let unify_enum_field en pl ef t =
@@ -818,6 +875,33 @@ let rec collapse_case el = match el with
 	| [] ->
 		assert false
 
+let mk_const ctx p = function
+	| TString s -> mk (TConst (TString s)) ctx.com.basic.tstring p
+	| TInt i -> mk (TConst (TInt i)) ctx.com.basic.tint p
+	| TFloat f -> mk (TConst (TFloat f)) ctx.com.basic.tfloat p
+	| TBool b -> mk (TConst (TBool b)) ctx.com.basic.tbool p
+	| TNull -> mk (TConst TNull) (ctx.com.basic.tnull (mk_mono())) p
+	| _ -> error "Unsupported constant" p
+
+let rec convert_st ctx st = match st.st_def with
+	| SVar v -> mk (TLocal v) v.v_type st.st_pos
+	| SField (sts,f) ->
+		let e = convert_st ctx sts in
+		let fa = try quick_field e.etype f with Not_found -> FDynamic f in
+		mk (TField(e,fa)) st.st_type st.st_pos
+	| SArray (sts,i) -> mk (TArray(convert_st ctx sts,mk_const ctx st.st_pos (TInt (Int32.of_int i)))) st.st_type st.st_pos
+	| STuple (st,_,_) -> convert_st ctx st
+	| SEnum(sts,ef,i) -> mk (TField(convert_st ctx sts, FEnumParameter(ef,i))) st.st_type st.st_pos
+
+let convert_con ctx con = match con.c_def with
+	| CConst c -> mk_const ctx con.c_pos c
+	| CType mt -> mk (TTypeExpr mt) t_dynamic con.c_pos
+	| CExpr e -> e
+	| CEnum(e,ef) -> mk_const ctx con.c_pos (TInt (Int32.of_int ef.ef_index))
+	| CArray i -> mk_const ctx con.c_pos (TInt (Int32.of_int i))
+	| CAny -> mk (TConst (TString "_")) (mk_mono()) con.c_pos
+	| CFields _ -> assert false
+
 (* Decision tree compilation *)
 
 let match_expr ctx e cases def with_type p =
@@ -1060,11 +1144,11 @@ let match_expr ctx e cases def with_type p =
 	loop 0 0;
 	(* reindex *)
 	let rec loop dt = match dt with
-		| Goto i -> if usage.(i) > 1 then Goto (map.(i)) else loop (DynArray.get mctx.dt_lut i)
-		| Switch(st,cl) -> Switch(st, List.map (fun (c,dt) -> c, loop dt) cl)
-		| Bind(bl,dt) -> Bind(bl,loop dt)
-		| Expr e -> Expr e
-		| Guard(e,dt1,dt2) -> Guard(e,loop dt1, match dt2 with None -> None | Some dt -> Some (loop dt))
+		| Goto i -> if usage.(i) > 1 then DTGoto (map.(i)) else loop (DynArray.get mctx.dt_lut i)
+		| Switch(st,cl) -> DTSwitch(convert_st ctx st, List.map (fun (c,dt) -> convert_con ctx c, loop dt) cl)
+		| Bind(bl,dt) -> DTBind(List.map (fun (v,st) -> v,convert_st ctx st) bl,loop dt)
+		| Expr e -> DTExpr e
+		| Guard(e,dt1,dt2) -> DTGuard(e,loop dt1, match dt2 with None -> None | Some dt -> Some (loop dt))
 	in
 	let lut = DynArray.map loop lut in
 	{

type.ml

@@ -292,40 +292,12 @@ and module_kind =
 	| MMacro
 	| MFake
 
-and con_def =
-	| CEnum of tenum * tenum_field
-	| CConst of tconstant
-	| CAny
-	| CType of module_type
-	| CArray of int
-	| CFields of int * (string * tclass_field) list
-	| CExpr of texpr
-
-and con = {
-	c_def : con_def;
-	c_type : t;
-	c_pos : pos;
-}
-
-and st_def =
-	| SVar of tvar
-	| SField of st * string
-	| SEnum of st * tenum_field * int
-	| SArray of st * int
-	| STuple of st * int * int
-
-and st = {
-	st_def : st_def;
-	st_type : t;
-	st_pos : pos;
-}
-
 and dt =
-	| Switch of st * (con * dt) list
-	| Bind of ((tvar * pos) * st) list * dt
-	| Goto of int
-	| Expr of texpr
-	| Guard of texpr * dt * dt option
+	| DTSwitch of texpr * (texpr * dt) list
+	| DTBind of ((tvar * pos) * texpr) list * dt
+	| DTGoto of int
+	| DTExpr of texpr
+	| DTGuard of texpr * dt * dt option
 
 and decision_tree = {
 	dt_dt_lookup : dt array;
@@ -1361,11 +1333,11 @@ let iter f e =
 		(match def with None -> () | Some e -> f e)
 	| TPatMatch dt ->
 		let rec loop dt = match dt with
-			| Bind(_,dt) -> loop dt
-			| Goto _ -> ()
-			| Switch(_,cl) -> List.iter (fun (_,dt) -> loop dt) cl
-			| Expr e -> f e
-			| Guard(eg,dt1,dt2) ->
+			| DTBind(_,dt) -> loop dt
+			| DTGoto _ -> ()
+			| DTSwitch(_,cl) -> List.iter (fun (_,dt) -> loop dt) cl
+			| DTExpr e -> f e
+			| DTGuard(eg,dt1,dt2) ->
 				f eg;
 				loop dt1;
 				(match dt2 with None -> () | Some dt -> loop dt)
@@ -1424,11 +1396,11 @@ let map_expr 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)) }
 	| TPatMatch dt ->
 		let rec loop dt = match dt with
-			| Bind(vl,dt) -> Bind(vl, loop dt)
-			| Goto _ -> dt
-			| Switch(st,cl) -> Switch(st, List.map (fun (c,dt) -> c,loop dt) cl)
-			| Expr e -> Expr(f e)
-			| Guard(e,dt1,dt2) -> Guard(f e,loop dt1,match dt2 with None -> None | Some dt -> Some (loop dt))
+			| DTBind(vl,dt) -> DTBind(vl, loop dt)
+			| DTGoto _ -> dt
+			| DTSwitch(st,cl) -> DTSwitch(st, List.map (fun (c,dt) -> c,loop dt) cl)
+			| DTExpr e -> DTExpr(f e)
+			| DTGuard(e,dt1,dt2) -> DTGuard(f e,loop dt1,match dt2 with None -> None | Some dt -> Some (loop dt))
 		in
 		let vi = List.map (fun (v,eo) -> v, match eo with None -> None | Some e -> Some(f e)) dt.dt_var_init in
 		{ e with eexpr = TPatMatch({dt with dt_dt_lookup = Array.map loop dt.dt_dt_lookup; dt_var_init = vi})}
@@ -1503,11 +1475,11 @@ let map_expr_type f ft fv e =
 		{ e with eexpr = TMatch (f e1, (en,List.map ft pl), List.map map_case cases, match def with None -> None | Some e -> Some (f e)); etype = ft e.etype }
 	| TPatMatch dt ->
 		let rec loop dt = match dt with
-			| Bind(vl,dt) -> Bind(vl, loop dt)
-			| Goto _ -> dt
-			| Switch(st,cl) -> Switch(st, List.map (fun (c,dt) -> c,loop dt) cl)
-			| Expr e -> Expr(f e)
-			| Guard (e,dt1,dt2) -> Guard(f e, loop dt, match dt2 with None -> None | Some dt -> Some (loop dt))
+			| DTBind(vl,dt) -> DTBind(vl, loop dt)
+			| DTGoto _ -> dt
+			| DTSwitch(st,cl) -> DTSwitch(st, List.map (fun (c,dt) -> c,loop dt) cl)
+			| DTExpr e -> DTExpr(f e)
+			| DTGuard (e,dt1,dt2) -> DTGuard(f e, loop dt, match dt2 with None -> None | Some dt -> Some (loop dt))
 		in
 		let vi = List.map (fun (v,eo) -> v, match eo with None -> None | Some e -> Some(f e)) dt.dt_var_init in
 		{ e with eexpr = TPatMatch({dt with dt_dt_lookup = Array.map loop dt.dt_dt_lookup; dt_var_init = vi}); etype = ft e.etype}
@@ -1560,44 +1532,7 @@ let s_const = function
 	| TThis -> "this"
 	| TSuper -> "super"
 
-let rec s_con con = match con.c_def with
-	| CEnum(_,ef) -> ef.ef_name
-	| CAny -> "_"
-	| CConst c -> s_const c
-	| CType mt -> s_type_path (t_path mt)
-	| CArray i -> "[" ^(string_of_int i) ^ "]"
-	| CFields (_,fl) -> String.concat "," (List.map (fun (s,_) -> s) fl)
-	| CExpr e -> s_expr (s_type (print_context())) e
-
-and st_args l r v =
-	(if l > 0 then (String.concat "," (ExtList.List.make l "_")) ^ "," else "")
-	^ v ^
-	(if r > 0 then "," ^ (String.concat "," (ExtList.List.make r "_")) else "")
-
-and s_dt tabs tree =
-	let s_type = s_type (print_context()) in
-	let rec s_st st =
-		(match st.st_def with
-		| SVar v -> v.v_name
-		| SEnum (st,ef,i) -> s_st st ^ "." ^ ef.ef_name ^ "." ^ (string_of_int i)
-		| SArray (st,i) -> s_st st ^ "[" ^ (string_of_int i) ^ "]"
-		| STuple (st,i,a) -> "(" ^ (st_args i (a - i - 1) (s_st st)) ^ ")"
-		| SField (st,n) -> s_st st ^ "." ^ n)
-	in
-	tabs ^ match tree with
-	| Switch (st, cl) ->
-		"switch(" ^ (s_st st) ^ ") { \n" ^ tabs
-		^ (String.concat ("\n" ^ tabs) (List.map (fun (c,dt) ->
-			"case " ^ (s_con c) ^ ":\n" ^ (s_dt (tabs ^ "\t") dt)
-		) cl))
-		^ "\n" ^ (if String.length tabs = 0 then "" else (String.sub tabs 0 (String.length tabs - 1))) ^ "}"
-	| Bind (bl, dt) -> "bind " ^ (String.concat "," (List.map (fun ((v,_),st) -> v.v_name ^ "(" ^ (string_of_int v.v_id) ^ ") =" ^ (s_st st)) bl)) ^ "\n" ^ (s_dt tabs dt)
-	| Goto i ->
-		"goto " ^ (string_of_int i)
-	| Expr e -> s_expr s_type e
-	| Guard (e,dt1,dt2) -> "if(" ^ (s_expr s_type e) ^ ") " ^ (s_dt tabs dt1) ^ (match dt2 with None -> "" | Some dt -> " else " ^ (s_dt tabs dt))
-
-and s_expr s_type e =
+let rec s_expr s_type e =
 	let sprintf = Printf.sprintf in
 	let slist f l = String.concat "," (List.map f l) in
 	let loop = s_expr s_type in
@@ -1679,6 +1614,21 @@ and s_expr s_type e =
 	) in
 	sprintf "(%s : %s)" str (s_type e.etype)
 
+and s_dt tabs tree =
+	let s_type = s_type (print_context()) in
+	tabs ^ match tree with
+	| DTSwitch (st, cl) ->
+		"switch(" ^ (s_expr s_type st) ^ ") { \n" ^ tabs
+		^ (String.concat ("\n" ^ tabs) (List.map (fun (c,dt) ->
+			"case " ^ (s_expr s_type c) ^ ":\n" ^ (s_dt (tabs ^ "\t") dt)
+		) cl))
+		^ "\n" ^ (if String.length tabs = 0 then "" else (String.sub tabs 0 (String.length tabs - 1))) ^ "}"
+	| DTBind (bl, dt) -> "bind " ^ (String.concat "," (List.map (fun ((v,_),st) -> v.v_name ^ "(" ^ (string_of_int v.v_id) ^ ") =" ^ (s_expr s_type st)) bl)) ^ "\n" ^ (s_dt tabs dt)
+	| DTGoto i ->
+		"goto " ^ (string_of_int i)
+	| DTExpr e -> s_expr s_type e
+	| DTGuard (e,dt1,dt2) -> "if(" ^ (s_expr s_type e) ^ ") " ^ (s_dt tabs dt1) ^ (match dt2 with None -> "" | Some dt -> " else " ^ (s_dt tabs dt))
+
 let rec s_expr_pretty tabs s_type e =
 	let sprintf = Printf.sprintf in
 	let loop = s_expr_pretty tabs s_type in

typeload.ml

@@ -888,13 +888,13 @@ let rec return_flow ctx e =
 		(match def with None -> () | Some e -> return_flow e)
 	| TPatMatch dt ->
 		let rec loop d = match d with
-			| Expr e -> return_flow e
-			| Guard(_,dt1,dt2) ->
+			| DTExpr e -> return_flow e
+			| DTGuard(_,dt1,dt2) ->
 				loop dt1;
 				(match dt2 with None -> () | Some dt -> loop dt)
-			| Bind (_,d) -> loop d
-			| Switch (_,cl) -> List.iter (fun (_,dt) -> loop dt) cl
-			| Goto i -> loop (dt.dt_dt_lookup.(i))
+			| DTBind (_,d) -> loop d
+			| DTSwitch (_,cl) -> List.iter (fun (_,dt) -> loop dt) cl
+			| DTGoto i -> loop (dt.dt_dt_lookup.(i))
 		in
 		loop (dt.dt_dt_lookup.(dt.dt_first))
 	| TTry (e,cases) ->