From b9d5ed44d8937392b1783e23c8b0433c68e13767 Mon Sep 17 00:00:00 2001 From: Jordan Date: Thu, 16 Jul 2020 15:47:11 -0700 Subject: [PATCH 1/2] 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/2] 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)) )