diff --git a/README.md b/README.md index d23c29a..dfaf41d 100644 --- a/README.md +++ b/README.md @@ -143,3 +143,6 @@ for UTF-8 characters within strings. `-allow-sig-withtype [true|false]` (default `false`) controls whether or not SuccessorML `withtype` in signatures syntax is allowed. + +`-allow-line-comments [true|false]` (default `false`) controls whether or not +SuccessorML line comments syntax is allowed. diff --git a/src/Main.smlnj.sml b/src/Main.smlnj.sml index 5bd99f8..220560a 100644 --- a/src/Main.smlnj.sml +++ b/src/Main.smlnj.sml @@ -66,6 +66,7 @@ struct , recordPun = false , orPat = false , extendedText = false + , lineComment = false } diff --git a/src/base/AstAllows.sml b/src/base/AstAllows.sml index 1f5b297..ac66859 100644 --- a/src/base/AstAllows.sml +++ b/src/base/AstAllows.sml @@ -14,6 +14,7 @@ sig , orPat: bool , extendedText: bool , sigWithtype: bool + , lineComment: bool } -> t @@ -23,6 +24,7 @@ sig val orPat: t -> bool val extendedText: t -> bool val sigWithtype: t -> bool + val lineComment: t -> bool end = struct datatype t = @@ -33,6 +35,7 @@ struct , orPat: bool , extendedText: bool , sigWithtype: bool + , lineComment: bool } fun make x = T x @@ -42,4 +45,5 @@ struct fun orPat (T x) = #orPat x fun extendedText (T x) = #extendedText x fun sigWithtype (T x) = #sigWithtype x + fun lineComment (T x) = #lineComment x end diff --git a/src/lex-mlb/MLBLexer.sml b/src/lex-mlb/MLBLexer.sml index ca43aa9..c538e75 100644 --- a/src/lex-mlb/MLBLexer.sml +++ b/src/lex-mlb/MLBLexer.sml @@ -34,6 +34,7 @@ struct , orPat = false , extendedText = false , sigWithtype = false + , lineComment = false } in case Lexer.next smlLexerAllows src of diff --git a/src/lex/Lexer.sml b/src/lex/Lexer.sml index f5ac51f..b7111e1 100644 --- a/src/lex/Lexer.sml +++ b/src/lex/Lexer.sml @@ -632,11 +632,20 @@ struct if nesting = 0 then success (mk Token.Comment (commentStart, s)) else if is #"(" at s andalso is #"*" at s + 1 then - loop_inComment (s + 2) - {commentStart = commentStart, nesting = nesting + 1} + if (AstAllows.lineComment allows) andalso is #")" at s + 2 then + (* Nested line comment *) + loop_inLineComment (s + 3) + {commentStart = commentStart, nesting = nesting + 1} + else + loop_inComment (s + 2) + {commentStart = commentStart, nesting = nesting + 1} else if is #"*" at s andalso is #")" at s + 1 then loop_inComment (s + 2) {commentStart = commentStart, nesting = nesting - 1} + else if (AstAllows.lineComment allows) andalso is #")" at commentStart + 2 then + (* Top-level line comment *) + loop_inLineComment (s + 1) + {commentStart = commentStart, nesting = nesting} else if isEndOfFileAt s then error { pos = slice (commentStart, commentStart + 2) @@ -647,6 +656,13 @@ struct loop_inComment (s + 1) {commentStart = commentStart, nesting = nesting} + and loop_inLineComment s {commentStart, nesting} = + if is #"\n" at s then + loop_inComment (s) + {commentStart = commentStart, nesting = nesting - 1} + else + loop_inLineComment (s + 1) + {commentStart = commentStart, nesting = nesting} in loop_topLevel startOffset diff --git a/src/parse-mlb/ParseAnnotations.sml b/src/parse-mlb/ParseAnnotations.sml index 01f4074..242068b 100644 --- a/src/parse-mlb/ParseAnnotations.sml +++ b/src/parse-mlb/ParseAnnotations.sml @@ -22,6 +22,7 @@ struct , orPat = b , extendedText = b , sigWithtype = b + , lineComment = b } @@ -33,6 +34,7 @@ struct , orPat = AstAllows.orPat a , extendedText = AstAllows.extendedText a , sigWithtype = AstAllows.sigWithtype a + , lineComment = AstAllows.lineComment a } @@ -44,6 +46,7 @@ struct , orPat = AstAllows.orPat a , extendedText = AstAllows.extendedText a , sigWithtype = AstAllows.sigWithtype a + , lineComment = AstAllows.lineComment a } @@ -55,6 +58,7 @@ struct , orPat = b , extendedText = AstAllows.extendedText a , sigWithtype = AstAllows.sigWithtype a + , lineComment = AstAllows.lineComment a } @@ -66,6 +70,7 @@ struct , orPat = AstAllows.orPat a , extendedText = b , sigWithtype = AstAllows.sigWithtype a + , lineComment = AstAllows.lineComment a } fun allowSigWithtype a b = @@ -76,6 +81,18 @@ struct , orPat = AstAllows.orPat a , extendedText = AstAllows.extendedText a , sigWithtype = b + , lineComment = AstAllows.lineComment a + } + + fun allowLineComments a b = + AstAllows.make + { optBar = AstAllows.optBar a + , topExp = AstAllows.topExp a + , recordPun = AstAllows.recordPun a + , orPat = AstAllows.orPat a + , extendedText = AstAllows.extendedText a + , sigWithtype = AstAllows.sigWithtype a + , lineComment = b } @@ -111,6 +128,8 @@ struct allowExtendedTextConsts allows false | ["allowSigWithtype", "true"] => allowSigWithtype allows true | ["allowSigWithtype", "false"] => allowSigWithtype allows false + | ["allowLineComments", "true"] => allowLineComments allows true + | ["allowLineComments", "false"] => allowLineComments allows false | _ => allows diff --git a/src/smlfmt.sml b/src/smlfmt.sml index 91eac66..bb84f12 100644 --- a/src/smlfmt.sml +++ b/src/smlfmt.sml @@ -79,6 +79,11 @@ val optionalArgDesc = \ Valid options are: true, false\n\ \ (default 'false')\n\ \\n\ + \ [-allow-line-comments B] Enable/disable SuccessorML line comments\n\ + \ syntax.\n\ + \ Valid options are: true, false\n\ + \ (default 'false')\n\ + \\n\ \ [--help] print this message\n" @@ -105,6 +110,8 @@ val allowExtendedText = CommandLineArgs.parseBool "allow-extended-text-consts" allowSuccessorML val allowSigWithtype = CommandLineArgs.parseBool "allow-sig-withtype" allowSuccessorML +val allowLineComments = + CommandLineArgs.parseBool "allow-line-comments" allowSuccessorML val doDebug = CommandLineArgs.parseFlag "debug-engine" val doForce = CommandLineArgs.parseFlag "force" @@ -126,6 +133,7 @@ val allows = AstAllows.make , orPat = allowOrPat , extendedText = allowExtendedText , sigWithtype = allowSigWithtype + , lineComment = allowLineComments } val _ = diff --git a/src/syntax-highlighting/SyntaxHighlighter.sml b/src/syntax-highlighting/SyntaxHighlighter.sml index 77fa07d..a519854 100644 --- a/src/syntax-highlighting/SyntaxHighlighter.sml +++ b/src/syntax-highlighting/SyntaxHighlighter.sml @@ -112,6 +112,7 @@ struct , orPat = true , extendedText = true , sigWithtype = true + , lineComment = true } val startOffset = Source.absoluteStartOffset src diff --git a/test/succeed/line-comments.mlb b/test/succeed/line-comments.mlb new file mode 100644 index 0000000..94e346d --- /dev/null +++ b/test/succeed/line-comments.mlb @@ -0,0 +1,5 @@ +$(SML_LIB)/basis/basis.mlb +ann "allowLineComments true" in + successor-ml/line-comments.sml + star-close-paren-but-not-comment.sml +end diff --git a/test/succeed/successor-ml/line-comments.sml b/test/succeed/successor-ml/line-comments.sml new file mode 100644 index 0000000..594d50e --- /dev/null +++ b/test/succeed/successor-ml/line-comments.sml @@ -0,0 +1,23 @@ +val x = + (*) whole line + case foobar of (*) end of line + + (* + (*) nested + *) + + (* + (*) nested with closing marker *) + *) + + (* with closing ) paren + *) + + (* after two (* nested block comments *) + (*) line comment + *) + + (* in two (* nested block comments + (*) line comment + *) *) + 3 => 2