From 0fdad302b8a9c17a5358ac0ffa46e89e63f3d73e Mon Sep 17 00:00:00 2001
From: Graydon Hoare <graydon@mozilla.com>
Date: Wed, 14 Jul 2010 09:41:08 -0700
Subject: [PATCH] Fix ret/put mis-identification in typechecker. Closes #87.

---
 src/boot/me/type.ml                | 48 +++++++++++++++++++++++++-----
 src/test/compile-fail/put-in-fn.rs |  8 +++++
 2 files changed, 49 insertions(+), 7 deletions(-)
 create mode 100644 src/test/compile-fail/put-in-fn.rs

diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index 701bee1a384..4727abd0da0 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -216,6 +216,20 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
   in
 
   let retval_tvs = Stack.create () in
+  let fns = Stack.create () in
+
+  let push_fn fn =
+    Stack.push fn fns
+  in
+
+  let pop_fn _ =
+    ignore (Stack.pop fns)
+  in
+
+  let fn_is_iter() =
+    (Stack.top fns).Ast.fn_aux.Ast.fn_is_iter
+  in
+
   let push_retval_tv tv =
     Stack.push tv retval_tvs
   in
@@ -1215,14 +1229,28 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
         | Ast.STMT_if { Ast.if_test = if_test } ->
             unify_expr rval_ctx if_test (ty Ast.TY_bool);
 
-        | Ast.STMT_ret atom_opt
-        | Ast.STMT_put atom_opt ->
+        | Ast.STMT_ret atom_opt ->
             begin
-              match atom_opt with
-                  None -> unify_ty arg_pass_ctx Ast.TY_nil (retval_tv())
-                | Some atom -> unify_atom arg_pass_ctx atom (retval_tv())
+              if fn_is_iter()
+              then
+                match atom_opt with
+                  | None -> ()
+                  | Some _ -> err None "Iter returning value"
+              else
+                match atom_opt with
+                  | None -> unify_ty arg_pass_ctx Ast.TY_nil (retval_tv())
+                  | Some atom -> unify_atom arg_pass_ctx atom (retval_tv())
             end
 
+        | Ast.STMT_put atom_opt ->
+            if fn_is_iter()
+            then
+              match atom_opt with
+                | None -> unify_ty arg_pass_ctx Ast.TY_nil (retval_tv())
+                | Some atom -> unify_atom arg_pass_ctx atom (retval_tv())
+            else
+              err None "Non-iter function with 'put'"
+
         | Ast.STMT_be (callee, args) ->
             check_callable (retval_tv()) callee args
 
@@ -1344,11 +1372,17 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
     in
 
     let enter_fn fn retspec =
+      push_fn fn;
       let out = fn.Ast.fn_output_slot in
         push_retval_tv (ref retspec);
         unify_slot arg_pass_ctx out.node (Some out.id) (retval_tv())
     in
 
+    let leave_fn _ =
+      pop_retval_tv ();
+      pop_fn ();
+    in
+
     let visit_obj_fn_pre obj ident fn =
       enter_fn fn.node TYSPEC_all;
       inner.Walk.visit_obj_fn_pre obj ident fn
@@ -1356,7 +1390,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
 
     let visit_obj_fn_post obj ident fn =
       inner.Walk.visit_obj_fn_post obj ident fn;
-      pop_retval_tv ();
+      leave_fn ();
     in
 
     let visit_mod_item_pre n p mod_item =
@@ -1382,7 +1416,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
       match mod_item.node.Ast.decl_item with
 
         | Ast.MOD_ITEM_fn _ ->
-            pop_retval_tv ();
+            leave_fn ();
             if (Some (path_name())) = cx.ctxt_main_name
             then
               begin
diff --git a/src/test/compile-fail/put-in-fn.rs b/src/test/compile-fail/put-in-fn.rs
new file mode 100644
index 00000000000..bb6363aca57
--- /dev/null
+++ b/src/test/compile-fail/put-in-fn.rs
@@ -0,0 +1,8 @@
+// error-pattern: Non-iter function
+
+fn f() -> int {
+  put 10;
+}
+
+fn main() {
+}
\ No newline at end of file