support external%foo (#2750)

* support `external%foo`

* add changelog entry

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
 

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

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

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";
+
+

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";