New implementation of block commets

examples/Modules/Main.fram

@@ -21,7 +21,7 @@
     Relative imports refer to the module which is the closest to the importing
     module, working upwards through the hierarchy. In this example the module
     `/Main/B/C/D` imports the relative path `A`, and the nearest matching
-    module is `/Main/B/A`. #}
+    module is `/Main/B/A`. ##}
 
 import List
 

src/DblParser/Error.ml

@@ -31,8 +31,11 @@ let unexpected_token pos tok =
 let invalid_character pos ch =
   (Some pos, Printf.sprintf "Invalid character `%s'" (Char.escaped ch))
 
-let eof_in_comment pos =
-  (Some pos, "Unexpected end of file inside a block comment")
+let eof_in_comment pos name =
+  (Some pos,
+    Printf.sprintf
+      "Unexpected end of file inside a block comment (`%s#}' was expected)"
+      name)
 
 let invalid_number pos str =
   (Some pos, Printf.sprintf "Invalid integer literal `%s'" str)

src/DblParser/Error.mli

@@ -22,7 +22,7 @@ val module_dependency_cycle : string -> t
 val unexpected_token  : Position.t -> string -> t
 val invalid_character : Position.t -> char -> t
 
-val eof_in_comment : Position.t -> t
+val eof_in_comment : Position.t -> string -> t
 
 val invalid_number : Position.t -> string -> t
 val number_out_of_bounds : Position.t -> string -> t

src/DblParser/Lexer.mll

@@ -149,10 +149,12 @@ let op_char = [
   '~' '*' '%' ';' ',' '=' '|' ':' '.' '/'
 ]
 
+let comment_name = [^'\000'-' ' '\x7f' '{' '}']*
+
 rule token = parse
     whitespace+ { token lexbuf }
   | '\n' { Lexing.new_line lexbuf; token lexbuf }
-  | "{#" { block_comment 1 lexbuf }
+  | "{#" (comment_name as name) { block_comment name lexbuf }
   | "#" { skip_line lexbuf; token lexbuf }
   | '('  { YaccParser.BR_OPN     }
   | ')'  { YaccParser.BR_CLS     }
@@ -205,25 +207,19 @@ and string_token pos buf = parse
         (Position.of_lexing 0 lexbuf.Lexing.lex_start_p))
     }
 
-and block_comment depth = parse
-    '\n' { Lexing.new_line lexbuf; block_comment depth lexbuf }
-  | "{#" { block_comment (depth+1) lexbuf }
-  | "#}" {
-      if depth = 1 then token lexbuf
-      else block_comment (depth-1) lexbuf
+and block_comment name = parse
+    '\n' { Lexing.new_line lexbuf; block_comment name lexbuf }
+  | (comment_name as name') "#}" {
+      if String.ends_with ~suffix:name name' then token lexbuf
+      else block_comment name lexbuf
     }
-  | '"' {
-      let buf = Buffer.create 32 in
-      let _ : YaccParser.token =
-        string_token lexbuf.Lexing.lex_start_p buf lexbuf in
-      block_comment depth lexbuf
-    }
-  | "#" { skip_line lexbuf; block_comment depth lexbuf }
+  | comment_name { block_comment name lexbuf }
   | eof {
       Error.fatal (Error.eof_in_comment
-        (Position.of_lexing 0 lexbuf.Lexing.lex_start_p))
+        (Position.of_lexing 0 lexbuf.Lexing.lex_start_p)
+        name)
     }
-  | _ { block_comment depth lexbuf }
+  | _ { block_comment name lexbuf }
 
 and skip_line = parse
     '\n' { Lexing.new_line lexbuf }

test/err/lexer_0002_eofInComment.fram

@@ -0,0 +1,3 @@
+# @stderr:!!#}
+{#!!
+{# #}

test/ok/ok0117_comments.fram

@@ -0,0 +1,39 @@
+# This is a single-line comment.
+{# This is a block comment. #}
+{# Block comments
+  may span multiple lines.
+#}
+let id x = x # A single-line comment may appear at the end of a line.
+
+let n {# A block comment may span a part of a single line. #} = 42
+{#aaa
+Comments cannot be nested,
+{# but the programmer may choose the comment delimiters. #}
+aaa#}
+
+{#!a! Comment names may contain operators. !a!#}
+
+{#abc
+This comment is ended by `abc` immediately followed by `#}`,
+even if the closing sequence is preceded by other characters.
+zzabc#}
+
+let {#
+# This is not a single-line comment,
+# because comments are not nested.
+# This comment can be ended #} here = 13
+
+## This is a documentation comment.
+let foo x = x
+
+{## This is another documentation comment. ##}
+let bar = foo
+
+{###
+Documentation comments can contain some code
+```
+{## with another documentation comment (with a different name). ##}
+let some_code = 42
+```
+###}
+let baz = bar