add feature for shipping experimental features

Author: zth

compiler/bsc/rescript_compiler_main.ml

@@ -402,6 +402,10 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
     ( "-absname",
       set absname,
       "*internal* Show absolute filenames in error messages" );
+    ( "-enable-experimental",
+      string_call Experimental_features.enable_from_string,
+      "Enable experimental features: repeatable, e.g. -enable-experimental \
+       LetUnwrap" );
     (* Not used, the build system did the expansion *)
     ( "-bs-no-bin-annot",
       clear Clflags.binary_annotations,

compiler/common/experimental_features.ml

@@ -0,0 +1,18 @@
+type feature = LetUnwrap
+
+let to_string (f : feature) : string =
+  match f with
+  | LetUnwrap -> "LetUnwrap"
+
+let from_string (s : string) : feature option =
+  match s with
+  | "LetUnwrap" -> Some LetUnwrap
+  | _ -> None
+
+let enabled_features : feature list ref = ref []
+let enable_from_string (s : string) =
+  match from_string s with
+  | Some f -> enabled_features := f :: !enabled_features
+  | None -> ()
+
+let is_enabled (f : feature) = List.mem f !enabled_features

compiler/common/experimental_features.mli

@@ -0,0 +1,5 @@
+type feature = LetUnwrap
+
+val enable_from_string : string -> unit
+val is_enabled : feature -> bool
+val to_string : feature -> string

compiler/frontend/bs_builtin_ppx.ml

@@ -171,6 +171,10 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
         ],
         body )
     when Ast_attributes.has_unwrap_attr pvb_attributes -> (
+    if not (Experimental_features.is_enabled Experimental_features.LetUnwrap)
+    then
+      Bs_syntaxerr.err pvb_pat.ppat_loc
+        (Experimental_feature_not_enabled LetUnwrap);
     let variant : [`Result_Ok | `Result_Error | `Option_Some | `Option_None] =
       match variant_name with
       | "Ok" -> `Result_Ok

compiler/frontend/bs_syntaxerr.ml

@@ -47,6 +47,7 @@ type error =
   | Misplaced_label_syntax
   | Optional_in_uncurried_bs_attribute
   | Bs_this_simple_pattern
+  | Experimental_feature_not_enabled of Experimental_features.feature
 
 let pp_error fmt err =
   Format.pp_print_string fmt
@@ -82,7 +83,13 @@ let pp_error fmt err =
        each constructor must have an argument."
     | Conflict_ffi_attribute str -> "Conflicting attributes: " ^ str
     | Bs_this_simple_pattern ->
-      "%@this expect its pattern variable to be simple form")
+      "%@this expect its pattern variable to be simple form"
+    | Experimental_feature_not_enabled feature ->
+      Printf.sprintf
+        "Experimental feature not enabled: %s. Enable it by setting \"%s\" to \
+         true under \"experimentalFeatures\" in rescript.json"
+        (Experimental_features.to_string feature)
+        (Experimental_features.to_string feature))
 
 type exn += Error of Location.t * error
 

compiler/frontend/bs_syntaxerr.mli

@@ -47,6 +47,7 @@ type error =
   | Misplaced_label_syntax
   | Optional_in_uncurried_bs_attribute
   | Bs_this_simple_pattern
+  | Experimental_feature_not_enabled of Experimental_features.feature
 
 val err : Location.t -> error -> 'a
 

docs/docson/build-schema.json

@@ -484,6 +484,17 @@
     "editor": {
       "$ref": "#/definitions/editor",
       "description": "Configure editor functionality, like modules that should be included in autocompletions for given (built-in) types."
+    },
+    "experimentalFeatures": {
+      "type": "object",
+      "description": "Enable experimental compiler features.",
+      "properties": {
+        "LetUnwrap": {
+          "type": "boolean",
+          "description": "Enable let? syntax."
+        }
+      },
+      "additionalProperties": false
     }
   },
   "additionalProperties": false,

rewatch/CompilerConfigurationSpec.md

@@ -32,6 +32,7 @@ This document contains a list of all bsconfig parameters with remarks, and wheth
 | bs-external-includes | array of string         |        |     [_]      |
 | suffix               | Suffix                  |        |     [x]      |
 | reanalyze            | Reanalyze               |        |     [_]      |
+| experimentalFeatures | ExperimentalFeatures    |        |     [x]      |
 
 ### Source
 
@@ -111,6 +112,17 @@ enum: "classic" | "automatic"
 
 enum: | "dce" | "exception" | "termination"
 
+### ExperimentalFeatures
+
+An object of feature flags to enable experimental compiler behavior. Only supported by Rewatch.
+
+- Keys: feature identifiers (PascalCase)
+- Values: boolean (true to enable)
+
+Currently supported features:
+
+- LetUnwrap: Enable the `let?` transformation.
+
 ### Warnings
 
 | Parameter | JSON type | Remark | Implemented? |

rewatch/src/build/compile.rs

@@ -381,6 +381,7 @@ pub fn compiler_args(
     let jsx_mode_args = root_config.get_jsx_mode_args();
     let jsx_preserve_args = root_config.get_jsx_preserve_args();
     let gentype_arg = config.get_gentype_arg();
+    let experimental_args = root_config.get_experimental_features_args();
     let warning_args = config.get_warning_args(is_local_dep);
 
     let read_cmi_args = match has_interface {
@@ -445,6 +446,7 @@ pub fn compiler_args(
         bsc_flags.to_owned(),
         warning_args,
         gentype_arg,
+        experimental_args,
         // vec!["-warn-error".to_string(), "A".to_string()],
         // ^^ this one fails for bisect-ppx
         // this is the default

rewatch/src/config.rs

@@ -4,7 +4,9 @@ use crate::helpers::deserialize::*;
 use crate::project_context::ProjectContext;
 use anyhow::{Result, bail};
 use convert_case::{Case, Casing};
-use serde::Deserialize;
+use serde::de::{Error as DeError, Visitor};
+use serde::{Deserialize, Deserializer};
+use std::collections::HashMap;
 use std::fs;
 use std::path::{MAIN_SEPARATOR, Path, PathBuf};
 
@@ -224,6 +226,39 @@ pub enum DeprecationWarning {
     BscFlags,
 }
 
+#[derive(Debug, Clone, Eq, PartialEq, Hash)]
+pub enum ExperimentalFeature {
+    LetUnwrap,
+}
+
+impl<'de> serde::Deserialize<'de> for ExperimentalFeature {
+    fn deserialize<D>(deserializer: D) -> Result<Self, D::Error>
+    where
+        D: Deserializer<'de>,
+    {
+        struct EFVisitor;
+        impl<'de> Visitor<'de> for EFVisitor {
+            type Value = ExperimentalFeature;
+            fn expecting(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
+                write!(f, "a valid experimental feature id (e.g. LetUnwrap)")
+            }
+            fn visit_str<E>(self, v: &str) -> Result<Self::Value, E>
+            where
+                E: DeError,
+            {
+                match v {
+                    "LetUnwrap" => Ok(ExperimentalFeature::LetUnwrap),
+                    other => Err(DeError::custom(format!(
+                        "Unknown experimental feature '{}'. Available features: LetUnwrap",
+                        other
+                    ))),
+                }
+            }
+        }
+        deserializer.deserialize_any(EFVisitor)
+    }
+}
+
 /// # rescript.json representation
 /// This is tricky, there is a lot of ambiguity. This is probably incomplete.
 #[derive(Deserialize, Debug, Clone, Default)]
@@ -256,6 +291,8 @@ pub struct Config {
 
     pub namespace: Option<NamespaceConfig>,
     pub jsx: Option<JsxSpecs>,
+    #[serde(rename = "experimentalFeatures")]
+    pub experimental_features: Option<HashMap<ExperimentalFeature, bool>>,
     #[serde(rename = "gentypeconfig")]
     pub gentype_config: Option<GenTypeConfig>,
     // this is a new feature of rewatch, and it's not part of the rescript.json spec
@@ -498,6 +535,25 @@ impl Config {
         }
     }
 
+    pub fn get_experimental_features_args(&self) -> Vec<String> {
+        match &self.experimental_features {
+            None => vec![],
+            Some(map) => map
+                .iter()
+                .filter_map(|(k, v)| if *v { Some(k) } else { None })
+                .flat_map(|feature| {
+                    vec![
+                        "-enable-experimental".to_string(),
+                        match feature {
+                            ExperimentalFeature::LetUnwrap => "LetUnwrap",
+                        }
+                        .to_string(),
+                    ]
+                })
+                .collect(),
+        }
+    }
+
     pub fn get_gentype_arg(&self) -> Vec<String> {
         match &self.gentype_config {
             Some(_) => vec!["-bs-gentype".to_string()],