Line directives for the lexer

src/DblParser/Error.ml

@@ -50,6 +50,14 @@ let invalid_escape_code pos =
 let eof_in_string pos =
   (Some pos, "Unexpected end of file inside a string literal")
 
+let invalid_lexer_directive ?msg pos =
+  (Some pos,
+    Printf.sprintf
+      "Invalid lexer directive%s"
+        (match msg with
+        | None -> ""
+        | Some msg -> ": " ^ msg))
+
 let desugar_error pos =
   (Some pos, "Syntax error. This construction cannot be used in this context")
 

src/DblParser/Error.mli

@@ -30,6 +30,8 @@ val number_out_of_bounds : Position.t -> string -> t
 val invalid_escape_code : Position.t -> t
 val eof_in_string       : Position.t -> t
 
+val invalid_lexer_directive : ?msg:string -> Position.t -> t
+
 val desugar_error : Position.t -> t
 val reserved_binop_error : Position.t -> string -> t
 val disallowed_op_error : Position.t -> string -> t

src/DblParser/Lexer.mll

@@ -155,7 +155,7 @@ rule token = parse
     whitespace+ { token lexbuf }
   | '\n' { Lexing.new_line lexbuf; token lexbuf }
   | "{#" (comment_name as name) { block_comment name lexbuf }
-  | "#" { skip_line lexbuf; token lexbuf }
+  | "#"  { line_comment lexbuf.Lexing.lex_start_p lexbuf; token lexbuf }
   | '('  { YaccParser.BR_OPN     }
   | ')'  { YaccParser.BR_CLS     }
   | '['  { YaccParser.SBR_OPN    }
@@ -221,7 +221,28 @@ and block_comment name = parse
     }
   | _ { block_comment name lexbuf }
 
-and skip_line = parse
-    '\n' { Lexing.new_line lexbuf }
-  | eof  { () }
-  | _    { skip_line lexbuf }
+and line_comment start_p = parse
+    "@ " (digit+ as lnum) " " ([^'\n']+ as fname) "\n" {
+      Lexing.new_line lexbuf;
+      match int_of_string_opt lnum with
+      | Some lnum ->
+        lexbuf.Lexing.lex_curr_p <-
+          { lexbuf.Lexing.lex_curr_p with
+            pos_fname = fname;
+            pos_lnum  = lnum
+          }
+      | None ->
+        let pos = Position.of_pp start_p lexbuf.Lexing.lex_curr_p in
+        Error.warn (
+          Error.invalid_lexer_directive
+            ~msg:"line number out of range"
+            pos)
+    }
+  | "@" [^'\n']* ("\n"? as nl) {
+      let pos = Position.of_pp start_p lexbuf.Lexing.lex_curr_p in
+      Error.warn (Error.invalid_lexer_directive pos);
+      if nl <> "" then Lexing.new_line lexbuf
+    }
+  | [^'\n']* ("\n"? as nl) {
+      if nl <> "" then Lexing.new_line lexbuf
+    }

test/err/lexer_0003_lexerDirective.fram

@@ -0,0 +1,3 @@
+#@ 123 foo
+in
+# @stderr:foo:123