implemented break for while-loop case

ast.ml - added break and cont statements
item.ml - added break and cont statements
lexer.mll - added break and cont statements
token.ml - added break and cont statements
trans.ml - implemented the break statement for the while-loop case
         - replaced hash table accesses with get_stmt_depth where needed
type.ml = added break and cont statements
typestate.ml - implemented the break statement for the while-loop case
             - added shorthand filter_live_block_slots
walk.ml - added break and cont statements
while-with-break.rs - code for testing while loops

8 files changed, 104 insertions, 36 deletions

diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml
index 54c48f7d..46a87dfe 100644
--- a/src/boot/fe/ast.ml
+++ b/src/boot/fe/ast.ml
@@ -207,6 +207,8 @@ and stmt' =
   | STMT_put_each of (lval * (atom array))
   | STMT_ret of (atom option)
   | STMT_be of (lval * (atom array))
+  | STMT_break
+  | STMT_cont
   | STMT_alt_tag of stmt_alt_tag
   | STMT_alt_type of stmt_alt_type
   | STMT_alt_port of stmt_alt_port
@@ -1228,6 +1230,10 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
           fmt_atoms ff az;
           fmt ff ";";
 
+      | STMT_break -> fmt ff "break;";
+
+      | STMT_cont -> fmt ff "cont;";
+
       | STMT_block b -> fmt_block ff b.node
 
       | STMT_copy (lv, ex) ->
diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml
index 3d3bf84f..c1746cc2 100644
--- a/src/boot/fe/item.ml
+++ b/src/boot/fe/item.ml
@@ -188,7 +188,14 @@ and parse_stmts_including_none (ps:pstate) : Ast.stmt array =
           let (stmts, atom) = ctxt "stmts: log value" parse_expr_atom ps in
             expect ps SEMI;
             spans ps stmts apos (Ast.STMT_log atom)
-
+      | BREAK ->
+          bump ps;
+          expect ps SEMI;
+          [| span ps apos (lexpos ps) Ast.STMT_break |]
+      | CONT ->
+          bump ps;
+          expect ps SEMI;
+          [| span ps apos (lexpos ps) Ast.STMT_cont |]
       | CHECK ->
           bump ps;
           begin
diff --git a/src/boot/fe/lexer.mll b/src/boot/fe/lexer.mll
index 763b50c9..151af827 100644
--- a/src/boot/fe/lexer.mll
+++ b/src/boot/fe/lexer.mll
@@ -113,6 +113,8 @@
                 ("const", CONST);
 
                 ("log", LOG);
+                ("break", BREAK);
+                ("cont", CONT);
                 ("spawn", SPAWN);
                 ("thread", THREAD);
                 ("yield", YIELD);
diff --git a/src/boot/fe/token.ml b/src/boot/fe/token.ml
index 85dd2a13..cd41ec2f 100644
--- a/src/boot/fe/token.ml
+++ b/src/boot/fe/token.ml
@@ -71,6 +71,8 @@ type token =
   | PUT
   | RET
   | BE
+  | BREAK
+  | CONT
 
   (* Type and type-state keywords *)
   | TYPE
@@ -226,6 +228,8 @@ let rec string_of_tok t =
     | PUT        -> "put"
     | RET        -> "ret"
     | BE         -> "be"
+    | BREAK      -> "break"
+    | CONT       -> "cont"
 
     (* Type and type-state keywords *)
     | TYPE       -> "type"
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index fb5c2aec..1161b58e 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -234,6 +234,7 @@ let trans_visitor
   in
 
   let epilogue_jumps = Stack.create() in
+  let simple_break_jumps = Stack.create() in (* not used for for-each *)
 
   let path_name (_:unit) : string =
     string_of_name (path_to_name path)
@@ -4717,7 +4718,7 @@ let trans_visitor
             Some params -> params
           | None -> [| |]
       in
-      let depth = Hashtbl.find cx.ctxt_stmt_loop_depths stmt_id in
+      let depth = get_stmt_depth cx stmt_id in
       let fc = { for_each_fixup = fix; for_each_depth = depth } in
         iflog (fun _ ->
                  log cx "for-each at depth %d\n" depth);
@@ -5059,12 +5060,16 @@ let trans_visitor
           let fwd_jmp = mark () in
             emit (Il.jmp Il.JMP Il.CodeNone);
             let block_begin = mark () in
+              Stack.push (Stack.create()) simple_break_jumps;
               trans_block sw.Ast.while_body;
               patch fwd_jmp;
               Array.iter trans_stmt head_stmts;
               check_interrupt_flag ();
-              let back_jmps = trans_cond false head_expr in
-                List.iter (fun j -> patch_existing j block_begin) back_jmps;
+              begin
+                let back_jmps = trans_cond false head_expr in
+                  List.iter (fun j -> patch_existing j block_begin) back_jmps;
+              end;
+              Stack.iter patch (Stack.pop simple_break_jumps);
 
       | Ast.STMT_if si ->
           let skip_thn_jmps = trans_cond true si.Ast.if_test in
@@ -5108,6 +5113,13 @@ let trans_visitor
           let (dst_cell, _) = get_current_output_cell_and_slot () in
             trans_be_fn cx dst_cell flv ty_params args
 
+      | Ast.STMT_break ->
+          if get_stmt_depth cx stmt.id > 0
+          then unimpl (Some stmt.id) "break within iterator-block";
+          drop_slots_at_curr_stmt();
+          Stack.push (mark()) (Stack.top simple_break_jumps);
+          emit (Il.jmp Il.JMP Il.CodeNone);
+
       | Ast.STMT_put atom_opt ->
           trans_put atom_opt
 
diff --git a/src/boot/me/type.ml b/src/boot/me/type.ml
index badd6b67..782d2e27 100644
--- a/src/boot/me/type.ml
+++ b/src/boot/me/type.ml
@@ -945,7 +945,9 @@ let check_stmt (cx:Semant.ctxt) : (fn_ctx -> Ast.stmt -> unit) =
 
         | Ast.STMT_alt_port _ -> () (* TODO *)
 
-        | Ast.STMT_fail | Ast.STMT_yield -> ()  (* always well-typed *)
+        (* always well-typed *)
+        | Ast.STMT_fail | Ast.STMT_yield 
+        | Ast.STMT_break | Ast.STMT_cont -> ()
 
         | Ast.STMT_join lval -> infer_lval Ast.TY_task lval
 
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index a88adcd2..12454191 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -445,6 +445,15 @@ let bitmap_assigning_visitor
         Walk.visit_block_pre = visit_block_pre }
 ;;
 
+type slots_stack = node_id Stack.t;;
+type block_slots_stack = slots_stack Stack.t;;
+type frame_block_slots_stack = block_slots_stack Stack.t;;
+type loop_block_slots_stack = block_slots_stack option Stack.t;;
+(* like ret drops slots from all blocks in the frame
+ * break from a simple loo drops slots from all block in a loop *)
+let (loop_blocks:loop_block_slots_stack) = 
+  let s = Stack.create() in Stack.push None s; s
+
 let condition_assigning_visitor
     (cx:ctxt)
     (tables_stack:typestate_tables Stack.t)
@@ -574,7 +583,7 @@ let condition_assigning_visitor
           let precond = slot_inits (lval_slots cx lval) in
             raise_precondition sid precond;
   in
-
+    
   let visit_stmt_pre s =
     begin
       match s.node with
@@ -694,7 +703,6 @@ let condition_assigning_visitor
         | Ast.STMT_check_expr expr ->
             let precond = slot_inits (expr_slots cx expr) in
               raise_pre_post_cond s.id precond
-
         | Ast.STMT_while sw ->
             let (_, expr) = sw.Ast.while_lval in
             let precond = slot_inits (expr_slots cx expr) in
@@ -1275,9 +1283,6 @@ let typestate_verify_visitor
         Walk.visit_block_pre = visit_block_pre }
 ;;
 
-type slots_stack = node_id Stack.t;;
-type block_slots_stack = slots_stack Stack.t;;
-type frame_block_slots_stack = block_slots_stack Stack.t;;
 
 let lifecycle_visitor
     (cx:ctxt)
@@ -1312,18 +1317,24 @@ let lifecycle_visitor
 
 
   let visit_block_pre b =
-    Stack.push (Stack.create()) (Stack.top frame_blocks);
-    begin
-      match htab_search implicit_init_block_slots b.id with
-          None -> ()
-        | Some slots ->
+   
+    let s = Stack.create() in
+      begin
+        match Stack.top loop_blocks with 
+            Some loop -> Stack.push s loop | None -> ()
+      end;
+      Stack.push s (Stack.top frame_blocks);
+      begin
+        match htab_search implicit_init_block_slots b.id with
+            None -> ()
+          | Some slots ->
             List.iter
               (fun slot ->
                  push_slot slot;
                  mark_slot_live slot)
               slots
-    end;
-    inner.Walk.visit_block_pre b
+      end;
+      inner.Walk.visit_block_pre b
   in
 
   let note_drops stmt slots =
@@ -1341,8 +1352,20 @@ let lifecycle_visitor
     htab_put cx.ctxt_post_stmt_slot_drops stmt.id slots
   in
 
+  let filter_live_block_slots slots =
+    List.filter (fun i -> Hashtbl.mem live_block_slots i) slots
+  in
+
   let visit_block_post b =
     inner.Walk.visit_block_post b;
+    begin
+      match Stack.top loop_blocks with
+          Some loop -> 
+            ignore(Stack.pop loop);
+            if Stack.is_empty loop then
+              ignore(Stack.pop loop_blocks);
+        | None -> ()
+    end;
     let block_slots = Stack.pop (Stack.top frame_blocks) in
     let stmts = b.node in
     let len = Array.length stmts in
@@ -1352,7 +1375,8 @@ let lifecycle_visitor
           let s = stmts.(len-1) in
             match s.node with
                 Ast.STMT_ret _
-              | Ast.STMT_be _ ->
+              | Ast.STMT_be _ 
+              | Ast.STMT_break ->
                   () (* Taken care of in visit_stmt_post below. *)
               | _ ->
                 (* The blk_slots stack we have has accumulated slots in
@@ -1364,11 +1388,7 @@ let lifecycle_visitor
                  * point in the block.
                  *)
                 let slots = stk_elts_from_top block_slots in
-                let live =
-                  List.filter
-                    (fun i -> Hashtbl.mem live_block_slots i)
-                    slots
-                in
+                let live = filter_live_block_slots slots in
                   note_drops s live
         end;
   in
@@ -1440,6 +1460,10 @@ let lifecycle_visitor
                 f.Ast.for_each_body.id
                 [ (fst f.Ast.for_each_slot).id ]
 
+          | Ast.STMT_while _ ->
+              iflog cx (fun _ -> log cx "entering a loop");
+              Stack.push (Some (Stack.create ()))  loop_blocks;
+
           | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms } ->
               let note_slot block slot_id =
                 log cx
@@ -1475,26 +1499,38 @@ let lifecycle_visitor
 
   let visit_stmt_post s =
     inner.Walk.visit_stmt_post s;
+    let handle_ret_like_stmt block_stack =
+      let blocks = stk_elts_from_top block_stack in
+          let slots = List.concat (List.map stk_elts_from_top blocks) in
+          let live = filter_live_block_slots slots in
+            note_drops s live
+    in
     match s.node with
         Ast.STMT_ret _
       | Ast.STMT_be _ ->
-          let blocks = stk_elts_from_top (Stack.top frame_blocks) in
-          let slots = List.concat (List.map stk_elts_from_top blocks) in
-          let live =
-            List.filter
-              (fun i -> Hashtbl.mem live_block_slots i)
-              slots
-          in
-            note_drops s live
+          handle_ret_like_stmt (Stack.top frame_blocks)
+      | Ast.STMT_break ->
+          begin
+            match (Stack.top loop_blocks) with
+                Some loop -> handle_ret_like_stmt loop
+              | None -> 
+                  iflog cx (fun _ ->
+                              log cx "break statement outside of a loop");
+                  err (Some s.id) "break statement outside of a loop"
+          end
       | _ -> ()
   in
 
   let enter_frame _ =
-    Stack.push (Stack.create()) frame_blocks
+    Stack.push (Stack.create()) frame_blocks;
+    Stack.push None loop_blocks
   in
-
+    
   let leave_frame _ =
-    ignore (Stack.pop frame_blocks)
+    ignore (Stack.pop frame_blocks);
+    match Stack.pop loop_blocks with
+        Some _ -> bug () "leave_frame should not end a loop"
+      | None -> ()
   in
 
   let visit_mod_item_pre n p i =
diff --git a/src/boot/me/walk.ml b/src/boot/me/walk.ml
index eb469dfb..d776d82d 100644
--- a/src/boot/me/walk.ml
+++ b/src/boot/me/walk.ml
@@ -481,8 +481,7 @@ and walk_stmt
       | Ast.STMT_decl (Ast.DECL_slot (_, slot)) ->
           walk_slot_identified v slot
 
-      | Ast.STMT_yield
-      | Ast.STMT_fail ->
+      | Ast.STMT_break | Ast.STMT_cont | Ast.STMT_yield | Ast.STMT_fail ->
           ()
 
       | Ast.STMT_join task ->