diff --git a/lib/Ast.ml b/lib/Ast.ml index 47b7af461d..911394cd19 100644 --- a/lib/Ast.ml +++ b/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 diff --git a/lib/Cmts.ml b/lib/Cmts.ml index c9221fbeaf..e79eb7adb8 100644 --- a/lib/Cmts.ml +++ b/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 diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index e38f1e1c23..0a6495da87 100644 --- a/lib/Fmt_ast.ml +++ b/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 diff --git a/lib/Normalize_extended_ast.ml b/lib/Normalize_extended_ast.ml index 2fba078573..d9805349a0 100644 --- a/lib/Normalize_extended_ast.ml +++ b/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 = diff --git a/lib/Sugar.ml b/lib/Sugar.ml index 52c520978e..056fe2eff0 100644 --- a/lib/Sugar.ml +++ b/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 diff --git a/lib/Sugar.mli b/lib/Sugar.mli index c97c5d4bde..6dac60d742 100644 --- a/lib/Sugar.mli +++ b/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 diff --git a/test/passing/tests/attributes.ml b/test/passing/tests/attributes.ml index 2ea68488d3..3310eda148 100644 --- a/test/passing/tests/attributes.ml +++ b/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 diff --git a/vendor/parser-extended/ast_helper.ml b/vendor/parser-extended/ast_helper.ml index a245df0856..4b3d1e5351 100644 --- a/vendor/parser-extended/ast_helper.ml +++ b/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)) diff --git a/vendor/parser-extended/ast_mapper.ml b/vendor/parser-extended/ast_mapper.ml index 66f72c1ab8..9f904551f5 100644 --- a/vendor/parser-extended/ast_mapper.ml +++ b/vendor/parser-extended/ast_mapper.ml @@ -557,8 +557,13 @@ module E = struct | Pexp_ifthenelse (eN, e2) -> ifthenelse ~loc ~attrs (List.map (map_if_branch sub) eN) (map_opt (sub.expr sub) e2) - | Pexp_sequence (e1, e2) -> - sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_sequence el -> + sequence ~loc ~attrs + (List.map (fun (exp, ext_opt) -> + let exp = sub.expr sub exp in + let ext_opt = map_opt (map_loc sub) ext_opt in + exp, ext_opt) + el) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> diff --git a/vendor/parser-extended/parser.mly b/vendor/parser-extended/parser.mly index 5fb12a2710..ba289bcde1 100644 --- a/vendor/parser-extended/parser.mly +++ b/vendor/parser-extended/parser.mly @@ -2108,16 +2108,19 @@ class_type_declarations: /* Core expressions */ +seq_expr_aux: + | expr %prec below_SEMI { [ $1, None ] } + | expr SEMI { [ $1, None ] } + | expr SEMI seq_expr_aux + { ($1, None) :: $3 } + | expr SEMI PERCENT attr_id seq_expr_aux + { ($1, Some $4) :: $5 } +; seq_expr: - | expr %prec below_SEMI { $1 } - | expr SEMI { $1 } - | mkexp(expr SEMI seq_expr - { Pexp_sequence($1, $3) }) - { $1 } - | expr SEMI PERCENT attr_id seq_expr - { let seq = mkexp ~loc:$sloc (Pexp_sequence ($1, $5)) in - let payload = PStr [mkstrexp seq []] in - mkexp ~loc:$sloc (Pexp_extension ($4, payload)) } + seq_expr_aux + { match $1 with + | [ x, _ ] -> x + | xx -> mkexp ~loc:$sloc (Pexp_sequence xx) } ; labeled_simple_pattern: QUESTION LPAREN label_let_pattern opt_default RPAREN diff --git a/vendor/parser-extended/parsetree.mli b/vendor/parser-extended/parsetree.mli index 82f3ce85bc..d781866bf4 100644 --- a/vendor/parser-extended/parsetree.mli +++ b/vendor/parser-extended/parsetree.mli @@ -372,7 +372,10 @@ and expression_desc = | Pexp_list of expression list (** [[ E1; ...; En ]] *) | Pexp_ifthenelse of if_branch list * expression option (** [if E1 then E2 else E3] *) - | Pexp_sequence of expression * expression (** [E1; E2] *) + | Pexp_sequence of (expression * string loc option) list + (** [Pexp_sequence [(E1, None); (E2, Some ext); (E3, None)] ] represents + [E1 ; E2 ;%ext E3]. + The last expression always has a [None] extension. *) | Pexp_while of expression * expression (** [while E1 do E2 done] *) | Pexp_for of pattern * expression * expression * direction_flag * expression (** [Pexp_for(i, E1, E2, direction, E3)] represents: diff --git a/vendor/parser-extended/printast.ml b/vendor/parser-extended/printast.ml index e8306a21e8..aec6188fb7 100644 --- a/vendor/parser-extended/printast.ml +++ b/vendor/parser-extended/printast.ml @@ -398,10 +398,13 @@ and expression i ppf x = line i ppf "Pexp_ifthenelse\n"; list i if_branch ppf eN; option i expression ppf eo; - | Pexp_sequence (e1, e2) -> + | Pexp_sequence l -> line i ppf "Pexp_sequence\n"; - expression i ppf e1; - expression i ppf e2; + list i (fun i ppf (exp, ext_opt) -> + expression i ppf exp; + option i (fun i ppf -> + line i ppf ";%a" fmt_string_loc) ppf ext_opt) + ppf l | Pexp_while (e1, e2) -> line i ppf "Pexp_while\n"; expression i ppf e1;