diff --git a/compiler/add_pragma_type_spec.m b/compiler/add_pragma_type_spec.m index 4c3f8525e..0b4e5436f 100644 --- a/compiler/add_pragma_type_spec.m +++ b/compiler/add_pragma_type_spec.m @@ -102,6 +102,7 @@ add_pragma_type_spec(TypeSpec, !ModuleInfo, !QualInfo, ModesOrArity = moa_arity(UserArity), user_arity_pred_form_arity(PredOrFunc, UserArity, PredFormArity) ), + % There should be at most one PredId in PredIds. predicate_table_lookup_pf_sym_name_name_pfa(PredTable, is_fully_qualified, PredOrFunc, SymName, PredFormArity, PredIds), predicate_table_lookup_pf_sym_name(PredTable, is_fully_qualified, @@ -114,6 +115,7 @@ add_pragma_type_spec(TypeSpec, !ModuleInfo, !QualInfo, MaybePredOrFunc = no, predicate_table_lookup_sym_name_arity(PredTable, is_fully_qualified, SymName, UserArity, PredIds), + % There should be at most two PredId in PredIds, one pred, one func. predicate_table_lookup_sym_name(PredTable, is_fully_qualified, SymName, AllArityPredIds) ), diff --git a/compiler/hlds_module.m b/compiler/hlds_module.m index 9b839658a..e44348e8b 100644 --- a/compiler/hlds_module.m +++ b/compiler/hlds_module.m @@ -173,6 +173,9 @@ % implemented, and works. Reimplementing it would not be % worthwhile, unless some new functionality was easier % to approach that way. + % + % XXX Applying both type and input mode specialization to + % the same predicate is an example of such "new functionality". forcing_preds :: set(pred_id), % Map from predicates for which the user requested a type diff --git a/compiler/input_specialization.m b/compiler/input_specialization.m index 86bdf7c17..94016ac1b 100644 --- a/compiler/input_specialization.m +++ b/compiler/input_specialization.m @@ -157,7 +157,12 @@ % contents of the table :-) % % type_spec -% We do not yet have code to handle these pragmas correctly. +% At least until the implementation of type specialization is simplified, +% we do not let a predicate be subject to both input specialization +% and type specialization. Type specialization pragmas add an entry +% to a table for each predicate they apply to; when this module finds +% this entry for a predicate that input specialization *could* apply to, +% it generates an error message instead. % %---------------------------------------------------------------------------% @@ -242,7 +247,7 @@ maybe_input_specialize_in_pred(InputSpecTable, PredId, ( UserMade = user_made_pred(_, _, _), input_specialize_in_pred_if_possible(!.ModuleInfo, InModuleMap, - PredInfo0, MaybeNewPredInfo, !Specs), + PredId, PredInfo0, MaybeNewPredInfo, !Specs), ( MaybeNewPredInfo = no ; @@ -281,11 +286,11 @@ maybe_input_specialize_in_pred(InputSpecTable, PredId, ). :- pred input_specialize_in_pred_if_possible(module_info::in, - input_spec_in_module_map::in, pred_info::in, maybe(pred_info)::out, - list(diag_spec)::in, list(diag_spec)::out) is det. + input_spec_in_module_map::in, pred_id::in, pred_info::in, + maybe(pred_info)::out, list(diag_spec)::in, list(diag_spec)::out) is det. input_specialize_in_pred_if_possible(ModuleInfo, InModuleMap, - PredInfo0, MaybeNewPredInfo, !Specs) :- + PredId, PredInfo0, MaybeNewPredInfo, !Specs) :- pred_info_get_arg_types(PredInfo0, ArgTypes), find_args_to_specialize(InModuleMap, 1, ArgTypes, ArgsToSpec), ( @@ -293,7 +298,7 @@ input_specialize_in_pred_if_possible(ModuleInfo, InModuleMap, MaybeNewPredInfo = no ; ArgsToSpec = [HeadArgToSpec | TailArgsToSpec], - report_any_incompatibilities(PredInfo0, PredSpecs), + report_any_incompatibilities(ModuleInfo, PredId, PredInfo0, PredSpecs), ( PredSpecs = [], input_specialize_in_pred(ModuleInfo, HeadArgToSpec, TailArgsToSpec, @@ -329,10 +334,10 @@ find_args_to_specialize(InModuleMap, ArgNum, [ArgType | ArgTypes], %---------------------------------------------------------------------------% -:- pred report_any_incompatibilities(pred_info::in, list(diag_spec)::out) - is det. +:- pred report_any_incompatibilities(module_info::in, + pred_id::in, pred_info::in, list(diag_spec)::out) is det. -report_any_incompatibilities(PredInfo0, Specs) :- +report_any_incompatibilities(ModuleInfo, PredId, PredInfo0, Specs) :- pred_info_get_proc_table(PredInfo0, ProcTable0), map.foldl4(acc_proc_eval_methods_structs, ProcTable0, [], NormalProcIds, [], TabledProcIds, no, Sharing, no, Reuse), @@ -360,7 +365,7 @@ report_any_incompatibilities(PredInfo0, Specs) :- TabledPieces = [words("Error:")] ++ TabledPredPieces ++ [words("could have its modes input specialized, but")] ++ color_as_incorrect(ProcsDesc) ++ - [words("and input specialization and tabling"), + [words("and input mode specialization and tabling"), words("are mutually exclusive."), nl], TabledSpec = spec($pred, severity_error, phase_input_spec, Context, TabledPieces), @@ -377,8 +382,8 @@ report_any_incompatibilities(PredInfo0, Specs) :- [words("could have its modes input specialized, but")] ++ color_as_incorrect( [words("it has a structure_sharing pragma,")]) ++ - [words("and input specialization and structure sharing analysis"), - words("are mutually exclusive."), nl], + [words("and input mode specialization and"), + words("structure sharing analysis are mutually exclusive."), nl], SharingSpec = spec($pred, severity_error, phase_input_spec, Context, SharingPieces), SharingSpecs = [SharingSpec] @@ -393,8 +398,8 @@ report_any_incompatibilities(PredInfo0, Specs) :- ReusePieces = [words("Error:")] ++ ReusePredPieces ++ [words("could have its modes input specialized, but")] ++ color_as_incorrect([words("it has a structure_reuse pragma,")]) ++ - [words("and input specialization and structure reuse analysis"), - words("are mutually exclusive."), nl], + [words("and input mode specialization and"), + words("structure reuse analysis are mutually exclusive."), nl], ReuseSpec = spec($pred, severity_error, phase_input_spec, Context, ReusePieces), ReuseSpecs = [ReuseSpec] @@ -402,7 +407,23 @@ report_any_incompatibilities(PredInfo0, Specs) :- Reuse = no, ReuseSpecs = [] ), - Specs = TabledSpecs ++ SharingSpecs ++ ReuseSpecs. + module_info_get_type_spec_tables(ModuleInfo, TypeSpecTables), + TypeSpecTables = type_spec_tables(_, _, _, PragmaMap), + ( if map.search(PragmaMap, PredId, _) then + TypeSpecPredPieces = describe_one_pred_info_name(yes(color_subject), + should_not_module_qualify, [], PredInfo0), + TypeSpecPieces = [words("Error:")] ++ TypeSpecPredPieces ++ + [words("could have its modes input specialized, but")] ++ + color_as_incorrect([words("it has a type_spec pragma,")]) ++ + [words("and input mode specialization and type specialization"), + words("are mutually exclusive."), nl], + TypeSpecSpec = spec($pred, severity_error, phase_input_spec, + Context, TypeSpecPieces), + TypeSpecSpecs = [TypeSpecSpec] + else + TypeSpecSpecs = [] + ), + Specs = TabledSpecs ++ SharingSpecs ++ ReuseSpecs ++ TypeSpecSpecs. :- pred acc_proc_eval_methods_structs(proc_id::in, proc_info::in, list(proc_id)::in, list(proc_id)::out, diff --git a/compiler/options.m b/compiler/options.m index 214b1a378..cd4f6987a 100644 --- a/compiler/options.m +++ b/compiler/options.m @@ -5677,7 +5677,8 @@ optdb(oc_dev_ctrl, compiler_sufficiently_recent, bool(no), "inrange-2025-10-01", "scout-disj-2025-11-15", "subtype-int2-2026-08-09", - "input-spec-2026-08-14"], [ + "input-spec-2026-08-14", + "input-mode-spec-2026-08-30"], [ w("Is the compiler sufficiently recent to contain the new feature"), w("or bugfix referred to by each name?")])). % These options are provided for use by implementors who want to compare diff --git a/tests/warnings/help_text.err_exp b/tests/warnings/help_text.err_exp index d870a71b9..3cd086795 100644 --- a/tests/warnings/help_text.err_exp +++ b/tests/warnings/help_text.err_exp @@ -3730,6 +3730,7 @@ Options for developers only --scout-disj-2025-11-15 --subtype-int2-2026-08-09 --input-spec-2026-08-14 + --input-mode-spec-2026-08-30 Is the compiler sufficiently recent to contain the new feature or bugfix referred to by each name?