Skip to content

Commit

Permalink
Remove state from Lexer
Browse files Browse the repository at this point in the history 
Instead of having a global reference containing lexed comments,
pass a reference to the lexer action
  • Loading branch information
@Alasdair
Alasdair committed Dec 21, 2023
1 parent ae902bf commit 8fec24d
Show file tree
Hide file tree
Showing 2 changed files with 31 additions and 36 deletions.
22 changes: 11 additions & 11 deletions src/lib/initial_check.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1443,27 +1443,27 @@ let initial_ctx =

let exp_of_string str =
try
let exp = Parser.exp_eof Lexer.token (Lexing.from_string str) in
let exp = Parser.exp_eof (Lexer.token (ref [])) (Lexing.from_string str) in
to_ast_exp initial_ctx exp
with Parser.Error -> Reporting.unreachable Parse_ast.Unknown __POS__ ("Failed to parse " ^ str)

let typschm_of_string str =
try
let typschm = Parser.typschm_eof Lexer.token (Lexing.from_string str) in
let typschm = Parser.typschm_eof (Lexer.token (ref [])) (Lexing.from_string str) in
let typschm, _ = to_ast_typschm initial_ctx typschm in
typschm
with Parser.Error -> Reporting.unreachable Parse_ast.Unknown __POS__ ("Failed to parse " ^ str)

let typ_of_string str =
try
let typ = Parser.typ_eof Lexer.token (Lexing.from_string str) in
let typ = Parser.typ_eof (Lexer.token (ref [])) (Lexing.from_string str) in
let typ = to_ast_typ initial_ctx typ in
typ
with Parser.Error -> Reporting.unreachable Parse_ast.Unknown __POS__ ("Failed to parse " ^ str)

let constraint_of_string str =
try
let atyp = Parser.typ_eof Lexer.token (Lexing.from_string str) in
let atyp = Parser.typ_eof (Lexer.token (ref [])) (Lexing.from_string str) in
to_ast_constraint initial_ctx atyp
with Parser.Error -> Reporting.unreachable Parse_ast.Unknown __POS__ ("Failed to parse " ^ str)

Expand Down Expand Up @@ -1672,7 +1672,7 @@ let ast_of_def_string_with ocaml_pos f str =
let internal = !opt_magic_hash in
opt_magic_hash := true;
lexbuf.lex_curr_p <- { pos_fname = ""; pos_lnum = 1; pos_bol = 0; pos_cnum = 0 };
let def = Parser.def_eof Lexer.token lexbuf in
let def = Parser.def_eof (Lexer.token (ref [])) lexbuf in
let ast = Reporting.forbid_errors ocaml_pos (fun ast -> process_ast ~generate:false ast) (P.Defs [("", f [def])]) in
opt_magic_hash := internal;
ast
Expand All @@ -1692,10 +1692,10 @@ let parse_file ?loc:(l = Parse_ast.Unknown) (f : string) : Lexer.comment list *
let lexbuf, in_chan = get_lexbuf f in
begin
try
Lexer.comments := [];
let defs = Parser.file Lexer.token lexbuf in
let comments = ref [] in
let defs = Parser.file (Lexer.token comments) lexbuf in
close_in in_chan;
(!Lexer.comments, defs)
(!comments, defs)
with Parser.Error ->
let pos = Lexing.lexeme_start_p lexbuf in
let tok = Lexing.lexeme lexbuf in
Expand All @@ -1711,9 +1711,9 @@ let get_lexbuf_from_string f s =
let parse_file_from_string ~filename:f ~contents:s =
let lexbuf = get_lexbuf_from_string f s in
try
Lexer.comments := [];
let defs = Parser.file Lexer.token lexbuf in
(!Lexer.comments, defs)
let comments = ref [] in
let defs = Parser.file (Lexer.token comments) lexbuf in
(!comments, defs)
with Parser.Error ->
let pos = Lexing.lexeme_start_p lexbuf in
let tok = Lexing.lexeme lexbuf in
Expand Down
45 changes: 20 additions & 25 deletions src/lib/lexer.mll
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,9 +71,6 @@ module Big_int = Nat_big_num
open Parse_ast
module M = Map.Make(String)

(* Available as Scanf.unescaped since OCaml 4.0 but 3.12 is still common *)
let unescaped s = Scanf.sscanf ("\"" ^ s ^ "\"") "%S%!" (fun x -> x)

let kw_table =
List.fold_left
(fun r (x,y) -> M.add x y r)
Expand Down Expand Up @@ -158,8 +155,6 @@ type comment_type = Comment_block | Comment_line
type comment =
| Comment of comment_type * Lexing.position * Lexing.position * string

let comments = ref []

}

let wsc = [' ''\t']
Expand All @@ -183,13 +178,13 @@ let operator = operator1 | operator2 | operatorn
let escape_sequence = ('\\' ['\\''\"''\'''n''t''b''r']) | ('\\' digit digit digit) | ('\\' 'x' hexdigit hexdigit)
let lchar = [^'\n']

rule token = parse
rule token comments = parse
| ws
{ token lexbuf }
{ token comments lexbuf }
| "\n"
| "\r\n"
{ Lexing.new_line lexbuf;
token lexbuf }
token comments lexbuf }
| "@" { At }
| "2" ws "^" { TwoCaret }
| "^" { Caret }
Expand Down Expand Up @@ -219,8 +214,8 @@ rule token = parse
| "<->" { Bidir }
| "=>" { EqGt "=>" }
| "/*!" { Doc (doc_comment (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) 0 false lexbuf) }
| "//" { line_comment (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) lexbuf; token lexbuf }
| "/*" { comment (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) 0 lexbuf; token lexbuf }
| "//" { line_comment comments (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) lexbuf; token comments lexbuf }
| "/*" { block_comment comments (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) 0 lexbuf; token comments lexbuf }
| "*/" { raise (Reporting.err_lex (Lexing.lexeme_start_p lexbuf) "Unbalanced comment") }
| "$[" (ident+ as i)
{ let startpos = Lexing.lexeme_start_p lexbuf in
Expand All @@ -229,7 +224,7 @@ rule token = parse
Attribute(i, String.trim attr) }
| "$" (ident+ as i)
{ let startpos = Lexing.lexeme_start_p lexbuf in
let arg = pragma (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) false lexbuf in
let arg = pragma comments (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) false lexbuf in
lexbuf.lex_start_p <- startpos;
Pragma (i, arg) }
| "infix" ws (digit as p) ws (operator as op)
Expand Down Expand Up @@ -274,23 +269,23 @@ line comment or a block comment, but the pragma cannot continue after
a block comment. This ensures that `$pragma fo/* comment */o` is not
allowed (it would otherwise have value `foo`) *)

and pragma pos b after_block = parse
and pragma comments pos b after_block = parse
| "\n" { Lexing.new_line lexbuf; Buffer.contents b }
| (wsc as c) { Buffer.add_string b (String.make 1 c); pragma pos b after_block lexbuf }
| "//" { line_comment (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) lexbuf; unescaped (Buffer.contents b) }
| "/*" { comment (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) 0 lexbuf; pragma pos b true lexbuf }
| (wsc as c) { Buffer.add_string b (String.make 1 c); pragma comments pos b after_block lexbuf }
| "//" { line_comment comments (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) lexbuf; Scanf.unescaped (Buffer.contents b) }
| "/*" { block_comment comments (Lexing.lexeme_start_p lexbuf) (Buffer.create 10) 0 lexbuf; pragma comments pos b true lexbuf }
| _ as c { if after_block then
raise (Reporting.err_lex (Lexing.lexeme_start_p lexbuf) "Directive continued after block comment")
else (
Buffer.add_string b (String.make 1 c);
pragma pos b after_block lexbuf
pragma comments pos b after_block lexbuf
) }
| eof { raise (Reporting.err_lex pos "File ended before newline in directive") }

and line_comment pos b = parse
and line_comment comments pos b = parse
| "\n" { Lexing.new_line lexbuf;
comments := Comment (Comment_line, pos, Lexing.lexeme_end_p lexbuf, Buffer.contents b) :: !comments }
| _ as c { Buffer.add_string b (String.make 1 c); line_comment pos b lexbuf }
| _ as c { Buffer.add_string b (String.make 1 c); line_comment comments pos b lexbuf }
| eof { raise (Reporting.err_lex pos "File ended before newline in comment") }

and doc_comment pos b depth lstart = parse
Expand All @@ -311,17 +306,17 @@ and doc_comment pos b depth lstart = parse
| _ as c { Buffer.add_string b (String.make 1 c); doc_comment pos b depth false lexbuf }
| eof { raise (Reporting.err_lex pos "Unbalanced documentation comment") }

and comment pos b depth = parse
| "/*" { comment pos b (depth + 1) lexbuf }
and block_comment comments pos b depth = parse
| "/*" { block_comment comments pos b (depth + 1) lexbuf }
| "*/" { if depth = 0 then (
comments := Comment (Comment_block, pos, Lexing.lexeme_end_p lexbuf, Buffer.contents b) :: !comments
) else (
comment pos b (depth-1) lexbuf
block_comment comments pos b (depth-1) lexbuf
) }
| "\n" { Buffer.add_string b "\n";
| "\n" { Buffer.add_string b "\n";
Lexing.new_line lexbuf;
comment pos b depth lexbuf }
| _ as c { Buffer.add_string b (String.make 1 c); comment pos b depth lexbuf }
block_comment comments pos b depth lexbuf }
| _ as c { Buffer.add_string b (String.make 1 c); block_comment comments pos b depth lexbuf }
| eof { raise (Reporting.err_lex pos "Unbalanced comment") }

and string pos b = parse
Expand All @@ -332,5 +327,5 @@ and string pos b = parse
| escape_sequence as i { Buffer.add_string b i; string pos b lexbuf }
| '\\' '\n' ws { Lexing.new_line lexbuf; string pos b lexbuf }
| '\\' { raise (Reporting.err_lex (Lexing.lexeme_start_p lexbuf) "String literal contains illegal backslash escape sequence") }
| '"' { unescaped (Buffer.contents b) }
| '"' { Scanf.unescaped (Buffer.contents b) }
| eof { raise (Reporting.err_lex pos "String literal not terminated") }

0 comments on commit 8fec24d

Please sign in to comment.