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/Makefile b/Makefile index b3acad86d..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 @@ -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 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..024b62c73 --- /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 artifacts are found in your +host machines `hello_reason` directory. diff --git a/formatTest/unit_tests/expected_output/comments.re b/formatTest/unit_tests/expected_output/comments.re new file mode 100644 index 000000000..d231d0d41 --- /dev/null +++ b/formatTest/unit_tests/expected_output/comments.re @@ -0,0 +1,182 @@ +/* + * Multiline comment + */ +// Empty comments, or comments with whitespaces: +// +// +// +//a +/*inlinecommentwithnospaces*/ +/* + + + */ +/* + * Multiline comment with a // single line comment + */ +// Single line comment + +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 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. + */ +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; + +// 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 new file mode 100644 index 000000000..a082f184b --- /dev/null +++ b/formatTest/unit_tests/input/comments.re @@ -0,0 +1,196 @@ +/* + * Multiline comment + */ + +// Empty comments, or comments with whitespaces: +// +// +// +//a +/*inlinecommentwithnospaces*/ + +/* + + + */ + +/* + * Multiline comment with a // single line comment + */ + +// Single line comment +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 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. + */ +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; + +// 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 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" ] diff --git a/src/reason_lexer.mll b/src/reason_lexer.mll index ae916d31a..1ef332ce7 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,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 None;; let in_comment () = !comment_start_loc <> [];; let is_in_string = ref false let in_string () = !is_in_string @@ -265,6 +267,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 +422,16 @@ 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 + line_comment_start_loc := Some start_loc; + reset_string_buffer (); + let end_loc = comment lexbuf in + let s = get_stored_string () in + reset_string_buffer (); + COMMENT (s, true, { start_loc with + Location.loc_end = end_loc.Location.loc_end }) + } | "/*" { let start_loc = Location.curr lexbuf in comment_start_loc := [start_loc]; @@ -425,7 +439,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 }) } | "/*/" @@ -437,7 +451,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 @@ -546,18 +560,32 @@ 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 - | _ :: l -> comment_start_loc := l; - store_lexeme lexbuf; - comment lexbuf; + { + match (!comment_start_loc, !line_comment_start_loc) with + | ([], None) -> + assert false + | ([_], None) -> + comment_start_loc := []; Location.curr lexbuf + | (_ :: l, None) -> + comment_start_loc := l; + store_lexeme lexbuf; + comment lexbuf; + (* 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; } | "\"" { @@ -616,17 +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 - | [] -> 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 - { update_loc lexbuf None 1 false 0; - store_lexeme lexbuf; - comment lexbuf + { + update_loc lexbuf None 1 false 0; + (* check if there are any unmatched nested comments *) + + match (!comment_start_loc, !line_comment_start_loc) with + | ([], None) -> + assert false + | (_, 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 } @@ -717,8 +767,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 ec1cebaff..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 = " " @@ -1265,13 +1263,20 @@ 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, is_line_comment, commLoc, physCommLoc) = let commLines = Str.split_delim (Str.regexp "\n") ("/*" ^ str ^ "*/") in - match commLines with - | [] -> easyAtom "" - | [hd] -> + 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 -> + | (zero::one::tl, _, _) -> let lineZero = List.nth commLines 0 in let lineOne = List.nth commLines 1 in let hasMeaningfulContentOnLineZero = lineZeroHasMeaningfulContent lineZero in @@ -1290,7 +1295,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 @@ -1312,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)-> @@ -1340,7 +1345,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) (* diff --git a/src/reason_toolchain.ml b/src/reason_toolchain.ml index 0c8788fc2..e68d8b154 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,38 +180,42 @@ 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) -> - (* 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) = - 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, - {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) - in - (com, attachment_location, physical_loc) + List.map (fun (str, is_line_comment, 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 @@ -272,6 +276,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 +355,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 = 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/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 )" 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 "$@"