urgh

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;
@@ -2398,9 +2398,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/parser.ml

@@ -22,6 +22,10 @@ open Globals
 open DisplayTypes.DisplayMode
 open DisplayPosition
 
+type parser_ctx = {
+	lexer_ctx : Lexer.lexer_ctx;
+}
+
 type preprocessor_error =
 	| InvalidEnd
 	| InvalidElse
@@ -105,6 +109,10 @@ type 'a parse_result =
 	(* Parsed non-display file with errors *)
 	| ParseError of 'a * parse_error * parse_error list
 
+let create_context lexer_ctx = {
+	lexer_ctx;
+}
+
 let s_decl_flag = function
 	| DPrivate -> "private"
 	| DExtern -> "extern"
@@ -133,21 +141,21 @@ module TokenCache = struct
 		(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)
 
-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)
+let next_pos ctx s = pos (next_token ctx s)
 
 (* Global state *)
 
@@ -184,18 +192,18 @@ let syntax_error_with_pos error_msg p v =
 	syntax_errors := (error_msg,p) :: !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
+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 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 =
 	(* do the peek first to make sure we fetch the doc *)
@@ -264,7 +272,7 @@ 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 =
+let would_skip_display_position ctx p1 plus_one s =
 	if !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
@@ -338,16 +346,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 =
-	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 handle_xml_literal ctx p1 =
+	Lexer.reset ctx.lexer_ctx;
+	let i = Lexer.lex_xml ctx.lexer_ctx p1.pmin !code_ref 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 +366,22 @@ let mk_null_expr p = (EConst(Ident "null"),p)
 
 let mk_display_expr e dk = (EDisplay(e,dk),(pos e))
 
-let is_completion () =
+let is_completion ctx =
 	!display_mode = DMDefault
 
-let is_signature_display () =
+let is_signature_display ctx =
 	!display_mode = DMSignature
 
-let check_resume p fyes fno =
+let check_resume ctx p fyes fno =
 	if is_completion () && !in_display_file && p.pmax = (display_position#get).pmin then begin
 		had_resume := true;
 		fyes()
 	end else
 		fno()
 
-let check_resume_range p s fyes fno =
+let check_resume_range ctx p s fyes fno =
 	if is_completion () && !in_display_file then begin
-		let pnext = next_pos s in
+		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,18 +389,18 @@ 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 =
+let check_type_decl_flag_completion ctx mode flags s =
 	if not !in_display_file || not (is_completion()) then raise Stream.Failure;
 	let mode () = match flags with
 		| [] ->
@@ -407,13 +415,13 @@ 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 =
+let check_type_decl_completion ctx mode pmax s =
 	if !in_display_file && is_completion() then begin
 		let pmin = match Stream.peek s with
 			| Some (Eof,_) | None -> max_int
@@ -431,7 +439,7 @@ let check_type_decl_completion mode pmax s =
 		end
 	end
 
-let check_signature_mark e p1 p2 =
+let check_signature_mark ctx e p1 p2 =
 	if not (is_signature_display()) then e
 	else begin
 		let p = punion p1 p2 in

src/syntax/parserEntry.ml

@@ -210,6 +210,8 @@ end
 
 (* parse main *)
 let parse entry lctx defines code file =
+	let pctx = Parser.create_context lctx in
+	let entry = entry pctx in
 	let restore_cache = TokenCache.clear () in
 	let was_display = !in_display in
 	let was_display_file = !in_display_file in
@@ -241,7 +243,7 @@ let parse entry lctx defines code file =
 	let dbc = new dead_block_collector conds 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 pctx (Preprocessor_error ppe) ~pos:(Some pos) sraw tk
 	in
 	let rec next_token() = process_token (Lexer.token lctx code)
 
@@ -266,7 +268,7 @@ let parse entry lctx defines 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 pctx sraw in
 			conds#cond_elseif (e,pe) (snd tk);
 			dbc#open_dead_block pe;
 			let tk = skip_tokens (pos tk) false in
@@ -295,7 +297,7 @@ let parse entry lctx defines code file =
 			tk
 
 	and enter_macro is_if p =
-		let tk, e = parse_macro_cond sraw in
+		let tk, e = parse_macro_cond pctx sraw in
 		(if is_if then conds#cond_if e else conds#cond_elseif e p);
 		let tk = (match tk with None -> Lexer.token lctx code | Some tk -> tk) in
 		if is_true (eval defines e) then begin
@@ -313,7 +315,7 @@ let parse entry lctx defines code file =
 			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 pctx sraw in
 			conds#cond_elseif (e,pe) (snd tk);
 			dbc#open_dead_block pe;
 			skip_tokens p test
@@ -330,7 +332,7 @@ let parse entry lctx defines code file =
 			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 pctx sraw in
 			conds#cond_if e;
 			dbc#open_dead_block (pos e);
 			let tk = skip_tokens p false in
@@ -374,7 +376,7 @@ let parse entry lctx defines code file =
 	with
 		| Stream.Error _
 		| Stream.Failure ->
-			let last = (match Stream.peek s with None -> last_token s | Some t -> t) in
+			let last = (match Stream.peek s with None -> last_token pctx s | Some t -> t) in
 			restore();
 			error (Unexpected (fst last)) (pos last)
 		| e ->