[parser] remove mstack, use condition_handler

src/syntax/parser.ml

@@ -22,11 +22,17 @@ open Globals
 open DisplayTypes.DisplayMode
 open DisplayPosition
 
+type preprocessor_error =
+	| InvalidEnd
+	| InvalidElse
+	| InvalidElseif
+	| UnclosedConditional
+
 type error_msg =
 	| Unexpected of token
 	| Duplicate_default
 	| Missing_semicolon
-	| Unclosed_conditional
+	| Preprocessor_error of preprocessor_error
 	| Unimplemented
 	| Missing_type
 	| Expected of string list
@@ -70,7 +76,13 @@ let error_msg = function
 	| Unexpected t -> "Unexpected "^(s_token t)
 	| Duplicate_default -> "Duplicate default"
 	| Missing_semicolon -> "Missing ;"
-	| Unclosed_conditional -> "Unclosed conditional compilation block"
+	| Preprocessor_error ppe ->
+		begin match ppe with
+			| UnclosedConditional -> "Unclosed conditional compilation block"
+			| InvalidEnd -> "Invalid #end"
+			| InvalidElse -> "Invalid #else"
+			| InvalidElseif -> "Invalid #elseif"
+		end
 	| Unimplemented -> "Not implemented for current platform"
 	| Missing_type -> "Missing type declaration"
 	| Expected sl -> "Expected " ^ (String.concat " or " sl)

src/syntax/parserEntry.ml

@@ -149,27 +149,30 @@ class condition_handler = object(self)
 		self#cond_if' e;
 		depths <- 1 :: depths
 
-	method cond_else = match conditional_stack with
+	method cond_else (p : pos) =
+		match conditional_stack with
 		| e :: el ->
 			conditional_stack <- (self#negate e) :: el
 		| [] ->
-			die "" __LOC__
+			error (Preprocessor_error InvalidElse) p
 
-	method cond_elseif (e : expr) =
-		self#cond_else;
+	method cond_elseif (e : expr) (p : pos) =
+		self#cond_else p;
 		self#cond_if' e;
 		match depths with
-		| [] -> die "" __LOC__
+		| [] ->
+			error (Preprocessor_error InvalidElseif) p
 		| depth :: depths' ->
 			depths <- (depth + 1) :: depths'
 
-	method cond_end =
+	method cond_end (p : pos) =
 		let rec loop d el =
 			if d = 0 then el
 			else loop (d - 1) (List.tl el)
 		in
 		match depths with
-			| [] -> die "" __LOC__
+			| [] ->
+				error (Preprocessor_error InvalidEnd) p
 			| depth :: depths' ->
 				conditional_stack <- loop depth conditional_stack;
 				depths <- depths'
@@ -224,7 +227,6 @@ let parse entry ctx code file =
 			code_ref := old_code;
 		)
 	in
-	let mstack = ref [] in
 	last_doc := None;
 	in_macro := Define.defined ctx Define.Macro;
 	Lexer.skip_header code;
@@ -237,6 +239,9 @@ 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 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)
 
 	and process_token tk =
@@ -257,31 +262,19 @@ let parse entry ctx code file =
 			end;
 			next_token()
 		| Sharp "end" ->
-			(match !mstack with
-			| [] -> tk
-			| _ :: l ->
-				conds#cond_end;
-				mstack := l;
-				next_token())
+			conds#cond_end (snd tk);
+			next_token()
 		| Sharp "elseif" ->
-			(match !mstack with
-			| [] -> tk
-			| _ :: l ->
-				let _,(e,pe) = parse_macro_cond sraw in
-				conds#cond_elseif (e,pe);
-				dbc#open_dead_block pe;
-				mstack := l;
-				let tk = skip_tokens (pos tk) false in
-				process_token tk)
+			let _,(e,pe) = parse_macro_cond sraw in
+			conds#cond_elseif (e,pe) (snd tk);
+			dbc#open_dead_block pe;
+			let tk = skip_tokens (pos tk) false in
+			process_token tk
 		| Sharp "else" ->
-			(match !mstack with
-			| [] -> tk
-			| _ :: l ->
-				conds#cond_else;
-				dbc#open_dead_block (pos tk);
-				mstack := l;
-				let tk = skip_tokens (pos tk) false in
-				process_token tk)
+			conds#cond_else (snd tk);
+			dbc#open_dead_block (pos tk);
+			let tk = skip_tokens (pos tk) false in
+			process_token tk
 		| Sharp "if" ->
 			process_token (enter_macro true (snd tk))
 		| Sharp "error" ->
@@ -302,10 +295,9 @@ 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 else conds#cond_elseif) e;
+		(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
-			mstack := p :: !mstack;
 			tk
 		end else begin
 			dbc#open_dead_block (pos e);
@@ -315,24 +307,23 @@ let parse entry ctx code file =
 	and skip_tokens_loop p test tk =
 		match fst tk with
 		| Sharp "end" ->
-			conds#cond_end;
+			conds#cond_end (snd tk);
 			dbc#close_dead_block (pos tk);
 			Lexer.token code
 		| Sharp "elseif" when not test ->
 			dbc#close_dead_block (pos tk);
 			let _,(e,pe) = parse_macro_cond sraw in
-			conds#cond_elseif (e,pe);
+			conds#cond_elseif (e,pe) (snd tk);
 			dbc#open_dead_block pe;
 			skip_tokens p test
 		| Sharp "else" when not test ->
-			conds#cond_else;
+			conds#cond_else (snd tk);
 			dbc#close_dead_block (pos tk);
 			dbc#open_dead_block (pos tk);
 			skip_tokens p test
 		| Sharp "else" ->
-			conds#cond_else;
+			conds#cond_else (snd tk);
 			dbc#close_dead_block (pos tk);
-			mstack := snd tk :: !mstack;
 			Lexer.token code
 		| Sharp "elseif" ->
 			dbc#close_dead_block (pos tk);
@@ -348,7 +339,7 @@ let parse entry ctx code file =
 		| Sharp s ->
 			sharp_error s (pos tk)
 		| Eof ->
-			syntax_error Unclosed_conditional ~pos:(Some p) sraw tk
+			preprocessor_error UnclosedConditional p tk
 		| _ ->
 			skip_tokens p test
 
@@ -362,7 +353,6 @@ let parse entry ctx code file =
 	) in
 	try
 		let l = entry s in
-		(match !mstack with p :: _ -> syntax_error Unclosed_conditional ~pos:(Some p) sraw () | _ -> ());
 		let was_display_file = !in_display_file in
 		restore();
 		Lexer.restore old;