support external%foo in signatures (#2766)

* support external%foo in signatures * changelog entry
reasonml · Jul 21, 2024 · 5451aa3 · 5451aa3
1 parent 035e633
commit 5451aa3
Show file tree

Hide file tree

Showing 5 changed files with 35 additions and 7 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -5,7 +5,7 @@
 - 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))
 - Fix outcome printing of optional arguments on OCaml 5.2 (@anmonteiro, [#2753](https://github.com/reasonml/reason/pull/2753))
-- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750))
+- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750), [#2766](https://github.com/reasonml/reason/pull/2766))
 - install `refmt` manpage (@anmonteiro, [#2760](https://github.com/reasonml/reason/pull/2760))
 - add support for parsing / printing of refutation clause in `switch` (@anmonteiro, [#2765](https://github.com/reasonml/reason/pull/2765))
 

diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly
@@ -1888,22 +1888,33 @@ signature:
   | signature_items SEMI signature { $1 @ $3 }
 ;
 
-
 signature_item:
   | item_attributes
     LET as_loc(val_ident) COLON core_type
     { let loc = mklocation $startpos($2) $endpos in
       Psig_value (Ast_helper.Val.mk $3 $5 ~attrs:$1 ~loc)
     }
   | 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
-      Psig_value (Ast_helper.Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc)
+      let psig_prim =
+        Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc)
+      in
+      match $3 with
+      | None -> psig_prim
+      | Some (ext_attrs, ext_id) ->
+        (Psig_extension ((ext_id, PSig [mksig ~loc psig_prim]), ext_attrs))
     }
   | 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
-      Psig_value (Ast_helper.Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc)
+      let psig_prim =
+        Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc)
+      in
+      match $3 with
+      | None -> psig_prim
+      | Some (ext_attrs, ext_id) ->
+        (Ppxlib.Parsetree.Psig_extension ((ext_id, PSig [mksig ~loc psig_prim]), ext_attrs))
     }
   | type_declarations
     { let (nonrec_flag, tyl) = $1 in Psig_type (nonrec_flag, tyl) }

diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml
@@ -7174,6 +7174,17 @@ let printer = object(self:'self)
       (self#class_self_pattern_and_structure cs)
 
   method signature signatureItems =
+    let signature_item item =
+      match item.psig_desc with
+      | Psig_extension ((extension, PSig [item]), _attrs) ->
+          begin match item.psig_desc with
+            (* In case of a value or `external`, the extension gets inlined
+               `let%private a = 1` *)
+            | Psig_value ({ pval_prim = [_]; _ } as vd) -> self#primitive_declaration ~extension vd
+            | _ -> self#signature_item item
+          end
+      | _ -> self#signature_item item
+    in
     match signatureItems with
     | [] -> atom ""
     | first::_ as signatureItems ->
@@ -7182,7 +7193,7 @@ let printer = object(self:'self)
       let loc_end = last.psig_loc.loc_end in
       let items =
         groupAndPrint
-          ~xf:self#signature_item
+          ~xf:signature_item
           ~getLoc:(fun x -> x.psig_loc)
           ~comments:self#comments
           signatureItems

diff --git a/test/general-syntax-rei.t/input.rei b/test/general-syntax-rei.t/input.rei
@@ -39,3 +39,6 @@ let not : string => string;
 let other : string => not;
 
 include (module type of Bos.Cmd) with type t = Bos.Cmd.t;
+
+external%foo bar: string => string = "";
+[%%foo: external bar: int => int = "hello" ]
diff --git a/test/general-syntax-rei.t/run.t b/test/general-syntax-rei.t/run.t
@@ -48,3 +48,6 @@ Format general interface syntax
   include
      (module type of Bos.Cmd) with
       type t = Bos.Cmd.t;
+
+  external%foo bar: string => string;
+  external%foo bar: int => int = "hello";