From b9d5ed44d8937392b1783e23c8b0433c68e13767 Mon Sep 17 00:00:00 2001 From: Jordan Date: Thu, 16 Jul 2020 15:47:11 -0700 Subject: [PATCH 1/3] Reason V4 [Stacked Diff 1/n #2605] [Allow multiple versions of Reason] Summary:This allows multiple versions of Reason in a single project by inferring and recording the version of syntax used into the file in an attribute. The attribute allows us to switch the parser and lexer on the fly. This attribute is not the only way we can infer the version, and we can allow project level configuration, but this is the approach that is guaranteed to work with any build system or tooling. Test Plan: Reviewers: CC: --- docs/RELEASING.md | 24 +- .../expected_output/arityConversion.re | 1 + .../expected_output/attributes.4.04.0.re | 1 + .../expected_output/attributes.re | 1 + .../expected_output/attributes.rei | 2 + .../expected_output/basics.re | 1 + .../expected_output/basics_no_semi.re | 1 + .../expected_output/bigarraySyntax.re | 1 + .../expected_output/comments.re | 2 + .../expected_output/comments.rei | 2 + .../expected_output/comments.rei.4.07.0 | 2 + .../expected_output/comments.rei.4.07.1 | 2 + .../expected_output/comments.rei.4.08.0 | 2 + .../expected_output/comments.rei.4.09.0 | 2 + .../expected_output/features406.4.06.0.re | 1 + .../expected_output/features408.4.08.0.re | 1 + .../expected_output/features408.4.08.0.rei | 1 + .../expected_output/imperative.re | 1 + .../typeCheckedTests/expected_output/jsx.re | 1 + .../expected_output/knownMlIssues.re | 1 + .../expected_output/knownReIssues.re | 1 + .../typeCheckedTests/expected_output/lazy.re | 1 + .../typeCheckedTests/expected_output/letop.re | 1 + .../expected_output/mlSyntax.re | 1 + .../expected_output/mlVariants.re | 1 + .../expected_output/mlVariants.re.4.06.1 | 1 + .../expected_output/mlVariants.re.4.07.1 | 1 + .../expected_output/mlVariants.re.4.08.0 | 1 + .../expected_output/mlVariants.re.4.09.0 | 1 + .../expected_output/mutation.re | 1 + .../expected_output/newAST.4.06.0.re | 1 + .../typeCheckedTests/expected_output/oo.re | 1 + .../expected_output/oo_3_dot_8.re | 435 +++++++++++++ .../expected_output/patternMatching.re | 1 + .../expected_output/pervasive.rei | 1 + .../expected_output/pipeFirst.re | 1 + .../expected_output/reasonComments.re | 1 + .../expected_output/reasonComments.rei | 1 + .../expected_output/sequences.re | 1 + .../specificMLSyntax.4.04.0.re | 1 + .../expected_output/trailing.re | 2 + .../expected_output/typeParameters.re | 3 +- .../expected_output/typeParameters_3_dot_8.re | 88 +++ .../typeCheckedTests/input/oo_3_dot_8.re | 435 +++++++++++++ .../typeCheckedTests/input/typeParameters.re | 1 + .../input/typeParameters_3_dot_8.re | 81 +++ .../unit_tests/expected_output/assert.re | 1 + .../expected_output/basicStructures.re | 1 + .../unit_tests/expected_output/bigarray.re | 1 + .../expected_output/bucklescript.re | 1 + .../unit_tests/expected_output/class_types.re | 3 +- .../expected_output/class_types_3_dot_8.re | 42 ++ .../expected_output/emptyFileComment.re | 1 + .../expected_output/escapesInStrings.re | 1 + .../unit_tests/expected_output/extensions.re | 2 + .../unit_tests/expected_output/externals.re | 1 + .../unit_tests/expected_output/features403.re | 1 + .../expected_output/firstClassModules.re | 1 + .../unit_tests/expected_output/fixme.re | 1 + .../expected_output/functionInfix.re | 1 + formatTest/unit_tests/expected_output/if.re | 1 + .../unit_tests/expected_output/infix.re | 1 + formatTest/unit_tests/expected_output/jsx.re | 1 + .../unit_tests/expected_output/jsx_functor.re | 1 + .../expected_output/lineComments.re | 1 + .../unit_tests/expected_output/modules.re | 1 + .../expected_output/modules_no_semi.re | 1 + .../unit_tests/expected_output/object.re | 1 + .../expected_output/ocaml_identifiers.re | 1 + .../unit_tests/expected_output/pexpFun.re | 1 + .../unit_tests/expected_output/pipeFirst.re | 1 + .../expected_output/polymorphism.re | 1 + .../unit_tests/expected_output/sharpop.re | 1 + .../expected_output/singleLineCommentEof.re | 1 + .../unit_tests/expected_output/syntax.re | 1 + .../unit_tests/expected_output/syntax.rei | 1 + .../unit_tests/expected_output/testUtils.re | 1 + .../unit_tests/expected_output/trailing.re | 2 + .../expected_output/trailingSpaces.re | 1 + .../expected_output/typeDeclarations.re | 1 + .../unit_tests/expected_output/uncurried.re | 1 + .../unit_tests/expected_output/variants.re | 1 + .../unit_tests/expected_output/whitespace.re | 1 + .../unit_tests/expected_output/whitespace.rei | 1 + .../expected_output/wrappingTest.re | 1 + .../expected_output/wrappingTest.rei | 1 + .../unit_tests/input/class_types_3_dot_8.re | 41 ++ src/reason-parser/dune | 2 +- src/reason-parser/reason_attributes.ml | 17 +- .../reason_declarative_lexer.mll | 15 + src/reason-parser/reason_parser.mly | 132 ++-- src/reason-parser/reason_pprint_ast.ml | 91 ++- src/reason-parser/reason_single_parser.ml | 18 +- src/reason-version/dune | 6 + src/reason-version/reason_version.ml | 192 ++++++ src/redoc/redoc_html.ml | 590 ------------------ src/refmt/dune | 2 +- src/refmt/refmt_impl.ml | 3 +- 98 files changed, 1630 insertions(+), 678 deletions(-) create mode 100644 formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re create mode 100644 formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re create mode 100644 formatTest/typeCheckedTests/input/oo_3_dot_8.re create mode 100644 formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re create mode 100644 formatTest/unit_tests/expected_output/class_types_3_dot_8.re create mode 100644 formatTest/unit_tests/input/class_types_3_dot_8.re create mode 100644 src/reason-version/dune create mode 100644 src/reason-version/reason_version.ml delete mode 100644 src/redoc/redoc_html.ml diff --git a/docs/RELEASING.md b/docs/RELEASING.md index a0913e1c4..7227b558f 100644 --- a/docs/RELEASING.md +++ b/docs/RELEASING.md @@ -16,14 +16,32 @@ and `rtop.json` respectively in the repo root, you would run that script after committing/bumping some versions: +**IMPORTANT: Update The Version Numbers In Packages:** +1. Make sure the version number in `esy.json` and `reason.json` is the new + version number for the release. +2. Make sure the file + [../../src/reason-version/reason_version.ml](../../src/reason-version/reason_version.ml) + also has that same version number that `refmt` has: + ```sh git checkout -b MYRELEASE origin/master git rebase origin/master -vim -O esy.json reason.json -# Then edit the version number accordingly on BOTH files. With that same VERSION do: -version=3.5.0 make pre_release +vim -O esy.json reason.json src/reason-version/reason_version.ml + +# Edit version field in jsons, and make sure reason_version has the new version +# let package_version = { +# major = 3; +# minor = 7; +# patch = 0; +# } + git commit -m "Bump version" git push origin HEAD:PullRequestForVersion # Commit these version bumps + +``` + +**Perform The Release:** +```sh node ./scripts/esy-prepublish.js ./reason.json ./rtop.json # Then publish. For example: diff --git a/formatTest/typeCheckedTests/expected_output/arityConversion.re b/formatTest/typeCheckedTests/expected_output/arityConversion.re index a725636be..737d0e6b8 100644 --- a/formatTest/typeCheckedTests/expected_output/arityConversion.re +++ b/formatTest/typeCheckedTests/expected_output/arityConversion.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; Some((1, 2, 3)); type bcd = diff --git a/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re b/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re index 26a69c9e2..c09b4d70b 100644 --- a/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re +++ b/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Pexp_letexception with attributes */ let () = { [@attribute] diff --git a/formatTest/typeCheckedTests/expected_output/attributes.re b/formatTest/typeCheckedTests/expected_output/attributes.re index 8324c5664..4b4448366 100644 --- a/formatTest/typeCheckedTests/expected_output/attributes.re +++ b/formatTest/typeCheckedTests/expected_output/attributes.re @@ -7,6 +7,7 @@ * This has a nice side effect when printing the terms: * If a node has attributes attached to it, */; +[@reason.version 3.7]; /**Floating comment text should be removed*/; diff --git a/formatTest/typeCheckedTests/expected_output/attributes.rei b/formatTest/typeCheckedTests/expected_output/attributes.rei index 4c6556400..51faaf1ee 100644 --- a/formatTest/typeCheckedTests/expected_output/attributes.rei +++ b/formatTest/typeCheckedTests/expected_output/attributes.rei @@ -1,6 +1,8 @@ /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /**Floating comment text should be removed*/; +[@reason.version 3.7]; + let test: int; /** diff --git a/formatTest/typeCheckedTests/expected_output/basics.re b/formatTest/typeCheckedTests/expected_output/basics.re index 0622c6f59..7619a0bf5 100644 --- a/formatTest/typeCheckedTests/expected_output/basics.re +++ b/formatTest/typeCheckedTests/expected_output/basics.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let l = diff --git a/formatTest/typeCheckedTests/expected_output/basics_no_semi.re b/formatTest/typeCheckedTests/expected_output/basics_no_semi.re index 31c651ee8..1f512e147 100644 --- a/formatTest/typeCheckedTests/expected_output/basics_no_semi.re +++ b/formatTest/typeCheckedTests/expected_output/basics_no_semi.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let l = diff --git a/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re b/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re index 3d47fa0a4..b00a5c1a7 100644 --- a/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re +++ b/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* https://github.com/facebook/reason/issues/2038 */ let my_big_array1 = Bigarray.Array1.create( diff --git a/formatTest/typeCheckedTests/expected_output/comments.re b/formatTest/typeCheckedTests/expected_output/comments.re index ace4ee3f0..9bee88955 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.re +++ b/formatTest/typeCheckedTests/expected_output/comments.re @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei b/formatTest/typeCheckedTests/expected_output/comments.rei index c6f7d5851..a5ec2cc99 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei +++ b/formatTest/typeCheckedTests/expected_output/comments.rei @@ -8,6 +8,8 @@ /***** comment */ /** */; +[@reason.version 3.7]; + /*** */ /**** */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re b/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re index 1ef225e53..30250f86a 100644 --- a/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re +++ b/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module EM = { /** Exception */ diff --git a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re index e1a9631b7..edb27b855 100644 --- a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re +++ b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; open { type t = string; }; diff --git a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei index ae50e8341..8729f7e2f 100644 --- a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei +++ b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module X: {type t;}; module M := X; diff --git a/formatTest/typeCheckedTests/expected_output/imperative.re b/formatTest/typeCheckedTests/expected_output/imperative.re index cee9f989d..8d3481e99 100644 --- a/formatTest/typeCheckedTests/expected_output/imperative.re +++ b/formatTest/typeCheckedTests/expected_output/imperative.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* diff --git a/formatTest/typeCheckedTests/expected_output/jsx.re b/formatTest/typeCheckedTests/expected_output/jsx.re index 9a00b4d76..d42c8fe1a 100644 --- a/formatTest/typeCheckedTests/expected_output/jsx.re +++ b/formatTest/typeCheckedTests/expected_output/jsx.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; type component = {displayName: string}; module Bar = { diff --git a/formatTest/typeCheckedTests/expected_output/knownMlIssues.re b/formatTest/typeCheckedTests/expected_output/knownMlIssues.re index b5c2a7af9..4d5a8ca96 100644 --- a/formatTest/typeCheckedTests/expected_output/knownMlIssues.re +++ b/formatTest/typeCheckedTests/expected_output/knownMlIssues.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* [x] fixed */ type t2 = (int, int); /* attributed to entire type not binding */ diff --git a/formatTest/typeCheckedTests/expected_output/knownReIssues.re b/formatTest/typeCheckedTests/expected_output/knownReIssues.re index 60e77946e..271e1b1d7 100644 --- a/formatTest/typeCheckedTests/expected_output/knownReIssues.re +++ b/formatTest/typeCheckedTests/expected_output/knownReIssues.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** Issue 940: https://github.com/facebook/reason/issues/940 The parens in the exception match case with an alias, diff --git a/formatTest/typeCheckedTests/expected_output/lazy.re b/formatTest/typeCheckedTests/expected_output/lazy.re index 6161ee0c6..5e8bf63be 100644 --- a/formatTest/typeCheckedTests/expected_output/lazy.re +++ b/formatTest/typeCheckedTests/expected_output/lazy.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let myComputation = lazy({ let tmp = 10; diff --git a/formatTest/typeCheckedTests/expected_output/letop.re b/formatTest/typeCheckedTests/expected_output/letop.re index fad703713..f72448f95 100644 --- a/formatTest/typeCheckedTests/expected_output/letop.re +++ b/formatTest/typeCheckedTests/expected_output/letop.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let (let.opt) = (x, f) => switch (x) { | None => None diff --git a/formatTest/typeCheckedTests/expected_output/mlSyntax.re b/formatTest/typeCheckedTests/expected_output/mlSyntax.re index 084c07817..98290479c 100644 --- a/formatTest/typeCheckedTests/expected_output/mlSyntax.re +++ b/formatTest/typeCheckedTests/expected_output/mlSyntax.re @@ -3,6 +3,7 @@ /** * Testing pattern matching using ml syntax to exercise nesting of cases. */; +[@reason.version 3.7]; type xyz = | X diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re b/formatTest/typeCheckedTests/expected_output/mlVariants.re index dba6c3c78..837068a8f 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mutation.re b/formatTest/typeCheckedTests/expected_output/mutation.re index e31b0a060..2b4031994 100644 --- a/formatTest/typeCheckedTests/expected_output/mutation.re +++ b/formatTest/typeCheckedTests/expected_output/mutation.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /** diff --git a/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re b/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re index 6d767e348..33485d798 100644 --- a/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re +++ b/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Oinherit (https://github.com/ocaml/ocaml/pull/1118) */ type t = {. a: string}; diff --git a/formatTest/typeCheckedTests/expected_output/oo.re b/formatTest/typeCheckedTests/expected_output/oo.re index 886c49bf2..f85f5f1d9 100644 --- a/formatTest/typeCheckedTests/expected_output/oo.re +++ b/formatTest/typeCheckedTests/expected_output/oo.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ class virtual stack ('a) (init) = { diff --git a/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re b/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re new file mode 100644 index 000000000..4c8d3be15 --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re @@ -0,0 +1,435 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class virtual stack <'a> (init) = { + /* + * The "as this" is implicit and will be formatted away. + */ + val virtual dummy: unit; + val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; + pub explicitOverrideTest = a => { + a + 1; + }; + pri explicitOverrideTest2 = a => { + a + 1; + }; +}; + +let tmp = { + /** + * comment here. + */; + val x = 10 +}; + +/** + * Comment on stackWithAttributes. + */ +[@thisShouldntBeFormattedAway] +class virtual stackWithAttributes <'a> (init) = { + /* Before class */ + /* The "as this" should not be formatted away because attributes. */ + as [@thisShouldntBeFormattedAway] this; + /* Before floatting attribute */ + [@floatingAttribute]; + /* Virtual member */ + [@itemAttr1] val virtual dummy: unit; + [@itemAttr2] val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; +}; + +class extendedStack <'a> (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => i; +}; + +class extendedStackAcknowledgeOverride + <'a> + (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => { + i + 1; + }; + pub! explicitOverrideTest = a => { + a + 2; + }; + pri! explicitOverrideTest2 = a => { + a + 2; + }; +}; + +let inst = (new extendedStack)([1, 2]); + +/** + * Recursive classes. + */ +/* + * First recursive class. + */ +class firstRecursiveClass (init) = { + val v = init; +} +/* + * Second recursive class. + */ +and secondRecursiveClass (init) = { + val v = init; +}; + +/** + * For now, mostly for historic reasons, the syntax for type + * definitions/annotations on anonymous objects are different than + * "class_instance_type". That needn't be the case. The only challenge is that + * whatever we do, there is a slight challenge in avoiding conflicts with + * records. Clearly {x:int, y:int} will conflict. However, open object types in + * the form of {.. x:int, y:int} do not conflict. The only thing that must be + * resolved is closed object types and records. you could have a special token + * that means "closed". {. x: int, y:int}. If only closed object types would be + * optimized in the same way that records are, records could just be replaced + * with closed object types. + */ +/** + * Anonymous objects. + */ + +type closedObj = {.}; + +let (<..>) = (a, b) => a + b; +let five = 2 <..> 3; + +type nestedObj = {. bar: {. a: int}}; + +let (>>) = (a, b) => a > b; + +let bigger = 3 >> 2; + +type typeDefForClosedObj = { + . + x: int, + y: int, +}; +type typeDefForOpenObj<'a> = + { + .. + x: int, + y: int, + } as 'a; +let anonClosedObject: { + . + x: int, + y: int, +} = { + pub x = { + 0; + }; + pub y = { + 0; + } +}; + +let onlyHasX = {pub x = 0}; +let xs: list({. x: int}) = [ + onlyHasX, + (anonClosedObject :> {. x: int}), +]; + +let constrainedAndCoerced = ( + [anonClosedObject, anonClosedObject]: + list({ + . + x: int, + y: int, + }) :> + list({. x: int}) +); + +/* If one day, unparenthesized type constraints are allowed on the RHS of a + * record value, we're going to have to be careful here because >} is parsed as + * a separate kind of token (for now). Any issues would likely be caught in the + * idempotent test case. + */ +let xs: ref({. x: int}) = { + contents: (anonClosedObject :> {. x: int}), +}; + +let coercedReturn = { + let tmp = anonClosedObject; + (tmp :> {. x: int}); +}; + +let acceptsOpenAnonObjAsArg = + ( + o: { + .. + x: int, + y: int, + }, + ) => + o#x + o#y; +let acceptsClosedAnonObjAsArg = + ( + o: { + . + x: int, + y: int, + }, + ) => + o#x + o#y; +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10; + pub z = 10 + }); + +let res = + acceptsClosedAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +/* TODO: Unify class constructor return values with function return values */ +class myClassWithAnnotatedReturnType + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; +/** + * May include a trailing semi after type row. + */ +class myClassWithAnnotatedReturnType2 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; + +/** + * May use equals sign, and may include colon if so. + */ +class myClassWithAnnotatedReturnType3 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y: int = init; +}; + +/** + * The one difference between class_constructor_types and expression + * constraints, is that we have to include the prefix word "new" before the + * final component of any arrow. This isn't required when annotating just the + * return value with ": foo ". + * This is only to temporarily work around a parsing conflict. (Can't tell if + * in the final arrow component it should begin parsing a non_arrowed_core_type + * or a class_instance_type). A better solution, would be to include + * class_instance_type as *part* of core_type, but then fail when it is + * observed in the non-last arrow position, or if a non_arrowed_core_type + * appears in the last arrow position. + * + * class_instance_type wouldn't always fail if parsed as any "core type" + * everywhere else in the grammar. + * + * Once nuance to that would be making a parse rule for "type application", and + * deferring whether or not that becomes a Pcty_constr or a Ptyp_constr. (The + * same for type identifiers and extensions.) + */ +class myClassWithAnnotatedReturnType3_annotated_constructor: + (int) => + { + pub x: int; + pub y: int; + } = + fun (init) => { + pub x: int = init; + pub y: int = init; + }; + +class tupleClass <'a, 'b> (init: ('a, 'b)) = { + pub pr = init; +}; + +module HasTupleClasses: { + /** + * exportedClass. + */ + class exportedClass: + (int) => + { + pub x: int; + pub y: int; + }; + /** + * anotherExportedClass. + */ + class anotherExportedClass <'a, 'b>: + (('a, 'b)) => + { + pub pr: ('a, 'b); + }; +} = { + /** + * exportedClass. + */ + class exportedClass = + class myClassWithAnnotatedReturnType3; + + /** + * anotherExportedClass. + */ + class anotherExportedClass <'a, 'b> = + class tupleClass<'a, 'b>; +}; + +class intTuples = class tupleClass; + +class intTuplesHardcoded = + (class tupleClass)((8, 8)); + +/** + * Note that the inner tupleClass doesn't have the "class" prefix because + * they're not kinds of classes - they're types of *values*. + * The parens here shouldn't be required. + */ +class intTuplesTuples = + class tupleClass< + tupleClass, + tupleClass, + >; + +let x: tupleClass = { + pub pr = (10, 10) +}; + +let x: #tupleClass = x; + +let incrementMyClassInstance: + (int, #tupleClass) => + #tupleClass = + (i, inst) => { + let (x, y) = inst#pr; + {pub pr = (x + i, y + i)}; + }; + +class myClassWithNoTypeParams = {}; +/** + * The #myClassWithNoTypeParams should be treated as "simple" + */ +type optionalMyClassSubtype<'a> = + option<#myClassWithNoTypeParams> as 'a; + +/** + * Remember, "class type" is really "class_instance_type" (which is the type of + * what is returned from the constructor). + * + * And when defining a class: + * + * addablePoint is the "class instance type" type generated in scope which is + * the closed object type of the return value of the constructor. + * + * #addablePoint is the extensible form of addablePoint (anything that + * adheres to the "interface.") + */ +class type addablePointClassType = { + pub x: int; + pub y: int; + pub add: + ( + addablePointClassType, + addablePointClassType + ) => + int; +}; + +/** + * Class constructor types can be annotated. + */ +class addablePoint: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +class addablePoint2: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +module type T = { + class virtual cl <'a>: {} + and cl2: {}; +}; + +let privacy = {pri x = c => 5 + c}; + +module Js = { + type t<'a>; +}; + +/* supports trailing comma */ +type stream<'a> = { + . + "observer": ('a => unit) => unit, +}; diff --git a/formatTest/typeCheckedTests/expected_output/patternMatching.re b/formatTest/typeCheckedTests/expected_output/patternMatching.re index f8239ba58..0ae355ad5 100644 --- a/formatTest/typeCheckedTests/expected_output/patternMatching.re +++ b/formatTest/typeCheckedTests/expected_output/patternMatching.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; type point = { x: int, y: int, diff --git a/formatTest/typeCheckedTests/expected_output/pervasive.rei b/formatTest/typeCheckedTests/expected_output/pervasive.rei index 35ff3d668..f34824fe5 100644 --- a/formatTest/typeCheckedTests/expected_output/pervasive.rei +++ b/formatTest/typeCheckedTests/expected_output/pervasive.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let (==): ('a, 'a) => bool; let (!=): ('a, 'a) => bool; diff --git a/formatTest/typeCheckedTests/expected_output/pipeFirst.re b/formatTest/typeCheckedTests/expected_output/pipeFirst.re index b06c18017..eb9295275 100644 --- a/formatTest/typeCheckedTests/expected_output/pipeFirst.re +++ b/formatTest/typeCheckedTests/expected_output/pipeFirst.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let (|.) = (x, y) => x + y; let a = 1; diff --git a/formatTest/typeCheckedTests/expected_output/reasonComments.re b/formatTest/typeCheckedTests/expected_output/reasonComments.re index 63b87d939..51228000c 100644 --- a/formatTest/typeCheckedTests/expected_output/reasonComments.re +++ b/formatTest/typeCheckedTests/expected_output/reasonComments.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; 3; /* - */ 3; /*-*/ diff --git a/formatTest/typeCheckedTests/expected_output/reasonComments.rei b/formatTest/typeCheckedTests/expected_output/reasonComments.rei index 86518f5a5..15c0a9377 100644 --- a/formatTest/typeCheckedTests/expected_output/reasonComments.rei +++ b/formatTest/typeCheckedTests/expected_output/reasonComments.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module JustString: { include Map.S; /* Comment eol include */ }; diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 72b5ad545..5ec8538a8 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /** diff --git a/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re b/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re index 6cc7f92c8..28843fc62 100644 --- a/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re +++ b/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module Foo = { type t = {name: string}; }; diff --git a/formatTest/typeCheckedTests/expected_output/trailing.re b/formatTest/typeCheckedTests/expected_output/trailing.re index 67833739a..ac03cf8f6 100644 --- a/formatTest/typeCheckedTests/expected_output/trailing.re +++ b/formatTest/typeCheckedTests/expected_output/trailing.re @@ -1,3 +1,5 @@ +[@reason.version 3.7]; + let x = 0; let y = 0; diff --git a/formatTest/typeCheckedTests/expected_output/typeParameters.re b/formatTest/typeCheckedTests/expected_output/typeParameters.re index 3d97c06da..1af0200a4 100644 --- a/formatTest/typeCheckedTests/expected_output/typeParameters.re +++ b/formatTest/typeCheckedTests/expected_output/typeParameters.re @@ -1,6 +1,7 @@ /** * Testing type parameters. - */ + */; +[@reason.version 3.7]; type threeThings('t) = ('t, 't, 't); type listOf('t) = list('t); diff --git a/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re b/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re new file mode 100644 index 000000000..c3bc2a35c --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re @@ -0,0 +1,88 @@ +/** + * Testing type parameters. + */; +[@reason.version 3.8]; + +type threeThings<'t> = ('t, 't, 't); +type listOf<'t> = list<'t>; + +type underscoreParam<_> = + | Underscored; +type underscoreParamCovariance<+_> = + | Underscored; +type underscoreParamContravariance<-_> = + | Underscored; + +type tickParamCovariance<+'a> = + | Underscored; +type tickParamContravariance<-'a> = + | Underscored; + +let x: option> = None; +type myFunctionType<'a> = ( + list<('a, 'a)>, + int => option>, +); +let funcAnnoted = (~a: list=[0, 1], ()) => a; + +/** + * Syntax that would be likely to conflict with lexing parsing of < > syntax. + */ + +let zero = 0; +let isGreaterThanNegFive = zero > (-5); +let isGreaterThanNegFive2 = zero > (-5); +let isGreaterThanNegFive3 = zero > (-5); + +let isGreaterThanEqNegFive = zero >= (-5); +let isGreaterThanEqNegFive2 = zero >= (-5); +let isGreaterThanEqNegFive3 = zero >= (-5); + +let (>>=) = (a, b) => a >= b; + +let isSuperGreaterThanEqNegFive = zero >>= (-5); +let isSuperGreaterThanEqNegFive2 = zero >>= (-5); +let isSuperGreaterThanEqNegFive3 = zero >>= (-5); + +let jsx = (~children, ()) => 0; + +type t<'a> = 'a; +let optionArg = (~arg: option>=?, ()) => arg; +let optionArgList = + (~arg: option>>=?, ()) => arg; +let defaultJsxArg = (~arg: t=, ()) => arg; +let defaultFalse = (~arg: t=!true, ()) => arg; +/* Doesn't work on master either let defaultTrue = (~arg:t= !!true) => arg; */ + +/** + * Things likely to conflict or impact precedence. + */ +let neg = (-1); +let tru = !false; +let x = + "arbitrary" === "example" + && "how long" >= "can you get" + && "seriously" <= "what is the line length"; + +let z = 0; +module Conss = { + let (>-) = (a, b) => a + b; + let four = 3 >- 1; + let two = 3 >- (-1); + let four' = 3 >- 1; + + let tr = 3 > (-1); + let tr' = 3 > 1; + let tr'' = 3 > (-1); +}; + +module Idents = { + let (>-) = (a, b) => a + b; + let four = z >- z; + let two = z >- - z; + let four' = z >- - (- z); + + let tr = z > - z; + let tr' = z > - (- z); + let tr'' = z > - (- (- z)); +}; diff --git a/formatTest/typeCheckedTests/input/oo_3_dot_8.re b/formatTest/typeCheckedTests/input/oo_3_dot_8.re new file mode 100644 index 000000000..1f036b5e2 --- /dev/null +++ b/formatTest/typeCheckedTests/input/oo_3_dot_8.re @@ -0,0 +1,435 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class virtual stack('a) (init) = { + /* + * The "as this" is implicit and will be formatted away. + */ + val virtual dummy: unit; + val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; + pub explicitOverrideTest = a => { + a + 1; + }; + pri explicitOverrideTest2 = a => { + a + 1; + }; +}; + +let tmp = { + /** + * comment here. + */; + val x = 10 +}; + +/** + * Comment on stackWithAttributes. + */ +[@thisShouldntBeFormattedAway] +class virtual stackWithAttributes ('a) (init) = { + /* Before class */ + /* The "as this" should not be formatted away because attributes. */ + as [@thisShouldntBeFormattedAway] this; + /* Before floatting attribute */ + [@floatingAttribute]; + /* Virtual member */ + [@itemAttr1] val virtual dummy: unit; + [@itemAttr2] val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; +}; + +class extendedStack ('a) (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => i; +}; + +class extendedStackAcknowledgeOverride + ('a) + (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => { + i + 1; + }; + pub! explicitOverrideTest = a => { + a + 2; + }; + pri! explicitOverrideTest2 = a => { + a + 2; + }; +}; + +let inst = (new extendedStack)([1, 2]); + +/** + * Recursive classes. + */ +/* + * First recursive class. + */ +class firstRecursiveClass (init) = { + val v = init; +} +/* + * Second recursive class. + */ +and secondRecursiveClass (init) = { + val v = init; +}; + +/** + * For now, mostly for historic reasons, the syntax for type + * definitions/annotations on anonymous objects are different than + * "class_instance_type". That needn't be the case. The only challenge is that + * whatever we do, there is a slight challenge in avoiding conflicts with + * records. Clearly {x:int, y:int} will conflict. However, open object types in + * the form of {.. x:int, y:int} do not conflict. The only thing that must be + * resolved is closed object types and records. you could have a special token + * that means "closed". {. x: int, y:int}. If only closed object types would be + * optimized in the same way that records are, records could just be replaced + * with closed object types. + */ +/** + * Anonymous objects. + */ + +type closedObj = {.}; + +let (<..>) = (a, b) => a + b; +let five = 2 <..> 3; + +type nestedObj = {. bar: {. a: int}}; + +let (>>) = (a, b) => a > b; + +let bigger = 3 >> 2; + +type typeDefForClosedObj = { + . + x: int, + y: int, +}; +type typeDefForOpenObj<'a> = + { + .. + x: int, + y: int, + } as 'a; +let anonClosedObject: { + . + x: int, + y: int, +} = { + pub x = { + 0; + }; + pub y = { + 0; + } +}; + +let onlyHasX = {pub x = 0}; +let xs: list({. x: int}) = [ + onlyHasX, + (anonClosedObject :> {. x: int}), +]; + +let constrainedAndCoerced = ( + [anonClosedObject, anonClosedObject]: + list({ + . + x: int, + y: int, + }) :> + list({. x: int}) +); + +/* If one day, unparenthesized type constraints are allowed on the RHS of a + * record value, we're going to have to be careful here because >} is parsed as + * a separate kind of token (for now). Any issues would likely be caught in the + * idempotent test case. + */ +let xs: ref({. x: int}) = { + contents: (anonClosedObject :> {. x: int}), +}; + +let coercedReturn = { + let tmp = anonClosedObject; + (tmp :> {. x: int}); +}; + +let acceptsOpenAnonObjAsArg = + ( + o: { + .. + x: int, + y: int, + }, + ) => + o#x + o#y; +let acceptsClosedAnonObjAsArg = + ( + o: { + . + x: int, + y: int, + }, + ) => + o#x + o#y; +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10; + pub z = 10 + }); + +let res = + acceptsClosedAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +/* TODO: Unify class constructor return values with function return values */ +class myClassWithAnnotatedReturnType + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; +/** + * May include a trailing semi after type row. + */ +class myClassWithAnnotatedReturnType2 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; + +/** + * May use equals sign, and may include colon if so. + */ +class myClassWithAnnotatedReturnType3 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y: int = init; +}; + +/** + * The one difference between class_constructor_types and expression + * constraints, is that we have to include the prefix word "new" before the + * final component of any arrow. This isn't required when annotating just the + * return value with ": foo ". + * This is only to temporarily work around a parsing conflict. (Can't tell if + * in the final arrow component it should begin parsing a non_arrowed_core_type + * or a class_instance_type). A better solution, would be to include + * class_instance_type as *part* of core_type, but then fail when it is + * observed in the non-last arrow position, or if a non_arrowed_core_type + * appears in the last arrow position. + * + * class_instance_type wouldn't always fail if parsed as any "core type" + * everywhere else in the grammar. + * + * Once nuance to that would be making a parse rule for "type application", and + * deferring whether or not that becomes a Pcty_constr or a Ptyp_constr. (The + * same for type identifiers and extensions.) + */ +class myClassWithAnnotatedReturnType3_annotated_constructor: + (int) => + { + pub x: int; + pub y: int; + } = + fun (init) => { + pub x: int = init; + pub y: int = init; + }; + +class tupleClass ('a, 'b) (init: ('a, 'b)) = { + pub pr = init; +}; + +module HasTupleClasses: { + /** + * exportedClass. + */ + class exportedClass: + (int) => + { + pub x: int; + pub y: int; + }; + /** + * anotherExportedClass. + */ + class anotherExportedClass ('a, 'b): + (('a, 'b)) => + { + pub pr: ('a, 'b); + }; +} = { + /** + * exportedClass. + */ + class exportedClass = + class myClassWithAnnotatedReturnType3; + + /** + * anotherExportedClass. + */ + class anotherExportedClass ('a, 'b) = + class tupleClass<'a, 'b>; +}; + +class intTuples = class tupleClass; + +class intTuplesHardcoded = + (class tupleClass)((8, 8)); + +/** + * Note that the inner tupleClass doesn't have the "class" prefix because + * they're not kinds of classes - they're types of *values*. + * The parens here shouldn't be required. + */ +class intTuplesTuples = + class tupleClass< + tupleClass, + tupleClass, + >; + +let x: tupleClass = { + pub pr = (10, 10) +}; + +let x: #tupleClass = x; + +let incrementMyClassInstance: + (int, #tupleClass) => + #tupleClass = + (i, inst) => { + let (x, y) = inst#pr; + {pub pr = (x + i, y + i)}; + }; + +class myClassWithNoTypeParams = {}; +/** + * The #myClassWithNoTypeParams should be treated as "simple" + */ +type optionalMyClassSubtype<'a> = + option< #myClassWithNoTypeParams> as 'a; + +/** + * Remember, "class type" is really "class_instance_type" (which is the type of + * what is returned from the constructor). + * + * And when defining a class: + * + * addablePoint is the "class instance type" type generated in scope which is + * the closed object type of the return value of the constructor. + * + * #addablePoint is the extensible form of addablePoint (anything that + * adheres to the "interface.") + */ +class type addablePointClassType = { + pub x: int; + pub y: int; + pub add: + ( + addablePointClassType, + addablePointClassType + ) => + int; +}; + +/** + * Class constructor types can be annotated. + */ +class addablePoint: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +class addablePoint2: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +module type T = { + class virtual cl ('a): {} + and cl2: {}; +}; + +let privacy = {pri x = c => 5 + c}; + +module Js = { + type t<'a>; +}; + +/* supports trailing comma */ +type stream<'a> = { + . + "observer": ('a => unit) => unit, +}; diff --git a/formatTest/typeCheckedTests/input/typeParameters.re b/formatTest/typeCheckedTests/input/typeParameters.re index a4ca9c32c..08e084825 100644 --- a/formatTest/typeCheckedTests/input/typeParameters.re +++ b/formatTest/typeCheckedTests/input/typeParameters.re @@ -1,6 +1,7 @@ /** * Testing type parameters. */ +[@reason.version 3.7]; type threeThings<'t> = ('t, 't, 't); type listOf<'t> = list<'t>; diff --git a/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re b/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re new file mode 100644 index 000000000..c7d6710bf --- /dev/null +++ b/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re @@ -0,0 +1,81 @@ +/** + * Testing type parameters. + */ +[@reason.version 3.8]; + +type threeThings<'t> = ('t, 't, 't); +type listOf<'t> = list<'t>; + +type underscoreParam<_> = Underscored; +type underscoreParamCovariance<+_> = Underscored; +type underscoreParamContravariance<-_> = Underscored; + +type tickParamCovariance<+'a> = Underscored; +type tickParamContravariance<-'a> = Underscored; + +let x : option > = None; +type myFunctionType<'a> = (list<('a, 'a)>, int => option >); +let funcAnnoted = (~a: list=[0, 1, ], ()) => a; + + + +/** + * Syntax that would be likely to conflict with lexing parsing of < > syntax. + */ + +let zero = 0; +let isGreaterThanNegFive = zero > - 5; +let isGreaterThanNegFive2 = zero > -5; +let isGreaterThanNegFive3 = zero >(-5); + +let isGreaterThanEqNegFive = zero >= -5; +let isGreaterThanEqNegFive2 = zero >= -5; +let isGreaterThanEqNegFive3 = zero >=(-5); + +let (>>=) = (a, b) => a >= b; + +let isSuperGreaterThanEqNegFive = zero >>= - 5; +let isSuperGreaterThanEqNegFive2 = zero >>= -5; +let isSuperGreaterThanEqNegFive3 = zero >>= (-5); + +let jsx= (~children, ()) => 0; + +type t<'a> = 'a; +let optionArg = (~arg:option>=?, ()) => arg; +let optionArgList = (~arg:option>>=?, ()) => arg; +let defaultJsxArg = (~arg:t(int)=, ()) => arg; +let defaultFalse = (~arg:t=!true, ()) => arg; +/* Doesn't work on master either let defaultTrue = (~arg:t= !!true) => arg; */ + +/** + * Things likely to conflict or impact precedence. + */ +let neg=-1; +let tru=!false; +let x = + "arbitrary" === "example" + && "how long" >= "can you get" + && "seriously" <= "what is the line length"; + +let z = 0; +module Conss = { + let (>-) = (a, b) => a + b; + let four = 3 >- 1; + let two = 3 >- -1; + let four' = 3 >- - - 1; + + let tr = 3 > - 1; + let tr' = 3 > - -1; + let tr'' = 3 > - - - 1; +} + +module Idents = { + let (>-) = (a, b) => a + b; + let four = z >- z; + let two = z >- -z; + let four' = z >- - - z; + + let tr = z > - z; + let tr' = z > - -z; + let tr'' = z > - - - z; +} diff --git a/formatTest/unit_tests/expected_output/assert.re b/formatTest/unit_tests/expected_output/assert.re index 136ae43bb..b2e1fc5f8 100644 --- a/formatTest/unit_tests/expected_output/assert.re +++ b/formatTest/unit_tests/expected_output/assert.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; switch (true) { | true => () | false => assert(false) diff --git a/formatTest/unit_tests/expected_output/basicStructures.re b/formatTest/unit_tests/expected_output/basicStructures.re index abf0b0e0b..7b0e6b11e 100644 --- a/formatTest/unit_tests/expected_output/basicStructures.re +++ b/formatTest/unit_tests/expected_output/basicStructures.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/formatTest/unit_tests/expected_output/bigarray.re b/formatTest/unit_tests/expected_output/bigarray.re index 09526c339..761637a4e 100644 --- a/formatTest/unit_tests/expected_output/bigarray.re +++ b/formatTest/unit_tests/expected_output/bigarray.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; my_big_array3.{ reallyLongStringThatWillDefinitelyBreakLine }; diff --git a/formatTest/unit_tests/expected_output/bucklescript.re b/formatTest/unit_tests/expected_output/bucklescript.re index ac88e9821..7c1186569 100644 --- a/formatTest/unit_tests/expected_output/bucklescript.re +++ b/formatTest/unit_tests/expected_output/bucklescript.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; bla #= 10; bla #= Some(10); diff --git a/formatTest/unit_tests/expected_output/class_types.re b/formatTest/unit_tests/expected_output/class_types.re index 9d0ecdd8d..c43771745 100644 --- a/formatTest/unit_tests/expected_output/class_types.re +++ b/formatTest/unit_tests/expected_output/class_types.re @@ -1,4 +1,5 @@ -class type _module ('provider_impl) = {}; +[@reason.version 3.7]; +class type _module('provider_impl) = {}; type t; class type bzz = { inherit _module(t); diff --git a/formatTest/unit_tests/expected_output/class_types_3_dot_8.re b/formatTest/unit_tests/expected_output/class_types_3_dot_8.re new file mode 100644 index 000000000..11e7e9714 --- /dev/null +++ b/formatTest/unit_tests/expected_output/class_types_3_dot_8.re @@ -0,0 +1,42 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class type _module<'provider_impl> = {}; +type t; +class type bzz = { + inherit _module; +}; + +class type t = { + as 'a; + constraint 'a = #s; +}; + +/* https://github.com/facebook/reason/issues/2037 */ +class type xt = { + as 'a; +}; + +class x = { + as self; +}; + +class type classWithNoArgType = { + pub x: int; + pub y: int; +}; + +class classWithNoArg = { + pub x = 0; + pub y = 0; +}; + +class type t = { + open M; + as 'a; +}; + +class type t = { + open M; +}; diff --git a/formatTest/unit_tests/expected_output/emptyFileComment.re b/formatTest/unit_tests/expected_output/emptyFileComment.re index eb2b9c00d..39bd0f9c6 100644 --- a/formatTest/unit_tests/expected_output/emptyFileComment.re +++ b/formatTest/unit_tests/expected_output/emptyFileComment.re @@ -1 +1,2 @@ +[@reason.version 3.7]; // file with just a single line comment diff --git a/formatTest/unit_tests/expected_output/escapesInStrings.re b/formatTest/unit_tests/expected_output/escapesInStrings.re index 51e486fe1..f6efc72b8 100644 --- a/formatTest/unit_tests/expected_output/escapesInStrings.re +++ b/formatTest/unit_tests/expected_output/escapesInStrings.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* diff --git a/formatTest/unit_tests/expected_output/extensions.re b/formatTest/unit_tests/expected_output/extensions.re index fb702a472..4a032dd59 100644 --- a/formatTest/unit_tests/expected_output/extensions.re +++ b/formatTest/unit_tests/expected_output/extensions.re @@ -1,3 +1,5 @@ +[@reason.version 3.7]; + /* Extension sugar */ %extend diff --git a/formatTest/unit_tests/expected_output/externals.re b/formatTest/unit_tests/expected_output/externals.re index d02f97a8c..4ef85fbcd 100644 --- a/formatTest/unit_tests/expected_output/externals.re +++ b/formatTest/unit_tests/expected_output/externals.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** * Tests external formatting. */ diff --git a/formatTest/unit_tests/expected_output/features403.re b/formatTest/unit_tests/expected_output/features403.re index 871a32e7a..d438a5e1b 100644 --- a/formatTest/unit_tests/expected_output/features403.re +++ b/formatTest/unit_tests/expected_output/features403.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; type t = | A({a: int}) | B; diff --git a/formatTest/unit_tests/expected_output/firstClassModules.re b/formatTest/unit_tests/expected_output/firstClassModules.re index a5937d38e..eb2a37492 100644 --- a/formatTest/unit_tests/expected_output/firstClassModules.re +++ b/formatTest/unit_tests/expected_output/firstClassModules.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module Modifier = ( val Db.Hashtbl.create(): Db.Sig with type t = Mods.t diff --git a/formatTest/unit_tests/expected_output/fixme.re b/formatTest/unit_tests/expected_output/fixme.re index 40a98c766..00ad649c6 100644 --- a/formatTest/unit_tests/expected_output/fixme.re +++ b/formatTest/unit_tests/expected_output/fixme.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** * Problem: In thise example, the comment should have a space after it. */ diff --git a/formatTest/unit_tests/expected_output/functionInfix.re b/formatTest/unit_tests/expected_output/functionInfix.re index ee1576ec5..79db3cb23 100644 --- a/formatTest/unit_tests/expected_output/functionInfix.re +++ b/formatTest/unit_tests/expected_output/functionInfix.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let entries = ref([]); let all = ref(0); diff --git a/formatTest/unit_tests/expected_output/if.re b/formatTest/unit_tests/expected_output/if.re index c789dedb7..5ae25d29b 100644 --- a/formatTest/unit_tests/expected_output/if.re +++ b/formatTest/unit_tests/expected_output/if.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let logTSuccess = self => diff --git a/formatTest/unit_tests/expected_output/infix.re b/formatTest/unit_tests/expected_output/infix.re index e01057497..d3050d3a4 100644 --- a/formatTest/unit_tests/expected_output/infix.re +++ b/formatTest/unit_tests/expected_output/infix.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* - A good way to test if formatting of infix operators groups precedences diff --git a/formatTest/unit_tests/expected_output/jsx.re b/formatTest/unit_tests/expected_output/jsx.re index f1b49f5a1..0b67ee53c 100644 --- a/formatTest/unit_tests/expected_output/jsx.re +++ b/formatTest/unit_tests/expected_output/jsx.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let x = { diff --git a/formatTest/unit_tests/expected_output/modules_no_semi.re b/formatTest/unit_tests/expected_output/modules_no_semi.re index 432bf12fa..f238705c9 100644 --- a/formatTest/unit_tests/expected_output/modules_no_semi.re +++ b/formatTest/unit_tests/expected_output/modules_no_semi.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/formatTest/unit_tests/expected_output/object.re b/formatTest/unit_tests/expected_output/object.re index 38af64c49..af231efbb 100644 --- a/formatTest/unit_tests/expected_output/object.re +++ b/formatTest/unit_tests/expected_output/object.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type t = {.}; diff --git a/formatTest/unit_tests/expected_output/ocaml_identifiers.re b/formatTest/unit_tests/expected_output/ocaml_identifiers.re index 78b5ca0b1..f0acc8ca0 100644 --- a/formatTest/unit_tests/expected_output/ocaml_identifiers.re +++ b/formatTest/unit_tests/expected_output/ocaml_identifiers.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Type names (supported with PR#2342) */ module T = { type pub_ = unit; diff --git a/formatTest/unit_tests/expected_output/pexpFun.re b/formatTest/unit_tests/expected_output/pexpFun.re index 6c3091161..2cf134267 100644 --- a/formatTest/unit_tests/expected_output/pexpFun.re +++ b/formatTest/unit_tests/expected_output/pexpFun.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let x = switch (x) { | Bar => diff --git a/formatTest/unit_tests/expected_output/pipeFirst.re b/formatTest/unit_tests/expected_output/pipeFirst.re index f75535627..ccc812b5a 100644 --- a/formatTest/unit_tests/expected_output/pipeFirst.re +++ b/formatTest/unit_tests/expected_output/pipeFirst.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; foo->f->g->h; bar->f->g->h; diff --git a/formatTest/unit_tests/expected_output/polymorphism.re b/formatTest/unit_tests/expected_output/polymorphism.re index c14249c32..fcc5bf2ca 100644 --- a/formatTest/unit_tests/expected_output/polymorphism.re +++ b/formatTest/unit_tests/expected_output/polymorphism.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/formatTest/unit_tests/expected_output/sharpop.re b/formatTest/unit_tests/expected_output/sharpop.re index 2c17c48d8..58f64aeb1 100644 --- a/formatTest/unit_tests/expected_output/sharpop.re +++ b/formatTest/unit_tests/expected_output/sharpop.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; foo #= bar[0]; foo##bar[0] = 3; diff --git a/formatTest/unit_tests/expected_output/singleLineCommentEof.re b/formatTest/unit_tests/expected_output/singleLineCommentEof.re index 18f9b9683..6568d3029 100644 --- a/formatTest/unit_tests/expected_output/singleLineCommentEof.re +++ b/formatTest/unit_tests/expected_output/singleLineCommentEof.re @@ -1 +1,2 @@ +[@reason.version 3.7]; // let x = 1 diff --git a/formatTest/unit_tests/expected_output/syntax.re b/formatTest/unit_tests/expected_output/syntax.re index 13a8959d2..98e0aa20d 100644 --- a/formatTest/unit_tests/expected_output/syntax.re +++ b/formatTest/unit_tests/expected_output/syntax.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ [@autoFormat let wrap = 80; let shift = 2]; diff --git a/formatTest/unit_tests/expected_output/syntax.rei b/formatTest/unit_tests/expected_output/syntax.rei index 3cee43a36..7fe239ed0 100644 --- a/formatTest/unit_tests/expected_output/syntax.rei +++ b/formatTest/unit_tests/expected_output/syntax.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /** diff --git a/formatTest/unit_tests/expected_output/testUtils.re b/formatTest/unit_tests/expected_output/testUtils.re index f2773a018..b65e35e94 100644 --- a/formatTest/unit_tests/expected_output/testUtils.re +++ b/formatTest/unit_tests/expected_output/testUtils.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let printSection = s => { diff --git a/formatTest/unit_tests/expected_output/trailing.re b/formatTest/unit_tests/expected_output/trailing.re index 5b41105e7..e471bd8df 100644 --- a/formatTest/unit_tests/expected_output/trailing.re +++ b/formatTest/unit_tests/expected_output/trailing.re @@ -1,3 +1,5 @@ +[@reason.version 3.7]; + let x = {"obj": obj}; let x = {"key": key, "keyTwo": keyTwo}; diff --git a/formatTest/unit_tests/expected_output/trailingSpaces.re b/formatTest/unit_tests/expected_output/trailingSpaces.re index 2c0dc7a99..0ebfaf9b2 100644 --- a/formatTest/unit_tests/expected_output/trailingSpaces.re +++ b/formatTest/unit_tests/expected_output/trailingSpaces.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ module M = diff --git a/formatTest/unit_tests/expected_output/typeDeclarations.re b/formatTest/unit_tests/expected_output/typeDeclarations.re index 0d2299c4c..9fde26a9f 100644 --- a/formatTest/unit_tests/expected_output/typeDeclarations.re +++ b/formatTest/unit_tests/expected_output/typeDeclarations.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* === test wrapping for arrows === */ type foo = option(int => int); type foo = option((int, int) => int); diff --git a/formatTest/unit_tests/expected_output/uncurried.re b/formatTest/unit_tests/expected_output/uncurried.re index 160f3c565..bc7ee27e3 100644 --- a/formatTest/unit_tests/expected_output/uncurried.re +++ b/formatTest/unit_tests/expected_output/uncurried.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; f(.); [@attr] diff --git a/formatTest/unit_tests/expected_output/variants.re b/formatTest/unit_tests/expected_output/variants.re index fa61fd7e0..6211a1e1f 100644 --- a/formatTest/unit_tests/expected_output/variants.re +++ b/formatTest/unit_tests/expected_output/variants.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ module LocalModule = { diff --git a/formatTest/unit_tests/expected_output/whitespace.re b/formatTest/unit_tests/expected_output/whitespace.re index 4acfff66f..07f0231bc 100644 --- a/formatTest/unit_tests/expected_output/whitespace.re +++ b/formatTest/unit_tests/expected_output/whitespace.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module Test = { open Belt; open React; diff --git a/formatTest/unit_tests/expected_output/whitespace.rei b/formatTest/unit_tests/expected_output/whitespace.rei index 8cbda032c..507adb08b 100644 --- a/formatTest/unit_tests/expected_output/whitespace.rei +++ b/formatTest/unit_tests/expected_output/whitespace.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** Interleave whitespace intelligently in signatures */ /* a */ diff --git a/formatTest/unit_tests/expected_output/wrappingTest.re b/formatTest/unit_tests/expected_output/wrappingTest.re index 3259658c7..2fe642ff6 100644 --- a/formatTest/unit_tests/expected_output/wrappingTest.re +++ b/formatTest/unit_tests/expected_output/wrappingTest.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* Run the formatting pretty printer with width 50 */ diff --git a/formatTest/unit_tests/expected_output/wrappingTest.rei b/formatTest/unit_tests/expected_output/wrappingTest.rei index b8b2a8132..56d76e27d 100644 --- a/formatTest/unit_tests/expected_output/wrappingTest.rei +++ b/formatTest/unit_tests/expected_output/wrappingTest.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let named: (~a: int, ~b: int) => int; diff --git a/formatTest/unit_tests/input/class_types_3_dot_8.re b/formatTest/unit_tests/input/class_types_3_dot_8.re new file mode 100644 index 000000000..50382cf3a --- /dev/null +++ b/formatTest/unit_tests/input/class_types_3_dot_8.re @@ -0,0 +1,41 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class type _module ('provider_impl) = { + +}; +type t; +class type bzz = { + inherit _module(t) +}; + +class type t = { as 'a; + constraint 'a = #s +}; + +/* https://github.com/facebook/reason/issues/2037 */ +class type xt = { as 'a }; + +class x = { + as self +}; + +class type classWithNoArgType { + pub x : int; + pub y : int +}; + +class classWithNoArg { + pub x = 0; + pub y = 0 +}; + +class type t = { + open M; + as 'a; +}; + +class type t = { + open M; +}; diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 0d9bbb27d..7f8d72aaa 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -97,4 +97,4 @@ reason_recover_parser reason_declarative_lexer reason_lexer reason_oprint reason_parser_explain_raw reason_parser_explain reason_parser_recover reason_string) - (libraries reason.ocaml-migrate-parsetree menhirLib reason.easy_format)) + (libraries reason.ocaml-migrate-parsetree menhirLib reason.easy_format reason.version)) diff --git a/src/reason-parser/reason_attributes.ml b/src/reason-parser/reason_attributes.ml index 99dba7589..5faa22323 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -13,6 +13,15 @@ type attributesPartition = { uncurried : bool } +let is_stylistic_attr = function + | { attr_name = {txt="reason.raw_literal"}; _} + (* Consider warnings to be "stylistic" attributes - attributes that do not + * affect printing *) + | { attr_name = {txt="ocaml.ppwarn"}; _} + | { attr_name = {txt="reason.preserve_braces"}; _} -> true + | _ -> false + + (** Partition attributes into kinds *) let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attributesPartition = match attrs with @@ -36,10 +45,7 @@ let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attrib | ({ attr_name = {txt="ocaml.doc" | "ocaml.text"}; _} as doc)::atTl when partDoc = true -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with docAttrs=doc::partition.docAttrs} - | ({ attr_name = {txt="reason.raw_literal"}; _} as attr) :: atTl -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with stylisticAttrs=attr::partition.stylisticAttrs} - | ({ attr_name = {txt="reason.preserve_braces"}; _} as attr) :: atTl -> + | attr :: atTl when is_stylistic_attr attr -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with stylisticAttrs=attr::partition.stylisticAttrs} | atHd :: atTl -> @@ -63,8 +69,7 @@ let extract_raw_literal attrs = let without_stylistic_attrs attrs = let rec loop acc = function - | attr :: rest when (partitionAttributes [attr]).stylisticAttrs != [] -> - loop acc rest + | attr :: rest when is_stylistic_attr attr -> loop acc rest | [] -> List.rev acc | attr :: rest -> loop (attr :: acc) rest in diff --git a/src/reason-parser/reason_declarative_lexer.mll b/src/reason-parser/reason_declarative_lexer.mll index 9da1f3108..e144191c7 100644 --- a/src/reason-parser/reason_declarative_lexer.mll +++ b/src/reason-parser/reason_declarative_lexer.mll @@ -451,6 +451,7 @@ rule token state = parse { SHARPEQUAL } | "#" operator_chars+ { SHARPOP (lexeme_operator lexbuf) } + (* File name / line number source mapping # n string\n *) | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']* ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")? [^ '\010' '\013'] * newline @@ -552,24 +553,38 @@ rule token state = parse } | "[|<" { set_lexeme_length lexbuf 2; + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) LBRACKETBAR } (* allow parsing of
*) | "/>
*) + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) set_lexeme_length lexbuf 2; SLASHGREATER } | "> *) + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) set_lexeme_length lexbuf 1; GREATER } | "><" uppercase_or_lowercase+ { (* allow parsing of
*) + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) set_lexeme_length lexbuf 1; GREATER } + | "[@reason.version " (['0'-'9']+ as major) '.' (['0'-'9']+ as minor) (('.' ['0'-'9']+)? as _patch) ']' { + (* Special case parsing of attribute so that we can special case its + * parsing. Parses x.y.z even though it is not valid syntax otherwise - + * just gracefully remove the last number. The parser will ignore this + * attribute when parsed, and instead record its presence, and then inject + * the attribute into the footer of the file. Then the printer will ensure + * it is formatted at the top of the file, ideally after the first file + * floating doc comment. *) + VERSION_ATTRIBUTE (int_of_string major, int_of_string minor) + } | "[@" { LBRACKETAT } | "[%" { LBRACKETPERCENT } | "[%%" { LBRACKETPERCENTPERCENT } diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index be040f13d..68d46bf55 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -846,6 +846,7 @@ let class_of_let_bindings lbs body = raise_error (Not_expecting (lbs.lbs_loc, "extension")) lbs.lbs_loc; Cl.let_ lbs.lbs_rec lbs.lbs_bindings body + (* * arity_conflict_resolving_mapper is triggered when both "implicit_arity" "explicit_arity" * are in the attribtues. In that case we have to remove "explicit_arity" @@ -1170,6 +1171,7 @@ let add_brace_attr expr = %token LIDENT [@recover.expr ""] [@recover.cost 2] %token LPAREN %token LBRACKETAT +%token VERSION_ATTRIBUTE %token OF %token PRI %token SWITCH @@ -1416,12 +1418,18 @@ conflicts. implementation: structure EOF - { apply_mapper_to_structure $1 reason_mapper } + { + let itms = Reason_version.Ast_nodes.inject_attr_from_version_impl $1 in + apply_mapper_to_structure itms reason_mapper + } ; interface: signature EOF - { apply_mapper_to_signature $1 reason_mapper } + { + let itms = Reason_version.Ast_nodes.inject_attr_from_version_intf $1 in + apply_mapper_to_signature itms reason_mapper + } ; toplevel_phrase: embedded @@ -1982,7 +1990,7 @@ and_class_declaration: ; class_declaration_details: - virtual_flag as_loc(LIDENT) ioption(class_type_parameters) + virtual_flag as_loc(LIDENT) optional_type_params(type_variable_without_underscore) ioption(labeled_pattern_list) class_declaration_body { let tree = match $4 with @@ -1990,7 +1998,7 @@ class_declaration_details: | Some (lpl, _uncurried) -> lpl in let body = List.fold_right mkclass_fun tree $5 in - let params = match $3 with None -> [] | Some x -> x in + let params = $3 in ($2, body, $1, params) } ; @@ -2299,14 +2307,10 @@ class_constructor_type: { List.fold_right mkcty_arrow $1 $3 } ; -class_type_arguments_comma_list: - | lseparated_nonempty_list(COMMA,core_type) COMMA? {$1} -; - class_instance_type: mark_position_cty ( as_loc(clty_longident) - loption(parenthesized(class_type_arguments_comma_list)) + loptioninline(type_parameters) { mkcty (Pcty_constr ($1, $2)) } | attribute class_instance_type (* Note that this will compound attributes - so they will become @@ -2405,16 +2409,8 @@ and_class_description: } ; -%inline class_type_parameter_comma_list: - | lseparated_nonempty_list(COMMA, type_parameter) COMMA? {$1} - -%inline class_type_parameters: - parenthesized(class_type_parameter_comma_list) - { $1 } -; - -class_description_details: - virtual_flag as_loc(LIDENT) loption(class_type_parameters) COLON class_constructor_type +%inline class_description_details: + virtual_flag as_loc(LIDENT) optional_type_params(type_variable_without_underscore) COLON class_constructor_type { ($2, $5, $1, $3) } ; @@ -2435,8 +2431,8 @@ and_class_type_declaration: } ; -class_type_declaration_details: - virtual_flag as_loc(LIDENT) loption(class_type_parameters) +%inline class_type_declaration_details: + virtual_flag as_loc(LIDENT) optional_type_params(type_variable_with_variance) either(preceded(EQUAL,class_instance_type), class_type_body) { ($2, $4, $1, $3) } ; @@ -3936,13 +3932,13 @@ and_type_declaration: } ; -type_declaration_details: - | as_loc(UIDENT) type_variables_with_variance type_declaration_kind +%inline type_declaration_details: + | as_loc(UIDENT) optional_type_params(type_variable_with_variance) type_declaration_kind { syntax_error $1.loc "a type name must start with a lower-case letter or an underscore"; let (kind, priv, manifest), constraints, endpos, and_types = $3 in (($1, $2, constraints, kind, priv, manifest), endpos, and_types) } - | as_loc(LIDENT) type_variables_with_variance type_declaration_kind + | as_loc(LIDENT) optional_type_params(type_variable_with_variance) type_declaration_kind { let (kind, priv, manifest), constraints, endpos, and_types = $3 in (($1, $2, constraints, kind, priv, manifest), endpos, and_types) } ; @@ -3971,7 +3967,7 @@ type_subst_kind: type_subst_declarations: item_attributes TYPE nrf=nonrec_flag name=as_loc(LIDENT) - params=type_variables_with_variance kind_priv_man=type_subst_kind + params=optional_type_params(type_variable_with_variance) kind_priv_man=type_subst_kind { check_nonrec_absent (mklocation $startpos(nrf) $endpos(nrf)) nrf; let (kind, priv, manifest), cstrs, endpos, and_types = kind_priv_man in let ty = @@ -3985,7 +3981,7 @@ type_subst_declarations: and_type_subst_declaration: | { [] } | item_attributes AND name=as_loc(LIDENT) - params=type_variables_with_variance kind_priv_man=type_subst_kind + params=optional_type_params(type_variable_with_variance) kind_priv_man=type_subst_kind { let (kind, priv, manifest), cstrs, endpos, and_types = kind_priv_man in Type.mk name ~params ~cstrs ~kind ~priv ?manifest @@ -4024,24 +4020,15 @@ type_other_kind: { (Ptype_record (prepend_attrs_to_labels $5 $6), $4, Some $2) } ; -type_variables_with_variance_comma_list: - lseparated_nonempty_list(COMMA, type_variable_with_variance) COMMA? {$1} -; - -type_variables_with_variance: - | loption(parenthesized(type_variables_with_variance_comma_list)) - { $1 } - (* No need to parse LESSIDENT here, because for - * type_variables_with_variance, you'll never have an identifier in any of - * the type parameters*) - | lessthangreaterthanized(type_variables_with_variance_comma_list) - { $1 } -; - -type_variable_with_variance: +/** + * Class syntax cannot accept an underscore for type parameters. + * There may be type checking problems, but at the very least it causes + * a grammar conflict. The grammar conflict would go away if type parameters + * *required* <> instead of also allowing (). + */ +%inline type_variable_without_underscore: embedded ( QUOTE ident { (mktyp (Ptyp_var $2) , Invariant ) } - | UNDERSCORE { (mktyp (Ptyp_any) , Invariant ) } | PLUS QUOTE ident { (mktyp (Ptyp_var $3) , Covariant ) } | PLUS UNDERSCORE { (mktyp (Ptyp_any) , Covariant ) } | MINUS QUOTE ident { (mktyp (Ptyp_var $3) , Contravariant) } @@ -4055,19 +4042,17 @@ type_variable_with_variance: } ; -type_parameter: type_variance type_variable { ($2, $1) }; -type_variance: - | (* empty *) { Invariant } - | PLUS { Covariant } - | MINUS { Contravariant } +type_variable_with_variance: + | type_variable_without_underscore { $1 } + | UNDERSCORE { + let first = mktyp Ptyp_any in + let second = Invariant in + let ptyp_loc = {first.ptyp_loc with loc_start = $symbolstartpos; loc_end = $endpos} in + ({first with ptyp_loc}, second) + } ; -type_variable: -mark_position_typ - (QUOTE ident { mktyp (Ptyp_var $2) }) - { $1 }; - constructor_declarations: | BAR and_type_declaration { ([], [], $endpos, $2) } | either(constructor_declaration,bar_constructor_declaration) @@ -4173,7 +4158,7 @@ str_type_extension: attrs = item_attributes TYPE flag = nonrec_flag ident = as_loc(itype_longident) - params = type_variables_with_variance + params = optional_type_params(type_variable_with_variance) PLUSEQ priv = embedded(private_flag) constructors = attributed_ext_constructors(either(extension_constructor_declaration, extension_constructor_rebind)) @@ -4187,7 +4172,7 @@ sig_type_extension: attrs = item_attributes TYPE flag = nonrec_flag ident = as_loc(itype_longident) - params = type_variables_with_variance + params = optional_type_params(type_variable_with_variance) PLUSEQ priv = embedded(private_flag) constructors = attributed_ext_constructors(extension_constructor_declaration) @@ -4232,7 +4217,7 @@ extension_constructor_rebind: (* "with" constraints (additional type equations over signature components) *) with_constraint: - | TYPE as_loc(label_longident) type_variables_with_variance + | TYPE as_loc(label_longident) optional_type_params(type_variable_with_variance) EQUAL embedded(private_flag) core_type constraints { let loc = mklocation $symbolstartpos $endpos in let typ = Type.mk {$2 with txt=Longident.last $2.txt} @@ -4241,7 +4226,7 @@ with_constraint: } (* used label_longident instead of type_longident to disallow functor applications in type path *) - | TYPE as_loc(label_longident) type_variables_with_variance + | TYPE as_loc(label_longident) optional_type_params(type_variable_with_variance) COLONEQUAL core_type { let last = match $2.txt with | Lident s -> s @@ -4979,6 +4964,19 @@ attr_id: ; attribute: + | VERSION_ATTRIBUTE + { + (* Just ignore the attribute in the AST at this point, but record its version, + * then we wil add it back at the "top" of the file. *) + let major, minor = $1 in + Reason_version.set_explicit (major, minor); + let attr_payload = Reason_version.Ast_nodes.mk_version_attr_payload major minor in + let loc = mklocation $symbolstartpos $endpos in + { attr_name = {loc; txt="reason.version"}; + attr_payload; + attr_loc = loc + } + } | LBRACKETAT attr_id payload RBRACKET { { attr_name = $2; @@ -5140,4 +5138,26 @@ lseparated_nonempty_list_aux(sep, X): (*Less than followed by one or more X, then greater than *) %inline lessthangreaterthanized(X): delimited(LESS, X, GREATER) { $1 }; +(*Less than followed by one or more X, then greater than *) +%inline loptioninline(X): ioption(X) { match $1 with None -> [] | Some x -> x}; + +%inline nonempty_comma_list(X): + lseparated_nonempty_list(COMMA, X) COMMA? {$1} +; + +(* Allows defining type variable regions that allow certain *kinds* of type + * variables depending on context *) +%inline type_param_group(X): + | parenthesized(X) + { $1 } + (* No need to parse LESSIDENT here, because for + * type_param_group, you'll never have an identifier in any of + * the type parameters*) + | lessthangreaterthanized(X) + { $1 } +; + +%inline optional_type_params(X): + | loptioninline(type_param_group(nonempty_comma_list(X))) { $1 } + %% diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 802e5d2e6..4fa2241b0 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -294,6 +294,14 @@ let expandLocation pos ~expand:(startPos, endPos) = } } +let should_keep_floating_stylistic_structure_attr = function + | {pstr_desc=Pstr_attribute a; _} -> not (Reason_attributes.is_stylistic_attr a) + | _ -> true + +let should_keep_floating_stylistic_sig_attr = function + | {psig_desc=Psig_attribute a; _} -> not (Reason_attributes.is_stylistic_attr a) + | _ -> true + (* Computes the location of the attribute with the lowest line number * that isn't ghost. Useful to determine the start location of an item * in the parsetree that has attributes. @@ -1064,6 +1072,19 @@ let makeTup ?(wrap=("", ""))?(trailComma=true) ?(uncurried = false) l = ~postSpace:true ~break:IfNeed l +(* Makes angle brackets < > *) +let typeParameterBookends ?(wrap=("", ""))?(trailComma=true) l = + let useAngle = Reason_version.supports Reason_version.AngleBracketTypes in + let left = if useAngle then "<" else "(" in + let right = if useAngle then ">" else ")" in + let (lwrap, rwrap) = wrap in + let lparen = lwrap ^ left in + makeList + ~wrap:(lparen, right ^ rwrap) + ~sep:(if trailComma then commaTrail else commaSep) + ~postSpace:true + ~break:IfNeed l + let ensureSingleTokenSticksToLabel x = let listConfigIfCommentsInterleaved cfg = let inline = (true, true) and postSpace = true and indent = 0 in @@ -2433,7 +2454,7 @@ let printer = object(self:'self) (* c ['a,'b] *) method class_params_def = function | [] -> atom "" - | l -> makeTup (List.map self#type_param l) + | l -> typeParameterBookends (List.map self#type_param l) (* This will fall through to the simple version. *) method non_arrowed_core_type x = self#non_arrowed_non_simple_core_type x @@ -2539,7 +2560,7 @@ let printer = object(self:'self) let labelWithParams = match formattedTypeParams with | [] -> binding - | l -> label binding (makeTup l) + | l -> label binding (typeParameterBookends l) in let everythingButConstraints = let nameParamsEquals = makeList ~postSpace:true [labelWithParams; assignToken] in @@ -2591,7 +2612,7 @@ let printer = object(self:'self) let binding = makeList ~postSpace:true (prepend::name::[]) in let labelWithParams = match formattedTypeParams with | [] -> binding - | l -> label binding (makeTup l) + | l -> label binding (typeParameterBookends l) in let everything = let nameParamsEquals = makeList ~postSpace:true [labelWithParams; assignToken] in @@ -2747,7 +2768,7 @@ let printer = object(self:'self) let ct = self#core_type arg in let ct = match arg.ptyp_desc with | Ptyp_tuple _ -> ct - | _ -> makeTup [ct] + | _ -> typeParameterBookends [ct] in if i == 0 && not opt_ampersand then ct @@ -3084,6 +3105,7 @@ let printer = object(self:'self) | [{ptyp_desc = Ptyp_constr(lii, [{ ptyp_desc = Ptyp_object (_::_ as ll, o)}])}] when isJsDotTLongIdent lii.txt -> label (self#longident_loc li) + (* ADD TEST CASE FOR THIS *) (self#unparseObject ~withStringKeys:true ~wrap:("(",")") ll o) | _ -> (* small guidance: in `type foo = bar`, we're now at the `bar` part *) @@ -3092,7 +3114,7 @@ let printer = object(self:'self) avoid (@see @avoidSingleTokenWrapping): *) label (self#longident_loc li) - (makeTup ( + (typeParameterBookends ( List.map self#type_param_list_element l )) ) @@ -3130,7 +3152,7 @@ let printer = object(self:'self) | Ptyp_class (li, l) -> label (makeList [atom "#"; self#longident_loc li]) - (makeTup (List.map self#core_type l)) + (typeParameterBookends (List.map self#core_type l)) | Ptyp_extension e -> self#extension e | Ptyp_arrow (_, _, _) | Ptyp_alias (_, _) @@ -6763,7 +6785,7 @@ let printer = object(self:'self) | _::_ -> label (self#longident_loc li) - (makeList ~wrap:("(", ")") ~sep:commaTrail (List.map self#core_type l)) + (typeParameterBookends (List.map self#core_type l)) ) | Pcty_extension e -> self#attach_std_item_attrs x.pcty_attributes (self#extension e) @@ -6820,7 +6842,7 @@ let printer = object(self:'self) label ~space:true (atom opener) (atom pci_name.txt) else label - ~space:true + ~space:false (label ~space:true (atom opener) (atom pci_name.txt)) (self#class_params_def ls) in @@ -7127,7 +7149,7 @@ let printer = object(self:'self) | Pcl_constr (li, l) -> label (makeList ~postSpace:true [atom "class"; self#longident_loc li]) - (makeTup (List.map self#non_arrowed_non_simple_core_type l)) + (typeParameterBookends (List.map self#non_arrowed_non_simple_core_type l)) | Pcl_open _ | Pcl_constraint _ | Pcl_extension _ @@ -7591,7 +7613,7 @@ let printer = object(self:'self) ~xf:self#structure_item ~getLoc:(fun x -> x.pstr_loc) ~comments:self#comments - structureItems + (List.filter should_keep_floating_stylistic_structure_attr structureItems) in source_map ~loc:{loc_start; loc_end; loc_ghost = false} (makeList @@ -8312,10 +8334,47 @@ let add_explicit_arity_mapper super = in { super with Ast_mapper. expr; pat } +(** Doesn't actually "map", but searches for version number in AST and records + * it if present. Needs to be executed before printing. *) +let record_version_mapper super = + let super_structure_item = super.Ast_mapper.structure_item in + let super_signature_item = super.Ast_mapper.signature_item in + let structure_item mapper structure_item = + (match Reason_version.Ast_nodes.extract_version_attribute_structure_item structure_item with + | None -> () + | Some(mjr, mnr) -> Reason_version.set_explicit (mjr, mnr)); + super_structure_item mapper structure_item + in + let signature_item mapper signature_item = + (match Reason_version.Ast_nodes.extract_version_attribute_signature_item signature_item with + | None -> () + | Some(mjr, mnr) -> Reason_version.set_explicit (mjr, mnr)); + super_signature_item mapper signature_item + in + { super with Ast_mapper.structure_item; Ast_mapper.signature_item } + +(* These won't get removed from partitioning since they are individual floating + * attributes *) +let remove_floating_style_attributes super = + let super_structure = super.Ast_mapper.structure in + let super_signature = super.Ast_mapper.signature in + let structure mapper structure = + super_structure + mapper + (List.filter should_keep_floating_stylistic_structure_attr structure) + in + let signature mapper signature = + super_signature + mapper + (List.filter should_keep_floating_stylistic_sig_attr signature) + in + { super with Ast_mapper.structure; Ast_mapper.signature } + let preprocessing_mapper = ml_to_reason_swap_operator_mapper - (escape_stars_slashes_mapper - (add_explicit_arity_mapper Ast_mapper.default_mapper)) + (remove_floating_style_attributes + (record_version_mapper (escape_stars_slashes_mapper + (add_explicit_arity_mapper Ast_mapper.default_mapper)))) let core_type ppf x = format_layout ppf @@ -8328,12 +8387,16 @@ let pattern ppf x = let signature (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments - (printer#signature (apply_mapper_to_signature x preprocessing_mapper)) + (printer#signature + (Reason_version.Ast_nodes.inject_attr_from_version_intf + (apply_mapper_to_signature x preprocessing_mapper))) let structure (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments - (printer#structure (apply_mapper_to_structure x preprocessing_mapper)) + (printer#structure + (Reason_version.Ast_nodes.inject_attr_from_version_impl + (apply_mapper_to_structure x preprocessing_mapper))) let expression ppf x = format_layout ppf diff --git a/src/reason-parser/reason_single_parser.ml b/src/reason-parser/reason_single_parser.ml index 6b1e2dde0..9f9392ead 100644 --- a/src/reason-parser/reason_single_parser.ml +++ b/src/reason-parser/reason_single_parser.ml @@ -186,6 +186,8 @@ let common_remaining_infix_token pcur = | ['!'] -> Some(Reason_parser.BANG, pcur, pnext) | ['>'] -> Some(Reason_parser.GREATER, pcur, pnext) | ['<'] -> Some(Reason_parser.LESS, pcur, pnext) + | ['#'] -> Some(Reason_parser.SHARP, pcur, pnext) + | [':'] -> Some(Reason_parser.COLON, pcur, pnext) | _ -> None let rec decompose_token pos0 split = @@ -193,7 +195,6 @@ let rec decompose_token pos0 split = let pnext = advance pos0 2 in match split with (* Empty token is a valid decomposition *) - | [] -> None | '=' :: tl -> let eq = (Reason_parser.EQUAL, pcur, pnext) in let (revFirstTwo, tl, pcur, _pnext) = match tl with @@ -206,7 +207,7 @@ let rec decompose_token pos0 split = (match common_remaining_infix_token pcur tl with | None -> None | Some(r) -> Some(List.rev (r :: revFirstTwo))) - (* For type parameters type t<+'a> = .. *) + (* For type parameters type t<+'a> = .. and t<#classNameOrPolyVariantKind>*) | '<' :: tl -> let less = [Reason_parser.LESS, pcur, pnext] in if tl == [] then Some less @@ -216,7 +217,13 @@ let rec decompose_token pos0 split = | Some(r) -> Some(List.rev (r :: less))) | '>' :: _tl -> (* Recurse to take advantage of all the logic in case the remaining - * begins with an equal sign. *) + * begins with an equal sign. + * This also handles: + * + * class foo<'a, 'b>: ... + * + * Where >: is initially lexed as an infix. + *) let gt_tokens, rest_split, prest = split_greaters [] pcur split in if rest_split == [] then Some gt_tokens @@ -224,6 +231,11 @@ let rec decompose_token pos0 split = (match decompose_token prest rest_split with | None -> None (* Couldn't parse the non-empty tail - invalidates whole thing *) | Some(r) -> Some(List.rev gt_tokens @ r)) + | [_] | [_; _] -> + (match common_remaining_infix_token pcur split with + | None -> None + | Some a -> Some [a]) + | [] -> None | _ -> None diff --git a/src/reason-version/dune b/src/reason-version/dune new file mode 100644 index 000000000..2e10bfd65 --- /dev/null +++ b/src/reason-version/dune @@ -0,0 +1,6 @@ +(library + (name reason_version) + (public_name reason.version) + (modules reason_version) + (libraries reason.ocaml-migrate-parsetree) +) diff --git a/src/reason-version/reason_version.ml b/src/reason-version/reason_version.ml new file mode 100644 index 000000000..5a1d9e318 --- /dev/null +++ b/src/reason-version/reason_version.ml @@ -0,0 +1,192 @@ +(** + * Tracks the version of Reason per file, and provides supported + * feature lookup per version. + *) +open Reason_migrate_parsetree +open OCaml_408.Ast +open Parsetree +open Location +open Asttypes +open Ast_helper + +type file_version = { + major : int; + minor : int; +} + +type package_version = { + major : int; + minor : int; + patch : int; +} + +type feature = + | AngleBracketTypes + +(** + * Tracks the current package version of Reason parser/printer. This is + * primarily for printing the version with `refmt --version`. + *) +let package_version = { + major = 3; + minor = 7; + patch = 0; +} + +let package_version_string = + (string_of_int package_version.major) ^ + "." ^ + (string_of_int package_version.minor) ^ + "." ^ + (string_of_int package_version.patch) + +(** + * Tracks the file version recorded in attribute. Defaults to 3.6 - + * the version before Reason's refmt began recording versions in + * editor formatting. + *) +let explicit_file_version = {contents = None} + +(** We start out with an inferred file version of 3.6, the last minor version + * that did not format a version into the file. *) +let infered_file_version = {contents = {major = 3; minor = 6;}} + +let set_explicit (major, minor) = + explicit_file_version.contents <- Some {major; minor} + +let effective () = match explicit_file_version.contents with + | Some efv -> efv + | None -> infered_file_version.contents + +let within + ~inclusive:lower_inclusive + (low_mjr, low_mnr) + ~inclusive:upper_inclusive + (up_mjr, up_mnr) = + let ev = effective () in + let mjr, mnr = ev.major, ev.minor in + let lower_meets = + if lower_inclusive then mjr > low_mjr || (mjr == low_mjr && mnr >= low_mnr) + else mjr > low_mjr || (mjr == low_mjr && mnr > low_mnr) + in + let upper_meets = + if upper_inclusive then mjr < up_mjr || (mjr == up_mjr && mnr <= up_mnr) + else mjr < up_mjr || (mjr == up_mjr && mnr < up_mnr) + in + lower_meets && upper_meets + +let at_least (major, minor) = + within ~inclusive:true (major, minor) ~inclusive:true (10000,0) + +let supports = function + | AngleBracketTypes -> at_least (3, 8) + + +let dummy_loc () = { + loc_start = Lexing.dummy_pos; + loc_end = Lexing.dummy_pos; + loc_ghost = false; +} + +(* Implementation of String.split_on_char, since it's not available in older + * OCamls *) +let _split_on_char sep_char str = + let r = {contents = []} in + let j = {contents = String.length str} in + for i = String.length str - 1 downto 0 do + if String.unsafe_get str i = sep_char then begin + r.contents <- String.sub str (i + 1) (!j - i - 1) :: r.contents; + j.contents <- i + end + done; + String.sub str 0 j.contents :: r.contents + +module Ast_nodes = struct + let mk_warning_attribute_payload ~loc msg = + let exp = Exp.mk ~loc (Pexp_constant (Pconst_string(msg, None))) in + let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in + PStr [item] + + let mk_version_attr_payload major minor = + let major, minor = string_of_int major, string_of_int minor in + let loc = dummy_loc () in + let exp = Exp.mk ~loc (Pexp_constant (Pconst_float(major ^ "." ^ minor, None))) in + let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in + PStr [item] + + (** Creates an attribute to inject into the AST if it was not already present *) + let inject_attr_from_version itms ~insert_after ~creator = + let loc = dummy_loc () in + match explicit_file_version.contents with + | None -> + let major, minor = package_version.major, package_version.minor in + let attr_payload = mk_version_attr_payload major minor in + let created = (creator ~loc {attr_name={loc; txt="reason.version"}; attr_payload; attr_loc=loc}) in + (match itms with + | first :: rest when insert_after first -> + first :: created :: rest + | _ -> created :: itms + ) + | Some efv -> begin + if efv.major > package_version.major || + (efv.major == package_version.major && efv.minor > package_version.minor) then + let efv_mjr = string_of_int efv.major in + let efv_mnr = string_of_int efv.minor in + let pkg_mjr = string_of_int package_version.major in + let pkg_mnr = string_of_int package_version.minor in + let msg = + "This file specifies a reason.version " ^ efv_mjr ^ "." ^ efv_mnr ^ + " which is greater than the package version " ^ pkg_mjr ^ "." ^ pkg_mnr ^ + " Either upgrade the Reason package or lower the version specified in [@reason.version ]." in + (* let loc = match itms with *) + (* | hd :: _ -> hd.pstr_loc *) + (* | [] -> loc *) + (* in *) + let attr_payload = mk_warning_attribute_payload ~loc msg in + let created = (creator ~loc {attr_name={loc; txt="ocaml.ppwarn"}; attr_payload; attr_loc=loc}) in + created :: itms + else itms + end + + let inject_attr_from_version_impl itms = + let insert_after = function + | {pstr_desc = Pstr_attribute {attr_name = {txt="ocaml.doc"|"ocaml.text"; _}; _}; _} -> true + | _ -> false + in + let creator = (fun ~loc x -> Str.mk ~loc (Pstr_attribute x)) in + inject_attr_from_version itms ~insert_after ~creator + + let inject_attr_from_version_intf itms = + let insert_after = function + | {psig_desc = Psig_attribute {attr_name = {txt="ocaml.doc"|"ocaml.text"; _}; _}; _} -> true + | _ -> false + in + let creator = (fun ~loc x -> Sig.mk ~loc (Psig_attribute x)) in + inject_attr_from_version itms ~insert_after ~creator + + let extract_version_attribute_structure_item structure_item = + (match structure_item with + | {pstr_desc=(Pstr_attribute { + attr_name={txt="reason.version"; _}; + attr_payload = PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_float(v, _)); _},_); _}]; + _ + }); _} -> + (match _split_on_char '.' v with + | [maj] | [maj; ""] -> Some (int_of_string maj, 0) + | maj :: mnr :: _ -> Some (int_of_string maj, int_of_string mnr) + | _ -> None); + | _ -> None) + + let extract_version_attribute_signature_item sig_item = + (match sig_item with + | {psig_desc=(Psig_attribute { + attr_name={txt="reason.version"; _}; + attr_payload = PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_float(v, _)); _},_); _}]; + _ + }); _} -> + (match _split_on_char '.' v with + | [maj] | [maj; ""] -> Some (int_of_string maj, 0) + | maj :: mnr :: _ -> Some (int_of_string maj, int_of_string mnr) + | _ -> None); + | _ -> None) +end diff --git a/src/redoc/redoc_html.ml b/src/redoc/redoc_html.ml deleted file mode 100644 index cb707133f..000000000 --- a/src/redoc/redoc_html.ml +++ /dev/null @@ -1,590 +0,0 @@ -(* - * Copyright (c) 2015-present, Facebook, Inc. - * - * This source code is licensed under the MIT license found in the - * LICENSE file in the root directory of this source tree. - * - * Forked from OCaml, which is provided under the license below: - * - * Xavier Leroy, projet Cristal, INRIA Rocquencourt - * - * Copyright © 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006 Inria - * - * Permission is hereby granted, free of charge, to the Licensee obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense - * under any license of the Licensee's choice, and/or sell copies of the - * Software, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice - * and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright - * notice, the following disclaimer in the documentation and/or other - * materials provided with the distribution. - * 3. All advertising materials mentioning features or use of the Software - * must display the following acknowledgement: This product includes all or - * parts of the Caml system developed by Inria and its contributors. - * 4. Other than specified in clause 3, neither the name of Inria nor the - * names of its contributors may be used to endorse or promote products - * derived from the Software without specific prior written permission. - * - * Disclaimer - * - * This software is provided by Inria and contributors “as is” and any express - * or implied warranties, including, but not limited to, the implied - * warranties of merchantability and fitness for a particular purpose are - * disclaimed. in no event shall Inria or its contributors be liable for any - * direct, indirect, incidental, special, exemplary, or consequential damages - * (including, but not limited to, procurement of substitute goods or - * services; loss of use, data, or profits; or business interruption) however - * caused and on any theory of liability, whether in contract, strict - * liability, or tort (including negligence or otherwise) arising in any way - * out of the use of this software, even if advised of the possibility of such - * damage. - * - *) - -open Odoc_info -module Naming = Odoc_html.Naming -open Odoc_info.Value -open Odoc_info.Module -open Odoc_info.Extension -open Odoc_info.Exception -open Odoc_info.Type -open Odoc_info.Class - -let p = Printf.bprintf -let bp = Printf.bprintf -let bs = Buffer.add_string - -let wrap f g fmt x = g fmt (f x) - -let () = - let open Reason_toolchain.From_current in - Oprint.out_value := wrap copy_out_value Reason_oprint.print_out_value; - Oprint.out_type := wrap copy_out_type Reason_oprint.print_out_type; - Oprint.out_class_type := wrap copy_out_class_type Reason_oprint.print_out_class_type; - Oprint.out_module_type := wrap copy_out_module_type Reason_oprint.print_out_module_type; - Oprint.out_sig_item := wrap copy_out_sig_item Reason_oprint.print_out_sig_item; - Oprint.out_signature := wrap (List.map copy_out_sig_item) Reason_oprint.print_out_signature; - Oprint.out_type_extension := wrap copy_out_type_extension Reason_oprint.print_out_type_extension; - Oprint.out_phrase := wrap copy_out_phrase Reason_oprint.print_out_phrase; - -module Html = - (val - ( - match !Odoc_args.current_generator with - None -> (module Odoc_html.Generator : Odoc_html.Html_generator) - | Some (Odoc_gen.Html m) -> m - | _ -> - failwith - "A non-html generator is already set. Cannot install the Todo-list html generator" - ) : Odoc_html.Html_generator) -;; - -let raw_string_of_type_list sep type_list = - let buf = Buffer.create 256 in - let fmt = Format.formatter_of_buffer buf in - let rec need_parent t = - match t.Types.desc with - Types.Tarrow _ | Types.Ttuple _ -> true - | Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2 - | Types.Tconstr _ -> - false - | Types.Tvar _ | Types.Tunivar _ | Types.Tobject _ | Types.Tpoly _ - | Types.Tfield _ | Types.Tnil | Types.Tvariant _ | Types.Tpackage _ -> false - in - let print_one_type variance t = - Printtyp.mark_loops t; - if need_parent t then - ( - Format.fprintf fmt "(%s" variance; - Printtyp.type_scheme_max ~b_reset_names: false fmt t; - Format.fprintf fmt ")" - ) - else - ( - Format.fprintf fmt "%s" variance; - Printtyp.type_scheme_max ~b_reset_names: false fmt t - ) - in - begin match type_list with - [] -> () - | [(variance, ty)] -> print_one_type variance ty - | (variance, ty) :: tyl -> - Format.fprintf fmt "@["; - print_one_type variance ty; - List.iter - (fun (variance, t) -> - Format.fprintf fmt "@,%s" sep; - print_one_type variance t - ) - tyl; - Format.fprintf fmt "@]" - end; - Format.pp_print_flush fmt (); - Buffer.contents buf - - -let string_of_type_param_list t = - Printf.sprintf "%s" - (raw_string_of_type_list " " - (List.map - (fun (typ, co, cn) -> (Odoc_str.string_of_variance t (co, cn), typ)) - t.Odoc_type.ty_parameters - ) - ) - -let string_of_type_extension_param_list te = - Printf.sprintf "%s" - (raw_string_of_type_list " " - (List.map - (fun typ -> ("", typ)) - te.Odoc_extension.te_type_parameters - ) - ) - -let string_of_value v = - let module M = Odoc_value in - "let "^(Name.simple v.M.val_name)^" : "^ - (Odoc_print.string_of_type_expr v.M.val_type)^"\n"^ - (match v.M.val_info with - None -> "" - | Some i -> Odoc_misc.string_of_info i) - -(*module Generator = -struct -class html = - object (self) - inherit Html.html as html - - method html_of_type_expr_param_list b m_name t = - let s = string_of_type_param_list t in - let s2 = Odoc_html.newline_to_indented_br s in - bs b ""; - bs b (self#create_fully_qualified_idents_links m_name s2); - bs b "" - - method html_of_module_kind b father ?modu kind = - match kind with - Module_struct eles -> - self#html_of_text b [Code "{"]; - ( - match modu with - None -> - bs b "
"; - List.iter (self#html_of_module_element b father) eles; - bs b "
" - | Some m -> - let (html_file, _) = Naming.html_files m.m_name in - bp b " .. " html_file - ); - self#html_of_text b [Code "}"] - | _ -> html#html_of_module_kind b father ?modu kind - - method html_of_module_parameter b father p = - let (s_functor,s_arrow) = - if !Odoc_html.html_short_functors then - "", "" - else - "", "=> " - in - self#html_of_text b - [ - Code (s_functor^"("); - Code p.mp_name ; - Code " : "; - ] ; - self#html_of_module_type_kind b father p.mp_kind; - self#html_of_text b [ Code (") "^s_arrow)] - - method html_of_module_type_kind b father ?modu ?mt kind = - match kind with - Module_type_struct eles -> - self#html_of_text b [Code "{"]; - ( - match mt with - None -> - ( - match modu with - None -> - bs b "
"; - List.iter (self#html_of_module_element b father) eles; - bs b "
" - | Some m -> - let (html_file, _) = Naming.html_files m.m_name in - bp b " .. " html_file - ) - | Some mt -> - let (html_file, _) = Naming.html_files mt.mt_name in - bp b " .. " html_file - ); - self#html_of_text b [Code "}"] - | _ -> html#html_of_module_type_kind b father ?modu ?mt kind - - method html_of_value b v = - Odoc_info.reset_type_names (); - bs b "\n
" ;
-      bp b "" (Naming.value_target v);
-      bs b (self#keyword "let");
-      bs b " ";
-      (
-       match v.val_code with
-         None -> bs b (self#escape (Name.simple v.val_name))
-       | Some c ->
-           let file = Naming.file_code_value_complete_target v in
-           self#output_code v.val_name (Filename.concat !Global.target_dir file) c;
-           bp b "%s" file (self#escape (Name.simple v.val_name))
-      );
-      bs b "";
-      bs b " : ";
-      self#html_of_type_expr b (Name.father v.val_name) v.val_type;
-      bs b "
"; - self#html_of_info b v.val_info; - ( - if !Odoc_html.with_parameter_list then - self#html_of_parameter_list b (Name.father v.val_name) v.val_parameters - else - self#html_of_described_parameter_list b (Name.father v.val_name) v.val_parameters - ) - - method html_of_type_extension b m_name te = - Odoc_info.reset_type_names (); - bs b "
";
-      bs b ((self#keyword "type")^" ");
-      let s = string_of_type_extension_param_list te in
-      let s2 = Odoc_html.newline_to_indented_br s in
-      bs b "";
-      bs b (self#create_fully_qualified_idents_links m_name s2);
-      bs b "";
-      (match te.te_type_parameters with [] -> () | _ -> bs b " ");
-      bs b (self#create_fully_qualified_idents_links m_name te.te_type_name);
-      bs b " += ";
-      if te.te_private = Asttypes.Private then bs b "private ";
-      bs b "
"; - bs b "\n"; - let print_one x = - let father = Name.father x.xt_name in - let cname = Name.simple x.xt_name in - bs b "\n\n\n"; - ( - match x.xt_text with - None -> () - | Some t -> - bs b ""; - bs b ""; - bs b ""; - ); - bs b "\n" - in - Odoc_html.print_concat b "\n" print_one te.te_constructors; - bs b "
\n"; - bs b ""; - bs b (self#keyword "|"); - bs b "\n"; - bs b ""; - bp b "%s" - (Naming.extension_target x) - (Name.simple x.xt_name); - ( - match x.xt_args, x.xt_ret with - Cstr_tuple [], None -> () - | l, None -> - bs b (" " ^ (self#keyword "of") ^ " "); - self#html_of_cstr_args ~par: false b father cname " * " l; - | Cstr_tuple [], Some r -> - bs b (" " ^ (self#keyword ":") ^ " "); - self#html_of_type_expr b father r; - | l, Some r -> - bs b (" " ^ (self#keyword ":") ^ " "); - self#html_of_cstr_args ~par: false b father cname " * " l; - bs b (" " ^ (self#keyword "->") ^ " "); - self#html_of_type_expr b father r; - ); - ( - match x.xt_alias with - None -> () - | Some xa -> - bs b " = "; - ( - match xa.xa_xt with - None -> bs b xa.xa_name - | Some x -> - bp b "%s" (Naming.complete_extension_target x) x.xt_name - ) - ); - bs b ""; - bs b ""; - bs b "(*"; - bs b ""; - self#html_of_info b (Some t); - bs b ""; - bs b ""; - bs b "*)"; - bs b "
\n"; - bs b "\n"; - self#html_of_info b te.te_info; - bs b "\n" - - method html_of_exception b e = - let cname = Name.simple e.ex_name in - Odoc_info.reset_type_names (); - bs b "\n
";
-      bp b "" (Naming.exception_target e);
-      bs b (self#keyword "exception");
-      bs b " ";
-      bs b (Name.simple e.ex_name);
-      bs b "";
-      (
-        match e.ex_args, e.ex_ret with
-          Cstr_tuple [], None -> ()
-        | _,None ->
-            bs b (" "^(self#keyword "of")^" ");
-            self#html_of_cstr_args
-                   ~par: false b (Name.father e.ex_name) cname " * " e.ex_args
-        | Cstr_tuple [],Some r ->
-            bs b (" " ^ (self#keyword ":") ^ " ");
-            self#html_of_type_expr b (Name.father e.ex_name) r;
-        | l,Some r ->
-            bs b (" " ^ (self#keyword ":") ^ " ");
-            self#html_of_cstr_args
-                   ~par: false b (Name.father e.ex_name) cname " * " l;
-            bs b (" " ^ (self#keyword "->") ^ " ");
-            self#html_of_type_expr b (Name.father e.ex_name) r;
-      );
-      (
-       match e.ex_alias with
-         None -> ()
-       | Some ea ->
-           bs b " = ";
-           (
-            match ea.ea_ex with
-              None -> bs b ea.ea_name
-            | Some e ->
-                bp b "%s" (Naming.complete_exception_target e) e.ex_name
-           )
-      );
-      bs b "
\n"; - self#html_of_info b e.ex_info - - method html_of_type b t = - Odoc_info.reset_type_names (); - let father = Name.father t.ty_name in - let print_field_prefix () = - bs b "\n\n"; - bs b "  "; - bs b "\n\n"; - bs b ""; - in - let print_field_comment = function - | None -> () - | Some t -> - bs b ""; - bs b ""; - bs b "(*"; - bs b ""; - bs b ""; - self#html_of_info b (Some t); - bs b ""; - bs b "*)" - in - bs b - (match t.ty_manifest, t.ty_kind with - None, Type_abstract - | None, Type_open -> "\n
"
-        | None, Type_variant _
-        | None, Type_record _ -> "\n
"
-        | Some _, Type_abstract
-        | Some _, Type_open -> "\n
"
-        | Some _, Type_variant _
-        | Some _, Type_record _ -> "\n
"
-        );
-      bp b "" (Naming.type_target t);
-      bs b ((self#keyword "type")^" ");
-      bs b (Name.simple t.ty_name);
-      (match t.ty_parameters with [] -> () | _ -> bs b " ");
-      self#html_of_type_expr_param_list b father t;
-      bs b " ";
-      let priv = t.ty_private = Asttypes.Private in
-      (
-       match t.ty_manifest with
-         None -> ()
-       | Some (Object_type fields) ->
-           bs b "= ";
-           if priv then bs b "private ";
-           bs b "<
";
-           bs b "\n" ;
-           let print_one f =
-             print_field_prefix () ;
-             bp b "%s : "
-               (Naming.objfield_target t f)
-               f.of_name;
-             self#html_of_type_expr b father f.of_type;
-             bs b ";\n";
-             print_field_comment f.of_text ;
-             bs b "\n"
-           in
-           Odoc_html.print_concat b "\n" print_one fields;
-           bs b "
\n>\n";
-           bs b " "
-       | Some (Other typ) ->
-           bs b "= ";
-           if priv then bs b "private ";
-           self#html_of_type_expr b father typ;
-           bs b " "
-      );
-      (match t.ty_kind with
-        Type_abstract -> bs b "
"
-      | Type_variant l ->
-          bs b "= ";
-          if priv then bs b "private ";
-          bs b
-            (
-             match t.ty_manifest with
-               None -> "
"
-             | Some _ -> "
" - ); - bs b "\n"; - let print_one constr = - bs b "\n\n\n"; - ( - match constr.vc_text with - None -> () - | Some t -> - bs b ""; - bs b ""; - bs b ""; - ); - bs b "\n" - in - Odoc_html.print_concat b "\n" print_one l; - bs b "
\n"; - bs b ""; - bs b (self#keyword "|"); - bs b "\n"; - bs b ""; - bp b "%s" - (Naming.const_target t constr) - (self#constructor constr.vc_name); - ( - match constr.vc_args, constr.vc_ret with - Cstr_tuple [], None -> () - | l,None -> - bs b (" " ^ (self#keyword "of") ^ " "); - self#html_of_cstr_args ~par: false b father constr.vc_name " * " l; - | Cstr_tuple [],Some r -> - bs b (" " ^ (self#keyword ":") ^ " "); - self#html_of_type_expr b father r; - | l,Some r -> - bs b (" " ^ (self#keyword ":") ^ " "); - self#html_of_cstr_args ~par: false b father constr.vc_name " * " l; - bs b (" " ^ (self#keyword "->") ^ " "); - self#html_of_type_expr b father r; - ); - bs b ""; - bs b ""; - bs b "(*"; - bs b ""; - self#html_of_info b (Some t); - bs b ""; - bs b ""; - bs b "*)"; - bs b "
\n" - | Type_record l -> - bs b "= "; - if priv then bs b "private " ; - bs b "{"; - bs b - ( - match t.ty_manifest with - None -> "" - | Some _ -> "" - ); - bs b "\n" ; - let print_one r = - bs b "\n\n\n"; - ( - match r.rf_text with - None -> () - | Some t -> - bs b ""; - bs b ""; - ); - bs b "\n" - in - Odoc_html.print_concat b "\n" print_one l; - bs b "
\n"; - bs b "  "; - bs b "\n"; - bs b ""; - if r.rf_mutable then bs b (self#keyword "mutable ") ; - bp b "%s : " - (Naming.recfield_target t r) - r.rf_name; - self#html_of_type_expr b father r.rf_type; - bs b ","; - bs b ""; - bs b "(*"; - bs b ""; - self#html_of_info b (Some t); - bs b ""; - bs b "*)
\n}\n" - | Type_open -> - bs b "= .."; - bs b "" - ); - bs b "\n"; - self#html_of_info b t.ty_info; - bs b "\n" - - method html_of_class_kind b father ?cl kind = - match kind with - Class_structure (inh, eles) -> - self#html_of_text b [Code "{"]; - ( - match cl with - None -> - bs b "\n"; - ( - match inh with - [] -> () - | _ -> - self#generate_inheritance_info b inh - ); - List.iter (self#html_of_class_element b) eles; - | Some cl -> - let (html_file, _) = Naming.html_files cl.cl_name in - bp b " .. " html_file - ); - self#html_of_text b [Code "}"] - | _ -> html#html_of_class_kind b father ?cl kind - - - method html_of_class_type_kind b father ?ct kind = - match kind with - Class_signature (inh, eles) -> - self#html_of_text b [Code "{"]; - ( - match ct with - None -> - bs b "\n"; - ( - match inh with - [] -> () - | _ -> self#generate_inheritance_info b inh - ); - List.iter (self#html_of_class_element b) eles - | Some ct -> - let (html_file, _) = Naming.html_files ct.clt_name in - bp b " .. " html_file - ); - self#html_of_text b [Code "}"] - | _ -> html#html_of_class_type_kind b father ?ct kind - - end -end - -let _ = Odoc_args.set_generator - (Odoc_gen.Html (module Generator : Odoc_html.Html_generator)) - ;;*) diff --git a/src/refmt/dune b/src/refmt/dune index 1a532995b..33a273c96 100644 --- a/src/refmt/dune +++ b/src/refmt/dune @@ -2,4 +2,4 @@ (name refmt_impl) (public_name refmt) (package reason) - (libraries reason reason.cmdliner)) + (libraries reason reason.cmdliner reason_version)) diff --git a/src/refmt/refmt_impl.ml b/src/refmt/refmt_impl.ml index e8c257786..8b3403a9b 100644 --- a/src/refmt/refmt_impl.ml +++ b/src/refmt/refmt_impl.ml @@ -103,8 +103,7 @@ let refmt let top_level_info = let doc = "Reason's Parser & Pretty-printer" in let man = [`S "DESCRIPTION"; `P "refmt lets you format Reason files, parse them, and convert them between OCaml syntax and Reason syntax."] in -let version = "Reason " ^ Package.version ^ " @ " ^ Package.git_short_version - in + let version = "Reason " ^ Reason_version.package_version_string in Term.info "refmt" ~version ~doc ~man let refmt_t = From 9c9842a05373b56438105325b5d9155cc5f864e8 Mon Sep 17 00:00:00 2001 From: Jordan Date: Sun, 5 Jul 2020 18:43:29 -0700 Subject: [PATCH 2/3] Reason V4 [Stacked Diff 2/n #2599] [String Template Literals] Summary:This diff implements string template literals. Test Plan: Reviewers: CC: --- docs/TEMPLATE_LITERALS.md | 146 ++++++++++++++ .../expected_output/templateStrings.re | 190 ++++++++++++++++++ .../typeCheckedTests/input/templateStrings.re | 159 +++++++++++++++ src/reason-parser/dune | 2 +- src/reason-parser/reason_attributes.ml | 1 + .../reason_declarative_lexer.mll | 89 +++++++- src/reason-parser/reason_errors.ml | 3 + src/reason-parser/reason_errors.mli | 1 + src/reason-parser/reason_lexer.ml | 82 ++++++-- src/reason-parser/reason_location.ml | 2 +- src/reason-parser/reason_parser.mly | 63 +++++- src/reason-parser/reason_parser_explain.ml | 15 +- src/reason-parser/reason_pprint_ast.ml | 110 ++++++++-- src/reason-parser/reason_syntax_util.cppo.ml | 40 ++++ src/reason-parser/reason_syntax_util.cppo.mli | 8 + src/reason-parser/reason_template.ml | 97 +++++++++ src/reason-parser/reason_template.mli | 19 ++ src/reason-version/dune | 2 + 18 files changed, 980 insertions(+), 49 deletions(-) create mode 100644 docs/TEMPLATE_LITERALS.md create mode 100644 formatTest/typeCheckedTests/expected_output/templateStrings.re create mode 100644 formatTest/typeCheckedTests/input/templateStrings.re create mode 100644 src/reason-parser/reason_template.ml create mode 100644 src/reason-parser/reason_template.mli diff --git a/docs/TEMPLATE_LITERALS.md b/docs/TEMPLATE_LITERALS.md new file mode 100644 index 000000000..12134f5bf --- /dev/null +++ b/docs/TEMPLATE_LITERALS.md @@ -0,0 +1,146 @@ + +Contributors: Lexing and Parsing String Templates: +=================================================== +Supporting string templates requires coordination between the lexer, parser and +printer. The lexer (as always) creates a token stream, but when it encounters a +backtick, it begins a special parsing mode that collects the (mostly) raw text, +until either hitting a closing backtick, or a `${`. If it encounters the `${` +(called an "interpolation region"), it will temporarily resume the "regular" +lexing approach, instead of collecting the raw text - until it hits a balanced +`}`, upon which it will enter the "raw text" mode again until it hits the +closing backtick. + +- Parsing of raw text regions and regular tokenizing: Handled by + `reason_declarative_lexer.ml`. +- Token balancing: Handled by `reason_lexer.ml`. + +The output of lexing becomes tokens streamed into the parser, and the parser +`reason_parser.mly` turns those tokens into AST expressions. + +## Lexing: + +String templates are opened by: +- A backtick. +- Followed by any whitespace character (newline, or space/tab). + +- Any whitespace character (newline, or space/tab). +- Followed by a backtick + +```reason +let x = ` hi this is my string template ` +let x = ` +The newline counts as a whitespace character both for opening and closing. +` + +``` + +Within the string template literal, there may be regions of non-string +"interpolation" where expressions are lexed/parsed. + +```reason +let x = ` hi this is my ${expressionHere() ++ "!"} template ` +``` + +Template strings are lexed into tokens, some of those tokens contain a string +"payload" with portions of the string content. +The opening backtick, closing backtick, and `${` characters do not become a +token that is fed to the parser, and are not included in the text payload of +any token. The Right Brace `}` closing an interpolation region `${` _does_ +become a token that is fed to the parser. There are three tokens that are +produced when lexing string templates. + +- `STRING_TEMPLATE_TERMINATED(string)`: A string region that is terminated with + closing backtick. It may be the entire string template contents if there are + no interpolation regions `${}`, or it may be the final string segment after + an interpolation region `${}`, as long as it is the closing of the entire + template. +- `STRING_TEMPLATE_SEGMENT_LBRACE(string)`: A string region occuring _before_ + an interpolation region `${`. The `string` payload of this token is the + contents up until (but not including) the next `${`. +- `RBRACE`: A `}` character that terminates an interpolation region that + started with `${`. + +Simple example: + + STRING_TEMPLATE_TERMINATED + | | + ` lorem ipsum lorem ipsum bla ` + ^ ^ + | | + | The closing backtick also doesn't show up in the token + | stream, but the last white space is part of the lexed + | STRING_TEMPLATE_TERMINATED token + | (it is used to compute indentation, but is stripped from + | the string constant, or re-inserted in refmting if not present) + | + The backtick doesn't show up anywhere in the token stream. The first + single white space after backtick is also not part of the lexed tokens. + +Multiline example: + + All of this leading line whitespace remains parts of the tokens' payloads + but it is is normalized and stripped when the parser converts the tokens + into string expressions. + | + | This newline not part of any token + | | + | v + | ` + +-> lorem ipsum lorem + ipsum bla + ` + ^ + | + All of this white space on final line is part of the token as well. + + +For interpolation, the token `STRING_TEMPLATE_SEGMENT_LBRACE` represents the +string contents (minus any single/first white space after backtick), up to the +`${`. As with non-interpolated string templates, the opening and closing +backtick does not show up in the token stream, the first white space character +after opening backtick is not included in the lexed string contents, the final +white space character before closing backtick *is* part of the lexed string +token (to compute indentation), but that final white space character, along +with leading line whitespace is stripped from the string expression when the +parsing stage converts from lexed tokens to AST string expressions. + + ` lorem ipsum lorem ipsum bla${expression}lorem ipsum lorem ip lorem` + | | || | + STRING_TEMPLATE_TERMINATED |STRING_TEMPLATE_TERMINATED + RBRACE +## Parsing: + +The string template tokens are turned into normal AST expressions. +`STRING_TEMPLATE_SEGMENT_LBRACE` and `STRING_TEMPLATE_TERMINATED` lexed tokens +contains all of the string contents, plus leading line whitespace for each +line, including the final whitespace before the closing backtick. These are +normalized in the parser by stripping that leading whitespace including two +additional spaces for nice indentation, before turning them into some +combination of string contants with a special attribute on the AST, or string +concats with a special attribute on the concat AST node. + +```reason + +// This: +let x = ` + Hello there +`; +// Becomes: +let x = [@reason.template] "Hello there"; + +// This: +let x = ` + ${expr} Hello there +`; +// Becomes: +let x = [@reason.template] (expr ++ [@reason.template] "Hello there"); + +``` + +User Documentation: +=================== +> This section is the user documentation for string template literals, which +> will be published to the [official Reason Syntax +> documentation](https://reasonml.github.io/) when + +TODO diff --git a/formatTest/typeCheckedTests/expected_output/templateStrings.re b/formatTest/typeCheckedTests/expected_output/templateStrings.re new file mode 100644 index 000000000..39ba021d1 --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/templateStrings.re @@ -0,0 +1,190 @@ +[@reason.version 3.7]; +/** + * Comments: + */ + +let addTwo = (a, b) => string_of_int(a + b); +let singleLineConstant = ` + Single line template +`; +let singleLineInterpolate = ` + Single line ${addTwo(1, 2)}! +`; + +let multiLineConstant = ` + Multi line template + Multi %a{x, y}line template + Multi line template + Multi line template +`; + +let printTwo = (a, b) => { + print_string(a); + print_string(b); +}; + +let templteWithAttribute = + [@attrHere] + ` + Passing line template + Passing line template + Passing line template + Passing line template + `; + +let result = + print_string( + ` + Passing line template + Passing line template + Passing line template + Passing line template + `, + ); + +let resultPrintTwo = + printTwo( + "short one", + ` + Passing line template + Passing line template + Passing line template + Passing line template + `, + ); + +let hasBackSlashes = ` + One not escaped: \ + Three not escaped: \ \ \ + Two not escaped: \\ + Two not escaped: \\\ + One not escaped slash, and one escaped tick: \\` + Two not escaped slashes, and one escaped tick: \\\` + Two not escaped slashes, and one escaped dollar-brace: \\\${ + One not escaped slash, then a close tick: \ +`; + +let singleLineInterpolateWithEscapeTick = ` + Single \`line ${addTwo(1, 2)}! +`; + +let singleLineConstantWithEscapeDollar = ` + Single \${line template +`; + +// The backslash here is a backslash literal. +let singleLineInterpolateWithBackslashThenDollar = ` + Single \$line ${addTwo(2, 3)}! +`; + +let beforeExpressionCommentInNonLetty = ` + Before expression comment in non-letty interpolation: + ${/* Comment */ string_of_int(1 + 2)} +`; + +let beforeExpressionCommentInNonLetty2 = ` + Same thing but with comment on own line: + ${ + /* Comment */ + string_of_int(10 + 8) + } +`; +module StringIndentationWorksInModuleIndentation = { + let beforeExpressionCommentInNonLetty2 = ` + Same thing but with comment on own line: + ${ + /* Comment */ + string_of_int(10 + 8) + } + `; +}; + +let beforeExpressionCommentInNonLetty3 = ` + Same thing but with text after final brace on same line: + ${ + /* Comment */ + string_of_int(20 + 1000) + }TextAfterBrace +`; + +let beforeExpressionCommentInNonLetty3 = ` + Same thing but with text after final brace on next line: + ${ + /* Comment */ + string_of_int(100) + } + TextAfterBrace +`; + +let x = 0; +let commentInLetSequence = ` + Comment in letty interpolation: + ${ + /* Comment */ + let x = 200 + 49; + string_of_int(x); + } +`; + +let commentInLetSequence2 = ` + Same but with text after final brace on same line: + ${ + /* Comment */ + let x = 200 + 49; + string_of_int(x); + }TextAfterBrace +`; + +let commentInLetSequence3 = ` + Same but with text after final brace on next line: + ${ + /* Comment */ + let x = 200 + 49; + string_of_int(x); + } + TextAfterBrace +`; + +let reallyCompicatedNested = ` + Comment in non-letty interpolation: + + ${ + /* Comment on first line of interpolation region */ + + let y = (a, b) => a + b; + let x = 0 + y(0, 2); + // Nested string templates + let s = ` + asdf${addTwo(0, 0)} + alskdjflakdsjf + `; + s ++ s; + }same line as brace with one space + and some more text at the footer no newline +`; + +let reallyLongIdent = "!"; +let backToBackInterpolations = ` + Two interpolations side by side: + ${addTwo(0, 0)}${addTwo(0, 0)} + Two interpolations side by side with leading and trailing: + Before${addTwo(0, 0)}${addTwo(0, 0)}After + + Two interpolations side by side second one should break: + Before${addTwo(0, 0)}${ + reallyLongIdent + ++ reallyLongIdent + ++ reallyLongIdent + ++ reallyLongIdent + }After + + Three interpolations side by side: + Before${addTwo(0, 0)}${ + reallyLongIdent + ++ reallyLongIdent + ++ reallyLongIdent + ++ reallyLongIdent + }${ + "" + }After +`; diff --git a/formatTest/typeCheckedTests/input/templateStrings.re b/formatTest/typeCheckedTests/input/templateStrings.re new file mode 100644 index 000000000..f036df30e --- /dev/null +++ b/formatTest/typeCheckedTests/input/templateStrings.re @@ -0,0 +1,159 @@ +/** + * Comments: + */ + + +let addTwo = (a, b) => string_of_int(a + b); +let singleLineConstant = ` Single line template `; +let singleLineInterpolate = ` Single line ${addTwo(1, 2)} ! `; + +let multiLineConstant = ` + Multi line template + Multi %a{x, y}line template + Multi line template + Multi line template +`; + +let printTwo = (a, b) => { + print_string(a) + print_string(b) +}; + +let templteWithAttribute = [@attrHere] ` + Passing line template + Passing line template + Passing line template + Passing line template +`; + + +let result = print_string(` + Passing line template + Passing line template + Passing line template + Passing line template +`); + +let resultPrintTwo = printTwo("short one", ` + Passing line template + Passing line template + Passing line template + Passing line template +`); + +let hasBackSlashes = ` + One not escaped: \ + Three not escaped: \ \ \ + Two not escaped: \\ + Two not escaped: \\\ + One not escaped slash, and one escaped tick: \\` + Two not escaped slashes, and one escaped tick: \\\` + Two not escaped slashes, and one escaped dollar-brace: \\\${ + One not escaped slash, then a close tick: \ `; + +let singleLineInterpolateWithEscapeTick = ` Single \`line ${addTwo(1, 2)} ! `; + +let singleLineConstantWithEscapeDollar = ` Single \${line template `; + +// The backslash here is a backslash literal. +let singleLineInterpolateWithBackslashThenDollar = ` Single \$line ${addTwo(2, 3)} ! `; + +let beforeExpressionCommentInNonLetty = ` + Before expression comment in non-letty interpolation: + ${/* Comment */ string_of_int(1 + 2)} +`; + +let beforeExpressionCommentInNonLetty2 = ` + Same thing but with comment on own line: + ${ + /* Comment */ + string_of_int(10 + 8) + } +`; +module StringIndentationWorksInModuleIndentation = { + let beforeExpressionCommentInNonLetty2 = ` + Same thing but with comment on own line: + ${ + /* Comment */ + string_of_int(10 + 8) + } + `; +}; + +let beforeExpressionCommentInNonLetty3 = ` + Same thing but with text after final brace on same line: + ${ + /* Comment */ + string_of_int(20 + 1000) + }TextAfterBrace +`; + +let beforeExpressionCommentInNonLetty3 = ` + Same thing but with text after final brace on next line: + ${ + /* Comment */ + string_of_int(100) + } + TextAfterBrace +`; + +let x = 0; +let commentInLetSequence = ` + Comment in letty interpolation: + ${ + /* Comment */ + let x = 200 + 49; + string_of_int(x); + } +`; + +let commentInLetSequence2 = ` + Same but with text after final brace on same line: + ${ + /* Comment */ + let x = 200 + 49; + string_of_int(x); + }TextAfterBrace +`; + +let commentInLetSequence3 = ` + Same but with text after final brace on next line: + ${ + /* Comment */ + let x = 200 + 49; + string_of_int(x); + } + TextAfterBrace +`; + +let reallyCompicatedNested = ` + Comment in non-letty interpolation: + + ${ + /* Comment on first line of interpolation region */ + + let y = (a, b) => a + b; + let x = 0 + y(0, 2); + // Nested string templates + let s = ` + asdf${addTwo(0, 0)} + alskdjflakdsjf + `; + s ++ s + } same line as brace with one space + and some more text at the footer no newline +`; + +let reallyLongIdent = "!"; +let backToBackInterpolations = ` + Two interpolations side by side: + ${addTwo(0, 0)}${addTwo(0, 0)} + Two interpolations side by side with leading and trailing: + Before${addTwo(0, 0)}${addTwo(0, 0)}After + + Two interpolations side by side second one should break: + Before${addTwo(0, 0)}${reallyLongIdent ++ reallyLongIdent ++ reallyLongIdent ++ reallyLongIdent}After + + Three interpolations side by side: + Before${addTwo(0, 0)}${reallyLongIdent ++ reallyLongIdent ++ reallyLongIdent ++ reallyLongIdent}${""}After +`; diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 7f8d72aaa..1d0897e86 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -96,5 +96,5 @@ reason_parser reason_single_parser reason_multi_parser merlin_recovery reason_recover_parser reason_declarative_lexer reason_lexer reason_oprint reason_parser_explain_raw reason_parser_explain reason_parser_recover - reason_string) + reason_template reason_string) (libraries reason.ocaml-migrate-parsetree menhirLib reason.easy_format reason.version)) diff --git a/src/reason-parser/reason_attributes.ml b/src/reason-parser/reason_attributes.ml index 5faa22323..f695a3b7a 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -19,6 +19,7 @@ let is_stylistic_attr = function * affect printing *) | { attr_name = {txt="ocaml.ppwarn"}; _} | { attr_name = {txt="reason.preserve_braces"}; _} -> true + | { attr_name = {txt="reason.template"}; _} -> true | _ -> false diff --git a/src/reason-parser/reason_declarative_lexer.mll b/src/reason-parser/reason_declarative_lexer.mll index e144191c7..bd135b1e7 100644 --- a/src/reason-parser/reason_declarative_lexer.mll +++ b/src/reason-parser/reason_declarative_lexer.mll @@ -45,8 +45,8 @@ * *) -(* This is the Reason lexer. As stated in src/README, there's a good section in - Real World OCaml that describes what a lexer is: +(* This is the Reason lexer. As stated in docs/GETTING_STARTED_CONTRIBUTING.md + * there's a good section in Real World OCaml that describes what a lexer is: https://realworldocaml.org/v1/en/html/parsing-with-ocamllex-and-menhir.html @@ -154,6 +154,11 @@ type state = { txt_buffer : Buffer.t; } +type string_template_parse_result = + | TemplateTerminated + | TemplateNotTerminated + | TemplateInterpolationMarker + let get_scratch_buffers { raw_buffer; txt_buffer } = Buffer.reset raw_buffer; Buffer.reset txt_buffer; @@ -376,6 +381,15 @@ rule token state = parse try Hashtbl.find keyword_table s with Not_found -> LIDENT s } + | "`" (lowercase | uppercase) identchar * + { let s = Lexing.lexeme lexbuf in + let word = String.sub s 1 (String.length s - 1) in + match Hashtbl.find keyword_table word with + | exception Not_found -> NAMETAG word + | _ -> + raise_error (Location.curr lexbuf) (Keyword_as_tag word); + LIDENT "thisIsABugReportThis" + } | lowercase_latin1 identchar_latin1 * { Ocaml_util.warn_latin1 lexbuf; LIDENT (Lexing.lexeme lexbuf) } | uppercase identchar * @@ -423,6 +437,17 @@ rule token state = parse let txt = flush_buffer raw_buffer in STRING (txt, None, Some delim) } + | "`" newline + { + (* Need to update the location in the case of newline so line counts are + * correct *) + update_loc lexbuf None 1 false 0; + token_in_template_string_region state lexbuf + } + | "`" (' ' | '\t') + { + token_in_template_string_region state lexbuf + } | "'" newline "'" { (* newline can span multiple characters (if the newline starts with \13) @@ -460,7 +485,6 @@ rule token state = parse } | "&" { AMPERSAND } | "&&" { AMPERAMPER } - | "`" { BACKQUOTE } | "'" { QUOTE } | "(" { LPAREN } | ")" { RPAREN } @@ -775,6 +799,7 @@ and comment buffer firstloc nestedloc = parse { store_lexeme buffer lexbuf; comment buffer firstloc nestedloc lexbuf } + | "'" newline "'" { store_lexeme buffer lexbuf; update_loc lexbuf None 1 false 1; @@ -912,6 +937,64 @@ and quoted_string buffer delim = parse quoted_string buffer delim lexbuf } +and template_string_region buffer = parse + | newline + { store_lexeme buffer lexbuf; + update_loc lexbuf None 1 false 0; + template_string_region buffer lexbuf + } + | eof + { TemplateNotTerminated } + | "`" + { + TemplateTerminated + } + | "${" + { + (* set_lexeme_length lexbuf 1; *) + TemplateInterpolationMarker + } + | '\\' '`' + { + Buffer.add_char buffer '`'; + template_string_region buffer lexbuf + } + | '\\' '$' '{' + { + Buffer.add_char buffer '$'; + Buffer.add_char buffer '{'; + template_string_region buffer lexbuf + } + | _ as c + { + Buffer.add_char buffer c; + template_string_region buffer lexbuf + } + + +and token_in_template_string_region state = parse + | _ + { + (* Unparse it, now go run the template string parser with a buffer *) + set_lexeme_length lexbuf 0; + let string_start = lexbuf.lex_start_p in + let start_loc = Location.curr lexbuf in + let raw_buffer, _ = get_scratch_buffers state in + match template_string_region raw_buffer lexbuf with + | TemplateNotTerminated -> raise_error start_loc Unterminated_string; + STRING_TEMPLATE_TERMINATED + "This should never be happen. If you see this string anywhere, file a bug to the Reason repo." + | TemplateTerminated -> + lexbuf.lex_start_p <- string_start; + let txt = flush_buffer raw_buffer in + STRING_TEMPLATE_TERMINATED txt + | TemplateInterpolationMarker -> + lexbuf.lex_start_p <- string_start; + let txt = flush_buffer raw_buffer in + STRING_TEMPLATE_SEGMENT_LBRACE txt + } + + and skip_sharp_bang = parse | "#!" [^ '\n']* '\n' [^ '\n']* "\n!#\n" { update_loc lexbuf None 3 false 0 } diff --git a/src/reason-parser/reason_errors.ml b/src/reason-parser/reason_errors.ml index b166d5ba8..4c6e46fdf 100644 --- a/src/reason-parser/reason_errors.ml +++ b/src/reason-parser/reason_errors.ml @@ -19,6 +19,7 @@ type lexing_error = | Unterminated_string | Unterminated_string_in_comment of Location.t * Location.t | Keyword_as_label of string + | Keyword_as_tag of string | Literal_overflow of string | Invalid_literal of string @@ -78,6 +79,8 @@ let format_lexing_error ppf = function Ocaml_util.print_loc loc | Keyword_as_label kwd -> fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd + | Keyword_as_tag kwd -> + fprintf ppf "`%s' is a keyword, it cannot be used as tag name" kwd | Literal_overflow ty -> fprintf ppf "Integer literal exceeds the range of representable \ integers of type %s" ty diff --git a/src/reason-parser/reason_errors.mli b/src/reason-parser/reason_errors.mli index c33a6fff8..e9dfe87b0 100644 --- a/src/reason-parser/reason_errors.mli +++ b/src/reason-parser/reason_errors.mli @@ -17,6 +17,7 @@ type lexing_error = | Unterminated_string | Unterminated_string_in_comment of Location.t * Location.t | Keyword_as_label of string + | Keyword_as_tag of string | Literal_overflow of string | Invalid_literal of string diff --git a/src/reason-parser/reason_lexer.ml b/src/reason-parser/reason_lexer.ml index f68831c02..c8f3e1a0d 100644 --- a/src/reason-parser/reason_lexer.ml +++ b/src/reason-parser/reason_lexer.ml @@ -31,16 +31,23 @@ let init ?insert_completion_ident lexbuf = let lexbuf state = state.lexbuf -let rec token state = - match - Reason_declarative_lexer.token - state.declarative_lexer_state state.lexbuf + +let rec comment_capturing_tokenizer tokenizer = + fun state -> + match tokenizer state.declarative_lexer_state state.lexbuf with | COMMENT (s, comment_loc) -> state.comments <- (s, comment_loc) :: state.comments; - token state + comment_capturing_tokenizer tokenizer state | tok -> tok +let token a = (comment_capturing_tokenizer Reason_declarative_lexer.token) a + +let token_after_interpolation_region state = + Reason_declarative_lexer.token_in_template_string_region + state.declarative_lexer_state + state.lexbuf + (* Routines for manipulating lexer state *) let save_triple lexbuf tok = @@ -56,6 +63,25 @@ exception Lex_balanced_failed of token positioned list * exn option let closing_of = function | LPAREN -> RPAREN | LBRACE -> RBRACE + | LBRACKET + | LBRACKETLESS + | LBRACKETGREATER + | LBRACKETAT + | LBRACKETPERCENT + | LBRACKETPERCENTPERCENT -> RBRACKET + | STRING_TEMPLATE_SEGMENT_LBRACE _ -> RBRACE + | _ -> assert false + +let continuer_after_closing = function + | LBRACKET + | LBRACKETLESS + | LBRACKETGREATER + | LBRACKETAT + | LBRACKETPERCENT + | LBRACKETPERCENTPERCENT + | LPAREN + | LBRACE -> fun a -> token a + | STRING_TEMPLATE_SEGMENT_LBRACE _ -> fun a-> token_after_interpolation_region a | _ -> assert false let inject_es6_fun = function @@ -77,17 +103,16 @@ let rec lex_balanced_step state closing acc tok = raise (Lex_balanced_failed (acc, None)) | (( LBRACKET | LBRACKETLESS | LBRACKETGREATER | LBRACKETAT - | LBRACKETPERCENT | LBRACKETPERCENTPERCENT ), _) -> - lex_balanced state closing (lex_balanced state RBRACKET acc) - | ((LPAREN | LBRACE), _) -> + | LBRACKETPERCENT | LBRACKETPERCENTPERCENT ) as l, _) -> + lex_balanced state closing (lex_balanced state (closing_of l) acc) + | ((LPAREN | LBRACE | STRING_TEMPLATE_SEGMENT_LBRACE _), _) -> let rparen = try lex_balanced state (closing_of tok) [] with (Lex_balanced_failed (rparen, None)) -> raise (Lex_balanced_failed (rparen @ acc, None)) in - begin match token state with - | exception exn -> - raise (Lex_balanced_failed (rparen @ acc, Some exn)) + begin match (continuer_after_closing tok) state with + | exception exn -> raise (Lex_balanced_failed (rparen @ acc, Some exn)) | tok' -> let acc = if is_triggering_token tok' then inject_es6_fun acc else acc in lex_balanced_step state closing (rparen @ acc) tok' @@ -118,8 +143,7 @@ let rec lex_balanced_step state closing acc tok = and lex_balanced state closing acc = match token state with - | exception exn -> - raise (Lex_balanced_failed (acc, Some exn)) + | exception exn -> raise (Lex_balanced_failed (acc, Some exn)) | tok -> lex_balanced_step state closing acc tok let lookahead_esfun state (tok, _, _ as lparen) = @@ -145,6 +169,25 @@ let lookahead_esfun state (tok, _, _ as lparen) = ) end +let rec lookahead_in_template_string_interpolation state (tok, _, _ as lparen) = + match lex_balanced state (closing_of tok) [] with + | exception (Lex_balanced_failed (tokens, exn)) -> + state.queued_tokens <- List.rev tokens; + state.queued_exn <- exn; + lparen + | tokens -> + (* tokens' head will be the RBRACE *) + (* Change the below to parse "remaining template string" entrypoint *) + begin match token_after_interpolation_region state with + | exception exn -> + state.queued_tokens <- List.rev tokens; + state.queued_exn <- Some exn; + lparen + | token -> + state.queued_tokens <- List.rev (save_triple state.lexbuf token :: tokens); + lparen + end + let token state = let lexbuf = state.lexbuf in match state.queued_tokens, state.queued_exn with @@ -155,8 +198,12 @@ let token state = lookahead_esfun state lparen | [(LBRACE, _, _) as lparen], None -> lookahead_esfun state lparen + | [(STRING_TEMPLATE_SEGMENT_LBRACE s, _, _) as template_seg], None -> + lookahead_in_template_string_interpolation state template_seg | [], None -> begin match token state with + | (STRING_TEMPLATE_SEGMENT_LBRACE _) as tok -> + lookahead_in_template_string_interpolation state (save_triple state.lexbuf tok) | LPAREN | LBRACE as tok -> lookahead_esfun state (save_triple state.lexbuf tok) | (LIDENT _ | UNDERSCORE) as tok -> @@ -166,10 +213,17 @@ let token state = state.queued_exn <- Some exn; tok | tok' -> + (* On finding an identifier or underscore in expression position, if + * the next token is "triggering" =>/:, then only return a + * ficticious (fake_triple) ES6_FUN marker, but queue up both the + * identifier tok as well as whatever was "triggering" into + * queued_tokens *) if is_triggering_token tok' then ( state.queued_tokens <- [tok; save_triple lexbuf tok']; fake_triple ES6_FUN tok ) else ( + (* Otherwise return the identifier token, but queue up the token + * that didn't "trigger" *) state.queued_tokens <- [save_triple lexbuf tok']; tok ) @@ -179,7 +233,9 @@ let token state = | x :: xs, _ -> state.queued_tokens <- xs; x +(* Tokenize with support for IDE completion *) let token state = + (* The _last_ token's end position *) let space_start = state.last_cnum in let (token', start_p, curr_p) as token = token state in let token_start = start_p.Lexing.pos_cnum in diff --git a/src/reason-parser/reason_location.ml b/src/reason-parser/reason_location.ml index 809d3096d..528daaeec 100644 --- a/src/reason-parser/reason_location.ml +++ b/src/reason-parser/reason_location.ml @@ -8,7 +8,7 @@ module Range = struct lnum_end: int } - (** + (* * make a range delimited by [loc1] and [loc2] * 1| let a = 1; * 2| diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 68d46bf55..c8b66b8f7 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -173,6 +173,9 @@ let make_ghost_loc loc = { let ghloc ?(loc=dummy_loc ()) d = { txt = d; loc = (make_ghost_loc loc) } +let reloc_expr exp startpos endpos = + {exp with pexp_loc = {exp.pexp_loc with loc_start = startpos; loc_end = endpos}} + (** * turn an object into a real *) @@ -309,11 +312,11 @@ let mkoperator {Location. txt; loc} = let ghunit ?(loc=dummy_loc ()) () = mkexp ~ghost:true ~loc (Pexp_construct (mknoloc (Lident "()"), None)) -let mkinfixop arg1 op arg2 = - mkexp(Pexp_apply(op, [Nolabel, arg1; Nolabel, arg2])) +let mkinfixop ?loc ?attrs arg1 op arg2 = + mkexp ?loc ?attrs (Pexp_apply(op, [Nolabel, arg1; Nolabel, arg2])) -let mkinfix arg1 name arg2 = - mkinfixop arg1 (mkoperator name) arg2 +let mkinfix ?loc ?attrs arg1 name arg2 = + mkinfixop ?loc ?attrs arg1 (mkoperator name) arg2 let neg_string f = if String.length f > 0 && f.[0] = '-' @@ -1100,6 +1103,7 @@ let add_brace_attr expr = %token AS %token ASSERT %token BACKQUOTE +%token NAMETAG [@recover.expr ""] [@recover.cost 2] %token BANG %token BAR %token BARBAR @@ -1210,6 +1214,12 @@ let add_brace_attr expr = %token STAR %token STRING [@recover.expr ("", None, None)] [@recover.cost 2] + +%token STRING_TEMPLATE_TERMINATED + [@recover.expr ("")] [@recover.cost 2] +%token STRING_TEMPLATE_SEGMENT_LBRACE + [@recover.expr ("")] [@recover.cost 2] + %token STRUCT %token THEN %token TILDE @@ -3009,6 +3019,11 @@ parenthesized_expr: *) %inline simple_expr_template(E): | as_loc(val_longident) { mkexp (Pexp_ident $1) } + | template_string + { + let (_indent, expr) = $1 in + expr + } | constant { let attrs, cst = $1 in mkexp ~attrs (Pexp_constant cst) } | jsx { $1 } @@ -4649,6 +4664,44 @@ constant: } ; +(* + * Important: Read docs/TEMPLATE_LITERALS.md to understand this. + * TODO: In STRING_TEMPLATE_TERMINATED case, detect empty string and return a + * None. + *) +template_string: + | STRING_TEMPLATE_TERMINATED { + let split_by_newlines = Reason_syntax_util.split_by_newline ~keep_empty:true $1 in + let revLines = List.rev split_by_newlines in + let (indent, revLines) = + Reason_template.Parse.normalize_or_remove_last_line revLines in + let txt = + Reason_template.Parse.strip_leading_for_non_last ~indent "" revLines in + ( indent, + Ast_helper.Exp.constant (Pconst_string (txt, Some "reason.template"))) + } + | STRING_TEMPLATE_SEGMENT_LBRACE seq_expr RBRACE template_string + { + let indent, tmplt = $4 in + let op1 = mkloc "++" (mklocation $endpos($1) $startpos($2)) in + let op2 = mkloc "++" (mklocation $startpos($3) $startpos($4)) in + (* Right associative, unlike the future ++ will be parsed in next breaking + * change. We will keep this right assoc though to make it easy to print *) + let attrs = simple_ghost_text_attr "reason.template" in + let seq_expr = reloc_expr $2 $endpos($1) $startpos($3) in + if String.length $1 == 0 then + (indent, mkinfix ~attrs seq_expr op2 tmplt) + else + let split_by_newlines = Reason_syntax_util.split_by_newline ~keep_empty:true $1 in + let revLines = List.rev split_by_newlines in + let txt = + Reason_template.Parse.strip_leading_for_non_last ~indent "" revLines in + let left = (Ast_helper.Exp.constant (Pconst_string (txt, None))) in + (indent, mkinfix ~attrs left op1 (mkinfix ~attrs seq_expr op2 tmplt)) + (* TODO: Perform the string concat or printf depending *) + } +; + signed_constant: | constant { $1 } | MINUS INT { let (n, m) = $2 in ([], Pconst_integer("-" ^ n, m)) } @@ -4849,7 +4902,7 @@ toplevel_directive: opt_LET_MODULE: MODULE { () } | LET MODULE { () }; -%inline name_tag: BACKQUOTE ident { $2 }; +%inline name_tag: NAMETAG { $1 }; %inline label: LIDENT { $1 }; diff --git a/src/reason-parser/reason_parser_explain.ml b/src/reason-parser/reason_parser_explain.ml index b3f25024c..9944db575 100644 --- a/src/reason-parser/reason_parser_explain.ml +++ b/src/reason-parser/reason_parser_explain.ml @@ -84,15 +84,15 @@ let unclosed_parenthesis is_opening_symbol closing_symbol check_function env = None let check_unclosed env = - let check (message, opening_symbols, closing_symbol, check_function) = + let check (message, open_msg, opening_symbols, closing_symbol, check_function) = match unclosed_parenthesis (fun x -> List.mem x opening_symbols) closing_symbol check_function env with | None -> None | Some (loc_start, _) -> - Some (Format.asprintf "Unclosed %S (opened line %d, column %d)" - message loc_start.pos_lnum + Some (Format.asprintf "Unclosed %S (%s on line %d, column %d)" + message open_msg loc_start.pos_lnum (loc_start.pos_cnum - loc_start.pos_bol)) in let rec check_list = function @@ -103,13 +103,16 @@ let check_unclosed env = | Some result -> result in check_list [ - ("(", Interp.[X (T T_LPAREN)], + ("${", "for string region beginning ", Interp.[X (T T_STRING_TEMPLATE_SEGMENT_LBRACE)], + Interp.X (T T_RBRACE), + Raw.transitions_on_rbrace); + ("(", "opened", Interp.[X (T T_LPAREN)], Interp.X (T T_RPAREN), Raw.transitions_on_rparen); - ("{", Interp.[X (T T_LBRACE); X (T T_LBRACELESS)], + ("{", "opened", Interp.[X (T T_LBRACE); X (T T_LBRACELESS)], Interp.X (T T_RBRACE), Raw.transitions_on_rbrace); - ("[", Interp.[ X (T T_LBRACKET); X (T T_LBRACKETAT); + ("[", "opened", Interp.[ X (T T_LBRACKET); X (T T_LBRACKETAT); X (T T_LBRACKETBAR); X (T T_LBRACKETGREATER); X (T T_LBRACKETLESS); X (T T_LBRACKETPERCENT); X (T T_LBRACKETPERCENTPERCENT); ], diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 4fa2241b0..d62a1fd36 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -1194,21 +1194,13 @@ let rec beginsWithStar_ line length idx = let beginsWithStar line = beginsWithStar_ line (String.length line) 0 -let rec numLeadingSpace_ line length idx accum = - if idx = length then accum else - match String.get line idx with - | '\t' | ' ' -> numLeadingSpace_ line length (idx + 1) (accum + 1) - | _ -> accum - -let numLeadingSpace line = numLeadingSpace_ line (String.length line) 0 0 - (* Computes the smallest leading spaces for non-empty lines *) let smallestLeadingSpaces strs = let rec smallestLeadingSpaces curMin strs = match strs with | [] -> curMin | ""::tl -> smallestLeadingSpaces curMin tl | hd::tl -> - let leadingSpace = numLeadingSpace hd in + let leadingSpace = Reason_syntax_util.num_leading_space hd in let nextMin = min curMin leadingSpace in smallestLeadingSpaces nextMin tl in @@ -1269,7 +1261,7 @@ let formatComment_ txt = | Some num -> num + 1 in let padNonOpeningLine s = - let numLeadingSpaceForThisLine = numLeadingSpace s in + let numLeadingSpaceForThisLine = Reason_syntax_util.num_leading_space s in if String.length s == 0 then "" else (String.make leftPad ' ') ^ (string_after s (min attemptRemoveCount numLeadingSpaceForThisLine)) in @@ -1852,7 +1844,7 @@ let semiTerminated term = makeList [term; atom ";"] (* postSpace is so that when comments are interleaved, we still use spacing rules. *) let makeLetSequence ?(wrap=("{", "}")) letItems = makeList - ~break:Always_rec + ~break:Layout.Always_rec ~inline:(true, false) ~wrap ~postSpace:true @@ -1896,6 +1888,60 @@ let formatAttributed ?(labelBreak=`Auto) x y = (makeList ~inline:(true, true) ~postSpace:true y) x + +(** Utility for creating several lines (in reverse order) where each line is of + * the form lbl(a, lbl(b, lbl(c ...) and the line never breaks unless the a, b, + * c were to break. + * + * This is useful for printing string interpolation syntax, but may be useful + * for many other things. + * TODO: Put this in its own module when we can refactor. + *) +module Reason_template_layout = struct + let labelLinesBreakRight ?(flushLine=false) revLines itm = + match flushLine, revLines with + | false, last_ln :: firsts -> + label ~break:`Never last_ln itm :: firsts + | _, [] + | true, _ -> itm :: revLines + + let lets ~wrap loc let_list = + if List.length let_list > 1 then source_map ~loc (makeLetSequence ~wrap let_list) + else source_map ~loc (makeList ~break:IfNeed ~wrap let_list) + + let rec append_lines ?(flushLine=false) acc lines = + match lines with + | [] -> acc + | hd :: tl -> append_lines ~flushLine:true (labelLinesBreakRight ~flushLine acc (atom hd)) tl + + let append_lines acc txt = + let escapedString = Reason_template.Print.escape_string_template txt in + let next_lines = Reason_syntax_util.split_by_newline ~keep_empty:true escapedString in + append_lines acc next_lines + + let rec format_simple_string_template_string_concat letListMaker acc e1 e2 = ( + match e1.pexp_attributes, e1.pexp_desc with + | [], Pexp_constant(Pconst_string (s, (None | Some("reason.template")))) -> + format_simple_string_template letListMaker (append_lines acc s) e2 + | _ -> + format_simple_string_template letListMaker ( + labelLinesBreakRight acc (lets e1.pexp_loc ~wrap:("${", "}") (letListMaker e1)) + ) e2 + ) + and format_simple_string_template letListMaker acc x = ( + let {stdAttrs; jsxAttrs; stylisticAttrs} = partitionAttributes x.pexp_attributes in + match (x.pexp_desc) with + | Pexp_constant(Pconst_string (s, (None | Some("reason.template")))) -> append_lines acc s + | ( + Pexp_apply ({pexp_desc=Pexp_ident ({txt = Longident.Lident("++")})}, [(Nolabel, e1); (Nolabel, e2)]) + ) when Reason_template.Print.is_template_style stylisticAttrs -> + format_simple_string_template_string_concat letListMaker acc e1 e2 + | _ -> + labelLinesBreakRight acc (lets x.pexp_loc ~wrap:("${", "}") (letListMaker x)) + ) +end + + (* For when the type constraint should be treated as a separate breakable line item itself not docked to some value/pattern label. fun x @@ -1915,7 +1961,6 @@ let formatCoerce expr optType coerced = | Some typ -> label ~space:true (makeList ~postSpace:true [formatTypeConstraint expr typ; atom ":>"]) coerced - (* Standard function application style indentation - no special wrapping * behavior. * @@ -2022,11 +2067,21 @@ let constant_string_for_primitive ppf s = let tyvar ppf str = Format.fprintf ppf "'%s" str +(* Constant string template that has no interpolation *) +let constant_string_template s = + let next_lines = Reason_syntax_util.split_by_newline ~keep_empty:true s in + let at_least_two = match next_lines with _ :: _ :: _ -> true | _ -> false in + makeList + ~wrap:("`", "`") + ~pad:(true, true) + ~break:(if at_least_two then Always_rec else IfNeed) + (List.map (fun s -> atom(Reason_template.Print.escape_string_template s)) next_lines) + (* In some places parens shouldn't be printed for readability: * e.g. Some((-1)) should be printed as Some(-1) * In `1 + (-1)` -1 should be wrapped in parens for readability *) -let constant ?raw_literal ?(parens=true) ppf = function +let single_token_constant ?raw_literal ?(parens=true) ppf = function | Pconst_char i -> Format.fprintf ppf "%C" i | Pconst_string (i, None) -> @@ -2036,6 +2091,9 @@ let constant ?raw_literal ?(parens=true) ppf = function | None -> Format.fprintf ppf "\"%s\"" (Reason_syntax_util.escape_string i) end + (* Ideally, this branch should never even be hit *) + | Pconst_string (i, Some "reason.template") -> + Format.fprintf ppf "` %s `" (Reason_template.Print.escape_string_template i) | Pconst_string (i, Some delim) -> Format.fprintf ppf "{%s|%s|%s}" delim i delim | Pconst_integer (i, None) -> @@ -2445,8 +2503,12 @@ let printer = object(self:'self) method longident_loc (x:Longident.t Location.loc) = source_map ~loc:x.loc (self#longident x.txt) - method constant ?raw_literal ?(parens=true) = - wrap (constant ?raw_literal ~parens) + method constant ?raw_literal ?(parens=true) c = + match c with + (* The one that isn't a "single token" *) + | Pconst_string (s, Some "reason.template") -> constant_string_template s + (* Single token constants *) + | _ -> ensureSingleTokenSticksToLabel (wrap (single_token_constant ?raw_literal ~parens) c) method constant_string_for_primitive = wrap constant_string_for_primitive method tyvar = wrap tyvar @@ -3504,11 +3566,20 @@ let printer = object(self:'self) e2; atom cls; ] - - method simple_get_application x = - let {stdAttrs; jsxAttrs} = partitionAttributes x.pexp_attributes in + let {stdAttrs; jsxAttrs; stylisticAttrs} = partitionAttributes x.pexp_attributes in match (x.pexp_desc, stdAttrs, jsxAttrs) with + | ( + Pexp_apply ({pexp_desc=Pexp_ident ({txt = Longident.Lident("++")})}, [(Nolabel, e1); (Nolabel, e2)]), + [], + [] + ) when Reason_template.Print.is_template_style stylisticAttrs -> + let revAllLines = + Reason_template_layout.format_simple_string_template_string_concat self#letList [] e1 e2 in + Some( + source_map ~loc:x.pexp_loc + (makeList ~pad:(true, true) ~wrap:("`", "`") ~break:Always_rec (List.rev (revAllLines))) + ) | (_, _::_, []) -> None (* Has some printed attributes - not simple *) | (Pexp_apply ({pexp_desc=Pexp_ident loc}, l), [], _jsx::_) -> ( (* TODO: Soon, we will allow the final argument to be an identifier which @@ -6405,8 +6476,7 @@ let printer = object(self:'self) | Pexp_constant c -> (* Constants shouldn't break when to the right of a label *) let raw_literal, _ = extract_raw_literal x.pexp_attributes in - Some (ensureSingleTokenSticksToLabel - (self#constant ?raw_literal c)) + Some ((self#constant ?raw_literal c)) | Pexp_pack me -> Some ( makeList diff --git a/src/reason-parser/reason_syntax_util.cppo.ml b/src/reason-parser/reason_syntax_util.cppo.ml index 0e658279b..8dc64e0bc 100644 --- a/src/reason-parser/reason_syntax_util.cppo.ml +++ b/src/reason-parser/reason_syntax_util.cppo.ml @@ -279,6 +279,11 @@ let split_by ?(keep_empty=false) is_delim str = in loop [] len (len - 1) +let is_newline c = c == '\n' + +let split_by_newline ?keep_empty str = split_by ?keep_empty is_newline str + +(* Returns the index of the first white space at the end of the string *) let rec trim_right_idx str idx = if idx = -1 then 0 else @@ -296,6 +301,29 @@ let trim_right str = str else String.sub str 0 index +(* Returns the index of the last white space after which we start the substring. + * max is the max size of white spaces to remove. *) +let rec trim_left_idx ~max_trim_size str idx = + let len = String.length str in + if (idx == len) || (idx == max_trim_size) then idx - 1 + else + match String.get str idx with + | '\t' | ' ' | '\n' | '\r' -> trim_left_idx ~max_trim_size str (idx + 1) + | _ -> idx - 1 + +let trim_left ?(max_trim_size) str = + let length = String.length str in + let max_trim_size = + match max_trim_size with None -> length | Some mts -> mts in + if length = 0 then "" + else + let index = trim_left_idx ~max_trim_size str 0 in + if index = length - 1 then "" + else if index = -1 then + str + else String.sub str (index + 1) (length - (index + 1)) + + let processLine line = let rightTrimmed = trim_right line in @@ -733,6 +761,18 @@ let location_contains loc1 loc2 = loc1.loc_start.Lexing.pos_cnum <= loc2.loc_start.Lexing.pos_cnum && loc1.loc_end.Lexing.pos_cnum >= loc2.loc_end.Lexing.pos_cnum +let rec last_index_rec_opt s lim i c = + if i <= lim then None else + if String.unsafe_get s i == c then Some i else last_index_rec_opt s lim (i - 1) c + +let rec num_leading_space_ line length idx accum = + if idx = length then accum else + match String.get line idx with + | '\t' | ' ' -> num_leading_space_ line length (idx + 1) (accum + 1) + | _ -> accum + +let num_leading_space line = num_leading_space_ line (String.length line) 0 0 + #if OCAML_VERSION >= (4, 8, 0) let split_compiler_error (err : Location.error) = (err.main.loc, Format.asprintf "%t" err.main.txt) diff --git a/src/reason-parser/reason_syntax_util.cppo.mli b/src/reason-parser/reason_syntax_util.cppo.mli index f90549927..afd5405b5 100644 --- a/src/reason-parser/reason_syntax_util.cppo.mli +++ b/src/reason-parser/reason_syntax_util.cppo.mli @@ -32,6 +32,8 @@ val pick_while : ('a -> bool) -> 'a list -> 'a list * 'a list val split_by : ?keep_empty:bool -> (char -> bool) -> string -> string list +val split_by_newline : ?keep_empty:bool -> string -> string list + val processLineEndingsAndStarts : string -> string val isLineComment : string -> bool @@ -87,9 +89,15 @@ val location_is_before : Location.t -> Location.t -> bool val location_contains : Location.t -> Location.t -> bool +val trim_right : string -> string + +val trim_left : ?max_trim_size:int -> string -> string + val split_compiler_error : Location.error -> Location.t * string val explode_str : string -> char list + +val num_leading_space : string -> int #endif module Clflags : sig diff --git a/src/reason-parser/reason_template.ml b/src/reason-parser/reason_template.ml new file mode 100644 index 000000000..b7efe436e --- /dev/null +++ b/src/reason-parser/reason_template.ml @@ -0,0 +1,97 @@ +(** + * This module should include utilities for parsing and printing template + * strings, but should not have any dependencies on any printing framework + * (like Easy_format or Reason_layout). For that, make another module. This + * file should be shared between the printer and the parser, so avoiding + * dependencies on printing frameworks, makes it easy to bundle just the parser + * if necessary. + *) + +open Reason_migrate_parsetree +open Ast_408 + +module Parse = struct + (* Normalizes the last line: + * + * ` + * abc + * 123 + * xyz` + * + * Into: + * + * ` + * abc + * 123 + * xyz + * ` + * ^ ^ + * | | + * | one less space than previously (or zero if already had zero) + * white spaces 2 fewer than observed indent of last line. + * + * Or doesn't do anything if the last line is all white space. + * + * ` + * abc + * 123 + * xyz + * ` + * + * Into: + * + * ` + * abc + * 123 + * xyz + * ` + * ^ ^ + * | | + * | Doesn't remove any trailing white space on last line in this case. + * Undisturbed + * + * Removes a final line filled only with whitespace, returning its indent, + * or does not remove the final line if it has non-whitespace, but returns + * a normalized version of that final line if it is not terminated with a newline *) + let normalize_or_remove_last_line rev_lst = + match rev_lst with + | [] -> (0, []) + | s :: tl -> + let indent = Reason_syntax_util.num_leading_space s in + let len = String.length s in + if indent == len then (indent, tl) + else + (* Else, the last line contains non-white space after white space *) + let withoutFinalWhite = + (* Also, trim one single final white space *) + match String.get s (len - 1) with + | '\t' | ' ' | '\n' | '\r' -> String.sub s 0 (len - 1) + | _ -> s + in + (indent, withoutFinalWhite :: tl) + + let rec strip_leading_for_non_last ~indent acc revLst = + match revLst with + | [] -> acc + | hd::tl -> + (* The first line doesn't get a newline before it *) + let ln = Reason_syntax_util.trim_left ~max_trim_size:(indent+2) hd in + let next = match tl with | [] -> ln ^ acc | _ -> "\n" ^ ln ^ acc in + strip_leading_for_non_last ~indent next tl +end + + +module Print = struct + let escape_string_template str = + let buf = Buffer.create (String.length str) in + let strLen = String.length str in + String.iteri (fun i c -> + match c with + | '`' -> Buffer.add_string buf "\\`" + | '$' when i + 1 < strLen && str.[i + 1] == '{' -> Buffer.add_string buf "\\$" + | c -> Buffer.add_char buf c + ) str; + Buffer.contents buf + let is_template_style lst = + match lst with [({Parsetree.attr_name = {txt="reason.template"}; _ })] -> true | _ -> false +end diff --git a/src/reason-parser/reason_template.mli b/src/reason-parser/reason_template.mli new file mode 100644 index 000000000..9b772fd2d --- /dev/null +++ b/src/reason-parser/reason_template.mli @@ -0,0 +1,19 @@ +(** + * This module should include utilities for parsing and printing template + * strings, but should not have any dependencies on any printing framework + * (like Easy_format or Reason_layout). For that, make another module. This + * file should be shared between the printer and the parser, so avoiding + * dependencies on printing frameworks, makes it easy to bundle just the parser + * if necessary. + *) + +module Parse : sig + val normalize_or_remove_last_line: string list -> int * string list + + val strip_leading_for_non_last: indent:int -> string -> string list -> string +end + +module Print : sig + val escape_string_template : string -> string + val is_template_style : Reason_migrate_parsetree.Ast_408.Parsetree.attribute list -> bool +end diff --git a/src/reason-version/dune b/src/reason-version/dune index 2e10bfd65..278d6ed43 100644 --- a/src/reason-version/dune +++ b/src/reason-version/dune @@ -3,4 +3,6 @@ (public_name reason.version) (modules reason_version) (libraries reason.ocaml-migrate-parsetree) + (flags + (:standard -short-paths -safe-string)) ) From 3340be120b4a4685628b1a8c0bb882a2c1a67fce Mon Sep 17 00:00:00 2001 From: Jordan Date: Mon, 17 Aug 2020 01:28:05 -0700 Subject: [PATCH 3/3] [Stacked Diff 3/n #2614] [Parse Hashtags for polymorphic variants]"" This reverts commit f005630051aa47c2e2a51634229e8f26d7b56ab6. --- esy.json | 2 +- .../expected_output/arityConversion.re | 1 + .../expected_output/attributes.re | 2 +- .../autoUpgradeAngleBrackets.re | 14 + .../autoUpgradeAngleBracketsNoVersionAttr.re | 13 + .../autoUpgradeDoNotAutoUpgrade.re | 5 + .../expected_output/comments.re | 1 + .../expected_output/comments.rei | 9 +- .../expected_output/comments.rei.4.07.0 | 1 + .../expected_output/comments.rei.4.07.1 | 1 + .../expected_output/comments.rei.4.08.0 | 1 + .../expected_output/comments.rei.4.09.0 | 1 + .../expected_output/mlSyntax.re | 4 +- .../expected_output/oo_3_dot_8.re | 50 +- .../expected_output/typeParameters.re | 40 +- .../expected_output/typeParameters_3_dot_8.re | 4 + .../expected_output/variants_3_dot_8.re | 540 ++++++++++++++++++ .../typeCheckedTests/input/arityConversion.ml | 2 + .../input/autoUpgradeAngleBrackets.re | 14 + .../autoUpgradeAngleBracketsNoVersionAttr.re | 12 + .../input/autoUpgradeDoNotAutoUpgrade.re | 5 + formatTest/typeCheckedTests/input/comments.ml | 3 + .../typeCheckedTests/input/comments.mli | 3 + .../input/features406.4.06.0.ml | 1 + .../input/features408.4.08.0.ml | 1 + .../input/features408.4.08.0.mli | 1 + .../typeCheckedTests/input/knownMlIssues.ml | 1 + formatTest/typeCheckedTests/input/mlSyntax.ml | 1 + .../typeCheckedTests/input/mlVariants.ml | 1 + .../typeCheckedTests/input/oo_3_dot_8.re | 50 +- .../typeCheckedTests/input/pervasive.mli | 3 +- .../input/specificMLSyntax.4.04.0.ml | 1 + .../typeCheckedTests/input/typeParameters.re | 6 + .../input/typeParameters_3_dot_8.re | 8 + .../input/variants_3_dot_8.re | 465 +++++++++++++++ .../unit_tests/expected_output/class_types.re | 12 + .../expected_output/class_types_3_dot_8.re | 2 +- .../expected_output/ocaml_identifiers.re | 2 +- formatTest/unit_tests/input/class_types.re | 15 + .../unit_tests/input/class_types_3_dot_8.re | 2 +- .../unit_tests/input/ocaml_identifiers.ml | 3 +- src/reason-parser/dune | 2 +- .../reason_declarative_lexer.mll | 167 ++++-- src/reason-parser/reason_lexer.ml | 14 +- src/reason-parser/reason_parser.mly | 195 ++++--- src/reason-parser/reason_pprint_ast.ml | 123 ++-- src/reason-parser/reason_single_parser.ml | 18 +- src/reason-version/reason_version.ml | 432 ++++++++++---- src/refmt/refmt_args.ml | 31 + src/refmt/refmt_impl.ml | 6 + src/rtop/reason_util.ml | 2 +- src/rtop/reason_utop.ml | 2 +- 52 files changed, 1934 insertions(+), 361 deletions(-) create mode 100644 formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBrackets.re create mode 100644 formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBracketsNoVersionAttr.re create mode 100644 formatTest/typeCheckedTests/expected_output/autoUpgradeDoNotAutoUpgrade.re create mode 100644 formatTest/typeCheckedTests/expected_output/variants_3_dot_8.re create mode 100644 formatTest/typeCheckedTests/input/autoUpgradeAngleBrackets.re create mode 100644 formatTest/typeCheckedTests/input/autoUpgradeAngleBracketsNoVersionAttr.re create mode 100644 formatTest/typeCheckedTests/input/autoUpgradeDoNotAutoUpgrade.re create mode 100644 formatTest/typeCheckedTests/input/variants_3_dot_8.re diff --git a/esy.json b/esy.json index 3a6d2cd3b..7b12e06eb 100644 --- a/esy.json +++ b/esy.json @@ -84,6 +84,6 @@ }, "scripts": { "test": "esy x make test-once-installed", - "doc": "esy dune build @doc" + "doc": "esy build dune build @doc" } } diff --git a/formatTest/typeCheckedTests/expected_output/arityConversion.re b/formatTest/typeCheckedTests/expected_output/arityConversion.re index 737d0e6b8..f03595db5 100644 --- a/formatTest/typeCheckedTests/expected_output/arityConversion.re +++ b/formatTest/typeCheckedTests/expected_output/arityConversion.re @@ -1,4 +1,5 @@ [@reason.version 3.7]; + Some((1, 2, 3)); type bcd = diff --git a/formatTest/typeCheckedTests/expected_output/attributes.re b/formatTest/typeCheckedTests/expected_output/attributes.re index 4b4448366..8d3fd665b 100644 --- a/formatTest/typeCheckedTests/expected_output/attributes.re +++ b/formatTest/typeCheckedTests/expected_output/attributes.re @@ -7,9 +7,9 @@ * This has a nice side effect when printing the terms: * If a node has attributes attached to it, */; -[@reason.version 3.7]; /**Floating comment text should be removed*/; +[@reason.version 3.7]; /** * Core language features: diff --git a/formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBrackets.re b/formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBrackets.re new file mode 100644 index 000000000..003bf1a80 --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBrackets.re @@ -0,0 +1,14 @@ +/** + * Even if you have an explicit v3.6 marker. + * This whole file wil be auto-upaded to 3.8 becase something uses + * angle brackets. + */; +[@reason.version 3.8]; +let watchThisIsOldStyle: list = [1, 2]; + +let watchThisIsOldStylePoly = #hello; + +/** + * This will cause the whole file to be promoted. + */ +let x: list = [1, 3]; diff --git a/formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBracketsNoVersionAttr.re b/formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBracketsNoVersionAttr.re new file mode 100644 index 000000000..98d5e9041 --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/autoUpgradeAngleBracketsNoVersionAttr.re @@ -0,0 +1,13 @@ +[@reason.version 3.8]; +/** + * Test auto-promotion based on feature inference even if no version + * tag. By default you're using the old 3.7. + */ +let watchThisIsOldStyle: list = [1, 2]; + +let watchThisIsOldStylePoly = #hello; + +/** + * This will cause the whole file to be promoted. + */ +let x: list = [1, 3]; diff --git a/formatTest/typeCheckedTests/expected_output/autoUpgradeDoNotAutoUpgrade.re b/formatTest/typeCheckedTests/expected_output/autoUpgradeDoNotAutoUpgrade.re new file mode 100644 index 000000000..297875baa --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/autoUpgradeDoNotAutoUpgrade.re @@ -0,0 +1,5 @@ +[@reason.version 3.7]; +/** + * This should just print a 3.7 version attr at the top. + */ +let watchThisIsOldStyle: list(int) = [1, 2]; diff --git a/formatTest/typeCheckedTests/expected_output/comments.re b/formatTest/typeCheckedTests/expected_output/comments.re index 9bee88955..530e1e7ec 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.re +++ b/formatTest/typeCheckedTests/expected_output/comments.re @@ -1,6 +1,7 @@ /* **** comment */ /*** comment */ /** docstring */; + [@reason.version 3.7]; /* comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei b/formatTest/typeCheckedTests/expected_output/comments.rei index a5ec2cc99..8bc5460c0 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei +++ b/formatTest/typeCheckedTests/expected_output/comments.rei @@ -1,15 +1,16 @@ /* **** comment */ /*** comment */ -/*** docstring */ +/** docstring */; + +[@reason.version 3.7]; + /* comment */ -/*** docstring */ +/** docstring */; /*** comment */ /**** comment */ /***** comment */ /** */; -[@reason.version 3.7]; - /*** */ /**** */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 index 7749a396e..8bc5460c0 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 @@ -1,6 +1,7 @@ /* **** comment */ /*** comment */ /** docstring */; + [@reason.version 3.7]; /* comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 index 7749a396e..8bc5460c0 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 @@ -1,6 +1,7 @@ /* **** comment */ /*** comment */ /** docstring */; + [@reason.version 3.7]; /* comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 index 7749a396e..8bc5460c0 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 @@ -1,6 +1,7 @@ /* **** comment */ /*** comment */ /** docstring */; + [@reason.version 3.7]; /* comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 index 7749a396e..8bc5460c0 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 @@ -1,6 +1,7 @@ /* **** comment */ /*** comment */ /** docstring */; + [@reason.version 3.7]; /* comment */ diff --git a/formatTest/typeCheckedTests/expected_output/mlSyntax.re b/formatTest/typeCheckedTests/expected_output/mlSyntax.re index 98290479c..a314853f3 100644 --- a/formatTest/typeCheckedTests/expected_output/mlSyntax.re +++ b/formatTest/typeCheckedTests/expected_output/mlSyntax.re @@ -1,8 +1,8 @@ /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ -/** +/*** * Testing pattern matching using ml syntax to exercise nesting of cases. - */; + */ [@reason.version 3.7]; type xyz = diff --git a/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re b/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re index 4c8d3be15..4660068db 100644 --- a/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re +++ b/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re @@ -2,13 +2,36 @@ [@reason.version 3.8]; +type canStillDefineConst = + | [] + | ::(int, canStillDefineConst); + class virtual stack <'a> (init) = { + as self; /* * The "as this" is implicit and will be formatted away. */ val virtual dummy: unit; val mutable v: list<'a> = init; pub virtual implementMe: int => int; + pub is_empty = () => + switch (v) { + | [] => true + | _ => false + }; + pub is_empty_unitless = + switch (v) { + | [] => true + | _ => false + }; + pub empty_unitless = { + v = []; + self; + }; + pub empty = () => { + v = []; + self; + }; pub pop = switch (v) { | [hd, ...tl] => @@ -90,6 +113,15 @@ class extendedStackAcknowledgeOverride let inst = (new extendedStack)([1, 2]); +let wasItFull = + !inst::empty()::empty_unitless::is_empty(); +// this is the same +let wasItFull' = + !inst::empty()::empty_unitless::is_empty(); + +let orig_not = (!); +let (!) = o => o::empty(); + /** * Recursive classes. */ @@ -195,7 +227,7 @@ let acceptsOpenAnonObjAsArg = y: int, }, ) => - o#x + o#y; + o::x + o::y; let acceptsClosedAnonObjAsArg = ( o: { @@ -204,7 +236,7 @@ let acceptsClosedAnonObjAsArg = y: int, }, ) => - o#x + o#y; + o::x + o::y; let res = acceptsOpenAnonObjAsArg({ pub x = 0; @@ -346,13 +378,13 @@ let x: tupleClass = { pub pr = (10, 10) }; -let x: #tupleClass = x; +let x: *tupleClass = x; let incrementMyClassInstance: - (int, #tupleClass) => - #tupleClass = + (int, *tupleClass) => + *tupleClass = (i, inst) => { - let (x, y) = inst#pr; + let (x, y) = inst::pr; {pub pr = (x + i, y + i)}; }; @@ -361,7 +393,7 @@ class myClassWithNoTypeParams = {}; * The #myClassWithNoTypeParams should be treated as "simple" */ type optionalMyClassSubtype<'a> = - option<#myClassWithNoTypeParams> as 'a; + option<*myClassWithNoTypeParams> as 'a; /** * Remember, "class type" is really "class_instance_type" (which is the type of @@ -398,7 +430,7 @@ class addablePoint: one: addablePointClassType, two: addablePointClassType, ) => - one#x + two#x + one#y + two#x; + one::x + two::x + one::y + two::x; pub x: int = init; pub y = init; }; @@ -412,7 +444,7 @@ class addablePoint2: one: addablePointClassType, two: addablePointClassType, ) => - one#x + two#x + one#y + two#x; + one::x + two::x + one::y + two::x; pub x: int = init; pub y = init; }; diff --git a/formatTest/typeCheckedTests/expected_output/typeParameters.re b/formatTest/typeCheckedTests/expected_output/typeParameters.re index 1af0200a4..21bee45a2 100644 --- a/formatTest/typeCheckedTests/expected_output/typeParameters.re +++ b/formatTest/typeCheckedTests/expected_output/typeParameters.re @@ -1,29 +1,33 @@ /** * Testing type parameters. */; -[@reason.version 3.7]; +[@reason.version 3.8]; -type threeThings('t) = ('t, 't, 't); -type listOf('t) = list('t); +module type ListItem = {let x: int;}; -type underscoreParam(_) = +let myListOfModules: list = []; + +type threeThings<'t> = ('t, 't, 't); +type listOf<'t> = list<'t>; + +type underscoreParam<_> = | Underscored; -type underscoreParamCovariance(+_) = +type underscoreParamCovariance<+_> = | Underscored; -type underscoreParamContravariance(-_) = +type underscoreParamContravariance<-_> = | Underscored; -type tickParamCovariance(+'a) = +type tickParamCovariance<+'a> = | Underscored; -type tickParamContravariance(-'a) = +type tickParamContravariance<-'a> = | Underscored; -let x: option(list('a)) = None; -type myFunctionType('a) = ( - list(('a, 'a)), - int => option(list('a)), +let x: option> = None; +type myFunctionType<'a> = ( + list<('a, 'a)>, + int => option>, ); -let funcAnnoted = (~a: list(int)=[0, 1], ()) => a; +let funcAnnoted = (~a: list=[0, 1], ()) => a; /** * Syntax that would be likely to conflict with lexing parsing of < > syntax. @@ -46,12 +50,12 @@ let isSuperGreaterThanEqNegFive3 = zero >>= (-5); let jsx = (~children, ()) => 0; -type t('a) = 'a; -let optionArg = (~arg: option(t(int))=?, ()) => arg; +type t<'a> = 'a; +let optionArg = (~arg: option>=?, ()) => arg; let optionArgList = - (~arg: option(list(list(int)))=?, ()) => arg; -let defaultJsxArg = (~arg: t(int)=, ()) => arg; -let defaultFalse = (~arg: t(bool)=!true, ()) => arg; + (~arg: option>>=?, ()) => arg; +let defaultJsxArg = (~arg: t=, ()) => arg; +let defaultFalse = (~arg: t=!true, ()) => arg; /* Doesn't work on master either let defaultTrue = (~arg:t= !!true) => arg; */ /** diff --git a/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re b/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re index c3bc2a35c..21bee45a2 100644 --- a/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re +++ b/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re @@ -3,6 +3,10 @@ */; [@reason.version 3.8]; +module type ListItem = {let x: int;}; + +let myListOfModules: list = []; + type threeThings<'t> = ('t, 't, 't); type listOf<'t> = list<'t>; diff --git a/formatTest/typeCheckedTests/expected_output/variants_3_dot_8.re b/formatTest/typeCheckedTests/expected_output/variants_3_dot_8.re new file mode 100644 index 000000000..7af065892 --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/variants_3_dot_8.re @@ -0,0 +1,540 @@ +[@reason.version 3.8]; + +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +type tt<'a> = int; + +module LocalModule = { + type accessedThroughModule = + | AccessedThroughModule; + type accessedThroughModuleWithArg = + | AccessedThroughModuleWith(int) + | AccessedThroughModuleWithTwo(int, int); +}; + +type notTupleVariant = + | NotActuallyATuple(int, int); +type attr1 = ..; +type attr1 += + | A(int); +type attr1 += + | Point(int, int); +type attr1 += + | PointA({ + a: int, + b: int, + }); + +type notTupleVariantExtraParens = + | NotActuallyATuple2(int, int); + +type simpleTupleVariant = + | SimpleActuallyATuple((int, int)); + +type tupleVariant = + | ActuallyATuple((int, int)); + +let intTuple = (20, 20); + +let notTupled: notTupleVariant = + NotActuallyATuple(10, 10); + +/* Doesn't work because we've correctly annotated parse tree nodes with explicit_arity! */ +/* let notTupled: notTupleVariant = NotActuallyATuple (10, 10); */ +let funcOnNotActuallyATuple = + (NotActuallyATuple(x, y)) => + x + y; + +/* let funcOnNotActuallyATuple (NotActuallyATuple (x, y)) = x + y; */ +/* let notTupled: notTupleVariant = NotActuallyATuple intTuple; /*Doesn't work! */ */ +/* At least the above acts as proof that there *is* a distinction that is + honored. */ +let simpleTupled: simpleTupleVariant = + SimpleActuallyATuple((10, 10)); + +let simpleTupled: simpleTupleVariant = + SimpleActuallyATuple(intTuple); + +/*Works! */ +let NotActuallyATuple(x, y) = + NotActuallyATuple(10, 20); + +let yesTupled: tupleVariant = + ActuallyATuple((10, 10)); + +let yesTupled: tupleVariant = + ActuallyATuple(intTuple); + +type threeForms = + | FormOne(int) + | FormTwo(int) + | FormThree; + +let doesntCareWhichForm = x => + switch (x) { + | FormOne(q) + | FormTwo(q) => 10 + | FormThree => 20 + }; + +let doesntCareWhichFormAs = x => + switch (x) { + | FormOne(q) as _ppp + | FormTwo(q) as _ppp => 10 + | FormThree => 20 + }; +type otherThingInheritedFrom = [ | #Base]; +type colorList1 = [ + otherThingInheritedFrom + | #Red + | #Black +]; + +type colorList2 = [ + | #Red + | #Black + | otherThingInheritedFrom +]; +type foo = [ | #foo]; +type colorList3 = [ + colorList2 + | foo + | #Red + | #Black + | foo +]; + +type lessThanGreaterThan<'a> = + [< | #Red | #Black | #Blue > #Red #Black] as 'a; + +/** + * In order to get this to typecheck you must admit the row variable. But it strangely + * does not type check on 4.06 and earlier. + * + * Therefore, we are including this in the unit tests but not the type checked tests. + + type colorList<'a> = + [< | #Red(int, int) &(int) | #Black&(int, int) &(int) | #Blue] as 'a; + +*/ +1 + doesntCareWhichForm(FormOne(10)); + +1 + doesntCareWhichForm(FormTwo(10)); + +1 + doesntCareWhichForm(FormThree); + +/* Destructured matching at function definition */ +let accessDeeply = + (LocalModule.AccessedThroughModule) => 10; + +let accessDeeplyWithArg = + ( + LocalModule.AccessedThroughModuleWith(x) | + LocalModule.AccessedThroughModuleWithTwo( + _, + x, + ), + ) => x; + +/* Destructured matching *not* at function definition */ +let accessDeeply = x => + switch (x) { + | LocalModule.AccessedThroughModule => 10 + }; + +let accessDeeplyWithArg = x => + switch (x) { + | LocalModule.AccessedThroughModuleWith(x) => 10 + | _ => 0 + }; + +/* In OCaml's syntax, to capture the wrapped data, you do: + * + * let myFunc x = function | `Blah (p as retVal) -> retVal` + * + * In OCaml's syntax, to capture the entire pattern you do: + * + * let myFunc x = function | `Blah p as retVal -> retVal` + */ +let accessDeeply = x => + switch (x) { + | LocalModule.AccessedThroughModule as _ppp => 1 + }; + +let accessDeeplyWithArg = x => + switch (x) { + | LocalModule.AccessedThroughModuleWith( + x as retVal, + ) => + retVal + 1 + | LocalModule.AccessedThroughModuleWithTwo( + x as retVal1, + y as retVal2, + ) => + retVal1 + retVal2 + 1 + }; + +/* Just to show that by default `as` captures much less aggresively */ +let rec accessDeeplyWithArgRecursive = + (x, count) => + switch (x) { + | LocalModule.AccessedThroughModuleWith(x) as entirePattern => + /* It captures the whole pattern */ + if (count > 0) { + 0; + } else { + accessDeeplyWithArgRecursive( + entirePattern, + count - 1, + ); + } + | LocalModule.AccessedThroughModuleWithTwo( + x, + y, + ) as entirePattern => + /* It captures the whole pattern */ + if (count > 0) { + 0; + } else { + accessDeeplyWithArgRecursive( + entirePattern, + count - 1, + ); + } + }; + +accessDeeplyWithArgRecursive( + LocalModule.AccessedThroughModuleWith(10), + 10, +); + +type combination<'a> = + | HeresTwoConstructorArguments(int, int); + +/** But then how do we parse matches in function arguments? */ +/* We must require parenthesis around construction matching in function args only*/ +let howWouldWeMatchFunctionArgs = + (HeresTwoConstructorArguments(x, y)) => + x + y; + +/* How would we annotate said arg? */ +let howWouldWeMatchFunctionArgs = + ( + HeresTwoConstructorArguments(x, y): + combination<'wat>, + ) => + x + y; + +let matchingTwoCurriedConstructorsInTuple = x => + switch (x) { + | ( + HeresTwoConstructorArguments(x, y), + HeresTwoConstructorArguments(a, b), + ) => + x + y + a + b + }; + +type twoCurriedConstructors = + | TwoCombos( + combination, + combination, + ); + +let matchingTwoCurriedConstructorInConstructor = + x => + switch (x) { + | TwoCombos( + HeresTwoConstructorArguments(x, y), + HeresTwoConstructorArguments(a, b), + ) => + a + b + x + y + }; + +type twoCurriedConstructorsPolyMorphic<'a> = + | TwoCombos( + combination<'a>, + combination<'a>, + ); + +/* Matching records */ +type pointRecord = { + x: int, + y: int, +}; + +type alsoHasARecord = + | Blah + | AlsoHasARecord(int, int, pointRecord); + +let result = + switch ( + AlsoHasARecord(10, 10, {x: 10, y: 20}) + ) { + | Blah => 1000 + | AlsoHasARecord(a, b, {x, y}) => + a + b + x + y + }; + +let rec commentPolymorphicCases: + 'a. + option<'a> => int + = + fun + | Some(a) => 1 + /* Comment on one */ + | None => 0; +type numbers = + | Zero + | One(int) + | Three(int, int, int); +let something = Zero; +let testSwitch = + switch (something) { + | Zero + | One(_) => 10 + | Three(_, _, _) => 100 + }; + +let thisWillCompileButLetsSeeHowItFormats = + fun + | Zero + | Three(_, _, _) => 10 + | One(_) => 20; + +/* Comment on two */ +/** + * GADTs. + */ +type term<_> = + | Int(int): term + | Add: term<(int, int) => int> + | App(term<'b => 'a>, term<'b>): term<'a>; + +let rec eval: type a. term => a = + fun + | Int(n) => n + /* a = int */ + | Add => ((x, y) => x + y) + /* a = int => int => int */ + | App(f, x) => eval(f, eval(x)); + +let rec eval: type a. term => a = + x => + switch (x) { + | Int(n) => n + /* a = int */ + | Add => ((x, y) => x + y) + /* a = int => int => int */ + | App(f, x) => eval(f, eval(x)) + }; + +/* eval called at types (b=>a) and b for fresh b */ +let evalArg = App(App(Add, Int(1)), Int(1)); + +let two = + eval(App(App(Add, Int(1)), Int(1))); + +type someVariant = + | Purple(int) + | Yellow(int); + +let Purple(x) | Yellow(x) = + switch (Yellow(100), Purple(101)) { + | (Yellow(y), Purple(p)) => Yellow(p + y) + | (Purple(p), Yellow(y)) => Purple(y + p) + | (Purple(p), Purple(y)) => Yellow(y + p) + | (Yellow(p), Yellow(y)) => Purple(y + p) + }; + +type tuples = + | Zero + | One(int) + | Two(int, int) + | OneTuple(int, int); + +let myTuple = OneTuple(20, 30); + +let res = + switch (myTuple) { + | Two(y, z) => + try(Two(y, z)) { + | Invalid_argument(_) => Zero + } + | One(_) => + switch (One(4)) { + | One(_) => Zero + | _ => Zero + } + | _ => Zero + }; + +/* FIXME type somePolyVariant = [ `Purple int | `Yellow int]; */ + +let ylw = #Yellow((100, 100)); + +let prp = #Purple((101, 100)); + +let res = + switch (ylw, prp) { + | (#Yellow(y, y2), #Purple(p, p2)) => + #Yellow((p + y, 0)) + | (#Purple(p, p2), #Yellow(y, y2)) => + #Purple((y + p, 0)) + | (#Purple(p, p2), #Purple(y, y2)) => + #Yellow((y + p, 0)) + | (#Yellow(p, p2), #Yellow(y, y2)) => + #Purple((y + p, 0)) + }; + +let ylw = #Yellow(100); + +let prp = #Purple(101); + +let res = + switch (ylw, prp) { + | (#Yellow(y), #Purple(p)) => #Yellow(p + y) + | (#Purple(p), #Yellow(y)) => #Purple(y + p) + | (#Purple(p), #Purple(y)) => #Yellow(y + p) + | (#Yellow(p), #Yellow(y)) => #Purple(y + p) + }; + +/* + * Now try polymorphic variants with *actual* tuples. + * You'll notice that these become indistinguishable from multiple constructor + * args! explicit_arity doesn't work on polymorphic variants! + * + * Way to resolve this (should also work for non-polymorphic variants): + * + * If you see *one* simple expr list that is a tuple, generate: + * Pexp_tuple (Pexp_tuple ..)) + * + * If you see *one* simple expr list that is *not* a tuple, generate: + * Pexp.. + * + * If you see *multiple* simple exprs, generate: + * Pexp_tuple.. + * + * Though, I'm not sure this will even work. + */ +let ylw = #Yellow((100, 100)); + +let prp = #Purple((101, 101)); + +let res = + switch (ylw, prp) { + | (#Yellow(y, y2), #Purple(p, p2)) => + #Yellow((p + y, 0)) + | (#Purple(p, p2), #Yellow(y, y2)) => + #Purple((y + p, 0)) + | (#Purple(p, p2), #Purple(y, y2)) => + #Yellow((y + p, 0)) + | (#Yellow(p, p2), #Yellow(y, y2)) => + #Purple((y + p, 0)) + }; + +type contentHolder<'a> = + | ContentHolderWithReallyLongNameCauseBreak( + 'a, + ) + | ContentHolder('a); + +/* + * When pretty printed, this appears to be multi-argument constructors. + */ +let prp = #Purple((101, 101)); + +let res = + switch (prp) { + | #Yellow(y, y2) => #Yellow((y2 + y, 0)) + | #Purple(p, p2) => #Purple((p2 + p, 0)) + }; + +/* + * Testing extensible variants + */ +type attr = ..; + +/* `of` is optional */ +type attr += + | StrString(string); + +type attr += + | Point2(int, int); + +type attr += + | Float(float) + | Char(char); + +type tag<'props> = ..; + +type titleProps = {title: string}; + +type tag<'props> += + | Title: tag + | Count(int): tag; + +module Graph = { + type node = ..; + type node += + | Str; +}; + +type Graph.node += + | Str = Graph.Str; + +type water = ..; + +type water += + pri + | Ocean; + +type water += + pri + | MineralWater + | SpringWater + | TapWater + | TableWater; +module Expr = { + type Graph.node += + | Node + | Atom; +}; +module F = { + type Graph.node += + pri + | Node = Expr.Node; +}; + +type Graph.node += + pri + | Node = Expr.Node + | Atom = Expr.Atom; + +type singleUnit = + | MyConstructorWithSingleUnitArg(unit); +/* without single unit arg sugar */ +MyConstructorWithSingleUnitArg(); +/* with single unit arg sugar */ +MyConstructorWithSingleUnitArg(); +/* without single unit arg sugar */ +#polyVariantWithSingleUnitArg(); +/* with single unit arg sugar */ +#polyVariantWithSingleUnitArg(); + +let x = #Poly; + +/* Format doc attrs consistent: https://github.com/facebook/reason/issues/2187 */ +type t = + | /** This is some documentation that might be fairly long and grant a line break */ + A + | /** Shorter docs */ + B + | /** Some more longer docs over here that make sense to break lines on too */ + C; + +/* https://github.com/facebook/reason/issues/1828 */ +type widget_state = [ + | #DEFAULT /* here */ + | #HOVER + | #ACTIVE +]; diff --git a/formatTest/typeCheckedTests/input/arityConversion.ml b/formatTest/typeCheckedTests/input/arityConversion.ml index d464f9172..5a7a76bb9 100644 --- a/formatTest/typeCheckedTests/input/arityConversion.ml +++ b/formatTest/typeCheckedTests/input/arityConversion.ml @@ -1,3 +1,5 @@ +[@@@reason.version 3.7] +;; Some (1, 2, 3) type bcd = TupleConstructor of (int * int) | MultiArgumentsConstructor of int * int diff --git a/formatTest/typeCheckedTests/input/autoUpgradeAngleBrackets.re b/formatTest/typeCheckedTests/input/autoUpgradeAngleBrackets.re new file mode 100644 index 000000000..0b6323b46 --- /dev/null +++ b/formatTest/typeCheckedTests/input/autoUpgradeAngleBrackets.re @@ -0,0 +1,14 @@ +/** + * Even if you have an explicit v3.6 marker. + * This whole file wil be auto-upaded to 3.8 becase something uses + * angle brackets. + */ +[@reason.version 3.6]; +let watchThisIsOldStyle : list(int) = [1, 2]; + +let watchThisIsOldStylePoly = `hello; + +/** + * This will cause the whole file to be promoted. + */ +let x : list = [1, 3]; diff --git a/formatTest/typeCheckedTests/input/autoUpgradeAngleBracketsNoVersionAttr.re b/formatTest/typeCheckedTests/input/autoUpgradeAngleBracketsNoVersionAttr.re new file mode 100644 index 000000000..a472558ab --- /dev/null +++ b/formatTest/typeCheckedTests/input/autoUpgradeAngleBracketsNoVersionAttr.re @@ -0,0 +1,12 @@ +/** + * Test auto-promotion based on feature inference even if no version + * tag. By default you're using the old 3.7. + */ +let watchThisIsOldStyle : list(int) = [1, 2]; + +let watchThisIsOldStylePoly = `hello; + +/** + * This will cause the whole file to be promoted. + */ +let x : list = [1, 3]; diff --git a/formatTest/typeCheckedTests/input/autoUpgradeDoNotAutoUpgrade.re b/formatTest/typeCheckedTests/input/autoUpgradeDoNotAutoUpgrade.re new file mode 100644 index 000000000..717c00fc6 --- /dev/null +++ b/formatTest/typeCheckedTests/input/autoUpgradeDoNotAutoUpgrade.re @@ -0,0 +1,5 @@ +/** + * This should just print a 3.7 version attr at the top. + */ +let watchThisIsOldStyle : list(int) = [1, 2]; + diff --git a/formatTest/typeCheckedTests/input/comments.ml b/formatTest/typeCheckedTests/input/comments.ml index b710320fc..4891b41c0 100644 --- a/formatTest/typeCheckedTests/input/comments.ml +++ b/formatTest/typeCheckedTests/input/comments.ml @@ -1,6 +1,9 @@ (* **** comment *) (*** comment *) (** docstring *) + +[@@@reason.version 3.7] + (* comment *) (** docstring *) (*** comment *) diff --git a/formatTest/typeCheckedTests/input/comments.mli b/formatTest/typeCheckedTests/input/comments.mli index 3c749db48..3bf8c001e 100644 --- a/formatTest/typeCheckedTests/input/comments.mli +++ b/formatTest/typeCheckedTests/input/comments.mli @@ -1,6 +1,9 @@ (* **** comment *) (*** comment *) (** docstring *) + +[@@@reason.version 3.7] + (* comment *) (** docstring *) (*** comment *) diff --git a/formatTest/typeCheckedTests/input/features406.4.06.0.ml b/formatTest/typeCheckedTests/input/features406.4.06.0.ml index 4be05c44b..1a634d7dc 100644 --- a/formatTest/typeCheckedTests/input/features406.4.06.0.ml +++ b/formatTest/typeCheckedTests/input/features406.4.06.0.ml @@ -1,3 +1,4 @@ +[@@@reason.version 3.7] module EM = struct (** Exception *) exception E of int * int diff --git a/formatTest/typeCheckedTests/input/features408.4.08.0.ml b/formatTest/typeCheckedTests/input/features408.4.08.0.ml index 52e986cae..fcd35b65a 100644 --- a/formatTest/typeCheckedTests/input/features408.4.08.0.ml +++ b/formatTest/typeCheckedTests/input/features408.4.08.0.ml @@ -1,3 +1,4 @@ +[@@@reason.version 3.7] open struct type t = string end diff --git a/formatTest/typeCheckedTests/input/features408.4.08.0.mli b/formatTest/typeCheckedTests/input/features408.4.08.0.mli index faf535a98..6e86b694a 100644 --- a/formatTest/typeCheckedTests/input/features408.4.08.0.mli +++ b/formatTest/typeCheckedTests/input/features408.4.08.0.mli @@ -1,3 +1,4 @@ +[@@@reason.version 3.7] module X : sig type t end diff --git a/formatTest/typeCheckedTests/input/knownMlIssues.ml b/formatTest/typeCheckedTests/input/knownMlIssues.ml index 47529ca40..2230a3895 100644 --- a/formatTest/typeCheckedTests/input/knownMlIssues.ml +++ b/formatTest/typeCheckedTests/input/knownMlIssues.ml @@ -1,3 +1,4 @@ +[@@@reason.version 3.7] (* [x] fixed *) type t2 = int * int (* attributed to entire type not binding *) diff --git a/formatTest/typeCheckedTests/input/mlSyntax.ml b/formatTest/typeCheckedTests/input/mlSyntax.ml index e501ecec2..ad2da79ed 100644 --- a/formatTest/typeCheckedTests/input/mlSyntax.ml +++ b/formatTest/typeCheckedTests/input/mlSyntax.ml @@ -3,6 +3,7 @@ (** * Testing pattern matching using ml syntax to exercise nesting of cases. *) +[@@@reason.version 3.7] type xyz = diff --git a/formatTest/typeCheckedTests/input/mlVariants.ml b/formatTest/typeCheckedTests/input/mlVariants.ml index 603edee27..ddbc282fc 100644 --- a/formatTest/typeCheckedTests/input/mlVariants.ml +++ b/formatTest/typeCheckedTests/input/mlVariants.ml @@ -1,3 +1,4 @@ +[@@@reason.version 3.7] (* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. *) type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/input/oo_3_dot_8.re b/formatTest/typeCheckedTests/input/oo_3_dot_8.re index 1f036b5e2..f4077aeb7 100644 --- a/formatTest/typeCheckedTests/input/oo_3_dot_8.re +++ b/formatTest/typeCheckedTests/input/oo_3_dot_8.re @@ -2,13 +2,36 @@ [@reason.version 3.8]; +type canStillDefineConst = + | [] + | :: (int, canStillDefineConst); + class virtual stack('a) (init) = { + as self; /* * The "as this" is implicit and will be formatted away. */ val virtual dummy: unit; val mutable v: list<'a> = init; pub virtual implementMe: int => int; + pub is_empty = () => + switch (v) { + | [] => true + | _ => false + }; + pub is_empty_unitless = + switch (v) { + | [] => true + | _ => false + }; + pub empty_unitless = { + v = []; + self + }; + pub empty = () => { + v = []; + self; + }; pub pop = switch (v) { | [hd, ...tl] => @@ -90,6 +113,15 @@ class extendedStackAcknowledgeOverride let inst = (new extendedStack)([1, 2]); +let wasItFull = !inst::empty()::empty_unitless::is_empty(); +// this is the same +let wasItFull' = !(inst::empty()::empty_unitless::is_empty()); + +let orig_not = (!); +let (!) = o => o::empty(); + + + /** * Recursive classes. */ @@ -195,7 +227,7 @@ let acceptsOpenAnonObjAsArg = y: int, }, ) => - o#x + o#y; + o::x + o::y; let acceptsClosedAnonObjAsArg = ( o: { @@ -204,7 +236,7 @@ let acceptsClosedAnonObjAsArg = y: int, }, ) => - o#x + o#y; + o::x + o::y; let res = acceptsOpenAnonObjAsArg({ pub x = 0; @@ -346,13 +378,13 @@ let x: tupleClass = { pub pr = (10, 10) }; -let x: #tupleClass = x; +let x: *tupleClass = x; let incrementMyClassInstance: - (int, #tupleClass) => - #tupleClass = + (int, *tupleClass) => + *tupleClass = (i, inst) => { - let (x, y) = inst#pr; + let (x, y) = inst::pr; {pub pr = (x + i, y + i)}; }; @@ -361,7 +393,7 @@ class myClassWithNoTypeParams = {}; * The #myClassWithNoTypeParams should be treated as "simple" */ type optionalMyClassSubtype<'a> = - option< #myClassWithNoTypeParams> as 'a; + option< *myClassWithNoTypeParams> as 'a; /** * Remember, "class type" is really "class_instance_type" (which is the type of @@ -398,7 +430,7 @@ class addablePoint: one: addablePointClassType, two: addablePointClassType, ) => - one#x + two#x + one#y + two#x; + one::x + two::x + one::y + two::x; pub x: int = init; pub y = init; }; @@ -412,7 +444,7 @@ class addablePoint2: one: addablePointClassType, two: addablePointClassType, ) => - one#x + two#x + one#y + two#x; + one::x + two::x + one::y + two::x; pub x: int = init; pub y = init; }; diff --git a/formatTest/typeCheckedTests/input/pervasive.mli b/formatTest/typeCheckedTests/input/pervasive.mli index 7a6400e32..22c36a6b7 100644 --- a/formatTest/typeCheckedTests/input/pervasive.mli +++ b/formatTest/typeCheckedTests/input/pervasive.mli @@ -1,5 +1,6 @@ +[@@@reason.version 3.7] val ( = ) : 'a -> 'a -> bool val ( <> ) : 'a -> 'a -> bool -val not : bool -> bool \ No newline at end of file +val not : bool -> bool diff --git a/formatTest/typeCheckedTests/input/specificMLSyntax.4.04.0.ml b/formatTest/typeCheckedTests/input/specificMLSyntax.4.04.0.ml index e1f0df6fa..32d3452d8 100644 --- a/formatTest/typeCheckedTests/input/specificMLSyntax.4.04.0.ml +++ b/formatTest/typeCheckedTests/input/specificMLSyntax.4.04.0.ml @@ -1,3 +1,4 @@ +[@@@reason.version 3.7] module Foo = struct type t = { name: string } end diff --git a/formatTest/typeCheckedTests/input/typeParameters.re b/formatTest/typeCheckedTests/input/typeParameters.re index 08e084825..f6e183c60 100644 --- a/formatTest/typeCheckedTests/input/typeParameters.re +++ b/formatTest/typeCheckedTests/input/typeParameters.re @@ -3,6 +3,12 @@ */ [@reason.version 3.7]; +module type ListItem = { + let x : int; +}; + +let myListOfModules: list(module ListItem) = []; + type threeThings<'t> = ('t, 't, 't); type listOf<'t> = list<'t>; diff --git a/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re b/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re index c7d6710bf..810aa0b20 100644 --- a/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re +++ b/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re @@ -3,6 +3,14 @@ */ [@reason.version 3.8]; + +module type ListItem = { + let x : int; +}; + +let myListOfModules: list = []; + + type threeThings<'t> = ('t, 't, 't); type listOf<'t> = list<'t>; diff --git a/formatTest/typeCheckedTests/input/variants_3_dot_8.re b/formatTest/typeCheckedTests/input/variants_3_dot_8.re new file mode 100644 index 000000000..2bff34380 --- /dev/null +++ b/formatTest/typeCheckedTests/input/variants_3_dot_8.re @@ -0,0 +1,465 @@ +[@reason.version 3.8]; + +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +type tt<'a> = int; + +module LocalModule = { + type accessedThroughModule = + | AccessedThroughModule; + type accessedThroughModuleWithArg = + | AccessedThroughModuleWith(int) + | AccessedThroughModuleWithTwo(int, int); +}; + +type notTupleVariant = + | NotActuallyATuple(int, int); +type attr1 = ..; +type attr1 += + | A(int); +type attr1 += + | Point(int, int); +type attr1 += + | PointA({ + a: int, + b: int, + }); + +type notTupleVariantExtraParens = + | NotActuallyATuple2(int, int); + +type simpleTupleVariant = + | SimpleActuallyATuple((int, int)); + +type tupleVariant = + | ActuallyATuple((int, int)); + +let intTuple = (20, 20); + +let notTupled: notTupleVariant = NotActuallyATuple(10, 10); + +/* Doesn't work because we've correctly annotated parse tree nodes with explicit_arity! */ +/* let notTupled: notTupleVariant = NotActuallyATuple (10, 10); */ +let funcOnNotActuallyATuple = (NotActuallyATuple(x, y)) => x + y; + +/* let funcOnNotActuallyATuple (NotActuallyATuple (x, y)) = x + y; */ +/* let notTupled: notTupleVariant = NotActuallyATuple intTuple; /*Doesn't work! */ */ +/* At least the above acts as proof that there *is* a distinction that is + honored. */ +let simpleTupled: simpleTupleVariant = SimpleActuallyATuple((10, 10)); + +let simpleTupled: simpleTupleVariant = SimpleActuallyATuple(intTuple); + +/*Works! */ +let NotActuallyATuple(x, y) = NotActuallyATuple(10, 20); + +let yesTupled: tupleVariant = ActuallyATuple((10, 10)); + +let yesTupled: tupleVariant = ActuallyATuple(intTuple); + +type threeForms = + | FormOne(int) + | FormTwo(int) + | FormThree; + +let doesntCareWhichForm = x => + switch (x) { + | FormOne(q) + | FormTwo(q) => 10 + | FormThree => 20 + }; + +let doesntCareWhichFormAs = x => + switch (x) { + | FormOne(q) as _ppp + | FormTwo(q) as _ppp => 10 + | FormThree => 20 + }; +type otherThingInheritedFrom = [ | #Base]; +type colorList1 = [ otherThingInheritedFrom | #Red | #Black]; + +type colorList2 = [ | #Red | #Black | otherThingInheritedFrom]; +type foo = [ | #foo]; +type colorList3 = [ colorList2 | foo | #Red | #Black | foo]; + +type lessThanGreaterThan<'a> = + [< | #Red | #Black | #Blue > #Red #Black] as 'a; + +/** + * In order to get this to typecheck you must admit the row variable. But it strangely + * does not type check on 4.06 and earlier. + * + * Therefore, we are including this in the unit tests but not the type checked tests. + + type colorList<'a> = + [< | #Red(int, int) &(int) | #Black&(int, int) &(int) | #Blue] as 'a; + +*/ + +1 + doesntCareWhichForm(FormOne(10)); + +1 + doesntCareWhichForm(FormTwo(10)); + +1 + doesntCareWhichForm(FormThree); + +/* Destructured matching at function definition */ +let accessDeeply = (LocalModule.AccessedThroughModule) => 10; + +let accessDeeplyWithArg = + ( + LocalModule.AccessedThroughModuleWith(x) | + LocalModule.AccessedThroughModuleWithTwo(_, x), + ) => x; + +/* Destructured matching *not* at function definition */ +let accessDeeply = x => + switch (x) { + | LocalModule.AccessedThroughModule => 10 + }; + +let accessDeeplyWithArg = x => + switch (x) { + | LocalModule.AccessedThroughModuleWith(x) => 10 + | _ => 0 + }; + +/* In OCaml's syntax, to capture the wrapped data, you do: + * + * let myFunc x = function | `Blah (p as retVal) -> retVal` + * + * In OCaml's syntax, to capture the entire pattern you do: + * + * let myFunc x = function | `Blah p as retVal -> retVal` + */ +let accessDeeply = x => + switch (x) { + | LocalModule.AccessedThroughModule as _ppp => 1 + }; + +let accessDeeplyWithArg = x => + switch (x) { + | LocalModule.AccessedThroughModuleWith(x as retVal) => retVal + 1 + | LocalModule.AccessedThroughModuleWithTwo(x as retVal1, y as retVal2) => + retVal1 + retVal2 + 1 + }; + +/* Just to show that by default `as` captures much less aggresively */ +let rec accessDeeplyWithArgRecursive = (x, count) => + switch (x) { + | LocalModule.AccessedThroughModuleWith(x) as entirePattern => + /* It captures the whole pattern */ + if (count > 0) { + 0; + } else { + accessDeeplyWithArgRecursive(entirePattern, count - 1); + } + | LocalModule.AccessedThroughModuleWithTwo(x, y) as entirePattern => + /* It captures the whole pattern */ + if (count > 0) { + 0; + } else { + accessDeeplyWithArgRecursive(entirePattern, count - 1); + } + }; + +accessDeeplyWithArgRecursive(LocalModule.AccessedThroughModuleWith(10), 10); + +type combination<'a> = + | HeresTwoConstructorArguments(int, int); + +/** But then how do we parse matches in function arguments? */ +/* We must require parenthesis around construction matching in function args only*/ +let howWouldWeMatchFunctionArgs = (HeresTwoConstructorArguments(x, y)) => + x + y; + +/* How would we annotate said arg? */ +let howWouldWeMatchFunctionArgs = + (HeresTwoConstructorArguments(x, y): combination<'wat>) => + x + y; + +let matchingTwoCurriedConstructorsInTuple = x => + switch (x) { + | (HeresTwoConstructorArguments(x, y), HeresTwoConstructorArguments(a, b)) => + x + y + a + b + }; + +type twoCurriedConstructors = + | TwoCombos(combination, combination); + +let matchingTwoCurriedConstructorInConstructor = x => + switch (x) { + | TwoCombos( + HeresTwoConstructorArguments(x, y), + HeresTwoConstructorArguments(a, b), + ) => + a + b + x + y + }; + +type twoCurriedConstructorsPolyMorphic<'a> = + | TwoCombos(combination<'a>, combination<'a>); + +/* Matching records */ +type pointRecord = { + x: int, + y: int, +}; + +type alsoHasARecord = + | Blah + | AlsoHasARecord(int, int, pointRecord); + +let result = + switch (AlsoHasARecord(10, 10, {x: 10, y: 20})) { + | Blah => 1000 + | AlsoHasARecord(a, b, {x, y}) => a + b + x + y + }; + +let rec commentPolymorphicCases: 'a. option<'a> => int = + fun + | Some(a) => 1 + /* Comment on one */ + | None => 0; +type numbers = + | Zero + | One(int) + | Three(int, int, int); +let something = Zero; +let testSwitch = + switch (something) { + | Zero + | One(_) => 10 + | Three(_, _, _) => 100 + }; + +let thisWillCompileButLetsSeeHowItFormats = + fun + | Zero + | Three(_, _, _) => 10 + | One(_) => 20; + +/* Comment on two */ +/** + * GADTs. + */ +type term<_> = + | Int(int): term + | Add: term<(int, int) => int> + | App(term<'b => 'a>, term<'b>): term<'a>; + +let rec eval: type a. term => a = + fun + | Int(n) => n + /* a = int */ + | Add => ((x, y) => x + y) + /* a = int => int => int */ + | App(f, x) => eval(f, eval(x)); + +let rec eval: type a. term => a = + x => + switch (x) { + | Int(n) => n + /* a = int */ + | Add => ((x, y) => x + y) + /* a = int => int => int */ + | App(f, x) => eval(f, eval(x)) + }; + +/* eval called at types (b=>a) and b for fresh b */ +let evalArg = App(App(Add, Int(1)), Int(1)); + +let two = eval(App(App(Add, Int(1)), Int(1))); + +type someVariant = + | Purple(int) + | Yellow(int); + +let Purple(x) | Yellow(x) = + switch (Yellow(100), Purple(101)) { + | (Yellow(y), Purple(p)) => Yellow(p + y) + | (Purple(p), Yellow(y)) => Purple(y + p) + | (Purple(p), Purple(y)) => Yellow(y + p) + | (Yellow(p), Yellow(y)) => Purple(y + p) + }; + +type tuples = + | Zero + | One(int) + | Two(int, int) + | OneTuple(int, int); + +let myTuple = OneTuple(20, 30); + +let res = + switch (myTuple) { + | Two(y, z) => + try(Two(y, z)) { + | Invalid_argument(_) => Zero + } + | One(_) => + switch (One(4)) { + | One(_) => Zero + | _ => Zero + } + | _ => Zero + }; + +/* FIXME type somePolyVariant = [ `Purple int | `Yellow int]; */ + +let ylw = #Yellow((100, 100)); + +let prp = #Purple((101, 100)); + +let res = + switch (ylw, prp) { + | (#Yellow(y, y2), #Purple(p, p2)) => #Yellow((p + y, 0)) + | (#Purple(p, p2), #Yellow(y, y2)) => #Purple((y + p, 0)) + | (#Purple(p, p2), #Purple(y, y2)) => #Yellow((y + p, 0)) + | (#Yellow(p, p2), #Yellow(y, y2)) => #Purple((y + p, 0)) + }; + +let ylw = #Yellow(100); + +let prp = #Purple(101); + +let res = + switch (ylw, prp) { + | (#Yellow(y), #Purple(p)) => #Yellow(p + y) + | (#Purple(p), #Yellow(y)) => #Purple(y + p) + | (#Purple(p), #Purple(y)) => #Yellow(y + p) + | (#Yellow(p), #Yellow(y)) => #Purple(y + p) + }; + +/* + * Now try polymorphic variants with *actual* tuples. + * You'll notice that these become indistinguishable from multiple constructor + * args! explicit_arity doesn't work on polymorphic variants! + * + * Way to resolve this (should also work for non-polymorphic variants): + * + * If you see *one* simple expr list that is a tuple, generate: + * Pexp_tuple (Pexp_tuple ..)) + * + * If you see *one* simple expr list that is *not* a tuple, generate: + * Pexp.. + * + * If you see *multiple* simple exprs, generate: + * Pexp_tuple.. + * + * Though, I'm not sure this will even work. + */ +let ylw = #Yellow((100, 100)); + +let prp = #Purple((101, 101)); + +let res = + switch (ylw, prp) { + | (#Yellow(y, y2), #Purple(p, p2)) => #Yellow((p + y, 0)) + | (#Purple(p, p2), #Yellow(y, y2)) => #Purple((y + p, 0)) + | (#Purple(p, p2), #Purple(y, y2)) => #Yellow((y + p, 0)) + | (#Yellow(p, p2), #Yellow(y, y2)) => #Purple((y + p, 0)) + }; + +type contentHolder<'a> = + | ContentHolderWithReallyLongNameCauseBreak('a) + | ContentHolder('a); + +/* + * When pretty printed, this appears to be multi-argument constructors. + */ +let prp = #Purple((101, 101)); + +let res = + switch (prp) { + | #Yellow(y, y2) => #Yellow((y2 + y, 0)) + | #Purple(p, p2) => #Purple((p2 + p, 0)) + }; + +/* + * Testing extensible variants + */ +type attr = ..; + +/* `of` is optional */ +type attr += + | StrString(string); + +type attr += + | Point2(int, int); + +type attr += + | Float(float) + | Char(char); + +type tag<'props> = ..; + +type titleProps = {title: string}; + +type tag<'props> += + | Title: tag + | Count(int): tag; + +module Graph = { + type node = ..; + type node += + | Str; +}; + +type Graph.node += + | Str = Graph.Str; + +type water = ..; + +type water += + pri + | Ocean; + +type water += + pri + | MineralWater + | SpringWater + | TapWater + | TableWater; +module Expr = { + type Graph.node += + | Node + | Atom; +}; +module F ={ + type Graph.node += + pri + | Node = Expr.Node; +} + +type Graph.node += + pri + | Node = Expr.Node + | Atom = Expr.Atom; + +type singleUnit = + | MyConstructorWithSingleUnitArg(unit); +/* without single unit arg sugar */ +MyConstructorWithSingleUnitArg(); +/* with single unit arg sugar */ +MyConstructorWithSingleUnitArg(); +/* without single unit arg sugar */ +#polyVariantWithSingleUnitArg(); +/* with single unit arg sugar */ +#polyVariantWithSingleUnitArg(); + +let x = #Poly; + +/* Format doc attrs consistent: https://github.com/facebook/reason/issues/2187 */ +type t = + | /** This is some documentation that might be fairly long and grant a line break */ + A + | /** Shorter docs */ + B + | /** Some more longer docs over here that make sense to break lines on too */ + C; + +/* https://github.com/facebook/reason/issues/1828 */ +type widget_state = [ + | #DEFAULT /* here */ + | #HOVER + | #ACTIVE +]; diff --git a/formatTest/unit_tests/expected_output/class_types.re b/formatTest/unit_tests/expected_output/class_types.re index c43771745..abe8156b9 100644 --- a/formatTest/unit_tests/expected_output/class_types.re +++ b/formatTest/unit_tests/expected_output/class_types.re @@ -37,3 +37,15 @@ class type t = { class type t = { open M; }; + +class intTuplesTuples = + class tupleClass( + #tupleClass(int, int), + #tupleClass(int, int), + ); + +class intTuplesTuples = + class tupleClass( + #tupleClass(int, int), + #tupleClass(int, int), + ); diff --git a/formatTest/unit_tests/expected_output/class_types_3_dot_8.re b/formatTest/unit_tests/expected_output/class_types_3_dot_8.re index 11e7e9714..42bf7ff59 100644 --- a/formatTest/unit_tests/expected_output/class_types_3_dot_8.re +++ b/formatTest/unit_tests/expected_output/class_types_3_dot_8.re @@ -10,7 +10,7 @@ class type bzz = { class type t = { as 'a; - constraint 'a = #s; + constraint 'a = *s; }; /* https://github.com/facebook/reason/issues/2037 */ diff --git a/formatTest/unit_tests/expected_output/ocaml_identifiers.re b/formatTest/unit_tests/expected_output/ocaml_identifiers.re index f0acc8ca0..945520670 100644 --- a/formatTest/unit_tests/expected_output/ocaml_identifiers.re +++ b/formatTest/unit_tests/expected_output/ocaml_identifiers.re @@ -1,5 +1,5 @@ -[@reason.version 3.7]; /* Type names (supported with PR#2342) */ +[@reason.version 3.7]; module T = { type pub_ = unit; }; diff --git a/formatTest/unit_tests/input/class_types.re b/formatTest/unit_tests/input/class_types.re index 168306e5a..8a3b4cd0a 100644 --- a/formatTest/unit_tests/input/class_types.re +++ b/formatTest/unit_tests/input/class_types.re @@ -35,3 +35,18 @@ class type t = { class type t = { open M; }; + +class intTuplesTuples = ( + class tupleClass( + (#tupleClass(int,int)), + (#tupleClass(int,int)) + ) +); + + +class intTuplesTuples = ( + class tupleClass( + (*tupleClass(int,int)), + (*tupleClass(int,int)) + ) +); diff --git a/formatTest/unit_tests/input/class_types_3_dot_8.re b/formatTest/unit_tests/input/class_types_3_dot_8.re index 50382cf3a..7ea0c7c50 100644 --- a/formatTest/unit_tests/input/class_types_3_dot_8.re +++ b/formatTest/unit_tests/input/class_types_3_dot_8.re @@ -11,7 +11,7 @@ class type bzz = { }; class type t = { as 'a; - constraint 'a = #s + constraint 'a = *s }; /* https://github.com/facebook/reason/issues/2037 */ diff --git a/formatTest/unit_tests/input/ocaml_identifiers.ml b/formatTest/unit_tests/input/ocaml_identifiers.ml index 61182be31..ea330e6fc 100644 --- a/formatTest/unit_tests/input/ocaml_identifiers.ml +++ b/formatTest/unit_tests/input/ocaml_identifiers.ml @@ -1,4 +1,5 @@ (* Type names (supported with PR#2342) *) +[@@@reason.version 3.7] module T = struct type pub = unit end @@ -92,4 +93,4 @@ let x = List.map (fun y -> (); y) -let newType (type method_) () = () \ No newline at end of file +let newType (type method_) () = () diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 1d0897e86..6560a67cf 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -88,7 +88,7 @@ (public_name reason) (wrapped false) (flags - (:standard -w -9-52 -safe-string)) + (:standard -short-paths -w -9-52 -safe-string)) (modules ocaml_util reason_syntax_util reason_comment reason_attributes reason_layout reason_heuristics reason_location reason_toolchain_conf reason_toolchain_reason reason_toolchain_ocaml reason_toolchain diff --git a/src/reason-parser/reason_declarative_lexer.mll b/src/reason-parser/reason_declarative_lexer.mll index bd135b1e7..f1a3b20b2 100644 --- a/src/reason-parser/reason_declarative_lexer.mll +++ b/src/reason-parser/reason_declarative_lexer.mll @@ -306,7 +306,6 @@ let update_loc lexbuf file line absolute chars = pos_lnum = if absolute then line else pos.pos_lnum + line; pos_bol = pos.pos_cnum - chars; } - } @@ -325,6 +324,7 @@ let identchar_latin1 = let operator_chars = ['!' '$' '%' '&' '+' '-' ':' '<' '=' '>' '?' '@' '^' '|' '~' '#' '.'] | ( '\\'? ['/' '*'] ) + let dotsymbolchar = ['!' '$' '%' '&' '*' '+' '-' '/' ':' '=' '>' '?' '@' '^' '|' '\\' 'a'-'z' 'A'-'Z' '_' '0'-'9'] let kwdopchar = ['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|' '.' '!'] @@ -346,6 +346,27 @@ let float_literal = ('.' ['0'-'9' '_']* )? (['e' 'E'] ['+' '-']? ['0'-'9'] ['0'-'9' '_']*)? +(* Will parse a patch version, as well as a leading v, and then we will just + * drop those. This is to gracefully handle if the user accidentally typed a v + * out in front or a patch version. It will be printed away. It will be printed + * back into the standard form [@reason.version 3.8] so that someone can + * contribute to a codebase that hasn't upgraded yet, but test a new version of + * Reason Syntax. + * + * Accepts: + * [@reason.version 3.8] + * [@reason.version 3.8.9] + * [@reason.version v3.8] + * [@reason.version v3.8.9] + * Eventually support: + * [@reason.3.8] + *) +let version_attribute = + "[@reason.version " + 'v'?(['0'-'9']+ as major) + '.' (['0'-'9']+ as minor) + (('.' ['0'-'9']+)? as _patch) ']' + let hex_float_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f'] ['0'-'9' 'A'-'F' 'a'-'f' '_']* @@ -354,20 +375,20 @@ let hex_float_literal = let literal_modifier = ['G'-'Z' 'g'-'z'] -rule token state = parse +rule base_token extends_tokenizer state = parse | "\\" newline { raise_error (Location.curr lexbuf) (Illegal_character (Lexing.lexeme_char lexbuf 0)); update_loc lexbuf None 1 false 0; - token state lexbuf + extends_tokenizer state lexbuf } | newline { update_loc lexbuf None 1 false 0; - token state lexbuf + extends_tokenizer state lexbuf } | blank + - { token state lexbuf } + { extends_tokenizer state lexbuf } | "_" { UNDERSCORE } | "~" @@ -381,14 +402,20 @@ rule token state = parse try Hashtbl.find keyword_table s with Not_found -> LIDENT s } - | "`" (lowercase | uppercase) identchar * - { let s = Lexing.lexeme lexbuf in - let word = String.sub s 1 (String.length s - 1) in - match Hashtbl.find keyword_table word with - | exception Not_found -> NAMETAG word - | _ -> - raise_error (Location.curr lexbuf) (Keyword_as_tag word); - LIDENT "thisIsABugReportThis" + | "`" ((lowercase | uppercase) identchar *) + { + if Reason_version.fast_parse_supports_HashVariantsColonMethodCallStarClassTypes () then ( + set_lexeme_length lexbuf 1; + SHARP_3_7 + ) else ( + let s = Lexing.lexeme lexbuf in + let word = String.sub s 1 (String.length s - 1) in + match Hashtbl.find keyword_table word with + | exception Not_found -> NAMETAG word + | _ -> + raise_error (Location.curr lexbuf) (Keyword_as_tag word); + LIDENT "thisIsABugReportThis" + ) } | lowercase_latin1 identchar_latin1 * { Ocaml_util.warn_latin1 lexbuf; LIDENT (Lexing.lexeme lexbuf) } @@ -465,23 +492,7 @@ rule token state = parse { CHAR (char_for_hexadecimal_code lexbuf 3) } | "'" (("\\" _) as esc) { raise_error (Location.curr lexbuf) (Illegal_escape esc); - token state lexbuf - } - | "#=<" - { (* Allow parsing of foo#= *) - set_lexeme_length lexbuf 2; - SHARPEQUAL - } - | "#=" - { SHARPEQUAL } - | "#" operator_chars+ - { SHARPOP (lexeme_operator lexbuf) } - (* File name / line number source mapping # n string\n *) - | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']* - ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")? - [^ '\010' '\013'] * newline - { update_loc lexbuf name (int_of_string num) true 0; - token state lexbuf + extends_tokenizer state lexbuf } | "&" { AMPERSAND } | "&&" { AMPERAMPER } @@ -497,30 +508,19 @@ rule token state = parse set_lexeme_length lexbuf 2; EQUALGREATER } - | "#" { SHARP } | "." { DOT } | ".." { DOTDOT } | "..."{ DOTDOTDOT } | ":" { COLON } - | "::" { COLONCOLON } | ":=" { COLONEQUAL } | ":>" { COLONGREATER } | ";" { SEMI } | ";;" { SEMISEMI } - | "<" { LESS } | "=" { EQUAL } | "[" { LBRACKET } | "[|" { LBRACKETBAR } | "[<" { LBRACKETLESS } | "[>" { LBRACKETGREATER } - | "<" (((uppercase identchar* '.')* - (lowercase_no_under | lowercase identchar identchar*)) as tag) - (* Parsing <_ helps resolve no conflicts in the parser and creates other - * challenges with splitting up INFIXOP0 tokens (in Reason_parser_single) - * so we don't do it. *) - { LESSIDENT tag } - | "<" ((uppercase identchar*) as tag) - { LESSUIDENT tag } | ">..." { GREATERDOTDOTDOT } (* Allow parsing of Pexp_override: * let z = {}; @@ -599,7 +599,7 @@ rule token state = parse set_lexeme_length lexbuf 1; GREATER } - | "[@reason.version " (['0'-'9']+ as major) '.' (['0'-'9']+ as minor) (('.' ['0'-'9']+)? as _patch) ']' { + | version_attribute { (* Special case parsing of attribute so that we can special case its * parsing. Parses x.y.z even though it is not valid syntax otherwise - * just gracefully remove the last number. The parser will ignore this @@ -607,7 +607,11 @@ rule token state = parse * the attribute into the footer of the file. Then the printer will ensure * it is formatted at the top of the file, ideally after the first file * floating doc comment. *) - VERSION_ATTRIBUTE (int_of_string major, int_of_string minor) + (* TODO: Error if version has already been set explicitly in token stream *) + let major = int_of_string major in + let minor = int_of_string minor in + Reason_version.record_explicit_version_in_ast_if_not_yet major minor; + VERSION_ATTRIBUTE (major, minor) } | "[@" { LBRACKETAT } | "[%" { LBRACKETPERCENT } @@ -627,6 +631,19 @@ rule token state = parse | "<..>" { LESSDOTDOTGREATER } | '\\'? ['~' '?' '!'] operator_chars+ { PREFIXOP (lexeme_operator lexbuf) } + (* The parsing of various LESS* needs to happen after parsing all the other + * tokens that start with < except before parsing INFIXOP0 *) + | "<" (blank | newline) { + set_lexeme_length lexbuf 1; + LESS_THEN_SPACE + } + | "<" + (* Parsing <_ helps resolve no conflicts in the parser and creates other + * challenges with splitting up INFIXOP0 tokens (in Reason_parser_single) + * so we don't do it. *) + { + LESS_THEN_NOT_SPACE + } | '\\'? ['=' '<' '>' '|' '&' '$'] operator_chars* { (* See decompose_token in Reason_single_parser.ml for how let `x=-1` is lexed @@ -677,12 +694,14 @@ rule token state = parse { LETOP (lexeme_operator lexbuf) } | "and" kwdopchar dotsymbolchar * { ANDOP (lexeme_operator lexbuf) } - | eof { EOF } + | eof { + EOF } | _ - { raise_error + { + raise_error (Location.curr lexbuf) (Illegal_character (Lexing.lexeme_char lexbuf 0)); - token state lexbuf + extends_tokenizer state lexbuf } and enter_comment state = parse @@ -799,7 +818,6 @@ and comment buffer firstloc nestedloc = parse { store_lexeme buffer lexbuf; comment buffer firstloc nestedloc lexbuf } - | "'" newline "'" { store_lexeme buffer lexbuf; update_loc lexbuf None 1 false 1; @@ -826,6 +844,61 @@ and comment buffer firstloc nestedloc = parse comment buffer firstloc nestedloc lexbuf } + +and token_v3_7 state = parse + (* All of the sharpops need to be duplicated as well because they + * need to take priority over # *) + | "#=<" + { (* Allow parsing of foo#= *) + set_lexeme_length lexbuf 2; + SHARPEQUAL + } + | "#=" { SHARPEQUAL } + | "#" operator_chars+ + { SHARPOP (lexeme_operator lexbuf) } + (* File name / line number source mapping # n string\n *) + | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']* + ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")? + [^ '\010' '\013'] * newline + { update_loc lexbuf name (int_of_string num) true 0; + token_v3_7 state lexbuf + } + | "#" { SHARP_3_7 } + | "::" { COLONCOLON_3_7 } + (* EOF must be handled here because there's no way to unlex it before + * dispatching to the base lexer *) + | eof { EOF } + | _ { + set_lexeme_length lexbuf 0; + base_token token_v3_7 state lexbuf } + +and token_v3_8 state = parse + (* All of the sharpops need to be duplicated as well because they + * need to take priority over # *) + | "#=<" + { (* Allow parsing of foo#= *) + set_lexeme_length lexbuf 2; + SHARPEQUAL + } + | "#=" { SHARPEQUAL } + | "#" operator_chars+ + { SHARPOP (lexeme_operator lexbuf) } + (* File name / line number source mapping # n string\n *) + | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']* + ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")? + [^ '\010' '\013'] * newline + { update_loc lexbuf name (int_of_string num) true 0; + token_v3_8 state lexbuf + } + | "#" { SHARP_3_8 } + | "::" { COLONCOLON_3_8 } + (* EOF must be handled here because there's no way to unlex it before + * dispatching to the base lexer *) + | eof { EOF } + | _ { + set_lexeme_length lexbuf 0; + base_token token_v3_8 state lexbuf } + (** [string rawbuf txtbuf lexbuf] parses a string from [lexbuf]. The string contents is stored in two buffers: - [rawbuf] for the text as it literally appear in the source diff --git a/src/reason-parser/reason_lexer.ml b/src/reason-parser/reason_lexer.ml index c8f3e1a0d..48ff24972 100644 --- a/src/reason-parser/reason_lexer.ml +++ b/src/reason-parser/reason_lexer.ml @@ -32,16 +32,20 @@ let init ?insert_completion_ident lexbuf = let lexbuf state = state.lexbuf -let rec comment_capturing_tokenizer tokenizer = - fun state -> +let rec comment_capturing_version_switching_token state = + let tokenizer = + if Reason_version.fast_parse_supports_HashVariantsColonMethodCallStarClassTypes () then + Reason_declarative_lexer.token_v3_8 + else + Reason_declarative_lexer.token_v3_7 + in match tokenizer state.declarative_lexer_state state.lexbuf with | COMMENT (s, comment_loc) -> state.comments <- (s, comment_loc) :: state.comments; - comment_capturing_tokenizer tokenizer state + comment_capturing_version_switching_token state | tok -> tok - -let token a = (comment_capturing_tokenizer Reason_declarative_lexer.token) a +let token = comment_capturing_version_switching_token let token_after_interpolation_region state = Reason_declarative_lexer.token_in_template_string_region diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index c8b66b8f7..a7d8714b8 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -925,6 +925,12 @@ let rewriteFunctorApp module_name elt loc = else mkexp ~loc (Pexp_ident {txt=Ldot (module_name, elt); loc}) + +let rec jsx_has_functor_app = function + | Lident _ -> false + | Ldot (l, _) -> jsx_has_functor_app l + | Lapply (_, _) -> true + let jsx_component lid attrs children loc = let is_module_name = function | Lident s @@ -1003,6 +1009,12 @@ let raise_record_trailing_semi_error loc = "Record entries are separated by comma; \ we've found a semicolon instead." +let raise_functor_app_with_lident_access loc = + syntax_error_exp loc + "JSX syntax does not allow accessing a specific lower cased identifier \ + after functor application such as " + + let raise_record_trailing_semi_error' loc = (Some (raise_record_trailing_semi_error loc), []) @@ -1112,7 +1124,8 @@ let add_brace_attr expr = %token CHAR %token CLASS %token COLON -%token COLONCOLON +%token COLONCOLON_3_7 +(* See COLONCOLON_3_8 which is only parsed in newer Reason Syntax and with SHARP precedence *) %token COLONEQUAL %token COLONGREATER %token COMMA @@ -1164,9 +1177,8 @@ let add_brace_attr expr = %token LBRACKETGREATER %token LBRACKETPERCENT %token LBRACKETPERCENTPERCENT -%token LESS -%token LESSIDENT [@recover.expr ""] [@recover.cost 2] -%token LESSUIDENT [@recover.expr ""] [@recover.cost 2] +%token LESS_THEN_SPACE +%token LESS_THEN_NOT_SPACE %token LESSGREATER %token LESSSLASHGREATER %token LESSDOTDOTGREATER @@ -1207,7 +1219,10 @@ let add_brace_attr expr = %token LESSSLASHIDENTGREATER [@recover.expr ""] [@recover.cost 2] %token SEMI %token SEMISEMI -%token SHARP +%token SHARP_3_7 +(* SHARP operator for v3.8+ *) +%token SHARP_3_8 +%token COLONCOLON_3_8 %token SHARPOP %token SHARPEQUAL %token SIG @@ -1271,10 +1286,11 @@ conflicts. %right OR BARBAR (* expr (e || e || e) *) %right AMPERSAND AMPERAMPER (* expr (e && e && e) *) -%left INFIXOP0 LESS GREATER GREATERDOTDOTDOT (* expr (e OP e OP e) *) +(* Menhir says that it is useless to include LESS_THEN_NOT_SPACE in the following list *) +%left INFIXOP0 LESS_THEN_SPACE GREATER GREATERDOTDOTDOT (* expr (e OP e OP e) *) %left LESSDOTDOTGREATER (* expr (e OP e OP e) *) %right INFIXOP1 (* expr (e OP e OP e) *) -%right COLONCOLON (* expr (e :: e :: e) *) +%right COLONCOLON_3_7 (* expr (e :: e :: e) *) %left INFIXOP2 PLUS PLUSDOT MINUS MINUSDOT PLUSEQ (* expr (e OP e OP e) *) %left PERCENT INFIXOP3 SLASHGREATER STAR (* expr (e OP e OP e) *) %right INFIXOP4 (* expr (e OP e OP e) *) @@ -1362,7 +1378,8 @@ conflicts. (* PREFIXOP and BANG precedence *) %nonassoc below_DOT_AND_SHARP (* practically same as below_SHARP but we convey purpose *) -%nonassoc SHARP (* simple_expr/toplevel_directive *) +%nonassoc SHARP_3_7 (* simple_expr/toplevel_directive *) +%nonassoc COLONCOLON_3_8 (* e::methodA::methodB is (e::methodA)::methodB *) %nonassoc below_DOT (* We need SHARPEQUAL to have lower precedence than `[` to make e.g. @@ -1429,7 +1446,7 @@ conflicts. implementation: structure EOF { - let itms = Reason_version.Ast_nodes.inject_attr_from_version_impl $1 in + let itms = Reason_version.Ast_nodes.inject_attr_to_instruct_printing_impl $1 in apply_mapper_to_structure itms reason_mapper } ; @@ -1437,7 +1454,7 @@ implementation: interface: signature EOF { - let itms = Reason_version.Ast_nodes.inject_attr_from_version_intf $1 in + let itms = Reason_version.Ast_nodes.inject_attr_to_instruct_printing_intf $1 in apply_mapper_to_signature itms reason_mapper } ; @@ -2716,18 +2733,26 @@ jsx_arguments: ; jsx_start_tag_and_args: - as_loc(LESSIDENT) jsx_arguments - { let name = parse_lid $1.txt in - (jsx_component {$1 with txt = name} $2, name) - } - | LESS as_loc(LIDENT) jsx_arguments - { let name = parse_lid $2.txt in + | LESS_THEN_NOT_SPACE as_loc(LIDENT) jsx_arguments + { + let name = parse_lid $2.txt in (jsx_component {$2 with txt = name} $3, name) } - | LESS as_loc(mod_ext_longident) jsx_arguments + | LESS_THEN_NOT_SPACE as_loc(mod_ext_longident) DOT LIDENT jsx_arguments + { + if jsx_has_functor_app $2.txt then + let name = Longident.parse $4 in + (fun _children _loc -> + raise_functor_app_with_lident_access (mklocation $startpos($4) $endpos($4))), + name + else ( + let name = Ldot($2.txt, $4) in + let loc_long_ident = mklocation $startpos($2) $endpos($4) in + (jsx_component {loc = loc_long_ident; txt = name} $5, name) + ) + } + | LESS_THEN_NOT_SPACE as_loc(mod_ext_longident) jsx_arguments { jsx_component $2 $3, $2.txt } - | as_loc(mod_ext_lesslongident) jsx_arguments - { jsx_component $1 $2, $1.txt } ; jsx_start_tag_and_args_without_leading_less: @@ -2817,7 +2842,7 @@ jsx_without_leading_less: (Nolabel, mkexp_constructor_unit loc loc) ] loc } - | jsx_start_tag_and_args_without_leading_less greater_spread simple_expr_no_call LESSSLASHIDENTGREATER { + | jsx_start_tag_and_args_without_leading_less greater_spread simple_expr_no_call LESSSLASHIDENTGREATER { let (component, start) = $1 in let loc = mklocation $symbolstartpos $endpos in (* TODO: Make this tag check simply a warning *) @@ -2836,6 +2861,11 @@ optional_expr_extension: | item_extension_sugar { fun exp -> expression_extension $1 exp } ; +%inline coloncolon: + | COLONCOLON_3_7 { $1 } + | COLONCOLON_3_8 { $1 } +; + (* * Parsing of expressions is quite involved as it depends on context. * At the top-level of a structure, expressions can't have attributes @@ -2889,7 +2919,7 @@ mark_position_exp | FOR optional_expr_extension LPAREN pattern IN expr direction_flag expr RPAREN simple_expr { $2 (mkexp (Pexp_for($4, $6, $8, $7, $10))) } - | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN + | LPAREN coloncolon RPAREN LPAREN expr COMMA expr RPAREN { let loc_colon = mklocation $startpos($2) $endpos($2) in let loc = mklocation $symbolstartpos $endpos in mkexp_cons loc_colon (mkexp ~ghost:true ~loc (Pexp_tuple[$5;$7])) loc @@ -3006,6 +3036,11 @@ parenthesized_expr: filter_raise_spread_syntax msg $2 }; +%inline send: + | SHARP_3_7 {$1} + | COLONCOLON_3_8 {$1} +; + %inline bigarray_access: DOT LBRACE lseparated_nonempty_list(COMMA, expr) COMMA? RBRACE { $3 } @@ -3117,7 +3152,7 @@ parenthesized_expr: let exp = Exp.mk ~loc ~attrs:[] (Pexp_override $4) in mkexp (Pexp_open(od, exp)) } - | E SHARP as_loc(label) + | E send as_loc(label) { mkexp (Pexp_send($1, $3)) } | E as_loc(SHARPOP) simple_expr_no_call { mkinfixop $1 (mkoperator $2) $3 } @@ -3711,14 +3746,14 @@ mark_position_pat | name_tag simple_pattern { mkpat (Ppat_variant($1, Some $2)) } - | pattern_without_or as_loc(COLONCOLON) pattern_without_or + | pattern_without_or as_loc(coloncolon) pattern_without_or { syntax_error $2.loc ":: is not supported in Reason, please use [hd, ...tl] instead"; let loc = mklocation $symbolstartpos $endpos in mkpat_cons (mkpat ~ghost:true ~loc (Ppat_tuple[$1;$3])) loc } - | LPAREN COLONCOLON RPAREN LPAREN pattern_without_or COMMA pattern_without_or RPAREN + | LPAREN coloncolon RPAREN LPAREN pattern_without_or COMMA pattern_without_or RPAREN { let loc = mklocation $symbolstartpos $endpos in mkpat_cons (mkpat ~ghost:true ~loc (Ppat_tuple[$5;$7])) loc } @@ -3761,6 +3796,10 @@ simple_pattern_ident: as_loc(val_ident) { mkpat ~loc:$1.loc (Ppat_var $1) } ; +%inline polyvariant_pat: + | SHARP_3_7 type_longident { mkpat (Ppat_type ($2)) } + | STAR type_longident { mkpat (Ppat_type ($2)) } + simple_pattern_not_ident: mark_position_pat ( UNDERSCORE @@ -3777,8 +3816,7 @@ mark_position_pat { mkpat (Ppat_construct ($1, None)) } | name_tag { mkpat (Ppat_variant ($1, None)) } - | SHARP type_longident - { mkpat (Ppat_type ($2)) } + | polyvariant_pat { $1 } | LPAREN lseparated_nonempty_list(COMMA, pattern_optional_constraint) COMMA? RPAREN { match $2 with | [] -> (* This shouldn't be possible *) @@ -4486,26 +4524,8 @@ non_arrowed_core_type: | lseparated_nonempty_list(COMMA, protected_type) COMMA? {$1} ; -%inline first_less_than_type_ident: - LESSIDENT { Lident $1 } - -(* Since the Lapply (p1, p2)) $1 $2 - } -; - - - - - - - mty_longident: | ident { Lident $1 } @@ -4873,7 +4869,7 @@ class_longident: (* Toplevel directives *) toplevel_directive: - SHARP as_loc(ident) embedded + SHARP_3_7 as_loc(ident) embedded ( (* empty *) { None } | STRING { let (s, _, _) = $1 in Some(Pdir_string s) } | INT { let (n, m) = $1 in Some(Pdir_int (n, m)) } @@ -4902,7 +4898,11 @@ toplevel_directive: opt_LET_MODULE: MODULE { () } | LET MODULE { () }; -%inline name_tag: NAMETAG { $1 }; +%inline name_tag: + | NAMETAG { $1 } + | SHARP_3_8 LIDENT { $2 } + | SHARP_3_8 UIDENT { $2 } +; %inline label: LIDENT { $1 }; @@ -5022,7 +5022,7 @@ attribute: (* Just ignore the attribute in the AST at this point, but record its version, * then we wil add it back at the "top" of the file. *) let major, minor = $1 in - Reason_version.set_explicit (major, minor); + Reason_version.record_explicit_version_in_ast_if_not_yet major minor; let attr_payload = Reason_version.Ast_nodes.mk_version_attr_payload major minor in let loc = mklocation $symbolstartpos $endpos in { attr_name = {loc; txt="reason.version"}; @@ -5188,8 +5188,15 @@ lseparated_nonempty_list_aux(sep, X): %inline parenthesized(X): delimited(LPAREN, X, RPAREN) { $1 }; +%inline either_kind_of_less: + | LESS_THEN_NOT_SPACE { $1 } + | LESS_THEN_SPACE { $1 } + (*Less than followed by one or more X, then greater than *) -%inline lessthangreaterthanized(X): delimited(LESS, X, GREATER) { $1 }; +%inline lessthangreaterthanized(X): delimited(either_kind_of_less, X, GREATER) { + Reason_version.refine_inferred Reason_version.AngleBracketTypes; + $1 +}; (*Less than followed by one or more X, then greater than *) %inline loptioninline(X): ioption(X) { match $1 with None -> [] | Some x -> x}; diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index d62a1fd36..93dcf4a05 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -1063,27 +1063,6 @@ let makeAppList = function | [hd] -> hd | l -> makeList ~inline:(true, true) ~postSpace:true ~break:IfNeed l -let makeTup ?(wrap=("", ""))?(trailComma=true) ?(uncurried = false) l = - let (lwrap, rwrap) = wrap in - let lparen = lwrap ^ (if uncurried then "(. " else "(") in - makeList - ~wrap:(lparen, ")" ^ rwrap) - ~sep:(if trailComma then commaTrail else commaSep) - ~postSpace:true - ~break:IfNeed l - -(* Makes angle brackets < > *) -let typeParameterBookends ?(wrap=("", ""))?(trailComma=true) l = - let useAngle = Reason_version.supports Reason_version.AngleBracketTypes in - let left = if useAngle then "<" else "(" in - let right = if useAngle then ">" else ")" in - let (lwrap, rwrap) = wrap in - let lparen = lwrap ^ left in - makeList - ~wrap:(lparen, right ^ rwrap) - ~sep:(if trailComma then commaTrail else commaSep) - ~postSpace:true - ~break:IfNeed l let ensureSingleTokenSticksToLabel x = let listConfigIfCommentsInterleaved cfg = @@ -1156,6 +1135,53 @@ let atom ?loc str = let style = { Easy_format.atom_style = Some "atomClss" } in source_map ?loc (Layout.Easy (Easy_format.Atom(str, style))) +let makeTup ?(wrap=("", ""))?(trailComma=true) ?(uncurried = false) l = + let (lwrap, rwrap) = wrap in + let lparen = lwrap ^ (if uncurried then "(. " else "(") in + makeList + ~wrap:(lparen, ")" ^ rwrap) + ~sep:(if trailComma then commaTrail else commaSep) + ~postSpace:true + ~break:IfNeed l + +(* Makes angle brackets < > *) +let typeParameterBookends ?(wrap=("", ""))?(trailComma=true) l = + let useAngle = Reason_version.print_supports Reason_version.AngleBracketTypes in + let left = if useAngle then "<" else "(" in + let right = if useAngle then ">" else ")" in + let (lwrap, rwrap) = wrap in + let lparen = lwrap ^ left in + makeList + ~wrap:(lparen, right ^ rwrap) + ~sep:(if trailComma then commaTrail else commaSep) + ~postSpace:true + ~break:IfNeed l + +let classTypeIdent formattedLongIdent = + let useStar = Reason_version.print_supports Reason_version.HashVariantsColonMethodCallStarClassTypes in + if useStar then + makeList [atom "*"; formattedLongIdent] + else makeList [atom "#"; formattedLongIdent] + +(* For matching on polymorphic variant types *) +let typePattern formattedLongIdent = + let useStar = Reason_version.print_supports Reason_version.HashVariantsColonMethodCallStarClassTypes in + if useStar then + makeList [atom "*"; formattedLongIdent] + else makeList [atom "#"; formattedLongIdent] + +let methodSend formattedObj = + let useColon = + Reason_version.print_supports Reason_version.HashVariantsColonMethodCallStarClassTypes in + if useColon then + label ~break:`Never formattedObj (atom "::") + else makeList [formattedObj; atom "#"] + +let polyVariantToken () = + let useColon = + Reason_version.print_supports Reason_version.HashVariantsColonMethodCallStarClassTypes in + if useColon then "#" else "`" + (** Take x,y,z and n and generate [x, y, z, ...n] *) let makeES6List ?wrap:((lwrap,rwrap)=("", "")) lst last = makeList @@ -2830,7 +2856,7 @@ let printer = object(self:'self) let ct = self#core_type arg in let ct = match arg.ptyp_desc with | Ptyp_tuple _ -> ct - | _ -> typeParameterBookends [ct] + | _ -> formatPrecedence ct in if i == 0 && not opt_ampersand then ct @@ -2886,7 +2912,7 @@ let printer = object(self:'self) add_bar fullLbl in - let prefix = if polymorphic then "`" else "" in + let prefix = if polymorphic then polyVariantToken () else "" in let sourceMappedName = atom ~loc:pcd_name.loc (prefix ^ pcd_name.txt) in let sourceMappedNameWithAttributes = let layout = match stdAttrs with @@ -3206,14 +3232,14 @@ let printer = object(self:'self) | (Closed,Some tl) -> ("<", tl) | (Open,_) -> (">", []) in let node_list = List.mapi variant_helper l in - let ll = (List.map (fun t -> atom ("`" ^ t)) tl) in + let ll = (List.map (fun t -> atom (polyVariantToken () ^ t)) tl) in let tag_list = makeList ~postSpace:true ~break:IfNeed ((atom ">")::ll) in let type_list = if tl != [] then node_list@[tag_list] else node_list in makeList ~wrap:("[" ^ designator,"]") ~pad:(true, false) ~postSpace:true ~break:IfNeed type_list - | Ptyp_class (li, []) -> makeList [atom "#"; self#longident_loc li] + | Ptyp_class (li, []) -> classTypeIdent (self#longident_loc li) | Ptyp_class (li, l) -> label - (makeList [atom "#"; self#longident_loc li]) + (classTypeIdent (self#longident_loc li)) (typeParameterBookends (List.map self#core_type l)) | Ptyp_extension e -> self#extension e | Ptyp_arrow (_, _, _) @@ -3333,7 +3359,7 @@ let printer = object(self:'self) raise (NotPossible "Should never see embedded attributes on poly variant") else source_map ~loc:x.ppat_loc - (self#constructor_pattern (atom ("`" ^ l)) p + (self#constructor_pattern (atom (polyVariantToken () ^ l)) p ~polyVariant:true ~arityIsClear:true) | Ppat_lazy p -> label ~space:true (atom "lazy") (self#simple_pattern p) | Ppat_construct (({txt} as li), po) when not (txt = Lident "::")-> (* FIXME The third field always false *) @@ -3506,8 +3532,7 @@ let printer = object(self:'self) label (label (self#longident_loc lid) (atom ("."))) (if needsParens then formatPrecedence pat else pat) - | Ppat_type li -> - makeList [atom "#"; self#longident_loc li] + | Ppat_type li -> typePattern (self#longident_loc li) | Ppat_record (l, closed) -> self#patternRecord l closed | Ppat_tuple l -> @@ -3517,7 +3542,7 @@ let printer = object(self:'self) (self#constant ?raw_literal c) | Ppat_interval (c1, c2) -> makeList ~postSpace:true [self#constant c1; atom ".."; self#constant c2] - | Ppat_variant (l, None) -> makeList[atom "`"; atom l] + | Ppat_variant (l, None) -> makeList[atom (polyVariantToken ()); atom l] | Ppat_constraint _ -> formatPrecedence (self#pattern x) | Ppat_lazy p ->formatPrecedence (label ~space:true (atom "lazy") (self#simple_pattern p)) @@ -4392,7 +4417,7 @@ let printer = object(self:'self) if arityAttrs != [] then raise (NotPossible "Should never see embedded attributes on poly variant") else - FunctionApplication [self#constructor_expression ~polyVariant:true ~arityIsClear:true stdAttrs (atom ("`" ^ l)) eo] + FunctionApplication [self#constructor_expression ~polyVariant:true ~arityIsClear:true stdAttrs (atom (polyVariantToken () ^ l)) eo] (* TODO: Should protect this identifier *) | Pexp_setinstvar (s, rightExpr) -> let rightItm = self#unparseResolvedRule ( @@ -6508,7 +6533,7 @@ let printer = object(self:'self) [formatCoerce (self#unparseExpr e) optFormattedType (self#core_type ct)] ) | Pexp_variant (l, None) -> - Some (ensureSingleTokenSticksToLabel (atom ("`" ^ l))) + Some (ensureSingleTokenSticksToLabel (atom (polyVariantToken () ^ l))) | Pexp_record (l, eo) -> Some (self#unparseRecord l eo) | Pexp_array l -> Some (self#unparseSequence ~construct:`Array l) @@ -6548,7 +6573,7 @@ let printer = object(self:'self) in let lhs = self#simple_enough_to_be_lhs_dot_send e in let lhs = if needparens then makeList ~wrap:("(",")") [lhs] else lhs in - Some (label (makeList [lhs; atom "#";]) (atom s.txt)) + Some (label (methodSend lhs) (atom s.txt)) | _ -> None in match item with @@ -8410,16 +8435,26 @@ let record_version_mapper super = let super_structure_item = super.Ast_mapper.structure_item in let super_signature_item = super.Ast_mapper.signature_item in let structure_item mapper structure_item = - (match Reason_version.Ast_nodes.extract_version_attribute_structure_item structure_item with - | None -> () - | Some(mjr, mnr) -> Reason_version.set_explicit (mjr, mnr)); - super_structure_item mapper structure_item + let mapped = + match Reason_version.Ast_nodes.is_structure_version_attribute structure_item with + | None -> structure_item + | Some(_updater, mjr, mnr) -> + Reason_version.print_version.major <- mjr; + Reason_version.print_version.minor <- mnr; + structure_item + in + super_structure_item mapper mapped in let signature_item mapper signature_item = - (match Reason_version.Ast_nodes.extract_version_attribute_signature_item signature_item with - | None -> () - | Some(mjr, mnr) -> Reason_version.set_explicit (mjr, mnr)); - super_signature_item mapper signature_item + let mapped = + match Reason_version.Ast_nodes.is_sig_version_attribute signature_item with + | None -> signature_item + | Some(_updater, mjr, mnr) -> + Reason_version.print_version.major <- mjr; + Reason_version.print_version.minor <- mnr; + signature_item + in + super_signature_item mapper mapped in { super with Ast_mapper.structure_item; Ast_mapper.signature_item } @@ -8458,15 +8493,13 @@ let signature (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments (printer#signature - (Reason_version.Ast_nodes.inject_attr_from_version_intf - (apply_mapper_to_signature x preprocessing_mapper))) + ((apply_mapper_to_signature x preprocessing_mapper))) let structure (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments (printer#structure - (Reason_version.Ast_nodes.inject_attr_from_version_impl - (apply_mapper_to_structure x preprocessing_mapper))) + ((apply_mapper_to_structure x preprocessing_mapper))) let expression ppf x = format_layout ppf diff --git a/src/reason-parser/reason_single_parser.ml b/src/reason-parser/reason_single_parser.ml index 9f9392ead..c2049d14e 100644 --- a/src/reason-parser/reason_single_parser.ml +++ b/src/reason-parser/reason_single_parser.ml @@ -185,9 +185,19 @@ let common_remaining_infix_token pcur = | ['+'; '.'] -> Some(Reason_parser.PLUSDOT, pcur, advance pnext 1) | ['!'] -> Some(Reason_parser.BANG, pcur, pnext) | ['>'] -> Some(Reason_parser.GREATER, pcur, pnext) - | ['<'] -> Some(Reason_parser.LESS, pcur, pnext) - | ['#'] -> Some(Reason_parser.SHARP, pcur, pnext) - | [':'] -> Some(Reason_parser.COLON, pcur, pnext) + (* Return the more liberal of the two `LESS_THEN_SPACE`, + `LESS_THEN_NOT_SPACE` because terms can either parse with either, or + LESS_THEN_NOT_SPACE, so return the one that some rules demand, and others + can tolerate. *) + | ['<'] -> Some(Reason_parser.LESS_THEN_NOT_SPACE, pcur, pnext) + | ['*'] -> Some(Reason_parser.STAR, pcur, pnext) + | ['#'] -> + if Reason_version.fast_parse_supports_HashVariantsColonMethodCallStarClassTypes () then + Some(Reason_parser.SHARP_3_8, pcur, pnext) + else + Some(Reason_parser.SHARP_3_7, pcur, pnext) + | [':'] -> + Some(Reason_parser.COLON, pcur, pnext) | _ -> None let rec decompose_token pos0 split = @@ -209,7 +219,7 @@ let rec decompose_token pos0 split = | Some(r) -> Some(List.rev (r :: revFirstTwo))) (* For type parameters type t<+'a> = .. and t<#classNameOrPolyVariantKind>*) | '<' :: tl -> - let less = [Reason_parser.LESS, pcur, pnext] in + let less = [Reason_parser.LESS_THEN_NOT_SPACE, pcur, pnext] in if tl == [] then Some less else (match common_remaining_infix_token pcur tl with diff --git a/src/reason-version/reason_version.ml b/src/reason-version/reason_version.ml index 5a1d9e318..f92d94365 100644 --- a/src/reason-version/reason_version.ml +++ b/src/reason-version/reason_version.ml @@ -10,77 +10,216 @@ open Asttypes open Ast_helper type file_version = { - major : int; - minor : int; + mutable major : int; + mutable minor : int; } type package_version = { - major : int; - minor : int; - patch : int; + pkg_major : int; + pkg_minor : int; + pkg_patch : int; } type feature = | AngleBracketTypes + | HashVariantsColonMethodCallStarClassTypes (** * Tracks the current package version of Reason parser/printer. This is - * primarily for printing the version with `refmt --version`. + * primarily for printing the version with `refmt --version`, but could also + * used for defaulting printed version in attributes if not specified. *) let package_version = { - major = 3; - minor = 7; - patch = 0; + pkg_major = 3; + pkg_minor = 8; + pkg_patch = 0; } let package_version_string = - (string_of_int package_version.major) ^ + (string_of_int package_version.pkg_major) ^ "." ^ - (string_of_int package_version.minor) ^ + (string_of_int package_version.pkg_minor) ^ "." ^ - (string_of_int package_version.patch) + (string_of_int package_version.pkg_patch) (** - * Tracks the file version recorded in attribute. Defaults to 3.6 - - * the version before Reason's refmt began recording versions in - * editor formatting. +Version to begin parsing with, absent information stating otherwise +(attributes/forced command line) +*) +let default_file_version = {major = 3; minor = 7} + +(** * A combination of version_in_ast_attr, cli_arg_parse_version and + default_file_version together make up the effective parse version. Each one + has priority over the next. *) + +let unspecified () = {major = -1; minor = -1} + +(** +Tracks the file version recorded in the AST itself. +*) +let version_in_ast_attr = {major = -1; minor = -1} + +(** Records an explicit version to instruct parsing. This would mean that observing + an attribute with [@reason.version 3.8] is not necessary to get the lexer/parser + to begin parsing in version 3.8. *) +let cli_arg_parse_version = {major = -1; minor = -1} + +(** Track use of features that would automatically "upgrade"/promote the user. + There is a subset of features that would correctly lex/parse in an older + version, *or* a newer version, despite only being printed in the newer + version of Reason Syntax. + At the end of parsing, the inferred_promote_version will map replace + ast version nodes with the newly upgraded version so that if it was persisted + in binary form to disk, it could be input into refmt, as if that were the explicitly + set file version in the ast. *) +let inferred_promote_version = {major = -1; minor = -1} + +(** Records an explicit version to instruct printing. This would be something + that was *not* parsed but was explicitly set. It's kind of like + inferred_promote_version, but explicitly set instead of being inferred by usage. + - Command line arguments to force printing to a specific version. + - Some future explicit tag such as [@reason.upgradeTo 3.8] *) +let cli_arg_promote_version = {major = -1; minor = -1} + +(* Print version starts out as the default, but then before printing we search for + any attributes in the AST that tell us to print differently, and if found we + update this. *) +let print_version = default_file_version + +let all_supported_file_versions = [ + default_file_version; + {major = 3; minor = 8} +] + +let latest_version_for_package = + List.nth all_supported_file_versions (List.length all_supported_file_versions - 1) + + +let is_set file_version = + file_version.major > 0 && file_version.minor > 0 + +let is_set_maj_min maj min = + maj > 0 && min > 0 + +let set_explicit_parse_version maj min = + cli_arg_parse_version.major <- maj; + cli_arg_parse_version.minor <- min + +let set_explicit_promote_version maj min = + cli_arg_promote_version.major <- maj; + cli_arg_promote_version.minor <- min + +(** + * We refine the inferred version based on feature usage. *) -let explicit_file_version = {contents = None} - -(** We start out with an inferred file version of 3.6, the last minor version - * that did not format a version into the file. *) -let infered_file_version = {contents = {major = 3; minor = 6;}} - -let set_explicit (major, minor) = - explicit_file_version.contents <- Some {major; minor} - -let effective () = match explicit_file_version.contents with - | Some efv -> efv - | None -> infered_file_version.contents - -let within - ~inclusive:lower_inclusive - (low_mjr, low_mnr) - ~inclusive:upper_inclusive - (up_mjr, up_mnr) = - let ev = effective () in - let mjr, mnr = ev.major, ev.minor in - let lower_meets = - if lower_inclusive then mjr > low_mjr || (mjr == low_mjr && mnr >= low_mnr) - else mjr > low_mjr || (mjr == low_mjr && mnr > low_mnr) - in - let upper_meets = - if upper_inclusive then mjr < up_mjr || (mjr == up_mjr && mnr <= up_mnr) - else mjr < up_mjr || (mjr == up_mjr && mnr < up_mnr) - in - lower_meets && upper_meets +let refine_inferred feature_used = match feature_used with + | AngleBracketTypes + | HashVariantsColonMethodCallStarClassTypes -> ( + let upgrade_to_maj = 3 in + let upgrade_to_min = 8 in + if inferred_promote_version.major < upgrade_to_maj || + (inferred_promote_version.major == upgrade_to_maj && + inferred_promote_version.minor < upgrade_to_min) then ( + inferred_promote_version.major <- upgrade_to_maj; + inferred_promote_version.minor <- upgrade_to_min + ) + ) + +let record_explicit_version_in_ast_if_not_yet major minor = + if not (is_set version_in_ast_attr) then ( + version_in_ast_attr.major <- major; + version_in_ast_attr.minor <- minor + ) -let at_least (major, minor) = - within ~inclusive:true (major, minor) ~inclusive:true (10000,0) +(* Allocationless accessor that allows previewing effective version. + - First any observed version token in the ASt. + - Then abscent that, any cli --parse-version. + - Then the default parse version. + *) +let effective_parse_version_major () = + if version_in_ast_attr.major >= 0 then + version_in_ast_attr.major + else + (if cli_arg_parse_version.major >= 0 then cli_arg_parse_version.major else default_file_version.major) + +(* Allocationless accessor that allows previewing effective version. + - First any observed version token in the ASt. + - Then abscent that, any cli --parse-version. + - Then the default parse version. + *) +let effective_parse_version_minor () = + if version_in_ast_attr.minor >= 0 then + version_in_ast_attr.minor + else + (if cli_arg_parse_version.minor >= 0 then cli_arg_parse_version.minor else default_file_version.minor) + +(* Effective version to promote to. Unlike effective_parse_version_major, what + * you pass as the command line --promote-version takes precedence over what is + * observed in the AST (such as inferred upgrades) *) +let effective_promote_version_major () = + if cli_arg_promote_version.major >= 0 then + cli_arg_promote_version.major + else ( + if inferred_promote_version.major >= 0 then + inferred_promote_version.major + else + effective_parse_version_major () + ) + +let effective_promote_version_minor () = + if cli_arg_promote_version.minor >= 0 then + cli_arg_promote_version.minor + else ( + if inferred_promote_version.minor >= 0 then + inferred_promote_version.minor + else + effective_parse_version_minor () + ) + +let version_within mjr mnr ~inclusive:low_incl (low_mjr, low_mnr) ~inclusive:up_inc (up_mjr, up_mnr) = + let lower_meets = + if low_incl then mjr > low_mjr || (mjr == low_mjr && mnr >= low_mnr) + else mjr > low_mjr || (mjr == low_mjr && mnr > low_mnr) + in + let upper_meets = + if up_inc then mjr < up_mjr || (mjr == up_mjr && mnr <= up_mnr) + else mjr < up_mjr || (mjr == up_mjr && mnr < up_mnr) + in + lower_meets && upper_meets + +let parse_version_within ~inclusive = + let mjr = effective_parse_version_major () in + let mnr = effective_parse_version_minor () in + (* Since this relies on side effects, we need to not use partial application + * without any label *) + version_within mjr mnr ~inclusive + +let print_version_within ~inclusive = + let mjr = print_version.major in + let mnr = print_version.minor in + (* Since this relies on side effects, we need to not use partial application + * without any label *) + version_within mjr mnr ~inclusive + +(* Fast version of checker to be able to use in tight lexer loops *) +let fast_parse_supports_HashVariantsColonMethodCallStarClassTypes () = + let mjr = effective_parse_version_major () in + let mnr = effective_parse_version_minor () in + (mjr == 3 && mnr >= 8) || mjr > 3 + +let parse_version_at_least (major, minor) = + parse_version_within ~inclusive:true (major, minor) ~inclusive:true (10000,0) + +let print_version_at_least (major, minor) = + print_version_within ~inclusive:true (major, minor) ~inclusive:true (10000,0) -let supports = function - | AngleBracketTypes -> at_least (3, 8) +let parse_supports = function + | AngleBracketTypes -> parse_version_at_least (3, 8) + | HashVariantsColonMethodCallStarClassTypes -> parse_version_at_least (3, 8) +let print_supports = function + | AngleBracketTypes -> print_version_at_least (3, 8) + | HashVariantsColonMethodCallStarClassTypes -> print_version_at_least (3, 8) let dummy_loc () = { loc_start = Lexing.dummy_pos; @@ -101,7 +240,76 @@ let _split_on_char sep_char str = done; String.sub str 0 j.contents :: r.contents +(** + * A note on "promotion". + * We will infer that we should auto-upgrade based on usage of certain + * features. + * + * Promotion either upgrades the version tag during injection of the + * (otherwise) default version tag, or it upgrades/rewrites tags during print + * time if tags were already present. + *) module Ast_nodes = struct + let parse_version v = + match _split_on_char '.' v, "0" with + | ([maj], mnr) + | ([maj; ""], mnr) + | (maj :: mnr :: _, _) -> + let imaj, imin = int_of_string maj, int_of_string mnr in + Some (imaj, imin) + | _ -> None + + let is_structure_version_attribute = function + | { pstr_desc=( + Pstr_attribute ({ + attr_name={txt="reason.version"; _}; + attr_payload = + PStr [ + {pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_float(v, _)); _} as b,_); _} as c + ]; + _ + } as a) + ); _ + } as structure_item -> + (match parse_version v with + | Some(imaj, imin) -> + let updater new_maj new_min = + let new_v = string_of_int new_maj ^ "." ^ string_of_int new_min in + let new_payload_desc = { + c with + pstr_desc=Pstr_eval({b with pexp_desc=Pexp_constant(Pconst_float(new_v, None))},[]) + } in + let new_pstr_desc = Pstr_attribute {a with attr_payload = PStr [new_payload_desc]} in + {structure_item with pstr_desc = new_pstr_desc} + in + Some (updater, imaj, imin) + | _ -> None) + | _ -> None + + let is_sig_version_attribute = function + | { psig_desc=( + Psig_attribute ({ + attr_name={txt="reason.version"; _}; + attr_payload = PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_float(v, _)); _} as b, _); _} as c]; + _ + } as a) + ); _ + } as sig_item -> + (match parse_version v with + | Some(imaj, imin) -> + let updater new_maj new_min = + let new_v = string_of_int new_maj ^ "." ^ string_of_int new_min in + let new_payload_desc = { + c with + pstr_desc=Pstr_eval({b with pexp_desc=Pexp_constant(Pconst_float(new_v, None))},[]) + } in + let new_psig_desc = Psig_attribute {a with attr_payload = PStr [new_payload_desc]} in + {sig_item with psig_desc = new_psig_desc} + in + Some (updater, imaj, imin) + | _ -> None) + | _ -> None + let mk_warning_attribute_payload ~loc msg = let exp = Exp.mk ~loc (Pexp_constant (Pconst_string(msg, None))) in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in @@ -114,79 +322,75 @@ module Ast_nodes = struct let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in PStr [item] + (* let should_promote ~inferred_min ~inferred_maj ~explicit = *) + (* let {major = inf_major; minor = inf_minor} = inferred in *) + (* let {major = exp_major; minor = exp_minor} = explicit in *) + (* is_set inferred && *) + (* (not (is_set explicit) || *) + (* inf_major > exp_major || inf_major == exp_major && inf_minor > exp_minor) *) + + (* + * splice_fallback is the splicer that will place an attribute at the best + * possible place. It starts out as just inserting at the head, but if a + * better place is discovered (according to insert_between) a new splice_fallback + * is created - then used if an update never occured. + *) + let replace_or_inject_item ~attribute_tester ~insert_between ~creator maj min items = + let rec impl ~splicer ~rev_prev items = + match (items : 'a list) with + | [] -> + let loc = dummy_loc () in + let attr_payload = mk_version_attr_payload maj min in + let created = (creator ~loc {attr_name={loc; txt="reason.version"}; attr_payload; attr_loc=loc}) in + splicer created + | hd :: tl -> + (match attribute_tester hd with + | None -> + let splicer = + if insert_between rev_prev items then fun itm -> List.rev rev_prev @ itm :: items else splicer + in + impl ~splicer ~rev_prev:(hd :: rev_prev) tl + | Some(updater, _old_maj, _old_min) -> (List.rev rev_prev) @ updater maj min :: tl + ) + in + impl ~splicer:(fun itm -> itm :: items) ~rev_prev:[] items + (** Creates an attribute to inject into the AST if it was not already present *) - let inject_attr_from_version itms ~insert_after ~creator = - let loc = dummy_loc () in - match explicit_file_version.contents with - | None -> - let major, minor = package_version.major, package_version.minor in - let attr_payload = mk_version_attr_payload major minor in - let created = (creator ~loc {attr_name={loc; txt="reason.version"}; attr_payload; attr_loc=loc}) in - (match itms with - | first :: rest when insert_after first -> - first :: created :: rest - | _ -> created :: itms - ) - | Some efv -> begin - if efv.major > package_version.major || - (efv.major == package_version.major && efv.minor > package_version.minor) then - let efv_mjr = string_of_int efv.major in - let efv_mnr = string_of_int efv.minor in - let pkg_mjr = string_of_int package_version.major in - let pkg_mnr = string_of_int package_version.minor in - let msg = - "This file specifies a reason.version " ^ efv_mjr ^ "." ^ efv_mnr ^ - " which is greater than the package version " ^ pkg_mjr ^ "." ^ pkg_mnr ^ - " Either upgrade the Reason package or lower the version specified in [@reason.version ]." in - (* let loc = match itms with *) - (* | hd :: _ -> hd.pstr_loc *) - (* | [] -> loc *) - (* in *) - let attr_payload = mk_warning_attribute_payload ~loc msg in - let created = (creator ~loc {attr_name={loc; txt="ocaml.ppwarn"}; attr_payload; attr_loc=loc}) in - created :: itms - else itms - end + let inject_attr_for_printing ~attribute_tester ~insert_between ~creator itms = + let major = effective_promote_version_major () in + let minor = effective_promote_version_minor () in + replace_or_inject_item ~attribute_tester ~insert_between ~creator major minor itms - let inject_attr_from_version_impl itms = - let insert_after = function - | {pstr_desc = Pstr_attribute {attr_name = {txt="ocaml.doc"|"ocaml.text"; _}; _}; _} -> true + (* Injects a version attribute if none was present. We don't do any inferred promotion here. + * The reason is that this will already happen in the printer if parsing and printing are done + * within the same process (the mutable inferred version will be retained and used to inform + * the printer which version of the syntax to print to (and how it should replace version attributes + * with rewritten ones according to the version that was inferred. *) + let is_floating_str_comment = function + | {pstr_desc = Pstr_attribute {attr_name = {txt="ocaml.doc"|"ocaml.text"; _}; _}; _} -> true + | _ -> false + let is_floating_sig_comment = function + | {psig_desc = Psig_attribute {attr_name = {txt="ocaml.doc"|"ocaml.text"; _}; _}; _} -> true + | _ -> false + let inject_attr_to_instruct_printing_impl itms = + (* Inserts after the first one or two floating comments *) + let insert_between rev_prev remaining = match rev_prev, remaining with + | [second; first], _third when is_floating_str_comment second && is_floating_str_comment first -> true + | [first], (second :: _) when is_floating_str_comment first && not (is_floating_str_comment second) -> true + | [first], [] when is_floating_str_comment first -> true | _ -> false in let creator = (fun ~loc x -> Str.mk ~loc (Pstr_attribute x)) in - inject_attr_from_version itms ~insert_after ~creator + inject_attr_for_printing ~attribute_tester:is_structure_version_attribute ~insert_between ~creator itms - let inject_attr_from_version_intf itms = - let insert_after = function - | {psig_desc = Psig_attribute {attr_name = {txt="ocaml.doc"|"ocaml.text"; _}; _}; _} -> true + let inject_attr_to_instruct_printing_intf itms = + (* Inserts after the first one or two floating comments *) + let insert_between rev_prev remaining = match rev_prev, remaining with + | [second; first], _third when is_floating_sig_comment second && is_floating_sig_comment first -> true + | [first], (second :: _) when is_floating_sig_comment first && not (is_floating_sig_comment second) -> true + | [first], [] when is_floating_sig_comment first -> true | _ -> false in let creator = (fun ~loc x -> Sig.mk ~loc (Psig_attribute x)) in - inject_attr_from_version itms ~insert_after ~creator - - let extract_version_attribute_structure_item structure_item = - (match structure_item with - | {pstr_desc=(Pstr_attribute { - attr_name={txt="reason.version"; _}; - attr_payload = PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_float(v, _)); _},_); _}]; - _ - }); _} -> - (match _split_on_char '.' v with - | [maj] | [maj; ""] -> Some (int_of_string maj, 0) - | maj :: mnr :: _ -> Some (int_of_string maj, int_of_string mnr) - | _ -> None); - | _ -> None) - - let extract_version_attribute_signature_item sig_item = - (match sig_item with - | {psig_desc=(Psig_attribute { - attr_name={txt="reason.version"; _}; - attr_payload = PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_float(v, _)); _},_); _}]; - _ - }); _} -> - (match _split_on_char '.' v with - | [maj] | [maj; ""] -> Some (int_of_string maj, 0) - | maj :: mnr :: _ -> Some (int_of_string maj, int_of_string mnr) - | _ -> None); - | _ -> None) + inject_attr_for_printing ~attribute_tester:is_sig_version_attribute ~insert_between ~creator itms end diff --git a/src/refmt/refmt_args.ml b/src/refmt/refmt_args.ml index ca371517e..7890b6e66 100644 --- a/src/refmt/refmt_args.ml +++ b/src/refmt/refmt_args.ml @@ -45,6 +45,37 @@ let print_width = let doc = "wrapping width for printing the AST" in Arg.(value & opt (int) (80) & info ["w"; "print-width"] ~docv ~doc) +let _version_options = + List.map + (fun fv -> + let major, minor = string_of_int fv.Reason_version.major, string_of_int fv.minor in + (major ^ "." ^ minor), fv) + Reason_version.all_supported_file_versions + +let unspecified_version = Reason_version.unspecified () +let version_options = ("default", unspecified_version) :: _version_options + +let parse_version = + let docv = "INT.INT" in + let doc = + "Sets the default assumed print of Reason Syntax to parse. \ + Usually refmt will assume 3.7, until it sees otherwise such as [@reason.version 3.8]. \ + Passing x.y for this option causes refmt to assume x.y until it an attribute requesting \ + otherwise." in + let opts = Arg.enum version_options in + Arg.(value & opt opts unspecified_version & info ["parse-version"] ~docv ~doc) + +let promote_version = + let docv = "INT.INT" in + let doc = + "Forces the parser to rewrite the Reason Syntax version attribute at \ + parse time, causing the printer to print it in the promoted version. \ + If no existing attribute was present, one will be injected at parse time \ + as usual." in + let opts = Arg.enum version_options in + Arg.(value & opt opts unspecified_version & info ["promote-version"] ~docv ~doc) + + let heuristics_file = let doc = "load path as a heuristics file to specify which constructors carry a tuple \ diff --git a/src/refmt/refmt_impl.ml b/src/refmt/refmt_impl.ml index 8b3403a9b..51d407a64 100644 --- a/src/refmt/refmt_impl.ml +++ b/src/refmt/refmt_impl.ml @@ -29,6 +29,8 @@ let refmt print_width heuristics_file in_place + parse_version + promote_version input_files = let refmt_single input_file = @@ -59,6 +61,8 @@ let refmt | (true, _) -> Some input_file | (false, _) -> None in + Reason_version.set_explicit_parse_version parse_version.Reason_version.major parse_version.minor; + Reason_version.set_explicit_promote_version promote_version.Reason_version.major promote_version.minor; let (module Printer : Printer_maker.PRINTER) = if interface then (module Reason_interface_printer) else (module Reason_implementation_printer) @@ -117,6 +121,8 @@ let refmt_t = $ print_width $ heuristics_file $ in_place + $ parse_version + $ promote_version $ input let () = diff --git a/src/rtop/reason_util.ml b/src/rtop/reason_util.ml index 056fa1464..fbead1f64 100644 --- a/src/rtop/reason_util.ml +++ b/src/rtop/reason_util.ml @@ -1,5 +1,5 @@ (** - * Some of this was coppied from @whitequark's m17n project. + * Some of this was coppied from whitequark's m17n project. *) (* * Portions Copyright (c) 2015-present, Facebook, Inc. diff --git a/src/rtop/reason_utop.ml b/src/rtop/reason_utop.ml index 1b053f9bc..18605d7f5 100644 --- a/src/rtop/reason_utop.ml +++ b/src/rtop/reason_utop.ml @@ -1,5 +1,5 @@ (** - * Some of this was coppied from @whitequark's m17n project. + * Some of this was coppied from whitequark's m17n project. *) (* * Portions Copyright (c) 2015-present, Facebook, Inc.