Represent the expr sequence as a list

lib/Ast.ml

@@ -131,17 +131,7 @@ module Exp = struct
   let is_symbol = test_id ~f:Std_longident.is_symbol
 
   let is_sequence exp =
-    match exp.pexp_desc with
-    | Pexp_sequence _ -> true
-    | Pexp_extension
-        ( ext
-        , PStr
-            [ { pstr_desc=
-                  Pstr_eval (({pexp_desc= Pexp_sequence _; _} as e), [])
-              ; _ } ] )
-      when Source.extension_using_sugar ~name:ext ~payload:e.pexp_loc ->
-        true
-    | _ -> false
+    match exp.pexp_desc with Pexp_sequence _ -> true | _ -> false
 
   let has_trailing_attributes {pexp_desc; pexp_attributes; _} =
     match pexp_desc with
@@ -1343,6 +1333,7 @@ end = struct
     | Pld _ -> assert false
     | Exp ctx -> (
         let f eI = eI == exp in
+        let fst_f (eI, _) = eI == exp in
         let snd_f (_, eI) = eI == exp in
         match ctx.pexp_desc with
         | Pexp_extension (_, ext) -> assert (check_extensions ext)
@@ -1404,7 +1395,7 @@ end = struct
          |Pexp_send (e, _)
          |Pexp_setinstvar (_, e) ->
             assert (e == exp)
-        | Pexp_sequence (e1, e2) -> assert (e1 == exp || e2 == exp)
+        | Pexp_sequence eN -> assert (List.exists eN ~f:fst_f)
         | Pexp_setfield (e1, _, e2) | Pexp_while (e1, e2) ->
             assert (e1 == exp || e2 == exp)
         | Pexp_ifthenelse (eN, e) ->
@@ -1983,11 +1974,11 @@ end = struct
          |Pexp_lazy e
          |Pexp_open (_, e)
          |Pexp_letopen (_, e)
-         |Pexp_sequence (_, e)
          |Pexp_setfield (_, _, e)
          |Pexp_setinstvar (_, e)
          |Pexp_variant (_, Some e) ->
             continue e
+        | Pexp_sequence l -> continue (fst @@ List.last_exn l)
         | Pexp_cons l -> continue (List.last_exn l)
         | Pexp_ifthenelse (eN, None) -> continue (List.last_exn eN).if_body
         | Pexp_extension
@@ -2058,11 +2049,11 @@ end = struct
        |Pexp_open (_, e)
        |Pexp_letopen (_, e)
        |Pexp_fun (_, e)
-       |Pexp_sequence (_, e)
        |Pexp_setfield (_, _, e)
        |Pexp_setinstvar (_, e)
        |Pexp_variant (_, Some e) ->
           continue e
+      | Pexp_sequence l -> continue (fst @@ List.last_exn l)
       | Pexp_cons l -> continue (List.last_exn l)
       | Pexp_let (_, e, _)
        |Pexp_letop {body= e; _}
@@ -2133,21 +2124,13 @@ end = struct
       | Pexp_let _ | Pexp_match _ | Pexp_try _ -> true
       | _ -> false
     in
-    let exp_in_sequence lhs rhs exp =
-      match (lhs.pexp_desc, exp.pexp_attributes) with
-      | (Pexp_match _ | Pexp_try _), _ :: _ when lhs == exp -> true
+    let exp_in_sequence l exp =
+      let last, _ = List.last_exn l in
+      match (exp.pexp_desc, exp.pexp_attributes) with
+      | (Pexp_match _ | Pexp_try _), _ :: _ when not (last == exp) -> true
       | _, _ :: _ -> false
-      | ( Pexp_extension
-            ( _
-            , PStr
-                [ { pstr_desc= Pstr_eval ({pexp_desc= Pexp_sequence _; _}, [])
-                  ; _ } ] )
-        , _ )
-        when lhs == exp ->
-          true
-      | _ when lhs == exp -> exposed_right_exp Let_match exp
-      | _ when rhs == exp -> false
-      | _ -> failwith "exp must be lhs or rhs from the parent expression"
+      | _, [] ->
+          if last == exp then false else exposed_right_exp Let_match exp
     in
     assert_check_exp xexp ;
     Hashtbl.find marked_parenzed_inner_nested_match exp
@@ -2309,7 +2292,7 @@ end = struct
       | Pexp_override fields
         when List.exists fields ~f:(fun (_, e0) -> e0 == exp) ->
           exposed_right_exp Sequence exp
-      | Pexp_sequence (lhs, rhs) -> exp_in_sequence lhs rhs exp
+      | Pexp_sequence l -> exp_in_sequence l exp
       | Pexp_apply (_, args)
         when List.exists args ~f:(fun (_, e0) ->
                  match (e0.pexp_desc, e0.pexp_attributes) with

lib/Cmts.ml

@@ -334,7 +334,7 @@ let relocate_pattern_matching_cmts (t : t) src tok ~whole_loc ~matched_loc =
   in
   relocate_cmts_before t ~src:matched_loc ~sep:kwd_loc ~dst:whole_loc
 
-let relocate_ext_cmts (t : t) src (pre, pld) ~whole_loc =
+let relocate_ext_cmts (t : t) src (_, pld) ~whole_loc =
   let open Extended_ast in
   match pld with
   | PStr
@@ -348,18 +348,6 @@ let relocate_ext_cmts (t : t) src (pre, pld) ~whole_loc =
         ; pstr_loc } ]
     when Source.is_quoted_string src pstr_loc ->
       ()
-  | PStr
-      [ { pstr_desc=
-            Pstr_eval
-              ( { pexp_desc= Pexp_sequence (e1, _)
-                ; pexp_loc= _
-                ; pexp_loc_stack= _
-                ; pexp_attributes }
-              , [] )
-        ; pstr_loc= _ } ]
-    when List.is_empty pexp_attributes
-         && Source.extension_using_sugar ~name:pre ~payload:e1.pexp_loc ->
-      ()
   | PStr [{pstr_desc= Pstr_eval _; pstr_loc; _}] ->
       let kwd_loc =
         match Source.loc_of_first_token_at src whole_loc LBRACKETPERCENT with

lib/Fmt_ast.ml

@@ -1597,7 +1597,7 @@ and fmt_args_grouped ?epi:(global_epi = noop) c ctx args =
   in
   list_fl groups fmt_args
 
-and fmt_sequence c ?ext ~has_attr parens width xexp fmt_atrs =
+and fmt_sequence c ctx ~has_attr parens width elts fmt_atrs =
   let fmt_sep c ?(force_break = false) xe1 ext xe2 =
     let break =
       let l1 = xe1.ast.pexp_loc and l2 = xe2.ast.pexp_loc in
@@ -1608,38 +1608,43 @@ and fmt_sequence c ?ext ~has_attr parens width xexp fmt_atrs =
       then break 1 (-2)
       else break 1 0
     in
-    match c.conf.fmt_opts.sequence_style.v with
-    | `Before ->
-        break $ str ";"
-        $ fmt_extension_suffix c ext
-        $ fmt_or (Option.is_some ext)
-            (fmt_or parens space_break (Fmt.break 1 2))
-            (str " ")
-    | `Separator -> str " ;" $ fmt_extension_suffix c ext $ break
-    | `Terminator -> str ";" $ fmt_extension_suffix c ext $ break
+    match xe1.ast with
+    (* special case for Meta/Facebook *)
+    | { pexp_desc=
+          Pexp_extension
+            ( {txt= "Trace.call"; _}
+            , PStr
+                [ { pstr_desc= Pstr_eval ({pexp_desc= Pexp_fun _; _}, [])
+                  ; pstr_loc= _ } ] )
+      ; _ } ->
+        space_break $ str ";" $ space_break
+    | _ -> (
+      match c.conf.fmt_opts.sequence_style.v with
+      | `Before ->
+          break $ str ";"
+          $ fmt_extension_suffix c ext
+          $ fmt_or (Option.is_some ext)
+              (fmt_or parens space_break (Fmt.break 1 2))
+              (str " ")
+      | `Separator -> str " ;" $ fmt_extension_suffix c ext $ break
+      | `Terminator -> str ";" $ fmt_extension_suffix c ext $ break )
   in
   let is_simple x = is_simple c.conf width x in
-  let break (_, xexp1) (_, xexp2) =
+  let break (xexp1, _) (xexp2, _) =
     not (is_simple xexp1 && is_simple xexp2)
   in
-  let elts = Sugar.sequence c.cmts xexp in
-  ( match elts with
-  | (None, _) :: (first_ext, _) :: _ ->
-      let compare {txt= x; _} {txt= y; _} = String.compare x y in
-      assert (Option.compare compare first_ext ext = 0)
-  | _ -> impossible "at least two elements" ) ;
+  let elts = List.map elts ~f:(fun (e, ext) -> (sub_exp ~ctx e, ext)) in
   let grps = List.group elts ~break in
-  let fmt_seq ~prev (ext, curr) ~next:_ =
-    let f (_, prev) = fmt_sep c prev ext curr in
-    opt prev f $ fmt_expression c curr
+  let fmt_seq ~prev:_ (curr, ext) ~next =
+    fmt_expression c curr
+    $ opt next (fun (next, _) -> fmt_sep c curr ext next)
   in
-  let fmt_seq_list ~prev x ~next:_ =
-    let f prev =
-      let prev = snd (List.last_exn prev) in
-      let ext, curr = List.hd_exn x in
-      fmt_sep c ~force_break:true prev ext curr
-    in
-    opt prev f $ list_pn x fmt_seq
+  let fmt_seq_list ~prev:_ x ~next =
+    list_pn x fmt_seq
+    $ opt next (fun next ->
+          let curr, ext = List.last_exn x in
+          let next, _ = List.hd_exn next in
+          fmt_sep c ~force_break:true curr ext next )
   in
   hvbox 0
     (Params.Exp.wrap c.conf ~parens
@@ -1796,42 +1801,6 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
   @@
   match pexp_desc with
   | Pexp_apply (_, []) -> impossible "not produced by parser"
-  | Pexp_sequence
-      ( { pexp_desc=
-            Pexp_extension
-              ( name
-              , PStr
-                  [ ( { pstr_desc=
-                          Pstr_eval (({pexp_desc= Pexp_fun _; _} as call), [])
-                      ; pstr_loc= _ } as pld ) ] )
-        ; _ }
-      , e2 ) ->
-      let xargs, xbody = Sugar.fun_ c.cmts (sub_exp ~ctx:(Str pld) call) in
-      let fmt_cstr, xbody = type_constr_and_body c xbody in
-      let is_simple x = is_simple c.conf (expression_width c) x in
-      let break xexp1 xexp2 = not (is_simple xexp1 && is_simple xexp2) in
-      let grps =
-        List.group
-          (List.map ~f:snd (Sugar.sequence c.cmts (sub_exp ~ctx e2)))
-          ~break
-      in
-      let fmt_grp grp =
-        list grp (str " ;" $ space_break) (fmt_expression c)
-      in
-      pro
-      $ hvbox 0
-          (Params.parens_if parens c.conf
-             ( hvbox c.conf.fmt_opts.extension_indent.v
-                 (wrap (str "[") (str "]")
-                    ( str "%"
-                    $ hovbox 2
-                        ( fmt_str_loc c name $ str " fun "
-                        $ fmt_attributes c ~suf:" " call.pexp_attributes
-                        $ fmt_expr_fun_args c xargs $ fmt_opt fmt_cstr
-                        $ space_break $ str "->" )
-                    $ space_break $ fmt_expression c xbody ) )
-             $ space_break $ str ";" $ space_break
-             $ list grps (str " ;" $ force_break) fmt_grp ) )
   | Pexp_infix
       ( {txt= "|>"; loc}
       , e0
@@ -2618,24 +2587,9 @@ and fmt_expression c ?(box = true) ?(pro = noop) ?eol ?parens
                     $ str "with" $ p2.break_after_with )
               $ fmt_fields )
           $ fmt_atrs )
-  | Pexp_extension
-      ( ext
-      , PStr
-          [ { pstr_desc=
-                Pstr_eval
-                  ( ( {pexp_desc= Pexp_sequence _; pexp_attributes= []; _} as
-                      e1 )
-                  , _ )
-            ; pstr_loc= _ } ] )
-    when Source.extension_using_sugar ~name:ext ~payload:e1.pexp_loc
-         && List.length (Sugar.sequence c.cmts xexp) > 1 ->
-      pro
-      $ fmt_sequence ~has_attr c parens (expression_width c) xexp fmt_atrs
-          ~ext
-  | Pexp_sequence _ ->
+  | Pexp_sequence l ->
       pro
-      $ fmt_sequence ~has_attr c parens (expression_width c) xexp fmt_atrs
-          ?ext
+      $ fmt_sequence ~has_attr c ctx parens (expression_width c) l fmt_atrs
   | Pexp_setfield (e1, lid, e2) ->
       pro
       $ hvbox 0

lib/Normalize_extended_ast.ml

@@ -72,7 +72,6 @@ let sort_attributes : attributes -> attributes =
   List.sort ~compare:Poly.compare
 
 let make_mapper ~ignore_doc_comments ~normalize_doc =
-  let open Ast_helper in
   (* remove locations *)
   let location _ _ = Location.none in
   let attribute (m : Ast_mapper.mapper) (attr : attribute) =
@@ -124,19 +123,9 @@ let make_mapper ~ignore_doc_comments ~normalize_doc =
   in
   let expr (m : Ast_mapper.mapper) exp =
     let exp = {exp with pexp_loc_stack= []} in
-    let {pexp_desc; pexp_loc= loc1; pexp_attributes= attrs1; _} = exp in
+    let {pexp_desc; pexp_loc= _; pexp_attributes= _; _} = exp in
     match pexp_desc with
     | Pexp_constraint (e, {ptyp_desc= Ptyp_poly ([], _t); _}) -> m.expr m e
-    | Pexp_sequence
-        ( exp1
-        , { pexp_desc= Pexp_sequence (exp2, exp3)
-          ; pexp_loc= loc2
-          ; pexp_attributes= attrs2
-          ; _ } ) ->
-        m.expr m
-          (Exp.sequence ~loc:loc1 ~attrs:attrs1
-             (Exp.sequence ~loc:loc2 ~attrs:attrs2 exp1 exp2)
-             exp3 )
     | _ -> Ast_mapper.default_mapper.expr m exp
   in
   let typ (m : Ast_mapper.mapper) typ =

lib/Sugar.ml

@@ -75,57 +75,6 @@ module Exp = struct
     infix_ None ~child_expr:false xexp
 end
 
-let sequence cmts xexp =
-  let rec sequence_ ?(allow_attribute = true) ({ast= exp; _} as xexp) =
-    let ctx = Exp exp in
-    let {pexp_desc; pexp_loc; _} = exp in
-    match pexp_desc with
-    | Pexp_extension
-        ( ext
-        , PStr
-            [ { pstr_desc=
-                  Pstr_eval
-                    ( ( { pexp_desc= Pexp_sequence (e1, e2)
-                        ; pexp_attributes
-                        ; _ } as exp )
-                    , _ )
-              ; pstr_loc } ] )
-      when List.is_empty pexp_attributes
-           && Source.extension_using_sugar ~name:ext ~payload:e1.pexp_loc ->
-        let ctx = Exp exp in
-        if (not allow_attribute) && not (List.is_empty exp.pexp_attributes)
-        then [(None, xexp)]
-        else (
-          Cmts.relocate cmts ~src:pstr_loc ~before:e1.pexp_loc
-            ~after:e2.pexp_loc ;
-          Cmts.relocate cmts ~src:pexp_loc ~before:e1.pexp_loc
-            ~after:e2.pexp_loc ;
-          if Ast.exposed_right_exp Ast.Let_match e1 then
-            [(None, sub_exp ~ctx e1); (Some ext, sub_exp ~ctx e2)]
-          else
-            let l1 = sequence_ ~allow_attribute:false (sub_exp ~ctx e1) in
-            let l2 =
-              match sequence_ ~allow_attribute:false (sub_exp ~ctx e2) with
-              | [] -> []
-              | (_, e2) :: l2 -> (Some ext, e2) :: l2
-            in
-            List.append l1 l2 )
-    | Pexp_sequence (e1, e2) ->
-        if (not allow_attribute) && not (List.is_empty exp.pexp_attributes)
-        then [(None, xexp)]
-        else (
-          Cmts.relocate cmts ~src:pexp_loc ~before:e1.pexp_loc
-            ~after:e2.pexp_loc ;
-          if Ast.exposed_right_exp Ast.Let_match e1 then
-            [(None, sub_exp ~ctx e1); (None, sub_exp ~ctx e2)]
-          else
-            List.append
-              (sequence_ ~allow_attribute:false (sub_exp ~ctx e1))
-              (sequence_ ~allow_attribute:false (sub_exp ~ctx e2)) )
-    | _ -> [(None, xexp)]
-  in
-  sequence_ xexp
-
 let mod_with pmty =
   let rec mod_with_ ({ast= me; _} as xme) =
     let ctx = Mty me in

lib/Sugar.mli

@@ -33,11 +33,6 @@ module Exp : sig
       precedence of the infix operator. *)
 end
 
-val sequence :
-  Cmts.t -> expression Ast.xt -> (label loc option * expression Ast.xt) list
-(** [sequence cmts exp] returns the list of expressions (with the optional
-    extension) from a sequence of expressions [exp]. *)
-
 val mod_with :
      module_type Ast.xt
   -> (with_constraint list * Warnings.loc * attributes) list

test/passing/tests/attributes.ml

@@ -356,6 +356,11 @@ let _ =
   (match[@ocaml.warning "-4"] bar with _ -> ()) ;
   foo
 
+let _ =
+  (match[@ocaml.warning "-4"] bar with _ -> ()) ;
+  (match[@ocaml.warning "-4"] bar with _ -> ()) ;
+  foo
+
 let _ =
   (try[@ocaml.warning "-4"] bar with _ -> ()) ;
   foo

vendor/parser-extended/ast_helper.ml

@@ -140,7 +140,7 @@ module Exp = struct
   let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a)
   let list ?loc ?attrs a = mk ?loc ?attrs (Pexp_list a)
   let ifthenelse ?loc ?attrs a b = mk ?loc ?attrs (Pexp_ifthenelse (a, b))
-  let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b))
+  let sequence ?loc ?attrs a = mk ?loc ?attrs (Pexp_sequence a)
   let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b))
   let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e))
   let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b))