Browse Source

clean up matcher.ml a bit

Simon Krajewski 11 năm trước cách đây
mục cha
commit
31734dea37
1 tập tin đã thay đổi với 21 bổ sung23 xóa
  1. 21 23
      matcher.ml

+ 21 - 23
matcher.ml

@@ -1219,29 +1219,27 @@ let match_expr ctx e cases def with_type p =
 	let pl = ExtList.List.mapi (fun i (ep,eg,e) ->
 		let save = save_locals ctx in
 		(* type case patterns *)
-		let pl,restore,with_type = try (match tl with
-				| [t] when not !array_match ->
-					(* context type parameters are turned into monomorphs until the pattern has been typed *)
-					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
-					let old_ret = ctx.ret in
-					ctx.ret <- apply_params ctx.type_params monos ctx.ret;
-					let restore = PMap.fold (fun v acc ->
-						(* apply context monomorphs to locals and replace them back after typing the case body *)
-						let t = v.v_type in
-						v.v_type <- apply_params ctx.type_params monos v.v_type;
-						(fun () -> v.v_type <- t) :: acc
-					) ctx.locals [fun() -> ctx.ret <- old_ret] in
-					(* turn any still unknown types back to type parameters *)
-					List.iter2 (fun m (_,t) -> match follow m with TMono _ -> Type.unify m t | _ -> ()) monos ctx.type_params;
-					pl,restore,(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)
+		let pl,restore,with_type =
+			try
+				(* context type parameters are turned into monomorphs until the pattern has been typed *)
+				let monos = List.map (fun _ -> mk_mono()) ctx.type_params in
+				let t = match tl with [t] when not !array_match -> t | tl -> tfun tl fake_tuple_type in
+				let t = apply_params ctx.type_params monos t in
+				let pl = [add_pattern_locals (to_pattern ctx ep t)] in
+				let old_ret = ctx.ret in
+				ctx.ret <- apply_params ctx.type_params monos ctx.ret;
+				let restore = PMap.fold (fun v acc ->
+					(* apply context monomorphs to locals and replace them back after typing the case body *)
+					let t = v.v_type in
+					v.v_type <- apply_params ctx.type_params monos v.v_type;
+					(fun () -> v.v_type <- t) :: acc
+				) ctx.locals [fun() -> ctx.ret <- old_ret] in
+				(* turn any still unknown types back to type parameters *)
+				List.iter2 (fun m (_,t) -> match follow m with TMono _ -> Type.unify m t | _ -> ()) monos ctx.type_params;
+				pl,restore,(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);
 			with Unrecognized_pattern (e,p) ->
 				error "Case expression must be a constant value or a pattern, not an arbitrary expression" p
 		in