diff --git a/CHANGES.md b/CHANGES.md index d97e9a144..9fd8b7551 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,7 @@ [#2738](https://github.com/reasonml/reason/pull/2738)) - Support local open and let bindings (@SanderSpies) [#2716](https://github.com/reasonml/reason/pull/2716) - outcome printer: change the printing of `@bs.*` to `@mel.*` (@anmonteiro, [#2755](https://github.com/reasonml/reason/pull/2755)) +- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750)) ## 3.11.0 diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 053127a37..868333f33 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -1671,13 +1671,27 @@ structure_item: { let (ext_attrs, ext_id) = $2 in struct_item_extension ($1@ext_attrs, ext_id) $3 } | item_attributes - EXTERNAL as_loc(val_ident) COLON core_type EQUAL primitive_declaration + EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type EQUAL primitive_declaration { let loc = mklocation $symbolstartpos $endpos in - mkstr (Pstr_primitive (Ast_helper.Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc)) } + let pstr_prim = + mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc)) + in + match $3 with + | None -> pstr_prim + | Some ext -> + struct_item_extension ext [pstr_prim] + } | item_attributes - EXTERNAL as_loc(val_ident) COLON core_type SEMI + EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type SEMI { let loc = mklocation $symbolstartpos $endpos in - mkstr (Pstr_primitive (Ast_helper.Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc)) } + let pstr_prim = + mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc)) + in + match $3 with + | None -> pstr_prim + | Some ext -> + struct_item_extension ext [pstr_prim] + } | type_declarations { let (nonrec_flag, tyl) = $1 in mkstr(Pstr_type (nonrec_flag, tyl)) } | str_type_extension diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 56be64e88..8b28e3857 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -6725,12 +6725,13 @@ let printer = object(self:'self) * format everything together in a ~postSpace:true (inline, inline) list for nicer breaking *) - method primitive_declaration vd = + method primitive_declaration ?extension vd = + let external_label = add_extension_sugar "external" extension in let lblBefore = label ~space:true (makeList - [(makeList ~postSpace:true [atom "external"; protectIdentifier vd.pval_name.txt]); (atom ":")]) + [(makeList ~postSpace:true [atom external_label; protectIdentifier vd.pval_name.txt]); (atom ":")]) (self#core_type vd.pval_type) in let primDecl = @@ -7608,8 +7609,10 @@ let printer = object(self:'self) match item.pstr_desc with | Pstr_extension ((extension, PStr [item]), attrs) -> begin match item.pstr_desc with - (* In case of a value, the extension gets inlined `let%private a = 1` *) + (* In case of a value or `external`, the extension gets inlined + `let%private a = 1` *) | Pstr_value (rf, vb_list) -> self#bindings ~extension (rf, vb_list) + | Pstr_primitive vd -> self#primitive_declaration ~extension vd | _ -> self#attach_std_item_attrs attrs (self#payload "%%" extension (PStr [item])) end | _ -> self#structure_item item diff --git a/test/extensions.t/input.re b/test/extensions.t/input.re index 2bbeab3c2..483ba2fc2 100644 --- a/test/extensions.t/input.re +++ b/test/extensions.t/input.re @@ -383,3 +383,9 @@ let predicate = /* Attributes shoudn't be inlined and always break */ [@warning "-8"] let a = 3; + +[%%foo external x: int => int = ""]; +[%%foo external x: int => int = "caml_prim"]; +external%foo x: int => int = "caml_prim"; + + diff --git a/test/extensions.t/run.t b/test/extensions.t/run.t index 459bfe2e4..8a883e525 100644 --- a/test/extensions.t/run.t +++ b/test/extensions.t/run.t @@ -385,3 +385,7 @@ Format extensions /* Attributes shoudn't be inlined and always break */ [@warning "-8"] let a = 3; + + external%foo x: int => int; + external%foo x: int => int = "caml_prim"; + external%foo x: int => int = "caml_prim";