diff --git a/src/DblParser/Error.ml b/src/DblParser/Error.ml index 39c47590..e3eea80b 100644 --- a/src/DblParser/Error.ml +++ b/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") diff --git a/src/DblParser/Error.mli b/src/DblParser/Error.mli index fa129dd7..7964d6bd 100644 --- a/src/DblParser/Error.mli +++ b/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 diff --git a/src/DblParser/Lexer.mll b/src/DblParser/Lexer.mll index 4cbf41c7..6a5bffb0 100644 --- a/src/DblParser/Lexer.mll +++ b/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 + } diff --git a/test/err/lexer_0003_lexerDirective.fram b/test/err/lexer_0003_lexerDirective.fram new file mode 100644 index 00000000..31c27eb3 --- /dev/null +++ b/test/err/lexer_0003_lexerDirective.fram @@ -0,0 +1,3 @@ +#@ 123 foo +in +# @stderr:foo:123