From 70705a3c7cdd747c3b2bb3f8edee8b64c4af14a7 Mon Sep 17 00:00:00 2001 From: Jordan Date: Thu, 16 Jul 2020 15:47:11 -0700 Subject: [PATCH] Reason V4 [Stacked Diff 1/n #2605] [Allow multiple versions of Reason] Summary:This allows multiple versions of Reason in a single project by inferring and recording the version of syntax used into the file in an attribute. The attribute allows us to switch the parser and lexer on the fly. This attribute is not the only way we can infer the version, and we can allow project level configuration, but this is the approach that is guaranteed to work with any build system or tooling. Test Plan: Reviewers: CC: --- docs/RELEASING.md | 24 +- src/reason-parser/dune | 3 +- src/reason-parser/reason_attributes.ml | 17 +- .../reason_declarative_lexer.mll | 15 + src/reason-parser/reason_parser.mly | 134 ++-- src/reason-parser/reason_pprint_ast.ml | 74 ++- src/reason-parser/reason_single_parser.ml | 18 +- src/reason-version/dune | 5 + src/reason-version/reason_version.ml | 191 ++++++ src/redoc/redoc_html.ml | 590 ------------------ src/refmt/dune | 2 +- src/refmt/refmt_impl.ml | 3 +- src/vendored-omp/tools/dune | 2 +- test/4.12/reasonComments-re.t/input.re | 1 + test/assert.t/run.t | 1 + test/basicStructures.t/run.t | 1 + test/bigarray.t/run.t | 1 + test/bucklescript.t/run.t | 1 + test/class_types.t/run.t | 3 +- test/class_types_3_dot_8.t/input.re | 43 ++ test/class_types_3_dot_8.t/run.t | 13 + test/comments-ml.t/run.t | 2 +- test/emptyFileComment.t/input.re | 1 + test/emptyFileComment.t/run.t | 1 + test/escapesInStrings.t/input.re | 1 + test/escapesInStrings.t/run.t | 1 + test/extensions.t/input.re | 2 + test/extensions.t/run.t | 2 + test/externals.t/run.t | 1 + test/firstClassModules.t/run.t | 1 + test/fixme.t/run.t | 1 + test/functionInfix.t/run.t | 1 + test/general-syntax-re.t/run.t | 1 + test/general-syntax-rei.t/run.t | 1 + test/generics.t/run.t | 1 + test/if.t/run.t | 1 + test/infix.t/run.t | 1 + test/jsx.t/run.t | 1 + test/jsx_functor.t/run.t | 1 + test/lineComments.t/run.t | 1 + test/modules.t/run.t | 1 + test/modules_no_semi.t/run.t | 1 + test/object.t/run.t | 1 + test/ocaml_identifiers.t/run.t | 1 + test/oo_3_dot_8.t/input.re | 435 +++++++++++++ test/oo_3_dot_8.t/run.t | 13 + test/pexpFun.t/run.t | 1 + test/pipeFirst.t/run.t | 1 + test/polymorphism.t/run.t | 1 + test/print-width-env.t | 2 + test/sharpop.t/run.t | 1 + test/singleLineCommentEof.t/input.re | 1 + test/singleLineCommentEof.t/run.t | 1 + test/testUtils.t/run.t | 1 + test/trailing.t/run.t | 2 + test/trailingSpaces.t/run.t | 1 + test/typeDeclarations.t/run.t | 1 + test/typeParameters.t/input.re | 1 + test/typeParameters_3_dot_8.t/input.re | 81 +++ test/typeParameters_3_dot_8.t/run.t | 13 + test/uncurried.t/run.t | 1 + test/variants.t/run.t | 1 + test/version.t | 2 +- test/whitespace-re.t/run.t | 1 + test/whitespace-rei.t/run.t | 1 + test/wrapping-re.t/run.t | 1 + test/wrapping-rei.t/run.t | 1 + 67 files changed, 1052 insertions(+), 680 deletions(-) create mode 100644 src/reason-version/dune create mode 100644 src/reason-version/reason_version.ml delete mode 100644 src/redoc/redoc_html.ml create mode 100644 test/class_types_3_dot_8.t/input.re create mode 100644 test/class_types_3_dot_8.t/run.t create mode 100644 test/oo_3_dot_8.t/input.re create mode 100644 test/oo_3_dot_8.t/run.t create mode 100644 test/typeParameters_3_dot_8.t/input.re create mode 100644 test/typeParameters_3_dot_8.t/run.t 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/src/reason-parser/dune b/src/reason-parser/dune index 2bb29de80..5b759eec7 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -125,4 +125,5 @@ reason.ocaml-migrate-parsetree menhirLib reason.easy_format - ppxlib)) + ppxlib + reason.version)) diff --git a/src/reason-parser/reason_attributes.ml b/src/reason-parser/reason_attributes.ml index a272ebdfa..e8cde7d8c 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -12,6 +12,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 @@ -35,10 +44,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 -> @@ -62,8 +68,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 720dacaa1..3237c0bdd 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 719ffdefd..dc0445e4f 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -839,6 +839,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" @@ -1162,6 +1163,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 @@ -1408,12 +1410,18 @@ conflicts. implementation: structure EOF - { reason_mapper apply_mapper_to_structure $1 } + { + let itms = Reason_version.Ast_nodes.inject_attr_from_version_impl $1 in + reason_mapper apply_mapper_to_structure itms + } ; interface: signature EOF - { reason_mapper apply_mapper_to_signature $1 } + { + let itms = Reason_version.Ast_nodes.inject_attr_from_version_intf $1 in + reason_mapper apply_mapper_to_signature itms + } ; toplevel_phrase: embedded @@ -1974,7 +1982,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 @@ -1982,7 +1990,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) } ; @@ -2291,14 +2299,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 @@ -2397,16 +2401,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) } ; @@ -2427,8 +2423,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) } ; @@ -3928,13 +3924,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) } ; @@ -3963,7 +3959,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 = @@ -3977,7 +3973,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 @@ -4016,24 +4012,16 @@ 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) , (NoVariance, NoInjectivity) ) } - | UNDERSCORE { (mktyp (Ptyp_any) , (NoVariance, NoInjectivity) ) } + (* | UNDERSCORE { (mktyp (Ptyp_any) , (NoVariance, NoInjectivity) ) } *) | PLUS QUOTE ident { (mktyp (Ptyp_var $3) , (Covariant, NoInjectivity) ) } | PLUS UNDERSCORE { (mktyp (Ptyp_any) , (Covariant, NoInjectivity) ) } | MINUS QUOTE ident { (mktyp (Ptyp_var $3) , (Contravariant, NoInjectivity)) } @@ -4047,19 +4035,16 @@ type_variable_with_variance: } ; -type_parameter: type_variance type_variable { ($2, ($1, NoInjectivity)) }; - -type_variance: - | (* empty *) { NoVariance } - | PLUS { Covariant } - | MINUS { Contravariant } +type_variable_with_variance: + | type_variable_without_underscore { $1 } + | UNDERSCORE { + let first = mktyp Ptyp_any in + let second = (NoVariance, NoInjectivity) 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) @@ -4165,7 +4150,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)) @@ -4179,7 +4164,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) @@ -4224,7 +4209,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_exn $2.txt} @@ -4233,7 +4218,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 @@ -4975,6 +4960,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; @@ -5136,4 +5134,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 668540a30..0ad2e918e 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -292,6 +292,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. @@ -1050,6 +1058,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 @@ -2426,7 +2447,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 @@ -2532,7 +2553,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 @@ -2584,7 +2605,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 @@ -2740,7 +2761,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 @@ -3077,6 +3098,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 *) @@ -3085,7 +3107,7 @@ let printer = object(self:'self) avoid (@see @avoidSingleTokenWrapping): *) label (self#longident_loc li) - (makeTup ( + (typeParameterBookends ( List.map self#type_param_list_element l )) ) @@ -3123,7 +3145,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 (_, _) @@ -6760,7 +6782,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) @@ -6817,7 +6839,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 @@ -7124,7 +7146,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 _ @@ -7608,7 +7630,7 @@ let printer = object(self:'self) ~xf: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 @@ -8295,7 +8317,6 @@ let built_in_explicit_arity_constructors = ["Some"; "Assert_failure"; "Match_fai let explicit_arity_constructors = StringSet.of_list(built_in_explicit_arity_constructors @ (!configuredSettings).constructorLists) - let preprocessing_mapper = let escape_slashes = new Reason_syntax_util.escape_stars_slashes_mapper in object @@ -8336,6 +8357,31 @@ let preprocessing_mapper = | x -> x in escape_slashes#pattern (super#pattern pat) + + (** Doesn't actually "map", but searches for version number in AST and records + * it if present. Needs to be executed before printing. *) + method! structure_item 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 structure_item + + method! signature_item 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 signature_item + + (* These won't get removed from partitioning since they are individual floating + * attributes *) + method! structure structure = + super#structure + (List.filter should_keep_floating_stylistic_structure_attr structure) + + method! signature signature = + super#signature + (List.filter should_keep_floating_stylistic_sig_attr signature) end let ml_to_reason_swap_operator_mapper = new Reason_syntax_util.ml_to_reason_swap_operator_mapper @@ -8359,13 +8405,15 @@ let signature (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments (printer#signature - (preprocessing_mapper apply_mapper_to_signature x)) + (Reason_version.Ast_nodes.inject_attr_from_version_intf + (preprocessing_mapper apply_mapper_to_signature x))) let structure (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments (printer#structure - (preprocessing_mapper apply_mapper_to_structure x)) + (Reason_version.Ast_nodes.inject_attr_from_version_impl + (preprocessing_mapper apply_mapper_to_structure x))) let expression ppf x = format_layout ppf diff --git a/src/reason-parser/reason_single_parser.ml b/src/reason-parser/reason_single_parser.ml index 6b1e2dde0..9f9392ead 100644 --- a/src/reason-parser/reason_single_parser.ml +++ b/src/reason-parser/reason_single_parser.ml @@ -186,6 +186,8 @@ let common_remaining_infix_token pcur = | ['!'] -> Some(Reason_parser.BANG, pcur, pnext) | ['>'] -> Some(Reason_parser.GREATER, pcur, pnext) | ['<'] -> Some(Reason_parser.LESS, pcur, pnext) + | ['#'] -> Some(Reason_parser.SHARP, pcur, pnext) + | [':'] -> Some(Reason_parser.COLON, pcur, pnext) | _ -> None let rec decompose_token pos0 split = @@ -193,7 +195,6 @@ let rec decompose_token pos0 split = let pnext = advance pos0 2 in match split with (* Empty token is a valid decomposition *) - | [] -> None | '=' :: tl -> let eq = (Reason_parser.EQUAL, pcur, pnext) in let (revFirstTwo, tl, pcur, _pnext) = match tl with @@ -206,7 +207,7 @@ let rec decompose_token pos0 split = (match common_remaining_infix_token pcur tl with | None -> None | Some(r) -> Some(List.rev (r :: revFirstTwo))) - (* For type parameters type t<+'a> = .. *) + (* For type parameters type t<+'a> = .. and t<#classNameOrPolyVariantKind>*) | '<' :: tl -> let less = [Reason_parser.LESS, pcur, pnext] in if tl == [] then Some less @@ -216,7 +217,13 @@ let rec decompose_token pos0 split = | Some(r) -> Some(List.rev (r :: less))) | '>' :: _tl -> (* Recurse to take advantage of all the logic in case the remaining - * begins with an equal sign. *) + * begins with an equal sign. + * This also handles: + * + * class foo<'a, 'b>: ... + * + * Where >: is initially lexed as an infix. + *) let gt_tokens, rest_split, prest = split_greaters [] pcur split in if rest_split == [] then Some gt_tokens @@ -224,6 +231,11 @@ let rec decompose_token pos0 split = (match decompose_token prest rest_split with | None -> None (* Couldn't parse the non-empty tail - invalidates whole thing *) | Some(r) -> Some(List.rev gt_tokens @ r)) + | [_] | [_; _] -> + (match common_remaining_infix_token pcur split with + | None -> None + | Some a -> Some [a]) + | [] -> None | _ -> None diff --git a/src/reason-version/dune b/src/reason-version/dune new file mode 100644 index 000000000..f135084cc --- /dev/null +++ b/src/reason-version/dune @@ -0,0 +1,5 @@ +(library + (name reason_version) + (public_name reason.version) + (modules reason_version) + (libraries ppxlib)) diff --git a/src/reason-version/reason_version.ml b/src/reason-version/reason_version.ml new file mode 100644 index 000000000..6a70bdab0 --- /dev/null +++ b/src/reason-version/reason_version.ml @@ -0,0 +1,191 @@ +(** + * Tracks the version of Reason per file, and provides supported + * feature lookup per version. + *) +open Ppxlib +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, Location.none, 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 70419f88c..818e26482 100644 --- a/src/refmt/dune +++ b/src/refmt/dune @@ -2,7 +2,7 @@ (name refmt_impl) (public_name refmt) (package reason) - (libraries reason reason.cmdliner dune-build-info)) + (libraries reason reason.cmdliner dune-build-info reason_version)) (rule (targets git_commit.ml) 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 = diff --git a/src/vendored-omp/tools/dune b/src/vendored-omp/tools/dune index 8122ac6b4..35301729a 100644 --- a/src/vendored-omp/tools/dune +++ b/src/vendored-omp/tools/dune @@ -18,7 +18,7 @@ (name gencopy) (enabled_if (and - (>= %{ocaml_version} 5.0))) + (= %{ocaml_version} 5.0))) (modules gencopy) (libraries compiler-libs.common compiler-libs.bytecomp) (flags :standard -w -3)) diff --git a/test/4.12/reasonComments-re.t/input.re b/test/4.12/reasonComments-re.t/input.re index 6156f3c4a..24732b768 100644 --- a/test/4.12/reasonComments-re.t/input.re +++ b/test/4.12/reasonComments-re.t/input.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; 3; /* - */ 3 /*-*/ ; diff --git a/test/assert.t/run.t b/test/assert.t/run.t index c0493bb26..e5346a04f 100644 --- a/test/assert.t/run.t +++ b/test/assert.t/run.t @@ -1,5 +1,6 @@ Format assertions $ refmt ./input.re + [@reason.version 3.7]; switch (true) { | true => () | false => assert(false) diff --git a/test/basicStructures.t/run.t b/test/basicStructures.t/run.t index cf6d3175e..6bc02a7ad 100644 --- a/test/basicStructures.t/run.t +++ b/test/basicStructures.t/run.t @@ -1,5 +1,6 @@ Format basicStructures $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/test/bigarray.t/run.t b/test/bigarray.t/run.t index f464bba67..b6ef00371 100644 --- a/test/bigarray.t/run.t +++ b/test/bigarray.t/run.t @@ -1,5 +1,6 @@ Format bigarray $ refmt ./input.re + [@reason.version 3.7]; my_big_array3.{ reallyLongStringThatWillDefinitelyBreakLine }; diff --git a/test/bucklescript.t/run.t b/test/bucklescript.t/run.t index 0c5b55994..9d7093a04 100644 --- a/test/bucklescript.t/run.t +++ b/test/bucklescript.t/run.t @@ -1,5 +1,6 @@ Format bucklescript $ refmt ./input.re + [@reason.version 3.7]; bla #= 10; bla #= Some(10); diff --git a/test/class_types.t/run.t b/test/class_types.t/run.t index 716dfe3cf..b684b756e 100644 --- a/test/class_types.t/run.t +++ b/test/class_types.t/run.t @@ -1,6 +1,7 @@ Format class and class type $ refmt ./input.re - 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/test/class_types_3_dot_8.t/input.re b/test/class_types_3_dot_8.t/input.re new file mode 100644 index 000000000..b0e6f439c --- /dev/null +++ b/test/class_types_3_dot_8.t/input.re @@ -0,0 +1,43 @@ +/* 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 s = { as 'a; }; +class type u = { 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 +}; + +module M = {}; +class type v = { + open M; + as 'a; +}; + +class type w = { + open M; +}; diff --git a/test/class_types_3_dot_8.t/run.t b/test/class_types_3_dot_8.t/run.t new file mode 100644 index 000000000..bcc6ea546 --- /dev/null +++ b/test/class_types_3_dot_8.t/run.t @@ -0,0 +1,13 @@ + +Format basic + $ refmt --print re ./input.re > ./formatted.re + +Type-check basics + $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re + +Format the formatted file back + $ refmt --print re ./formatted.re > ./formatted_back.re + +Ensure idempotency: first format and second format are the same + $ diff formatted.re formatted_back.re + diff --git a/test/comments-ml.t/run.t b/test/comments-ml.t/run.t index 19671337b..0b0b7503a 100644 --- a/test/comments-ml.t/run.t +++ b/test/comments-ml.t/run.t @@ -14,5 +14,5 @@ Format the formatted file back Ensure idempotency: first format and second format are the same $ diff formatted.re formatted_back.re 0a1 - > + > [@reason.version 3.7]; [1] diff --git a/test/emptyFileComment.t/input.re b/test/emptyFileComment.t/input.re index eb2b9c00d..39bd0f9c6 100644 --- a/test/emptyFileComment.t/input.re +++ b/test/emptyFileComment.t/input.re @@ -1 +1,2 @@ +[@reason.version 3.7]; // file with just a single line comment diff --git a/test/emptyFileComment.t/run.t b/test/emptyFileComment.t/run.t index 8fcb9da22..1323f7812 100644 --- a/test/emptyFileComment.t/run.t +++ b/test/emptyFileComment.t/run.t @@ -1,3 +1,4 @@ Format empty file comment $ refmt ./input.re + [@reason.version 3.7]; // file with just a single line comment diff --git a/test/escapesInStrings.t/input.re b/test/escapesInStrings.t/input.re index 51e486fe1..f6efc72b8 100755 --- a/test/escapesInStrings.t/input.re +++ b/test/escapesInStrings.t/input.re @@ -1,3 +1,4 @@ +[@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* diff --git a/test/escapesInStrings.t/run.t b/test/escapesInStrings.t/run.t index e68366deb..25ff5fa08 100644 --- a/test/escapesInStrings.t/run.t +++ b/test/escapesInStrings.t/run.t @@ -1,5 +1,6 @@ Format escapes in strings $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* diff --git a/test/extensions.t/input.re b/test/extensions.t/input.re index 2bbeab3c2..b9df6a2d6 100644 --- a/test/extensions.t/input.re +++ b/test/extensions.t/input.re @@ -1,3 +1,5 @@ +[@reason.version 3.7]; + /* Extension sugar */ [%extend open M]; diff --git a/test/extensions.t/run.t b/test/extensions.t/run.t index 459bfe2e4..695e5632a 100644 --- a/test/extensions.t/run.t +++ b/test/extensions.t/run.t @@ -1,5 +1,7 @@ Format extensions $ refmt ./input.re + [@reason.version 3.7]; + /* Extension sugar */ [%extend open M]; diff --git a/test/externals.t/run.t b/test/externals.t/run.t index 91a7a9cbf..722ebf41c 100644 --- a/test/externals.t/run.t +++ b/test/externals.t/run.t @@ -1,5 +1,6 @@ Format externals $ refmt ./input.re + [@reason.version 3.7]; /** * Tests external formatting. */ diff --git a/test/firstClassModules.t/run.t b/test/firstClassModules.t/run.t index 4ad6da514..54428c20c 100644 --- a/test/firstClassModules.t/run.t +++ b/test/firstClassModules.t/run.t @@ -1,5 +1,6 @@ Format first class modules $ refmt ./input.re + [@reason.version 3.7]; module Modifier = ( val Db.Hashtbl.create(): Db.Sig with type t = Mods.t diff --git a/test/fixme.t/run.t b/test/fixme.t/run.t index da9fcfbb5..3f2a2aa4f 100644 --- a/test/fixme.t/run.t +++ b/test/fixme.t/run.t @@ -1,5 +1,6 @@ Format fixme $ refmt ./input.re + [@reason.version 3.7]; /** * Problem: In thise example, the comment should have a space after it. */ diff --git a/test/functionInfix.t/run.t b/test/functionInfix.t/run.t index 0b8c2baaa..0ed5e414a 100644 --- a/test/functionInfix.t/run.t +++ b/test/functionInfix.t/run.t @@ -1,5 +1,6 @@ Format function infix $ refmt ./input.re + [@reason.version 3.7]; let entries = ref([]); let all = ref(0); diff --git a/test/general-syntax-re.t/run.t b/test/general-syntax-re.t/run.t index 2d62820ef..b6c2d8fe4 100644 --- a/test/general-syntax-re.t/run.t +++ b/test/general-syntax-re.t/run.t @@ -1,5 +1,6 @@ Format general implementation syntax $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ [@autoFormat diff --git a/test/general-syntax-rei.t/run.t b/test/general-syntax-rei.t/run.t index 7a0ef630b..a04dbc184 100644 --- a/test/general-syntax-rei.t/run.t +++ b/test/general-syntax-rei.t/run.t @@ -1,5 +1,6 @@ Format general interface syntax $ refmt ./input.rei + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /** diff --git a/test/generics.t/run.t b/test/generics.t/run.t index ea1c09af0..559842e67 100644 --- a/test/generics.t/run.t +++ b/test/generics.t/run.t @@ -1,5 +1,6 @@ Format features from OCaml 4.03 $ refmt ./input.re + [@reason.version 3.7]; type t = | A({a: int}) | B; diff --git a/test/if.t/run.t b/test/if.t/run.t index 933226dfb..fa6406f86 100644 --- a/test/if.t/run.t +++ b/test/if.t/run.t @@ -1,5 +1,6 @@ Format if statements $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let logTSuccess = self => diff --git a/test/infix.t/run.t b/test/infix.t/run.t index 9725da45e..9aa86fcbb 100644 --- a/test/infix.t/run.t +++ b/test/infix.t/run.t @@ -1,5 +1,6 @@ Format infix operators $ refmt ./input.re + [@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/test/jsx.t/run.t b/test/jsx.t/run.t index 01f2990e9..94d6107d5 100644 --- a/test/jsx.t/run.t +++ b/test/jsx.t/run.t @@ -1,5 +1,6 @@ Format JSX $ refmt ./input.re + [@reason.version 3.7]; let x = { diff --git a/test/modules_no_semi.t/run.t b/test/modules_no_semi.t/run.t index 91dc96c67..bafbd890f 100644 --- a/test/modules_no_semi.t/run.t +++ b/test/modules_no_semi.t/run.t @@ -1,5 +1,6 @@ Format modules no semi $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/test/object.t/run.t b/test/object.t/run.t index 2b1738d9b..2b8c75348 100644 --- a/test/object.t/run.t +++ b/test/object.t/run.t @@ -1,5 +1,6 @@ Format objects $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ type t = {.}; diff --git a/test/ocaml_identifiers.t/run.t b/test/ocaml_identifiers.t/run.t index 1f52cfca3..528a1e839 100644 --- a/test/ocaml_identifiers.t/run.t +++ b/test/ocaml_identifiers.t/run.t @@ -1,5 +1,6 @@ Format OCaml identifiers file $ refmt ./input.ml --print re + [@reason.version 3.7]; /* Type names (supported with PR#2342) */ module T = { type pub_ = unit; diff --git a/test/oo_3_dot_8.t/input.re b/test/oo_3_dot_8.t/input.re new file mode 100644 index 000000000..1f036b5e2 --- /dev/null +++ b/test/oo_3_dot_8.t/input.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/test/oo_3_dot_8.t/run.t b/test/oo_3_dot_8.t/run.t new file mode 100644 index 000000000..bcc6ea546 --- /dev/null +++ b/test/oo_3_dot_8.t/run.t @@ -0,0 +1,13 @@ + +Format basic + $ refmt --print re ./input.re > ./formatted.re + +Type-check basics + $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re + +Format the formatted file back + $ refmt --print re ./formatted.re > ./formatted_back.re + +Ensure idempotency: first format and second format are the same + $ diff formatted.re formatted_back.re + diff --git a/test/pexpFun.t/run.t b/test/pexpFun.t/run.t index ce4479c61..26cff22a5 100644 --- a/test/pexpFun.t/run.t +++ b/test/pexpFun.t/run.t @@ -1,5 +1,6 @@ Format function expressipns (pexpFun) $ refmt ./input.re + [@reason.version 3.7]; let x = switch (x) { | Bar => diff --git a/test/pipeFirst.t/run.t b/test/pipeFirst.t/run.t index 52e54c672..b88bb86c8 100644 --- a/test/pipeFirst.t/run.t +++ b/test/pipeFirst.t/run.t @@ -1,5 +1,6 @@ Format pipe first (->) $ refmt ./input.re + [@reason.version 3.7]; foo->f->g->h; bar->f->g->h; diff --git a/test/polymorphism.t/run.t b/test/polymorphism.t/run.t index e76a398a6..e269cc655 100644 --- a/test/polymorphism.t/run.t +++ b/test/polymorphism.t/run.t @@ -1,5 +1,6 @@ Format polymoprhism $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let run = () => { diff --git a/test/print-width-env.t b/test/print-width-env.t index e64e0c39d..0499af809 100644 --- a/test/print-width-env.t +++ b/test/print-width-env.t @@ -5,11 +5,13 @@ Create a file with a long line Set the print width to 120 characters via env "REFMT_PRINT_WIDTH" $ REFMT_PRINT_WIDTH=120 refmt test.re + [@reason.version 3.7]; let initialState = uiStateFromValidated(~ownership=RemoteData.NotAsked, ~limits=initialLimits, SiteAuditSettings.default); Set the print width to 80 characters via env "REFMT_PRINT_WIDTH" $ REFMT_PRINT_WIDTH=80 refmt test.re + [@reason.version 3.7]; let initialState = uiStateFromValidated( ~ownership=RemoteData.NotAsked, diff --git a/test/sharpop.t/run.t b/test/sharpop.t/run.t index 585a1f60a..8451552f5 100644 --- a/test/sharpop.t/run.t +++ b/test/sharpop.t/run.t @@ -1,5 +1,6 @@ Format sharp operator $ refmt ./input.re + [@reason.version 3.7]; foo #= bar[0]; foo##bar[0] = 3; diff --git a/test/singleLineCommentEof.t/input.re b/test/singleLineCommentEof.t/input.re index 18f9b9683..6568d3029 100644 --- a/test/singleLineCommentEof.t/input.re +++ b/test/singleLineCommentEof.t/input.re @@ -1 +1,2 @@ +[@reason.version 3.7]; // let x = 1 diff --git a/test/singleLineCommentEof.t/run.t b/test/singleLineCommentEof.t/run.t index 5fec6a04b..0b3d40575 100644 --- a/test/singleLineCommentEof.t/run.t +++ b/test/singleLineCommentEof.t/run.t @@ -1,3 +1,4 @@ Format single line comment at the end of the file $ refmt ./input.re + [@reason.version 3.7]; // let x = 1 diff --git a/test/testUtils.t/run.t b/test/testUtils.t/run.t index 57f189cb5..5b71e2af6 100644 --- a/test/testUtils.t/run.t +++ b/test/testUtils.t/run.t @@ -1,5 +1,6 @@ Format test utils $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let printSection = s => { diff --git a/test/trailing.t/run.t b/test/trailing.t/run.t index f28bd1786..fa78728d8 100644 --- a/test/trailing.t/run.t +++ b/test/trailing.t/run.t @@ -1,5 +1,7 @@ Format trailing $ refmt ./input.re + [@reason.version 3.7]; + let x = {"obj": obj}; let x = {"key": key, "keyTwo": keyTwo}; diff --git a/test/trailingSpaces.t/run.t b/test/trailingSpaces.t/run.t index e72973b79..e3c1282d0 100644 --- a/test/trailingSpaces.t/run.t +++ b/test/trailingSpaces.t/run.t @@ -1,5 +1,6 @@ Format trailing spaces $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ module M = diff --git a/test/typeDeclarations.t/run.t b/test/typeDeclarations.t/run.t index baa4ea052..5971f7448 100644 --- a/test/typeDeclarations.t/run.t +++ b/test/typeDeclarations.t/run.t @@ -1,5 +1,6 @@ Format type declarations $ refmt ./input.re + [@reason.version 3.7]; /* === test wrapping for arrows === */ type foo = option(int => int); type foo = option((int, int) => int); diff --git a/test/typeParameters.t/input.re b/test/typeParameters.t/input.re index a4ca9c32c..08e084825 100644 --- a/test/typeParameters.t/input.re +++ b/test/typeParameters.t/input.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/test/typeParameters_3_dot_8.t/input.re b/test/typeParameters_3_dot_8.t/input.re new file mode 100644 index 000000000..c7d6710bf --- /dev/null +++ b/test/typeParameters_3_dot_8.t/input.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/test/typeParameters_3_dot_8.t/run.t b/test/typeParameters_3_dot_8.t/run.t new file mode 100644 index 000000000..87812e8f9 --- /dev/null +++ b/test/typeParameters_3_dot_8.t/run.t @@ -0,0 +1,13 @@ +Format basic + $ refmt --print re ./input.re > ./formatted.re + +Type-check basics + $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re + +Format the formatted file back + $ refmt --print re ./formatted.re > ./formatted_back.re + +Ensure idempotency: first format and second format are the same + $ diff formatted.re formatted_back.re + + diff --git a/test/uncurried.t/run.t b/test/uncurried.t/run.t index a4d347b3c..d6c22caa7 100644 --- a/test/uncurried.t/run.t +++ b/test/uncurried.t/run.t @@ -1,5 +1,6 @@ Format uncurried $ refmt ./input.re + [@reason.version 3.7]; f(.); [@attr] diff --git a/test/variants.t/run.t b/test/variants.t/run.t index e0e57e394..a3b13dca7 100644 --- a/test/variants.t/run.t +++ b/test/variants.t/run.t @@ -1,5 +1,6 @@ Format variants $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ module LocalModule = { diff --git a/test/version.t b/test/version.t index 444ddaf62..3e1fe1f99 100644 --- a/test/version.t +++ b/test/version.t @@ -1,3 +1,3 @@ Ensures refmt --version prints the right version $ refmt --version | cut -d '@' -f 1 - Reason 3.8.2 + Reason 3.7.0 diff --git a/test/whitespace-re.t/run.t b/test/whitespace-re.t/run.t index 83cc6f0c1..3b52250b1 100644 --- a/test/whitespace-re.t/run.t +++ b/test/whitespace-re.t/run.t @@ -1,5 +1,6 @@ Format whitespace in .re files $ refmt ./input.re + [@reason.version 3.7]; module Test = { open Belt; open React; diff --git a/test/whitespace-rei.t/run.t b/test/whitespace-rei.t/run.t index e4b4b700d..307d4e358 100644 --- a/test/whitespace-rei.t/run.t +++ b/test/whitespace-rei.t/run.t @@ -1,5 +1,6 @@ Format whitespace in .rei files $ refmt ./input.rei + [@reason.version 3.7]; /** Interleave whitespace intelligently in signatures */ /* a */ diff --git a/test/wrapping-re.t/run.t b/test/wrapping-re.t/run.t index c8823ac54..1207808ef 100644 --- a/test/wrapping-re.t/run.t +++ b/test/wrapping-re.t/run.t @@ -1,5 +1,6 @@ Format wrapping in .re files $ refmt ./input.re + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ /* Run the formatting pretty printer with width 50 */ diff --git a/test/wrapping-rei.t/run.t b/test/wrapping-rei.t/run.t index db8a10cd8..eb47e1330 100644 --- a/test/wrapping-rei.t/run.t +++ b/test/wrapping-rei.t/run.t @@ -1,5 +1,6 @@ Format wrapping in .rei files $ refmt ./input.rei + [@reason.version 3.7]; /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ let named: (~a: int, ~b: int) => int;