feat(compiler): Providing, including, reproviding exceptions (#1849)

Author: alex-snezhko

compiler/src/formatting/format.re

@@ -3917,7 +3917,8 @@ and print_expression_inner =
               switch (item) {
               | PUseValue({loc})
               | PUseModule({loc})
-              | PUseType({loc}) => loc
+              | PUseType({loc})
+              | PUseException({loc}) => loc
               };
             };
 
@@ -3961,6 +3962,8 @@ and print_expression_inner =
                 Doc.concat([Doc.text("module "), item_name(name, alias)])
               | PUseType({name, alias}) =>
                 Doc.concat([Doc.text("type "), item_name(name, alias)])
+              | PUseException({name, alias}) =>
+                Doc.concat([Doc.text("exception "), item_name(name, alias)])
               };
             };
 
@@ -5068,6 +5071,7 @@ let rec toplevel_print =
             switch (item) {
             | PProvideValue({loc})
             | PProvideModule({loc})
+            | PProvideException({loc})
             | PProvideType({loc}) => loc
             };
           };
@@ -5112,6 +5116,8 @@ let rec toplevel_print =
               Doc.concat([Doc.text("module "), item_name(name, alias)])
             | PProvideType({name, alias}) =>
               Doc.concat([Doc.text("type "), item_name(name, alias)])
+            | PProvideException({name, alias}) =>
+              Doc.concat([Doc.text("exception "), item_name(name, alias)])
             };
           };
 

compiler/src/language_server/definition.re

@@ -71,6 +71,7 @@ let process =
     | [Pattern({definition}), ..._]
     | [Type({definition}), ..._]
     | [Declaration({definition}), ..._]
+    | [Exception({definition}), ..._]
     | [Module({definition}), ..._] =>
       switch (definition) {
       | None => send_no_result(~id)

compiler/src/language_server/hover.re

@@ -125,6 +125,13 @@ let declaration_lens = (ident: Ident.t, decl: Types.type_declaration) => {
   grain_type_code_block(Printtyp.string_of_type_declaration(~ident, decl));
 };
 
+let exception_declaration_lens =
+    (ident: Ident.t, ext: Types.extension_constructor) => {
+  grain_type_code_block(
+    Printtyp.string_of_extension_constructor(~ident, ext),
+  );
+};
+
 let process =
     (
       ~id: Protocol.message_id,
@@ -161,6 +168,12 @@ let process =
         ~range=Utils.loc_to_range(loc),
         declaration_lens(ident, decl),
       )
+    | [Exception({ident, ext, loc}), ..._] =>
+      send_hover(
+        ~id,
+        ~range=Utils.loc_to_range(loc),
+        exception_declaration_lens(ident, ext),
+      )
     | [Module({path, decl, loc}), ..._] =>
       send_hover(~id, ~range=Utils.loc_to_range(loc), module_lens(decl))
     | _ => send_no_result(~id)

compiler/src/language_server/sourcetree.re

@@ -157,6 +157,12 @@ module type Sourcetree = {
         loc: Location.t,
         definition: option(Location.t),
       })
+    | Exception({
+        ident: Ident.t,
+        ext: Types.extension_constructor,
+        loc: Location.t,
+        definition: option(Location.t),
+      })
     | Module({
         path: Path.t,
         decl: Types.module_declaration,
@@ -236,6 +242,12 @@ module Sourcetree: Sourcetree = {
         loc: Location.t,
         definition: option(Location.t),
       })
+    | Exception({
+        ident: Ident.t,
+        ext: Types.extension_constructor,
+        loc: Location.t,
+        definition: option(Location.t),
+      })
     | Module({
         path: Path.t,
         decl: Types.module_declaration,
@@ -387,6 +399,15 @@ module Sourcetree: Sourcetree = {
                                    definition: Some(value.val_loc),
                                  }),
                                )
+                             | TUseException({name, ext, loc}) => (
+                                 loc_to_interval(loc),
+                                 Exception({
+                                   ident: Ident.create(name),
+                                   ext,
+                                   loc,
+                                   definition: Some(ext.ext_loc),
+                                 }),
+                               )
                              }
                            },
                            items,

compiler/src/middle_end/linearize.re

@@ -13,7 +13,7 @@ let compile_constructor_tag =
     fun
     | CstrConstant(i) => i
     | CstrBlock(i) => i
-    | CstrExtension(i, _, _) => i
+    | CstrExtension(i, _, _, _) => i
     | CstrUnboxed =>
       failwith("compile_constructor_tag: cannot compile CstrUnboxed")
   );

compiler/src/parsing/ast_mapper.re

@@ -190,6 +190,12 @@ module E = {
                     alias: Option.map(map_identifier(sub), alias),
                     loc: sub.location(sub, loc),
                   })
+                | PUseException({name, alias, loc}) =>
+                  PUseException({
+                    name: map_identifier(sub, name),
+                    alias: Option.map(map_identifier(sub), alias),
+                    loc: sub.location(sub, loc),
+                  })
                 | PUseModule({name, alias, loc}) =>
                   PUseModule({
                     name: map_identifier(sub, name),
@@ -432,6 +438,12 @@ module Pr = {
             alias: Option.map(map_identifier(sub), alias),
             loc: sub.location(sub, loc),
           })
+        | PProvideException({name, alias, loc}) =>
+          PProvideException({
+            name: map_identifier(sub, name),
+            alias: Option.map(map_identifier(sub), alias),
+            loc: sub.location(sub, loc),
+          })
         | PProvideModule({name, alias, loc}) =>
           PProvideModule({
             name: map_identifier(sub, name),

compiler/src/parsing/parser.messages

@@ -455,6 +455,18 @@ program: MODULE UIDENT EOL FROM UIDENT USE LBRACE MODULE YIELD
 
 Expected an uppercase type identifier.
 
+program: MODULE UIDENT EOL FROM UIDENT USE LBRACE EXCEPTION YIELD
+##
+## Ends in an error in state: 57.
+##
+## use_item -> EXCEPTION . aliasable(uid) [ RBRACE EOL COMMA ]
+##
+## The known suffix of the stack is as follows:
+## EXCEPTION
+##
+
+Expected an uppercase exception identifier.
+
 program: MODULE UIDENT EOL PROVIDE LBRACE MODULE UIDENT YIELD
 ##
 ## Ends in an error in state: 49.
@@ -558,6 +570,18 @@ program: MODULE UIDENT EOL PROVIDE LBRACE TYPE YIELD
 
 Expected a type identifier to provide.
 
+program: MODULE UIDENT EOL PROVIDE LBRACE EXCEPTION YIELD
+##
+## Ends in an error in state: 825.
+##
+## provide_item -> EXCEPTION . aliasable(uid) [ RBRACE EOL COMMA ]
+##
+## The known suffix of the stack is as follows:
+## EXCEPTION
+##
+
+Expected an exception identifier to provide.
+
 program: MODULE UIDENT EOL FROM UIDENT USE LBRACE LIDENT AS LIDENT YIELD
 ##
 ## Ends in an error in state: 62.

compiler/src/parsing/parser.mly

@@ -343,6 +343,7 @@ aliasable(X):
 use_item:
   | TYPE aliasable(uid) { PUseType { name=fst $2; alias = snd $2; loc=to_loc $loc} }
   | MODULE aliasable(uid) { PUseModule { name=fst $2; alias = snd $2; loc=to_loc $loc} }
+  | EXCEPTION aliasable(uid) { PUseException { name=fst $2; alias = snd $2; loc=to_loc $loc} }
   | aliasable(lid) { PUseValue { name=fst $1; alias = snd $1; loc=to_loc $loc} }
 
 use_items:
@@ -372,6 +373,7 @@ data_declaration_stmts:
 provide_item:
   | TYPE aliasable(uid) { PProvideType { name=fst $2; alias = snd $2; loc=to_loc $loc} }
   | MODULE aliasable(uid) { PProvideModule { name=fst $2; alias = snd $2; loc=to_loc $loc} }
+  | EXCEPTION aliasable(uid) { PProvideException { name=fst $2; alias = snd $2; loc=to_loc $loc} }
   | aliasable(lid) { PProvideValue { name=fst $1; alias = snd $1; loc=to_loc $loc} }
 
 provide_items:

compiler/src/parsing/parsetree.re

@@ -464,6 +464,11 @@ and use_item =
       alias: option(loc(Identifier.t)),
       loc: Location.t,
     })
+  | PUseException({
+      name: loc(Identifier.t),
+      alias: option(loc(Identifier.t)),
+      loc: Location.t,
+    })
   | PUseModule({
       name: loc(Identifier.t),
       alias: option(loc(Identifier.t)),
@@ -595,6 +600,11 @@ type provide_item =
       alias: option(loc(Identifier.t)),
       loc: Location.t,
     })
+  | PProvideException({
+      name: loc(Identifier.t),
+      alias: option(loc(Identifier.t)),
+      loc: Location.t,
+    })
   | PProvideModule({
       name: loc(Identifier.t),
       alias: option(loc(Identifier.t)),

compiler/src/parsing/parsetree_iter.re

@@ -124,6 +124,7 @@ and iter_provide = (hooks, items) => {
     item => {
       switch (item) {
       | PProvideType({name, alias, loc})
+      | PProvideException({name, alias, loc})
       | PProvideModule({name, alias, loc})
       | PProvideValue({name, alias, loc}) =>
         iter_ident(hooks, name);
@@ -290,6 +291,7 @@ and iter_expression =
         item => {
           switch (item) {
           | PUseType({name, alias, loc})
+          | PUseException({name, alias, loc})
           | PUseModule({name, alias, loc})
           | PUseValue({name, alias, loc}) =>
             iter_ident(hooks, name);