diff --git a/NEWS.md b/NEWS.md index 582656b26..c9a0c3a29 100644 --- a/NEWS.md +++ b/NEWS.md @@ -852,6 +852,8 @@ Changes to the Mercury standard library - func `get_values_for_key/2` - func `reverse_add/3` - pred `reverse_add/4` + - func `to_sorted_assoc_list/1` + - pred `to_sorted_assoc_list/2` - func `ucount/1` - pred `ucount/2` diff --git a/compiler/hlds_rtti.m b/compiler/hlds_rtti.m index 3d55f99d0..f6e87b6f2 100644 --- a/compiler/hlds_rtti.m +++ b/compiler/hlds_rtti.m @@ -165,6 +165,33 @@ % The value associated with a given key is the prog_constraint that % the typeclass_info is for. % + % XXX That documentation is incomplete/inaccurate, because some of the keys + % in this map can also be BASE_typeclass_infos. The only way to distinguish + % the from typeclass_infos is by looking up their names in the var_table. + % + % I, zs, have seen both tables that contain a pair of keys, + % - one of which is a typeclass_info variable and + % - the other of which is a base_typeclass_info variable + % both map to the same constraint, and tables that contain + % no base_typeclass_info variables as keys. + % I don't know what logic governs the circumstances under which + % the polymorphism pass adds base_typeclass_info variables to this map, + % and I don't think any documentation exists about this issue. + % + % Also, the presence of a pair + % in this map does NOT guarantee that the corresponding + % pair will appear in the + % tci_constraint_to_var_map. I don't know what logic governs + % the presence of that pair there. + % + % And a third issue is that it is possible for two typeclass_info vars + % to map to the same constraint in this map even when the calls + % that those typeclass_info vars are part of the same piece of straight + % line code (i.e. there are not in different branches of e.g. a switch). + % The reason for this is that typeclass_info vars constructed using + % static data are cheaper to create again than to save on the stack + % across calls. + % :- type tci_var_to_constraint_map == map(prog_var, prog_constraint). % This predicate is intended to be used *only* for HLDS dumps. @@ -377,12 +404,16 @@ %---------------------% -:- type are_typeclass_records_complete - ---> typeclass_records_are_not_complete - ; typeclass_records_are_complete. - -:- pred check_whether_typeclass_records_are_complete(rtti_varmaps::in, - are_typeclass_records_complete::out) is det. + % compute_duplicate_typeclass_info_vars(VarTable, RttiVarMaps, + % DupTCIVarsToConstraintMap): + % + % Find the set of constraints in the procedure for which the RttiVarMaps + % records more than one variable as holding its typeclass_info, + % and return the set of those variables, mapping each one + % to the constraint it is for. + % +:- pred compute_duplicate_typeclass_info_vars(var_table::in, rtti_varmaps::in, + map(prog_var, prog_constraint)::out) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% @@ -396,6 +427,9 @@ :- import_module parse_tree.prog_type_subst. :- import_module assoc_list. +:- import_module int. +:- import_module one_or_more. +:- import_module one_or_more_map. :- import_module pair. :- import_module require. :- import_module set_tree234. @@ -911,26 +945,56 @@ get_typeinfo_vars_acc(VarTable, TVarToLocnMap, [Var | Vars], !TypeInfoVars) :- %---------------------------------------------------------------------------% -check_whether_typeclass_records_are_complete(RttiVarMaps, MaybeComplete) :- - RttiVarMaps = rtti_varmaps(_, _, - ConstraintToVarMap0, VarToConstraintMap0), - map.foldl(delete_forward_edge, ConstraintToVarMap0, - VarToConstraintMap0, VarToConstraintMap), - ( if map.is_empty(VarToConstraintMap) then - MaybeComplete = typeclass_records_are_complete +compute_duplicate_typeclass_info_vars(VarTable, RttiVarMaps, + DupTCIVarsToConstraintMap) :- + RttiVarMaps = rtti_varmaps(_, _, _, VarToConstraintMap), + map.foldl(acc_constraint_typeclass_info_var(VarTable), + VarToConstraintMap, one_or_more_map.init, ConstraintToTCIVarsMap), + one_or_more_map.to_sorted_assoc_list(ConstraintToTCIVarsMap, + ConstraintToTCIVarsAL), + record_duplicate_typeclass_info_vars(ConstraintToTCIVarsAL, + map.init, DupTCIVarsToConstraintMap). + +:- pred acc_constraint_typeclass_info_var(var_table::in, + prog_var::in, prog_constraint::in, + one_or_more_map(prog_constraint, prog_var)::in, + one_or_more_map(prog_constraint, prog_var)::out) is det. + +acc_constraint_typeclass_info_var(VarTable, Var, Constraint, + !ConstraintToTCIVarsMap) :- + VarName = var_table_entry_name(VarTable, Var), + % The table we are iterating over contains typeclass_infos, but + % it may, or may not, also contain base_typeclass_infos. + % We do not want to report "parallel typeclass_infos" if one of them + % is just a base_typeclass_info. + ( if string.prefix(VarName, "TypeClassInfo") then + one_or_more_map.add(Constraint, Var, !ConstraintToTCIVarsMap) else - MaybeComplete = typeclass_records_are_not_complete + true ). -:- pred delete_forward_edge(prog_constraint::in, prog_var::in, - tci_var_to_constraint_map::in, tci_var_to_constraint_map::out) is det. +:- pred record_duplicate_typeclass_info_vars( + assoc_list(prog_constraint, one_or_more(prog_var))::in, + map(prog_var, prog_constraint)::in, + map(prog_var, prog_constraint)::out) is det. -delete_forward_edge(Constraint, Var, !VarToConstraintMap) :- - % Var not occurring in !.VarToConstraintMap, and ... - map.det_remove(Var, VarConstraint, !VarToConstraintMap), - % ... the matching constraint not being Constraint, would both be bugs. - expect(unify(Constraint, VarConstraint), $pred, - "Constraint != VarConstraint"). +record_duplicate_typeclass_info_vars([], !DupTCIVarsToConstraintMap). +record_duplicate_typeclass_info_vars([Head | Tail], + !DupTCIVarsToConstraintMap) :- + Head = Constraint - OoMTCIVars, + one_or_more.length(OoMTCIVars, NumTCIVars), + ( if NumTCIVars > 1 then + % XXX This could be a library predicate, named possibly + % map.det_rev_insert. + InsertPred = + ( pred(V::in, M0::in, M::out) is det :- + map.det_insert(V, Constraint, M0, M) + ), + one_or_more.foldl(InsertPred, OoMTCIVars, !DupTCIVarsToConstraintMap) + else + true + ), + record_duplicate_typeclass_info_vars(Tail, !DupTCIVarsToConstraintMap). %---------------------------------------------------------------------------% :- end_module hlds.hlds_rtti. diff --git a/compiler/polymorphism_type_class_info.m b/compiler/polymorphism_type_class_info.m index cef448cd7..994e8f0ff 100644 --- a/compiler/polymorphism_type_class_info.m +++ b/compiler/polymorphism_type_class_info.m @@ -399,6 +399,26 @@ get_or_make_typeclass_info_from_proof_instance(ExistQVars, Context, Seen, ) ), + % We have two obvious choices for how we reuse existing typeclass_infos. + % We can either cache the typeclass_info variables themselves, or the + % static data they refer to. + % + % Caching the variables has the disadvantage that it simply does not work + % in the presence of branched code. Any typeclass_info variable we cache + % in one branch of e.g. a switch will not be visible from any other branch. + % + % This is why we cache the static data in the const_struct_db instead. + % Any later reference to the same typeclass_info, whether it is in the + % branch, in a different branch, or after the end of the branched control + % structure all together, can pick up that same constant data and just + % assign it to a new typeclass_info variable. Even in the case of + % a reuse in the same branch, this can be more efficient than reusing + % the originally-constructed typeclass_info variable, because reusing + % the variable would require storing it in a stack slot for the duration + % of any intervening calls, while reusing the static data does not impose + % that cost. (This is why, when common.m processes the code we generate, + % it pass does NOT replace the assignment of the same constant to the + % second typeclass_info variable with an assigment from the first.) poly_info_get_const_struct_db(!.Info, ConstStructDb0), ConstInstanceId = ciid(InstanceNum, Constraint, Seen), ( if diff --git a/compiler/simplify_proc.m b/compiler/simplify_proc.m index 6c6b4068c..f30e311cc 100644 --- a/compiler/simplify_proc.m +++ b/compiler/simplify_proc.m @@ -94,6 +94,7 @@ :- import_module check_hlds.simplify.simplify_info. :- import_module check_hlds.simplify.split_switch_arms. :- import_module hlds.code_model. +:- import_module hlds.goal_util. :- import_module hlds.hlds_error_util. :- import_module hlds.hlds_markers. :- import_module hlds.hlds_out. @@ -124,6 +125,7 @@ :- import_module cord. :- import_module int. :- import_module map. +:- import_module multi_map. :- import_module require. :- import_module set. :- import_module string. @@ -360,10 +362,8 @@ simplify_proc_return_msgs(ProgressStream, SimplifyTasks0, PredId, ProcId, proc_info_get_argmodes(!.ProcInfo, ArgModes), find_and_record_any_direct_arg_in_out_posns(PredId, ProcId, VarTable2, HeadVars, ArgModes, !ModuleInfo), - % ZZZ We ignore the new !:Specs until we fix - % tests/typeclasses;/extra_type_info. check_typeclass_records(!.ModuleInfo, PredId, ProcId, !.ProcInfo, - RttiVarMaps0, !.Specs, _) + VarTable2, RttiVarMaps0, !Specs) else VarTable2 = VarTable1 ), @@ -489,11 +489,11 @@ simplify_proc_maybe_mark_modecheck_clauses(!ProcInfo) :- ). :- pred check_typeclass_records(module_info::in, pred_id::in, proc_id::in, - proc_info::in, rtti_varmaps::in, + proc_info::in, var_table::in, rtti_varmaps::in, list(diag_spec)::in, list(diag_spec)::out) is det. -check_typeclass_records(ModuleInfo, PredId, ProcId, ProcInfo, RttiVarMaps, - !Specs) :- +check_typeclass_records(ModuleInfo, PredId, ProcId, ProcInfo, + VarTable, RttiVarMaps, !Specs) :- module_info_get_globals(ModuleInfo, Globals), globals.lookup_bool_option(Globals, body_typeinfo_liveness, BodyTypeInfoLiveness), @@ -501,46 +501,300 @@ check_typeclass_records(ModuleInfo, PredId, ProcId, ProcInfo, RttiVarMaps, BodyTypeInfoLiveness = no ; BodyTypeInfoLiveness = yes, - check_whether_typeclass_records_are_complete(RttiVarMaps, - MaybeComplete), - ( - MaybeComplete = typeclass_records_are_complete - ; - MaybeComplete = typeclass_records_are_not_complete, - ProcPieces = describe_one_proc_name_maybe_argmodes(ModuleInfo, - output_debug, yes(color_subject), should_module_qualify, [], - proc(PredId, ProcId)), - % We say "debugging enabled", because this is by far - % the most common way for body_typeinfo_liveness to be set. - % Both alternatives, the use of .agc grades and manual setting - % of the option, are extremely rare. - MainPieces = [words("Sorry: he compiler cannot compile")] ++ - ProcPieces ++ [words("with debugging enabled."), - words("This is due to a known limitation that concerns"), - words("the mapping between typeclass on the one hand,"), - words("and the hidden, compiler-generated variables"), - words("storing information about them on the other hand."), - nl], - VerbosePieces = - [words("The limitation occurs when the definition"), - words("of a predicate or function contains"), - words("both the deconstructions of terms"), - words("that contain existentially typed arguments,"), - words("and branched code, such as if-then-elses,"), - words("disjunctions and/or switches."), - words("You can work around the limitation"), - words("by moving such deconstruction unifications"), - words("to helper predicates that contain no branching."), nl], - Msg = simple_msg(Context, - [always(MainPieces), - verbose_only(verbose_once, VerbosePieces)]), - Phase = phase_simplify(report_in_any_mode), - proc_info_get_context(ProcInfo, Context), - Spec = gen_spec($pred, severity_error, Phase, [Msg]), - !:Specs = [Spec | !.Specs] + % If there are no constraints that have two or more typeclass_info + % variables, then having two branches of a branched control + % structure generating different typeclass_infos for the same + % constraint is not possible. + % + % This is a cheap test to make, because its cost is bounded + % by the size of the RttiVarMaps, which is just about always small. + % This is why we start with that, and go on to traverse the body goal + % (which may be MUCH bigger) only if we have to. + compute_duplicate_typeclass_info_vars(VarTable, RttiVarMaps, + DupTCIVarsToConstraintMap), + ( if map.is_empty(DupTCIVarsToConstraintMap) then + true + else + map.keys_as_set(DupTCIVarsToConstraintMap, DupTCIVarsSet), + DupTCIVars = set_of_var.set_to_bitset(DupTCIVarsSet), + proc_info_get_initial_instmap(ModuleInfo, ProcInfo, InstMap0), + proc_info_get_goal(ProcInfo, Goal), + look_for_typeclass_info_conflict_in_goal(DupTCIVars, + DupTCIVarsToConstraintMap, InstMap0, Goal, + multi_map.init, _, no_typeclass_info_conflict, Conflict), + ( + Conflict = no_typeclass_info_conflict + ; + Conflict = found_typeclass_info_conflict, + report_typeclass_info_problem(ModuleInfo, PredId, ProcId, + ProcInfo, !Specs) + ) ) ). +:- type typeclass_info_conflict + ---> no_typeclass_info_conflict + ; found_typeclass_info_conflict. + + % Look for branched goals in which two different branches + % produce typeclass_infos for the same constraint. + % + % Because the polymorphism pass always generates code that either + % constructs or retrieves typeclass_infos just before goals that + % need them, and only ever reuses the variables that hold them + % in straight line code, the typeclass_infos generated in + % different branches are guaranteed be in different variables. + % This is a problem, because the current design of the rtti_varmaps + % structure allows us to record only one of those typeclass_info vars + % as the holder of the available information about that constraint. + % This is the cause of Mantis bug #585, whose entry discusses the issue + % in detail. + % +:- pred look_for_typeclass_info_conflict_in_goal(set_of_progvar::in, + map(prog_var, prog_constraint)::in, instmap::in, hlds_goal::in, + multi_map(prog_constraint, prog_var)::in, + multi_map(prog_constraint, prog_var)::out, + typeclass_info_conflict::in, typeclass_info_conflict::out) is det. + +look_for_typeclass_info_conflict_in_goal(DupTCIVars, TCIVarToConstraintMap, + InstMap0, Goal, !TCIConstraints, !Conflict) :- + Goal = hlds_goal(GoalExpr, GoalInfo), + ( + ( GoalExpr = unify(_, _, _, _, _) + ; GoalExpr = plain_call(_, _, _, _, _, _) + ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _) + ; GoalExpr = generic_call(_, _, _, _, _) + ), + InstMapDelta = goal_info_get_instmap_delta(GoalInfo), + instmap_delta_changed_vars(InstMapDelta, ChangedVars), + set_of_var.intersect(DupTCIVars, ChangedVars, ChangedDupTCIVars), + ( if set_of_var.is_non_empty(ChangedDupTCIVars) then + set_of_var.to_sorted_list(ChangedDupTCIVars, ChangedDupTCIVarList), + list.foldl(record_delta_typeclass_info_var(TCIVarToConstraintMap), + ChangedDupTCIVarList, !TCIConstraints) + else + true + ) + ; + GoalExpr = conj(_ConjKind, Conjuncts), + % Neither debugging nor accurate gc, the two reasons for + % turning on typeinfo liveness, support parallel conjunctions. + % Therefore we should not get here if _ConjKind = parallel_conj. + % However, the code intended for plain_conjs should also work + % for parallel_conjs as well. + look_for_typeclass_info_conflict_in_plain_conj(DupTCIVars, + TCIVarToConstraintMap, InstMap0, Conjuncts, + !TCIConstraints, !Conflict) + ; + GoalExpr = disj(Disjuncts), + look_for_typeclass_info_conflict_in_disj(DupTCIVars, + TCIVarToConstraintMap, InstMap0, Disjuncts, !Conflict) + ; + GoalExpr = switch(_, _, Cases), + look_for_typeclass_info_conflict_in_switch(DupTCIVars, + TCIVarToConstraintMap, InstMap0, Cases, !Conflict) + ; + GoalExpr = if_then_else(_Vars, CondGoal, ThenGoal, ElseGoal), + look_for_typeclass_info_conflict_in_goal(DupTCIVars, + TCIVarToConstraintMap, InstMap0, CondGoal, + multi_map.init, CondTCIConstraints, !Conflict), + apply_goal_instmap_delta(CondGoal, InstMap0, InstMapAfterCond), + look_for_typeclass_info_conflict_in_goal(DupTCIVars, + TCIVarToConstraintMap, InstMapAfterCond, ThenGoal, + CondTCIConstraints, ThenTCIConstraints, !Conflict), + look_for_typeclass_info_conflict_in_goal(DupTCIVars, + TCIVarToConstraintMap, InstMap0, ElseGoal, + multi_map.init, ElseTCIConstraints, !Conflict), + detect_conflicts_in_arms(set.init, + [ThenTCIConstraints, ElseTCIConstraints], !Conflict) + ; + GoalExpr = negation(SubGoal), + look_for_typeclass_info_conflict_in_goal(DupTCIVars, + TCIVarToConstraintMap, InstMap0, SubGoal, + !TCIConstraints, !Conflict) + ; + GoalExpr = scope(Reason, SubGoal), + ( if + Reason = from_ground_term(_, FGT), + ( FGT = from_ground_term_construct + ; FGT = from_ground_term_deconstruct + ) + then + true + else + look_for_typeclass_info_conflict_in_goal(DupTCIVars, + TCIVarToConstraintMap, InstMap0, SubGoal, + !TCIConstraints, !Conflict) + ) + ; + GoalExpr = shorthand(ShortHand), + ( + ShortHand = atomic_goal(_GoalType, _Outer, _Inner, + _MaybeOutputVars, MainGoal, OrElseGoals, _OrElseInners), + Disjuncts = [MainGoal | OrElseGoals], + look_for_typeclass_info_conflict_in_disj(DupTCIVars, + TCIVarToConstraintMap, InstMap0, Disjuncts, !Conflict) + ; + ShortHand = try_goal(_, _, _), + % These should have been expanded out by now. + unexpected($pred, "try_goal") + ; + ShortHand = bi_implication(_, _), + % These should have been expanded out by now. + unexpected($pred, "bi_implication") + ) + ). + +:- pred record_delta_typeclass_info_var(map(prog_var, prog_constraint)::in, + prog_var::in, + multi_map(prog_constraint, prog_var)::in, + multi_map(prog_constraint, prog_var)::out) is det. + +record_delta_typeclass_info_var(TCIVarToConstraintMap, TCIVar, + !TCIConstraints) :- + map.lookup(TCIVarToConstraintMap, TCIVar, Constraint), + multi_map.add(Constraint, TCIVar, !TCIConstraints). + +%---------------------% + +:- pred look_for_typeclass_info_conflict_in_plain_conj(set_of_progvar::in, + map(prog_var, prog_constraint)::in, instmap::in, list(hlds_goal)::in, + multi_map(prog_constraint, prog_var)::in, + multi_map(prog_constraint, prog_var)::out, + typeclass_info_conflict::in, typeclass_info_conflict::out) is det. + +look_for_typeclass_info_conflict_in_plain_conj(_, _, _, [], + !TCIConstraints, !Conflict). +look_for_typeclass_info_conflict_in_plain_conj(DupTCIVars, + TCIVarToConstraintMap, InstMap0, [Conjunct | Conjuncts], + !TCIConstraints, !Conflict) :- + look_for_typeclass_info_conflict_in_goal(DupTCIVars, TCIVarToConstraintMap, + InstMap0, Conjunct, !TCIConstraints, !Conflict), + apply_goal_instmap_delta(Conjunct, InstMap0, InstMap1), + look_for_typeclass_info_conflict_in_plain_conj(DupTCIVars, + TCIVarToConstraintMap, InstMap1, Conjuncts, + !TCIConstraints, !Conflict). + +%---------------------% + +:- pred look_for_typeclass_info_conflict_in_disj(set_of_progvar::in, + map(prog_var, prog_constraint)::in, instmap::in, list(hlds_goal)::in, + typeclass_info_conflict::in, typeclass_info_conflict::out) is det. + +look_for_typeclass_info_conflict_in_disj(DupTCIVars, TCIVarToConstraintMap, + InstMap0, Disjuncts, !Conflict) :- + look_for_typeclass_info_conflict_in_disjuncts(DupTCIVars, + TCIVarToConstraintMap, InstMap0, Disjuncts, ArmTCIConstraints, + !Conflict), + detect_conflicts_in_arms(set.init, ArmTCIConstraints, !Conflict). + +:- pred look_for_typeclass_info_conflict_in_disjuncts(set_of_progvar::in, + map(prog_var, prog_constraint)::in, instmap::in, list(hlds_goal)::in, + list(multi_map(prog_constraint, prog_var))::out, + typeclass_info_conflict::in, typeclass_info_conflict::out) is det. + +look_for_typeclass_info_conflict_in_disjuncts(_, _, _, [], [], !Conflict). +look_for_typeclass_info_conflict_in_disjuncts(DupTCIVars, + TCIVarToConstraintMap, InstMap0, [HeadDisjunct | TailDisjuncts], + [HeadTCIConstraints | TailTCIConstraints], !Conflict) :- + look_for_typeclass_info_conflict_in_goal(DupTCIVars, TCIVarToConstraintMap, + InstMap0, HeadDisjunct, multi_map.init, HeadTCIConstraints, !Conflict), + look_for_typeclass_info_conflict_in_disjuncts(DupTCIVars, + TCIVarToConstraintMap, InstMap0, + TailDisjuncts, TailTCIConstraints, !Conflict). + +%---------------------% + +:- pred look_for_typeclass_info_conflict_in_switch(set_of_progvar::in, + map(prog_var, prog_constraint)::in, instmap::in, list(case)::in, + typeclass_info_conflict::in, typeclass_info_conflict::out) is det. + +look_for_typeclass_info_conflict_in_switch(DupTCIVars, TCIVarToConstraintMap, + InstMap0, Disjuncts, !Conflict) :- + look_for_typeclass_info_conflict_in_cases(DupTCIVars, + TCIVarToConstraintMap, InstMap0, Disjuncts, ArmTCIConstraints, + !Conflict), + detect_conflicts_in_arms(set.init, ArmTCIConstraints, !Conflict). + +:- pred look_for_typeclass_info_conflict_in_cases(set_of_progvar::in, + map(prog_var, prog_constraint)::in, instmap::in, list(case)::in, + list(multi_map(prog_constraint, prog_var))::out, + typeclass_info_conflict::in, typeclass_info_conflict::out) is det. + +look_for_typeclass_info_conflict_in_cases(_, _, _, [], [], !Conflict). +look_for_typeclass_info_conflict_in_cases(DupTCIVars, TCIVarToConstraintMap, + InstMap0, [HeadCase | TailCases], + [HeadTCIConstraints | TailTCIConstraints], !Conflict) :- + HeadCase = case(_MainConsId, _OtherConsIds, HeadGoal), + % We ignore the instmap changes resulting from binding the switched-on + % variable to MainConsId or OtherConsIds, because they cannot affect + % the compiler-generated code that binds typeclass infos. + look_for_typeclass_info_conflict_in_goal(DupTCIVars, TCIVarToConstraintMap, + InstMap0, HeadGoal, multi_map.init, HeadTCIConstraints, !Conflict), + look_for_typeclass_info_conflict_in_cases(DupTCIVars, + TCIVarToConstraintMap, InstMap0, + TailCases, TailTCIConstraints, !Conflict). + +%---------------------% + +:- pred detect_conflicts_in_arms(set(prog_constraint)::in, + list(multi_map(prog_constraint, prog_var))::in, + typeclass_info_conflict::in, typeclass_info_conflict::out) is det. + +detect_conflicts_in_arms(_, [], !Conflict). +detect_conflicts_in_arms(!.SeenConstraints, + [HeadArmTCIConstraints | TailArmTCIConstraints], !Conflict) :- + multi_map.keys_as_set(HeadArmTCIConstraints, HeadConstraints), + set.intersect(!.SeenConstraints, HeadConstraints, SeenHeadConstraints), + ( if set.is_non_empty(SeenHeadConstraints) then + % This arm and one (or more) of the previous arms both define + % typeclass_infos for the constraints in SeenHeadConstraints. + !:Conflict = found_typeclass_info_conflict + else + true + ), + set.union(HeadConstraints, !SeenConstraints), + detect_conflicts_in_arms(!.SeenConstraints, TailArmTCIConstraints, + !Conflict). + +%---------------------% + +:- pred report_typeclass_info_problem(module_info::in, + pred_id::in, proc_id::in, proc_info::in, + list(diag_spec)::in, list(diag_spec)::out) is det. + +report_typeclass_info_problem(ModuleInfo, PredId, ProcId, ProcInfo, !Specs) :- + ProcPieces = describe_one_proc_name_maybe_argmodes(ModuleInfo, + output_debug, yes(color_subject), should_module_qualify, [], + proc(PredId, ProcId)), + proc_info_get_context(ProcInfo, Context), + % We say "debugging enabled", because this is by far + % the most common way for body_typeinfo_liveness to be set. + % Both alternatives, the use of .agc grades and manual setting + % of the option, are extremely rare. + MainPieces = [words("Sorry: he compiler cannot compile")] ++ + ProcPieces ++ [words("with debugging enabled."), + words("This is due to a known limitation that concerns"), + words("the mapping between typeclass on the one hand,"), + words("and the hidden, compiler-generated variables"), + words("storing information about them on the other hand."), + nl], + VerbosePieces = + [words("The limitation occurs when the definition"), + words("of a predicate or function contains"), + words("both the deconstructions of terms"), + words("that contain existentially typed arguments,"), + words("and branched code, such as if-then-elses,"), + words("disjunctions and/or switches."), + words("You can work around the limitation"), + words("by moving such deconstruction unifications"), + words("to helper predicates that contain no branching."), nl], + Msg = simple_msg(Context, + [always(MainPieces), verbose_only(verbose_once, VerbosePieces)]), + Phase = phase_simplify(report_in_any_mode), + Spec = gen_spec($pred, severity_error, Phase, [Msg]), + !:Specs = [Spec | !.Specs]. + %---------------------------------------------------------------------------% :- pred simplify_proc_analyze_and_format_calls(io.text_output_stream::in, diff --git a/library/one_or_more_map.m b/library/one_or_more_map.m index ba678e95a..abc657490 100644 --- a/library/one_or_more_map.m +++ b/library/one_or_more_map.m @@ -251,6 +251,14 @@ :- pred to_assoc_list(one_or_more_map(K, V)::in, assoc_list(K, one_or_more(V))::out) is det. + % Convert a one_or_more_map to an association list, with all the values + % for each key in one element of the association list, sorted on the keys. + % +:- func to_sorted_assoc_list(one_or_more_map(K, V)) + = assoc_list(K, one_or_more(V)). +:- pred to_sorted_assoc_list(one_or_more_map(K, V)::in, + assoc_list(K, one_or_more(V))::out) is det. + % Convert an association list with all the values for each key % in one element of the list to a one_or_more_map. % @@ -598,6 +606,12 @@ to_assoc_list(OneOrMoreMap) = AssocList :- to_assoc_list(OneOrMoreMap, AssocList) :- map.to_assoc_list(OneOrMoreMap, AssocList). +to_sorted_assoc_list(OneOrMoreMap) = AssocList :- + one_or_more_map.to_sorted_assoc_list(OneOrMoreMap, AssocList). + +to_sorted_assoc_list(OneOrMoreMap, AssocList) :- + map.to_sorted_assoc_list(OneOrMoreMap, AssocList). + from_assoc_list(AssocList) = OneOrMoreMap :- one_or_more_map.from_assoc_list(AssocList, OneOrMoreMap). diff --git a/tests/invalid/Mercury.options b/tests/invalid/Mercury.options index 3680444b1..b3eceecb7 100644 --- a/tests/invalid/Mercury.options +++ b/tests/invalid/Mercury.options @@ -125,7 +125,7 @@ MCFLAGS-string_format_unknown += --warn-unknown-format-calls MCFLAGS-subtype_user_compare += -E MCFLAGS-synth_attr_error += --event-set-file-name synth_attr_error_spec MCFLAGS-syntax_error_event += --event-set-file-name syntax_error_event_spec -MCFLAGS-tci_liveness_abort += --grade asm_fast.gc.debug +MCFLAGS-tci_liveness_abort += --grade asm_fast.gc.debug -E # We compile test_feature_set in grade java because that grade is incompatible # with the features in the test require_feature_set pragma. MCFLAGS-test_feature_set += --grade java --no-intermod-opt -E diff --git a/tests/invalid/tci_liveness_abort.err_exp b/tests/invalid/tci_liveness_abort.err_exp index 26e131dbb..493a27ff3 100644 --- a/tests/invalid/tci_liveness_abort.err_exp +++ b/tests/invalid/tci_liveness_abort.err_exp @@ -1,25 +1,9 @@ -tci_liveness_abort.m:020: Sorry: due to a known limitation, the compiler cannot -tci_liveness_abort.m:020: compile predicate `tci_liveness_abort.test1'/4 with -tci_liveness_abort.m:020: debugging enabled. The limitation concerns the -tci_liveness_abort.m:020: mapping between typeclass on the one hand, and the -tci_liveness_abort.m:020: hidden, compiler-generated variables storing -tci_liveness_abort.m:020: information about them on the other hand. -tci_liveness_abort.m:020: -tci_liveness_abort.m:020: The limitation occurs when the definition of a -tci_liveness_abort.m:020: predicate or function contains both the -tci_liveness_abort.m:020: deconstructions of terms that contain existentially -tci_liveness_abort.m:020: typed arguments, and branched code, such as -tci_liveness_abort.m:020: if-then-elses, disjunctions and/or switches. You -tci_liveness_abort.m:020: can work around the limitation by moving such -tci_liveness_abort.m:020: deconstruction unifications to helper predicates -tci_liveness_abort.m:020: that contain no branching. -tci_liveness_abort.m:022: Sorry: due to a known limitation, the compiler cannot -tci_liveness_abort.m:022: compile predicate `tci_liveness_abort.test2'/3 with -tci_liveness_abort.m:022: debugging enabled. The limitation concerns the -tci_liveness_abort.m:022: mapping between typeclass on the one hand, and the -tci_liveness_abort.m:022: hidden, compiler-generated variables storing -tci_liveness_abort.m:022: information about them on the other hand. -tci_liveness_abort.m:022: +tci_liveness_abort.m:022: Sorry: he compiler cannot compile predicate +tci_liveness_abort.m:022: `tci_liveness_abort.test2'/3 with debugging +tci_liveness_abort.m:022: enabled. This is due to a known limitation that +tci_liveness_abort.m:022: concerns the mapping between typeclass on the one +tci_liveness_abort.m:022: hand, and the hidden, compiler-generated variables +tci_liveness_abort.m:022: storing information about them on the other hand. tci_liveness_abort.m:022: The limitation occurs when the definition of a tci_liveness_abort.m:022: predicate or function contains both the tci_liveness_abort.m:022: deconstructions of terms that contain existentially