feat(compiler)!: Remove arbitrary per-file compiler flags, add accept…

…able options as module attributes (#1804)

Co-authored-by: Oscar Spencer <oscar@grain-lang.org>

cli/bin/grain.js

@@ -108,10 +108,6 @@ class GrainCommand extends commander.Command {
     cmd.forwardOption("--import-memory", "import the memory from `env.memory`");
     cmd.option("--dir <dir...>", "directory to preopen");
     cmd.option("--env <env...>", "WASI environment variables");
-    cmd.forwardOption(
-      "--compilation-mode <mode>",
-      "compilation mode (advanced use only)"
-    );
     cmd.forwardOption(
       "--elide-type-info",
       "don't include runtime type information used by toString/print"

compiler/src/compile.re

@@ -88,25 +88,6 @@ let log_state = state =>
     prerr_string("\n\n");
   };
 
-let apply_inline_flags = (prog: Parsetree.parsed_program) => {
-  switch (prog.comments) {
-  | [Block({cmt_content, cmt_loc}), ..._] =>
-    Grain_utils.Config.apply_inline_flags(
-      ~on_error=
-        err => {
-          switch (err) {
-          | `Help =>
-            raise(InlineFlagsError(cmt_loc, Cannot_use_help_or_version))
-          | `Message(msg) =>
-            raise(InlineFlagsError(cmt_loc, Cannot_parse_inline_flags(msg)))
-          }
-        },
-      cmt_content,
-    )
-  | _ => ()
-  };
-};
-
 let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) => {
   let cstate_desc =
     switch (cstate_desc) {
@@ -145,7 +126,15 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) =>
       cleanup();
       Parsed(parsed);
     | Parsed(p) =>
-      apply_inline_flags(p);
+      let has_attr = name =>
+        List.exists(
+          attr => attr.Asttypes.attr_name.txt == name,
+          p.attributes,
+        );
+      Grain_utils.Config.apply_attribute_flags(
+        ~no_pervasives=has_attr("noPervasives"),
+        ~runtime_mode=has_attr("runtimeMode"),
+      );
       if (is_root_file) {
         Grain_utils.Config.set_root_config();
       };
@@ -266,7 +255,7 @@ let compile_wasi_polyfill = () => {
   switch (Grain_utils.Config.wasi_polyfill^) {
   | Some(file) =>
     Grain_utils.Config.preserve_config(() => {
-      Grain_utils.Config.compilation_mode := Some("runtime");
+      Grain_utils.Config.compilation_mode := Grain_utils.Config.Runtime;
       let cstate = {
         cstate_desc: Initial(InputFile(file)),
         cstate_filename: Some(file),

compiler/src/formatting/fmt.re

@@ -3991,12 +3991,53 @@ let print_program = (fmt, parsed_program) => {
       )
     };
 
-  group @@
-  fmt.print_comment_range(
-    fmt,
-    enclosing_start_location(parsed_program.prog_loc),
-    parsed_program.module_name.loc,
-  )
+  let attributes =
+    switch (parsed_program.attributes) {
+    | [] =>
+      group(
+        fmt.print_comment_range(
+          fmt,
+          enclosing_start_location(parsed_program.prog_loc),
+          parsed_program.module_name.loc,
+        ),
+      )
+    | _ =>
+      group @@
+      concat_map(
+        ~lead=
+          first =>
+            fmt.print_comment_range(
+              fmt,
+              ~trail=hardline,
+              enclosing_start_location(parsed_program.prog_loc),
+              first.attr_loc,
+            ),
+        ~sep=
+          (prev, next) =>
+            fmt.print_comment_range(
+              fmt,
+              ~none=hardline,
+              ~lead=space,
+              ~trail=hardline,
+              prev.Asttypes.attr_loc,
+              next.attr_loc,
+            ),
+        ~trail=
+          prev =>
+            fmt.print_comment_range(
+              fmt,
+              ~none=hardline,
+              ~lead=space,
+              ~trail=hardline,
+              prev.Asttypes.attr_loc,
+              parsed_program.prog_core_loc,
+            ),
+        ~f=(~final, a) => fmt.print_attribute(fmt, a),
+        parsed_program.attributes,
+      )
+    };
+
+  attributes
   ++ string("module ")
   ++ string(parsed_program.module_name.txt)
   ++ toplevel;

compiler/src/parsing/driver.re

@@ -150,6 +150,11 @@ let parse = (~name=?, lexbuf, source): Parsetree.parsed_program => {
 let read_imports = (program: Parsetree.parsed_program) => {
   open Parsetree_iter;
 
+  let module_has_attr = name =>
+    List.exists(
+      attr => attr.Asttypes.attr_name.txt == name,
+      program.attributes,
+    );
   let implicit_opens =
     List.map(
       o => {
@@ -159,15 +164,11 @@ let read_imports = (program: Parsetree.parsed_program) => {
         | Grain_utils.Config.Gc_mod => Location.mknoloc("runtime/gc.gr")
         }
       },
-      switch (program.comments) {
-      | [Block({cmt_content}), ..._] =>
-        Grain_utils.Config.with_inline_flags(
-          ~on_error=_ => (),
-          cmt_content,
-          Grain_utils.Config.get_implicit_opens,
-        )
-      | _ => Grain_utils.Config.get_implicit_opens()
-      },
+      Grain_utils.Config.with_attribute_flags(
+        ~no_pervasives=module_has_attr("noPervasives"),
+        ~runtime_mode=module_has_attr("runtimeMode"),
+        Grain_utils.Config.get_implicit_opens,
+      ),
     );
   let found_includes = ref([]);
 

compiler/src/parsing/parser.messages

@@ -24,6 +24,42 @@ program: EOL YIELD
 ## In state 3, spurious reduction of production nonempty_list(eol) -> EOL
 ## In state 6, spurious reduction of production eols -> nonempty_list(eol)
 ##
+program: AT LIDENT TYPE
+##
+## Ends in an error in state: 49.
+##
+## program -> option(attribute) . module_header eos toplevel_stmts EOF [ # ]
+## program -> option(attribute) . module_header option(eos) EOF [ # ]
+##
+## The known suffix of the stack is as follows:
+## option(attribute)
+##
+## WARNING: This example involves spurious reductions.
+## This implies that, although the LR(1) items shown above provide an
+## accurate view of the past (what has been recognized so far), they
+## may provide an INCOMPLETE view of the future (what was expected next).
+## In state 34, spurious reduction of production loption(attribute_arguments) ->
+## In state 45, spurious reduction of production attribute -> AT id_str loption(attribute_arguments)
+## In state 873, spurious reduction of production option(attribute) -> attribute
+##
+program: EOL AT LIDENT TYPE
+##
+## Ends in an error in state: 866.
+##
+## program -> eols option(attribute) . module_header eos toplevel_stmts EOF [ # ]
+## program -> eols option(attribute) . module_header option(eos) EOF [ # ]
+##
+## The known suffix of the stack is as follows:
+## eols option(attribute)
+##
+## WARNING: This example involves spurious reductions.
+## This implies that, although the LR(1) items shown above provide an
+## accurate view of the past (what has been recognized so far), they
+## may provide an INCOMPLETE view of the future (what was expected next).
+## In state 34, spurious reduction of production loption(attribute_arguments) ->
+## In state 45, spurious reduction of production attribute -> AT id_str loption(attribute_arguments)
+## In state 873, spurious reduction of production option(attribute) -> attribute
+##
 
 Expected a module header, e.g. `module Main`.
 

compiler/src/parsing/parser.mly

@@ -744,5 +744,5 @@ module_header:
   | MODULE UIDENT { mkstr $loc($2) $2 }
 
 program:
-  | opt_eols module_header eos toplevel_stmts EOF { make_program ~loc:(to_loc $sloc) $2 $4 }
-  | opt_eols module_header eos? EOF { make_program ~loc:(to_loc $sloc) $2 [] }
+  | opt_eols attributes module_header eos toplevel_stmts EOF { make_program ~loc:(to_loc $sloc) ~core_loc:(to_loc (fst $loc($3), snd $loc)) ~attributes:$2 $3 $5 }
+  | opt_eols attributes module_header eos? EOF { make_program ~loc:(to_loc $sloc) ~core_loc:(to_loc (fst $loc($3), snd $loc)) ~attributes:$2 $3 [] }

compiler/src/parsing/parser_header.re

@@ -89,13 +89,20 @@ let make_include_alias = ident => {
   };
 };
 
-let make_program = (~loc, module_name, statements) => {
+let make_program = (~loc, ~core_loc, ~attributes, module_name, statements) => {
   // Ensure the program loc starts at the beginning of the file even if
   // there's whitespace or comments
   let loc_start = {...loc.loc_start, pos_lnum: 1, pos_cnum: 0, pos_bol: 0};
   let prog_loc = {...loc, loc_start};
 
-  {module_name, statements, comments: [], prog_loc};
+  {
+    attributes,
+    module_name,
+    statements,
+    comments: [],
+    prog_loc,
+    prog_core_loc: core_loc,
+  };
 };
 
 let parse_program = (program, token, lexbuf) => {

compiler/src/parsing/parsetree.re

@@ -693,9 +693,12 @@ type comment =
 
 [@deriving (sexp, yojson)]
 type parsed_program = {
+  attributes,
   module_name: loc(string),
   statements: list(toplevel_stmt),
   comments: list(comment),
   [@sexp_drop_if sexp_locs_disabled]
-  prog_loc: Location.t,
+  prog_loc: Location.t, // The full location of the program
+  [@sexp_drop_if sexp_locs_disabled]
+  prog_core_loc: Location.t // The core location, without attributes
 };

compiler/src/parsing/parsetree_iter.re

@@ -87,6 +87,7 @@ let iter_attributes = (hooks, attrs) => {
 
 let rec iter_parsed_program = (hooks, {statements} as program) => {
   hooks.enter_parsed_program(program);
+  iter_attributes(hooks, program.attributes);
   iter_toplevel_stmts(hooks, statements);
   hooks.leave_parsed_program(program);
 }

compiler/src/parsing/well_formedness.re

@@ -11,7 +11,7 @@ type wferr =
   | RHSLetRecMayOnlyBeFunction(Location.t)
   | NoLetRecMut(Location.t)
   | RationalZeroDenominator(Location.t)
-  | UnknownAttribute(string, Location.t)
+  | UnknownAttribute(string, string, Location.t)
   | InvalidAttributeArity(string, int, Location.t)
   | AttributeDisallowed(string, Location.t)
   | LoopControlOutsideLoop(string, Location.t)
@@ -49,8 +49,8 @@ let prepare_error =
         errorf(~loc, "let rec may not be used with the `mut` keyword.")
       | RationalZeroDenominator(loc) =>
         errorf(~loc, "Rational numbers may not have a denominator of zero.")
-      | UnknownAttribute(attr, loc) =>
-        errorf(~loc, "Unknown attribute `%s`.", attr)
+      | UnknownAttribute(attr_context, attr, loc) =>
+        errorf(~loc, "Unknown %s attribute `%s`.", attr_context, attr)
       | InvalidAttributeArity(attr, arity, loc) =>
         switch (arity) {
         | 0 => errorf(~loc, "Attribute `%s` expects no arguments.", attr)
@@ -300,35 +300,28 @@ type known_attribute = {
   arity: int,
 };
 
-let known_attributes = [
-  {name: "disableGC", arity: 0},
-  {name: "unsafe", arity: 0},
-  {name: "externalName", arity: 1},
-];
-
-let valid_attributes = (errs, super) => {
-  let enter_attribute =
-      ({Asttypes.attr_name: {txt, loc}, attr_args: args} as attr) => {
-    switch (List.find_opt(({name}) => name == txt, known_attributes)) {
-    | Some({arity}) when List.length(args) != arity =>
-      errs := [InvalidAttributeArity(txt, arity, loc), ...errs^]
-    | None => errs := [UnknownAttribute(txt, loc), ...errs^]
-    | _ => ()
-    };
-    super.enter_attribute(attr);
+let disallowed_attributes = (errs, super) => {
+  let validate_against_known = (attrs, known_attributes, context) => {
+    List.iter(
+      ({Asttypes.attr_name: {txt, loc}, attr_args: args}) => {
+        switch (List.find_opt(({name}) => name == txt, known_attributes)) {
+        | Some({arity}) when List.length(args) != arity =>
+          errs := [InvalidAttributeArity(txt, arity, loc), ...errs^]
+        | None => errs := [UnknownAttribute(context, txt, loc), ...errs^]
+        | _ => ()
+        }
+      },
+      attrs,
+    );
   };
 
-  {
-    errs,
-    iter_hooks: {
-      ...super,
-      enter_attribute,
-    },
-  };
-};
+  let known_expr_attributes = [
+    {name: "disableGC", arity: 0},
+    {name: "unsafe", arity: 0},
+    {name: "externalName", arity: 1},
+  ];
 
-let disallowed_attributes = (errs, super) => {
-  let enter_expression = ({pexp_desc: desc, pexp_attributes: attrs} as e) => {
+  let enter_expression = ({pexp_attributes: attrs} as e) => {
     switch (
       List.find_opt(
         ({Asttypes.attr_name: {txt}}) => txt == "externalName",
@@ -345,8 +338,10 @@ let disallowed_attributes = (errs, super) => {
         ]
     | None => ()
     };
+    validate_against_known(attrs, known_expr_attributes, "expression");
     super.enter_expression(e);
   };
+
   let enter_toplevel_stmt =
       ({ptop_desc: desc, ptop_attributes: attrs} as top) => {
     switch (
@@ -399,15 +394,26 @@ let disallowed_attributes = (errs, super) => {
       }
     | None => ()
     };
+    validate_against_known(attrs, known_expr_attributes, "top-level");
     super.enter_toplevel_stmt(top);
   };
 
+  let enter_parsed_program = ({attributes} as prog) => {
+    let known_module_attributes = [
+      {name: "runtimeMode", arity: 0},
+      {name: "noPervasives", arity: 0},
+    ];
+    validate_against_known(attributes, known_module_attributes, "module");
+    super.enter_parsed_program(prog);
+  };
+
   {
     errs,
     iter_hooks: {
       ...super,
       enter_expression,
       enter_toplevel_stmt,
+      enter_parsed_program,
     },
   };
 };
@@ -842,7 +848,6 @@ let well_formedness_checks = [
   only_functions_oh_rhs_letrec,
   no_letrec_mut,
   no_zero_denominator_rational,
-  valid_attributes,
   disallowed_attributes,
   no_loop_control_statement_outside_of_loop,
   malformed_return_statements,

compiler/src/typed/env.re

@@ -668,11 +668,7 @@ let get_components = c =>
   | Some(c) => c
   };
 
-type compilation_mode =
-  | Normal /* Standard compilation with regular bells and whistles */
-  | Runtime /* GC doesn't exist yet, allocations happen in runtime heap */;
-
-let current_unit = ref(("", "", Normal));
+let current_unit = ref(("", "", Grain_utils.Config.Normal));
 
 let set_unit = unit => current_unit := unit;