make lexer thread-safe

src-json/define.json

@@ -607,7 +607,8 @@
 	{
 		"name": "OldErrorFormat",
 		"define": "old-error-format",
-		"doc": "Use Haxe 3.x zero-based column error messages instead of new one-based format."
+		"doc": "Use Haxe 3.x zero-based column error messages instead of new one-based format.",
+		"deprecated": "OldErrorFormat has been removed in Haxe 5"
 	},
 	{
 		"name": "PhpPrefix",

src/compiler/displayProcessing.ml

@@ -103,17 +103,6 @@ let process_display_configuration ctx =
 			| WMDisable ->
 				()
 		);
-	end;
-	Lexer.old_format := Common.defined com Define.OldErrorFormat;
-	if !Lexer.old_format && !Parser.in_display then begin
-		let p = DisplayPosition.display_position#get in
-		(* convert byte position to utf8 position *)
-		try
-			let content = Std.input_file ~bin:true (Path.get_real_path p.pfile) in
-			let pos = Extlib_leftovers.UTF8.length (String.sub content 0 p.pmin) in
-			DisplayPosition.display_position#set { p with pmin = pos; pmax = pos }
-		with _ ->
-			() (* ignore *)
 	end
 
 let process_display_file com actx =

src/compiler/serverCompilationContext.ml

@@ -44,7 +44,6 @@ let reset sctx =
 	Hashtbl.clear sctx.changed_directories;
 	sctx.was_compilation <- false;
 	Parser.reset_state();
-	Lexer.cur := Lexer.make_file "";
 	Hashtbl.clear DeprecationCheck.warned_positions;
 	stats.s_files_parsed := 0;
 	stats.s_classes_built := 0;

src/core/ds/threadSafeHashtbl.ml

@@ -0,0 +1,18 @@
+type ('a,'b) t = {
+	h : ('a,'b) Hashtbl.t;
+	mutex : Mutex.t
+}
+
+let create size = {
+	h = Hashtbl.create size;
+	mutex = Mutex.create ();
+}
+
+let add h k v =
+	Mutex.protect h.mutex (fun () -> Hashtbl.add h.h k) v
+
+let replace h k v =
+	Mutex.protect h.mutex (fun () -> Hashtbl.replace h.h k) v
+
+let find h k =
+	Mutex.protect h.mutex (fun () -> Hashtbl.find h.h) k

src/core/warning.ml

@@ -11,7 +11,7 @@ type warning_option = {
 	wo_mode : warning_mode;
 }
 
-let parse_options s ps lexbuf =
+let parse_options lctx s ps lexbuf =
 	let fail msg p =
 		raise_typing_error msg {p with pmin = ps.pmin + p.pmin; pmax = ps.pmin + p.pmax}
 	in
@@ -22,7 +22,7 @@ let parse_options s ps lexbuf =
 			fail (Printf.sprintf "Unknown warning: %s" s) p
 		end
 	in
-	let parse_warning () = match Lexer.token lexbuf with
+	let parse_warning () = match Lexer.token lctx lexbuf with
 		| Const (Ident s),p ->
 			parse_string s p
 		| (_,p) ->
@@ -31,7 +31,7 @@ let parse_options s ps lexbuf =
 	let add acc mode warning =
 		{ wo_warning = warning; wo_mode = mode } :: acc
 	in
-	let rec next acc = match Lexer.token lexbuf with
+	let rec next acc = match Lexer.token lctx lexbuf with
 		| Binop OpAdd,_ ->
 			next (add acc WMEnable (parse_warning()))
 		| Binop OpSub,_ ->
@@ -44,13 +44,9 @@ let parse_options s ps lexbuf =
 	next []
 
 let parse_options s ps =
-	let restore = Lexer.reinit ps.pfile in
-	Std.finally (fun () ->
-		restore()
-	) (fun () ->
-		let lexbuf = Sedlexing.Utf8.from_string s in
-		parse_options s ps lexbuf
-	) ()
+	let lctx = Lexer.create_temp_ctx ps.pfile in
+	let lexbuf = Sedlexing.Utf8.from_string s in
+	parse_options lctx s ps lexbuf
 
 let from_meta ml =
 	let parse_arg e = match fst e with

src/syntax/lexer.ml

@@ -34,7 +34,23 @@ type error_msg =
 
 exception Error of error_msg * pos
 
+type lexer_file = {
+	lfile : string;
+	mutable lline : int;
+	mutable lmaxline : int;
+	mutable llines : (int * int) list;
+	mutable lalines : (int * int) array;
+	mutable llast : int;
+	mutable llastindex : int;
+}
+
+type lexer_ctx = {
+	file : lexer_file;
+	buf : Buffer.t;
+}
+
 type xml_lexing_context = {
+	lexer_ctx : lexer_ctx;
 	open_tag : string;
 	close_tag : string;
 	lexbuf : Sedlexing.lexbuf;
@@ -52,16 +68,6 @@ let error_msg = function
 	| Invalid_option -> "Invalid regular expression option"
 	| Unterminated_markup -> "Unterminated markup literal"
 
-type lexer_file = {
-	lfile : string;
-	mutable lline : int;
-	mutable lmaxline : int;
-	mutable llines : (int * int) list;
-	mutable lalines : (int * int) array;
-	mutable llast : int;
-	mutable llastindex : int;
-}
-
 let make_file file =
 	{
 		lfile = file;
@@ -73,6 +79,26 @@ let make_file file =
 		llastindex = 0;
 	}
 
+let create_context file = {
+	file = file;
+	buf = Buffer.create 100;
+}
+
+let create_temp_ctx file =
+	create_context (make_file file)
+
+let all_files = ThreadSafeHashtbl.create 0
+
+let create_file_ctx file =
+	let f = make_file file in
+	ThreadSafeHashtbl.replace all_files file f;
+	create_context f
+
+let newline ctx lexbuf =
+	let cur = ctx.file in
+	cur.lline <- cur.lline + 1;
+	cur.llines <- (lexeme_end lexbuf,cur.lline) :: cur.llines
+
 let copy_file source dest =
 	dest.lline <- source.lline;
 	dest.lmaxline <- source.lmaxline;
@@ -86,14 +112,8 @@ let print_file file =
 	let slalines = String.concat ";" (Array.to_list (Array.map (fun (i1,i2) -> Printf.sprintf "(%i,%i)" i1 i2) file.lalines)) in
 	Printf.sprintf "lfile: %s\nlline: %i\nlmaxline: %i\nllines: [%s]\nlalines: [%s]\nllast: %i\nllastindex: %i" file.lfile file.lline file.lmaxline sllines slalines file.llast file.llastindex
 
-let cur = ref (make_file "")
-
-let all_files = Hashtbl.create 0
-
-let buf = Buffer.create 100
-
-let error e pos =
-	raise (Error (e,{ pmin = pos; pmax = pos; pfile = !cur.lfile }))
+let error ctx e pos =
+	raise (Error (e,{ pmin = pos; pmax = pos; pfile = ctx.file.lfile }))
 
 let keywords =
 	let h = Hashtbl.create 3 in
@@ -157,31 +177,6 @@ let split_float_suffix s =
 	let (literal,suffix) = split_suffix s false in
 	Const (Float (literal,suffix))
 
-let init file =
-	let f = make_file file in
-	cur := f;
-	Hashtbl.replace all_files file f
-
-let save() =
-	!cur
-
-let reinit file =
-	let old_file = try Some (Hashtbl.find all_files file) with Not_found -> None in
-	let old_cur = !cur in
-	init file;
-	(fun () ->
-		cur := old_cur;
-		Option.may (Hashtbl.replace all_files file) old_file;
-	)
-
-let restore c =
-	cur := c
-
-let newline lexbuf =
-	let cur = !cur in
-	cur.lline <- cur.lline + 1;
-	cur.llines <- (lexeme_end lexbuf,cur.lline) :: cur.llines
-
 let find_line p f =
 	(* rebuild cache if we have a new line *)
 	if f.lmaxline <> f.lline then begin
@@ -268,11 +263,11 @@ let resolve_file_pos file =
 
 let find_file file =
 	try
-		Hashtbl.find all_files file
+		ThreadSafeHashtbl.find all_files file
 	with Not_found ->
 		try
 			let f = resolve_file_pos file in
-			Hashtbl.add all_files file f;
+			ThreadSafeHashtbl.add all_files file f;
 			f
 		with Sys_error _ ->
 			make_file file
@@ -284,24 +279,18 @@ let get_error_line p =
 	let l, _ = find_pos p in
 	l
 
-
 let get_error_line_if_exists p =
 	try
-		let file = Hashtbl.find all_files p.pfile in
+		let file = ThreadSafeHashtbl.find all_files p.pfile in
 		fst (find_line p.pmin file)
 	with Not_found ->
 		0
 
-let old_format = ref false
-
 let get_pos_coords p =
 	let file = find_file p.pfile in
 	let l1, p1 = find_line p.pmin file in
 	let l2, p2 = find_line p.pmax file in
-	if !old_format then
-		l1, p1, l2, p2
-	else
-		l1, p1+1, l2, p2+1
+	l1, p1+1, l2, p2+1
 
 let get_error_pos printer p =
 	if p.pmin = -1 then
@@ -314,28 +303,29 @@ let get_error_pos printer p =
 		end else
 			Printf.sprintf "%s lines %d-%d" (printer p.pfile l1) l1 l2
 ;;
+
 Globals.get_error_pos_ref := get_error_pos
 
-let reset() = Buffer.reset buf
-let contents() = Buffer.contents buf
-let store lexbuf = Buffer.add_string buf (lexeme lexbuf)
-let add c = Buffer.add_string buf c
+let reset ctx = Buffer.reset ctx.buf
+let contents ctx = Buffer.contents ctx.buf
+let store ctx lexbuf = Buffer.add_string ctx.buf (lexeme lexbuf)
+let add ctx c = Buffer.add_string ctx.buf c
 
-let mk_tok t pmin pmax =
-	t , { pfile = !cur.lfile; pmin = pmin; pmax = pmax }
+let mk_tok ctx t pmin pmax =
+	t , { pfile = ctx.file.lfile; pmin = pmin; pmax = pmax }
 
-let mk lexbuf t =
-	mk_tok t (lexeme_start lexbuf) (lexeme_end lexbuf)
+let mk ctx lexbuf t =
+	mk_tok ctx t (lexeme_start lexbuf) (lexeme_end lexbuf)
 
-let mk_ident lexbuf =
+let mk_ident ctx lexbuf =
 	let s = lexeme lexbuf in
-	mk lexbuf (Const (Ident s))
+	mk ctx lexbuf (Const (Ident s))
 
-let mk_keyword lexbuf kwd =
-	mk lexbuf (Kwd kwd)
+let mk_keyword ctx lexbuf kwd =
+	mk ctx lexbuf (Kwd kwd)
 
-let invalid_char lexbuf =
-	error (Invalid_character (Uchar.to_int (lexeme_char lexbuf 0))) (lexeme_start lexbuf)
+let invalid_char ctx lexbuf =
+	error ctx (Invalid_character (Uchar.to_int (lexeme_char lexbuf 0))) (lexeme_start lexbuf)
 
 let ident = [%sedlex.regexp?
 	(
@@ -408,7 +398,12 @@ let rec skip_header lexbuf =
 	| "" | eof -> ()
 	| _ -> die "" __LOC__
 
-let rec token lexbuf =
+let rec token ctx lexbuf =
+	let mk = mk ctx in
+	let token = token ctx in
+	let newline = newline ctx in
+	let mk_tok = mk_tok ctx in
+	let mk_keyword = mk_keyword ctx in
 	match%sedlex lexbuf with
 	| eof -> mk lexbuf Eof
 	| Plus (Chars " \t") -> token lexbuf
@@ -487,27 +482,27 @@ let rec token lexbuf =
 	| "@" -> mk lexbuf At
 
 	| "/*" ->
-		reset();
+		reset ctx;
 		let pmin = lexeme_start lexbuf in
-		let pmax = (try comment lexbuf with Exit -> error Unclosed_comment pmin) in
-		mk_tok (Comment (contents())) pmin pmax;
+		let pmax = (try comment ctx lexbuf with Exit -> error ctx Unclosed_comment pmin) in
+		mk_tok (Comment (contents ctx)) pmin pmax;
 	| '"' ->
-		reset();
+		reset ctx;
 		let pmin = lexeme_start lexbuf in
-		let pmax = (try string lexbuf with Exit -> error Unterminated_string pmin) in
-		let str = (try unescape (contents()) with Invalid_escape_sequence(c,i,msg) -> error (Invalid_escape (c,msg)) (pmin + i)) in
+		let pmax = (try string ctx lexbuf with Exit -> error ctx Unterminated_string pmin) in
+		let str = (try unescape (contents ctx) with Invalid_escape_sequence(c,i,msg) -> error ctx (Invalid_escape (c,msg)) (pmin + i)) in
 		mk_tok (Const (String(str,SDoubleQuotes))) pmin pmax;
 	| "'" ->
-		reset();
+		reset ctx;
 		let pmin = lexeme_start lexbuf in
-		let pmax = (try string2 lexbuf with Exit -> error Unterminated_string pmin) in
-		let str = (try unescape (contents()) with Invalid_escape_sequence(c,i,msg) -> error (Invalid_escape (c,msg)) (pmin + i)) in
+		let pmax = (try string2 ctx lexbuf with Exit -> error ctx Unterminated_string pmin) in
+		let str = (try unescape (contents ctx) with Invalid_escape_sequence(c,i,msg) -> error ctx (Invalid_escape (c,msg)) (pmin + i)) in
 		mk_tok (Const (String(str,SSingleQuotes))) pmin pmax;
 	| "~/" ->
-		reset();
+		reset ctx;
 		let pmin = lexeme_start lexbuf in
-		let options, pmax = (try regexp lexbuf with Exit -> error Unterminated_regexp pmin) in
-		let str = contents() in
+		let options, pmax = (try regexp ctx lexbuf with Exit -> error ctx Unterminated_regexp pmin) in
+		let str = contents ctx in
 		mk_tok (Const (Regexp (str,options))) pmin pmax;
 	| '#', ident ->
 		let v = lexeme lexbuf in
@@ -568,101 +563,101 @@ let rec token lexbuf =
 	| "new" -> mk_keyword lexbuf New
 	| "in" -> mk_keyword lexbuf In
 	| "cast" -> mk_keyword lexbuf Cast
-	| ident -> mk_ident lexbuf
+	| ident -> mk_ident ctx lexbuf
 	| idtype -> mk lexbuf (Const (Ident (lexeme lexbuf)))
-	| _ -> invalid_char lexbuf
+	| _ -> invalid_char ctx lexbuf
 
-and comment lexbuf =
+and comment ctx lexbuf =
 	match%sedlex lexbuf with
 	| eof -> raise Exit
-	| '\n' | '\r' | "\r\n" -> newline lexbuf; store lexbuf; comment lexbuf
+	| '\n' | '\r' | "\r\n" -> newline ctx lexbuf; store ctx lexbuf; comment ctx lexbuf
 	| "*/" -> lexeme_end lexbuf
-	| '*' -> store lexbuf; comment lexbuf
-	| Plus (Compl ('*' | '\n' | '\r')) -> store lexbuf; comment lexbuf
+	| '*' -> store ctx lexbuf; comment ctx lexbuf
+	| Plus (Compl ('*' | '\n' | '\r')) -> store ctx lexbuf; comment ctx lexbuf
 	| _ -> die "" __LOC__
 
-and string lexbuf =
+and string ctx lexbuf =
 	match%sedlex lexbuf with
 	| eof -> raise Exit
-	| '\n' | '\r' | "\r\n" -> newline lexbuf; store lexbuf; string lexbuf
-	| "\\\"" -> store lexbuf; string lexbuf
-	| "\\\\" -> store lexbuf; string lexbuf
-	| '\\' -> store lexbuf; string lexbuf
+	| '\n' | '\r' | "\r\n" -> newline ctx lexbuf; store ctx lexbuf; string ctx lexbuf
+	| "\\\"" -> store ctx lexbuf; string ctx lexbuf
+	| "\\\\" -> store ctx lexbuf; string ctx lexbuf
+	| '\\' -> store ctx lexbuf; string ctx lexbuf
 	| '"' -> lexeme_end lexbuf
-	| Plus (Compl ('"' | '\\' | '\r' | '\n')) -> store lexbuf; string lexbuf
+	| Plus (Compl ('"' | '\\' | '\r' | '\n')) -> store ctx lexbuf; string ctx lexbuf
 	| _ -> die "" __LOC__
 
-and string2 lexbuf =
+and string2 ctx lexbuf =
 	match%sedlex lexbuf with
 	| eof -> raise Exit
-	| '\n' | '\r' | "\r\n" -> newline lexbuf; store lexbuf; string2 lexbuf
-	| '\\' -> store lexbuf; string2 lexbuf
-	| "\\\\" -> store lexbuf; string2 lexbuf
-	| "\\'" -> store lexbuf; string2 lexbuf
+	| '\n' | '\r' | "\r\n" -> newline ctx lexbuf; store ctx lexbuf; string2 ctx lexbuf
+	| '\\' -> store ctx lexbuf; string2 ctx lexbuf
+	| "\\\\" -> store ctx lexbuf; string2 ctx lexbuf
+	| "\\'" -> store ctx lexbuf; string2 ctx lexbuf
 	| "'" -> lexeme_end lexbuf
-	| "$$" | "\\$" | '$' -> store lexbuf; string2 lexbuf
+	| "$$" | "\\$" | '$' -> store ctx lexbuf; string2 ctx lexbuf
 	| "${" ->
 		let pmin = lexeme_start lexbuf in
-		store lexbuf;
-		(try code_string lexbuf 0 with Exit -> error Unclosed_code pmin);
-		string2 lexbuf;
-	| Plus (Compl ('\'' | '\\' | '\r' | '\n' | '$')) -> store lexbuf; string2 lexbuf
+		store ctx lexbuf;
+		(try code_string ctx lexbuf 0 with Exit -> error ctx Unclosed_code pmin);
+		string2 ctx lexbuf;
+	| Plus (Compl ('\'' | '\\' | '\r' | '\n' | '$')) -> store ctx lexbuf; string2 ctx lexbuf
 	| _ -> die "" __LOC__
 
-and code_string lexbuf open_braces =
+and code_string ctx lexbuf open_braces =
 	match%sedlex lexbuf with
 	| eof -> raise Exit
-	| '\n' | '\r' | "\r\n" -> newline lexbuf; store lexbuf; code_string lexbuf open_braces
-	| '{' -> store lexbuf; code_string lexbuf (open_braces + 1)
-	| '/' -> store lexbuf; code_string lexbuf open_braces
+	| '\n' | '\r' | "\r\n" -> newline ctx lexbuf; store ctx lexbuf; code_string ctx lexbuf open_braces
+	| '{' -> store ctx lexbuf; code_string ctx lexbuf (open_braces + 1)
+	| '/' -> store ctx lexbuf; code_string ctx lexbuf open_braces
 	| '}' ->
-		store lexbuf;
-		if open_braces > 0 then code_string lexbuf (open_braces - 1)
+		store ctx lexbuf;
+		if open_braces > 0 then code_string ctx lexbuf (open_braces - 1)
 	| '"' ->
-		add "\"";
+		add ctx "\"";
 		let pmin = lexeme_start lexbuf in
-		(try ignore(string lexbuf) with Exit -> error Unterminated_string pmin);
-		add "\"";
-		code_string lexbuf open_braces
+		(try ignore(string ctx lexbuf) with Exit -> error ctx Unterminated_string pmin);
+		add ctx "\"";
+		code_string ctx lexbuf open_braces
 	| "'" ->
-		add "'";
+		add ctx "'";
 		let pmin = lexeme_start lexbuf in
-		(try ignore(string2 lexbuf) with Exit -> error Unterminated_string pmin);
-		add "'";
-		code_string lexbuf open_braces
+		(try ignore(string2 ctx lexbuf) with Exit -> error ctx Unterminated_string pmin);
+		add ctx "'";
+		code_string ctx lexbuf open_braces
 	| "/*" ->
 		let pmin = lexeme_start lexbuf in
-		let save = contents() in
-		reset();
-		(try ignore(comment lexbuf) with Exit -> error Unclosed_comment pmin);
-		reset();
-		Buffer.add_string buf save;
-		code_string lexbuf open_braces
-	| "//", Star (Compl ('\n' | '\r')) -> store lexbuf; code_string lexbuf open_braces
-	| Plus (Compl ('/' | '"' | '\'' | '{' | '}' | '\n' | '\r')) -> store lexbuf; code_string lexbuf open_braces
+		let save = contents ctx in
+		reset ctx;
+		(try ignore(comment ctx lexbuf) with Exit -> error ctx Unclosed_comment pmin);
+		reset ctx;
+		Buffer.add_string ctx.buf save;
+		code_string ctx lexbuf open_braces
+	| "//", Star (Compl ('\n' | '\r')) -> store ctx lexbuf; code_string ctx lexbuf open_braces
+	| Plus (Compl ('/' | '"' | '\'' | '{' | '}' | '\n' | '\r')) -> store ctx lexbuf; code_string ctx lexbuf open_braces
 	| _ -> die "" __LOC__
 
-and regexp lexbuf =
+and regexp ctx lexbuf =
 	match%sedlex lexbuf with
 	| eof | '\n' | '\r' -> raise Exit
-	| '\\', '/' -> add "/"; regexp lexbuf
-	| '\\', 'r' -> add "\r"; regexp lexbuf
-	| '\\', 'n' -> add "\n"; regexp lexbuf
-	| '\\', 't' -> add "\t"; regexp lexbuf
-	| '\\', ('\\' | '$' | '.' | '*' | '+' | '^' | '|' | '{' | '}' | '[' | ']' | '(' | ')' | '?' | '-' | '0'..'9') -> add (lexeme lexbuf); regexp lexbuf
-	| '\\', ('w' | 'W' | 'b' | 'B' | 's' | 'S' | 'd' | 'D' | 'x') -> add (lexeme lexbuf); regexp lexbuf
-	| '\\', ('u' | 'U'), ('0'..'9' | 'a'..'f' | 'A'..'F'), ('0'..'9' | 'a'..'f' | 'A'..'F'), ('0'..'9' | 'a'..'f' | 'A'..'F'), ('0'..'9' | 'a'..'f' | 'A'..'F') -> add (lexeme lexbuf); regexp lexbuf
-	| '\\', Compl '\\' -> error (Invalid_character (Uchar.to_int (lexeme_char lexbuf 0))) (lexeme_end lexbuf - 1)
-	| '/' -> regexp_options lexbuf, lexeme_end lexbuf
-	| Plus (Compl ('\\' | '/' | '\r' | '\n')) -> store lexbuf; regexp lexbuf
+	| '\\', '/' -> add  ctx"/"; regexp ctx lexbuf
+	| '\\', 'r' -> add  ctx"\r"; regexp ctx lexbuf
+	| '\\', 'n' -> add  ctx"\n"; regexp ctx lexbuf
+	| '\\', 't' -> add  ctx"\t"; regexp ctx lexbuf
+	| '\\', ('\\' | '$' | '.' | '*' | '+' | '^' | '|' | '{' | '}' | '[' | ']' | '(' | ')' | '?' | '-' | '0'..'9') -> add  ctx(lexeme lexbuf); regexp ctx lexbuf
+	| '\\', ('w' | 'W' | 'b' | 'B' | 's' | 'S' | 'd' | 'D' | 'x') -> add  ctx(lexeme lexbuf); regexp ctx lexbuf
+	| '\\', ('u' | 'U'), ('0'..'9' | 'a'..'f' | 'A'..'F'), ('0'..'9' | 'a'..'f' | 'A'..'F'), ('0'..'9' | 'a'..'f' | 'A'..'F'), ('0'..'9' | 'a'..'f' | 'A'..'F') -> add  ctx(lexeme lexbuf); regexp ctx lexbuf
+	| '\\', Compl '\\' -> error ctx (Invalid_character (Uchar.to_int (lexeme_char lexbuf 0))) (lexeme_end lexbuf - 1)
+	| '/' -> regexp_options ctx lexbuf, lexeme_end lexbuf
+	| Plus (Compl ('\\' | '/' | '\r' | '\n')) -> store ctx lexbuf; regexp ctx lexbuf
 	| _ -> die "" __LOC__
 
-and regexp_options lexbuf =
+and regexp_options ctx lexbuf =
 	match%sedlex lexbuf with
 	| 'g' | 'i' | 'm' | 's' | 'u' ->
 		let l = lexeme lexbuf in
-		l ^ regexp_options lexbuf
-	| 'a'..'z' -> error Invalid_option (lexeme_start lexbuf)
+		l ^ regexp_options ctx lexbuf
+	| 'a'..'z' -> error ctx Invalid_option (lexeme_start lexbuf)
 	| "" -> ""
 	| _ -> die "" __LOC__
 
@@ -672,13 +667,13 @@ and not_xml ctx depth in_open =
 	| eof ->
 		raise Exit
 	| '\n' | '\r' | "\r\n" ->
-		newline lexbuf;
-		store lexbuf;
+		newline ctx.lexer_ctx lexbuf;
+		store ctx.lexer_ctx lexbuf;
 		not_xml ctx depth in_open
 	(* closing tag *)
 	| '<','/',xml_name,'>' ->
 		let s = lexeme lexbuf in
-		Buffer.add_string buf s;
+		Buffer.add_string ctx.lexer_ctx.buf s;
 		(* If it matches our document close tag, finish or decrease depth. *)
 		if s = ctx.close_tag then begin
 			if depth = 0 then lexeme_end lexbuf
@@ -688,56 +683,57 @@ and not_xml ctx depth in_open =
 	(* opening tag *)
 	| '<',xml_name ->
 		let s = lexeme lexbuf in
-		Buffer.add_string buf s;
+		Buffer.add_string ctx.lexer_ctx.buf s;
 		(* If it matches our document open tag, increase depth and set in_open to true. *)
 		let depth,in_open = if s = ctx.open_tag then depth + 1,true else depth,false in
 		not_xml ctx depth in_open
 	(* /> *)
 	| '/','>' ->
 		let s = lexeme lexbuf in
-		Buffer.add_string buf s;
+		Buffer.add_string ctx.lexer_ctx.buf s;
 		(* We only care about this if we are still in the opening tag, i.e. if it wasn't closed yet.
 		   In that case, decrease depth and finish if it's 0. *)
 		let depth = if in_open then depth - 1 else depth in
 		if depth < 0 then lexeme_end lexbuf
 		else not_xml ctx depth false
 	| '<' | '/' | '>' ->
-		store lexbuf;
+		store ctx.lexer_ctx lexbuf;
 		not_xml ctx depth in_open
 	| Plus (Compl ('<' | '/' | '>' | '\n' | '\r')) ->
-		store lexbuf;
+		store ctx.lexer_ctx lexbuf;
 		not_xml ctx depth in_open
 	| _ ->
 		die "" __LOC__
 
-let rec sharp_token lexbuf =
+let rec sharp_token ctx lexbuf =
 	match%sedlex lexbuf with
-	| sharp_ident -> mk_ident lexbuf
-	| Plus (Chars " \t") -> sharp_token lexbuf
-	| "\r\n" -> newline lexbuf; sharp_token lexbuf
-	| '\n' | '\r' -> newline lexbuf; sharp_token lexbuf
+	| sharp_ident -> mk_ident ctx lexbuf
+	| Plus (Chars " \t") -> sharp_token ctx lexbuf
+	| "\r\n" -> newline ctx lexbuf; sharp_token ctx lexbuf
+	| '\n' | '\r' -> newline ctx lexbuf; sharp_token ctx lexbuf
 	| "/*" ->
-		reset();
+		reset ctx;
 		let pmin = lexeme_start lexbuf in
-		ignore(try comment lexbuf with Exit -> error Unclosed_comment pmin);
-		sharp_token lexbuf
-	| _ -> token lexbuf
+		ignore(try comment ctx lexbuf with Exit -> error ctx Unclosed_comment pmin);
+		sharp_token ctx lexbuf
+	| _ -> token ctx lexbuf
 
-let lex_xml p lexbuf =
+let lex_xml ctx p lexbuf =
 	let name,pmin = match%sedlex lexbuf with
 	| xml_name -> lexeme lexbuf,lexeme_start lexbuf
-	| _ -> invalid_char lexbuf
+	| _ -> invalid_char ctx lexbuf
 	in
-	if p + 1 <> pmin then invalid_char lexbuf;
-	Buffer.add_string buf ("<" ^ name);
+	if p + 1 <> pmin then invalid_char ctx lexbuf;
+	Buffer.add_string ctx.buf ("<" ^ name);
 	let open_tag = "<" ^ name in
 	let close_tag = "</" ^ name ^ ">" in
-	let ctx = {
+	let xml_ctx = {
+		lexer_ctx = ctx;
 		open_tag = open_tag;
 		close_tag = close_tag;
 		lexbuf = lexbuf;
 	} in
 	try
-		not_xml ctx 0 (name <> "") (* don't allow self-closing fragments *)
+		not_xml xml_ctx 0 (name <> "") (* don't allow self-closing fragments *)
 	with Exit ->
-		error Unterminated_markup p
+		error ctx Unterminated_markup p

src/syntax/parser.ml

@@ -339,9 +339,9 @@ let rec make_meta name params ((v,p2) as e) p1 =
 	| _ -> EMeta((name,params,p1),e),punion p1 p2
 
 let handle_xml_literal p1 =
-	Lexer.reset();
-	let i = Lexer.lex_xml p1.pmin !code_ref in
-	let xml = Lexer.contents() in
+	let lctx = Lexer.create_temp_ctx p1.pfile in
+	let i = Lexer.lex_xml lctx p1.pmin !code_ref in
+	let xml = Lexer.contents lctx in
 	let e = EConst (String(xml,SDoubleQuotes)),{p1 with pmax = i} in (* STRINGTODO: distinct kind? *)
 	let e = make_meta Meta.Markup [] e p1 in
 	e

src/syntax/parserEntry.ml

@@ -209,8 +209,7 @@ class dead_block_collector conds = object(self)
 end
 
 (* parse main *)
-let parse entry ctx code file =
-	let old = Lexer.save() in
+let parse entry lctx defines code file =
 	let restore_cache = TokenCache.clear () in
 	let was_display = !in_display in
 	let was_display_file = !in_display_file in
@@ -230,7 +229,7 @@ let parse entry ctx code file =
 		)
 	in
 	last_doc := None;
-	in_macro := Define.defined ctx Define.Macro;
+	in_macro := Define.defined defines Define.Macro;
 	Lexer.skip_header code;
 
 	let sharp_error s p =
@@ -240,11 +239,11 @@ let parse entry ctx code file =
 
 	let conds = new condition_handler in
 	let dbc = new dead_block_collector conds in
-	let sraw = Stream.from (fun _ -> Some (Lexer.sharp_token code)) in
+	let sraw = Stream.from (fun _ -> Some (Lexer.sharp_token lctx code)) in
 	let preprocessor_error ppe pos tk =
 		syntax_error (Preprocessor_error ppe) ~pos:(Some pos) sraw tk
 	in
-	let rec next_token() = process_token (Lexer.token code)
+	let rec next_token() = process_token (Lexer.token lctx code)
 
 	and process_token tk =
 		match fst tk with
@@ -280,7 +279,7 @@ let parse entry ctx code file =
 		| Sharp "if" ->
 			process_token (enter_macro true (snd tk))
 		| Sharp "error" ->
-			(match Lexer.token code with
+			(match Lexer.token lctx code with
 			| (Const (String(s,_)),p) -> error (Custom s) p
 			| _ -> error Unimplemented (snd tk))
 		| Sharp "line" ->
@@ -288,7 +287,7 @@ let parse entry ctx code file =
 				| (Const (Int (s, _)),p) -> (try int_of_string s with _ -> error (Custom ("Could not parse ridiculous line number " ^ s)) p)
 				| (t,p) -> error (Unexpected t) p
 			) in
-			!(Lexer.cur).Lexer.lline <- line - 1;
+			lctx.file.Lexer.lline <- line - 1;
 			next_token();
 		| Sharp s ->
 			sharp_error s (pos tk)
@@ -298,8 +297,8 @@ let parse entry ctx code file =
 	and enter_macro is_if p =
 		let tk, e = parse_macro_cond sraw in
 		(if is_if then conds#cond_if e else conds#cond_elseif e p);
-		let tk = (match tk with None -> Lexer.token code | Some tk -> tk) in
-		if is_true (eval ctx e) then begin
+		let tk = (match tk with None -> Lexer.token lctx code | Some tk -> tk) in
+		if is_true (eval defines e) then begin
 			tk
 		end else begin
 			dbc#open_dead_block (pos e);
@@ -311,7 +310,7 @@ let parse entry ctx code file =
 		| Sharp "end" ->
 			conds#cond_end (snd tk);
 			dbc#close_dead_block (pos tk);
-			Lexer.token code
+			Lexer.token lctx code
 		| Sharp "elseif" when not test ->
 			dbc#close_dead_block (pos tk);
 			let _,(e,pe) = parse_macro_cond sraw in
@@ -326,7 +325,7 @@ let parse entry ctx code file =
 		| Sharp "else" ->
 			conds#cond_else (snd tk);
 			dbc#close_dead_block (pos tk);
-			Lexer.token code
+			Lexer.token lctx code
 		| Sharp "elseif" ->
 			dbc#close_dead_block (pos tk);
 			enter_macro false (snd tk)
@@ -345,7 +344,7 @@ let parse entry ctx code file =
 		| _ ->
 			skip_tokens p test
 
-	and skip_tokens p test = skip_tokens_loop p test (Lexer.token code)
+	and skip_tokens p test = skip_tokens_loop p test (Lexer.token lctx code)
 
 	in
 	let s = Stream.from (fun _ ->
@@ -365,7 +364,6 @@ let parse entry ctx code file =
 		end;
 		let was_display_file = !in_display_file in
 		restore();
-		Lexer.restore old;
 		let pdi = {pd_errors = List.rev !syntax_errors;pd_dead_blocks = dbc#get_dead_blocks;pd_conditions = conds#get_conditions} in
 		if was_display_file then
 			ParseSuccess(l,true,pdi)
@@ -377,50 +375,40 @@ let parse entry ctx code file =
 		| Stream.Error _
 		| Stream.Failure ->
 			let last = (match Stream.peek s with None -> last_token s | Some t -> t) in
-			Lexer.restore old;
 			restore();
 			error (Unexpected (fst last)) (pos last)
 		| e ->
-			Lexer.restore old;
 			restore();
 			raise e
 
-let parse_string entry com s p error inlined =
-	let old = Lexer.save() in
-	let old_file = (try Some (Hashtbl.find Lexer.all_files p.pfile) with Not_found -> None) in
-	let restore_file_data =
-		let f = Lexer.make_file old.lfile in
-		Lexer.copy_file old f;
-		(fun () ->
-			Lexer.copy_file f old
-		)
-	in
+let parse_string entry defines s p error inlined =
 	let old_display = display_position#get in
 	let old_in_display_file = !in_display_file in
 	let old_syntax_errors = !syntax_errors in
 	syntax_errors := [];
 	let restore() =
-		(match old_file with
-		| None -> Hashtbl.remove Lexer.all_files p.pfile
-		| Some f -> Hashtbl.replace Lexer.all_files p.pfile f);
 		if not inlined then begin
 			display_position#set old_display;
 			in_display_file := old_in_display_file;
 		end;
 		syntax_errors := old_syntax_errors;
-		Lexer.restore old;
-		(* String parsing might mutate lexer_file information, e.g. from newline() calls. Here we
-		   restore the actual file data (issue #10763). *)
-		restore_file_data()
 	in
-	if inlined then
-		Lexer.init p.pfile
-	else begin
+	let lctx = if inlined then begin
 		display_position#reset;
 		in_display_file := false;
-	end;
+		begin try
+			let old_file = ThreadSafeHashtbl.find Lexer.all_files p.pfile in
+			let new_file = Lexer.make_file p.pfile in
+			Lexer.copy_file old_file new_file;
+			Lexer.create_context new_file
+		with Not_found ->
+			Lexer.create_temp_ctx p.pfile
+		end
+	end else
+		Lexer.create_temp_ctx p.pfile
+	in
 	let result = try
-		parse entry com (Sedlexing.Utf8.from_string s) p.pfile
+		parse entry lctx defines (Sedlexing.Utf8.from_string s) p.pfile
 	with Error (e,pe) ->
 		restore();
 		error (error_msg e) (if inlined then pe else p)
@@ -431,9 +419,9 @@ let parse_string entry com s p error inlined =
 	restore();
 	result
 
-let parse_expr_string com s p error inl =
+let parse_expr_string defines s p error inl =
 	let s = if p.pmin > 0 then (String.make p.pmin ' ') ^ s else s in
-	let result = parse_string expr com s p error inl in
+	let result = parse_string expr defines s p error inl in
 	if inl then
 		result
 	else begin

src/typing/macroContext.ml

@@ -192,7 +192,7 @@ let make_macro_com_api com mcom p =
 		);
 		register_file_contents = (fun file content ->
 			let f = Lexer.resolve_file_content_pos file content in
-			Hashtbl.add Lexer.all_files file f;
+			ThreadSafeHashtbl.add Lexer.all_files file f;
 		);
 		type_expr = (fun e ->
 			Interp.exc_string "unsupported"

src/typing/typeloadParse.ml

@@ -31,10 +31,9 @@ open Error
 exception DisplayInMacroBlock
 
 let parse_file_from_lexbuf com file p lexbuf =
-	Lexer.init file;
 	incr stats.s_files_parsed;
 	let parse_result = try
-		ParserEntry.parse Grammar.parse_file com.defines lexbuf file
+		ParserEntry.parse Grammar.parse_file (Lexer.create_file_ctx file) com.defines lexbuf file
 	with
 		| Sedlexing.MalFormed ->
 			raise_typing_error "Malformed file. Source files must be encoded with UTF-8." (file_pos file)
@@ -229,7 +228,7 @@ module PdiHandler = struct
 		ParserEntry.is_true (ParserEntry.eval defines e)
 
 	let handle_pdi com pdi =
-		let macro_defines = adapt_defines_to_macro_context com.defines in
+		let macro_defines = adapt_defines_to_macro_context com.Common.defines in
 		let check = (if com.display.dms_kind = DMHover then
 			encloses_position_gt
 		else