diff --git a/compiler/mercury_compile_augment.m b/compiler/mercury_compile_augment.m index 8e05e9769..5c2d2dc31 100644 --- a/compiler/mercury_compile_augment.m +++ b/compiler/mercury_compile_augment.m @@ -76,6 +76,7 @@ :- import_module parse_tree.module_baggage. :- import_module parse_tree.module_cmds. :- import_module parse_tree.prog_data. +:- import_module parse_tree.write_error_spec. :- import_module recompilation.usage. :- import_module recompilation.used_file. :- import_module top_level.mercury_compile_front_end. @@ -231,10 +232,35 @@ process_augmented_module(ProgressStream, ErrorStream, Globals, !DumpInfo, !HaveParseTreeMaps, !MaybeWrittenSpecs, !IO) :- make_hlds_pass(ProgressStream, ErrorStream, Globals, OpModeAugment, InvokedByMmcMake, Baggage, AugCompUnit, - HLDS1, QualInfo, MaybeTimestampMap, UndefTypes, UndefModes, - PreHLDSErrors, !DumpInfo, !HaveParseTreeMaps, !MaybeWrittenSpecs, !IO), + HLDS1, QualInfo, MaybeTimestampMap, MakeHldsResult, + !DumpInfo, !HaveParseTreeMaps, !MaybeWrittenSpecs, !IO), + globals.lookup_bool_option(Globals, verbose, Verbose), + maybe_write_not_yet_written_specs(ErrorStream, Globals, Verbose, + !MaybeWrittenSpecs, !IO), + MakeHldsResult = make_hlds_result(InvalidTypeSpecs, InvalidInstModeSpecs, + OptBlockingSpecs, ExpandSpecs, EventSetSpecs), + % All of the errors in ExpandSpecs report errors that make some type + % definition invalid. + % Any errors with the definition of events are likely to lead to + % spurious errors when typechecking event calls. Stopping before + % typechecking will prevent the compiler from complaining about them. + BlockingTypeSpecs = InvalidTypeSpecs ++ ExpandSpecs ++ EventSetSpecs, + ( + BlockingTypeSpecs = [_ | _], + % We can't continue after an undefined type error, since typecheck + % would get internal errors. + maybe_write_string(ProgressStream, Verbose, + "% Program contains undefined type error(s).\n", !IO), + ExtraObjFiles = [], + io.set_exit_status(1, !IO) + ; + BlockingTypeSpecs = [], + SpecsSoFar = maybe_written_specs_to_specs(!.MaybeWrittenSpecs), + SemanticErrors = contains_errors(Globals, SpecsSoFar), + OptBlockingErrors = contains_errors(Globals, OptBlockingSpecs), + bool.or(SemanticErrors, OptBlockingErrors, PreHLDSErrors), frontend_pass(ProgressStream, ErrorStream, OpModeAugment, QualInfo, - UndefTypes, UndefModes, PreHLDSErrors, FrontEndErrors, + InvalidInstModeSpecs, PreHLDSErrors, FrontEndErrors, HLDS1, HLDS20, !DumpInfo, !MaybeWrittenSpecs, !IO), io.get_exit_status(ExitStatus, !IO), ( if @@ -244,18 +270,21 @@ process_augmented_module(ProgressStream, ErrorStream, Globals, contains_errors(Globals, SpecsSofar) = no, ExitStatus = 0 then - process_augmented_module_after_front_end(ProgressStream, ErrorStream, - Globals, OpModeAugment, Baggage, MaybeTimestampMap, HLDS20, - ExtraObjFiles, !DumpInfo, !MaybeWrittenSpecs, !IO) + process_augmented_module_after_front_end(ProgressStream, + ErrorStream, Globals, OpModeAugment, Baggage, + MaybeTimestampMap, HLDS20, ExtraObjFiles, + !DumpInfo, !MaybeWrittenSpecs, !IO) else % If the number of errors is > 0, make sure that the compiler - % exits with a non-zero exit status. + % exits with a non-zero exit status. However, do not override + % an exit status that may already be nonzero. ( if ExitStatus = 0 then io.set_exit_status(1, !IO) else true ), ExtraObjFiles = [] + ) ). :- pred process_augmented_module_after_front_end(io.text_output_stream::in, diff --git a/compiler/mercury_compile_front_end.m b/compiler/mercury_compile_front_end.m index b96ffba0a..08567e01c 100644 --- a/compiler/mercury_compile_front_end.m +++ b/compiler/mercury_compile_front_end.m @@ -29,16 +29,18 @@ :- import_module libs. :- import_module libs.op_mode. :- import_module parse_tree. +:- import_module parse_tree.error_spec. :- import_module parse_tree.error_util. :- import_module bool. :- import_module io. +:- import_module list. :- import_module maybe. %---------------------------------------------------------------------------% :- pred frontend_pass(io.text_output_stream::in, io.text_output_stream::in, - op_mode_augment::in, qual_info::in, bool::in, bool::in, + op_mode_augment::in, qual_info::in, list(error_spec)::in, bool::in, bool::out, module_info::in, module_info::out, dump_info::in, dump_info::out, maybe_written_specs::in, maybe_written_specs::out, io::di, io::uo) is det. @@ -139,7 +141,6 @@ :- import_module libs.options. :- import_module mdbcomp. :- import_module mdbcomp.sym_name. -:- import_module parse_tree.error_spec. :- import_module parse_tree.file_names. :- import_module parse_tree.find_module. :- import_module parse_tree.maybe_error. @@ -157,7 +158,6 @@ :- import_module benchmarking. :- import_module int. -:- import_module list. :- import_module map. :- import_module pair. :- import_module require. @@ -169,34 +169,16 @@ %---------------------------------------------------------------------------% frontend_pass(ProgressStream, ErrorStream, OpModeAugment, QualInfo0, - FoundUndefTypeError, FoundUndefModeError, !FoundError, + FoundUndefModeError, !FoundError, !HLDS, !DumpInfo, !MaybeWrittenSpecs, !IO) :- - % We can't continue after an undefined type error, since typecheck - % would get internal errors. module_info_get_globals(!.HLDS, Globals), - globals.lookup_bool_option(Globals, verbose, Verbose), - ( - FoundUndefTypeError = yes, - % We can't continue after an undefined type error, because if we did, - % typecheck could get internal errors. - !:FoundError = yes, - maybe_write_not_yet_written_specs(ErrorStream, Globals, Verbose, - !MaybeWrittenSpecs, !IO), - maybe_write_string(ProgressStream, Verbose, - "% Program contains undefined type error(s).\n", !IO), - io.set_exit_status(1, !IO) - ; - FoundUndefTypeError = no, - maybe_write_not_yet_written_specs(ErrorStream, Globals, Verbose, - !MaybeWrittenSpecs, !IO), - - % It would be nice to move the decide_type_repns pass later, - % possibly all the way to the end of the semantic analysis passes, - % to make sure that semantic analysis does not depend on implementation - % details. + % It would be nice to move the decide_type_repns pass later, possibly + % all the way to the end of the semantic analysis passes, to make sure + % that semantic analysis does not depend on implementation details. % % Unfortunately, this would require a large amount of extra work, % for reasons that are documented at the top of du_type_layout.m. + globals.lookup_bool_option(Globals, verbose, Verbose), globals.lookup_bool_option(Globals, statistics, Stats), decide_type_repns_pass(ProgressStream, ErrorStream, Verbose, Stats, !HLDS, !MaybeWrittenSpecs, !IO), @@ -222,17 +204,16 @@ frontend_pass(ProgressStream, ErrorStream, OpModeAugment, QualInfo0, frontend_pass_after_typeclass_check(ProgressStream, ErrorStream, OpModeAugment, FoundUndefModeError, !FoundError, !HLDS, !DumpInfo, !MaybeWrittenSpecs, !IO) - ) ). :- pred frontend_pass_after_typeclass_check(io.text_output_stream::in, io.text_output_stream::in, op_mode_augment::in, - bool::in, bool::in, bool::out, + list(error_spec)::in, bool::in, bool::out, module_info::in, module_info::out, dump_info::in, dump_info::out, maybe_written_specs::in, maybe_written_specs::out, io::di, io::uo) is det. frontend_pass_after_typeclass_check(ProgressStream, ErrorStream, OpModeAugment, - FoundUndefModeError, !FoundError, !HLDS, !DumpInfo, + InvalidInstModeSpecs, !FoundError, !HLDS, !DumpInfo, !MaybeWrittenSpecs, !IO) :- module_info_get_globals(!.HLDS, Globals), globals.lookup_bool_option(Globals, verbose, Verbose), @@ -254,7 +235,7 @@ frontend_pass_after_typeclass_check(ProgressStream, ErrorStream, OpModeAugment, % We can't continue if the type inference iteration limit was exceeded % because the code to resolve overloading in post_typecheck.m (called by % purity.m) could abort. - ( if FoundUndefModeError = yes then + ( if InvalidInstModeSpecs = [_ | _] then !:FoundError = yes, maybe_write_string(ProgressStream, Verbose, "% Program contains undefined inst or undefined mode error(s).\n", @@ -342,7 +323,7 @@ frontend_pass_after_typeclass_check(ProgressStream, ErrorStream, OpModeAugment, !:FoundError = yes else frontend_pass_after_typecheck(ProgressStream, ErrorStream, - OpModeAugment, Verbose, Stats, Globals, FoundUndefModeError, + OpModeAugment, Globals, Verbose, Stats, InvalidInstModeSpecs, !FoundError, !HLDS, !DumpInfo, !MaybeWrittenSpecs, !IO) ) ). @@ -465,13 +446,13 @@ do_typecheck(ProgressStream, ErrorStream, Verbose, Stats, Globals, maybe_dump_hlds(ProgressStream, !.HLDS, 15, "typecheck", !DumpInfo, !IO). :- pred frontend_pass_after_typecheck(io.text_output_stream::in, - io.text_output_stream::in, op_mode_augment::in, bool::in, bool::in, - globals::in, bool::in, bool::in, bool::out, + io.text_output_stream::in, op_mode_augment::in, globals::in, + bool::in, bool::in, list(error_spec)::in, bool::in, bool::out, module_info::in, module_info::out, dump_info::in, dump_info::out, maybe_written_specs::in, maybe_written_specs::out, io::di, io::uo) is det. frontend_pass_after_typecheck(ProgressStream, ErrorStream, OpModeAugment, - Verbose, Stats, Globals, FoundUndefModeError, + Globals, Verbose, Stats, InvalidInstModeSpecs, !FoundError, !HLDS, !DumpInfo, !MaybeWrittenSpecs, !IO) :- % We invoke purity check even if --typecheck-only was specified, % because the resolution of predicate and function overloading @@ -524,7 +505,7 @@ frontend_pass_after_typecheck(ProgressStream, ErrorStream, OpModeAugment, ( if !.FoundError = no, - FoundUndefModeError = no + InvalidInstModeSpecs = [] then MakeOptIntEnabled = yes else diff --git a/compiler/mercury_compile_make_hlds.m b/compiler/mercury_compile_make_hlds.m index e2e1a7b40..61409bb06 100644 --- a/compiler/mercury_compile_make_hlds.m +++ b/compiler/mercury_compile_make_hlds.m @@ -25,22 +25,31 @@ :- import_module libs.globals. :- import_module libs.op_mode. :- import_module parse_tree. +:- import_module parse_tree.error_spec. :- import_module parse_tree.error_util. :- import_module parse_tree.module_baggage. :- import_module parse_tree.prog_parse_tree. :- import_module parse_tree.read_modules. -:- import_module bool. :- import_module io. +:- import_module list. :- import_module maybe. %---------------------------------------------------------------------------% +:- type make_hlds_result + ---> make_hlds_result( + mhr_invalid_types :: list(error_spec), + mhr_invalid_insts_modes :: list(error_spec), + mhr_opt_blocking :: list(error_spec), + mhr_expansion :: list(error_spec), + mhr_event_set :: list(error_spec) + ). + % make_hlds_pass(ProgressStream, ErrorStream, Globals, % OpModeAugment, InvokedByMMCMake, Baggage0, AugCompUnit0, - % HLDS0, QualInfo, MaybeTimestampMap, UndefTypes, UndefModes, - % PreHLDSErrors, !DumpInfo, !HaveReadModuleMaps, - % !MaybeWrittenSpecs, !IO): + % HLDS0, QualInfo, MaybeTimestampMap, Result, + % !DumpInfo, !HaveReadModuleMaps, !MaybeWrittenSpecs, !IO): % % Every error_spec in MakeHLDSResults will also appear in % !:MaybeWrittenSpecs. They are also returned separately in order @@ -51,7 +60,7 @@ globals::in, op_mode_augment::in, op_mode_invoked_by_mmc_make::in, module_baggage::in, aug_compilation_unit::in, module_info::out, qual_info::out, maybe(module_timestamp_map)::out, - bool::out, bool::out, bool::out, dump_info::in, dump_info::out, + make_hlds_result::out, dump_info::in, dump_info::out, have_parse_tree_maps::in, have_parse_tree_maps::out, maybe_written_specs::in, maybe_written_specs::out, io::di, io::uo) is det. @@ -70,7 +79,6 @@ :- import_module mdbcomp.sym_name. :- import_module parse_tree.build_eqv_maps. :- import_module parse_tree.equiv_type_parse_tree. -:- import_module parse_tree.error_spec. :- import_module parse_tree.file_names. :- import_module parse_tree.generate_mmakefile_fragments. :- import_module parse_tree.grab_modules. @@ -86,9 +94,9 @@ :- import_module parse_tree.write_error_spec. :- import_module recompilation. +:- import_module bool. :- import_module char. :- import_module library. -:- import_module list. :- import_module map. :- import_module set. :- import_module set_tree234. @@ -100,8 +108,7 @@ make_hlds_pass(ProgressStream, ErrorStream, Globals, OpModeAugment, InvokedByMMCMake, Baggage0, AugCompUnit0, - !:HLDS, QualInfo, MaybeTimestampMap, - UndefTypes, UndefModes, PreHLDSErrors, + !:HLDS, QualInfo, MaybeTimestampMap, Result, !DumpInfo, !HaveReadModuleMaps, !MaybeWrittenSpecs, !IO) :- globals.lookup_bool_option(Globals, statistics, Stats), globals.lookup_bool_option(Globals, verbose, Verbose), @@ -117,23 +124,22 @@ make_hlds_pass(ProgressStream, ErrorStream, Globals, OpModeAugment, Verbose, MaybeDFileTransOptDeps, OptBlockingSpecs, Baggage0, Baggage1, AugCompUnit0, AugCompUnit1, !HaveReadModuleMaps, !MaybeWrittenSpecs, !IO), - ( - OptBlockingSpecs = [], - IntermodError = no - ; - OptBlockingSpecs = [_ | _], add_to_be_written_specs(OptBlockingSpecs, !MaybeWrittenSpecs), - IntermodError = yes - ), MaybeTimestampMap = Baggage1 ^ mb_maybe_timestamp_map, BaggageSpecs = get_read_module_specs(Baggage1 ^ mb_errors), add_to_be_written_specs(BaggageSpecs, !MaybeWrittenSpecs), + % We must read in EventSpecMap0 before + % - the call to module_qualify_aug_comp_unit, since that call + % module qualifies EventSpecMap0's contents, returning EventSpecMap1; + % - and the call to expand_eqv_types_insts, which expands equivalences + % in EventSpecMap1, returning EventSpecMap. globals.lookup_string_option(Globals, event_set_file_name, EventSetFileName), - maybe_read_event_set(Globals, EventSetFileName, EventSetName, - EventSpecMap0, EventSetErrors, !MaybeWrittenSpecs, !IO), + maybe_read_event_set(Globals, EventSetFileName, + EventSetName, EventSpecMap0, EventSetSpecs, !IO), + add_to_be_written_specs(EventSetSpecs, !MaybeWrittenSpecs), maybe_write_not_yet_written_specs(ErrorStream, Globals, Verbose, !MaybeWrittenSpecs, !IO), @@ -157,7 +163,6 @@ make_hlds_pass(ProgressStream, ErrorStream, Globals, expand_eqv_types_insts(AugCompUnit2, AugCompUnit, EventSpecMap1, EventSpecMap, TypeEqvMap, UsedEqvModules, RecompInfo0, RecompInfo, ExpandSpecs), - ExpandErrors = contains_errors(Globals, ExpandSpecs), add_to_be_written_specs(ExpandSpecs, !MaybeWrittenSpecs), maybe_write_not_yet_written_specs(ErrorStream, Globals, Verbose, !MaybeWrittenSpecs, !IO), @@ -178,30 +183,19 @@ make_hlds_pass(ProgressStream, ErrorStream, Globals, add_to_be_written_specs(InvalidInstModeSpecs, !MaybeWrittenSpecs), add_to_be_written_specs(MakeSpecs, !MaybeWrittenSpecs), + % Now that we have both EventSpecMap and an initial HLDS, + % we can put the former into the latter. EventSet = event_set(EventSetName, EventSpecMap), module_info_set_event_set(EventSet, !HLDS), - % ZZZ - io.get_exit_status(Status, !IO), - SpecsSoFar = maybe_written_specs_to_specs(!.MaybeWrittenSpecs), - SpecsErrors = contains_errors(Globals, SpecsSoFar), - ( if - ( Status \= 0 - ; SpecsErrors = yes - ) - then - FoundSemanticError = yes, - % ZZZ - io.set_exit_status(1, !IO) - else - FoundSemanticError = no - ), + Result = make_hlds_result(InvalidTypeSpecs, InvalidInstModeSpecs, + OptBlockingSpecs, ExpandSpecs, EventSetSpecs), + maybe_write_not_yet_written_specs(ErrorStream, Globals, Verbose, !MaybeWrittenSpecs, !IO), maybe_write_string(ProgressStream, Verbose, "% done.\n", !IO), maybe_report_stats(ProgressStream, Stats, !IO), - bool.or(FoundSemanticError, IntermodError, PreHLDSErrors), maybe_write_definitions(ProgressStream, Verbose, Stats, !.HLDS, !IO), maybe_write_definition_line_counts(ProgressStream, @@ -209,23 +203,6 @@ make_hlds_pass(ProgressStream, ErrorStream, Globals, maybe_write_definition_extents(ProgressStream, Verbose, Stats, !.HLDS, !IO), - ( if - InvalidTypeSpecs = [], - EventSetErrors = no, - ExpandErrors = no - then - UndefTypes = no - else - UndefTypes = yes - ), - ( - InvalidInstModeSpecs = [], - UndefModes = no - ; - InvalidInstModeSpecs = [_ | _], - UndefModes = yes - ), - maybe_dump_hlds(ProgressStream, !.HLDS, 1, "initial", !DumpInfo, !IO), maybe_write_d_file(ProgressStream, Globals, Baggage0, AugCompUnit, !.HLDS, WriteDFile, MaybeDFileTransOptDeps, !IO). @@ -322,19 +299,18 @@ maybe_mention_undoc(DocUndoc, Pieces0, Pieces) :- %---------------------% :- pred maybe_read_event_set(globals::in, string::in, - string::out, event_spec_map::out, bool::out, - maybe_written_specs::in, maybe_written_specs::out, io::di, io::uo) is det. + string::out, event_spec_map::out, list(error_spec)::out, + io::di, io::uo) is det. maybe_read_event_set(Globals, EventSetFileName, EventSetName, EventSpecMap, - Errors, !MaybeWrittenSpecs, !IO) :- + EventSetSpecs, !IO) :- ( if EventSetFileName = "" then EventSetName = "", EventSpecMap = map.init, - Errors = no + EventSetSpecs = [] else read_event_set(EventSetFileName, EventSetName0, EventSpecMap0, EventSetSpecs, !IO), - add_to_be_written_specs(EventSetSpecs, !MaybeWrittenSpecs), Errors = contains_errors(Globals, EventSetSpecs), ( Errors = no,