Desugar the head stmts all the way out of STMT_for, rather than stashing them in the node. That's only necessary for STMT_while.

Author: graydon

src/boot/fe/ast.ml

@@ -283,7 +283,7 @@ and stmt_for_each =
 and stmt_for =
     {
       for_slot: (slot identified * ident);
-      for_seq: ((stmt array) * lval);
+      for_seq: lval;
       for_body: block;
     }
 
@@ -1098,15 +1098,14 @@ and fmt_stmt_body (ff:Format.formatter) (s:stmt) : unit =
 
       | STMT_for sfor ->
           let (slot, ident) = sfor.for_slot in
-          let (stmts, lval) = sfor.for_seq in
+          let lval = sfor.for_seq in
             begin
               fmt_obox ff;
               fmt ff "for (";
               fmt_slot ff slot.node;
               fmt ff " ";
               fmt_ident ff ident;
               fmt ff " in ";
-              fmt_stmts ff stmts;
               fmt_lval ff lval;
               fmt ff ") ";
               fmt_obr ff;

src/boot/fe/item.ml

@@ -369,17 +369,18 @@ and parse_stmts (ps:pstate) : Ast.stmt array =
                   let inner ps =
                     let slot = (parse_identified_slot_and_ident false ps) in
                     let _    = (expect ps IN) in
-                    let lval = (parse_lval ps) in
-                      (slot, lval) in
-                  let (slot, seq) =
+                      (slot, (parse_lval ps))
+                  in
+                  let (slot, (stmts, lval)) =
                     ctxt "stmts: for head" (bracketed LPAREN RPAREN inner) ps
                   in
                   let body_block = ctxt "stmts: for body" parse_block ps in
                   let bpos = lexpos ps in
-                    [| span ps apos bpos
-                         (Ast.STMT_for
+                    Array.append stmts
+                      [| span ps apos bpos
+                           (Ast.STMT_for
                             { Ast.for_slot = slot;
-                              Ast.for_seq = seq;
+                              Ast.for_seq = lval;
                               Ast.for_body = body_block; }) |]
           end
 

src/boot/me/trans.ml

@@ -4021,10 +4021,9 @@ let trans_visitor
     let dst_slot_id = (fst (fo.Ast.for_slot)).id in
     let dst_slot = get_slot cx dst_slot_id in
     let dst_cell = cell_of_block_slot dst_slot_id in
-    let (head_stmts, seq) = fo.Ast.for_seq in
+    let seq = fo.Ast.for_seq in
     let (seq_cell, seq_ty) = trans_lval seq in
     let unit_ty = seq_unit_ty seq_ty in
-      Array.iter trans_stmt head_stmts;
       iter_seq_parts ty_params seq_cell seq_cell unit_ty
         begin
           fun _ src_cell unit_ty _ ->

src/boot/me/type.ml

@@ -1263,7 +1263,7 @@ let process_crate (cx:ctxt) (crate:Ast.crate) : unit =
             let mem_tv = ref TYSPEC_all in
             let seq_tv = ref (TYSPEC_collection mem_tv) in
             let (si, _) = fo.Ast.for_slot in
-            let (_, seq) = fo.Ast.for_seq in
+            let seq = fo.Ast.for_seq in
               unify_lval rval_ctx seq seq_tv;
               unify_slot lval_ctx si.node (Some si.id) mem_tv
 

src/boot/me/typestate.ml

@@ -533,7 +533,7 @@ let condition_assigning_visitor
 
         | Ast.STMT_for fo ->
             let (si, _) = fo.Ast.for_slot in
-            let (_, lval) = fo.Ast.for_seq in
+            let lval = fo.Ast.for_seq in
             let precond = slot_inits (lval_slots cx lval) in
             let block_entry_state = [| Constr_init si.id |] in
               raise_pre_post_cond s.id precond;

src/boot/me/walk.ml

@@ -419,9 +419,8 @@ and walk_stmt
       (s:Ast.stmt_for)
       : unit =
     let (si,_) = s.Ast.for_slot in
-    let (ss,lv) = s.Ast.for_seq in
+    let lv = s.Ast.for_seq in
       walk_slot_identified v si;
-      Array.iter (walk_stmt v) ss;
       walk_lval v lv;
       walk_block v s.Ast.for_body
   in