New feature: break/continue in loops

analysis/examples/larger-project/src/Unison.res

@@ -1,20 +1,20 @@
 // Exmple of several DCE checks operating in unison
 
-type break =
+type break_ =
   | IfNeed
   | Never
   | Always
 
 type t = {
-  break: break,
+  break_: break_,
   doc: string,
 }
 
 type rec stack =
   | Empty
   | Cons(t, stack)
 
-let group = (~break=IfNeed, doc) => {break: break, doc: doc}
+let group = (~break_=IfNeed, doc) => {break_, doc: doc}
 
 let rec fits = (w, stack) =>
   switch stack {
@@ -25,8 +25,8 @@ let rec fits = (w, stack) =>
 
 let rec toString = (~width, stack) =>
   switch stack {
-  | Cons({break, doc}, stack) =>
-    switch break {
+  | Cons({break_, doc}, stack) =>
+    switch break_ {
     | IfNeed => (fits(width, stack) ? "fits " : "no ") ++ (stack |> toString(~width=width - 1))
     | Never => "never " ++ (doc ++ (stack |> toString(~width=width - 1)))
     | Always => "always " ++ (doc ++ (stack |> toString(~width=width - 1)))
@@ -35,5 +35,5 @@ let rec toString = (~width, stack) =>
   }
 
 toString(~width=80, Empty)
-toString(~width=80, Cons(group(~break=Never, "abc"), Empty))
-toString(~width=80, Cons(group(~break=Always, "d"), Empty))
+toString(~width=80, Cons(group(~break_=Never, "abc"), Empty))
+toString(~width=80, Cons(group(~break_=Always, "d"), Empty))

analysis/examples/larger-project/src/res_doc.res

@@ -330,8 +330,8 @@ let debug = t => {
           text(")"),
         }),
       )
-    | LineBreak(break) =>
-      let breakTxt = switch break {
+    | LineBreak(break_) =>
+      let breakTxt = switch break_ {
       | Classic => "Classic"
       | Soft => "Soft"
       | Hard => "Hard"

analysis/src/Utils.ml

@@ -98,6 +98,8 @@ let identifyPexp pexp =
   | Pexp_array _ -> "Pexp_array"
   | Pexp_ifthenelse _ -> "Pexp_ifthenelse"
   | Pexp_sequence _ -> "Pexp_sequence"
+  | Pexp_break -> "Pexp_break"
+  | Pexp_continue -> "Pexp_continue"
   | Pexp_while _ -> "Pexp_while"
   | Pexp_for _ -> "Pexp_for"
   | Pexp_constraint _ -> "Pexp_constraint"

compiler/core/j.ml

@@ -249,23 +249,25 @@ and case_clause = {
 
 and string_clause = Ast_untagged_variants.tag_type * case_clause
 and int_clause = int * case_clause
+and label = string
 
 and statement_desc =
   | Block of block
   | Variable of variable_declaration
   (* Function declaration and Variable declaration  *)
   | Exp of expression
   | If of expression * block * block
-  | While of expression * block
+  | While of label option * expression * block
     (* check if it contains loop mutable values, happens in nested loop *)
   | ForRange of
-      for_ident_expression option
+      label option
+      * for_ident_expression option
       * finish_ident_expression
       * for_ident
       * for_direction
       * block
-  | Continue
-  | Break (* only used when inline a fucntion *)
+  | Continue of label option
+  | Break of label option (* only used when inline a fucntion *)
   | Return of expression
   (* Here we need track back a bit ?, move Return to Function ...
      Then we can only have one Return, which is not good *)

compiler/core/js_analyzer.ml

@@ -132,7 +132,7 @@ let no_side_effect_obj =
     statement =
       (fun self s ->
         match s.statement_desc with
-        | Throw _ | Debugger | Break | Variable _ | Continue ->
+        | Throw _ | Debugger | Break _ | Variable _ | Continue _ ->
           raise_notrace Not_found
         | Exp e -> self.expression self e
         | Int_switch _ | String_switch _ | ForRange _ | If _ | While _ | Block _
@@ -250,12 +250,12 @@ and eq_statement ({statement_desc = x0} : J.statement)
     | Return b -> eq_expression a b
     | _ -> false)
   | Debugger -> y0 = Debugger
-  | Break -> y0 = Break
+  | Break label -> y0 = Break label
   | Block xs0 -> (
     match y0 with
     | Block ys0 -> eq_block xs0 ys0
     | _ -> false)
-  | Variable _ | If _ | While _ | ForRange _ | Continue | Int_switch _
+  | Variable _ | If _ | While _ | ForRange _ | Continue _ | Int_switch _
   | String_switch _ | Throw _ | Try _ ->
     false
 

compiler/core/js_dump.ml

@@ -237,15 +237,6 @@ let debugger_nl f =
   semi f;
   P.newline f
 
-let break_nl f =
-  P.string f L.break;
-  semi f;
-  P.newline f
-
-let continue f =
-  P.string f L.continue;
-  semi f
-
 let formal_parameter_list cxt f l = iter_lst cxt f l Ext_pp_scope.ident comma_sp
 
 (* IdentMap *)
@@ -1390,9 +1381,18 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
       P.string f L.else_;
       P.space f;
       brace_block cxt f s2)
-  | While (e, s) ->
+  | While (label, e, s) ->
     (*  FIXME: print scope as well *)
     let cxt =
+      let cxt =
+        match label with
+        | None -> cxt
+        | Some label ->
+          P.string f label;
+          P.string f L.colon;
+          P.space f;
+          cxt
+      in
       match e.expression_desc with
       | Number (Int {i = 1l}) ->
         P.string f L.while_;
@@ -1412,9 +1412,18 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
     let cxt = brace_block cxt f s in
     semi f;
     cxt
-  | ForRange (for_ident_expression, finish, id, direction, s) ->
+  | ForRange (label, for_ident_expression, finish, id, direction, s) ->
     let action cxt =
       P.vgroup f 0 (fun _ ->
+          let cxt =
+            match label with
+            | None -> cxt
+            | Some label ->
+              P.string f label;
+              P.string f L.colon;
+              P.space f;
+              cxt
+          in
           let cxt =
             P.group f 0 (fun _ ->
                 (* The only place that [semi] may have semantics here *)
@@ -1489,15 +1498,28 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt =
           brace_block cxt f s)
     in
     action cxt
-  | Continue ->
-    continue f;
+  | Continue label ->
+    P.string f L.continue;
+    (match label with
+    | None -> ()
+    | Some label ->
+      P.space f;
+      P.string f label);
+    semi f;
     cxt
   (* P.newline f;  #2642 *)
   | Debugger ->
     debugger_nl f;
     cxt
-  | Break ->
-    break_nl f;
+  | Break label ->
+    P.string f L.break;
+    (match label with
+    | None -> ()
+    | Some label ->
+      P.space f;
+      P.string f label);
+    semi f;
+    P.newline f;
     cxt
   | Return e -> (
     match e.expression_desc with

compiler/core/js_fold.ml

@@ -228,11 +228,11 @@ class fold =
         let _self = _self#block _x1 in
         let _self = _self#block _x2 in
         _self
-      | While (_x0, _x1) ->
+      | While (_label, _x0, _x1) ->
         let _self = _self#expression _x0 in
         let _self = _self#block _x1 in
         _self
-      | ForRange (_x0, _x1, _x2, _x3, _x4) ->
+      | ForRange (_label, _x0, _x1, _x2, _x3, _x4) ->
         let _self =
           option (fun _self -> _self#for_ident_expression) _self _x0
         in
@@ -241,8 +241,8 @@ class fold =
         let _self = _self#for_direction _x3 in
         let _self = _self#block _x4 in
         _self
-      | Continue -> _self
-      | Break -> _self
+      | Continue _ -> _self
+      | Break _ -> _self
       | Return _x0 ->
         let _self = _self#expression _x0 in
         _self

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, _, _) ->
           (* TODO: simplify definition of For *)
           let {
             defined_idents = defined_idents';
@@ -287,7 +287,7 @@ let record_scope_pass =
             closured_idents =
               Set_ident.union state.closured_idents lexical_scope;
           }
-        | While (pred, body) ->
+        | While (_, pred, body) ->
           with_in_loop
             (self.block self
                (with_in_loop (self.expression self state pred) true)

compiler/core/js_record_fold.ml

@@ -234,19 +234,19 @@ let statement_desc : 'a. ('a, statement_desc) fn =
     let st = _self.block _self st _x1 in
     let st = _self.block _self st _x2 in
     st
-  | While (_x0, _x1) ->
+  | While (_label, _x0, _x1) ->
     let st = _self.expression _self st _x0 in
     let st = _self.block _self st _x1 in
     st
-  | ForRange (_x0, _x1, _x2, _x3, _x4) ->
+  | ForRange (_label, _x0, _x1, _x2, _x3, _x4) ->
     let st = option for_ident_expression _self st _x0 in
     let st = finish_ident_expression _self st _x1 in
     let st = _self.for_ident _self st _x2 in
     let st = for_direction _self st _x3 in
     let st = _self.block _self st _x4 in
     st
-  | Continue -> st
-  | Break -> st
+  | Continue _ -> st
+  | Break _ -> st
   | Return _x0 ->
     let st = _self.expression _self st _x0 in
     st

compiler/core/js_record_iter.ml

@@ -170,17 +170,17 @@ let statement_desc : statement_desc fn =
     _self.expression _self _x0;
     _self.block _self _x1;
     _self.block _self _x2
-  | While (_x0, _x1) ->
+  | While (_label, _x0, _x1) ->
     _self.expression _self _x0;
     _self.block _self _x1
-  | ForRange (_x0, _x1, _x2, _x3, _x4) ->
+  | ForRange (_label, _x0, _x1, _x2, _x3, _x4) ->
     option for_ident_expression _self _x0;
     finish_ident_expression _self _x1;
     _self.for_ident _self _x2;
     for_direction _self _x3;
     _self.block _self _x4
-  | Continue -> ()
-  | Break -> ()
+  | Continue _ -> ()
+  | Break _ -> ()
   | Return _x0 -> _self.expression _self _x0
   | Int_switch (_x0, _x1, _x2) ->
     _self.expression _self _x0;

compiler/core/js_record_map.ml

@@ -232,19 +232,19 @@ let statement_desc : statement_desc fn =
     let _x1 = _self.block _self _x1 in
     let _x2 = _self.block _self _x2 in
     If (_x0, _x1, _x2)
-  | While (_x0, _x1) ->
+  | While (_label, _x0, _x1) ->
     let _x0 = _self.expression _self _x0 in
     let _x1 = _self.block _self _x1 in
-    While (_x0, _x1)
-  | ForRange (_x0, _x1, _x2, _x3, _x4) ->
+    While (_label, _x0, _x1)
+  | ForRange (_label, _x0, _x1, _x2, _x3, _x4) ->
     let _x0 = option for_ident_expression _self _x0 in
     let _x1 = finish_ident_expression _self _x1 in
     let _x2 = _self.for_ident _self _x2 in
     let _x3 = for_direction _self _x3 in
     let _x4 = _self.block _self _x4 in
-    ForRange (_x0, _x1, _x2, _x3, _x4)
-  | Continue as v -> v
-  | Break as v -> v
+    ForRange (_label, _x0, _x1, _x2, _x3, _x4)
+  | Continue _ as v -> v
+  | Break _ as v -> v
   | Return _x0 ->
     let _x0 = _self.expression _self _x0 in
     Return _x0

compiler/core/js_stmt_make.ml

@@ -188,7 +188,7 @@ let rec block_last_is_return_throw_or_continue (x : J.block) =
   | [] -> false
   | [x] -> (
     match x.statement_desc with
-    | Return _ | Throw _ | Continue -> true
+    | Return _ | Throw _ | Continue _ | Break _ -> true
     | _ -> false)
   | _ :: rest -> block_last_is_return_throw_or_continue rest
 
@@ -314,20 +314,23 @@ let if_ ?comment ?declaration ?else_ (e : J.expression) (then_ : J.block) : t =
 let assign ?comment id e : t =
   {statement_desc = J.Exp (E.assign (E.var id) e); comment}
 
-let while_ ?comment (e : E.t) (st : J.block) : t =
-  {statement_desc = While (e, st); comment}
+let while_ ?comment ?label (e : E.t) (st : J.block) : t =
+  {statement_desc = While (label, e, st); comment}
 
-let for_ ?comment for_ident_expression finish_ident_expression id direction
-    (b : J.block) : t =
+let for_ ?comment ?label for_ident_expression finish_ident_expression id
+    direction (b : J.block) : t =
   {
     statement_desc =
-      ForRange (for_ident_expression, finish_ident_expression, id, direction, b);
+      ForRange
+        (label, for_ident_expression, finish_ident_expression, id, direction, b);
     comment;
   }
 
 let try_ ?comment ?with_ ?finally body : t =
   {statement_desc = Try (body, with_, finally); comment}
 
-let continue_ : t = {statement_desc = Continue; comment = None}
+let break_ ?label () : t = {statement_desc = Break label; comment = None}
+
+let continue_ ?label () : t = {statement_desc = Continue label; comment = None}
 
 let debugger_block : t list = [{statement_desc = Debugger; comment = None}]

compiler/core/js_stmt_make.mli

@@ -130,10 +130,11 @@ val assign : ?comment:string -> J.ident -> J.expression -> t
    J.ident ->
    t *)
 
-val while_ : ?comment:string -> J.expression -> J.block -> t
+val while_ : ?comment:string -> ?label:J.label -> J.expression -> J.block -> t
 
 val for_ :
   ?comment:string ->
+  ?label:J.label ->
   J.for_ident_expression option ->
   J.finish_ident_expression ->
   J.for_ident ->
@@ -163,6 +164,8 @@ val return_stmt : ?comment:string -> J.expression -> t
    unit  ->
    t *)
 
-val continue_ : t
+val break_ : ?label:J.label -> unit -> t
+
+val continue_ : ?label:J.label -> unit -> t
 
 val debugger_block : t list