support external%foo in signatures

reasonml · Jul 21, 2024 · f710250 · f710250
1 parent 035e633
commit f710250
Show file tree

Hide file tree

Showing 4 changed files with 34 additions and 6 deletions.
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";