feat(compiler): Ignore compiler warnings

cli/bin/grain.js

@@ -153,6 +153,12 @@ class GrainCommand extends commander.Command {
       "--verbose",
       "print critical information at various stages of compilation"
     );
+    cmd.forwardOption(
+      "--ignore-warnings <warnings>",
+      "compiler warnings to ignore",
+      list,
+      []
+    );
     return cmd;
   }
 }

compiler/src/parsing/parser.conflicts

@@ -0,0 +1,90 @@
+
+** Conflict (shift/reduce) in state 301.
+** Tokens involved: UIDENT LPAREN LIDENT
+** The following explanations concentrate on token UIDENT.
+** This state is reached from program after reading:
+
+attributes module_header eos lbrace
+
+** The derivations that appear below have the following common factor:
+** (The question mark symbol (?) represents the spot where the derivations begin to differ.)
+
+program 
+attributes module_header eos toplevel_stmts EOF 
+                             lseparated_nonempty_list_inner(eos,toplevel_stmt) option(eos) 
+                             toplevel_stmt 
+                             expr 
+                             non_stmt_expr 
+                             annotated_expr 
+                             non_binop_expr 
+                             non_assign_expr 
+                             left_accessor_expr 
+                             braced_expr 
+                             (?)
+
+** In state 301, looking ahead at UIDENT, reducing production
+** list(terminated(attribute,opt_eols)) ->
+** is permitted because of the following sub-derivation:
+
+lbrace block_body rbrace 
+       lseparated_nonempty_list_inner(eos,block_body_expr) 
+       block_body_expr 
+       attributes expr // lookahead token appears because expr can begin with UIDENT
+       list(terminated(attribute,opt_eols)) // lookahead token is inherited
+       . 
+
+** In state 301, looking ahead at UIDENT, shifting is permitted
+** because of the following sub-derivation:
+
+lbrace record_exprs rbrace 
+       non_punned_record_field option(comma) 
+       qualified_lid COLON expr 
+       lseparated_nonempty_list_inner(dot,type_id_str) DOT id_str 
+       type_id_str 
+       . UIDENT 
+
+** Conflict (shift/reduce) in state 34.
+** Token involved: LPAREN
+** This state is reached from program after reading:
+
+attributes module_header eos lbrace AT id_str
+
+** The derivations that appear below have the following common factor:
+** (The question mark symbol (?) represents the spot where the derivations begin to differ.)
+
+program 
+attributes module_header eos toplevel_stmts EOF 
+                             lseparated_nonempty_list_inner(eos,toplevel_stmt) option(eos) 
+                             toplevel_stmt 
+                             expr 
+                             non_stmt_expr 
+                             annotated_expr 
+                             non_binop_expr 
+                             non_assign_expr 
+                             left_accessor_expr 
+                             braced_expr 
+                             lbrace block_body rbrace 
+                                    lseparated_nonempty_list_inner(eos,block_body_expr) 
+                                    block_body_expr 
+                                    (?)
+
+** In state 34, looking ahead at LPAREN, reducing production
+** loption(attribute_arguments) ->
+** is permitted because of the following sub-derivation:
+
+attributes expr // lookahead token appears because expr can begin with LPAREN
+list(terminated(attribute,opt_eols)) // lookahead token is inherited
+attribute list(terminated(attribute,opt_eols)) // lookahead token is inherited because list(terminated(attribute,opt_eols)) can vanish
+AT id_str loption(attribute_arguments) // lookahead token is inherited
+          . 
+
+** In state 34, looking ahead at LPAREN, shifting is permitted
+** because of the following sub-derivation:
+
+attributes expr 
+list(terminated(attribute,opt_eols)) 
+attribute list(terminated(attribute,opt_eols)) 
+AT id_str loption(attribute_arguments) 
+          attribute_arguments 
+          lparen rparen 
+          . LPAREN 

compiler/src/parsing/parser.mly

@@ -644,7 +644,7 @@ left_accessor_expr:
 
 block_body_expr:
   | let_expr    { $1 }
-  | expr  { $1 }
+  | attributes expr %prec attributes { $2 }
 
 %inline tuple_expr_ending:
   | ioption(eols) lseparated_nonempty_list(comma, expr) comma? { $2 }

compiler/src/parsing/parsetree.re

@@ -672,6 +672,7 @@ and toplevel_stmt_desc =
 
 [@deriving (sexp, yojson)]
 and toplevel_stmt = {
+  ptop_ignored_warnings: list(string),
   ptop_desc: toplevel_stmt_desc,
   ptop_attributes: attributes,
   [@sexp_drop_if sexp_locs_disabled]
@@ -700,6 +701,7 @@ type comment =
 [@deriving (sexp, yojson)]
 type parsed_program = {
   attributes,
+  prog_ignored_warnings: list(string),
   module_name: loc(string),
   statements: list(toplevel_stmt),
   comments: list(comment),

compiler/src/parsing/well_formedness.re

@@ -840,7 +840,7 @@ let mutual_rec_type_improper_rec_keyword = (errs, super) => {
 };
 
 let array_index_non_integer = (errs, super) => {
-  let enter_expression = ({pexp_desc: desc, pexp_loc: loc} as e) => {
+  let enter_expression = ({pexp_desc: desc, pexp_loc: loc, pexp_ignored_warnings: ignored_warnings} as e) => {
     switch (desc) {
     | PExpArrayGet(_, {pexp_desc: PExpConstant(PConstNumber(number_type))})
     | PExpArraySet({
@@ -849,7 +849,7 @@ let array_index_non_integer = (errs, super) => {
       switch (number_type) {
       | PConstNumberFloat({txt}) =>
         let warning = Warnings.ArrayIndexNonInteger(txt);
-        if (Warnings.is_active(warning)) {
+        if (Warnings.is_active(warning, ignored_warnings)) {
           Location.prerr_warning(loc, warning);
         };
       | PConstNumberRational({
@@ -858,7 +858,7 @@ let array_index_non_integer = (errs, super) => {
         }) =>
         let warning =
           Warnings.ArrayIndexNonInteger(numerator ++ "/" ++ denominator);
-        if (Grain_utils.Warnings.is_active(warning)) {
+        if (Grain_utils.Warnings.is_active(warning, ignored_warnings)) {
           Location.prerr_warning(loc, warning);
         };
       | _ => ()

compiler/src/typed/typecore.re

@@ -1184,7 +1184,10 @@ and type_expect_ =
       | [(_, lbl, _), ..._] => Array.length(lbl.lbl_all)
       };
     if (b != None && List.length(es) == num_fields) {
-      Location.prerr_warning(loc, Grain_utils.Warnings.UselessRecordSpread);
+      let warning = Grain_utils.Warnings.UselessRecordSpread;
+      if (Warnings.is_active(warning, sexp.pexp_ignored_warnings)) {
+        Location.prerr_warning(loc, warning);
+      }
     };
     let label_descriptions = {
       let (_, {lbl_all}, _) = List.hd(lbl_exp_list);
@@ -2220,7 +2223,10 @@ and type_statement_expr = (~explanation=?, ~in_function=?, env, sexp) => {
   let ty = expand_head(env, exp.exp_type)
   and tv = newvar();
   if (is_Tvar(ty) && ty.level > tv.level) {
-    Location.prerr_warning(loc, Grain_utils.Warnings.NonreturningStatement);
+    let warning = Grain_utils.Warnings.NonreturningStatement;
+    if (Warnings.is_active(warning, sexp.pexp_ignored_warnings)) {
+      Location.prerr_warning(loc, warning);
+    }
   };
   if (Grain_utils.Config.strict_sequence^) {
     let expected_ty = instance_def(Builtin_types.type_void);

compiler/src/typed/typed_well_formedness.re

@@ -243,7 +243,7 @@ module WellFormednessArg: TypedtreeIter.IteratorArgument = {
   include TypedtreeIter.DefaultIteratorArgument;
 
   let enter_expression: expression => unit =
-    ({exp_desc, exp_loc, exp_attributes} as exp) => {
+    ({exp_desc, exp_loc, exp_attributes, exp_ignored_warnings} as exp) => {
       // Check: Avoid using Pervasives equality ops with WasmXX types
       switch (exp_desc) {
       | TExpLet(_) when is_marked_unsafe(exp_attributes) => push_unsafe(true)
@@ -273,7 +273,7 @@ module WellFormednessArg: TypedtreeIter.IteratorArgument = {
               Printf.sprintf("%s.(%s)", typeName, func),
               typeName,
             );
-          if (Grain_utils.Warnings.is_active(warning)) {
+          if (Grain_utils.Warnings.is_active(warning, exp_ignored_warnings)) {
             Grain_parsing.Location.prerr_warning(exp_loc, warning);
           };
         }
@@ -296,7 +296,7 @@ module WellFormednessArg: TypedtreeIter.IteratorArgument = {
         | Some({arg_expr}) =>
           let typeName = resolve_unsafe_type(arg_expr);
           let warning = Grain_utils.Warnings.PrintUnsafe(typeName);
-          if (Grain_utils.Warnings.is_active(warning)) {
+          if (Grain_utils.Warnings.is_active(warning, exp_ignored_warnings)) {
             Grain_parsing.Location.prerr_warning(exp_loc, warning);
           };
         | _ => ()
@@ -323,7 +323,7 @@ module WellFormednessArg: TypedtreeIter.IteratorArgument = {
         | Some({arg_expr}) =>
           let typeName = resolve_unsafe_type(arg_expr);
           let warning = Grain_utils.Warnings.ToStringUnsafe(typeName);
-          if (Grain_utils.Warnings.is_active(warning)) {
+          if (Grain_utils.Warnings.is_active(warning, exp_ignored_warnings)) {
             Grain_parsing.Location.prerr_warning(exp_loc, warning);
           };
         | _ => ()
@@ -381,7 +381,7 @@ module WellFormednessArg: TypedtreeIter.IteratorArgument = {
           };
         let warning =
           Grain_utils.Warnings.FromNumberLiteral(mod_type, modname, n_str);
-        if (Grain_utils.Warnings.is_active(warning)) {
+        if (Grain_utils.Warnings.is_active(warning, exp_ignored_warnings)) {
           Grain_parsing.Location.prerr_warning(exp_loc, warning);
         };
       | _ => ()

compiler/src/typed/typedtree.re

@@ -446,6 +446,7 @@ and pattern_desc =
 
 [@deriving sexp]
 type expression = {
+  exp_ignored_warnings: list(string),
   exp_desc: expression_desc,
   [@sexp_drop_if sexp_locs_disabled]
   exp_loc: Location.t,
@@ -596,6 +597,7 @@ and toplevel_stmt_desc =
 
 [@deriving sexp]
 and toplevel_stmt = {
+  ttop_ignored_warnings: list(string),
   ttop_desc: toplevel_stmt_desc,
   ttop_attributes: attributes,
   [@sexp_drop_if sexp_locs_disabled]
@@ -621,6 +623,7 @@ type comment =
 
 [@deriving sexp]
 type typed_program = {
+  ignored_warnings: list(string),
   module_name: loc(string),
   statements: list(toplevel_stmt),
   env: [@sexp.opaque] Env.t,

compiler/src/utils/config.re

@@ -398,6 +398,61 @@ let import_memory =
     false,
   );
 
+type ignore_warning =
+  | IgnoreAll
+  | LetRecNonFunction
+  | AmbiguousName
+  | StatementType
+  | NonreturningStatement
+  | AllClausesGuarded
+  | PartialMatch
+  | UnusedMatch
+  | UnusedPat
+  | NonClosedRecordPattern
+  | UnreachableCase
+  | ShadowConstructor
+  | NoCmiFile
+  | FuncWasmUnsafe
+  | FromNumberLiteral
+  | UselessRecordSpread
+  | PrintUnsafe
+  | ToStringUnsafe
+  | ArrayIndexNonInteger;
+
+let ignore_warnings =
+  opt(
+    ~names=["ignore-warnings"],
+    ~conv=
+      Cmdliner.Arg.(
+        list(
+          enum([
+            ("all", IgnoreAll),
+            ("letRecNonFunction", LetRecNonFunction),
+            ("ambiguousName", AmbiguousName),
+            ("statementType", StatementType),
+            ("nonreturningStatement", NonreturningStatement),
+            ("allClausesGuarded", AllClausesGuarded),
+            ("partialMatch", PartialMatch),
+            ("unusedMatch", UnusedMatch),
+            ("unusedPat", UnusedPat),
+            ("nonClosedRecordPattern", NonClosedRecordPattern),
+            ("unreachableCase", UnreachableCase),
+            ("shadowConstructor", ShadowConstructor),
+            ("noCmiFile", NoCmiFile),
+            ("funcWasmUnsafe", FuncWasmUnsafe),
+            ("fromNumberLiteral", FromNumberLiteral),
+            ("uselessRecordSpread", UselessRecordSpread),
+            ("printUnsafe", PrintUnsafe),
+            ("toStringUnsafe", ToStringUnsafe),
+            ("arrayIndexNonInteger", ArrayIndexNonInteger),
+          ]),
+        )
+      ),
+    ~doc="Compiler warnings to ignore",
+    ~digestible=NotDigestible,
+    [],
+  );
+
 type compilation_mode =
   | Normal /* Standard compilation with regular bells and whistles */
   | Runtime /* GC doesn't exist yet, allocations happen in runtime heap */;

compiler/src/utils/config.rei

@@ -5,6 +5,27 @@ type compilation_mode =
   | Normal /* Standard compilation with regular bells and whistles */
   | Runtime /* GC doesn't exist yet, allocations happen in runtime heap */;
 
+type ignore_warning =
+  | IgnoreAll
+  | LetRecNonFunction
+  | AmbiguousName
+  | StatementType
+  | NonreturningStatement
+  | AllClausesGuarded
+  | PartialMatch
+  | UnusedMatch
+  | UnusedPat
+  | NonClosedRecordPattern
+  | UnreachableCase
+  | ShadowConstructor
+  | NoCmiFile
+  | FuncWasmUnsafe
+  | FromNumberLiteral
+  | UselessRecordSpread
+  | PrintUnsafe
+  | ToStringUnsafe
+  | ArrayIndexNonInteger;
+
 /** The Grain stdlib directory, based on the current configuration */
 let stdlib_directory: unit => option(string);
 
@@ -82,6 +103,10 @@ let maximum_memory_pages: ref(option(int));
 
 let import_memory: ref(bool);
 
+/** Compiler warnings to ignore */
+
+let ignore_warnings: ref(list(ignore_warning));
+
 /** Whether this module should be compiled in runtime mode */
 
 let compilation_mode: ref(compilation_mode);