[matcher] temp var pattern sub-subjects

closes #8064

src/typing/matcher.ml

@@ -1089,9 +1089,19 @@ module Compile = struct
 		let sigma,null = get_column_sigma cases in
 		if mctx.match_debug then print_endline (Printf.sprintf "compile_switch:\n\tsubject: %s\n\ttsubjects: %s\n\tcases: %s" (s_expr_pretty subject) (s_subjects subjects) (s_cases cases));
 		let switch_cases = List.map (fun (con,unguarded) ->
-			let subjects = get_sub_subjects mctx subject con @ subjects in
+			let sub_subjects = get_sub_subjects mctx subject con in
+			let rec loop bindings locals sub_subjects = match sub_subjects with
+				| e :: sub_subjects ->
+					let v = gen_local mctx.ctx e.etype e.epos in
+					loop ((v,v.v_pos,e) :: bindings) ((mk (TLocal v) v.v_type v.v_pos) :: locals) sub_subjects
+				| [] ->
+					List.rev bindings,List.rev locals
+			in
+			let bindings,sub_subjects = loop [] [] sub_subjects in
+			let subjects = sub_subjects @ subjects in
 			let spec = specialize subject con cases in
 			let dt = compile mctx subjects spec in
+			let dt = bind mctx bindings dt in
 			con,unguarded,dt
 		) sigma in
 		let default = default subject cases in
@@ -1195,14 +1205,22 @@ module TexprConverter = struct
 
 	exception Not_exhaustive
 
-	let s_subject s e =
+	let s_subject v_lookup s e =
 		let rec loop s e = match e.eexpr with
+			| TField(_,FEnum(en,ef)) ->
+				s
 			| TField(e1,fa) ->
 				loop (Printf.sprintf "{ %s: %s }" (field_name fa) s) e1
 			| TEnumParameter(e1,ef,i) ->
 				let arity = match follow ef.ef_type with TFun(args,_) -> List.length args | _ -> assert false in
 				let l = make_offset_list i (arity - i - 1) s "_" in
 				loop (Printf.sprintf "%s(%s)" ef.ef_name (String.concat ", " l)) e1
+			| TLocal v ->
+				begin try
+					loop s (IntMap.find v.v_id v_lookup)
+				with Not_found ->
+					s
+				end
 			| _ ->
 				s
 		in
@@ -1319,7 +1337,7 @@ module TexprConverter = struct
 		let unmatched = ConTable.fold (fun con _ acc -> con :: acc) h [] in
 		e,unmatched,kind,finiteness
 
-	let report_not_exhaustive e_subject unmatched =
+	let report_not_exhaustive v_lookup e_subject unmatched =
 		let sl = match follow e_subject.etype with
 			| TAbstract({a_impl = Some c} as a,tl) when Meta.has Meta.Enum a.a_meta ->
 				List.map (fun (con,_) -> match fst con with
@@ -1340,9 +1358,10 @@ module TexprConverter = struct
 			| [] -> "_"
 			| _ -> String.concat " | " (List.sort Pervasives.compare sl)
 		in
-		error (Printf.sprintf "Unmatched patterns: %s" (s_subject s e_subject)) e_subject.epos
+		error (Printf.sprintf "Unmatched patterns: %s" (s_subject v_lookup s e_subject)) e_subject.epos
 
 	let to_texpr ctx t_switch match_debug with_type dt =
+		let v_lookup = ref IntMap.empty in
 		let com = ctx.com in
 		let p = dt.dt_pos in
 		let c_type = match follow (Typeload.load_instance ctx ({ tpackage = ["std"]; tname="Type"; tparams=[]; tsub = None},p) true) with TInst(c,_) -> c | t -> assert false in
@@ -1382,7 +1401,7 @@ module TexprConverter = struct
 								| WithType.NoValue,Infinite when toplevel -> None
 								| _,CompileTimeFinite when unmatched = [] -> None
 								| _ when ctx.com.display.DisplayMode.dms_error_policy = DisplayMode.EPIgnore -> None
-								| _ -> report_not_exhaustive e_subject unmatched
+								| _ -> report_not_exhaustive !v_lookup e_subject unmatched
 						in
 						let cases = ExtList.List.filter_map (fun (con,_,dt) -> match unify_constructor ctx params e_subject.etype con with
 							| Some(_,params) -> Some (con,dt,params)
@@ -1471,11 +1490,12 @@ module TexprConverter = struct
 						with Not_exhaustive ->
 							if toplevel then (fun () -> loop toplevel params dt2)
 							else if ctx.com.display.DisplayMode.dms_error_policy = DisplayMode.EPIgnore then (fun () -> mk (TConst TNull) (mk_mono()) dt2.dt_pos)
-							else report_not_exhaustive e [(ConConst TNull,dt.dt_pos),dt.dt_pos]
+							else report_not_exhaustive !v_lookup e [(ConConst TNull,dt.dt_pos),dt.dt_pos]
 						in
 						f()
 					| Bind(bl,dt) ->
 						let el = List.rev_map (fun (v,p,e) ->
+							v_lookup := IntMap.add v.v_id e !v_lookup;
 							mk (TVar(v,Some e)) com.basic.tvoid p
 						) bl in
 						let e = loop toplevel params dt in