change handling of or-patterns (closes #2508)

matcher.ml

@@ -79,9 +79,10 @@ and pat = {
 }
 
 type out = {
-	o_pos : pos;
+	mutable o_pos : pos;
 	o_id : int;
 	o_default : bool;
+	mutable o_num_paths : int;
 }
 
 type pat_vec = pat array * out
@@ -104,7 +105,6 @@ type matcher = {
 	mutable dt_count : int;
 	mutable outcomes : (pat list,out) PMap.t;
 	mutable toplevel_or : bool;
-	mutable used_paths : (int,bool) Hashtbl.t;
 	mutable has_extractor : bool;
 	mutable expr_map : (int,texpr * texpr option) PMap.t;
 }
@@ -133,13 +133,15 @@ let mk_out mctx id e eg pl is_default p =
 		o_pos = p;
 		o_id = id;
 		o_default = is_default;
+		o_num_paths = 0;
 	} in
 	mctx.outcomes <- PMap.add pl out mctx.outcomes;
 	mctx.expr_map <- PMap.add id (e,eg) mctx.expr_map;
 	out
 
 let clone_out mctx out pl p =
-	let out = {out with o_pos = p; } in
+ 	let out = {out with o_pos = p; } in
+ 	mctx.outcomes <- PMap.add pl out mctx.outcomes;
 	out
 
 let get_guard mctx id =
@@ -160,17 +162,9 @@ let mk_con cdef t p = {
 	c_pos = p;
 }
 
-let mk_con_pat cdef pl t p = {
-	p_def = PCon(mk_con cdef t p,pl);
-	p_type = t;
-	p_pos = p;
-}
+let mk_con_pat cdef pl t p = mk_pat (PCon(mk_con cdef t p,pl)) t p
 
-let mk_any t p = {
-	p_def = PAny;
-	p_type = t;
-	p_pos = p;
-}
+let mk_any t p = mk_pat PAny t p
 
 let any = mk_any t_dynamic Ast.null_pos
 
@@ -384,11 +378,7 @@ let to_pattern ctx e t =
 			begin match get_tuple_types t with
 			| Some tl ->
 				let pl = List.map (fun (_,_,t) -> mk_any t p) tl in
-				{
-					p_def = PTuple (Array.of_list pl);
-					p_pos = p;
-					p_type = t_dynamic;
-				}
+				mk_pat (PTuple (Array.of_list pl)) t_dynamic p
 			| None ->
 				mk_any t p
 			end
@@ -519,11 +509,7 @@ let to_pattern ctx e t =
 					with Invalid_argument _ ->
 						error ("Invalid number of arguments: expected " ^ (string_of_int (List.length tl)) ^ ", found " ^ (string_of_int (List.length el))) p
 					in
-					{
-						p_def = PTuple (Array.of_list pl);
-						p_pos = p;
-						p_type = t_dynamic;
-					}
+					mk_pat (PTuple (Array.of_list pl)) t_dynamic p
 				| _ ->
 					error ((s_type t) ^ " should be Array") p
 			end
@@ -616,15 +602,12 @@ let spec mctx con pmat =
 			()
 		| PAny | PVar _->
 			add (Array.append (Array.make a (mk_any (pv.(0).p_type) (pv.(0).p_pos))) (array_tl pv)) out
- 		| POr(pat1,pat2) ->
-			let tl = array_tl pv in
-			let out2 = clone_out mctx out [pat2] pat2.p_pos in
-			loop2 (Array.append [|pat1|] tl) out;
-			loop2 (Array.append [|pat2|] tl) out2;
 		| PBind(_,pat) ->
 			loop2 (Array.append [|pat|] (array_tl pv)) out
 		| PTuple tl ->
 			loop2 tl out
+ 		| POr _ ->
+			assert false
 	in
 	let rec loop pmat = match pmat with
 		| (pv,out) :: pl ->
@@ -646,15 +629,12 @@ let default mctx pmat =
 			()
 		| PAny | PVar _->
 			add (array_tl pv) out
- 		| POr(pat1,pat2) ->
-			let tl = array_tl pv in
-			let out2 = clone_out mctx out [pat2] pat2.p_pos in
-			loop2 (Array.append [|pat1|] tl) out;
-			loop2 (Array.append [|pat2|] tl) out2;
 		| PBind(_,pat) ->
 			loop2 (Array.append [|pat|] (array_tl pv)) out
 		| PTuple tl ->
 			loop2 tl out
+ 		| POr _ ->
+			assert false
 	in
  	let rec loop pmat = match pmat with
 		| (pv,out) :: pl ->
@@ -700,6 +680,34 @@ let swap_columns i (row : 'a list) : 'a list =
 	| _ ->
 		[]
 
+let expand_or mctx pmat =
+	let rec loop pmat = match pmat with
+		| (pv,out) :: pmat ->
+			let acc = ref [] in
+			let rec loop2 pv out = match pv.(0) with
+				| {p_def = POr(pat1,pat2)} ->
+					out.o_pos <- pat1.p_pos;
+					let out2 = clone_out mctx out [pat2] pat2.p_pos in
+					let tl = array_tl pv in
+					loop2 (Array.append [|pat2|] tl) out2;
+					loop2 (Array.append [|pat1|] tl) out;
+				| {p_def = PBind(v,{p_def = POr(pat1,pat2)})} as pat ->
+					out.o_pos <- pat1.p_pos;
+					let out2 = clone_out mctx out [pat2] pat2.p_pos in
+					let tl = array_tl pv in
+					loop2 (Array.append [|{pat with p_def = PBind(v,pat2)}|] tl) out2;
+					loop2 (Array.append [|{pat with p_def = PBind(v,pat1)}|] tl) out;
+				| _ ->
+					acc := (pv,out) :: !acc
+			in
+			let r = loop pmat in
+			loop2 pv out;
+			!acc @ r
+		| [] ->
+			[]
+	in
+	loop pmat
+
 let column_sigma mctx st pmat =
 	let acc = ref [] in
 	let bindings = ref [] in
@@ -716,10 +724,6 @@ let column_sigma mctx st pmat =
 			let rec loop2 out = function
 				| PCon (c,_) ->
 					add c ((get_guard mctx out.o_id) <> None);
-				| POr(pat1,pat2) ->
-					let out2 = clone_out mctx out [pat2] pat2.p_pos in
-					loop2 out pat1.p_def;
-					loop2 out2 pat2.p_def;
 				| PVar v ->
 					bind_st out st v;
 				| PBind(v,pat) ->
@@ -729,6 +733,8 @@ let column_sigma mctx st pmat =
 					()
 				| PTuple tl ->
 					loop2 out tl.(0).p_def
+				| POr _ ->
+					assert false
 			in
 			loop2 out pv.(0).p_def;
 			loop pr
@@ -792,11 +798,7 @@ let rec collapse_pattern pl = match pl with
 		pat
 	| pat :: pl ->
 		let pat2 = collapse_pattern pl in
-		{
-			p_def = POr(pat,pat2);
-			p_pos = punion pat.p_pos pat2.p_pos;
-			p_type = pat.p_type
-		}
+		mk_pat (POr(pat,pat2)) pat.p_type (punion pat.p_pos pat2.p_pos)
 	| [] ->
 		assert false
 
@@ -854,7 +856,7 @@ let rec compile mctx stl pmat toplevel =
 	| (pv,out) :: pl ->
 		let i = pick_column pmat in
 		if i = -1 then begin
-			Hashtbl.replace mctx.used_paths out.o_id true;
+			out.o_num_paths <- out.o_num_paths + 1;
 			let bl = bind_remaining out pv stl in
 			let dt = match (get_guard mctx out.o_id) with
 				| None -> expr out.o_id
@@ -867,6 +869,7 @@ let rec compile mctx stl pmat toplevel =
 			compile mctx stls pmat toplevel
 		end else begin
 			let st_head,st_tail = match stl with st :: stl -> st,stl | _ -> assert false in
+			let pmat = expand_or mctx pmat in
 			let sigma,bl = column_sigma mctx st_head pmat in
 			let all,inf = all_ctors mctx st_head.st_type in
 			let cases = List.map (fun (c,g) ->
@@ -1097,7 +1100,6 @@ let match_expr ctx e cases def with_type p =
 		need_val = need_val;
 		outcomes = PMap.empty;
 		toplevel_or = false;
-		used_paths = Hashtbl.create 0;
 		dt_lut = DynArray.create ();
 		dt_cache = Hashtbl.create 0;
 		dt_count = 0;
@@ -1205,7 +1207,7 @@ let match_expr ctx e cases def with_type p =
 			ctx.on_error <- old_error;
 		in
  		PMap.iter (fun _ out ->
- 			if not (Hashtbl.mem mctx.used_paths out.o_id || out.o_default) then begin
+ 			if not (out.o_num_paths > 0 || out.o_default) then begin
 				unused out.o_pos;
 				if mctx.toplevel_or then begin match evals with
 					| [{etype = t}] when (match follow t with TAbstract({a_path=[],"Int"},[]) -> true | _ -> false) ->

tests/unit/TestMatch.hx

@@ -613,7 +613,6 @@ class TestMatch extends Test {
 		switch({s:"foo"}) {
 			case { s : "foo" } :
 			case { s : a } :
-			case _: // unused
 		}
 
 		switch( { s:"foo", t:"bar" } ) {

tests/unit/unitstd/haxe/ds/BalancedTree.unit.hx

@@ -24,8 +24,10 @@ for (k in test.keys()) {
 for (k in otherKeys) {
 	eq(false, m.exists(k));
 }
-[for (key in m.keys()) key] == [1,6,8,11,13,15,17,22,25,27];
-[for (val in m) val] == [4,8,2,5,1,6,3,9,7,10];
+var r = [for (key in m.keys()) key];
+r == [1,6,8,11,13,15,17,22,25,27];
+var r = [for (val in m) val];
+r == [4,8,2,5,1,6,3,9,7,10];
 for (k in test.keys()) {
 	eq(true, m.remove(k));
 	eq(false, m.exists(k));