re-raise WithTypeResume errors (fixed issue #1496)

matcher.ml

@@ -1061,7 +1061,7 @@ let rec collapse_case el = match el with
 		assert false
 
 let match_expr ctx e cases def with_type p =
-	let need_val, wtype = (match with_type with NoValue -> false, None | Value -> true, None | WithType t | WithTypeResume t -> true, Some t) in
+	let need_val = match with_type with NoValue -> false | _ -> true in
 	let cases = match cases,def with
 		| [],None -> []
 		| cases,Some def ->
@@ -1129,7 +1129,10 @@ let match_expr ctx e cases def with_type p =
 					let monos = List.map (fun _ -> mk_mono()) ctx.type_params in
 					let t = apply_params ctx.type_params monos t in
 					let pl = [add_pattern_locals (to_pattern ctx ep t)] in
-					pl,(match wtype with Some t -> WithType (apply_params ctx.type_params monos t) | _ -> with_type);
+					pl,(match with_type with
+						| WithType t -> WithType (apply_params ctx.type_params monos t)
+						| WithTypeResume t -> WithTypeResume (apply_params ctx.type_params monos t)
+						| _ -> with_type);
 				| tl ->
 					let t = monomorphs ctx.type_params (tfun tl fake_tuple_type) in
 					[add_pattern_locals (to_pattern ctx ep t)],with_type)
@@ -1140,7 +1143,10 @@ let match_expr ctx e cases def with_type p =
 			| None -> mk (TBlock []) ctx.com.basic.tvoid (punion_el el)
 			| Some e ->
 				let e = type_expr ctx e with_type in
-				(match with_type with WithType t -> unify ctx e.etype t e.epos | _ -> ());
+				(match with_type with
+				| WithType t -> unify ctx e.etype t e.epos
+				| WithTypeResume t -> (try unify_raise ctx e.etype t e.epos with Error (Unify l,p) -> raise (Typer.WithTypeError (l,p)) )
+				| _ -> ());
 				e
 		in
 		let eg = match eg with None -> None | Some e -> Some (type_expr ctx e Value) in
@@ -1160,9 +1166,9 @@ let match_expr ctx e cases def with_type p =
 		end) mctx.outcomes;
 		let t = if not need_val then
 			mk_mono()
-		else match wtype with
-			| Some t -> t
-			| None -> try Typer.unify_min_raise ctx (List.rev_map (fun (_,out) -> out.o_expr) (List.rev pl)) with Error (Unify l,p) -> error (error_msg (Unify l)) p
+		else match with_type with
+			| WithType t | WithTypeResume t -> t
+			| _ -> try Typer.unify_min_raise ctx (List.rev_map (fun (_,out) -> out.o_expr) (List.rev pl)) with Error (Unify l,p) -> error (error_msg (Unify l)) p
 		in
 		let e = to_typed_ast mctx dt in
 		let e = { e with epos = p} in

typer.ml

@@ -2326,11 +2326,14 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		]) v.v_type p
 	| EArrayDecl ((EBinop(OpArrow,_,_),_) as e1 :: el) ->
 		let keys = Hashtbl.create 0 in
-		let tkey,tval = match with_type with
-			| WithType (TAbstract({a_path=[],"Map"},[tk;tv]))
-			| WithTypeResume (TAbstract({a_path=[],"Map"},[tk;tv])) ->
-				tk,tv
-			| _ -> mk_mono(),mk_mono()
+		let tkey,tval,resume = match with_type with
+			| WithType (TAbstract({a_path=[],"Map"},[tk;tv])) -> tk,tv,false
+			| WithTypeResume (TAbstract({a_path=[],"Map"},[tk;tv])) -> tk,tv,true
+			| _ -> mk_mono(),mk_mono(),false
+		in
+		let unify_with_resume ctx a b p =
+			if resume then try unify_raise ctx a b p with Error (Unify l,p) -> raise (WithTypeError(l,p))
+			else unify ctx a b p
 		in
 		let type_arrow e1 e2 =
 			let e1 = type_expr ctx e1 (WithType tkey) in
@@ -2340,9 +2343,9 @@ and type_expr ctx (e,p) (with_type:with_type) =
 				error "Previously defined here" p
 			with Not_found ->
 				Hashtbl.add keys e1.eexpr e1.epos;
-				unify ctx e1.etype tkey e1.epos;
+				unify_with_resume ctx e1.etype tkey e1.epos;
 				let e2 = type_expr ctx e2 (WithType tval) in
-				unify ctx e2.etype tval e2.epos;
+				unify_with_resume ctx e2.etype tval e2.epos;
 				e1,e2
 		in
 		let m = Typeload.load_module ctx ([],"Map") null_pos in