[matcher] fixed position of matched enum arguments (#8304)

* [matcher] fixed position of matched enum arguments

* cleanup

* fix tests/misc/projects/Issue7333

* fix for wrong amount of arguments

src/typing/matcher.ml

@@ -887,7 +887,7 @@ module Compile = struct
 	let guard mctx e dt1 dt2 = hashcons mctx (Guard(e,dt1,dt2)) (punion dt1.dt_pos dt2.dt_pos)
 	let guard_null mctx e dt1 dt2 = hashcons mctx (GuardNull(e,dt1,dt2)) (punion dt1.dt_pos dt2.dt_pos)
 
-	let rec get_sub_subjects mctx e con =
+	let rec get_sub_subjects mctx e con arg_positions =
 		match fst con with
 		| ConEnum(en,ef) ->
 			let tl = List.map (fun _ -> mk_mono()) en.e_params in
@@ -895,7 +895,19 @@ module Compile = struct
 			let e = if not (type_iseq t_en e.etype) then mk (TCast(e,None)) t_en e.epos else e in
 			begin match follow ef.ef_type with
 				| TFun(args,_) ->
-					ExtList.List.mapi (fun i (_,_,t) -> mk (TEnumParameter(e,ef,i)) (apply_params en.e_params tl (monomorphs ef.ef_params t)) e.epos) args
+					let rec combine args positions =
+						match (args, positions) with
+							| (a :: args, p :: positions) -> (a, p) :: combine args positions
+							| (a :: args, []) -> (a, e.epos) :: combine args positions
+							| _ -> []
+					in
+					let arg_and_pos = combine args arg_positions in
+					ExtList.List.mapi
+						(fun i ((_,_,t), p) ->
+							let params = apply_params en.e_params tl (monomorphs ef.ef_params t) in
+							mk (TEnumParameter({ e with epos = p },ef,i)) params p
+						)
+						arg_and_pos
 				| _ ->
 					[]
 			end
@@ -1070,9 +1082,10 @@ module Compile = struct
 				let rec loop bindings pat = match fst pat with
 					| PatConstructor((ConConst TNull,_),_) ->
 						null := (case,bindings,List.tl patterns) :: !null;
-					| PatConstructor(con,_) ->
+					| PatConstructor(con,patterns) ->
 						if case.case_guard = None then ConTable.replace unguarded con true;
-						ConTable.replace sigma con true;
+						let arg_positions = snd (List.split patterns) in
+						ConTable.replace sigma con arg_positions;
 					| PatBind(v,pat) -> loop ((v,pos pat,subject) :: bindings) pat
 					| PatVariable _ | PatAny -> ()
 					| PatExtractor _ -> raise Extractor
@@ -1080,13 +1093,13 @@ module Compile = struct
 				in
 				loop bindings (List.hd patterns)
 			) cases;
-			let sigma = ConTable.fold (fun con _ acc -> (con,ConTable.mem unguarded con) :: acc) sigma [] in
+			let sigma = ConTable.fold (fun con arg_positions acc -> (con,ConTable.mem unguarded con,arg_positions) :: acc) sigma [] in
 			sigma,List.rev !null
 		in
 		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 sub_subjects = get_sub_subjects mctx subject con in
+		let switch_cases = List.map (fun (con,unguarded,arg_positions) ->
+			let sub_subjects = get_sub_subjects mctx subject con arg_positions 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

tests/misc/projects/Issue7333/compile-fail.hxml.stderr

@@ -1 +1 @@
-Main.hx:9: characters 16-22 : Unmatched patterns: A(_)
+Main.hx:10: characters 20-21 : Unmatched patterns: A(_)