feat(compiler)!: Per-file compiler flags as module attribute

grain-lang · Feb 25, 2024 · c3e4c0a · c3e4c0a
1 parent 5f44d4e
commit c3e4c0a
Show file tree

Hide file tree

Showing 64 changed files with 555 additions and 272 deletions.
diff --git a/cli/bin/grain.js b/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"

diff --git a/compiler/src/compile.re b/compiler/src/compile.re
@@ -89,25 +89,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) {
@@ -146,7 +127,10 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) =>
       cleanup();
       Parsed(parsed);
     | Parsed(p) =>
-      apply_inline_flags(p);
+      Grain_utils.Config.apply_attribute_flags(
+        ~no_pervasives=Option.is_some(p.attributes.no_pervasives),
+        ~runtime_mode=Option.is_some(p.attributes.runtime_mode),
+      );
       if (is_root_file) {
         Grain_utils.Config.set_root_config();
       };
@@ -267,7 +251,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),

diff --git a/compiler/src/formatting/fmt.re b/compiler/src/formatting/fmt.re
@@ -3921,6 +3921,16 @@ let print_comment_range =
 };
 
 let print_program = (fmt, parsed_program) => {
+  let attrs =
+    Option.to_list(parsed_program.attributes.no_pervasives)
+    @ Option.to_list(parsed_program.attributes.runtime_mode);
+
+  let first_loc =
+    switch (attrs) {
+    | [fst, ..._] => fst.attr_loc
+    | _ => parsed_program.prog_core_loc
+    };
+
   let toplevel =
     switch (parsed_program.statements) {
     | [] =>
@@ -3988,8 +3998,35 @@ let print_program = (fmt, parsed_program) => {
   fmt.print_comment_range(
     fmt,
     enclosing_start_location(parsed_program.prog_loc),
-    parsed_program.module_name.loc,
+    first_loc,
   )
+  ++ group(
+       concat_map(
+         ~lead=_ => empty,
+         ~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),
+         attrs,
+       ),
+     )
   ++ string("module ")
   ++ string(parsed_program.module_name.txt)
   ++ toplevel;

diff --git a/compiler/src/parsing/driver.re b/compiler/src/parsing/driver.re
@@ -158,15 +158,12 @@ let read_imports = (program: Parsetree.parsed_program) => {
         | Grain_utils.Config.Gc_mod => Location.mknoloc("runtime/gc")
         }
       },
-      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(
+        ~on_error=_ => (),
+        ~no_pervasives=Option.is_some(program.attributes.no_pervasives),
+        ~runtime_mode=Option.is_some(program.attributes.runtime_mode),
+        Grain_utils.Config.get_implicit_opens,
+      ),
     );
   let found_includes = ref([]);
 

diff --git a/compiler/src/parsing/parser.messages b/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`.
 

diff --git a/compiler/src/parsing/parser.mly b/compiler/src/parsing/parser.mly
@@ -555,10 +555,13 @@ attribute_arguments:
   | lparen lseparated_list(comma, attribute_argument) rparen { $2 }
 
 attribute:
-  | AT id_str loption(attribute_arguments) opt_eols { Attribute.mk ~loc:(to_loc $loc) $2 $3 }
+  | AT id_str loption(attribute_arguments) { Attribute.mk ~loc:(to_loc $loc) $2 $3 }
+
+attribute_with_opt_eols:
+  | attribute opt_eols { $1 }
 
 attributes:
-  | attribute* { $1 }
+  | attribute_with_opt_eols* { $1 }
 
 let_expr:
   | attributes LET REC value_binds { Expression.let_ ~loc:(to_loc $sloc) ~core_loc:(to_loc (fst $loc($2), snd $loc)) ~attributes:$1 Recursive Immutable $4 }
@@ -744,5 +747,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 [] }
diff --git a/compiler/src/parsing/parser_header.re b/compiler/src/parsing/parser_header.re
@@ -116,13 +116,47 @@ 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};
+  let (no_pervasives, runtime_mode) =
+    List.fold_left(
+      ((no_pervasives, runtime_mode), attr) => {
+        switch (attr) {
+        | Asttypes.{attr_name: {txt: "noPervasives"}, attr_args: []} => (
+            Some(attr),
+            runtime_mode,
+          )
+        | {attr_name: {txt: "runtimeMode"}, attr_args: []} => (
+            no_pervasives,
+            Some(attr),
+          )
+        | {attr_name: {loc}} =>
+          raise(
+            SyntaxError(
+              loc,
+              "@noPervasives and @runtimeMode are the only valid top-level module attributes.",
+            ),
+          )
+        }
+      },
+      (None, None),
+      attributes,
+    );
 
-  fix_blocks({module_name, statements, comments: [], prog_loc});
+  fix_blocks({
+    attributes: {
+      no_pervasives,
+      runtime_mode,
+    },
+    module_name,
+    statements,
+    comments: [],
+    prog_loc,
+    prog_core_loc: core_loc,
+  });
 };
 
 let parse_program = (program, token, lexbuf) => {

diff --git a/compiler/src/parsing/parsetree.re b/compiler/src/parsing/parsetree.re
@@ -691,11 +691,20 @@ type comment =
 
 /** The type for parsed programs */
 
+[@deriving (sexp, yojson)]
+type module_attributes = {
+  no_pervasives: option(attribute),
+  runtime_mode: option(attribute),
+};
+
 [@deriving (sexp, yojson)]
 type parsed_program = {
+  attributes: module_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
 };
diff --git a/compiler/src/typed/env.re b/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;
 

diff --git a/compiler/src/typed/env.rei b/compiler/src/typed/env.rei
@@ -162,13 +162,8 @@ let add_local_type: (Path.t, type_declaration, t) => t;
 let add_item: (signature_item, t) => t;
 let add_signature: (signature, t) => t;
 
-/* Remember the current compilation unit: modname * filename * compilation mode. */
-type compilation_mode =
-  | Normal
-  | Runtime;
-
-let set_unit: ((string, string, compilation_mode)) => unit;
-let get_unit: unit => (string, string, compilation_mode);
+let set_unit: ((string, string, Grain_utils.Config.compilation_mode)) => unit;
+let get_unit: unit => (string, string, Grain_utils.Config.compilation_mode);
 let is_runtime_mode: unit => bool;
 
 /* Insertion of a module */

diff --git a/compiler/src/typed/typed_well_formedness.re b/compiler/src/typed/typed_well_formedness.re
@@ -337,11 +337,10 @@ module WellFormednessArg: TypedtreeIter.IteratorArgument = {
       };
       // For now, we only raise the error inside of functions.
       if (exp_is_wasm_unsafe(exp)
-          && !(
-               Grain_utils.Config.no_gc^
-               || Grain_utils.Config.compilation_mode^ == Some("runtime")
-               || is_unsafe()
-             )) {
+          && !
+               Grain_utils.Config.(
+                 no_gc^ || compilation_mode^ == Runtime || is_unsafe()
+               )) {
         raise(Error(exp_loc, WasmOutsideDisableGc));
       };
     };

diff --git a/compiler/src/typed/typemod.re b/compiler/src/typed/typemod.re
@@ -1040,17 +1040,14 @@ let initial_env = () => {
   );
 };
 
-let get_compilation_mode = () => {
-  switch (Grain_utils.Config.compilation_mode^) {
-  | Some("runtime") => Env.Runtime
-  | _ => Env.Normal
-  };
-};
-
 let type_implementation = prog => {
   let sourcefile = prog.prog_loc.loc_start.pos_fname;
   let module_name = prog.module_name.txt;
-  Env.set_unit((module_name, sourcefile, get_compilation_mode()));
+  Env.set_unit((
+    module_name,
+    sourcefile,
+    Grain_utils.Config.compilation_mode^,
+  ));
   let initenv = initial_env();
   let (statements, sg, finalenv) = type_module(initenv, prog.statements);
   let simple_sg = simplify_signature(sg);