Add support for parser warnings

src/compiler/displayProcessing.ml

@@ -217,7 +217,7 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 
 let load_display_file_standalone (ctx : Typecore.typer) file =
 	let com = ctx.com in
-	let pack,decls = TypeloadParse.parse_module_file com (ClassPaths.create_resolved_file file ctx.com.empty_class_path) null_pos in
+	let (pack,decls),_ = TypeloadParse.parse_module_file com (ClassPaths.create_resolved_file file ctx.com.empty_class_path) null_pos in
 	let path = Path.FilePath.parse file in
 	let name = match path.file_name with
 		| None -> "?DISPLAY"
@@ -239,7 +239,7 @@ let load_display_content_standalone (ctx : Typecore.typer) input =
 	let file = file_input_marker in
 	let p = file_pos file in
 	let parsed = TypeloadParse.parse_file_from_string com file p input in
-	let pack,decls = TypeloadParse.handle_parser_result com p parsed in
+	let (pack,decls),_ = TypeloadParse.handle_parser_result com p parsed in
 	ignore(TypeloadModule.type_module ctx.com ctx.g (pack,"?DISPLAY") file ~dont_check_path:true decls p)
 
 (* 4. Display processing before typing *)

src/compiler/server.ml

@@ -242,8 +242,8 @@ let check_module sctx com m_path m_extra p =
 			let cfile = cc#find_file fkey in
 			(* We must use the module path here because the file path is absolute and would cause
 				positions in the parsed declarations to differ. *)
-			let new_data = TypeloadParse.parse_module com m_path p in
-			cfile.c_decls <> snd new_data
+			let _,decls,_ = TypeloadParse.parse_module com m_path p in
+			cfile.c_decls <> decls
 		with Not_found ->
 			true
 	in

src/context/display/displayToplevel.ml

@@ -129,7 +129,7 @@ let read_class_paths com timer =
 	explore_class_paths com timer (com.class_paths#filter (fun cp -> cp#path <> "")) true (fun _ -> ()) (fun file path ->
 		(* Don't parse the display file as that would maybe overwrite the content from stdin with the file contents. *)
 		if not (DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then begin
-			let rfile,_,pack,_ = Display.parse_module' com path Globals.null_pos in
+			let rfile,_,pack,_,_ = Display.parse_module' com path Globals.null_pos in
 			if pack <> fst path then begin
 				let file_key = com.file_keys#get file in
 				(CommonCache.get_cache com)#remove_file_for_real file_key

src/syntax/parser.ml

@@ -84,6 +84,7 @@ type parser_config = {
 type parser_ctx = {
 	lexer_ctx : Lexer.lexer_ctx;
 	mutable syntax_errors : (error_msg * pos) list;
+	mutable syntax_warnings : (Warning.warning * pos) list;
 	mutable last_doc : (string * int) option;
 	in_macro : bool;
 	code : Sedlexing.lexbuf;
@@ -114,9 +115,11 @@ let error_msg = function
 type parse_data = string list * (type_def * pos) list
 
 type parse_error = (error_msg * pos)
+type parse_warning = (Warning.warning * pos)
 
 type parser_display_information = {
 	pd_errors : parse_error list;
+	pd_warnings : parse_warning list;
 	pd_dead_blocks : (pos * expr) list;
 	pd_conditions : expr list;
 	pd_was_display_file : bool;
@@ -131,6 +134,7 @@ type 'a parse_result =
 let create_context lexer_ctx config in_macro code = {
 	lexer_ctx;
 	syntax_errors = [];
+	syntax_warnings = [];
 	last_doc = None;
 	in_macro;
 	code;
@@ -194,6 +198,14 @@ 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 syntax_warning_with_pos ctx warning p =
+	let p = if p.pmax = max_int then {p with pmax = p.pmin + 1} else p in
+	ctx.syntax_warnings <- (warning,p) :: ctx.syntax_warnings
+
+let syntax_warning ctx warning ?(pos=None) s =
+	let p = (match pos with Some p -> p | None -> next_pos ctx s) in
+	syntax_warning_with_pos ctx warning p
+
 let handle_stream_error ctx msg s =
 	let err,pos = if msg = "Parse error." then begin
 		let tk,pos = next_token ctx s in

src/syntax/parserEntry.ml

@@ -349,6 +349,7 @@ let parse config entry lctx code file =
 		let was_display_file = ctx.config.in_display_file in
 		let pdi = {
 			pd_errors = List.rev ctx.syntax_errors;
+			pd_warnings = List.rev ctx.syntax_warnings;
 			pd_dead_blocks = dbc#get_dead_blocks;
 			pd_conditions = conds#get_conditions;
 			pd_was_display_file = was_display_file;

src/typing/typeloadModule.ml

@@ -308,14 +308,15 @@ module ModuleLevel = struct
 				r
 			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
+					let (_,r),warnings = match !TypeloadParse.parse_hook com (ClassPaths.create_resolved_file path com.empty_class_path) p with
+						| ParseSuccess(data,pdi) -> data,pdi.pd_warnings
 						| 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;
 					let m_import = make_import_module path r in
 					add_module com m_import p;
 					add_dependency m m_import MDepFromImport;
+					List.iter (fun (w, p) -> module_warning com m WIfDisplay [] (Warning.warning_obj WIfDisplay).w_doc p) warnings;
 					r
 				end else begin
 					let r = [] in
@@ -829,10 +830,10 @@ and load_module' com g m p =
 			if com.module_nonexistent_lut#mem m then raise_not_found();
 			if g.load_only_cached_modules then raise_not_found();
 			let is_extern = ref false in
-			let file, decls = try
+			let file, decls, warnings = try
 				(* Try parsing *)
-				let rfile,decls = TypeloadParse.parse_module com m p in
-				rfile.file,decls
+				let rfile,decls,warnings = TypeloadParse.parse_module com m p in
+				rfile.file,decls,warnings
 			with Not_found ->
 				(* Nothing to parse, try loading extern type *)
 				let rec loop = function
@@ -842,13 +843,15 @@ and load_module' com g m p =
 					| (file,load) :: l ->
 						match load m p with
 						| None -> loop l
-						| Some (_,a) -> file, a
+						| Some (_,a) -> file, a, []
 				in
 				is_extern := true;
 				loop com.load_extern_type
 			in
 			let is_extern = !is_extern in
-			type_module com g m file ~is_extern decls p
+			let m = type_module com g m file ~is_extern decls p in
+			List.iter (fun (w, p) -> module_warning com m WIfDisplay [] (Warning.warning_obj WIfDisplay).w_doc p) warnings;
+			m
 
 let load_module ?(origin:module_dep_origin = MDepFromTyping) ctx m p =
 	let m2 = load_module' ctx.com ctx.g m p in

src/typing/typeloadParse.ml

@@ -281,10 +281,10 @@ let handle_parser_result com p result =
 				end;
 				PdiHandler.handle_pdi com pdi;
 			end;
-			data
+			data,pdi.pd_warnings
 		| ParseError(data,(msg,p),_) ->
 			handle_parser_error msg p;
-			data
+			data,[]
 
 let parse_module_file com file p =
 	handle_parser_result com p ((!parse_hook) com file p)
@@ -292,11 +292,11 @@ let parse_module_file com file p =
 let parse_module' com m p =
 	let remap = ref (fst m) in
 	let rfile = resolve_module_file com m remap p in
-	let pack,decls = parse_module_file com rfile p in
-	rfile,remap,pack,decls
+	let (pack,decls),warnings = parse_module_file com rfile p in
+	rfile,remap,pack,decls,warnings
 
 let parse_module com m p =
-	let rfile,remap,pack,decls = parse_module' com m p in
+	let rfile,remap,pack,decls,warnings = parse_module' com m p in
 	if pack <> !remap then begin
 		let spack m = if m = [] then "`package;`" else "`package " ^ (String.concat "." m) ^ ";`" in
 		if p == null_pos then
@@ -304,7 +304,7 @@ let parse_module com m p =
 		else
 			display_error com (spack pack ^ " in " ^ rfile.file ^ " should be " ^ spack (fst m)) {p with pmax = p.pmin}
 	end;
-	rfile, if !remap <> fst m then
+	rfile, (if !remap <> fst m then
 		(* build typedefs to redirect to real package *)
 		List.rev (List.fold_left (fun acc (t,p) ->
 			let build f d =
@@ -340,4 +340,4 @@ let parse_module com m p =
 			| EImport _ | EUsing _ -> acc
 		) [(EImport (List.map (fun s -> s,null_pos) (!remap @ [snd m]),INormal),null_pos)] decls)
 	else
-		decls
+		decls), warnings