From 8047d1d3aa514a3b347f240402a3d16ebde43679 Mon Sep 17 00:00:00 2001 From: Jordan Date: Thu, 16 Jul 2020 15:47:11 -0700 Subject: [PATCH] Reason V4 Feature [Allow multiple versions of Resaon] 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: --- .ci/build-platform.yml | 4 +- 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 ++ miscTests/backportSyntaxTests.sh | 2 +- src/reason-parser/dune | 2 +- src/reason-parser/reason_attributes.ml | 17 +- .../reason_declarative_lexer.mll | 15 + src/reason-parser/reason_parser.conflicts | 53 +- 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 +- 101 files changed, 1660 insertions(+), 707 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/.ci/build-platform.yml b/.ci/build-platform.yml index 1354ec972..d7af02028 100644 --- a/.ci/build-platform.yml +++ b/.ci/build-platform.yml @@ -16,10 +16,10 @@ jobs: # Needed so that the mingw tar doesn't shadow the system tar. See # pipelines.yaml. We need windows bsdtar from system32, not the mingw # one. Note powershell doesn't need escaping of backslashes. - - powershell: Write-Host "##vso[task.setvariable variable=PATH;]C:\Windows\system32;${env:PATH}" + - powershell: Write-Host "##vso[task.setvariable variable=PATH;]C:\Program Files\Git\bin;C:\Windows\system32;${env:PATH}" continueOnError: true condition: eq(variables['AGENT.OS'], 'Windows_NT') - displayName: "Make sure windows/system32 is at front of path if windows" + displayName: "Make sure git/bin and windows/system32 is at front of path if windows" - powershell: $Env:Path continueOnError: true condition: and(eq(variables['AGENT.OS'], 'Windows_NT'), and(eq(variables['Build.Reason'], 'PullRequest'), and(succeeded(), ne(variables['Build.SourceBranch'], variables['System.PullRequest.TargetBranch'])))) 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 247be1464..f7f49d7be 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 b7388a20f..ae6f325a8 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 4251dd614..c395ad777 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/miscTests/backportSyntaxTests.sh b/miscTests/backportSyntaxTests.sh index 26d07e742..8bce3ffc3 100755 --- a/miscTests/backportSyntaxTests.sh +++ b/miscTests/backportSyntaxTests.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/bin/sh set -e echo "Testing the backport of 'letop'" diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 98fe54c52..9214362b3 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -95,4 +95,4 @@ reason_recover_parser reason_declarative_lexer reason_lexer reason_oprint reason_parser_explain_raw reason_parser_explain reason_parser_recover reason_string) - (libraries ocaml-migrate-parsetree menhirLib reason.easy_format)) + (libraries 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 029ef61fe..45329deb4 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.conflicts b/src/reason-parser/reason_parser.conflicts index 272bf6cd5..9a6e8f566 100644 --- a/src/reason-parser/reason_parser.conflicts +++ b/src/reason-parser/reason_parser.conflicts @@ -1,10 +1,10 @@ -** Conflict (shift/reduce) in state 1219. -** Tokens involved: SLASHGREATER QUESTION LPAREN INFIXOP3 GREATERDOTDOTDOT GREATER DOT -** The following explanations concentrate on token LPAREN. +** Conflict (reduce/reduce) in state 1461. +** Tokens involved: RPAREN COMMA +** The following explanations concentrate on token RPAREN. ** This state is reached from implementation after reading: -unattributed_expr GREATER LESS UIDENT +CLASS virtual_flag LIDENT LPAREN UNDERSCORE ** The derivations that appear below have the following common factor: ** (The question mark symbol (?) represents the spot where the derivations begin to differ.) @@ -12,27 +12,28 @@ unattributed_expr GREATER LESS UIDENT implementation structure EOF structure_item -unattributed_expr -(?) - -** In state 1219, looking ahead at LPAREN, shifting is permitted -** because of the following sub-derivation: - -unattributed_expr GREATER expr - simple_expr_call - jsx - jsx_start_tag_and_args SLASHGREATER - LESS mod_ext_longident jsx_arguments - mod_ext_apply - UIDENT . LPAREN lseparated_nonempty_list_aux(COMMA,mod_ext_longident) RPAREN - -** In state 1219, looking ahead at LPAREN, reducing production -** mod_longident -> UIDENT +CLASS class_declaration_details list(and_class_declaration) + (?) + +** In state 1461, looking ahead at RPAREN, reducing production +** embedded(__anonymous_33) -> UNDERSCORE +** is permitted because of the following sub-derivation: + +virtual_flag LIDENT LPAREN type_variables_with_variance_comma_list RPAREN class_declaration_body // lookahead token appears + lseparated_nonempty_list_aux(COMMA,type_variable_with_variance) option(COMMA) // lookahead token is inherited because option(COMMA) can vanish + type_variable_with_variance // lookahead token is inherited + embedded(__anonymous_33) // lookahead token is inherited + UNDERSCORE . + +** In state 1461, looking ahead at RPAREN, reducing production +** simple_pattern_not_ident -> UNDERSCORE ** is permitted because of the following sub-derivation: -unattributed_expr GREATER LESS expr - simple_expr_call - simple_expr_call labeled_arguments // lookahead token appears because labeled_arguments can begin with LPAREN - constr_longident // lookahead token is inherited - mod_longident // lookahead token is inherited - UIDENT . +virtual_flag LIDENT LPAREN lseparated_nonempty_list_aux(COMMA,labeled_pattern) option(COMMA) RPAREN class_declaration_body // lookahead token appears because option(COMMA) can vanish + labeled_pattern // lookahead token is inherited + pattern_optional_constraint // lookahead token is inherited + pattern // lookahead token is inherited + pattern_without_or // lookahead token is inherited + simple_pattern // lookahead token is inherited + simple_pattern_not_ident // lookahead token is inherited + UNDERSCORE . diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 43a82d572..010f3400c 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -867,6 +867,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" @@ -1190,6 +1191,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 @@ -1436,12 +1438,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 @@ -2002,7 +2010,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 @@ -2010,7 +2018,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) } ; @@ -2319,14 +2327,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 @@ -2425,16 +2429,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) } ; @@ -2455,8 +2451,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) } ; @@ -3949,13 +3945,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) } ; @@ -3984,7 +3980,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 = @@ -3998,7 +3994,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 @@ -4037,24 +4033,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) } @@ -4068,19 +4055,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) @@ -4186,7 +4171,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)) @@ -4200,7 +4185,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) @@ -4245,7 +4230,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} @@ -4254,7 +4239,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 @@ -4992,6 +4977,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; @@ -5153,4 +5151,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 f164c1c2d..0d0c1fb05 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 @@ -2440,7 +2461,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 @@ -2546,7 +2567,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 @@ -2598,7 +2619,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 @@ -2754,7 +2775,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 @@ -3091,6 +3112,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 *) @@ -3099,7 +3121,7 @@ let printer = object(self:'self) avoid (@see @avoidSingleTokenWrapping): *) label (self#longident_loc li) - (makeTup ( + (typeParameterBookends ( List.map self#type_param_list_element l )) ) @@ -3137,7 +3159,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 (_, _) @@ -6740,7 +6762,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) @@ -6797,7 +6819,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 @@ -7104,7 +7126,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 _ @@ -7568,7 +7590,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 @@ -8288,10 +8310,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 @@ -8304,12 +8363,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 489ee8d63..baf4c5c46 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..2ebd0782b --- /dev/null +++ b/src/reason-version/dune @@ -0,0 +1,6 @@ +(library + (name reason_version) + (public_name reason.version) + (modules reason_version) + (libraries 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..000371c54 --- /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 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 =