Add context to parser (#12124)

* make lexer thread-safe

* fix branching mishap

* maybe like this?

* simplify

* urgh

* syntax errors

* last_doc

* parser config start

* was_auto_triggered

* had_parser_resume

* code_ref

* delayed syntax completion

* special_identifier_files

wtf is this anyway?

* token cache

* remove weird field refs

* remove lying comments

* banish to parser_state

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/compiler.ml

@@ -438,7 +438,7 @@ with
 	| Parser.Error (m,p) ->
 		error ctx (Parser.error_msg m) p
 	| Typecore.Forbid_package ((pack,m,p),pl,pf)  ->
-		if !Parser.display_mode <> DMNone && ctx.has_next then begin
+		if ctx.com.display.dms_kind <> DMNone && ctx.has_next then begin
 			ctx.has_error <- false;
 			ctx.messages <- [];
 		end else begin
@@ -539,7 +539,7 @@ let create_context comm cs timer_ctx compilation_step params = {
 		revision = version_revision;
 		pre = version_pre;
 		extra = Version.version_extra;
-	} params (DisplayTypes.DisplayMode.create !Parser.display_mode);
+	} params (DisplayTypes.DisplayMode.create DMNone);
 	messages = [];
 	has_next = false;
 	has_error = false;

src/compiler/displayProcessing.ml

@@ -29,7 +29,6 @@ let handle_display_argument_old com file_pos actx =
 		let file_unique = com.file_keys#get file in
 		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
 		let create mode =
-			Parser.display_mode := mode;
 			DisplayTypes.DisplayMode.create mode
 		in
 		let dm = match smode with
@@ -103,17 +102,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 =
@@ -276,7 +264,7 @@ let maybe_load_display_file_before_typing tctx display_file_dot_path = match dis
 let handle_display_after_typing ctx tctx display_file_dot_path =
 	let com = ctx.com in
 	if ctx.com.display.dms_kind = DMNone && ctx.has_error then raise Abort;
-	begin match ctx.com.display.dms_kind,!Parser.delayed_syntax_completion with
+	begin match ctx.com.display.dms_kind,Atomic.get ctx.com.parser_state.delayed_syntax_completion with
 		| DMDefault,Some(kind,subj) -> DisplayOutput.handle_syntax_completion com kind subj
 		| _ -> ()
 	end;

src/compiler/server.ml

@@ -57,12 +57,12 @@ let parse_file cs com (rfile : ClassPaths.resolved_file) p =
 			try
 				let cfile = cc#find_file fkey in
 				if cfile.c_time <> ftime then raise Not_found;
-				Parser.ParseSuccess((cfile.c_package,cfile.c_decls),false,cfile.c_pdi)
+				Parser.ParseSuccess((cfile.c_package,cfile.c_decls),cfile.c_pdi)
 			with Not_found ->
 				let parse_result = TypeloadParse.parse_file com rfile p in
 				let info,is_unusual = match parse_result with
 					| ParseError(_,_,_) -> "not cached, has parse error",true
-					| ParseSuccess(data,is_display_file,pdi) ->
+					| ParseSuccess(data,pdi) ->
 						if is_display_file then begin
 							if pdi.pd_errors <> [] then
 								"not cached, is display file with parse errors",true
@@ -75,7 +75,7 @@ let parse_file cs com (rfile : ClassPaths.resolved_file) p =
 							(* We assume that when not in display mode it's okay to cache stuff that has #if display
 							checks. The reasoning is that non-display mode has more information than display mode. *)
 							if com.display.dms_full_typing then raise Not_found;
-							let ident = Hashtbl.find Parser.special_identifier_files fkey in
+							let ident = ThreadSafeHashtbl.find com.parser_state.special_identifier_files fkey in
 							Printf.sprintf "not cached, using \"%s\" define" ident,true
 						with Not_found ->
 							cc#cache_file fkey (ClassPaths.create_resolved_file ffile rfile.class_path) ftime data pdi;
@@ -295,7 +295,7 @@ let check_module sctx com m_path m_extra p =
 				end
 		in
 		let has_policy policy = List.mem policy m_extra.m_check_policy || match policy with
-			| NoFileSystemCheck when !ServerConfig.do_not_check_modules && !Parser.display_mode <> DMNone -> true
+			| NoFileSystemCheck when !ServerConfig.do_not_check_modules && com.display.dms_kind <> DMNone -> true
 			| _ -> false
 		in
 		let check_file () =

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/context/common.ml

@@ -227,6 +227,13 @@ class virtual abstract_hxb_lib = object(self)
 	method virtual get_string_pool : string -> string array option
 end
 
+type parser_state = {
+	mutable was_auto_triggered : bool;
+	mutable had_parser_resume : bool;
+	delayed_syntax_completion : Parser.syntax_completion_on option Atomic.t;
+	special_identifier_files : (Path.UniqueKey.t,string) ThreadSafeHashtbl.t;
+}
+
 type context = {
 	compilation_step : int;
 	mutable stage : compiler_stage;
@@ -250,6 +257,7 @@ type context = {
 	main : Gctx.context_main;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable report_mode : report_mode;
+	parser_state : parser_state;
 	(* communication *)
 	mutable print : string -> unit;
 	mutable error : Gctx.error_function;
@@ -770,6 +778,12 @@ let create timer_ctx compilation_step cs version args display_mode =
 		hxb_reader_api = None;
 		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_writer_config = None;
+		parser_state = {
+			was_auto_triggered = false;
+			had_parser_resume = false;
+			delayed_syntax_completion = Atomic.make None;
+			special_identifier_files = ThreadSafeHashtbl.create 0;
+		}
 	} in
 	com
 

src/context/display/display.ml

@@ -31,8 +31,8 @@ module ReferencePosition = struct
 end
 
 let preprocess_expr com e = match com.display.dms_kind with
-	| DMDefinition | DMTypeDefinition | DMUsage _ | DMImplementation | DMHover | DMDefault -> ExprPreprocessing.find_before_pos com.display.dms_kind e
-	| DMSignature -> ExprPreprocessing.find_display_call e
+	| DMDefinition | DMTypeDefinition | DMUsage _ | DMImplementation | DMHover | DMDefault -> ExprPreprocessing.find_before_pos com.parser_state.was_auto_triggered com.display.dms_kind e
+	| DMSignature -> ExprPreprocessing.find_display_call com.parser_state.was_auto_triggered e
 	| _ -> e
 
 let sort_fields l with_type tk =

src/context/display/displayJson.ml

@@ -51,7 +51,6 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
 
 	method enable_display ?(skip_define=false) mode =
 		com.display <- create mode;
-		Parser.display_mode := mode;
 		if not skip_define then Common.define_value com Define.Display "1"
 
 	method set_display_file was_auto_triggered requires_offset =
@@ -65,7 +64,7 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
 		) None in
 
 		let pos = if requires_offset then jsonrpc#get_int_param "offset" else (-1) in
-		Parser.was_auto_triggered := was_auto_triggered;
+		com.parser_state.was_auto_triggered <- was_auto_triggered;
 
 		if file <> file_input_marker then begin
 			let file_unique = com.file_keys#get file in

src/context/display/exprPreprocessing.ml

@@ -3,7 +3,7 @@ open Ast
 open DisplayTypes.DisplayMode
 open DisplayPosition
 
-let find_before_pos dm e =
+let find_before_pos was_auto_triggered dm e =
 	let display_pos = ref (DisplayPosition.display_position#get) in
 	let was_annotated = ref false in
 	let is_annotated,is_completion = match dm with
@@ -160,7 +160,7 @@ let find_before_pos dm e =
 			raise Exit
 		| EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p ->
 			annotate_marked e
-		| EConst (String (_,q)) when ((q <> SSingleQuotes) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion ->
+		| EConst (String (_,q)) when ((q <> SSingleQuotes) || was_auto_triggered) && is_annotated (pos e) && is_completion ->
 			(* TODO: check if this makes any sense *)
 			raise Exit
 		| EConst(Regexp _) when is_annotated (pos e) && is_completion ->
@@ -199,13 +199,13 @@ let find_before_pos dm e =
 	in
 	try map e with Exit -> e
 
-let find_display_call e =
+let find_display_call was_auto_triggered e =
 	let found = ref false in
 	let handle_el e el =
 		let call_arg_is_marked () =
 			el = [] || List.exists (fun (e,_) -> match e with EDisplay(_,DKMarked) -> true | _ -> false) el
 		in
-		if not !Parser.was_auto_triggered || call_arg_is_marked () then begin
+		if not was_auto_triggered || call_arg_is_marked () then begin
 		found := true;
 		Parser.mk_display_expr e DKCall
 		end else

src/context/formatString.ml

@@ -1,7 +1,7 @@
 open Globals
 open Ast
 
-let format_string defines s p process_expr =
+let format_string config s p process_expr =
 	let e = ref None in
 	let pmin = ref p.pmin in
 	let min = ref (p.pmin + 1) in
@@ -83,8 +83,8 @@ let format_string defines s p process_expr =
 					if Lexer.string_is_whitespace scode then Error.raise_typing_error "Expression cannot be empty" ep
 					else Error.raise_typing_error msg pos
 				in
-				match ParserEntry.parse_expr_string defines scode ep error true with
-					| ParseSuccess(data,_,_) -> data
+				match ParserEntry.parse_expr_string config scode ep error true with
+					| ParseSuccess(data,_) -> data
 					| ParseError(_,(msg,p),_) -> error (Parser.error_msg msg) p
 			in
 			add_expr e slen

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/macro/eval/evalDebugMisc.ml

@@ -78,10 +78,10 @@ let find_breakpoint ctx sid =
 
 exception Parse_expr_error of string
 
-let parse_expr ctx s p =
+let parse_expr ctx config s p =
 	let error s = raise (Parse_expr_error s) in
-	match ParserEntry.parse_expr_string (ctx.curapi.get_com()).Common.defines s p error true with
-	| ParseSuccess(data,_,_) -> data
+	match ParserEntry.parse_expr_string config s p error true with
+	| ParseSuccess(data,_) -> data
 	| ParseError(_,(msg,_),_) -> error (Parser.error_msg msg)
 
 (* Vars *)

src/macro/eval/evalDebugSocket.ml

@@ -475,18 +475,18 @@ module ValueCompletion = struct
 	let get_completion ctx text column env =
 		let p = file_pos "" in
 		let save =
-			let old = !Parser.display_mode,DisplayPosition.display_position#get in
+			let old = DisplayPosition.display_position#get in
 			(fun () ->
-				Parser.display_mode := fst old;
-				DisplayPosition.display_position#set (snd old);
+				DisplayPosition.display_position#set old;
 			)
 		in
-		Parser.display_mode := DMDefault;
+		let com = (ctx.curapi.get_com()) in
+		let config = Parser.create_config com.Common.defines true true DMDefault com.parser_state.was_auto_triggered None in
 		let offset = column + (String.length "class X{static function main() ") - 1 (* this is retarded *) in
 		DisplayPosition.display_position#set {p with pmin = offset; pmax = offset};
 		begin try
-			let e = parse_expr ctx text p in
-			let e = ExprPreprocessing.find_before_pos DMDefault e in
+			let e = parse_expr ctx config text p in
+			let e = ExprPreprocessing.find_before_pos com.parser_state.was_auto_triggered DMDefault e in
 			save();
 			let rec loop e = match fst e with
 			| EDisplay(e1,DKDot) ->
@@ -542,6 +542,9 @@ let expect_env hctx env = match env with
 	| None -> hctx.send_error "No frame found"
 
 let handler =
+	let parse_expr ctx p =
+		parse_expr ctx (ParserConfig.default_config (ctx.curapi.get_com()).Common.defines) p
+	in
 	let parse_breakpoint hctx jo =
 		let j = hctx.jsonrpc in
 		let obj = j#get_object "breakpoint" jo in

src/macro/macroApi.ml

@@ -35,7 +35,7 @@ type 'value compiler_api = {
 	on_type_not_found : (string -> 'value) -> unit;
 	parse_string : string -> Globals.pos -> bool -> Ast.expr;
 	register_file_contents : string -> string -> unit;
-	parse : 'a . ((Ast.token * Globals.pos) Stream.t -> 'a) -> string -> 'a;
+	parse : 'a . (Parser.parser_ctx -> (Ast.token * Globals.pos) Stream.t -> 'a) -> string -> 'a;
 	type_expr : Ast.expr -> Type.texpr;
 	resolve_type  : Ast.complex_type -> Globals.pos -> t;
 	resolve_complex_type : Ast.type_hint -> Ast.type_hint;
@@ -2233,7 +2233,7 @@ let macro_api ccom get_api =
 				encode_obj ["file",encode_string p.Globals.pfile;"pos",vint p.Globals.pmin]
 		);
 		"get_display_mode", vfun0 (fun() ->
-			encode_display_mode !Parser.display_mode
+			encode_display_mode (ccom()).display.dms_kind;
 		);
 		"get_configuration", vfun0 (fun() ->
 			let com = ccom() in
@@ -2397,9 +2397,9 @@ let macro_api ccom get_api =
 		);
 		"with_imports", vfun3(fun imports usings f ->
 			let imports = List.map decode_string (decode_array imports) in
-			let imports = List.map ((get_api()).parse (fun s -> Grammar.parse_import' s Globals.null_pos)) imports in
+			let imports = List.map ((get_api()).parse (fun pctx s -> Grammar.parse_import' pctx s Globals.null_pos)) imports in
 			let usings = List.map decode_string (decode_array usings) in
-			let usings = List.map ((get_api()).parse (fun s -> Grammar.parse_using' s Globals.null_pos)) usings in
+			let usings = List.map ((get_api()).parse (fun pctx s -> Grammar.parse_using' pctx s Globals.null_pos)) usings in
 			let f = prepare_callback f 0 in
 			(get_api()).with_imports imports usings (fun () -> f [])
 		);

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,27 +79,43 @@ let make_file file =
 		llastindex = 0;
 	}
 
-let copy_file source dest =
-	dest.lline <- source.lline;
-	dest.lmaxline <- source.lmaxline;
-	dest.llines <- source.llines;
-	dest.lalines <- source.lalines;
-	dest.llast <- source.llast;
-	dest.llastindex <- source.llastindex
+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 = {
+	lfile = source.lfile;
+	lline = source.lline;
+	lmaxline = source.lmaxline;
+	llines = source.llines;
+	lalines = source.lalines;
+	llast = source.llast;
+	llastindex = source.llastindex;
+}
 
 let print_file file =
 	let sllines = String.concat ";" (List.map (fun (i1,i2) -> Printf.sprintf "(%i,%i)" i1 i2) file.llines) in
 	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 +179,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 +265,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 +281,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 +305,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 +400,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 +484,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 +565,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 +669,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 +685,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

@@ -19,7 +19,6 @@
 
 open Ast
 open Globals
-open DisplayTypes.DisplayMode
 open DisplayPosition
 
 type preprocessor_error =
@@ -67,9 +66,32 @@ type 'a sequence_parsing_result =
 	| End of pos
 	| Error of string
 
+type syntax_completion_on = syntax_completion * DisplayTypes.completion_subject
+
 exception Error of error_msg * pos
 exception TypePath of string list * (string * bool) option * bool (* in import *) * pos
-exception SyntaxCompletion of syntax_completion * DisplayTypes.completion_subject
+exception SyntaxCompletion of syntax_completion_on
+
+type parser_config = {
+	defines : Define.define;
+	in_display : bool;
+	in_display_file : bool;
+	display_mode : DisplayTypes.DisplayMode.t;
+	was_auto_triggered : bool;
+	special_identifier_files : (Path.UniqueKey.t,string) ThreadSafeHashtbl.t option;
+}
+
+type parser_ctx = {
+	lexer_ctx : Lexer.lexer_ctx;
+	mutable syntax_errors : (error_msg * pos) list;
+	mutable last_doc : (string * int) option;
+	in_macro : bool;
+	code : Sedlexing.lexbuf;
+	mutable had_resume : bool;
+	mutable delayed_syntax_completion : syntax_completion_on option;
+	cache : (token * pos) DynArray.t;
+	config : parser_config;
+}
 
 let error_msg = function
 	| Unexpected (Kwd k) -> "Unexpected keyword \""^(s_keyword k)^"\""
@@ -97,14 +119,36 @@ type parser_display_information = {
 	pd_errors : parse_error list;
 	pd_dead_blocks : (pos * expr) list;
 	pd_conditions : expr list;
+	pd_was_display_file : bool;
+	pd_had_resume : bool;
+	pd_delayed_syntax_completion : syntax_completion_on option;
 }
 
 type 'a parse_result =
-	(* Parsed non-display-file without errors. *)
-	| ParseSuccess of 'a * bool * parser_display_information
-	(* Parsed non-display file with errors *)
+	| ParseSuccess of 'a * parser_display_information
 	| ParseError of 'a * parse_error * parse_error list
 
+let create_context lexer_ctx config in_macro code = {
+	lexer_ctx;
+	syntax_errors = [];
+	last_doc = None;
+	in_macro;
+	code;
+	had_resume = false;
+	delayed_syntax_completion = None;
+	cache = DynArray.create ();
+	config;
+}
+
+let create_config defines in_display in_display_file display_mode was_auto_triggered special_identifier_files = {
+	defines;
+	in_display;
+	in_display_file;
+	display_mode;
+	was_auto_triggered;
+	special_identifier_files;
+}
+
 let s_decl_flag = function
 	| DPrivate -> "private"
 	| DExtern -> "extern"
@@ -121,96 +165,58 @@ let syntax_completion kind so p =
 
 let error m p = raise (Error (m,p))
 
-let special_identifier_files : (Path.UniqueKey.t,string) Hashtbl.t = Hashtbl.create 0
-
-module TokenCache = struct
-	let cache = ref (DynArray.create ())
-	let add (token : (token * pos)) = DynArray.add (!cache) token
-	let get index = DynArray.get (!cache) index
-	let clear () =
-		let old_cache = !cache in
-		cache := DynArray.create ();
-		(fun () -> cache := old_cache)
-end
-
-let last_token s =
+let last_token ctx s =
 	let n = Stream.count s in
-	TokenCache.get (if n = 0 then 0 else n - 1)
+	DynArray.get ctx.cache (if n = 0 then 0 else n - 1)
 
-let last_pos s = pos (last_token s)
+let last_pos ctx s = pos (last_token ctx s)
 
-let next_token s = match Stream.peek s with
+let next_token ctx s = match Stream.peek s with
 	| Some (Eof,p) ->
 		(Eof,p)
 	| Some tk -> tk
 	| None ->
-		let last_pos = pos (last_token s) in
+		let last_pos = pos (last_token ctx s) in
 		(Eof,last_pos)
 
-let next_pos s = pos (next_token s)
-
-(* Global state *)
-
-let in_display = ref false
-let was_auto_triggered = ref false
-let display_mode = ref DMNone
-let in_macro = ref false
-let had_resume = ref false
-let code_ref = ref (Sedlexing.Utf8.from_string "")
-let delayed_syntax_completion : (syntax_completion * DisplayTypes.completion_subject) option ref = ref None
-
-(* Per-file state *)
-
-let in_display_file = ref false
-let last_doc : (string * int) option ref = ref None
-let syntax_errors = ref []
+let next_pos ctx s = pos (next_token ctx s)
 
 let reset_state () =
-	in_display := false;
-	was_auto_triggered := false;
-	display_mode := DMNone;
-	display_position#reset;
-	in_macro := false;
-	had_resume := false;
-	code_ref := Sedlexing.Utf8.from_string "";
-	delayed_syntax_completion := None;
-	in_display_file := false;
-	last_doc := None;
-	syntax_errors := []
-
-let syntax_error_with_pos error_msg p v =
+	display_position#reset
+
+let syntax_error_with_pos ctx error_msg p v =
 	let p = if p.pmax = max_int then {p with pmax = p.pmin + 1} else p in
-	if not !in_display then error error_msg p;
-	syntax_errors := (error_msg,p) :: !syntax_errors;
+	if not ctx.config.in_display then error error_msg p;
+	ctx.syntax_errors <- (error_msg,p) :: ctx.syntax_errors;
 	v
 
-let syntax_error error_msg ?(pos=None) s v =
-	let p = (match pos with Some p -> p | None -> next_pos s) in
-	syntax_error_with_pos error_msg p v
+let syntax_error ctx error_msg ?(pos=None) s v =
+	let p = (match pos with Some p -> p | None -> next_pos ctx s) in
+	syntax_error_with_pos ctx error_msg p v
 
-let handle_stream_error msg s =
+let handle_stream_error ctx msg s =
 	let err,pos = if msg = "Parse error." then begin
-		let tk,pos = next_token s in
+		let tk,pos = next_token ctx s in
 		(Unexpected tk),Some pos
 	end else
 		(StreamError msg),None
 	in
-	syntax_error err ~pos s ()
+	syntax_error ctx err ~pos s ()
 
-let get_doc s =
+let get_doc ctx s =
 	(* do the peek first to make sure we fetch the doc *)
 	match Stream.peek s with
 	| None -> None
 	| Some (tk,p) ->
-		match !last_doc with
+		match ctx.last_doc with
 		| None -> None
 		| Some (d,pos) ->
-			last_doc := None;
+			ctx.last_doc <- None;
 			Some d
 
-let unsupported_decl_flag decl flag pos =
+let unsupported_decl_flag decl flag pos ctx =
 	let msg = (s_decl_flag flag) ^ " modifier is not supported for " ^ decl in
-	syntax_error_with_pos (Custom msg) pos None
+	syntax_error_with_pos ctx (Custom msg) pos None
 
 let unsupported_decl_flag_class = unsupported_decl_flag "classes"
 let unsupported_decl_flag_enum = unsupported_decl_flag "enums"
@@ -218,35 +224,35 @@ let unsupported_decl_flag_abstract = unsupported_decl_flag "abstracts"
 let unsupported_decl_flag_typedef = unsupported_decl_flag "typedefs"
 let unsupported_decl_flag_module_field = unsupported_decl_flag "module-level fields"
 
-let decl_flag_to_class_flag (flag,p) = match flag with
+let decl_flag_to_class_flag ctx (flag,p) = match flag with
 	| DPrivate -> Some HPrivate
 	| DExtern -> Some HExtern
 	| DFinal -> Some HFinal
-	| DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_class flag p
+	| DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_class flag p ctx
 
-let decl_flag_to_enum_flag (flag,p) = match flag with
+let decl_flag_to_enum_flag ctx (flag,p) = match flag with
 	| DPrivate -> Some EPrivate
 	| DExtern -> Some EExtern
-	| DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_enum flag p
+	| DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_enum flag p ctx
 
-let decl_flag_to_abstract_flag (flag,p) = match flag with
+let decl_flag_to_abstract_flag ctx (flag,p) = match flag with
 	| DPrivate -> Some AbPrivate
 	| DExtern -> Some AbExtern
-	| DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_abstract flag p
+	| DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_abstract flag p ctx
 
-let decl_flag_to_typedef_flag (flag,p) = match flag with
+let decl_flag_to_typedef_flag ctx (flag,p) = match flag with
 	| DPrivate -> Some TDPrivate
 	| DExtern -> Some TDExtern
-	| DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_typedef flag p
+	| DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_typedef flag p ctx
 
-let decl_flag_to_module_field_flag (flag,p) = match flag with
+let decl_flag_to_module_field_flag ctx (flag,p) = match flag with
 	| DPrivate -> Some (APrivate,p)
 	| DMacro -> Some (AMacro,p)
 	| DDynamic -> Some (ADynamic,p)
 	| DInline -> Some (AInline,p)
 	| DOverload -> Some (AOverload,p)
 	| DExtern -> Some (AExtern,p)
-	| DFinal | DPublic | DStatic -> unsupported_decl_flag_module_field flag p
+	| DFinal | DPublic | DStatic -> unsupported_decl_flag_module_field flag p ctx
 
 let serror() = raise (Stream.Error "Parse error.")
 
@@ -257,15 +263,15 @@ let magic_type_ct p = make_ptp_ct magic_type_path p
 
 let magic_type_th p = magic_type_ct p,p
 
-let delay_syntax_completion kind so p =
-	delayed_syntax_completion := Some(kind,DisplayTypes.make_subject so p)
+let delay_syntax_completion ctx kind so p =
+	ctx.delayed_syntax_completion <- Some(kind,DisplayTypes.make_subject so p)
 
 let type_path sl in_import p = match sl with
 	| n :: l when n.[0] >= 'A' && n.[0] <= 'Z' -> raise (TypePath (List.rev l,Some (n,false),in_import,p));
 	| _ -> raise (TypePath (List.rev sl,None,in_import,p))
 
-let would_skip_display_position p1 plus_one s =
-	if !in_display_file then match Stream.npeek 1 s with
+let would_skip_display_position ctx p1 plus_one s =
+	if ctx.config.in_display_file then match Stream.npeek 1 s with
 		| [ (_,p2) ] ->
 			let p2 = {p2 with pmin = p1.pmax + (if plus_one then 1 else 0)} in
 			display_position#enclosed_in p2
@@ -338,16 +344,16 @@ let rec make_meta name params ((v,p2) as e) p1 =
 	| ETernary (e1,e2,e3) -> ETernary (make_meta name params e1 p1 , e2, e3), punion p1 p2
 	| _ -> 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 handle_xml_literal ctx p1 =
+	Lexer.reset ctx.lexer_ctx;
+	let i = Lexer.lex_xml ctx.lexer_ctx p1.pmin ctx.code in
+	let xml = Lexer.contents ctx.lexer_ctx 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
 
-let punion_next p1 s =
-	let _,p2 = next_token s in
+let punion_next ctx p1 s =
+	let _,p2 = next_token ctx s in
 	{
 		pfile = p1.pfile;
 		pmin = p1.pmin;
@@ -358,22 +364,22 @@ let mk_null_expr p = (EConst(Ident "null"),p)
 
 let mk_display_expr e dk = (EDisplay(e,dk),(pos e))
 
-let is_completion () =
-	!display_mode = DMDefault
+let is_completion ctx =
+	ctx.config.display_mode = DMDefault
 
-let is_signature_display () =
-	!display_mode = DMSignature
+let is_signature_display ctx =
+	ctx.config.display_mode = DMSignature
 
-let check_resume p fyes fno =
-	if is_completion () && !in_display_file && p.pmax = (display_position#get).pmin then begin
-		had_resume := true;
+let check_resume ctx p fyes fno =
+	if is_completion ctx && ctx.config.in_display_file && p.pmax = (display_position#get).pmin then begin
+		ctx.had_resume <- true;
 		fyes()
 	end else
 		fno()
 
-let check_resume_range p s fyes fno =
-	if is_completion () && !in_display_file then begin
-		let pnext = next_pos s in
+let check_resume_range ctx p s fyes fno =
+	if is_completion ctx && ctx.config.in_display_file then begin
+		let pnext = next_pos ctx s in
 		if p.pmin < (display_position#get).pmin && pnext.pmin >= (display_position#get).pmax then
 			fyes pnext
 		else
@@ -381,19 +387,19 @@ let check_resume_range p s fyes fno =
 	end else
 		fno()
 
-let check_completion p0 plus_one s =
+let check_completion ctx p0 plus_one s =
 	match Stream.peek s with
 	| Some((Const(Ident name),p)) when display_position#enclosed_in p ->
 		Stream.junk s;
 		(Some(Some name,p))
 	| _ ->
-		if would_skip_display_position p0 plus_one s then
+		if would_skip_display_position ctx p0 plus_one s then
 			Some(None,DisplayPosition.display_position#with_pos p0)
 		else
 			None
 
-let check_type_decl_flag_completion mode flags s =
-	if not !in_display_file || not (is_completion()) then raise Stream.Failure;
+let check_type_decl_flag_completion ctx mode flags s =
+	if not ctx.config.in_display_file || not (is_completion ctx) then raise Stream.Failure;
 	let mode () = match flags with
 		| [] ->
 			SCTypeDecl mode
@@ -407,14 +413,14 @@ let check_type_decl_flag_completion mode flags s =
 			the parser would fail otherwise anyway. *)
 		| Some((Const(Ident name),p)) when display_position#enclosed_in p -> syntax_completion (mode()) (Some name) p
 		| _ -> match flags with
-			| (_,p) :: _ when would_skip_display_position p true s ->
+			| (_,p) :: _ when would_skip_display_position ctx p true s ->
 				let flags = List.map fst flags in
 				syntax_completion (SCAfterTypeFlag flags) None (DisplayPosition.display_position#with_pos p)
 			| _ ->
 				raise Stream.Failure
 
-let check_type_decl_completion mode pmax s =
-	if !in_display_file && is_completion() then begin
+let check_type_decl_completion ctx mode pmax s =
+	if ctx.config.in_display_file && is_completion ctx then begin
 		let pmin = match Stream.peek s with
 			| Some (Eof,_) | None -> max_int
 			| Some tk -> (pos tk).pmin
@@ -427,15 +433,15 @@ let check_type_decl_completion mode pmax s =
 			| Some(e,p) -> None,p
 			| _ -> None,p
 			in
-			delay_syntax_completion (SCTypeDecl mode) so p
+			delay_syntax_completion ctx (SCTypeDecl mode) so p
 		end
 	end
 
-let check_signature_mark e p1 p2 =
-	if not (is_signature_display()) then e
+let check_signature_mark ctx e p1 p2 =
+	if not (is_signature_display ctx) then e
 	else begin
 		let p = punion p1 p2 in
-		if true || not !was_auto_triggered then begin (* TODO: #6383 *)
+		if true || not ctx.config.was_auto_triggered then begin (* TODO: #6383 *)
 			if encloses_position_gt display_position#get p then (mk_display_expr e DKMarked)
 			else e
 		end else begin
@@ -444,8 +450,8 @@ let check_signature_mark e p1 p2 =
 		end
 	end
 
-let convert_abstract_flags flags =
-	ExtList.List.filter_map decl_flag_to_abstract_flag flags
+let convert_abstract_flags ctx flags =
+	ExtList.List.filter_map (decl_flag_to_abstract_flag ctx) flags
 
 let no_keyword what s =
 	match Stream.peek s with

src/syntax/parserConfig.ml

@@ -0,0 +1,12 @@
+open Globals
+open Common
+open DisplayPosition
+
+let default_config defines =
+	Parser.create_config defines false false DMNone false None
+
+let file_parser_config com file =
+	let open DisplayPosition in
+	let in_display = display_position#get <> null_pos in
+	let in_display_file = in_display && display_position#is_in_file (Path.UniqueKey.create file) in
+	Parser.create_config com.defines in_display in_display_file com.display.dms_kind com.parser_state.was_auto_triggered (Some com.parser_state.special_identifier_files)

src/syntax/parserEntry.ml

@@ -209,28 +209,11 @@ class dead_block_collector conds = object(self)
 end
 
 (* parse main *)
-let parse entry ctx code file =
-	let old = Lexer.save() in
-	let restore_cache = TokenCache.clear () in
-	let was_display = !in_display in
-	let was_display_file = !in_display_file in
-	let old_code = !code_ref in
-	let old_macro = !in_macro in
-	code_ref := code;
-	in_display := display_position#get <> null_pos;
-	in_display_file := !in_display && display_position#is_in_file (Path.UniqueKey.create file);
-	syntax_errors := [];
-	let restore =
-		(fun () ->
-			restore_cache ();
-			in_display := was_display;
-			in_macro := old_macro;
-			in_display_file := was_display_file;
-			code_ref := old_code;
-		)
-	in
-	last_doc := None;
-	in_macro := Define.defined ctx Define.Macro;
+let parse config entry lctx code file =
+	let defines = config.defines in
+	let in_macro = Define.defined defines Define.Macro in
+	let ctx = Parser.create_context lctx config in_macro code in
+	let entry = entry ctx in
 	Lexer.skip_header code;
 
 	let sharp_error s p =
@@ -240,25 +223,25 @@ 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
+		syntax_error ctx (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
 		| Comment s ->
 			(* if encloses_resume (pos tk) then syntax_completion SCComment (pos tk); *)
 			let l = String.length s in
-			if l > 0 && s.[0] = '*' then last_doc := Some (String.sub s 1 (l - (if l > 1 && s.[l-1] = '*' then 2 else 1)), (snd tk).pmin);
+			if l > 0 && s.[0] = '*' then ctx.last_doc <- Some (String.sub s 1 (l - (if l > 1 && s.[l-1] = '*' then 2 else 1)), (snd tk).pmin);
 			let tk = next_token() in
 			tk
 		| CommentLine s ->
-			if !in_display_file then begin
+			if ctx.config.in_display_file then begin
 				let p = pos tk in
 				(* Completion at the / should not pick up the comment (issue #9133) *)
-				let p = if is_completion() then {p with pmin = p.pmin + 1} else p in
+				let p = if is_completion ctx then {p with pmin = p.pmin + 1} else p in
 				(* The > 0 check is to deal with the special case of line comments at the beginning of the file (issue #10322) *)
 				if display_position#enclosed_in p && p.pmin > 0 then syntax_completion SCComment None (pos tk);
 			end;
@@ -267,7 +250,7 @@ let parse entry ctx code file =
 			conds#cond_end (snd tk);
 			next_token()
 		| Sharp "elseif" ->
-			let _,(e,pe) = parse_macro_cond sraw in
+			let _,(e,pe) = parse_macro_cond ctx sraw in
 			conds#cond_elseif (e,pe) (snd tk);
 			dbc#open_dead_block pe;
 			let tk = skip_tokens (pos tk) false in
@@ -280,7 +263,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 +271,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)
@@ -296,10 +279,10 @@ let parse entry ctx code file =
 			tk
 
 	and enter_macro is_if p =
-		let tk, e = parse_macro_cond sraw in
+		let tk, e = parse_macro_cond ctx 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,10 +294,10 @@ 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
+			let _,(e,pe) = parse_macro_cond ctx sraw in
 			conds#cond_elseif (e,pe) (snd tk);
 			dbc#open_dead_block pe;
 			skip_tokens p test
@@ -326,12 +309,12 @@ 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)
 		| Sharp "if" ->
-			let _,e = parse_macro_cond sraw in
+			let _,e = parse_macro_cond ctx sraw in
 			conds#cond_if e;
 			dbc#open_dead_block (pos e);
 			let tk = skip_tokens p false in
@@ -345,12 +328,12 @@ 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 _ ->
 		let t = next_token() in
-		TokenCache.add t;
+		DynArray.add ctx.cache t;
 		Some t
 	) in
 	try
@@ -363,77 +346,59 @@ let parse entry ctx code file =
 			| Some (tok,p) ->
 				error (Unexpected tok) p (* This isn't *)
 		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
+		let was_display_file = ctx.config.in_display_file in
+		let pdi = {
+			pd_errors = List.rev ctx.syntax_errors;
+			pd_dead_blocks = dbc#get_dead_blocks;
+			pd_conditions = conds#get_conditions;
+			pd_was_display_file = was_display_file;
+			pd_had_resume = ctx.had_resume;
+			pd_delayed_syntax_completion = ctx.delayed_syntax_completion;
+		} in
 		if was_display_file then
-			ParseSuccess(l,true,pdi)
-		else begin match List.rev !syntax_errors with
-			| [] -> ParseSuccess(l,false,pdi)
+			ParseSuccess(l,pdi)
+		else begin match List.rev ctx.syntax_errors with
+			| [] -> ParseSuccess(l,pdi)
 			| error :: errors -> ParseError(l,error,errors)
 		end
 	with
 		| Stream.Error _
 		| Stream.Failure ->
-			let last = (match Stream.peek s with None -> last_token s | Some t -> t) in
-			Lexer.restore old;
-			restore();
+			let last = (match Stream.peek s with None -> last_token ctx s | Some t -> t) in
 			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 config entry 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 = Lexer.create_temp_ctx p.pfile in
+	let config = if not inlined then begin
 		display_position#reset;
-		in_display_file := false;
-	end;
+		{ config with in_display_file = false }
+	end else
+		config
+	in
 	let result = try
-		parse entry com (Sedlexing.Utf8.from_string s) p.pfile
+		parse config entry lctx (Sedlexing.Utf8.from_string s) p.pfile
 	with Error (e,pe) ->
 		restore();
 		error (error_msg e) (if inlined then pe else p)
 	| Lexer.Error (e,pe) ->
 		restore();
 		error (Lexer.error_msg e) (if inlined then pe else p)
+	| exc ->
+		restore();
+		raise exc
 	in
 	restore();
 	result
 
-let parse_expr_string com s p error inl =
+let parse_expr_string config 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 config expr s p error inl in
 	if inl then
 		result
 	else begin
@@ -442,6 +407,6 @@ let parse_expr_string com s p error inl =
 			(fst e,p)
 		in
 		match result with
-		| ParseSuccess(data,is_display_file,pdi) -> ParseSuccess(loop data,is_display_file,pdi)
+		| ParseSuccess(data,pdi) -> ParseSuccess(loop data,pdi)
 		| ParseError(data,error,errors) -> ParseError(loop data,error,errors)
 	end

src/typing/macroContext.ml

@@ -99,8 +99,8 @@ let make_macro_com_api com mcom p =
 	let timer_level = Timer.level_from_define com.defines Define.MacroTimes in
 	let parse_metadata s p =
 		try
-			match ParserEntry.parse_string Grammar.parse_meta com.defines s null_pos raise_typing_error false with
-			| ParseSuccess(meta,_,_) -> meta
+			match ParserEntry.parse_string (ParserConfig.default_config com.defines) Grammar.parse_meta s null_pos raise_typing_error false with
+			| ParseSuccess(meta,_) -> meta
 			| ParseError(_,_,_) -> raise_typing_error "Malformed metadata string" p
 		with _ ->
 			raise_typing_error "Malformed metadata string" p
@@ -169,9 +169,9 @@ let make_macro_com_api com mcom p =
 			let exit() = com.error_ext <- old in
 
 			try
-				let r = match ParserEntry.parse_expr_string com.defines s p raise_typing_error inl with
-					| ParseSuccess(data,true,_) when inl -> data (* ignore errors when inline-parsing in display file *)
-					| ParseSuccess(data,_,_) -> data
+				let r = match ParserEntry.parse_expr_string (ParserConfig.file_parser_config com p.pfile) s p raise_typing_error inl with
+					| ParseSuccess(data,{pd_was_display_file = true}) when inl -> data (* ignore errors when inline-parsing in display file *)
+					| ParseSuccess(data,_) -> data
 					| ParseError _ -> Interp.exc_string "Invalid expression"
 				in
 				exit();
@@ -187,13 +187,13 @@ let make_macro_com_api com mcom p =
 				raise e
 		);
 		parse = (fun entry s ->
-			match ParserEntry.parse_string entry com.defines s null_pos raise_typing_error false with
-			| ParseSuccess(r,_,_) -> r
+			match ParserEntry.parse_string (ParserConfig.default_config com.defines) entry s null_pos raise_typing_error false with
+			| ParseSuccess(r,_) -> r
 			| ParseError(_,(msg,p),_) -> Parser.error msg 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"
@@ -240,7 +240,7 @@ let make_macro_com_api com mcom p =
 			null_module
 		);
 		format_string = (fun s p ->
-			FormatString.format_string com.defines s p (fun e p -> (e,p))
+			FormatString.format_string (ParserConfig.file_parser_config com p.pfile) s p (fun e p -> (e,p))
 		);
 		cast_or_unify = (fun t e p ->
 			Interp.exc_string "unsupported"
@@ -302,8 +302,8 @@ let make_macro_com_api com mcom p =
 let make_macro_api ctx mctx p =
 	let parse_metadata s p =
 		try
-			match ParserEntry.parse_string Grammar.parse_meta ctx.com.defines s null_pos raise_typing_error false with
-			| ParseSuccess(meta,_,_) -> meta
+			match ParserEntry.parse_string (ParserConfig.default_config mctx.com.defines) Grammar.parse_meta s null_pos raise_typing_error false with
+			| ParseSuccess(meta,_) -> meta
 			| ParseError(_,_,_) -> raise_typing_error "Malformed metadata string" p
 		with _ ->
 			raise_typing_error "Malformed metadata string" p
@@ -1023,8 +1023,8 @@ let resolve_init_macro com e =
 	let p = fake_pos ("--macro " ^ e) in
 	let e = try
 		if String.get e (String.length e - 1) = ';' then raise_typing_error "Unexpected ;" p;
-		begin match ParserEntry.parse_expr_string com.defines e p raise_typing_error false with
-		| ParseSuccess(data,_,_) -> data
+		begin match ParserEntry.parse_expr_string (ParserConfig.default_config com.defines) e p raise_typing_error false with
+		| ParseSuccess(data,_) -> data
 		| ParseError(_,(msg,p),_) -> (Parser.error msg p)
 		end
 	with err ->

src/typing/typeloadFunction.ml

@@ -63,7 +63,7 @@ let type_function ctx (args : function_arguments) ret e do_display p =
 	end else begin
 		let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.f.curfield.cf_meta in
 		if is_display_debug then print_endline ("before processing:\n" ^ (Expr.dump_with_pos e));
-		let e = if !Parser.had_resume then e else Display.preprocess_expr ctx.com e in
+		let e = if ctx.com.parser_state.had_parser_resume then e else Display.preprocess_expr ctx.com e in
 		if is_display_debug then print_endline ("after processing:\n" ^ (Expr.dump_with_pos e));
 		type_expr ctx e NoValue
 	end in

src/typing/typeloadModule.ml

@@ -294,7 +294,7 @@ module ModuleLevel = struct
 			with Not_found ->
 				if Sys.file_exists path then begin
 					let _,r = match !TypeloadParse.parse_hook com (ClassPaths.create_resolved_file path com.empty_class_path) p with
-						| ParseSuccess(data,_,_) -> data
+						| ParseSuccess(data,_) -> data
 						| ParseError(_,(msg,p),_) -> Parser.error msg p
 					in
 					List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> raise_typing_error "Only import and using is allowed in import.hx files" p) r;

src/typing/typeloadParse.ml

@@ -31,21 +31,24 @@ 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 (ParserConfig.file_parser_config com file) Grammar.parse_file (Lexer.create_file_ctx file) lexbuf file
 	with
 		| Sedlexing.MalFormed ->
 			raise_typing_error "Malformed file. Source files must be encoded with UTF-8." (file_pos file)
 		| e ->
 			raise e
 	in
-	begin match !Parser.display_mode,parse_result with
+	begin match com.display.dms_kind,parse_result with
 		| DMModuleSymbols (Some ""),_ -> ()
-		| DMModuleSymbols filter,(ParseSuccess(data,_,_)) when filter = None && DisplayPosition.display_position#is_in_file (com.file_keys#get file) ->
+		| DMModuleSymbols filter,(ParseSuccess(data,_)) when filter = None && DisplayPosition.display_position#is_in_file (com.file_keys#get file) ->
 			let ds = DocumentSymbols.collect_module_symbols None (filter = None) data in
 			DisplayException.raise_module_symbols (DocumentSymbols.Printer.print_module_symbols com [file,ds] filter);
+		| _,ParseSuccess(_,({pd_was_display_file = true} as pdi)) ->
+			if pdi.pd_had_resume then
+				com.parser_state.had_parser_resume <- true;
+			Atomic.set com.parser_state.delayed_syntax_completion pdi.pd_delayed_syntax_completion
 		| _ ->
 			()
 	end;
@@ -124,7 +127,7 @@ let resolve_module_file com m remap p =
 			| [] -> []
 		in
 		let meta = match parse_result with
-			| ParseSuccess((_,decls),_,_) -> loop decls
+			| ParseSuccess((_,decls),_) -> loop decls
 			| ParseError _ -> []
 		in
 		if not (Meta.has Meta.NoPackageRestrict meta) then begin
@@ -229,7 +232,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
@@ -269,8 +272,8 @@ let handle_parser_result com p result =
 				com.has_error <- true
 	in
 	match result with
-		| ParseSuccess(data,is_display_file,pdi) ->
-			if is_display_file then begin
+		| ParseSuccess(data,pdi) ->
+			if pdi.pd_was_display_file then begin
 				begin match pdi.pd_errors with
 				| (msg,p) :: _ -> handle_parser_error msg p
 				| [] -> ()

src/typing/typer.ml

@@ -626,7 +626,7 @@ and type_vars ctx vl p =
 		mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos
 
 and format_string ctx s p =
-	FormatString.format_string ctx.com.defines s p (fun enext p ->
+	FormatString.format_string (ParserConfig.file_parser_config ctx.com p.pfile) s p (fun enext p ->
 		if ctx.f.in_display && DisplayPosition.display_position#enclosed_in p then
 			Display.preprocess_expr ctx.com (enext,p)
 		else

src/typing/typerDisplay.ml

@@ -491,7 +491,7 @@ and display_expr ctx e_ast e dk mode with_type p =
 		raise_positions pl
 	| DMTypeDefinition ->
 		raise_position_of_type ctx e.etype
-	| DMDefault when not (!Parser.had_resume)->
+	| DMDefault when not ctx.com.parser_state.had_parser_resume ->
 		let display_fields e_ast e1 so =
 			let l = match so with None -> 0 | Some s -> String.length s in
 			let fields = DisplayFields.collect ctx e_ast e1 dk with_type p in