diff --git a/docs/RELEASING.md b/docs/RELEASING.md index a0913e1c4..7227b558f 100644 --- a/docs/RELEASING.md +++ b/docs/RELEASING.md @@ -16,14 +16,32 @@ and `rtop.json` respectively in the repo root, you would run that script after committing/bumping some versions: +**IMPORTANT: Update The Version Numbers In Packages:** +1. Make sure the version number in `esy.json` and `reason.json` is the new + version number for the release. +2. Make sure the file + [../../src/reason-version/reason_version.ml](../../src/reason-version/reason_version.ml) + also has that same version number that `refmt` has: + ```sh git checkout -b MYRELEASE origin/master git rebase origin/master -vim -O esy.json reason.json -# Then edit the version number accordingly on BOTH files. With that same VERSION do: -version=3.5.0 make pre_release +vim -O esy.json reason.json src/reason-version/reason_version.ml + +# Edit version field in jsons, and make sure reason_version has the new version +# let package_version = { +# major = 3; +# minor = 7; +# patch = 0; +# } + git commit -m "Bump version" git push origin HEAD:PullRequestForVersion # Commit these version bumps + +``` + +**Perform The Release:** +```sh node ./scripts/esy-prepublish.js ./reason.json ./rtop.json # Then publish. For example: diff --git a/formatTest/typeCheckedTests/expected_output/arityConversion.re b/formatTest/typeCheckedTests/expected_output/arityConversion.re index a725636be..737d0e6b8 100644 --- a/formatTest/typeCheckedTests/expected_output/arityConversion.re +++ b/formatTest/typeCheckedTests/expected_output/arityConversion.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; Some((1, 2, 3)); type bcd = diff --git a/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re b/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re index 26a69c9e2..c09b4d70b 100644 --- a/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re +++ b/formatTest/typeCheckedTests/expected_output/attributes.4.04.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Pexp_letexception with attributes */ let () = { [@attribute] diff --git a/formatTest/typeCheckedTests/expected_output/attributes.re b/formatTest/typeCheckedTests/expected_output/attributes.re index 8324c5664..4b4448366 100644 --- a/formatTest/typeCheckedTests/expected_output/attributes.re +++ b/formatTest/typeCheckedTests/expected_output/attributes.re @@ -7,6 +7,7 @@ * This has a nice side effect when printing the terms: * If a node has attributes attached to it, */; +[@reason.version 3.7]; /**Floating comment text should be removed*/; diff --git a/formatTest/typeCheckedTests/expected_output/attributes.rei b/formatTest/typeCheckedTests/expected_output/attributes.rei index 4c6556400..51faaf1ee 100644 --- a/formatTest/typeCheckedTests/expected_output/attributes.rei +++ b/formatTest/typeCheckedTests/expected_output/attributes.rei @@ -1,6 +1,8 @@ /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /**Floating comment text should be removed*/; +[@reason.version 3.7]; + let test: int; /** diff --git a/formatTest/typeCheckedTests/expected_output/basics.re b/formatTest/typeCheckedTests/expected_output/basics.re index 0622c6f59..7619a0bf5 100644 --- a/formatTest/typeCheckedTests/expected_output/basics.re +++ b/formatTest/typeCheckedTests/expected_output/basics.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let l = diff --git a/formatTest/typeCheckedTests/expected_output/basics_no_semi.re b/formatTest/typeCheckedTests/expected_output/basics_no_semi.re index 31c651ee8..1f512e147 100644 --- a/formatTest/typeCheckedTests/expected_output/basics_no_semi.re +++ b/formatTest/typeCheckedTests/expected_output/basics_no_semi.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let l = diff --git a/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re b/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re index 3d47fa0a4..b00a5c1a7 100644 --- a/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re +++ b/formatTest/typeCheckedTests/expected_output/bigarraySyntax.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* https://github.com/facebook/reason/issues/2038 */ let my_big_array1 = Bigarray.Array1.create( diff --git a/formatTest/typeCheckedTests/expected_output/comments.re b/formatTest/typeCheckedTests/expected_output/comments.re index ace4ee3f0..9bee88955 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.re +++ b/formatTest/typeCheckedTests/expected_output/comments.re @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei b/formatTest/typeCheckedTests/expected_output/comments.rei index c6f7d5851..a5ec2cc99 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei +++ b/formatTest/typeCheckedTests/expected_output/comments.rei @@ -8,6 +8,8 @@ /***** comment */ /** */; +[@reason.version 3.7]; + /*** */ /**** */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.0 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.07.1 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.08.0 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 b/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 index 0d0f98b81..7749a396e 100644 --- a/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 +++ b/formatTest/typeCheckedTests/expected_output/comments.rei.4.09.0 @@ -1,6 +1,8 @@ /* **** comment */ /*** comment */ /** docstring */; +[@reason.version 3.7]; + /* comment */ /** docstring */; /*** comment */ diff --git a/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re b/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re index 1ef225e53..30250f86a 100644 --- a/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re +++ b/formatTest/typeCheckedTests/expected_output/features406.4.06.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module EM = { /** Exception */ diff --git a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re index e1a9631b7..edb27b855 100644 --- a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re +++ b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; open { type t = string; }; diff --git a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei index ae50e8341..8729f7e2f 100644 --- a/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei +++ b/formatTest/typeCheckedTests/expected_output/features408.4.08.0.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module X: {type t;}; module M := X; diff --git a/formatTest/typeCheckedTests/expected_output/imperative.re b/formatTest/typeCheckedTests/expected_output/imperative.re index cee9f989d..8d3481e99 100644 --- a/formatTest/typeCheckedTests/expected_output/imperative.re +++ b/formatTest/typeCheckedTests/expected_output/imperative.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* diff --git a/formatTest/typeCheckedTests/expected_output/jsx.re b/formatTest/typeCheckedTests/expected_output/jsx.re index 9a00b4d76..d42c8fe1a 100644 --- a/formatTest/typeCheckedTests/expected_output/jsx.re +++ b/formatTest/typeCheckedTests/expected_output/jsx.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; type component = {displayName: string}; module Bar = { diff --git a/formatTest/typeCheckedTests/expected_output/knownMlIssues.re b/formatTest/typeCheckedTests/expected_output/knownMlIssues.re index b5c2a7af9..4d5a8ca96 100644 --- a/formatTest/typeCheckedTests/expected_output/knownMlIssues.re +++ b/formatTest/typeCheckedTests/expected_output/knownMlIssues.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* [x] fixed */ type t2 = (int, int); /* attributed to entire type not binding */ diff --git a/formatTest/typeCheckedTests/expected_output/knownReIssues.re b/formatTest/typeCheckedTests/expected_output/knownReIssues.re index 60e77946e..271e1b1d7 100644 --- a/formatTest/typeCheckedTests/expected_output/knownReIssues.re +++ b/formatTest/typeCheckedTests/expected_output/knownReIssues.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** Issue 940: https://github.com/facebook/reason/issues/940 The parens in the exception match case with an alias, diff --git a/formatTest/typeCheckedTests/expected_output/lazy.re b/formatTest/typeCheckedTests/expected_output/lazy.re index 6161ee0c6..5e8bf63be 100644 --- a/formatTest/typeCheckedTests/expected_output/lazy.re +++ b/formatTest/typeCheckedTests/expected_output/lazy.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let myComputation = lazy({ let tmp = 10; diff --git a/formatTest/typeCheckedTests/expected_output/letop.re b/formatTest/typeCheckedTests/expected_output/letop.re index fad703713..f72448f95 100644 --- a/formatTest/typeCheckedTests/expected_output/letop.re +++ b/formatTest/typeCheckedTests/expected_output/letop.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let (let.opt) = (x, f) => switch (x) { | None => None diff --git a/formatTest/typeCheckedTests/expected_output/mlSyntax.re b/formatTest/typeCheckedTests/expected_output/mlSyntax.re index 084c07817..98290479c 100644 --- a/formatTest/typeCheckedTests/expected_output/mlSyntax.re +++ b/formatTest/typeCheckedTests/expected_output/mlSyntax.re @@ -3,6 +3,7 @@ /** * Testing pattern matching using ml syntax to exercise nesting of cases. */; +[@reason.version 3.7]; type xyz = | X diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re b/formatTest/typeCheckedTests/expected_output/mlVariants.re index dba6c3c78..837068a8f 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.06.1 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.07.1 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.08.0 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 index 2e1204e7a..8a346fca2 100644 --- a/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 +++ b/formatTest/typeCheckedTests/expected_output/mlVariants.re.4.09.0 @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type polyVariantsInMl = [ diff --git a/formatTest/typeCheckedTests/expected_output/mutation.re b/formatTest/typeCheckedTests/expected_output/mutation.re index e31b0a060..2b4031994 100644 --- a/formatTest/typeCheckedTests/expected_output/mutation.re +++ b/formatTest/typeCheckedTests/expected_output/mutation.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /** diff --git a/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re b/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re index 6d767e348..33485d798 100644 --- a/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re +++ b/formatTest/typeCheckedTests/expected_output/newAST.4.06.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Oinherit (https://github.com/ocaml/ocaml/pull/1118) */ type t = {. a: string}; diff --git a/formatTest/typeCheckedTests/expected_output/oo.re b/formatTest/typeCheckedTests/expected_output/oo.re index 886c49bf2..f85f5f1d9 100644 --- a/formatTest/typeCheckedTests/expected_output/oo.re +++ b/formatTest/typeCheckedTests/expected_output/oo.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ class virtual stack ('a) (init) = { diff --git a/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re b/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re new file mode 100644 index 000000000..4c8d3be15 --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/oo_3_dot_8.re @@ -0,0 +1,435 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class virtual stack <'a> (init) = { + /* + * The "as this" is implicit and will be formatted away. + */ + val virtual dummy: unit; + val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; + pub explicitOverrideTest = a => { + a + 1; + }; + pri explicitOverrideTest2 = a => { + a + 1; + }; +}; + +let tmp = { + /** + * comment here. + */; + val x = 10 +}; + +/** + * Comment on stackWithAttributes. + */ +[@thisShouldntBeFormattedAway] +class virtual stackWithAttributes <'a> (init) = { + /* Before class */ + /* The "as this" should not be formatted away because attributes. */ + as [@thisShouldntBeFormattedAway] this; + /* Before floatting attribute */ + [@floatingAttribute]; + /* Virtual member */ + [@itemAttr1] val virtual dummy: unit; + [@itemAttr2] val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; +}; + +class extendedStack <'a> (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => i; +}; + +class extendedStackAcknowledgeOverride + <'a> + (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => { + i + 1; + }; + pub! explicitOverrideTest = a => { + a + 2; + }; + pri! explicitOverrideTest2 = a => { + a + 2; + }; +}; + +let inst = (new extendedStack)([1, 2]); + +/** + * Recursive classes. + */ +/* + * First recursive class. + */ +class firstRecursiveClass (init) = { + val v = init; +} +/* + * Second recursive class. + */ +and secondRecursiveClass (init) = { + val v = init; +}; + +/** + * For now, mostly for historic reasons, the syntax for type + * definitions/annotations on anonymous objects are different than + * "class_instance_type". That needn't be the case. The only challenge is that + * whatever we do, there is a slight challenge in avoiding conflicts with + * records. Clearly {x:int, y:int} will conflict. However, open object types in + * the form of {.. x:int, y:int} do not conflict. The only thing that must be + * resolved is closed object types and records. you could have a special token + * that means "closed". {. x: int, y:int}. If only closed object types would be + * optimized in the same way that records are, records could just be replaced + * with closed object types. + */ +/** + * Anonymous objects. + */ + +type closedObj = {.}; + +let (<..>) = (a, b) => a + b; +let five = 2 <..> 3; + +type nestedObj = {. bar: {. a: int}}; + +let (>>) = (a, b) => a > b; + +let bigger = 3 >> 2; + +type typeDefForClosedObj = { + . + x: int, + y: int, +}; +type typeDefForOpenObj<'a> = + { + .. + x: int, + y: int, + } as 'a; +let anonClosedObject: { + . + x: int, + y: int, +} = { + pub x = { + 0; + }; + pub y = { + 0; + } +}; + +let onlyHasX = {pub x = 0}; +let xs: list({. x: int}) = [ + onlyHasX, + (anonClosedObject :> {. x: int}), +]; + +let constrainedAndCoerced = ( + [anonClosedObject, anonClosedObject]: + list({ + . + x: int, + y: int, + }) :> + list({. x: int}) +); + +/* If one day, unparenthesized type constraints are allowed on the RHS of a + * record value, we're going to have to be careful here because >} is parsed as + * a separate kind of token (for now). Any issues would likely be caught in the + * idempotent test case. + */ +let xs: ref({. x: int}) = { + contents: (anonClosedObject :> {. x: int}), +}; + +let coercedReturn = { + let tmp = anonClosedObject; + (tmp :> {. x: int}); +}; + +let acceptsOpenAnonObjAsArg = + ( + o: { + .. + x: int, + y: int, + }, + ) => + o#x + o#y; +let acceptsClosedAnonObjAsArg = + ( + o: { + . + x: int, + y: int, + }, + ) => + o#x + o#y; +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10; + pub z = 10 + }); + +let res = + acceptsClosedAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +/* TODO: Unify class constructor return values with function return values */ +class myClassWithAnnotatedReturnType + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; +/** + * May include a trailing semi after type row. + */ +class myClassWithAnnotatedReturnType2 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; + +/** + * May use equals sign, and may include colon if so. + */ +class myClassWithAnnotatedReturnType3 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y: int = init; +}; + +/** + * The one difference between class_constructor_types and expression + * constraints, is that we have to include the prefix word "new" before the + * final component of any arrow. This isn't required when annotating just the + * return value with ": foo ". + * This is only to temporarily work around a parsing conflict. (Can't tell if + * in the final arrow component it should begin parsing a non_arrowed_core_type + * or a class_instance_type). A better solution, would be to include + * class_instance_type as *part* of core_type, but then fail when it is + * observed in the non-last arrow position, or if a non_arrowed_core_type + * appears in the last arrow position. + * + * class_instance_type wouldn't always fail if parsed as any "core type" + * everywhere else in the grammar. + * + * Once nuance to that would be making a parse rule for "type application", and + * deferring whether or not that becomes a Pcty_constr or a Ptyp_constr. (The + * same for type identifiers and extensions.) + */ +class myClassWithAnnotatedReturnType3_annotated_constructor: + (int) => + { + pub x: int; + pub y: int; + } = + fun (init) => { + pub x: int = init; + pub y: int = init; + }; + +class tupleClass <'a, 'b> (init: ('a, 'b)) = { + pub pr = init; +}; + +module HasTupleClasses: { + /** + * exportedClass. + */ + class exportedClass: + (int) => + { + pub x: int; + pub y: int; + }; + /** + * anotherExportedClass. + */ + class anotherExportedClass <'a, 'b>: + (('a, 'b)) => + { + pub pr: ('a, 'b); + }; +} = { + /** + * exportedClass. + */ + class exportedClass = + class myClassWithAnnotatedReturnType3; + + /** + * anotherExportedClass. + */ + class anotherExportedClass <'a, 'b> = + class tupleClass<'a, 'b>; +}; + +class intTuples = class tupleClass; + +class intTuplesHardcoded = + (class tupleClass)((8, 8)); + +/** + * Note that the inner tupleClass doesn't have the "class" prefix because + * they're not kinds of classes - they're types of *values*. + * The parens here shouldn't be required. + */ +class intTuplesTuples = + class tupleClass< + tupleClass, + tupleClass, + >; + +let x: tupleClass = { + pub pr = (10, 10) +}; + +let x: #tupleClass = x; + +let incrementMyClassInstance: + (int, #tupleClass) => + #tupleClass = + (i, inst) => { + let (x, y) = inst#pr; + {pub pr = (x + i, y + i)}; + }; + +class myClassWithNoTypeParams = {}; +/** + * The #myClassWithNoTypeParams should be treated as "simple" + */ +type optionalMyClassSubtype<'a> = + option<#myClassWithNoTypeParams> as 'a; + +/** + * Remember, "class type" is really "class_instance_type" (which is the type of + * what is returned from the constructor). + * + * And when defining a class: + * + * addablePoint is the "class instance type" type generated in scope which is + * the closed object type of the return value of the constructor. + * + * #addablePoint is the extensible form of addablePoint (anything that + * adheres to the "interface.") + */ +class type addablePointClassType = { + pub x: int; + pub y: int; + pub add: + ( + addablePointClassType, + addablePointClassType + ) => + int; +}; + +/** + * Class constructor types can be annotated. + */ +class addablePoint: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +class addablePoint2: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +module type T = { + class virtual cl <'a>: {} + and cl2: {}; +}; + +let privacy = {pri x = c => 5 + c}; + +module Js = { + type t<'a>; +}; + +/* supports trailing comma */ +type stream<'a> = { + . + "observer": ('a => unit) => unit, +}; diff --git a/formatTest/typeCheckedTests/expected_output/patternMatching.re b/formatTest/typeCheckedTests/expected_output/patternMatching.re index f8239ba58..0ae355ad5 100644 --- a/formatTest/typeCheckedTests/expected_output/patternMatching.re +++ b/formatTest/typeCheckedTests/expected_output/patternMatching.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; type point = { x: int, y: int, diff --git a/formatTest/typeCheckedTests/expected_output/pervasive.rei b/formatTest/typeCheckedTests/expected_output/pervasive.rei index 35ff3d668..f34824fe5 100644 --- a/formatTest/typeCheckedTests/expected_output/pervasive.rei +++ b/formatTest/typeCheckedTests/expected_output/pervasive.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let (==): ('a, 'a) => bool; let (!=): ('a, 'a) => bool; diff --git a/formatTest/typeCheckedTests/expected_output/pipeFirst.re b/formatTest/typeCheckedTests/expected_output/pipeFirst.re index b06c18017..eb9295275 100644 --- a/formatTest/typeCheckedTests/expected_output/pipeFirst.re +++ b/formatTest/typeCheckedTests/expected_output/pipeFirst.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let (|.) = (x, y) => x + y; let a = 1; diff --git a/formatTest/typeCheckedTests/expected_output/reasonComments.re b/formatTest/typeCheckedTests/expected_output/reasonComments.re index 63b87d939..51228000c 100644 --- a/formatTest/typeCheckedTests/expected_output/reasonComments.re +++ b/formatTest/typeCheckedTests/expected_output/reasonComments.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; 3; /* - */ 3; /*-*/ diff --git a/formatTest/typeCheckedTests/expected_output/reasonComments.rei b/formatTest/typeCheckedTests/expected_output/reasonComments.rei index 86518f5a5..15c0a9377 100644 --- a/formatTest/typeCheckedTests/expected_output/reasonComments.rei +++ b/formatTest/typeCheckedTests/expected_output/reasonComments.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module JustString: { include Map.S; /* Comment eol include */ }; diff --git a/formatTest/typeCheckedTests/expected_output/sequences.re b/formatTest/typeCheckedTests/expected_output/sequences.re index 72b5ad545..5ec8538a8 100644 --- a/formatTest/typeCheckedTests/expected_output/sequences.re +++ b/formatTest/typeCheckedTests/expected_output/sequences.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /** diff --git a/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re b/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re index 6cc7f92c8..28843fc62 100644 --- a/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re +++ b/formatTest/typeCheckedTests/expected_output/specificMLSyntax.4.04.0.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module Foo = { type t = {name: string}; }; diff --git a/formatTest/typeCheckedTests/expected_output/trailing.re b/formatTest/typeCheckedTests/expected_output/trailing.re index 67833739a..ac03cf8f6 100644 --- a/formatTest/typeCheckedTests/expected_output/trailing.re +++ b/formatTest/typeCheckedTests/expected_output/trailing.re @@ -1,3 +1,5 @@ +[@reason.version 3.7]; + let x = 0; let y = 0; diff --git a/formatTest/typeCheckedTests/expected_output/typeParameters.re b/formatTest/typeCheckedTests/expected_output/typeParameters.re index 3d97c06da..1af0200a4 100644 --- a/formatTest/typeCheckedTests/expected_output/typeParameters.re +++ b/formatTest/typeCheckedTests/expected_output/typeParameters.re @@ -1,6 +1,7 @@ /** * Testing type parameters. - */ + */; +[@reason.version 3.7]; type threeThings('t) = ('t, 't, 't); type listOf('t) = list('t); diff --git a/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re b/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re new file mode 100644 index 000000000..c3bc2a35c --- /dev/null +++ b/formatTest/typeCheckedTests/expected_output/typeParameters_3_dot_8.re @@ -0,0 +1,88 @@ +/** + * Testing type parameters. + */; +[@reason.version 3.8]; + +type threeThings<'t> = ('t, 't, 't); +type listOf<'t> = list<'t>; + +type underscoreParam<_> = + | Underscored; +type underscoreParamCovariance<+_> = + | Underscored; +type underscoreParamContravariance<-_> = + | Underscored; + +type tickParamCovariance<+'a> = + | Underscored; +type tickParamContravariance<-'a> = + | Underscored; + +let x: option> = None; +type myFunctionType<'a> = ( + list<('a, 'a)>, + int => option>, +); +let funcAnnoted = (~a: list=[0, 1], ()) => a; + +/** + * Syntax that would be likely to conflict with lexing parsing of < > syntax. + */ + +let zero = 0; +let isGreaterThanNegFive = zero > (-5); +let isGreaterThanNegFive2 = zero > (-5); +let isGreaterThanNegFive3 = zero > (-5); + +let isGreaterThanEqNegFive = zero >= (-5); +let isGreaterThanEqNegFive2 = zero >= (-5); +let isGreaterThanEqNegFive3 = zero >= (-5); + +let (>>=) = (a, b) => a >= b; + +let isSuperGreaterThanEqNegFive = zero >>= (-5); +let isSuperGreaterThanEqNegFive2 = zero >>= (-5); +let isSuperGreaterThanEqNegFive3 = zero >>= (-5); + +let jsx = (~children, ()) => 0; + +type t<'a> = 'a; +let optionArg = (~arg: option>=?, ()) => arg; +let optionArgList = + (~arg: option>>=?, ()) => arg; +let defaultJsxArg = (~arg: t=, ()) => arg; +let defaultFalse = (~arg: t=!true, ()) => arg; +/* Doesn't work on master either let defaultTrue = (~arg:t= !!true) => arg; */ + +/** + * Things likely to conflict or impact precedence. + */ +let neg = (-1); +let tru = !false; +let x = + "arbitrary" === "example" + && "how long" >= "can you get" + && "seriously" <= "what is the line length"; + +let z = 0; +module Conss = { + let (>-) = (a, b) => a + b; + let four = 3 >- 1; + let two = 3 >- (-1); + let four' = 3 >- 1; + + let tr = 3 > (-1); + let tr' = 3 > 1; + let tr'' = 3 > (-1); +}; + +module Idents = { + let (>-) = (a, b) => a + b; + let four = z >- z; + let two = z >- - z; + let four' = z >- - (- z); + + let tr = z > - z; + let tr' = z > - (- z); + let tr'' = z > - (- (- z)); +}; diff --git a/formatTest/typeCheckedTests/input/oo_3_dot_8.re b/formatTest/typeCheckedTests/input/oo_3_dot_8.re new file mode 100644 index 000000000..1f036b5e2 --- /dev/null +++ b/formatTest/typeCheckedTests/input/oo_3_dot_8.re @@ -0,0 +1,435 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class virtual stack('a) (init) = { + /* + * The "as this" is implicit and will be formatted away. + */ + val virtual dummy: unit; + val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; + pub explicitOverrideTest = a => { + a + 1; + }; + pri explicitOverrideTest2 = a => { + a + 1; + }; +}; + +let tmp = { + /** + * comment here. + */; + val x = 10 +}; + +/** + * Comment on stackWithAttributes. + */ +[@thisShouldntBeFormattedAway] +class virtual stackWithAttributes ('a) (init) = { + /* Before class */ + /* The "as this" should not be formatted away because attributes. */ + as [@thisShouldntBeFormattedAway] this; + /* Before floatting attribute */ + [@floatingAttribute]; + /* Virtual member */ + [@itemAttr1] val virtual dummy: unit; + [@itemAttr2] val mutable v: list<'a> = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; +}; + +class extendedStack ('a) (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => i; +}; + +class extendedStackAcknowledgeOverride + ('a) + (init) = { + inherit (class stack<'a>)(init); + val dummy = (); + pub implementMe = i => { + i + 1; + }; + pub! explicitOverrideTest = a => { + a + 2; + }; + pri! explicitOverrideTest2 = a => { + a + 2; + }; +}; + +let inst = (new extendedStack)([1, 2]); + +/** + * Recursive classes. + */ +/* + * First recursive class. + */ +class firstRecursiveClass (init) = { + val v = init; +} +/* + * Second recursive class. + */ +and secondRecursiveClass (init) = { + val v = init; +}; + +/** + * For now, mostly for historic reasons, the syntax for type + * definitions/annotations on anonymous objects are different than + * "class_instance_type". That needn't be the case. The only challenge is that + * whatever we do, there is a slight challenge in avoiding conflicts with + * records. Clearly {x:int, y:int} will conflict. However, open object types in + * the form of {.. x:int, y:int} do not conflict. The only thing that must be + * resolved is closed object types and records. you could have a special token + * that means "closed". {. x: int, y:int}. If only closed object types would be + * optimized in the same way that records are, records could just be replaced + * with closed object types. + */ +/** + * Anonymous objects. + */ + +type closedObj = {.}; + +let (<..>) = (a, b) => a + b; +let five = 2 <..> 3; + +type nestedObj = {. bar: {. a: int}}; + +let (>>) = (a, b) => a > b; + +let bigger = 3 >> 2; + +type typeDefForClosedObj = { + . + x: int, + y: int, +}; +type typeDefForOpenObj<'a> = + { + .. + x: int, + y: int, + } as 'a; +let anonClosedObject: { + . + x: int, + y: int, +} = { + pub x = { + 0; + }; + pub y = { + 0; + } +}; + +let onlyHasX = {pub x = 0}; +let xs: list({. x: int}) = [ + onlyHasX, + (anonClosedObject :> {. x: int}), +]; + +let constrainedAndCoerced = ( + [anonClosedObject, anonClosedObject]: + list({ + . + x: int, + y: int, + }) :> + list({. x: int}) +); + +/* If one day, unparenthesized type constraints are allowed on the RHS of a + * record value, we're going to have to be careful here because >} is parsed as + * a separate kind of token (for now). Any issues would likely be caught in the + * idempotent test case. + */ +let xs: ref({. x: int}) = { + contents: (anonClosedObject :> {. x: int}), +}; + +let coercedReturn = { + let tmp = anonClosedObject; + (tmp :> {. x: int}); +}; + +let acceptsOpenAnonObjAsArg = + ( + o: { + .. + x: int, + y: int, + }, + ) => + o#x + o#y; +let acceptsClosedAnonObjAsArg = + ( + o: { + . + x: int, + y: int, + }, + ) => + o#x + o#y; +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10; + pub z = 10 + }); + +let res = + acceptsClosedAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + +/* TODO: Unify class constructor return values with function return values */ +class myClassWithAnnotatedReturnType + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; +/** + * May include a trailing semi after type row. + */ +class myClassWithAnnotatedReturnType2 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; +}; + +/** + * May use equals sign, and may include colon if so. + */ +class myClassWithAnnotatedReturnType3 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y: int = init; +}; + +/** + * The one difference between class_constructor_types and expression + * constraints, is that we have to include the prefix word "new" before the + * final component of any arrow. This isn't required when annotating just the + * return value with ": foo ". + * This is only to temporarily work around a parsing conflict. (Can't tell if + * in the final arrow component it should begin parsing a non_arrowed_core_type + * or a class_instance_type). A better solution, would be to include + * class_instance_type as *part* of core_type, but then fail when it is + * observed in the non-last arrow position, or if a non_arrowed_core_type + * appears in the last arrow position. + * + * class_instance_type wouldn't always fail if parsed as any "core type" + * everywhere else in the grammar. + * + * Once nuance to that would be making a parse rule for "type application", and + * deferring whether or not that becomes a Pcty_constr or a Ptyp_constr. (The + * same for type identifiers and extensions.) + */ +class myClassWithAnnotatedReturnType3_annotated_constructor: + (int) => + { + pub x: int; + pub y: int; + } = + fun (init) => { + pub x: int = init; + pub y: int = init; + }; + +class tupleClass ('a, 'b) (init: ('a, 'b)) = { + pub pr = init; +}; + +module HasTupleClasses: { + /** + * exportedClass. + */ + class exportedClass: + (int) => + { + pub x: int; + pub y: int; + }; + /** + * anotherExportedClass. + */ + class anotherExportedClass ('a, 'b): + (('a, 'b)) => + { + pub pr: ('a, 'b); + }; +} = { + /** + * exportedClass. + */ + class exportedClass = + class myClassWithAnnotatedReturnType3; + + /** + * anotherExportedClass. + */ + class anotherExportedClass ('a, 'b) = + class tupleClass<'a, 'b>; +}; + +class intTuples = class tupleClass; + +class intTuplesHardcoded = + (class tupleClass)((8, 8)); + +/** + * Note that the inner tupleClass doesn't have the "class" prefix because + * they're not kinds of classes - they're types of *values*. + * The parens here shouldn't be required. + */ +class intTuplesTuples = + class tupleClass< + tupleClass, + tupleClass, + >; + +let x: tupleClass = { + pub pr = (10, 10) +}; + +let x: #tupleClass = x; + +let incrementMyClassInstance: + (int, #tupleClass) => + #tupleClass = + (i, inst) => { + let (x, y) = inst#pr; + {pub pr = (x + i, y + i)}; + }; + +class myClassWithNoTypeParams = {}; +/** + * The #myClassWithNoTypeParams should be treated as "simple" + */ +type optionalMyClassSubtype<'a> = + option< #myClassWithNoTypeParams> as 'a; + +/** + * Remember, "class type" is really "class_instance_type" (which is the type of + * what is returned from the constructor). + * + * And when defining a class: + * + * addablePoint is the "class instance type" type generated in scope which is + * the closed object type of the return value of the constructor. + * + * #addablePoint is the extensible form of addablePoint (anything that + * adheres to the "interface.") + */ +class type addablePointClassType = { + pub x: int; + pub y: int; + pub add: + ( + addablePointClassType, + addablePointClassType + ) => + int; +}; + +/** + * Class constructor types can be annotated. + */ +class addablePoint: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +class addablePoint2: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + +module type T = { + class virtual cl ('a): {} + and cl2: {}; +}; + +let privacy = {pri x = c => 5 + c}; + +module Js = { + type t<'a>; +}; + +/* supports trailing comma */ +type stream<'a> = { + . + "observer": ('a => unit) => unit, +}; diff --git a/formatTest/typeCheckedTests/input/typeParameters.re b/formatTest/typeCheckedTests/input/typeParameters.re index a4ca9c32c..08e084825 100644 --- a/formatTest/typeCheckedTests/input/typeParameters.re +++ b/formatTest/typeCheckedTests/input/typeParameters.re @@ -1,6 +1,7 @@ /** * Testing type parameters. */ +[@reason.version 3.7]; type threeThings<'t> = ('t, 't, 't); type listOf<'t> = list<'t>; diff --git a/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re b/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re new file mode 100644 index 000000000..c7d6710bf --- /dev/null +++ b/formatTest/typeCheckedTests/input/typeParameters_3_dot_8.re @@ -0,0 +1,81 @@ +/** + * Testing type parameters. + */ +[@reason.version 3.8]; + +type threeThings<'t> = ('t, 't, 't); +type listOf<'t> = list<'t>; + +type underscoreParam<_> = Underscored; +type underscoreParamCovariance<+_> = Underscored; +type underscoreParamContravariance<-_> = Underscored; + +type tickParamCovariance<+'a> = Underscored; +type tickParamContravariance<-'a> = Underscored; + +let x : option > = None; +type myFunctionType<'a> = (list<('a, 'a)>, int => option >); +let funcAnnoted = (~a: list=[0, 1, ], ()) => a; + + + +/** + * Syntax that would be likely to conflict with lexing parsing of < > syntax. + */ + +let zero = 0; +let isGreaterThanNegFive = zero > - 5; +let isGreaterThanNegFive2 = zero > -5; +let isGreaterThanNegFive3 = zero >(-5); + +let isGreaterThanEqNegFive = zero >= -5; +let isGreaterThanEqNegFive2 = zero >= -5; +let isGreaterThanEqNegFive3 = zero >=(-5); + +let (>>=) = (a, b) => a >= b; + +let isSuperGreaterThanEqNegFive = zero >>= - 5; +let isSuperGreaterThanEqNegFive2 = zero >>= -5; +let isSuperGreaterThanEqNegFive3 = zero >>= (-5); + +let jsx= (~children, ()) => 0; + +type t<'a> = 'a; +let optionArg = (~arg:option>=?, ()) => arg; +let optionArgList = (~arg:option>>=?, ()) => arg; +let defaultJsxArg = (~arg:t(int)=, ()) => arg; +let defaultFalse = (~arg:t=!true, ()) => arg; +/* Doesn't work on master either let defaultTrue = (~arg:t= !!true) => arg; */ + +/** + * Things likely to conflict or impact precedence. + */ +let neg=-1; +let tru=!false; +let x = + "arbitrary" === "example" + && "how long" >= "can you get" + && "seriously" <= "what is the line length"; + +let z = 0; +module Conss = { + let (>-) = (a, b) => a + b; + let four = 3 >- 1; + let two = 3 >- -1; + let four' = 3 >- - - 1; + + let tr = 3 > - 1; + let tr' = 3 > - -1; + let tr'' = 3 > - - - 1; +} + +module Idents = { + let (>-) = (a, b) => a + b; + let four = z >- z; + let two = z >- -z; + let four' = z >- - - z; + + let tr = z > - z; + let tr' = z > - -z; + let tr'' = z > - - - z; +} diff --git a/formatTest/unit_tests/expected_output/assert.re b/formatTest/unit_tests/expected_output/assert.re index 136ae43bb..b2e1fc5f8 100644 --- a/formatTest/unit_tests/expected_output/assert.re +++ b/formatTest/unit_tests/expected_output/assert.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; switch (true) { | true => () | false => assert(false) diff --git a/formatTest/unit_tests/expected_output/basicStructures.re b/formatTest/unit_tests/expected_output/basicStructures.re index abf0b0e0b..7b0e6b11e 100644 --- a/formatTest/unit_tests/expected_output/basicStructures.re +++ b/formatTest/unit_tests/expected_output/basicStructures.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/formatTest/unit_tests/expected_output/bigarray.re b/formatTest/unit_tests/expected_output/bigarray.re index 09526c339..761637a4e 100644 --- a/formatTest/unit_tests/expected_output/bigarray.re +++ b/formatTest/unit_tests/expected_output/bigarray.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; my_big_array3.{ reallyLongStringThatWillDefinitelyBreakLine }; diff --git a/formatTest/unit_tests/expected_output/bucklescript.re b/formatTest/unit_tests/expected_output/bucklescript.re index ac88e9821..7c1186569 100644 --- a/formatTest/unit_tests/expected_output/bucklescript.re +++ b/formatTest/unit_tests/expected_output/bucklescript.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; bla #= 10; bla #= Some(10); diff --git a/formatTest/unit_tests/expected_output/class_types.re b/formatTest/unit_tests/expected_output/class_types.re index 9d0ecdd8d..c43771745 100644 --- a/formatTest/unit_tests/expected_output/class_types.re +++ b/formatTest/unit_tests/expected_output/class_types.re @@ -1,4 +1,5 @@ -class type _module ('provider_impl) = {}; +[@reason.version 3.7]; +class type _module('provider_impl) = {}; type t; class type bzz = { inherit _module(t); diff --git a/formatTest/unit_tests/expected_output/class_types_3_dot_8.re b/formatTest/unit_tests/expected_output/class_types_3_dot_8.re new file mode 100644 index 000000000..11e7e9714 --- /dev/null +++ b/formatTest/unit_tests/expected_output/class_types_3_dot_8.re @@ -0,0 +1,42 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class type _module<'provider_impl> = {}; +type t; +class type bzz = { + inherit _module; +}; + +class type t = { + as 'a; + constraint 'a = #s; +}; + +/* https://github.com/facebook/reason/issues/2037 */ +class type xt = { + as 'a; +}; + +class x = { + as self; +}; + +class type classWithNoArgType = { + pub x: int; + pub y: int; +}; + +class classWithNoArg = { + pub x = 0; + pub y = 0; +}; + +class type t = { + open M; + as 'a; +}; + +class type t = { + open M; +}; diff --git a/formatTest/unit_tests/expected_output/emptyFileComment.re b/formatTest/unit_tests/expected_output/emptyFileComment.re index eb2b9c00d..39bd0f9c6 100644 --- a/formatTest/unit_tests/expected_output/emptyFileComment.re +++ b/formatTest/unit_tests/expected_output/emptyFileComment.re @@ -1 +1,2 @@ +[@reason.version 3.7]; // file with just a single line comment diff --git a/formatTest/unit_tests/expected_output/escapesInStrings.re b/formatTest/unit_tests/expected_output/escapesInStrings.re index 51e486fe1..f6efc72b8 100644 --- a/formatTest/unit_tests/expected_output/escapesInStrings.re +++ b/formatTest/unit_tests/expected_output/escapesInStrings.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* diff --git a/formatTest/unit_tests/expected_output/extensions.re b/formatTest/unit_tests/expected_output/extensions.re index fb702a472..4a032dd59 100644 --- a/formatTest/unit_tests/expected_output/extensions.re +++ b/formatTest/unit_tests/expected_output/extensions.re @@ -1,3 +1,5 @@ +[@reason.version 3.7]; + /* Extension sugar */ %extend diff --git a/formatTest/unit_tests/expected_output/externals.re b/formatTest/unit_tests/expected_output/externals.re index d02f97a8c..4ef85fbcd 100644 --- a/formatTest/unit_tests/expected_output/externals.re +++ b/formatTest/unit_tests/expected_output/externals.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** * Tests external formatting. */ diff --git a/formatTest/unit_tests/expected_output/features403.re b/formatTest/unit_tests/expected_output/features403.re index 871a32e7a..d438a5e1b 100644 --- a/formatTest/unit_tests/expected_output/features403.re +++ b/formatTest/unit_tests/expected_output/features403.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; type t = | A({a: int}) | B; diff --git a/formatTest/unit_tests/expected_output/firstClassModules.re b/formatTest/unit_tests/expected_output/firstClassModules.re index a5937d38e..eb2a37492 100644 --- a/formatTest/unit_tests/expected_output/firstClassModules.re +++ b/formatTest/unit_tests/expected_output/firstClassModules.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module Modifier = ( val Db.Hashtbl.create(): Db.Sig with type t = Mods.t diff --git a/formatTest/unit_tests/expected_output/fixme.re b/formatTest/unit_tests/expected_output/fixme.re index 40a98c766..00ad649c6 100644 --- a/formatTest/unit_tests/expected_output/fixme.re +++ b/formatTest/unit_tests/expected_output/fixme.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** * Problem: In thise example, the comment should have a space after it. */ diff --git a/formatTest/unit_tests/expected_output/functionInfix.re b/formatTest/unit_tests/expected_output/functionInfix.re index ee1576ec5..79db3cb23 100644 --- a/formatTest/unit_tests/expected_output/functionInfix.re +++ b/formatTest/unit_tests/expected_output/functionInfix.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let entries = ref([]); let all = ref(0); diff --git a/formatTest/unit_tests/expected_output/if.re b/formatTest/unit_tests/expected_output/if.re index c789dedb7..5ae25d29b 100644 --- a/formatTest/unit_tests/expected_output/if.re +++ b/formatTest/unit_tests/expected_output/if.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let logTSuccess = self => diff --git a/formatTest/unit_tests/expected_output/infix.re b/formatTest/unit_tests/expected_output/infix.re index e01057497..d3050d3a4 100644 --- a/formatTest/unit_tests/expected_output/infix.re +++ b/formatTest/unit_tests/expected_output/infix.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* - A good way to test if formatting of infix operators groups precedences diff --git a/formatTest/unit_tests/expected_output/jsx.re b/formatTest/unit_tests/expected_output/jsx.re index f1b49f5a1..0b67ee53c 100644 --- a/formatTest/unit_tests/expected_output/jsx.re +++ b/formatTest/unit_tests/expected_output/jsx.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let x = { diff --git a/formatTest/unit_tests/expected_output/modules_no_semi.re b/formatTest/unit_tests/expected_output/modules_no_semi.re index 432bf12fa..f238705c9 100644 --- a/formatTest/unit_tests/expected_output/modules_no_semi.re +++ b/formatTest/unit_tests/expected_output/modules_no_semi.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/formatTest/unit_tests/expected_output/object.re b/formatTest/unit_tests/expected_output/object.re index 38af64c49..af231efbb 100644 --- a/formatTest/unit_tests/expected_output/object.re +++ b/formatTest/unit_tests/expected_output/object.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type t = {.}; diff --git a/formatTest/unit_tests/expected_output/ocaml_identifiers.re b/formatTest/unit_tests/expected_output/ocaml_identifiers.re index 78b5ca0b1..f0acc8ca0 100644 --- a/formatTest/unit_tests/expected_output/ocaml_identifiers.re +++ b/formatTest/unit_tests/expected_output/ocaml_identifiers.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Type names (supported with PR#2342) */ module T = { type pub_ = unit; diff --git a/formatTest/unit_tests/expected_output/pexpFun.re b/formatTest/unit_tests/expected_output/pexpFun.re index 6c3091161..2cf134267 100644 --- a/formatTest/unit_tests/expected_output/pexpFun.re +++ b/formatTest/unit_tests/expected_output/pexpFun.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; let x = switch (x) { | Bar => diff --git a/formatTest/unit_tests/expected_output/pipeFirst.re b/formatTest/unit_tests/expected_output/pipeFirst.re index f75535627..ccc812b5a 100644 --- a/formatTest/unit_tests/expected_output/pipeFirst.re +++ b/formatTest/unit_tests/expected_output/pipeFirst.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; foo->f->g->h; bar->f->g->h; diff --git a/formatTest/unit_tests/expected_output/polymorphism.re b/formatTest/unit_tests/expected_output/polymorphism.re index c14249c32..fcc5bf2ca 100644 --- a/formatTest/unit_tests/expected_output/polymorphism.re +++ b/formatTest/unit_tests/expected_output/polymorphism.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/formatTest/unit_tests/expected_output/sharpop.re b/formatTest/unit_tests/expected_output/sharpop.re index 2c17c48d8..58f64aeb1 100644 --- a/formatTest/unit_tests/expected_output/sharpop.re +++ b/formatTest/unit_tests/expected_output/sharpop.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; foo #= bar[0]; foo##bar[0] = 3; diff --git a/formatTest/unit_tests/expected_output/singleLineCommentEof.re b/formatTest/unit_tests/expected_output/singleLineCommentEof.re index 18f9b9683..6568d3029 100644 --- a/formatTest/unit_tests/expected_output/singleLineCommentEof.re +++ b/formatTest/unit_tests/expected_output/singleLineCommentEof.re @@ -1 +1,2 @@ +[@reason.version 3.7]; // let x = 1 diff --git a/formatTest/unit_tests/expected_output/syntax.re b/formatTest/unit_tests/expected_output/syntax.re index 13a8959d2..98e0aa20d 100644 --- a/formatTest/unit_tests/expected_output/syntax.re +++ b/formatTest/unit_tests/expected_output/syntax.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ [@autoFormat let wrap = 80; let shift = 2]; diff --git a/formatTest/unit_tests/expected_output/syntax.rei b/formatTest/unit_tests/expected_output/syntax.rei index 3cee43a36..7fe239ed0 100644 --- a/formatTest/unit_tests/expected_output/syntax.rei +++ b/formatTest/unit_tests/expected_output/syntax.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /** diff --git a/formatTest/unit_tests/expected_output/testUtils.re b/formatTest/unit_tests/expected_output/testUtils.re index f2773a018..b65e35e94 100644 --- a/formatTest/unit_tests/expected_output/testUtils.re +++ b/formatTest/unit_tests/expected_output/testUtils.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let printSection = s => { diff --git a/formatTest/unit_tests/expected_output/trailing.re b/formatTest/unit_tests/expected_output/trailing.re index 5b41105e7..e471bd8df 100644 --- a/formatTest/unit_tests/expected_output/trailing.re +++ b/formatTest/unit_tests/expected_output/trailing.re @@ -1,3 +1,5 @@ +[@reason.version 3.7]; + let x = {"obj": obj}; let x = {"key": key, "keyTwo": keyTwo}; diff --git a/formatTest/unit_tests/expected_output/trailingSpaces.re b/formatTest/unit_tests/expected_output/trailingSpaces.re index 2c0dc7a99..0ebfaf9b2 100644 --- a/formatTest/unit_tests/expected_output/trailingSpaces.re +++ b/formatTest/unit_tests/expected_output/trailingSpaces.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ module M = diff --git a/formatTest/unit_tests/expected_output/typeDeclarations.re b/formatTest/unit_tests/expected_output/typeDeclarations.re index 0d2299c4c..9fde26a9f 100644 --- a/formatTest/unit_tests/expected_output/typeDeclarations.re +++ b/formatTest/unit_tests/expected_output/typeDeclarations.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* === test wrapping for arrows === */ type foo = option(int => int); type foo = option((int, int) => int); diff --git a/formatTest/unit_tests/expected_output/uncurried.re b/formatTest/unit_tests/expected_output/uncurried.re index 160f3c565..bc7ee27e3 100644 --- a/formatTest/unit_tests/expected_output/uncurried.re +++ b/formatTest/unit_tests/expected_output/uncurried.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; f(.); [@attr] diff --git a/formatTest/unit_tests/expected_output/variants.re b/formatTest/unit_tests/expected_output/variants.re index fa61fd7e0..6211a1e1f 100644 --- a/formatTest/unit_tests/expected_output/variants.re +++ b/formatTest/unit_tests/expected_output/variants.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ module LocalModule = { diff --git a/formatTest/unit_tests/expected_output/whitespace.re b/formatTest/unit_tests/expected_output/whitespace.re index 4acfff66f..07f0231bc 100644 --- a/formatTest/unit_tests/expected_output/whitespace.re +++ b/formatTest/unit_tests/expected_output/whitespace.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; module Test = { open Belt; open React; diff --git a/formatTest/unit_tests/expected_output/whitespace.rei b/formatTest/unit_tests/expected_output/whitespace.rei index 8cbda032c..507adb08b 100644 --- a/formatTest/unit_tests/expected_output/whitespace.rei +++ b/formatTest/unit_tests/expected_output/whitespace.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /** Interleave whitespace intelligently in signatures */ /* a */ diff --git a/formatTest/unit_tests/expected_output/wrappingTest.re b/formatTest/unit_tests/expected_output/wrappingTest.re index 3259658c7..2fe642ff6 100644 --- a/formatTest/unit_tests/expected_output/wrappingTest.re +++ b/formatTest/unit_tests/expected_output/wrappingTest.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* Run the formatting pretty printer with width 50 */ diff --git a/formatTest/unit_tests/expected_output/wrappingTest.rei b/formatTest/unit_tests/expected_output/wrappingTest.rei index b8b2a8132..56d76e27d 100644 --- a/formatTest/unit_tests/expected_output/wrappingTest.rei +++ b/formatTest/unit_tests/expected_output/wrappingTest.rei @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let named: (~a: int, ~b: int) => int; diff --git a/formatTest/unit_tests/input/class_types_3_dot_8.re b/formatTest/unit_tests/input/class_types_3_dot_8.re new file mode 100644 index 000000000..50382cf3a --- /dev/null +++ b/formatTest/unit_tests/input/class_types_3_dot_8.re @@ -0,0 +1,41 @@ +/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + +[@reason.version 3.8]; + +class type _module ('provider_impl) = { + +}; +type t; +class type bzz = { + inherit _module(t) +}; + +class type t = { as 'a; + constraint 'a = #s +}; + +/* https://github.com/facebook/reason/issues/2037 */ +class type xt = { as 'a }; + +class x = { + as self +}; + +class type classWithNoArgType { + pub x : int; + pub y : int +}; + +class classWithNoArg { + pub x = 0; + pub y = 0 +}; + +class type t = { + open M; + as 'a; +}; + +class type t = { + open M; +}; diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 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 3d47bd6b1..74d0e4395 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -13,6 +13,15 @@ type attributesPartition = { uncurried : bool } +let is_stylistic_attr = function + | { attr_name = {txt="reason.raw_literal"}; _} + (* Consider warnings to be "stylistic" attributes - attributes that do not + * affect printing *) + | { attr_name = {txt="ocaml.ppwarn"}; _} + | { attr_name = {txt="reason.preserve_braces"}; _} -> true + | _ -> false + + (** Partition attributes into kinds *) let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attributesPartition = match attrs with @@ -36,10 +45,7 @@ let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attrib | ({ attr_name = {txt="ocaml.doc" | "ocaml.text"}; _} as doc)::atTl when partDoc = true -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with docAttrs=doc::partition.docAttrs} - | ({ attr_name = {txt="reason.raw_literal"}; _} as attr) :: atTl -> - let partition = partitionAttributes ~partDoc ~allowUncurry atTl in - {partition with stylisticAttrs=attr::partition.stylisticAttrs} - | ({ attr_name = {txt="reason.preserve_braces"}; _} as attr) :: atTl -> + | attr :: atTl when is_stylistic_attr attr -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with stylisticAttrs=attr::partition.stylisticAttrs} | atHd :: atTl -> @@ -63,8 +69,7 @@ let extract_raw_literal attrs = let without_stylistic_attrs attrs = let rec loop acc = function - | attr :: rest when (partitionAttributes [attr]).stylisticAttrs != [] -> - loop acc rest + | attr :: rest when is_stylistic_attr attr -> loop acc rest | [] -> List.rev acc | attr :: rest -> loop (attr :: acc) rest in diff --git a/src/reason-parser/reason_declarative_lexer.mll b/src/reason-parser/reason_declarative_lexer.mll index 9da1f3108..e144191c7 100644 --- a/src/reason-parser/reason_declarative_lexer.mll +++ b/src/reason-parser/reason_declarative_lexer.mll @@ -451,6 +451,7 @@ rule token state = parse { SHARPEQUAL } | "#" operator_chars+ { SHARPOP (lexeme_operator lexbuf) } + (* File name / line number source mapping # n string\n *) | "#" [' ' '\t']* (['0'-'9']+ as num) [' ' '\t']* ("\"" ([^ '\010' '\013' '"' ] * as name) "\"")? [^ '\010' '\013'] * newline @@ -552,24 +553,38 @@ rule token state = parse } | "[|<" { set_lexeme_length lexbuf 2; + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) LBRACKETBAR } (* allow parsing of
*) | "/>
*) + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) set_lexeme_length lexbuf 2; SLASHGREATER } | "> *) + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) set_lexeme_length lexbuf 1; GREATER } | "><" uppercase_or_lowercase+ { (* allow parsing of
*) + (* TODO: See if decompose_token in Reason_single_parser.ml would work better for this *) set_lexeme_length lexbuf 1; GREATER } + | "[@reason.version " (['0'-'9']+ as major) '.' (['0'-'9']+ as minor) (('.' ['0'-'9']+)? as _patch) ']' { + (* Special case parsing of attribute so that we can special case its + * parsing. Parses x.y.z even though it is not valid syntax otherwise - + * just gracefully remove the last number. The parser will ignore this + * attribute when parsed, and instead record its presence, and then inject + * the attribute into the footer of the file. Then the printer will ensure + * it is formatted at the top of the file, ideally after the first file + * floating doc comment. *) + VERSION_ATTRIBUTE (int_of_string major, int_of_string minor) + } | "[@" { LBRACKETAT } | "[%" { LBRACKETPERCENT } | "[%%" { LBRACKETPERCENTPERCENT } diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 17b0fb6c1..35eeb54e3 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" @@ -1191,6 +1192,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 @@ -1437,12 +1439,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 @@ -2003,7 +2011,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 @@ -2011,7 +2019,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) } ; @@ -2320,14 +2328,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 @@ -2426,16 +2430,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) } ; @@ -2456,8 +2452,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) } ; @@ -3957,13 +3953,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) } ; @@ -3992,7 +3988,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 = @@ -4006,7 +4002,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 @@ -4045,24 +4041,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) } @@ -4076,19 +4063,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) @@ -4194,7 +4179,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)) @@ -4208,7 +4193,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) @@ -4253,7 +4238,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} @@ -4262,7 +4247,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 @@ -5000,6 +4985,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; @@ -5161,4 +5159,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 4cee9fd14..44a167e04 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 (_, _) @@ -6770,7 +6792,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) @@ -6827,7 +6849,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 @@ -7134,7 +7156,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 _ @@ -7598,7 +7620,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 @@ -8319,10 +8341,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 @@ -8335,12 +8394,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 =