Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

feat: support type%foo extension sugar #2790

Merged
merged 2 commits into from
Aug 20, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,8 @@
(@anmonteiro, [#2784](https://github.com/reasonml/reason/pull/2784))
- Add support for module type substitutions
(@anmonteiro, [#2785](https://github.com/reasonml/reason/pull/2785))
- Support `type%foo` extension sugar syntax (@anmonteiro,
[#2790](https://github.com/reasonml/reason/pull/2790))

## 3.12.0

Expand Down
78 changes: 69 additions & 9 deletions src/reason-parser/reason_parser.mly
Original file line number Diff line number Diff line change
Expand Up @@ -1704,9 +1704,20 @@ structure_item:
$3
}
| type_declarations
{ let (nonrec_flag, tyl) = $1 in mkstr(Pstr_type (nonrec_flag, tyl)) }
{
let (nonrec_flag, tyl, loc, extension) = $1 in
wrap_str_ext
~loc
(mkstr(Pstr_type (nonrec_flag, tyl)))
extension
}
| str_type_extension
{ mkstr(Pstr_typext $1) }
{ let typext, loc, extension = $1 in
wrap_str_ext
~loc
(mkstr(Pstr_typext typext))
extension
}
| str_exception_declaration
{ mkstr(Pstr_exception (Ast_helper.Te.mk_exception ~loc:$1.pext_loc $1)) }
| item_attributes opt_LET_MODULE_ident module_binding_body
Expand Down Expand Up @@ -1933,11 +1944,21 @@ signature_item:
$3
}
| type_declarations
{ let (nonrec_flag, tyl) = $1 in Psig_type (nonrec_flag, tyl) }
{ let (nonrec_flag, tyl, loc, extension) = $1 in
wrap_sig_ext
~loc
(Psig_type (nonrec_flag, tyl))
extension
}
| type_subst_declarations
{ Psig_typesubst $1 }
| sig_type_extension
{ Psig_typext $1 }
{ let (typext, loc, extension) = $1 in
wrap_sig_ext
~loc
(Psig_typext typext)
extension
}
| sig_exception_declaration
{ Psig_exception $1 }
| item_attributes opt_LET_MODULE_ident module_declaration
Expand Down Expand Up @@ -4041,7 +4062,14 @@ type_declarations:
let loc = mklocation $startpos($2) endpos in
let ty = Ast_helper.Type.mk ident ~params:params ~cstrs:constraints
~kind ~priv ?manifest ~attrs:$1 ~loc in
($3, ty :: and_types)
($3, ty :: and_types, loc, None)
}
| item_attributes TYPE item_extension_sugar nonrec_flag type_declaration_details
{ let (ident, params, constraints, kind, priv, manifest), endpos, and_types = $5 in
let loc = mklocation $startpos($2) endpos in
let ty = Ast_helper.Type.mk ident ~params:params ~cstrs:constraints
~kind ~priv ?manifest ~attrs:$1 ~loc in
($4, ty :: and_types, loc, Some $3)
}
;

Expand Down Expand Up @@ -4296,29 +4324,61 @@ record_declaration:

str_type_extension:
attrs = item_attributes
TYPE flag = nonrec_flag
TYPE
flag = nonrec_flag
ident = as_loc(itype_longident)
params = type_variables_with_variance
PLUSEQ priv = embedded(private_flag)
constructors =
attributed_ext_constructors(either(extension_constructor_declaration, extension_constructor_rebind))
{ if flag <> Recursive then
not_expecting $startpos(flag) $endpos(flag) "nonrec flag";
Ast_helper.Te.mk ~params ~priv ~attrs ident constructors
let loc = mklocation $startpos($2) $endpos in
(Ast_helper.Te.mk ~loc ~params ~priv ~attrs ident constructors, loc, None)
}
| attrs = item_attributes
TYPE
extension = item_extension_sugar
flag = nonrec_flag
ident = as_loc(itype_longident)
params = type_variables_with_variance
PLUSEQ priv = embedded(private_flag)
constructors =
attributed_ext_constructors(either(extension_constructor_declaration, extension_constructor_rebind))
{ if flag <> Recursive then
not_expecting $startpos(flag) $endpos(flag) "nonrec flag";
let loc = mklocation $startpos($2) $endpos in
(Ast_helper.Te.mk ~loc ~params ~priv ~attrs ident constructors, loc, Some extension)
}
;

sig_type_extension:
attrs = item_attributes
TYPE flag = nonrec_flag
TYPE
flag = nonrec_flag
ident = as_loc(itype_longident)
params = type_variables_with_variance
PLUSEQ priv = embedded(private_flag)
constructors =
attributed_ext_constructors(extension_constructor_declaration)
{ if flag <> Recursive then
not_expecting $startpos(flag) $endpos(flag) "nonrec flag";
let loc = mklocation $startpos($2) $endpos in
(Ast_helper.Te.mk ~params ~priv ~attrs ident constructors, loc, None)
}
| attrs = item_attributes
TYPE
extension = item_extension_sugar
flag = nonrec_flag
ident = as_loc(itype_longident)
params = type_variables_with_variance
PLUSEQ priv = embedded(private_flag)
constructors =
attributed_ext_constructors(extension_constructor_declaration)
{ if flag <> Recursive then
not_expecting $startpos(flag) $endpos(flag) "nonrec flag";
Ast_helper.Te.mk ~params ~priv ~attrs ident constructors
let loc = mklocation $startpos($2) $endpos in
(Ast_helper.Te.mk ~params ~priv ~attrs ident constructors, loc, Some extension)
}
;

Expand Down
24 changes: 15 additions & 9 deletions src/reason-parser/reason_pprint_ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2905,8 +2905,8 @@ let createFormatter () =
in
source_map ~loc:pext_loc everything

(* shared by [Pstr_type,Psig_type]*)
method type_def_list ?(eq_symbol = "=") (rf, l) =
(* shared by [Pstr_type, Psig_type]*)
method type_def_list ?(eq_symbol = "=") ?extension rf l =
(* As oposed to used in type substitution. *)
let formatOneTypeDefStandard prepend td =
let itm =
Expand Down Expand Up @@ -2935,7 +2935,9 @@ let createFormatter () =
| hd :: tl ->
let first =
match rf with
| Recursive -> formatOneTypeDefStandard (atom "type") hd
| Recursive ->
let label = add_extension_sugar "type" extension in
formatOneTypeDefStandard (atom label) hd
| Nonrecursive -> formatOneTypeDefStandard (atom "type nonrec") hd
in
(match tl with
Expand Down Expand Up @@ -8644,6 +8646,8 @@ let createFormatter () =
| Psig_module pmd -> self#psig_module ~extension pmd
| Psig_recmodule pmd -> self#psig_recmodule ~extension pmd
| Psig_open od -> self#psig_open ~extension od
| Psig_type (rf, l) -> self#type_def_list ~extension rf l
| Psig_typext te -> self#type_extension ~extension te
| _ -> self#payload "%%" extension (PSig [ item ]))
| _ -> self#signature_item' item

Expand Down Expand Up @@ -8802,7 +8806,7 @@ let createFormatter () =
method signature_item' x : Layout.t =
let item : Layout.t =
match x.psig_desc with
| Psig_type (rf, l) -> self#type_def_list (rf, l)
| Psig_type (rf, l) -> self#type_def_list rf l
| Psig_value vd ->
if vd.pval_prim != []
then self#primitive_declaration vd
Expand Down Expand Up @@ -8907,8 +8911,7 @@ let createFormatter () =
~loc:pms_loc
~layout
()
| Psig_typesubst l ->
self#type_def_list ~eq_symbol:":=" (Recursive, l)
| Psig_typesubst l -> self#type_def_list ~eq_symbol:":=" Recursive l
| Psig_modtypesubst x -> self#modtype x ~delim:":="
in
source_map ~loc:x.psig_loc item
Expand Down Expand Up @@ -9207,6 +9210,8 @@ let createFormatter () =
self#attach_std_item_attrs binding.pmb_attributes module_binding
| Pstr_recmodule decls -> self#recmodule ~extension decls
| Pstr_open od -> self#pstr_open ~extension od
| Pstr_type (rf, l) -> self#type_def_list ~extension rf l
| Pstr_typext te -> self#type_extension ~extension te
| _ ->
self#attach_std_item_attrs
attrs
Expand Down Expand Up @@ -9359,7 +9364,7 @@ let createFormatter () =
let jsxAttrNodes = List.map self#attribute jsxAttrs in
makeList ~sep:(Sep " ") (jsxAttrNodes @ [ layout ]))
| Pstr_type (_, []) -> assert false
| Pstr_type (rf, l) -> self#type_def_list (rf, l)
| Pstr_type (rf, l) -> self#type_def_list rf l
| Pstr_value (rf, l) -> self#bindings (rf, l)
| Pstr_typext te -> self#type_extension te
| Pstr_exception ed ->
Expand Down Expand Up @@ -9426,7 +9431,7 @@ let createFormatter () =
in
source_map ~loc:term.pstr_loc item

method type_extension te =
method type_extension ?extension te =
let formatOneTypeExtStandard prepend ({ ptyext_path } as te) =
let name = self#longident_loc ptyext_path in
let item = self#formatOneTypeExt prepend name (atom "+=") te in
Expand All @@ -9443,7 +9448,8 @@ let createFormatter () =
~layout
()
in
formatOneTypeExtStandard (atom "type") te
let label = add_extension_sugar "type" extension in
formatOneTypeExtStandard (atom label) te

(* [allowUnguardedSequenceBodies] allows sequence expressions {} to the
right of `=>` to not be guarded in `{}` braces. *)
Expand Down
3 changes: 3 additions & 0 deletions test/general-syntax-rei.t/input.rei
Original file line number Diff line number Diff line change
Expand Up @@ -68,3 +68,6 @@ open%foo Bar;

open! %foo Bar;

type%foo t = int;

type%x foo += Int;
5 changes: 5 additions & 0 deletions test/general-syntax-rei.t/run.t
Original file line number Diff line number Diff line change
Expand Up @@ -77,3 +77,8 @@ Format general interface syntax
open%foo Bar;

open! %foo Bar;

type%foo t = int;

type%x foo +=
| Int;
4 changes: 4 additions & 0 deletions test/typeDeclarations.t/input.re
Original file line number Diff line number Diff line change
Expand Up @@ -60,3 +60,7 @@ type a = array({. "someStringKeyThatCausesLineToBreak": string });
type b = {
punned: [@with_attribute] punned
};

type%x foo = int;

type%x foo += Int;
5 changes: 5 additions & 0 deletions test/typeDeclarations.t/run.t
Original file line number Diff line number Diff line change
Expand Up @@ -128,3 +128,8 @@ Format type declarations
});

type b = {punned: [@with_attribute] punned};

type%x foo = int;

type%x foo +=
| Int;
Loading