Browse Source

use unify_min on return

Simon Krajewski 13 years ago
parent
commit
138244ebde
3 changed files with 10 additions and 2 deletions
  1. 1 1
      typecore.ml
  2. 5 0
      typeload.ml
  3. 4 1
      typer.ml

+ 1 - 1
typecore.ml

@@ -300,5 +300,5 @@ let unify_min_raise ctx el =
 let unify_min ctx el = 
 let unify_min ctx el = 
 	try unify_min_raise ctx el
 	try unify_min_raise ctx el
 	with Error (Unify l,p) ->
 	with Error (Unify l,p) ->
-		display_error ctx (error_msg (Unify l)) p;
+		if not ctx.untyped then display_error ctx (error_msg (Unify l)) p;
 		(List.hd el).etype
 		(List.hd el).etype

+ 5 - 0
typeload.ml

@@ -571,12 +571,16 @@ let type_function ctx args ret fmode f p =
 		add_local ctx n t, c
 		add_local ctx n t, c
 	) args in
 	) args in
 	let old_ret = ctx.ret in
 	let old_ret = ctx.ret in
+	let old_ret_exprs = ctx.ret_exprs in
 	let old_fun = ctx.curfun in
 	let old_fun = ctx.curfun in
 	let old_opened = ctx.opened in
 	let old_opened = ctx.opened in
 	ctx.curfun <- fmode;
 	ctx.curfun <- fmode;
 	ctx.ret <- ret;
 	ctx.ret <- ret;
+	ctx.ret_exprs <- [];
 	ctx.opened <- [];
 	ctx.opened <- [];
 	let e = type_expr ctx (match f.f_expr with None -> error "Function body required" p | Some e -> e) false in
 	let e = type_expr ctx (match f.f_expr with None -> error "Function body required" p | Some e -> e) false in
+	let t = unify_min ctx ctx.ret_exprs in
+	unify ctx t ctx.ret e.epos;
 	let rec loop e =
 	let rec loop e =
 		match e.eexpr with
 		match e.eexpr with
 		| TReturn (Some _) -> raise Exit
 		| TReturn (Some _) -> raise Exit
@@ -617,6 +621,7 @@ let type_function ctx args ret fmode f p =
 	in
 	in
 	List.iter (fun r -> r := Closed) ctx.opened;
 	List.iter (fun r -> r := Closed) ctx.opened;
 	ctx.ret <- old_ret;
 	ctx.ret <- old_ret;
+	ctx.ret_exprs <- old_ret_exprs;
 	ctx.curfun <- old_fun;
 	ctx.curfun <- old_fun;
 	ctx.opened <- old_opened;
 	ctx.opened <- old_opened;
 	e , fargs
 	e , fargs

+ 4 - 1
typer.ml

@@ -1544,7 +1544,10 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				None , v
 				None , v
 			| Some e ->
 			| Some e ->
 				let e = type_expr ctx e in
 				let e = type_expr ctx e in
-				unify ctx e.etype ctx.ret e.epos;
+				if ctx.untyped || ctx.ret == t_dynamic then
+					unify ctx e.etype ctx.ret e.epos
+ 				else
+					ctx.ret_exprs <- e :: ctx.ret_exprs;
 				Some e , e.etype
 				Some e , e.etype
 		) in
 		) in
 		mk (TReturn e) t_dynamic p
 		mk (TReturn e) t_dynamic p