SuccessorML line comments

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.

src/Main.smlnj.sml

@@ -66,6 +66,7 @@ struct
     , recordPun = false
     , orPat = false
     , extendedText = false
+    , lineComment = false
     }
 
 

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

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

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

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
 
 

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 _ =

src/syntax-highlighting/SyntaxHighlighter.sml

@@ -112,6 +112,7 @@ struct
         , orPat = true
         , extendedText = true
         , sigWithtype = true
+        , lineComment = true
         }
 
       val startOffset = Source.absoluteStartOffset src

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

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