From e626622c675e5d9b98ded76aad6cf517ac10a0ef Mon Sep 17 00:00:00 2001
From: Antonio Nuno Monteiro <anmonteiro@gmail.com>
Date: Sun, 7 Jul 2024 23:56:38 -0700
Subject: [PATCH] support `external%foo` (#2750)

* support `external%foo`

* add changelog entry
---
 CHANGES.md                             |  1 +
 src/reason-parser/reason_parser.mly    | 22 ++++++++++++++++++----
 src/reason-parser/reason_pprint_ast.ml |  9 ++++++---
 test/extensions.t/input.re             |  6 ++++++
 test/extensions.t/run.t                |  4 ++++
 5 files changed, 35 insertions(+), 7 deletions(-)

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