From 1fdf565bdb3e8a9d4d750a76b92eb77a280898e6 Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Thu, 19 May 2016 01:02:55 +0100 Subject: [PATCH 01/14] Do not spam standard output --- src/reasonbuild.ml | 7 +++++-- src/reopt.sh | 2 -- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/reasonbuild.ml b/src/reasonbuild.ml index cc62c8e8e..975bac7a8 100644 --- a/src/reasonbuild.ml +++ b/src/reasonbuild.ml @@ -64,14 +64,17 @@ let compile_ocaml_interf rei cmi env build = let ocamldep_command ~impl arg out env _build = let out = List.map env out in let out = List.map (fun n -> Px n) out in - let teeout = [Sh "|"; P "tee"] @ out in + let out = + match List.rev out with + | ([] | [_]) as out -> out + | last :: rev_prefix -> [Sh "|"; P "tee"] @ List.rev_append rev_prefix [Sh ">"; last] in let arg = env arg in let tags = tags_of_pathname arg in let specs = [ ocamldep_command' tags; A "-pp"; P refmt ] @ impl_intf ~impl arg - @ teeout in + @ out in Cmd (S specs) ;; diff --git a/src/reopt.sh b/src/reopt.sh index 316cc0d61..cfe88ed49 100755 --- a/src/reopt.sh +++ b/src/reopt.sh @@ -7,7 +7,6 @@ MY_OCAML_BUILD="-o myocamlbuild" -echo "$REASON_BUILD_DIR" if [ -z "$REASON_BUILD_DIR" ]; then REASON_BUILD_DIR=$(ocamlfind query reason) @@ -59,7 +58,6 @@ then # Link reason build rules set -- "${@:1:$#-3}" "$REASON_BUILD_DIR/reasonbuild.cmx" "${@: -3}" fi -echo $OCAMLOPT $@ # use OCAMLOPT that's passed in by rebuild $OCAMLOPT "$@" From a08f0211ea7b33477f33ff70ecb795579efb5edc Mon Sep 17 00:00:00 2001 From: KC Sivaramakrishnan Date: Thu, 19 May 2016 10:55:10 +0100 Subject: [PATCH 02/14] Add dockerfile for Reason --- .gitignore | 1 + docker/Dockerfile | 6 ++++++ docker/README.md | 41 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 48 insertions(+) create mode 100644 docker/Dockerfile create mode 100644 docker/README.md diff --git a/.gitignore b/.gitignore index 14a82f9e1..68b94b797 100644 --- a/.gitignore +++ b/.gitignore @@ -16,3 +16,4 @@ formatTest/customMLFiles/*.ml formatTest/customMLFormatOutput.re .jenga src/reason_parser.messages.bak +*~ diff --git a/docker/Dockerfile b/docker/Dockerfile new file mode 100644 index 000000000..0662bf2c5 --- /dev/null +++ b/docker/Dockerfile @@ -0,0 +1,6 @@ +FROM ocaml/opam:debian +RUN sudo -u opam sh -c "opam depext -u merlin utop" +RUN opam remote add main https://opam.ocaml.org && \ + opam pin add -y merlin https://github.com/the-lambda-church/merlin.git#reason-0.0.1 && \ + opam pin add -y merlin_extend https://github.com/let-def/merlin-extend.git#reason-0.0.1 && \ + opam pin add -y reason https://github.com/facebook/reason.git#0.0.6 diff --git a/docker/README.md b/docker/README.md new file mode 100644 index 000000000..21b5a44dc --- /dev/null +++ b/docker/README.md @@ -0,0 +1,41 @@ +# Dockerfile for Reason + +A Docker file for Reason development. + +## Build + +* Ensure that you have docker [installed](https://docs.docker.com/engine/installation/). +* Build the image: `docker build -t reason .` + +All set! + +## Running + +### Reason interactive top-level + +Start the Reason interactive top-level with: + + $ docker run -it reason rtop + +### Build native apps + +Assuming that you have a reason project directory called `hello_reason` with a +single file `hello.re`: + +``` +$ cat hello.re +print_string "Hello, Reason!\n" +``` + +To build the `hello` native app: + + $ cd hello_reason + $ docker run -it -v `pwd`:/src reason + $ cd /src + $ rebuild hello.native + $ ./hello.native + Hello, Reason! + +You can further edit your source file from the host machine and rebuild the +native app from your docker container. The build artefacts are found in your +host machins `hello_reason` directory. From 73710e56af14c9c02208c692f000012fd089a6a4 Mon Sep 17 00:00:00 2001 From: Yunxing Dai Date: Fri, 20 May 2016 00:14:36 -0700 Subject: [PATCH 03/14] Fix the ocaml version at 4.02.3 --- opam | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/opam b/opam index c5e8377e4..bf74d5c57 100644 --- a/opam +++ b/opam @@ -32,4 +32,4 @@ depopts: [ conflicts: [ "utop" {< "1.17"} ] -available: [ ocaml-version >= "4.02.3" ] +available: [ ocaml-version = "4.02.3" ] From 3ff7fb30f8d149a8d665e26226540527b48c5083 Mon Sep 17 00:00:00 2001 From: Sander Date: Fri, 20 May 2016 10:49:44 +0200 Subject: [PATCH 04/14] Create a Menhir conflicts file Makes it easier to find out what's wrong when you change `reason_parser.mly`. --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index b3acad86d..496f8b48a 100644 --- a/Makefile +++ b/Makefile @@ -33,12 +33,12 @@ clean: # Compile error messages into ml file, checks if the error messages are complete and not redundent compile_error: update_error - menhir --strict --unused-tokens src/reason_parser.mly --compile-errors src/reason_parser.messages > src/reason_parser_message.ml + menhir --explain --strict --unused-tokens src/reason_parser.mly --compile-errors src/reason_parser.messages > src/reason_parser_message.ml # Update error messages based on new grammar update_error: @ cp -f src/reason_parser.messages src/reason_parser.messages.bak - @ if ! menhir --strict --unused-tokens src/reason_parser.mly --update-errors src/reason_parser.messages.bak | sed -e 's/[[:space:]]*$$//g' > src/reason_parser.messages ; then \ + @ if ! menhir --explain --strict --unused-tokens src/reason_parser.mly --update-errors src/reason_parser.messages.bak | sed -e 's/[[:space:]]*$$//g' > src/reason_parser.messages ; then \ cp src/reason_parser.messages.bak src/reason_parser.messages ; \ exit 1 ; \ fi From 230d1e99b1badc09153fba487e7784ce4aed10ce Mon Sep 17 00:00:00 2001 From: Thomas Mulvaney Date: Fri, 20 May 2016 11:05:26 +0100 Subject: [PATCH 05/14] fix typos --- docker/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docker/README.md b/docker/README.md index 21b5a44dc..024b62c73 100644 --- a/docker/README.md +++ b/docker/README.md @@ -37,5 +37,5 @@ To build the `hello` native app: Hello, Reason! You can further edit your source file from the host machine and rebuild the -native app from your docker container. The build artefacts are found in your -host machins `hello_reason` directory. +native app from your docker container. The build artifacts are found in your +host machines `hello_reason` directory. From 3ead83a6aa7abf7f90758ba906313cdc089e4f84 Mon Sep 17 00:00:00 2001 From: Aleksey Kladov Date: Sun, 22 May 2016 01:23:48 +0300 Subject: [PATCH 06/14] Don't hardcode path to bash --- Makefile | 2 +- src/refmt_merlin_impl.sh | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 496f8b48a..27bf52d4a 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ # Portions Copyright (c) 2015-present, Facebook, Inc. All rights reserved. -SHELL=/bin/bash -o pipefail +SHELL=bash -o pipefail default: build test diff --git a/src/refmt_merlin_impl.sh b/src/refmt_merlin_impl.sh index a6cd19758..fddee2a2f 100644 --- a/src/refmt_merlin_impl.sh +++ b/src/refmt_merlin_impl.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" From 4f2ab4972df4e353f99f33594f7b44e4a1738c0c Mon Sep 17 00:00:00 2001 From: David Date: Sun, 10 Apr 2016 00:59:07 -0700 Subject: [PATCH 07/14] add comments test input file and its expected output --- .../unit_tests/expected_output/comments.re | 131 +++++++++++++ formatTest/unit_tests/input/comments.re | 172 ++++++++++++++++++ 2 files changed, 303 insertions(+) create mode 100644 formatTest/unit_tests/expected_output/comments.re create mode 100644 formatTest/unit_tests/input/comments.re diff --git a/formatTest/unit_tests/expected_output/comments.re b/formatTest/unit_tests/expected_output/comments.re new file mode 100644 index 000000000..8a1aed30c --- /dev/null +++ b/formatTest/unit_tests/expected_output/comments.re @@ -0,0 +1,131 @@ +/* + * Multiline comment + */ +/* + * Multiline comment with a // single line comment + */ +// Single line comment +// Single line comment with a multiline /* starting +let testPostComment = ""; + +// let commentedCode = ""; +// Test inter-code comments +let testMultiline a => + switch a { + // single line comment + | `Thingy x => { + print_string + // multiline comment should be fine + "matched thingy x"; + let zz = 10; + // post line single line comment + zz + } + | `Other x => { + // single line comment above + print_string "matched other x"; + x + } + }; + +// single line comment below +// short comment +let x = ["test"]; + +// short comment +let x = { + // /* */ + let y = ""; + () +}; + +// /* this is a valid nested comment*/ this is a valid comment +// valid /* this is a valid comment +let z = 10; + +// The following tests will test the conversion of /* */ to single line +// comments as well as the wrapping of interleaved comments within short sequences. +/* + * Test wrapping every form of named arguments where various parts are + * commented. + */ +let a = 10; + +let b = 20; + +//A +let named /* a::a */ a::a /* b::b */ b::b => /* a + b */ a + b; + +//B +let namedAlias /* a::aa */ a::aa /* b::bb */ b::bb => /* aa + bb */ aa + bb; + +//C +let namedAnnot + /* a::(a: option int) */ + a::(a: option int) + /* b::(b: option int) */ + b::(b: option int) => + // 20 + 20; + +//D +let namedAliasAnnot + /* a::(aa: option int) */ + a::(aa: option int) + /* b::(bb: option int) */ + b::(bb: option int) => + // 20 + 20; + +//E +let optional /* a::a=? */ a::a=? /* b::b=? */ b::b=? /* () */ () => + // 10 + 10; + +//F +let optionalAlias /* a::aa */ a::aa=? /* ?b:bb */ b::bb=? /* () */ () => + // 10 + 10; + +//G +let optionalAnnot + /* a::(a: option int)=? */ + a::(a: option int)=? + /* ?b:(b: option int) */ + b::(b: option int)=? + /* () */ + () => + // 10 + 10; + +//H +let optionalAliasAnnot + /* a::(aa: option int)=? */ + a::(aa: option int)=? + /* b::(bb: option int)=? */ + b::(bb: option int)=? + /* () => */ + () => + // 10 + 10; + +//I: This one is really annoying? Where's the visual label? +let defOptional /* a::a=10 */ a::a=10 /* b::b=10 */ b::b=10 /* () => */ () => + // 10 + 10; + +//J +let defOptionalAlias /* a::aa=10 */ a::aa=10 /* b::bb=10 */ b::bb=10 /* () => */ () => + // 10; + 10; + +//K +let defOptionalAnnot + /* a::(a:int)=10 */ + a::(a: int)=10 + /* b::(b:int)=10 */ + b::(b: int)=10 + /* () => */ + () => + // 10; + 10; diff --git a/formatTest/unit_tests/input/comments.re b/formatTest/unit_tests/input/comments.re new file mode 100644 index 000000000..336730e94 --- /dev/null +++ b/formatTest/unit_tests/input/comments.re @@ -0,0 +1,172 @@ +/* + * Multiline comment + */ + +/* + * Multiline comment with a // single line comment + */ +// Single line comment +// Single line comment with a multiline /* starting +let testPostComment = ""; +// let commentedCode = ""; + +// Test inter-code comments +let testMultiline a => switch a { + // single line comment + | `Thingy x => { + print_string /* multiline comment should be fine */ "matched thingy x"; + let zz = 10; // post line single line comment + zz; + } + | `Other x => { + // single line comment above + print_string "matched other x"; + x; + } + // single line comment below +}; + + +/* short comment */ +let x = [ + "test", +]; + + +/* short comment */ +let x = { + // /* */ + let y = "" +}; + +// /* this is a valid nested comment*/ this is a valid comment + + +// valid /* this is a valid comment + +let z = 10; + + + +// The following tests will test the conversion of /* */ to single line +// comments as well as the wrapping of interleaved comments within short sequences. + +/* + * Test wrapping every form of named arguments where various parts are + * commented. + */ +let a = 10; +let b = 20; +/*A*/ +let named + /* a::a */ + a::a + /* b::b */ + b::b => + /* a + b */ + a + b; + +/*B*/ +let namedAlias + /* a::aa */ + a::aa + /* b::bb */ + b::bb => + /* aa + bb */ + aa + bb; + +/*C*/ +let namedAnnot + /* a::(a: option int) */ + a::(a: option int) + /* b::(b: option int) */ + b::(b: option int) => + /* 20 */ + 20; + +/*D*/ +let namedAliasAnnot + /* a::(aa: option int) */ + a::(aa: option int) + /* b::(bb: option int) */ + b::(bb: option int) => + /* 20 */ + 20; + +/*E*/ +let optional + /* a::a=? */ + a::a=? + /* b::b=? */ + b::b=? + /* () */ + () => + /* 10 */ + 10; + +/*F*/ +let optionalAlias + /* a::aa */ + a::aa=? + /* ?b:bb */ + b::bb=? + /* () */ + () => + /* 10 */ + 10; + +/*G*/ +let optionalAnnot + /* a::(a: option int)=? */ + a::(a: option int)=? + /* ?b:(b: option int) */ + b::(b: option int)=? + /* () */ + () => + /* 10 */ + 10; + +/*H*/ +let optionalAliasAnnot + /* a::(aa: option int)=? */ + a::(aa: option int)=? + /* b::(bb: option int)=? */ + b::(bb: option int)=? + /* () => */ + () => + /* 10 */ + 10; +/*I: This one is really annoying? Where's the visual label?*/ +let defOptional + /* a::a=10 */ + a::a=10 + /* b::b=10 */ + b::b=10 + /* () => */ + () => + /* 10 */ + 10; + +/*J*/ +let defOptionalAlias + /* a::aa=10 */ + a::aa=10 + /* b::bb=10 */ + b::bb=10 + /* () => */ + () => + /* 10; */ + 10; + +/*K*/ +let defOptionalAnnot + /* a::(a:int)=10 */ + a::(a:int)=10 + /* b::(b:int)=10 */ + b::(b:int)=10 + /* () => */ + () => + /* 10; */ + 10; + + From f9a44022ea708e7a89571044023d010ab6492a38 Mon Sep 17 00:00:00 2001 From: David Date: Sun, 10 Apr 2016 01:14:14 -0700 Subject: [PATCH 08/14] fix nested comments case --- formatTest/unit_tests/input/comments.re | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/formatTest/unit_tests/input/comments.re b/formatTest/unit_tests/input/comments.re index 336730e94..0127a753a 100644 --- a/formatTest/unit_tests/input/comments.re +++ b/formatTest/unit_tests/input/comments.re @@ -2,11 +2,15 @@ * Multiline comment */ +/* + + + */ + /* * Multiline comment with a // single line comment */ // Single line comment -// Single line comment with a multiline /* starting let testPostComment = ""; // let commentedCode = ""; @@ -42,7 +46,7 @@ let x = { // /* this is a valid nested comment*/ this is a valid comment -// valid /* this is a valid comment +// valid /* this is a valid comment */ let z = 10; From 51c75aa967c940983cd64dc5a39c56bc3475063d Mon Sep 17 00:00:00 2001 From: David Date: Tue, 12 Apr 2016 15:52:13 -0700 Subject: [PATCH 09/14] update lexer to handle line comment tokens --- src/reason_lexer.mll | 69 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 61 insertions(+), 8 deletions(-) diff --git a/src/reason_lexer.mll b/src/reason_lexer.mll index ae916d31a..2bb156c28 100644 --- a/src/reason_lexer.mll +++ b/src/reason_lexer.mll @@ -58,6 +58,7 @@ type error = | Illegal_character of char | Illegal_escape of string | Unterminated_comment of Location.t + | Unmatched_nested_comment of Location.t | Unterminated_string | Unterminated_string_in_comment of Location.t * Location.t | Keyword_as_label of string @@ -166,6 +167,8 @@ let get_stored_string () = (* To store the position of the beginning of a string and comment *) let string_start_loc = ref Location.none;; let comment_start_loc = ref [];; +let line_comment_start_loc = ref [];; +let single_line_comment = ref false;; let in_comment () = !comment_start_loc <> [];; let is_in_string = ref false let in_string () = !is_in_string @@ -265,6 +268,8 @@ let report_error ppf = function fprintf ppf "Illegal backslash escape in string or character (%s)" s | Unterminated_comment _ -> fprintf ppf "Comment not terminated" + | Unmatched_nested_comment _ -> + fprintf ppf "Unmatched nested comment" | Unterminated_string -> fprintf ppf "String literal not terminated" | Unterminated_string_in_comment (_, loc) -> @@ -418,6 +423,17 @@ rule token = parse let esc = String.sub l 1 (String.length l - 1) in raise (Error(Illegal_escape esc, Location.curr lexbuf)) } + | "//" + { let start_loc = Location.curr lexbuf in + single_line_comment := true; + line_comment_start_loc := [start_loc]; + reset_string_buffer (); + let end_loc = comment lexbuf in + let s = get_stored_string () in + reset_string_buffer (); + COMMENT (s, { start_loc with + Location.loc_end = end_loc.Location.loc_end }) + } | "/*" { let start_loc = Location.curr lexbuf in comment_start_loc := [start_loc]; @@ -546,15 +562,33 @@ rule token = parse } and comment = parse - "/*" - { comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc; + | "/*" + { + comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc; store_lexeme lexbuf; comment lexbuf; } | "*/" - { match !comment_start_loc with - | [] -> assert false - | [_] -> comment_start_loc := []; Location.curr lexbuf + { + match !comment_start_loc with + | [] -> + (* If it's part of a single line comment, we should raise an + * unterminated nested comment error *) + if !single_line_comment then ( + let loc = Location.curr lexbuf in + let start = List.hd (List.rev !line_comment_start_loc) in + raise (Error (Unmatched_nested_comment loc, start)) + ) + else assert false + | [_] -> + if !single_line_comment then ( + comment_start_loc := []; + store_lexeme lexbuf; + comment lexbuf; + ) + else ( + comment_start_loc := []; Location.curr lexbuf + ) | _ :: l -> comment_start_loc := l; store_lexeme lexbuf; comment lexbuf; @@ -624,9 +658,28 @@ and comment = parse raise (Error (Unterminated_comment start, loc)) } | newline - { update_loc lexbuf None 1 false 0; - store_lexeme lexbuf; - comment lexbuf + { + if not !single_line_comment then ( + update_loc lexbuf None 1 false 0; + store_lexeme lexbuf; + comment lexbuf + ) + else ( + update_loc lexbuf None 1 false 0; + (* check if there are any unmatched nested comments *) + match !comment_start_loc with + | [] -> ( + (* reset since we're done parsing a single line comment *) + single_line_comment := false; + match !line_comment_start_loc with + | [] -> assert false + | _ -> line_comment_start_loc := []; Location.curr lexbuf + ) + | _ -> + let start = List.hd (List.rev !comment_start_loc) in + comment_start_loc := []; + raise (Error (Unmatched_nested_comment start, Location.curr lexbuf)) + ) } | _ { store_lexeme lexbuf; comment lexbuf } From 4f85addc6cadf3b86163d9029bfdd88f48adef1a Mon Sep 17 00:00:00 2001 From: David Date: Tue, 12 Apr 2016 15:53:10 -0700 Subject: [PATCH 10/14] update pretty printer to print line comments while forcing multiline comments for lists that break `IfNeed`ed --- src/reason_pprint_ast.ml | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/src/reason_pprint_ast.ml b/src/reason_pprint_ast.ml index ec1cebaff..90a1eb227 100644 --- a/src/reason_pprint_ast.ml +++ b/src/reason_pprint_ast.ml @@ -1265,12 +1265,21 @@ let smallestLeadingSpaces strs = in smallestLeadingSpaces 99999 strs -let formatItemComment (str, commLoc, physCommLoc) = +(* + forceMultiline should be set to true in cases where the comment + is part of a list that could potentially break to prevent inline + comments from being rendered as line comments +*) +let formatItemComment ?(forceMultiline=false) (str, commLoc, physCommLoc) = let commLines = Str.split_delim (Str.regexp "\n") ("/*" ^ str ^ "*/") in match commLines with | [] -> easyAtom "" | [hd] -> - makeEasyList ~inline:(true, true) ~postSpace:true ~preSpace:true ~indent:0 ~break:IfNeed [easyAtom hd] + if forceMultiline then + makeEasyList ~inline:(true, true) ~postSpace:true ~preSpace:true ~indent:0 ~break:IfNeed [easyAtom hd] + (* caveat: single line comment . *) + else + makeEasyList ~inline:(true, true) ~postSpace:true ~preSpace:true ~indent:0 ~break:IfNeed [easyAtom ("//" ^ str)] | zero::one::tl -> let lineZero = List.nth commLines 0 in let lineOne = List.nth commLines 1 in @@ -1290,7 +1299,7 @@ let formatItemComment (str, commLoc, physCommLoc) = (* Use the Str module for regex splitting *) makeEasyList ~inline:(true, true) ~indent:0 ~break:Always_rec (List.map easyAtom lines) -let formatComments comms = List.map formatItemComment comms +let formatComments ?(forceMultiline=false) comms = List.map (formatItemComment ~forceMultiline:forceMultiline) comms let convertIsListyToIsSequencey isListyImpl = let rec isSequencey layoutNode = match layoutNode with @@ -1340,7 +1349,16 @@ let rec interleaveComments ?endMaxChar listConfig layoutListItems comments = let eolEasyComments = List.map formatItemComment endOfLineComments in let item = Item (easyItem, eolEasyComments) in let (rest, recUnconsumedComms) = interleaveComments ?endMaxChar listConfig tl itemUnconsumed in - let easyComments = List.map (fun c -> ItemComment (formatItemComment c, (isDocComment c))) onItem in + let easyComments = match listConfig.break with + (* + * If the comment is part of a list that isn't meant to break, or potentially might not break, + * we need to force it to be a multiline string due to interleaving + *) + | IfNeed | Never -> + List.map (fun c -> ItemComment (formatItemComment ~forceMultiline:true c, (isDocComment c))) onItem + | _ -> + List.map (fun c -> ItemComment (formatItemComment ~forceMultiline:false c, (isDocComment c))) onItem + in (List.concat [easyComments; [item]; rest], recUnconsumedComms) (* From 8c95524022963e5be383ade1e14004ae966f867e Mon Sep 17 00:00:00 2001 From: David Date: Sun, 24 Apr 2016 14:35:00 -0700 Subject: [PATCH 11/14] update comments tests --- formatTest/unit_tests/input/comments.re | 29 ++++++++++++++++++------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/formatTest/unit_tests/input/comments.re b/formatTest/unit_tests/input/comments.re index 0127a753a..6424dbfbb 100644 --- a/formatTest/unit_tests/input/comments.re +++ b/formatTest/unit_tests/input/comments.re @@ -1,7 +1,6 @@ /* * Multiline comment */ - /* @@ -10,11 +9,12 @@ /* * Multiline comment with a // single line comment */ + // Single line comment let testPostComment = ""; // let commentedCode = ""; -// Test inter-code comments +// Test: inter-code comments let testMultiline a => switch a { // single line comment | `Thingy x => { @@ -30,13 +30,11 @@ let testMultiline a => switch a { // single line comment below }; - /* short comment */ let x = [ "test", ]; - /* short comment */ let x = { // /* */ @@ -45,15 +43,14 @@ let x = { // /* this is a valid nested comment*/ this is a valid comment - -// valid /* this is a valid comment */ +// valid /* this is also a valid nested comment */ let z = 10; - - +/////////////////////////////////////////////////////////////////////////////////// // The following tests will test the conversion of /* */ to single line // comments as well as the wrapping of interleaved comments within short sequences. +/////////////////////////////////////////////////////////////////////////////////// /* * Test wrapping every form of named arguments where various parts are @@ -173,4 +170,20 @@ let defOptionalAnnot /* 10; */ 10; +// This tests a short inline comment that should retain it's inline properties when formatted +let x = [ + /* sh */ + "te", +]; + +// This tests an empty /* */ nested comment + +// This tests a line comment that should be converted to an inline comment when formatted +let x = [ + // sh + "te", +]; + + + From f9c5a6c1dbb73f1394a7049c01924c48a5f92d5a Mon Sep 17 00:00:00 2001 From: David Date: Sun, 17 Apr 2016 00:51:39 -0700 Subject: [PATCH 12/14] clean up single line comment code --- src/reason_lexer.mll | 56 ++++++++++++++++++++------------------------ 1 file changed, 25 insertions(+), 31 deletions(-) diff --git a/src/reason_lexer.mll b/src/reason_lexer.mll index 2bb156c28..de3f62523 100644 --- a/src/reason_lexer.mll +++ b/src/reason_lexer.mll @@ -570,28 +570,23 @@ and comment = parse } | "*/" { - match !comment_start_loc with - | [] -> - (* If it's part of a single line comment, we should raise an - * unterminated nested comment error *) - if !single_line_comment then ( - let loc = Location.curr lexbuf in - let start = List.hd (List.rev !line_comment_start_loc) in - raise (Error (Unmatched_nested_comment loc, start)) - ) - else assert false - | [_] -> - if !single_line_comment then ( - comment_start_loc := []; - store_lexeme lexbuf; - comment lexbuf; - ) - else ( - comment_start_loc := []; Location.curr lexbuf - ) - | _ :: l -> comment_start_loc := l; - store_lexeme lexbuf; - comment lexbuf; + match (!comment_start_loc, !single_line_comment) with + | ([], false) -> + assert false + | ([], true) -> + let loc = Location.curr lexbuf in + let start = List.hd (List.rev !line_comment_start_loc) in + raise (Error (Unmatched_nested_comment loc, start)) + | ([_], true) -> + comment_start_loc := []; + store_lexeme lexbuf; + comment lexbuf; + | ([_], false) -> + comment_start_loc := []; Location.curr lexbuf + | (_ :: l, _) -> + comment_start_loc := l; + store_lexeme lexbuf; + comment lexbuf; } | "\"" { @@ -667,15 +662,14 @@ and comment = parse else ( update_loc lexbuf None 1 false 0; (* check if there are any unmatched nested comments *) - match !comment_start_loc with - | [] -> ( - (* reset since we're done parsing a single line comment *) - single_line_comment := false; - match !line_comment_start_loc with - | [] -> assert false - | _ -> line_comment_start_loc := []; Location.curr lexbuf - ) - | _ -> + + single_line_comment := false; + match (!comment_start_loc, !line_comment_start_loc) with + | ([], []) -> + assert false + | ([], _) -> + line_comment_start_loc := []; Location.curr lexbuf + | (_, _) -> let start = List.hd (List.rev !comment_start_loc) in comment_start_loc := []; raise (Error (Unmatched_nested_comment start, Location.curr lexbuf)) From 35f1604e88cb986f33c357cf77c64f67b1ad59e4 Mon Sep 17 00:00:00 2001 From: David Date: Sun, 24 Apr 2016 14:12:55 -0700 Subject: [PATCH 13/14] add new tests and add is_line_comment boolean to lexer COMMENT definition --- .../unit_tests/expected_output/comments.re | 149 ++++++++++++------ formatTest/unit_tests/input/comments.re | 11 +- src/reason_lexer.mll | 25 ++- src/reason_parser.mly | 2 +- src/reason_pprint_ast.ml | 24 ++- src/reason_toolchain.ml | 25 +-- 6 files changed, 154 insertions(+), 82 deletions(-) diff --git a/formatTest/unit_tests/expected_output/comments.re b/formatTest/unit_tests/expected_output/comments.re index 8a1aed30c..d231d0d41 100644 --- a/formatTest/unit_tests/expected_output/comments.re +++ b/formatTest/unit_tests/expected_output/comments.re @@ -1,38 +1,46 @@ /* * Multiline comment + */ +// Empty comments, or comments with whitespaces: +// +// +// +//a +/*inlinecommentwithnospaces*/ +/* + + */ /* * Multiline comment with a // single line comment */ // Single line comment -// Single line comment with a multiline /* starting + let testPostComment = ""; // let commentedCode = ""; -// Test inter-code comments +// Test: inter-code comments let testMultiline a => switch a { // single line comment - | `Thingy x => { - print_string - // multiline comment should be fine - "matched thingy x"; - let zz = 10; - // post line single line comment - zz - } - | `Other x => { - // single line comment above - print_string "matched other x"; - x - } - }; - -// single line comment below -// short comment + | `Thingy x => + print_string + /* multiline comment should be fine */ + "matched thingy x"; + let zz = 10; + // post line single line comment + zz + | `Other x => + // single line comment above + print_string "matched other x"; + x + } +// single line comment below; + +/* short comment */ let x = ["test"]; -// short comment +/* short comment */ let x = { // /* */ let y = ""; @@ -40,11 +48,13 @@ let x = { }; // /* this is a valid nested comment*/ this is a valid comment -// valid /* this is a valid comment +// valid /* this is also a valid nested comment */ let z = 10; +/////////////////////////////////////////////////////////////////////////////////// // The following tests will test the conversion of /* */ to single line // comments as well as the wrapping of interleaved comments within short sequences. +/////////////////////////////////////////////////////////////////////////////////// /* * Test wrapping every form of named arguments where various parts are * commented. @@ -53,41 +63,61 @@ let a = 10; let b = 20; -//A -let named /* a::a */ a::a /* b::b */ b::b => /* a + b */ a + b; - -//B -let namedAlias /* a::aa */ a::aa /* b::bb */ b::bb => /* aa + bb */ aa + bb; - -//C +/*A*/ +let named /* a::a */ a::a /* b::b */ b::b => + /* a + b */ + a + b; + +/*B*/ +let namedAlias + /* a::aa */ + a::aa + /* b::bb */ + b::bb => + /* aa + bb */ + aa + bb; + +/*C*/ let namedAnnot /* a::(a: option int) */ a::(a: option int) /* b::(b: option int) */ b::(b: option int) => - // 20 + /* 20 */ 20; -//D +/*D*/ let namedAliasAnnot /* a::(aa: option int) */ a::(aa: option int) /* b::(bb: option int) */ b::(bb: option int) => - // 20 + /* 20 */ 20; -//E -let optional /* a::a=? */ a::a=? /* b::b=? */ b::b=? /* () */ () => - // 10 +/*E*/ +let optional + /* a::a=? */ + a::a=? + /* b::b=? */ + b::b=? + /* () */ + () => + /* 10 */ 10; -//F -let optionalAlias /* a::aa */ a::aa=? /* ?b:bb */ b::bb=? /* () */ () => - // 10 +/*F*/ +let optionalAlias + /* a::aa */ + a::aa=? + /* ?b:bb */ + b::bb=? + /* () */ + () => + /* 10 */ 10; -//G +/*G*/ let optionalAnnot /* a::(a: option int)=? */ a::(a: option int)=? @@ -95,10 +125,10 @@ let optionalAnnot b::(b: option int)=? /* () */ () => - // 10 + /* 10 */ 10; -//H +/*H*/ let optionalAliasAnnot /* a::(aa: option int)=? */ a::(aa: option int)=? @@ -106,20 +136,32 @@ let optionalAliasAnnot b::(bb: option int)=? /* () => */ () => - // 10 + /* 10 */ 10; -//I: This one is really annoying? Where's the visual label? -let defOptional /* a::a=10 */ a::a=10 /* b::b=10 */ b::b=10 /* () => */ () => - // 10 +/*I: This one is really annoying? Where's the visual label?*/ +let defOptional + /* a::a=10 */ + a::a=10 + /* b::b=10 */ + b::b=10 + /* () => */ + () => + /* 10 */ 10; -//J -let defOptionalAlias /* a::aa=10 */ a::aa=10 /* b::bb=10 */ b::bb=10 /* () => */ () => - // 10; +/*J*/ +let defOptionalAlias + /* a::aa=10 */ + a::aa=10 + /* b::bb=10 */ + b::bb=10 + /* () => */ + () => + /* 10; */ 10; -//K +/*K*/ let defOptionalAnnot /* a::(a:int)=10 */ a::(a: int)=10 @@ -127,5 +169,14 @@ let defOptionalAnnot b::(b: int)=10 /* () => */ () => - // 10; + /* 10; */ 10; + +// This tests a short inline comment that should retain it's inline properties when formatted +let x = [/* sh */ "te"]; + +// This tests an empty /* */ nested comment +// This tests a line comment that should be converted to an inline comment when formatted +let x = [/* sh*/ "te"]; + +// File ends with a comment \ No newline at end of file diff --git a/formatTest/unit_tests/input/comments.re b/formatTest/unit_tests/input/comments.re index 6424dbfbb..a082f184b 100644 --- a/formatTest/unit_tests/input/comments.re +++ b/formatTest/unit_tests/input/comments.re @@ -1,6 +1,14 @@ /* * Multiline comment */ + +// Empty comments, or comments with whitespaces: +// +// +// +//a +/*inlinecommentwithnospaces*/ + /* @@ -185,5 +193,4 @@ let x = [ ]; - - +// File ends with a comment diff --git a/src/reason_lexer.mll b/src/reason_lexer.mll index de3f62523..31fd11845 100644 --- a/src/reason_lexer.mll +++ b/src/reason_lexer.mll @@ -431,7 +431,7 @@ rule token = parse let end_loc = comment lexbuf in let s = get_stored_string () in reset_string_buffer (); - COMMENT (s, { start_loc with + COMMENT (s, true, { start_loc with Location.loc_end = end_loc.Location.loc_end }) } | "/*" @@ -441,7 +441,7 @@ rule token = parse let end_loc = comment lexbuf in let s = get_stored_string () in reset_string_buffer (); - COMMENT (s, { start_loc with + COMMENT (s, false, { start_loc with Location.loc_end = end_loc.Location.loc_end }) } | "/*/" @@ -453,7 +453,7 @@ rule token = parse let end_loc = comment lexbuf in let s = get_stored_string () in reset_string_buffer (); - COMMENT (s, { loc with Location.loc_end = end_loc.Location.loc_end }) + COMMENT (s, false, { loc with Location.loc_end = end_loc.Location.loc_end }) } | "*/" { let loc = Location.curr lexbuf in @@ -646,7 +646,20 @@ and comment = parse { store_lexeme lexbuf; comment lexbuf } | eof { match !comment_start_loc with - | [] -> assert false + | [] -> + (* if the file ends with a single line comment then *) + if !single_line_comment then ( + single_line_comment := false; + match (!comment_start_loc, !line_comment_start_loc) with + | ([], []) -> + assert false + | ([], _) -> + line_comment_start_loc := []; Location.curr lexbuf + | (_, _) -> + let start = List.hd (List.rev !comment_start_loc) in + comment_start_loc := []; + raise (Error (Unmatched_nested_comment start, Location.curr lexbuf)) + ) else assert false | loc :: _ -> let start = List.hd (List.rev !comment_start_loc) in comment_start_loc := []; @@ -764,8 +777,8 @@ and skip_sharp_bang = parse let last_comments = ref [] let rec token lexbuf = match token_with_comments lexbuf with - COMMENT (s, comment_loc) -> - last_comments := (s, comment_loc) :: !last_comments; + COMMENT (s, is_line_comment, comment_loc) -> + last_comments := (s, is_line_comment, comment_loc) :: !last_comments; token lexbuf | tok -> tok let comments () = List.rev !last_comments diff --git a/src/reason_parser.mly b/src/reason_parser.mly index 55598bae4..6df5153a2 100644 --- a/src/reason_parser.mly +++ b/src/reason_parser.mly @@ -915,7 +915,7 @@ let built_in_explicit_arity_constructors = ["Some"; "Assert_failure"; "Match_fai %token WHEN %token WHILE %token WITH -%token COMMENT +%token COMMENT %token EOL diff --git a/src/reason_pprint_ast.ml b/src/reason_pprint_ast.ml index 90a1eb227..2ff8f5e67 100644 --- a/src/reason_pprint_ast.ml +++ b/src/reason_pprint_ast.ml @@ -1221,7 +1221,7 @@ let rec extractComments comments tester = let open Lexing in (* There might be an issue here - we shouldn't have to split "up to and including". Up to should be sufficient. Comments' end position might be off by one (too large) *) - comments |> List.partition (fun (str, attLoc, physLoc) -> + comments |> List.partition (fun (str, isLineComment, attLoc, physLoc) -> let oneGreaterThanAttachmentLocEnd = attLoc.loc_end.pos_cnum in let attachmentLocLastChar = oneGreaterThanAttachmentLocEnd - 1 in let oneGreaterThanPhysLocEnd = physLoc.loc_end.pos_cnum in @@ -1229,8 +1229,6 @@ let rec extractComments comments tester = tester attLoc.loc_start.pos_cnum attachmentLocLastChar physLoc.loc_start.pos_cnum physLastChar ) - - let space = " " (* Can't you tell the difference? *) let tab = " " @@ -1270,17 +1268,15 @@ let smallestLeadingSpaces strs = is part of a list that could potentially break to prevent inline comments from being rendered as line comments *) -let formatItemComment ?(forceMultiline=false) (str, commLoc, physCommLoc) = +let formatItemComment ?(forceMultiline=false) (str, is_line_comment, commLoc, physCommLoc) = let commLines = Str.split_delim (Str.regexp "\n") ("/*" ^ str ^ "*/") in - match commLines with - | [] -> easyAtom "" - | [hd] -> - if forceMultiline then - makeEasyList ~inline:(true, true) ~postSpace:true ~preSpace:true ~indent:0 ~break:IfNeed [easyAtom hd] - (* caveat: single line comment . *) - else - makeEasyList ~inline:(true, true) ~postSpace:true ~preSpace:true ~indent:0 ~break:IfNeed [easyAtom ("//" ^ str)] - | zero::one::tl -> + match (commLines, is_line_comment, forceMultiline) with + | (_, true, false) -> + makeEasyList ~inline:(true, true) ~postSpace:true ~preSpace:true ~indent:0 ~break:IfNeed [easyAtom ("//" ^ str)] + | ([], _, _) -> easyAtom "" + | ([hd], _, _) -> + makeEasyList ~inline:(true, true) ~postSpace:true ~preSpace:true ~indent:0 ~break:IfNeed [easyAtom hd] + | (zero::one::tl, _, _) -> let lineZero = List.nth commLines 0 in let lineOne = List.nth commLines 1 in let hasMeaningfulContentOnLineZero = lineZeroHasMeaningfulContent lineZero in @@ -1321,7 +1317,7 @@ let removeSepFromListConfig listSettings = 1. Before-line items break in unison with list items. 2. End of line comments are placed *after* separators. *) let rec interleaveComments ?endMaxChar listConfig layoutListItems comments = - let isDocComment (c, _, _) = String.length c > 0 && c.[0] == '*' in + let isDocComment (c, _, _, _) = String.length c > 0 && c.[0] == '*' in match (layoutListItems, endMaxChar) with | ([], None)-> ([], comments) | ([], Some endMax)-> diff --git a/src/reason_toolchain.ml b/src/reason_toolchain.ml index 0c8788fc2..24ad83007 100644 --- a/src/reason_toolchain.ml +++ b/src/reason_toolchain.ml @@ -124,8 +124,8 @@ let setup_lexbuf use_stdin filename = Location.init lexbuf filename; lexbuf -(* (comment text, attachment_location, physical location) *) -type attached_comments = (String.t * Location.t * Location.t) list +(* (comment text, is_line_comment, attachment_location, physical location) *) +type attached_comments = (String.t * bool * Location.t * Location.t) list module type Toolchain = sig (* Parsing *) @@ -152,7 +152,6 @@ module type Toolchain_spec = sig module rec Lexer_impl: sig val init: unit -> unit val token: Lexing.lexbuf -> Parser_impl.token - val comments: unit -> (String.t * Location.t) list end and Parser_impl: sig @@ -164,6 +163,7 @@ module type Toolchain_spec = sig val interface: Lexing.lexbuf -> Parsetree.signature val toplevel_phrase: Lexing.lexbuf -> Parsetree.toplevel_phrase val use_file: Lexing.lexbuf -> Parsetree.toplevel_phrase list + val comments: unit -> (String.t * bool * Location.t) list val format_interface_with_comments: (Parsetree.signature * attached_comments) -> Format.formatter -> unit val format_implementation_with_comments: (Parsetree.structure * attached_comments) -> Format.formatter -> unit @@ -180,21 +180,21 @@ module Create_parse_entrypoint (Toolchain_impl: Toolchain_spec) :Toolchain = str Toolchain_impl.safeguard_parsing lexbuf (fun () -> let _ = Toolchain_impl.Lexer_impl.init () in let ast = parsing_fun lexbuf in - let unmodified_comments = Toolchain_impl.Lexer_impl.comments() in + let unmodified_comments = Toolchain_impl.comments() in match !chan_input with | "" -> let _ = Parsing.clear_parser() in - (ast, unmodified_comments |> List.map (fun (txt, phys_loc) -> (txt, phys_loc, phys_loc))) + (ast, unmodified_comments |> List.map (fun (txt, is_line_comment, phys_loc) -> (txt, is_line_comment, phys_loc, phys_loc))) | _ -> let modified_and_attached_comments = - List.map (fun (str, physical_loc) -> + List.map (fun (str, is_line_comment, physical_loc) -> (* When searching for "^" regexp, returns location of newline + 1 *) let first_char_of_line = Str.search_backward new_line !chan_input physical_loc.loc_start.pos_cnum in let end_pos_plus_one = physical_loc.loc_end.pos_cnum in let comment_length = (end_pos_plus_one - physical_loc.loc_start.pos_cnum - 4) in (* Also, the string contents originally reported are incorrect! *) let original_comment_contents = String.sub !chan_input (physical_loc.loc_start.pos_cnum + 2) comment_length in - let (com, attachment_location) = + let (com, is_line_comment, attachment_location) = match Str.search_forward line_content !chan_input first_char_of_line with | n -> @@ -205,13 +205,14 @@ module Create_parse_entrypoint (Toolchain_impl: Toolchain_spec) :Toolchain = str Str.string_match space_before_newline !chan_input one_greater_than_comment_end in if n < physical_loc.loc_start.pos_cnum && comment_is_last_thing_on_line then ( original_comment_contents, + is_line_comment, {physical_loc with loc_start = {physical_loc.loc_start with pos_cnum = n}} ) else - (original_comment_contents, physical_loc) - | exception Not_found -> (original_comment_contents, physical_loc) + (original_comment_contents, is_line_comment, physical_loc) + | exception Not_found -> (original_comment_contents, is_line_comment, physical_loc) in - (com, attachment_location, physical_loc) + (com, is_line_comment, attachment_location, physical_loc) ) unmodified_comments in @@ -272,6 +273,8 @@ end module OCaml_syntax = struct module Lexer_impl = Lexer module Parser_impl = Parser + let comments () = + List.map (fun (str, loc) -> (str, false, loc)) (Lexer_impl.comments()) let implementation = Parser.implementation Lexer.token let core_type = Parser.parse_core_type Lexer.token @@ -349,6 +352,8 @@ module JS_syntax = struct module I = Reason_parser.MenhirInterpreter module Lexer_impl = Reason_lexer module Parser_impl = Reason_parser + let comments () = + Lexer_impl.comments() let initial_checkpoint constructor lexbuf = From b235362317b57d2faac702a2095533df18e717ed Mon Sep 17 00:00:00 2001 From: David Date: Sun, 24 Apr 2016 15:14:31 -0700 Subject: [PATCH 14/14] cleanup !single_line_comment, fix unmatched nested comment edge case --- src/reason_lexer.mll | 76 ++++++++++++++++++----------------------- src/reason_toolchain.ml | 53 ++++++++++++++-------------- 2 files changed, 61 insertions(+), 68 deletions(-) diff --git a/src/reason_lexer.mll b/src/reason_lexer.mll index 31fd11845..1ef332ce7 100644 --- a/src/reason_lexer.mll +++ b/src/reason_lexer.mll @@ -167,8 +167,7 @@ let get_stored_string () = (* To store the position of the beginning of a string and comment *) let string_start_loc = ref Location.none;; let comment_start_loc = ref [];; -let line_comment_start_loc = ref [];; -let single_line_comment = ref false;; +let line_comment_start_loc = ref None;; let in_comment () = !comment_start_loc <> [];; let is_in_string = ref false let in_string () = !is_in_string @@ -425,8 +424,7 @@ rule token = parse } | "//" { let start_loc = Location.curr lexbuf in - single_line_comment := true; - line_comment_start_loc := [start_loc]; + line_comment_start_loc := Some start_loc; reset_string_buffer (); let end_loc = comment lexbuf in let s = get_stored_string () in @@ -570,20 +568,21 @@ and comment = parse } | "*/" { - match (!comment_start_loc, !single_line_comment) with - | ([], false) -> + match (!comment_start_loc, !line_comment_start_loc) with + | ([], None) -> assert false - | ([], true) -> - let loc = Location.curr lexbuf in - let start = List.hd (List.rev !line_comment_start_loc) in - raise (Error (Unmatched_nested_comment loc, start)) - | ([_], true) -> - comment_start_loc := []; + | ([_], None) -> + comment_start_loc := []; Location.curr lexbuf + | (_ :: l, None) -> + comment_start_loc := l; store_lexeme lexbuf; comment lexbuf; - | ([_], false) -> - comment_start_loc := []; Location.curr lexbuf - | (_ :: l, _) -> + (* line comment *) + | ([], Some start_loc) -> + let loc = Location.curr lexbuf in + raise (Error (Unmatched_nested_comment loc, start_loc)) + (* a multiline comment nested within a line comment *) + | (_ :: l, Some _) -> comment_start_loc := l; store_lexeme lexbuf; comment lexbuf; @@ -645,48 +644,39 @@ and comment = parse | "'\\" 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] "'" { store_lexeme lexbuf; comment lexbuf } | eof - { match !comment_start_loc with - | [] -> - (* if the file ends with a single line comment then *) - if !single_line_comment then ( - single_line_comment := false; - match (!comment_start_loc, !line_comment_start_loc) with - | ([], []) -> - assert false - | ([], _) -> - line_comment_start_loc := []; Location.curr lexbuf - | (_, _) -> - let start = List.hd (List.rev !comment_start_loc) in - comment_start_loc := []; - raise (Error (Unmatched_nested_comment start, Location.curr lexbuf)) - ) else assert false - | loc :: _ -> + { match (!comment_start_loc, !line_comment_start_loc) with + | ([], None) -> assert false + | (loc :: _, None) -> let start = List.hd (List.rev !comment_start_loc) in comment_start_loc := []; raise (Error (Unterminated_comment start, loc)) + (* line comment ended with no nested multilines *) + | ([], Some _) -> + line_comment_start_loc := None; Location.curr lexbuf + (* line comment ends with an unfinished multiline *) + | (_, Some _) -> + let start = List.hd (List.rev !comment_start_loc) in + comment_start_loc := []; + raise (Error (Unmatched_nested_comment start, Location.curr lexbuf)) } | newline { - if not !single_line_comment then ( - update_loc lexbuf None 1 false 0; - store_lexeme lexbuf; - comment lexbuf - ) - else ( update_loc lexbuf None 1 false 0; (* check if there are any unmatched nested comments *) - single_line_comment := false; match (!comment_start_loc, !line_comment_start_loc) with - | ([], []) -> + | ([], None) -> assert false - | ([], _) -> - line_comment_start_loc := []; Location.curr lexbuf - | (_, _) -> + | (_, None) -> + update_loc lexbuf None 1 false 0; + store_lexeme lexbuf; + comment lexbuf + | ([], Some _) -> + line_comment_start_loc := None; Location.curr lexbuf + | (_, Some _) -> let start = List.hd (List.rev !comment_start_loc) in comment_start_loc := []; raise (Error (Unmatched_nested_comment start, Location.curr lexbuf)) - ) } | _ { store_lexeme lexbuf; comment lexbuf } diff --git a/src/reason_toolchain.ml b/src/reason_toolchain.ml index 24ad83007..e68d8b154 100644 --- a/src/reason_toolchain.ml +++ b/src/reason_toolchain.ml @@ -188,31 +188,34 @@ module Create_parse_entrypoint (Toolchain_impl: Toolchain_spec) :Toolchain = str | _ -> let modified_and_attached_comments = List.map (fun (str, is_line_comment, physical_loc) -> - (* When searching for "^" regexp, returns location of newline + 1 *) - let first_char_of_line = Str.search_backward new_line !chan_input physical_loc.loc_start.pos_cnum in - let end_pos_plus_one = physical_loc.loc_end.pos_cnum in - let comment_length = (end_pos_plus_one - physical_loc.loc_start.pos_cnum - 4) in - (* Also, the string contents originally reported are incorrect! *) - let original_comment_contents = String.sub !chan_input (physical_loc.loc_start.pos_cnum + 2) comment_length in - let (com, is_line_comment, attachment_location) = - match Str.search_forward line_content !chan_input first_char_of_line - with - | n -> - (* Recall that all end positions are actually the position of end + 1. *) - let one_greater_than_comment_end = end_pos_plus_one in - (* Str.string_match lets you specify a position one greater than last position *) - let comment_is_last_thing_on_line = - Str.string_match space_before_newline !chan_input one_greater_than_comment_end in - if n < physical_loc.loc_start.pos_cnum && comment_is_last_thing_on_line then ( - original_comment_contents, - is_line_comment, - {physical_loc with loc_start = {physical_loc.loc_start with pos_cnum = n}} - ) - else - (original_comment_contents, is_line_comment, physical_loc) - | exception Not_found -> (original_comment_contents, is_line_comment, physical_loc) - in - (com, is_line_comment, attachment_location, physical_loc) + if not is_line_comment then + (* When searching for "^" regexp, returns location of newline + 1 *) + let first_char_of_line = Str.search_backward new_line !chan_input physical_loc.loc_start.pos_cnum in + let end_pos_plus_one = physical_loc.loc_end.pos_cnum in + let comment_length = (end_pos_plus_one - physical_loc.loc_start.pos_cnum - 4) in + (* Also, the string contents originally reported are incorrect! *) + let original_comment_contents = String.sub !chan_input (physical_loc.loc_start.pos_cnum + 2) comment_length in + let (com, is_line_comment, attachment_location) = + match Str.search_forward line_content !chan_input first_char_of_line + with + | n -> + (* Recall that all end positions are actually the position of end + 1. *) + let one_greater_than_comment_end = end_pos_plus_one in + (* Str.string_match lets you specify a position one greater than last position *) + let comment_is_last_thing_on_line = + Str.string_match space_before_newline !chan_input one_greater_than_comment_end in + if n < physical_loc.loc_start.pos_cnum && comment_is_last_thing_on_line then ( + original_comment_contents, + is_line_comment, + {physical_loc with loc_start = {physical_loc.loc_start with pos_cnum = n}} + ) + else + (original_comment_contents, is_line_comment, physical_loc) + | exception Not_found -> (original_comment_contents, is_line_comment, physical_loc) + in + (com, is_line_comment, attachment_location, physical_loc) + else + (str, is_line_comment, physical_loc, physical_loc) ) unmodified_comments in