diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index e91361d1ac..805ee0fff2 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/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, diff --git a/compiler/common/experimental_features.ml b/compiler/common/experimental_features.ml new file mode 100644 index 0000000000..aeb1ce54fe --- /dev/null +++ b/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 diff --git a/compiler/common/experimental_features.mli b/compiler/common/experimental_features.mli new file mode 100644 index 0000000000..bc58c931c2 --- /dev/null +++ b/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 diff --git a/compiler/frontend/ast_attributes.ml b/compiler/frontend/ast_attributes.ml index add0c41225..b02733aa4c 100644 --- a/compiler/frontend/ast_attributes.ml +++ b/compiler/frontend/ast_attributes.ml @@ -199,6 +199,12 @@ let has_bs_optional (attrs : t) : bool = true | _ -> false) +let has_unwrap_attr (attrs : t) : bool = + Ext_list.exists attrs (fun ({txt}, _) -> + match txt with + | "let.unwrap" -> true + | _ -> false) + let iter_process_bs_int_as (attrs : t) = let st = ref None in Ext_list.iter attrs (fun (({txt; loc}, payload) as attr) -> diff --git a/compiler/frontend/ast_attributes.mli b/compiler/frontend/ast_attributes.mli index c2adfdd19e..1acb788701 100644 --- a/compiler/frontend/ast_attributes.mli +++ b/compiler/frontend/ast_attributes.mli @@ -46,6 +46,8 @@ val iter_process_bs_string_as : t -> string option val has_bs_optional : t -> bool +val has_unwrap_attr : t -> bool + val iter_process_bs_int_as : t -> int option type as_const_payload = Int of int | Str of string * External_arg_spec.delim diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml index 92f55fc2d8..4ae5b42c8c 100644 --- a/compiler/frontend/bs_builtin_ppx.ml +++ b/compiler/frontend/bs_builtin_ppx.ml @@ -143,6 +143,114 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) ] ) -> default_expr_mapper self {e with pexp_desc = Pexp_ifthenelse (b, t_exp, Some f_exp)} + (* Transform: + - `@let.unwrap let Ok(inner_pat) = expr` + - `@let.unwrap let Error(inner_pat) = expr` + - `@let.unwrap let Some(inner_pat) = expr` + - `@let.unwrap let None = expr` + ...into switches *) + | Pexp_let + ( Nonrecursive, + [ + { + pvb_pat = + { + ppat_desc = + ( Ppat_construct + ({txt = Lident ("Ok" as variant_name)}, Some _) + | Ppat_construct + ({txt = Lident ("Error" as variant_name)}, Some _) + | Ppat_construct + ({txt = Lident ("Some" as variant_name)}, Some _) + | Ppat_construct + ({txt = Lident ("None" as variant_name)}, None) ); + } as pvb_pat; + pvb_expr; + pvb_attributes; + }; + ], + 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 + | "Error" -> `Result_Error + | "Some" -> `Option_Some + | _ -> `Option_None + in + match pvb_expr.pexp_desc with + | Pexp_pack _ -> default_expr_mapper self e + | _ -> + let cont_case = + { + Parsetree.pc_bar = None; + pc_lhs = pvb_pat; + pc_guard = None; + pc_rhs = body; + } + in + let loc = {pvb_pat.ppat_loc with loc_ghost = true} in + let early_case = + match variant with + (* Result: continue on Ok(_), early-return on Error(e) *) + | `Result_Ok -> + { + Parsetree.pc_bar = None; + pc_lhs = + Ast_helper.Pat.alias + (Ast_helper.Pat.construct ~loc + {txt = Lident "Error"; loc} + (Some (Ast_helper.Pat.any ~loc ()))) + {txt = "e"; loc}; + pc_guard = None; + pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "e"; loc}; + } + (* Result: continue on Error(_), early-return on Ok(x) *) + | `Result_Error -> + { + Parsetree.pc_bar = None; + pc_lhs = + Ast_helper.Pat.alias + (Ast_helper.Pat.construct ~loc {txt = Lident "Ok"; loc} + (Some (Ast_helper.Pat.any ~loc ()))) + {txt = "x"; loc}; + pc_guard = None; + pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "x"; loc}; + } + (* Option: continue on Some(_), early-return on None *) + | `Option_Some -> + { + Parsetree.pc_bar = None; + pc_lhs = + Ast_helper.Pat.alias + (Ast_helper.Pat.construct ~loc {txt = Lident "None"; loc} None) + {txt = "x"; loc}; + pc_guard = None; + pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "x"; loc}; + } + (* Option: continue on None, early-return on Some(x) *) + | `Option_None -> + { + Parsetree.pc_bar = None; + pc_lhs = + Ast_helper.Pat.alias + (Ast_helper.Pat.construct ~loc {txt = Lident "Some"; loc} + (Some (Ast_helper.Pat.any ~loc ()))) + {txt = "x"; loc}; + pc_guard = None; + pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "x"; loc}; + } + in + default_expr_mapper self + { + e with + pexp_desc = Pexp_match (pvb_expr, [early_case; cont_case]); + pexp_attributes = e.pexp_attributes @ pvb_attributes; + }) | Pexp_let ( Nonrecursive, [ diff --git a/compiler/frontend/bs_syntaxerr.ml b/compiler/frontend/bs_syntaxerr.ml index 88ea8ac270..0b0bace60f 100644 --- a/compiler/frontend/bs_syntaxerr.ml +++ b/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 diff --git a/compiler/frontend/bs_syntaxerr.mli b/compiler/frontend/bs_syntaxerr.mli index d5b3c9b6f9..6602a36c18 100644 --- a/compiler/frontend/bs_syntaxerr.mli +++ b/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 diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index ab9d0d4cee..0cf4c1151d 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -105,6 +105,12 @@ module ErrorMessages = struct ] |> Doc.to_string ~width:80 + let experimental_let_unwrap_rec = + "let? is not allowed to be recursive. Use a regular `let` or remove `rec`." + + let experimental_let_unwrap_sig = + "let? is not allowed in signatures. Use a regular `let` instead." + let type_param = "A type param consists of a singlequote followed by a name like `'a` or \ `'A`" @@ -2626,21 +2632,35 @@ and parse_attributes_and_binding (p : Parser.t) = | _ -> [] (* definition ::= let [rec] let-binding { and let-binding } *) -and parse_let_bindings ~attrs ~start_pos p = - Parser.optional p Let |> ignore; +and parse_let_bindings ~unwrap ~attrs ~start_pos p = + Parser.optional p (Let {unwrap}) |> ignore; let rec_flag = if Parser.optional p Token.Rec then Asttypes.Recursive else Asttypes.Nonrecursive in + let end_pos = p.Parser.start_pos in + if rec_flag = Asttypes.Recursive && unwrap then + Parser.err ~start_pos ~end_pos p + (Diagnostics.message ErrorMessages.experimental_let_unwrap_rec); + let add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs = + if unwrap then + ( {Asttypes.txt = "let.unwrap"; loc = mk_loc start_pos end_pos}, + Ast_payload.empty ) + :: attrs + else attrs + in + let attrs = add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs in let first = parse_let_binding_body ~start_pos ~attrs p in let rec loop p bindings = let start_pos = p.Parser.start_pos in + let end_pos = p.Parser.end_pos in let attrs = parse_attributes_and_binding p in + let attrs = add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs in match p.Parser.token with | And -> Parser.next p; - ignore (Parser.optional p Let); + ignore (Parser.optional p (Let {unwrap = false})); (* overparse for fault tolerance *) let let_binding = parse_let_binding_body ~start_pos ~attrs p in loop p (let_binding :: bindings) @@ -3336,8 +3356,10 @@ and parse_expr_block_item p = let block_expr = parse_expr_block p in let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.open_ ~loc od.popen_override od.popen_lid block_expr - | Let -> - let rec_flag, let_bindings = parse_let_bindings ~attrs ~start_pos p in + | Let {unwrap} -> + let rec_flag, let_bindings = + parse_let_bindings ~unwrap ~attrs ~start_pos p + in parse_newline_or_semicolon_expr_block p; let next = if Grammar.is_block_expr_start p.Parser.token then parse_expr_block p @@ -3508,7 +3530,7 @@ and parse_if_or_if_let_expression p = Parser.expect If p; let expr = match p.Parser.token with - | Let -> + | Let _ -> Parser.next p; let if_let_expr = parse_if_let_expr start_pos p in Parser.err ~start_pos:if_let_expr.pexp_loc.loc_start @@ -5854,8 +5876,10 @@ and parse_structure_item_region p = parse_newline_or_semicolon_structure p; let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Str.open_ ~loc open_description) - | Let -> - let rec_flag, let_bindings = parse_let_bindings ~attrs ~start_pos p in + | Let {unwrap} -> + let rec_flag, let_bindings = + parse_let_bindings ~unwrap ~attrs ~start_pos p + in parse_newline_or_semicolon_structure p; let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Str.value ~loc rec_flag let_bindings) @@ -6484,7 +6508,11 @@ and parse_signature_item_region p = let start_pos = p.Parser.start_pos in let attrs = parse_attributes p in match p.Parser.token with - | Let -> + | Let {unwrap} -> + if unwrap then ( + Parser.err ~start_pos ~end_pos:p.Parser.end_pos p + (Diagnostics.message ErrorMessages.experimental_let_unwrap_sig); + Parser.next p); Parser.begin_region p; let value_desc = parse_sign_let_desc ~attrs p in parse_newline_or_semicolon_signature p; @@ -6684,7 +6712,7 @@ and parse_module_type_declaration ~attrs ~start_pos p = and parse_sign_let_desc ~attrs p = let start_pos = p.Parser.start_pos in - Parser.optional p Let |> ignore; + Parser.optional p (Let {unwrap = false}) |> ignore; let name, loc = parse_lident p in let name = Location.mkloc name loc in Parser.expect Colon p; diff --git a/compiler/syntax/src/res_grammar.ml b/compiler/syntax/src/res_grammar.ml index 456767c5bc..2c5b1e1ac0 100644 --- a/compiler/syntax/src/res_grammar.ml +++ b/compiler/syntax/src/res_grammar.ml @@ -124,8 +124,8 @@ let to_string = function | DictRows -> "rows of a dict" let is_signature_item_start = function - | Token.At | Let | Typ | External | Exception | Open | Include | Module | AtAt - | PercentPercent -> + | Token.At | Let _ | Typ | External | Exception | Open | Include | Module + | AtAt | PercentPercent -> true | _ -> false @@ -162,7 +162,7 @@ let is_jsx_attribute_start = function | _ -> false let is_structure_item_start = function - | Token.Open | Let | Typ | External | Exception | Include | Module | AtAt + | Token.Open | Let _ | Typ | External | Exception | Include | Module | AtAt | PercentPercent | At -> true | t when is_expr_start t -> true @@ -265,7 +265,7 @@ let is_jsx_child_start = is_atomic_expr_start let is_block_expr_start = function | Token.Assert | At | Await | Backtick | Bang | Codepoint _ | Exception | False | Float _ | For | Forwardslash | ForwardslashDot | Hash | If | Int _ - | Lbrace | Lbracket | LessThan | Let | Lident _ | List | Lparen | Minus + | Lbrace | Lbracket | LessThan | Let _ | Lident _ | List | Lparen | Minus | MinusDot | Module | Open | Percent | Plus | PlusDot | String _ | Switch | True | Try | Uident _ | Underscore | While | Dict -> true diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index a7c95cf5ee..cf790f8201 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -2093,11 +2093,20 @@ and print_type_parameter ~state {attrs; lbl; typ} cmt_tbl = and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl i = + let has_unwrap = ref false in let attrs = - print_attributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmt_tbl - in + vb.pvb_attributes + |> List.filter_map (function + | {Asttypes.txt = "let.unwrap"}, _ -> + has_unwrap := true; + None + | attr -> Some attr) + in + let attrs = print_attributes ~state ~loc:vb.pvb_pat.ppat_loc attrs cmt_tbl in let header = - if i == 0 then Doc.concat [Doc.text "let "; rec_flag] else Doc.text "and " + if i == 0 then + Doc.concat [Doc.text (if !has_unwrap then "let? " else "let "); rec_flag] + else Doc.text "and " in match vb with | { diff --git a/compiler/syntax/src/res_scanner.ml b/compiler/syntax/src/res_scanner.ml index c404d36cc2..ee731f0ec5 100644 --- a/compiler/syntax/src/res_scanner.ml +++ b/compiler/syntax/src/res_scanner.ml @@ -209,6 +209,10 @@ let scan_identifier scanner = next scanner; (* TODO: this isn't great *) Token.lookup_keyword "dict{" + | {ch = '?'}, "let" -> + next scanner; + (* TODO: this isn't great *) + Token.lookup_keyword "let?" | _ -> Token.lookup_keyword str let scan_digits scanner ~base = diff --git a/compiler/syntax/src/res_token.ml b/compiler/syntax/src/res_token.ml index 5fc89658c0..d48a97d24e 100644 --- a/compiler/syntax/src/res_token.ml +++ b/compiler/syntax/src/res_token.ml @@ -17,7 +17,7 @@ type t = | DotDotDot | Bang | Semicolon - | Let + | Let of {unwrap: bool} | And | Rec | Underscore @@ -133,7 +133,8 @@ let to_string = function | Float {f} -> "Float: " ^ f | Bang -> "!" | Semicolon -> ";" - | Let -> "let" + | Let {unwrap = true} -> "let?" + | Let {unwrap = false} -> "let" | And -> "and" | Rec -> "rec" | Underscore -> "_" @@ -231,7 +232,8 @@ let keyword_table = function | "if" -> If | "in" -> In | "include" -> Include - | "let" -> Let + | "let?" -> Let {unwrap = true} + | "let" -> Let {unwrap = false} | "list{" -> List | "dict{" -> Dict | "module" -> Module @@ -251,7 +253,7 @@ let keyword_table = function let is_keyword = function | Await | And | As | Assert | Constraint | Else | Exception | External | False - | For | If | In | Include | Land | Let | List | Lor | Module | Mutable | Of + | For | If | In | Include | Land | Let _ | List | Lor | Module | Mutable | Of | Open | Private | Rec | Switch | True | Try | Typ | When | While | Dict -> true | _ -> false diff --git a/compiler/syntax/src/res_token_debugger.ml b/compiler/syntax/src/res_token_debugger.ml index 6f3631ec20..852bc110a3 100644 --- a/compiler/syntax/src/res_token_debugger.ml +++ b/compiler/syntax/src/res_token_debugger.ml @@ -33,7 +33,7 @@ let dump_tokens filename = | Res_token.DotDotDot -> "DotDotDot" | Res_token.Bang -> "Bang" | Res_token.Semicolon -> "Semicolon" - | Res_token.Let -> "Let" + | Res_token.Let {unwrap} -> "Let" ^ if unwrap then "?" else "" | Res_token.And -> "And" | Res_token.Rec -> "Rec" | Res_token.Underscore -> "Underscore" diff --git a/docs/docson/build-schema.json b/docs/docson/build-schema.json index fa46f507e6..f22af7fc7a 100644 --- a/docs/docson/build-schema.json +++ b/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, diff --git a/rewatch/CompilerConfigurationSpec.md b/rewatch/CompilerConfigurationSpec.md index b47b4da6d5..6568945818 100644 --- a/rewatch/CompilerConfigurationSpec.md +++ b/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? | diff --git a/rewatch/src/build/compile.rs b/rewatch/src/build/compile.rs index f62a5123d8..f5b908ea11 100644 --- a/rewatch/src/build/compile.rs +++ b/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 diff --git a/rewatch/src/config.rs b/rewatch/src/config.rs index 3435859e4b..794f7ad18a 100644 --- a/rewatch/src/config.rs +++ b/rewatch/src/config.rs @@ -2,7 +2,9 @@ use crate::build::packages; use crate::helpers::deserialize::*; 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::{Path, PathBuf}; @@ -222,6 +224,39 @@ pub enum DeprecationWarning { BscFlags, } +#[derive(Debug, Clone, Eq, PartialEq, Hash)] +pub enum ExperimentalFeature { + LetUnwrap, +} + +impl<'de> serde::Deserialize<'de> for ExperimentalFeature { + fn deserialize(deserializer: D) -> Result + 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(self, v: &str) -> Result + 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)] @@ -254,6 +289,8 @@ pub struct Config { pub namespace: Option, pub jsx: Option, + #[serde(rename = "experimentalFeatures")] + pub experimental_features: Option>, #[serde(rename = "gentypeconfig")] pub gentype_config: Option, // this is a new feature of rewatch, and it's not part of the rescript.json spec @@ -491,6 +528,25 @@ impl Config { } } + pub fn get_experimental_features_args(&self) -> Vec { + 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 { match &self.gentype_config { Some(_) => vec!["-bs-gentype".to_string()], @@ -656,6 +712,7 @@ pub mod tests { gentype_config: None, namespace_entry: None, deprecation_warnings: vec![], + experimental_features: None, allowed_dependents: args.allowed_dependents, path: args.path, } diff --git a/rewatch/tests/experimental-invalid.sh b/rewatch/tests/experimental-invalid.sh new file mode 100755 index 0000000000..bb93545aff --- /dev/null +++ b/rewatch/tests/experimental-invalid.sh @@ -0,0 +1,36 @@ +#!/bin/bash +cd $(dirname $0) +source "./utils.sh" +cd ../testrepo + +bold "Test: invalid experimentalFeatures keys produce helpful error" + +cp rescript.json rescript.json.bak + +node -e ' +const fs=require("fs"); +const j=JSON.parse(fs.readFileSync("rescript.json","utf8")); +j.experimentalFeatures={FooBar:true}; +fs.writeFileSync("rescript.json", JSON.stringify(j,null,2)); +' + +out=$(rewatch compiler-args packages/file-casing/src/Consume.res 2>&1) +status=$? + +mv rescript.json.bak rescript.json + +if [ $status -eq 0 ]; then + error "Expected compiler-args to fail for unknown experimental feature" + echo "$out" + exit 1 +fi + +echo "$out" | grep -q "Unknown experimental feature 'FooBar'. Available features: LetUnwrap" +if [ $? -ne 0 ]; then + error "Missing helpful message for unknown experimental feature" + echo "$out" + exit 1 +fi + +success "invalid experimentalFeatures produces helpful error" + diff --git a/rewatch/tests/experimental.sh b/rewatch/tests/experimental.sh new file mode 100755 index 0000000000..f38ae1617c --- /dev/null +++ b/rewatch/tests/experimental.sh @@ -0,0 +1,38 @@ +#!/bin/bash +cd $(dirname $0) +source "./utils.sh" +cd ../testrepo + +bold "Test: experimentalFeatures in rescript.json emits -enable-experimental as string list" + +# Backup rescript.json +cp rescript.json rescript.json.bak + +# Inject experimentalFeatures enabling LetUnwrap using node for portability +node -e ' +const fs=require("fs"); +const j=JSON.parse(fs.readFileSync("rescript.json","utf8")); +j.experimentalFeatures={LetUnwrap:true}; +fs.writeFileSync("rescript.json", JSON.stringify(j,null,2)); +' + +stdout=$(rewatch compiler-args packages/file-casing/src/Consume.res 2>/dev/null) +if [ $? -ne 0 ]; then + mv rescript.json.bak rescript.json + error "Error grabbing compiler args with experimentalFeatures enabled" + exit 1 +fi + +# Expect repeated string-list style: presence of -enable-experimental and LetUnwrap entries +echo "$stdout" | grep -q '"-enable-experimental"' && echo "$stdout" | grep -q '"LetUnwrap"' +if [ $? -ne 0 ]; then + mv rescript.json.bak rescript.json + error "-enable-experimental / LetUnwrap not found in compiler-args output" + echo "$stdout" + exit 1 +fi + +# Restore original rescript.json +mv rescript.json.bak rescript.json + +success "experimentalFeatures emits -enable-experimental as string list" diff --git a/rewatch/tests/suite-ci.sh b/rewatch/tests/suite-ci.sh index fc1d615643..d7da7de3ce 100755 --- a/rewatch/tests/suite-ci.sh +++ b/rewatch/tests/suite-ci.sh @@ -43,4 +43,4 @@ else exit 1 fi -./compile.sh && ./watch.sh && ./lock.sh && ./suffix.sh && ./legacy.sh && ./format.sh && ./clean.sh && ./compiler-args.sh \ No newline at end of file +./compile.sh && ./watch.sh && ./lock.sh && ./suffix.sh && ./legacy.sh && ./format.sh && ./clean.sh && ./experimental.sh && ./experimental-invalid.sh && ./compiler-args.sh diff --git a/tests/build_tests/super_errors/expected/feature_letunwrap_not_enabled.res.expected b/tests/build_tests/super_errors/expected/feature_letunwrap_not_enabled.res.expected new file mode 100644 index 0000000000..7facd8a5c8 --- /dev/null +++ b/tests/build_tests/super_errors/expected/feature_letunwrap_not_enabled.res.expected @@ -0,0 +1,11 @@ + + We've found a bug for you! + /.../fixtures/feature_letunwrap_not_enabled.res:4:8-13 + + 2 │ + 3 │ let x = { + 4 │ let? Ok(_x) = ok + 5 │ Ok() + 6 │ } + + Experimental feature not enabled: LetUnwrap. Enable it by setting "LetUnwrap" to true under "experimentalFeatures" in rescript.json \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/feature_letunwrap_not_enabled.res b/tests/build_tests/super_errors/fixtures/feature_letunwrap_not_enabled.res new file mode 100644 index 0000000000..1c8ca1c6a8 --- /dev/null +++ b/tests/build_tests/super_errors/fixtures/feature_letunwrap_not_enabled.res @@ -0,0 +1,6 @@ +let ok = Ok(1) + +let x = { + let? Ok(_x) = ok + Ok() +} diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/letUnwrapRec.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/letUnwrapRec.res.txt new file mode 100644 index 0000000000..ee6fbcfcf4 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/letUnwrapRec.res.txt @@ -0,0 +1,11 @@ + + Syntax error! + syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res:1:1-9 + + 1 │ let? rec Some(baz) = someOption + 2 │ and Some(bar) = baz + + let? is not allowed to be recursive. Use a regular `let` or remove `rec`. + +let rec Some baz = someOption[@@let.unwrap ] +and Some bar = baz[@@let.unwrap ] \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res b/tests/syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res new file mode 100644 index 0000000000..ce29385c36 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res @@ -0,0 +1,2 @@ +let? rec Some(baz) = someOption +and Some(bar) = baz \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/signature/expected/letUnwrap.resi.txt b/tests/syntax_tests/data/parsing/errors/signature/expected/letUnwrap.resi.txt new file mode 100644 index 0000000000..74ace608ce --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/signature/expected/letUnwrap.resi.txt @@ -0,0 +1,9 @@ + + Syntax error! + syntax_tests/data/parsing/errors/signature/letUnwrap.resi:1:1-4 + + 1 │ let? foo: string + + let? is not allowed in signatures. Use a regular `let` instead. + +val foo : string \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/signature/letUnwrap.resi b/tests/syntax_tests/data/parsing/errors/signature/letUnwrap.resi new file mode 100644 index 0000000000..4b31b705e8 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/signature/letUnwrap.resi @@ -0,0 +1 @@ +let? foo: string \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/letUnwrap.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/letUnwrap.res.txt new file mode 100644 index 0000000000..46810e3112 --- /dev/null +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/letUnwrap.res.txt @@ -0,0 +1,4 @@ +let Ok foo = someResult[@@let.unwrap ] +let Some bar = someOption[@@let.unwrap ] +let Some baz = someOption[@@let.unwrap ] +and Some bar = someOtherOption[@@let.unwrap ] \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/letUnwrap.res b/tests/syntax_tests/data/parsing/grammar/expressions/letUnwrap.res new file mode 100644 index 0000000000..bf141d4d09 --- /dev/null +++ b/tests/syntax_tests/data/parsing/grammar/expressions/letUnwrap.res @@ -0,0 +1,9 @@ +// with Ok +let? Ok(foo) = someResult + +// with Some +let? Some(bar) = someOption + +// with and +let? Some(baz) = someOption +and Some(bar) = someOtherOption \ No newline at end of file diff --git a/tests/syntax_tests/data/printer/expr/expected/letUnwrap.res.txt b/tests/syntax_tests/data/printer/expr/expected/letUnwrap.res.txt new file mode 100644 index 0000000000..4f64a35929 --- /dev/null +++ b/tests/syntax_tests/data/printer/expr/expected/letUnwrap.res.txt @@ -0,0 +1,9 @@ +// with Ok +let? Ok(foo) = someResult + +// with Some +let? Some(bar) = someOption + +// with and +let? Some(baz) = someOption +and Some(bar) = someOtherOption diff --git a/tests/syntax_tests/data/printer/expr/letUnwrap.res b/tests/syntax_tests/data/printer/expr/letUnwrap.res new file mode 100644 index 0000000000..bf141d4d09 --- /dev/null +++ b/tests/syntax_tests/data/printer/expr/letUnwrap.res @@ -0,0 +1,9 @@ +// with Ok +let? Ok(foo) = someResult + +// with Some +let? Some(bar) = someOption + +// with and +let? Some(baz) = someOption +and Some(bar) = someOtherOption \ No newline at end of file diff --git a/tests/syntax_tests/res_test.ml b/tests/syntax_tests/res_test.ml index a7a0d57b4f..505637dd04 100644 --- a/tests/syntax_tests/res_test.ml +++ b/tests/syntax_tests/res_test.ml @@ -94,7 +94,7 @@ module ParserApiTest = struct assert (parser.scanner.lnum == 1); assert (parser.scanner.line_offset == 0); assert (parser.scanner.offset == 6); - assert (parser.token = Res_token.Let); + assert (parser.token = Res_token.Let {unwrap = false}); print_endline "✅ Parser make: initializes parser and checking offsets" let unix_lf () = diff --git a/tests/tests/src/LetUnwrap.mjs b/tests/tests/src/LetUnwrap.mjs new file mode 100644 index 0000000000..9bf42700b7 --- /dev/null +++ b/tests/tests/src/LetUnwrap.mjs @@ -0,0 +1,193 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +function doStuffWithResult(s) { + if (s === "s") { + return { + TAG: "Ok", + _0: "hello" + }; + } else { + return { + TAG: "Error", + _0: "InvalidString" + }; + } +} + +function doNextStuffWithResult(s) { + if (s === "s") { + return { + TAG: "Ok", + _0: "hello" + }; + } else { + return { + TAG: "Error", + _0: "InvalidNext" + }; + } +} + +function getXWithResult(s) { + let e = doStuffWithResult(s); + if (e.TAG !== "Ok") { + return e; + } + let y = e._0; + let e$1 = doNextStuffWithResult(y); + if (e$1.TAG === "Ok") { + return { + TAG: "Ok", + _0: e$1._0 + y + }; + } else { + return e$1; + } +} + +let x = getXWithResult("s"); + +let someResult; + +someResult = x.TAG === "Ok" ? x._0 : ( + x._0 === "InvalidNext" ? "nope!" : "nope" + ); + +function doStuffWithOption(s) { + if (s === "s") { + return "hello"; + } + +} + +function doNextStuffWithOption(s) { + if (s === "s") { + return "hello"; + } + +} + +function getXWithOption(s) { + let x = doStuffWithOption(s); + if (x === undefined) { + return x; + } + let x$1 = doNextStuffWithOption(x); + if (x$1 !== undefined) { + return x$1 + x; + } else { + return x$1; + } +} + +let x$1 = getXWithOption("s"); + +let someOption = x$1 !== undefined ? x$1 : "nope"; + +async function doStuffResultAsync(s) { + if (s === "s") { + return { + TAG: "Ok", + _0: { + s: "hello" + } + }; + } else { + return { + TAG: "Error", + _0: "FetchError" + }; + } +} + +async function decodeResAsync(res) { + let match = res.s; + if (match === "s") { + return { + TAG: "Ok", + _0: res.s + }; + } else { + return { + TAG: "Error", + _0: "DecodeError" + }; + } +} + +async function getXWithResultAsync(s) { + let e = await doStuffResultAsync(s); + if (e.TAG !== "Ok") { + return e; + } + let res = e._0; + console.log(res.s); + let e$1 = await decodeResAsync(res); + if (e$1.TAG === "Ok") { + return { + TAG: "Ok", + _0: e$1._0 + }; + } else { + return e$1; + } +} + +function returnsAliasOnFirstError(s) { + let e = doStuffWithResult(s); + if (e.TAG === "Ok") { + return { + TAG: "Ok", + _0: "ok" + }; + } else { + return e; + } +} + +function returnsAliasOnSecondError(s) { + let e = doStuffWithResult(s); + if (e.TAG !== "Ok") { + return e; + } + let e$1 = doNextStuffWithResult(e._0); + if (e$1.TAG === "Ok") { + return { + TAG: "Ok", + _0: "ok" + }; + } else { + return e$1; + } +} + +function returnsAliasOnOk(s) { + let x = doStuffWithResult(s); + if (x.TAG === "Ok") { + return x; + } else { + return { + TAG: "Error", + _0: "GotError" + }; + } +} + +export { + doStuffWithResult, + doNextStuffWithResult, + getXWithResult, + someResult, + doStuffWithOption, + doNextStuffWithOption, + getXWithOption, + someOption, + doStuffResultAsync, + decodeResAsync, + getXWithResultAsync, + returnsAliasOnFirstError, + returnsAliasOnSecondError, + returnsAliasOnOk, +} +/* x Not a pure module */ diff --git a/tests/tests/src/LetUnwrap.res b/tests/tests/src/LetUnwrap.res new file mode 100644 index 0000000000..9611cc9adb --- /dev/null +++ b/tests/tests/src/LetUnwrap.res @@ -0,0 +1,87 @@ +@@config({flags: ["-enable-experimental", "LetUnwrap"]}) + +let doStuffWithResult = s => + switch s { + | "s" => Ok("hello") + | _ => Error(#InvalidString) + } + +let doNextStuffWithResult = s => + switch s { + | "s" => Ok("hello") + | _ => Error(#InvalidNext) + } + +let getXWithResult = s => { + let? Ok(y) = doStuffWithResult(s) + let? Ok(x) = doNextStuffWithResult(y) + Ok(x ++ y) +} + +let someResult = switch getXWithResult("s") { +| Ok(x) => x +| Error(#InvalidString) => "nope" +| Error(#InvalidNext) => "nope!" +} + +let doStuffWithOption = s => + switch s { + | "s" => Some("hello") + | _ => None + } + +let doNextStuffWithOption = s => + switch s { + | "s" => Some("hello") + | _ => None + } + +let getXWithOption = s => { + let? Some(y) = doStuffWithOption(s) + let? Some(x) = doNextStuffWithOption(y) + Some(x ++ y) +} + +let someOption = switch getXWithOption("s") { +| Some(x) => x +| None => "nope" +} + +type res = {s: string} + +let doStuffResultAsync = async s => { + switch s { + | "s" => Ok({s: "hello"}) + | _ => Error(#FetchError) + } +} + +let decodeResAsync = async res => { + switch res.s { + | "s" => Ok(res.s) + | _ => Error(#DecodeError) + } +} + +let getXWithResultAsync = async s => { + let? Ok({s} as res) = await doStuffResultAsync(s) + Console.log(s) + let? Ok(x) = await decodeResAsync(res) + Ok(x) +} + +let returnsAliasOnFirstError = s => { + let? Ok(_y) = doStuffWithResult(s) + Ok("ok") +} + +let returnsAliasOnSecondError = s => { + let? Ok(y) = doStuffWithResult(s) + let? Ok(_x) = doNextStuffWithResult(y) + Ok("ok") +} + +let returnsAliasOnOk = s => { + let? Error(_e) = doStuffWithResult(s) + Error(#GotError) +}