Very basic implementation of for..of loops

analysis/reanalyze/src/Arnold.ml

@@ -979,6 +979,9 @@ module Compile = struct
     | Texp_for _ ->
       notImplemented "Texp_for";
       assert false
+    | Texp_for_of _ ->
+      notImplemented "Texp_for_of";
+      assert false
     | Texp_send _ ->
       notImplemented "Texp_send";
       assert false

analysis/reanalyze/src/SideEffects.ml

@@ -59,6 +59,8 @@ let rec exprNoSideEffects (expr : Typedtree.expression) =
   | Texp_for (_id, _pat, e1, e2, _dir, e3) ->
     e1 |> exprNoSideEffects && e2 |> exprNoSideEffects
     && e3 |> exprNoSideEffects
+  | Texp_for_of (_id, _pat, e1, e2) ->
+    e1 |> exprNoSideEffects && e2 |> exprNoSideEffects
   | Texp_send _ -> false
   | Texp_letexception (_ec, e) -> e |> exprNoSideEffects
   | Texp_pack _ -> false

analysis/src/Utils.ml

@@ -100,6 +100,7 @@ let identifyPexp pexp =
   | Pexp_sequence _ -> "Pexp_sequence"
   | Pexp_while _ -> "Pexp_while"
   | Pexp_for _ -> "Pexp_for"
+  | Pexp_for_of _ -> "Pexp_for_of"
   | Pexp_constraint _ -> "Pexp_constraint"
   | Pexp_coerce _ -> "Pexp_coerce"
   | Pexp_send _ -> "Pexp_send"

compiler/core/j.ml

@@ -264,6 +264,7 @@ and statement_desc =
       * for_ident
       * for_direction
       * block
+  | ForOf of for_ident * expression * block
   | Continue
   | Break (* only used when inline a fucntion *)
   | Return of expression

compiler/core/js_analyzer.ml

@@ -135,8 +135,8 @@ let no_side_effect_obj =
         | Throw _ | Debugger | Break | Variable _ | Continue ->
           raise_notrace Not_found
         | Exp e -> self.expression self e
-        | Int_switch _ | String_switch _ | ForRange _ | If _ | While _ | Block _
-        | Return _ | Try _ ->
+        | Int_switch _ | String_switch _ | ForRange _ | ForOf _ | If _ | While _
+        | Block _ | Return _ | Try _ ->
           super.statement self s);
     expression =
       (fun _ s ->
@@ -255,7 +255,7 @@ and eq_statement ({statement_desc = x0} : J.statement)
     match y0 with
     | Block ys0 -> eq_block xs0 ys0
     | _ -> false)
-  | Variable _ | If _ | While _ | ForRange _ | Continue | Int_switch _
+  | Variable _ | If _ | While _ | ForRange _ | ForOf _ | Continue | Int_switch _
   | String_switch _ | Throw _ | Try _ ->
     false
 

compiler/core/js_dump.ml

@@ -1478,6 +1478,21 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
           brace_block cxt f s)
     in
     action cxt
+  | ForOf (id, iterable, s) ->
+    P.vgroup f 0 (fun _ ->
+        P.group f 0 (fun _ ->
+            P.string f L.for_;
+            P.space f;
+            P.paren_group f 1 (fun _ ->
+                P.string f L.let_;
+                P.space f;
+                ignore (Ext_pp_scope.ident cxt f id);
+                P.space f;
+                P.string f L.of_;
+                P.space f;
+                ignore (expression ~level:0 cxt f iterable)));
+        P.space f;
+        brace_block cxt f s)
   | Continue ->
     continue f;
     cxt

compiler/core/js_dump_lit.ml

@@ -90,6 +90,8 @@ let if_ = "if"
 
 let for_ = "for"
 
+let of_ = "of"
+
 let try_ = "try"
 
 let finally = "finally"

compiler/core/js_fold.ml

@@ -241,6 +241,11 @@ class fold =
         let _self = _self#for_direction _x3 in
         let _self = _self#block _x4 in
         _self
+      | ForOf (_x0, _x1, _x2) ->
+        let _self = _self#for_ident _x0 in
+        let _self = _self#expression _x1 in
+        let _self = _self#block _x2 in
+        _self
       | Continue -> _self
       | Break -> _self
       | Return _x0 ->

compiler/core/js_pass_scope.ml

@@ -238,7 +238,7 @@ let record_scope_pass =
     statement =
       (fun self state x ->
         match x.statement_desc with
-        | ForRange (_, _, loop_id, _, _) ->
+        | ForRange (_, _, loop_id, _, _) | ForOf (loop_id, _, _) ->
           (* TODO: simplify definition of For *)
           let {
             defined_idents = defined_idents';

compiler/core/js_record_fold.ml

@@ -245,6 +245,11 @@ let statement_desc : 'a. ('a, statement_desc) fn =
     let st = for_direction _self st _x3 in
     let st = _self.block _self st _x4 in
     st
+  | ForOf (_x0, _x1, _x2) ->
+    let st = _self.for_ident _self st _x0 in
+    let st = _self.expression _self st _x1 in
+    let st = _self.block _self st _x2 in
+    st
   | Continue -> st
   | Break -> st
   | Return _x0 ->

compiler/core/js_record_iter.ml

@@ -179,6 +179,10 @@ let statement_desc : statement_desc fn =
     _self.for_ident _self _x2;
     for_direction _self _x3;
     _self.block _self _x4
+  | ForOf (_x0, _x1, _x2) ->
+    _self.for_ident _self _x0;
+    _self.expression _self _x1;
+    _self.block _self _x2
   | Continue -> ()
   | Break -> ()
   | Return _x0 -> _self.expression _self _x0

compiler/core/js_record_map.ml

@@ -243,6 +243,11 @@ let statement_desc : statement_desc fn =
     let _x3 = for_direction _self _x3 in
     let _x4 = _self.block _self _x4 in
     ForRange (_x0, _x1, _x2, _x3, _x4)
+  | ForOf (_x0, _x1, _x2) ->
+    let _x0 = _self.for_ident _self _x0 in
+    let _x1 = _self.expression _self _x1 in
+    let _x2 = _self.block _self _x2 in
+    ForOf (_x0, _x1, _x2)
   | Continue as v -> v
   | Break as v -> v
   | Return _x0 ->

compiler/core/js_stmt_make.ml

@@ -325,6 +325,9 @@ let for_ ?comment for_ident_expression finish_ident_expression id direction
     comment;
   }
 
+let for_of ?comment iterable_expression id (b : J.block) : t =
+  {statement_desc = ForOf (id, iterable_expression, b); comment}
+
 let try_ ?comment ?with_ ?finally body : t =
   {statement_desc = Try (body, with_, finally); comment}
 

compiler/core/js_stmt_make.mli

@@ -141,6 +141,8 @@ val for_ :
   J.block ->
   t
 
+val for_of : ?comment:string -> J.expression -> J.ident -> J.block -> t
+
 val try_ :
   ?comment:string ->
   ?with_:J.ident * J.block ->

compiler/core/lam.ml

@@ -106,6 +106,7 @@ module Types = struct
     | Lsequence of t * t
     | Lwhile of t * t
     | Lfor of ident * t * t * Asttypes.direction_flag * t
+    | Lfor_of of ident * t * t
     | Lassign of ident * t
   (* | Lsend of Lam_compat.meth_kind * t * t * t list * Location.t *)
 end
@@ -158,6 +159,7 @@ module X = struct
     | Lsequence of t * t
     | Lwhile of t * t
     | Lfor of ident * t * t * Asttypes.direction_flag * t
+    | Lfor_of of ident * t * t
     | Lassign of ident * t
   (* | Lsend of Lam_compat.meth_kind * t * t * t list * Location.t *)
 end
@@ -246,6 +248,10 @@ let inner_map (l : t) (f : t -> X.t) : X.t =
     let e2 = f e2 in
     let e3 = f e3 in
     Lfor (v, e1, e2, dir, e3)
+  | Lfor_of (v, e1, e2) ->
+    let e1 = f e1 in
+    let e2 = f e2 in
+    Lfor_of (v, e1, e2)
   | Lassign (id, e) ->
     let e = f e in
     Lassign (id, e)
@@ -401,7 +407,8 @@ let rec eq_approx (l1 : t) (l2 : t) =
   | Lfunction _
   | Llet (_, _, _, _)
   | Lletrec _ | Lswitch _ | Lstaticcatch _ | Ltrywith _
-  | Lfor (_, _, _, _, _) ->
+  | Lfor (_, _, _, _, _)
+  | Lfor_of (_, _, _) ->
     false
 
 and eq_option l1 l2 =
@@ -459,6 +466,7 @@ let letrec bindings body : t = Lletrec (bindings, body)
 let while_ a b : t = Lwhile (a, b)
 let try_ body id handler : t = Ltrywith (body, id, handler)
 let for_ v e1 e2 dir e3 : t = Lfor (v, e1, e2, dir, e3)
+let for_of v e1 e2 : t = Lfor_of (v, e1, e2)
 let assign v l : t = Lassign (v, l)
 let staticcatch a b c : t = Lstaticcatch (a, b, c)
 let staticraise a b : t = Lstaticraise (a, b)

compiler/core/lam.mli

@@ -79,6 +79,7 @@ and t = private
   | Lsequence of t * t
   | Lwhile of t * t
   | Lfor of ident * t * t * Asttypes.direction_flag * t
+  | Lfor_of of ident * t * t
   | Lassign of ident * t
 
 (* | Lsend of Lambda.meth_kind * t * t * t list * Location.t *)
@@ -164,6 +165,8 @@ val staticraise : int -> t list -> t
 
 val for_ : ident -> t -> t -> Asttypes.direction_flag -> t -> t
 
+val for_of : ident -> t -> t -> t
+
 (**************************************************************)
 
 val eq_approx : t -> t -> bool

compiler/core/lam_analysis.ml

@@ -119,6 +119,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
   | Lwhile _ ->
     false (* conservative here, non-terminating loop does have side effect *)
   | Lfor _ -> false
+  | Lfor_of _ -> false
   | Lassign _ -> false (* actually it depends ... *)
   (* | Lsend _ -> false  *)
   | Lapply
@@ -179,6 +180,7 @@ let rec size (lam : Lam.t) =
     | Lsequence (l1, l2) -> size l1 + size l2
     | Lwhile _ -> really_big ()
     | Lfor _ -> really_big ()
+    | Lfor_of _ -> really_big ()
     | Lassign (_, v) -> 1 + size v
     (* This is side effectful,  be careful *)
     (* | Lsend _  ->  really_big () *)

compiler/core/lam_arity_analysis.ml

@@ -129,7 +129,8 @@ let rec get_arity (meta : Lam_stats.t) (lam : Lam.t) : Lam_arity.t =
   | Lifthenelse (_, l2, l3) -> all_lambdas meta [l2; l3]
   | Lsequence (_, l2) -> get_arity meta l2
   | Lstaticraise _ (* since it will not be in tail position *) -> Lam_arity.na
-  | Lwhile _ | Lfor _ | Lassign _ -> Lam_arity.non_function_arity_info
+  | Lwhile _ | Lfor _ | Lfor_of _ | Lassign _ ->
+    Lam_arity.non_function_arity_info
 
 and all_lambdas meta (xs : Lam.t list) =
   match xs with

compiler/core/lam_bounded_vars.ml

@@ -103,6 +103,11 @@ let rewrite (map : _ Hash_ident.t) (lam : Lam.t) : Lam.t =
       let l2 = aux l2 in
       let l3 = aux l3 in
       Lam.for_ ident (aux l1) l2 dir l3
+    | Lfor_of (ident, l1, l2) ->
+      let ident = rebind ident in
+      let l1 = aux l1 in
+      let l2 = aux l2 in
+      Lam.for_of ident l1 l2
     | Lconst _ -> lam
     | Lprim {primitive; args; loc} ->
       (* here it makes sure that global vars are not rebound *)

compiler/core/lam_check.ml

@@ -62,6 +62,9 @@ let check file lam =
       check_staticfails e1 cxt;
       check_staticfails e2 cxt;
       check_staticfails e3 Set_int.empty
+    | Lfor_of (_v, e1, e2) ->
+      check_staticfails e1 cxt;
+      check_staticfails e2 Set_int.empty
     | Llet (_str, _id, arg, body) -> check_list [arg; body] cxt
     | Lletrec (decl, body) ->
       check_list_snd decl cxt;
@@ -146,6 +149,10 @@ let check file lam =
       iter e2;
       def v;
       iter e3
+    | Lfor_of (v, e1, e2) ->
+      iter e1;
+      def v;
+      iter e2
     | Lassign (id, e) ->
       use id;
       iter e

compiler/core/lam_closure.ml

@@ -134,6 +134,10 @@ let free_variables (export_idents : Set_ident.t) (params : stats Map_ident.t)
       iter sink_pos e1;
       iter sink_pos e2;
       iter sink_pos e3
+    | Lfor_of (v, e1, e2) ->
+      local_add v;
+      iter sink_pos e1;
+      iter sink_pos e2
     | Lassign (id, e) ->
       used top id;
       iter top e

compiler/core/lam_compile.ml

@@ -1181,6 +1181,23 @@ let compile output_prefix =
     in
     Js_output.output_of_block_and_expression lambda_cxt.continuation block
       E.unit
+  and compile_for_of (id : J.for_ident) (iterable : Lam.t) (body : Lam.t)
+      (lambda_cxt : Lam_compile_context.t) =
+    let new_cxt = {lambda_cxt with continuation = NeedValue Not_tail} in
+    let block =
+      match compile_lambda new_cxt iterable with
+      | {value = None} -> assert false
+      | {block = b1; value = Some e1} ->
+        let block_body =
+          Js_output.output_as_block
+            (compile_lambda
+               {lambda_cxt with continuation = EffectCall Not_tail}
+               body)
+        in
+        Ext_list.append b1 [S.for_of e1 id block_body]
+    in
+    Js_output.output_of_block_and_expression lambda_cxt.continuation block
+      E.unit
   and compile_assign id (lambda : Lam.t) (lambda_cxt : Lam_compile_context.t) =
     let block =
       match lambda with
@@ -1824,6 +1841,7 @@ let compile output_prefix =
         compile_for id start finish
           (if direction = Upto then Upto else Downto)
           body lambda_cxt)
+    | Lfor_of (id, iterable, body) -> compile_for_of id iterable body lambda_cxt
     | Lassign (id, lambda) -> compile_assign id lambda lambda_cxt
     | Ltrywith (lam, id, catch) ->
       (* generate documentation *)

compiler/core/lam_convert.ml

@@ -89,6 +89,7 @@ let exception_id_destructed (l : Lam.t) (fv : Ident.t) : bool =
     | Llet (_str, _id, arg, body) -> hit arg || hit body
     | Lletrec (decl, body) -> hit body || hit_list_snd decl
     | Lfor (_v, e1, e2, _dir, e3) -> hit e1 || hit e2 || hit e3
+    | Lfor_of (_v, e1, e2) -> hit e1 || hit e2
     | Lconst _ -> false
     | Lapply {ap_func; ap_args; _} -> hit ap_func || hit_list ap_args
     | Lglobal_module _ (* global persistent module, play safe *) -> false
@@ -507,6 +508,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
     | Lwhile (b, body) -> Lam.while_ (convert_aux b) (convert_aux body)
     | Lfor (id, from_, to_, dir, loop) ->
       Lam.for_ id (convert_aux from_) (convert_aux to_) dir (convert_aux loop)
+    | Lfor_of (id, iterable, body) ->
+      Lam.for_of id (convert_aux iterable) (convert_aux body)
     | Lassign (id, body) -> Lam.assign id (convert_aux body)
   and convert_let (kind : Lam_compat.let_kind) id (e : Lambda.lambda) body :
       Lam.t =

compiler/core/lam_exit_count.ml

@@ -96,6 +96,9 @@ let count_helper (lam : Lam.t) : collection =
       count l1;
       count l2;
       count l3
+    | Lfor_of (_, l1, l2) ->
+      count l1;
+      count l2
     | Lassign (_, l) -> count l
   and count_default sw =
     match sw.sw_failaction with

compiler/core/lam_free_variables.ml

@@ -57,6 +57,10 @@ let pass_free_variables (l : Lam.t) : Set_ident.t =
       free e2;
       free e3;
       fv := Set_ident.remove !fv v
+    | Lfor_of (v, e1, e2) ->
+      free e1;
+      free e2;
+      fv := Set_ident.remove !fv v
     | Lconst _ -> ()
     | Lapply {ap_func; ap_args; _} ->
       free ap_func;

compiler/core/lam_hit.ml

@@ -43,6 +43,7 @@ let hit_variables (fv : Set_ident.t) (l : t) : bool =
     | Llet (_str, _id, arg, body) -> hit arg || hit body
     | Lletrec (decl, body) -> hit body || hit_list_snd decl
     | Lfor (_v, e1, e2, _dir, e3) -> hit e1 || hit e2 || hit e3
+    | Lfor_of (_v, e1, e2) -> hit e1 || hit e2
     | Lconst _ -> false
     | Lapply {ap_func; ap_args; _} -> hit ap_func || hit_list ap_args
     | Lglobal_module _ (* global persistent module, play safe *) -> false
@@ -78,6 +79,7 @@ let hit_variable (fv : Ident.t) (l : t) : bool =
     | Llet (_str, _id, arg, body) -> hit arg || hit body
     | Lletrec (decl, body) -> hit body || hit_list_snd decl
     | Lfor (_v, e1, e2, _dir, e3) -> hit e1 || hit e2 || hit e3
+    | Lfor_of (_v, e1, e2) -> hit e1 || hit e2
     | Lconst _ -> false
     | Lapply {ap_func; ap_args; _} -> hit ap_func || hit_list ap_args
     | Lglobal_module _ (* global persistent module, play safe *) -> false

compiler/core/lam_iter.ml

@@ -79,6 +79,9 @@ let inner_iter (l : t) (f : t -> unit) : unit =
     f e1;
     f e2;
     f e3
+  | Lfor_of (_v, e1, e2) ->
+    f e1;
+    f e2
   | Lassign (_id, e) -> f e
 
 let inner_exists (l : t) (f : t -> bool) : bool =
@@ -112,4 +115,5 @@ let inner_exists (l : t) (f : t -> bool) : bool =
   | Lsequence (e1, e2) -> f e1 || f e2
   | Lwhile (e1, e2) -> f e1 || f e2
   | Lfor (_v, e1, e2, _dir, e3) -> f e1 || f e2 || f e3
+  | Lfor_of (_v, e1, e2) -> f e1 || f e2
   | Lassign (_id, e) -> f e