diff --git a/compiler/hlds_out_pred.m b/compiler/hlds_out_pred.m index 999c3b80e..3b9c698cf 100644 --- a/compiler/hlds_out_pred.m +++ b/compiler/hlds_out_pred.m @@ -411,13 +411,12 @@ format_obsolete_in_favour_of(ObsoleteInFavourOf, !State) :- format_pred_types(VarNamePrint, TVarSet, VarTable, RttiVarMaps, ProofMap, ConstraintMap, ExternalTypeParams, !State) :- - format_rtti_varmaps(VarNamePrint, TVarSet, VarTable, RttiVarMaps, !State), + format_rtti_varmaps(TVarSet, VarTable, RttiVarMaps, !State), ( if map.is_empty(ProofMap) then true else format_constraint_proof_map(0u, VarNamePrint, TVarSet, - ProofMap, !State), - string.builder.append_string("\n", !State) + ProofMap, !State) ), ( if map.is_empty(ConstraintMap) then true @@ -774,7 +773,7 @@ format_proc(Info, VarNamePrint, ModuleInfo, PredId, PredInfo, [s(Indent1Str), i(ProcIdInt), s(DetismStr)], !State), format_var_types(VarNamePrint, TVarSet, VarTable, !State), - format_rtti_varmaps(VarNamePrint, TVarSet, VarTable, RttiVarMaps, !State), + format_rtti_varmaps(TVarSet, VarTable, RttiVarMaps, !State), format_proc_flags(CanProcess, IsAddressTaken, HasParallelConj, HasUserEvent, !State), @@ -890,7 +889,8 @@ format_var_types_loop(VarNamePrint, TypeVarSet, [Var - Entry | VarsEntries], !State) :- Entry = vte(Name, Type, IsDummy), term.var_to_int(Var, VarNum), - VarStr = mercury_var_raw_to_string(VarNamePrint, Var, Name), + % We print the number separately at the start of the line anyway. + VarStr = mercury_var_raw_to_string(print_name_only, Var, Name), TypeStr = mercury_type_to_string(TypeVarSet, VarNamePrint, Type), ( IsDummy = is_dummy_type, @@ -905,66 +905,100 @@ format_var_types_loop(VarNamePrint, TypeVarSet, %---------------------% -:- pred format_rtti_varmaps(var_name_print::in, tvarset::in, var_table::in, - rtti_varmaps::in, +:- pred format_rtti_varmaps(tvarset::in, var_table::in, rtti_varmaps::in, string.builder.state::di, string.builder.state::uo) is det. -format_rtti_varmaps(VarNamePrint, TVarSet, VarTable, RttiVarMaps, !State) :- - string.builder.append_string("% type_info varmap:\n", !State), - rtti_varmaps_tvars(RttiVarMaps, TypeVars), - list.foldl( - format_type_info_locn(VarNamePrint, TVarSet, VarTable, RttiVarMaps), - TypeVars, !State), - string.builder.append_string("% typeclass_info varmap:\n", !State), - rtti_varmaps_reusable_constraints(RttiVarMaps, Constraints), - list.foldl( - format_typeclass_info_var(VarNamePrint, TVarSet, VarTable, - RttiVarMaps), - Constraints, !State), - string.builder.append_string("% rtti_var_info:\n", !State), +format_rtti_varmaps(TVarSet, VarTable, RttiVarMaps, !State) :- + rtti_varmaps_components(RttiVarMaps, TVarToLocnMap, TIVarToTypeMap, + ConstraintToVarMap, VarToConstraintMap), + VarNamePrint = print_name_and_num, + string.builder.append_string("% RTTI varmaps\n", !State), + + string.builder.append_string("% tvar_to_ti_locn_map:\n", !State), + map.foldl( + format_tvar_to_type_info_locn(VarNamePrint, TVarSet, VarTable), + TVarToLocnMap, !State), + + string.builder.append_string("% ti_var_to_type_map:\n", !State), + map.foldl( + format_ti_var_to_type(VarNamePrint, TVarSet, VarTable), + TIVarToTypeMap, !State), + + string.builder.append_string("% tci_constraint_to_var_map:\n", !State), + map.foldl( + format_constraint_to_var(VarNamePrint, TVarSet, VarTable), + ConstraintToVarMap, !State), + + string.builder.append_string("% tci_var_to_constraint_map:\n", !State), + map.foldl( + format_var_to_constraint(VarNamePrint, TVarSet, VarTable), + VarToConstraintMap, !State), + + % The information printed below is synthesized from the info above. + string.builder.append_string("% rtti_prog_vars:\n", !State), rtti_varmaps_rtti_prog_vars(RttiVarMaps, ProgVars), list.foldl( format_rtti_var_info(VarNamePrint, TVarSet, VarTable, RttiVarMaps), ProgVars, !State). -:- pred format_type_info_locn(var_name_print::in, - tvarset::in, var_table::in, rtti_varmaps::in, tvar::in, +:- pred format_tvar_to_type_info_locn(var_name_print::in, + tvarset::in, var_table::in, tvar::in, type_info_locn::in, string.builder.state::di, string.builder.state::uo) is det. -format_type_info_locn(VarNamePrint, TVarSet, VarTable, RttiVarMaps, TVar, +format_tvar_to_type_info_locn(VarNamePrint, TVarSet, VarTable, TVar, Locn, !State) :- TVarStr = mercury_var_to_string_vs(TVarSet, VarNamePrint, TVar), - term.var_to_int(TVar, TVarNum), - string.builder.format("%% %s(number %d) -> ", - [s(TVarStr), i(TVarNum)], !State), - rtti_lookup_type_info_locn(RttiVarMaps, TVar, Locn), + string.builder.format("%% %-10s -> ", [s(TVarStr)], !State), ( Locn = type_info(Var), VarStr = mercury_var_to_string(VarTable, VarNamePrint, Var), - string.builder.format("type_info(%s)", [s(VarStr)], !State) + string.builder.format("type_info(%s)\n", [s(VarStr)], !State) ; Locn = typeclass_info(Var, Index), VarStr = mercury_var_to_string(VarTable, VarNamePrint, Var), - string.builder.format("typeclass_info(%s, %d)", + string.builder.format("typeclass_info(%s, %d)\n", [s(VarStr), i(Index)], !State) - ), - term.var_to_int(Var, VarNum), - string.builder.format(" (number %d)\n", [i(VarNum)], !State). + ). -:- pred format_typeclass_info_var(var_name_print::in, tvarset::in, - var_table::in, rtti_varmaps::in, prog_constraint::in, +:- pred format_ti_var_to_type(var_name_print::in, + tvarset::in, var_table::in, prog_var::in, mer_type::in, string.builder.state::di, string.builder.state::uo) is det. -format_typeclass_info_var(VarNamePrint, TVarSet, VarTable, RttiVarMaps, - Constraint, !State) :- - string.builder.append_string("% ", !State), - mercury_format_constraint(TVarSet, VarNamePrint, Constraint, - string.builder.handle, !State), - string.builder.append_string(" -> ", !State), - rtti_lookup_typeclass_info_var(RttiVarMaps, Constraint, Var), - mercury_format_var(VarTable, VarNamePrint, Var, - string.builder.handle, !State), - string.builder.append_string("\n", !State). +format_ti_var_to_type(VarNamePrint, TVarSet, VarTable, TIVar, Type0, !State) :- + strip_module_names_from_type(strip_all_module_names, set_default_func, + Type0, Type), + TIVarStr = mercury_var_to_string(VarTable, VarNamePrint, TIVar), + TypeStr = mercury_type_to_string(TVarSet, VarNamePrint, Type), + string.builder.format("%% %-34s -> %s\n", + [s(TIVarStr), s(TypeStr)], !State). + +:- pred format_constraint_to_var(var_name_print::in, + tvarset::in, var_table::in, prog_constraint::in, prog_var::in, + string.builder.state::di, string.builder.state::uo) is det. + +format_constraint_to_var(VarNamePrint, TVarSet, VarTable, Constraint0, Var, + !State) :- + strip_module_names_from_constraint(strip_all_module_names, + set_default_func, Constraint0, Constraint), + ConstraintStr = mercury_constraint_to_string(TVarSet, VarNamePrint, + Constraint), + VarStr = mercury_var_to_string(VarTable, VarNamePrint, Var), + string.builder.format("%% %-34s -> %s\n", + [s(ConstraintStr), s(VarStr)], !State). + +:- pred format_var_to_constraint(var_name_print::in, + tvarset::in, var_table::in, prog_var::in, prog_constraint::in, + string.builder.state::di, string.builder.state::uo) is det. + +format_var_to_constraint(VarNamePrint, TVarSet, VarTable, Var, Constraint0, + !State) :- + strip_module_names_from_constraint(strip_all_module_names, + set_default_func, Constraint0, Constraint), + VarStr = mercury_var_to_string(VarTable, VarNamePrint, Var), + ConstraintStr = mercury_constraint_to_string(TVarSet, VarNamePrint, + Constraint), + string.builder.format("%% %-34s -> %s\n", + [s(VarStr), s(ConstraintStr)], !State). :- pred format_rtti_var_info(var_name_print::in, tvarset::in, var_table::in, rtti_varmaps::in, prog_var::in, @@ -972,19 +1006,21 @@ format_typeclass_info_var(VarNamePrint, TVarSet, VarTable, RttiVarMaps, format_rtti_var_info(VarNamePrint, TVarSet, VarTable, RttiVarMaps, Var, !State) :- - term.var_to_int(Var, VarNum), - VarStr = mercury_var_to_string(VarTable, VarNamePrint, Var), - string.builder.format("%% %s (number %d) -> ", - [s(VarStr), i(VarNum)], !State), rtti_varmaps_var_info(RttiVarMaps, Var, VarInfo), + VarStr = mercury_var_to_string(VarTable, VarNamePrint, Var), + string.builder.format("%% %-34s -> ", [s(VarStr)], !State), ( - VarInfo = type_info_var(Type), - string.builder.append_string("type_info for ", !State), + VarInfo = type_info_var(Type0), + strip_module_names_from_type(strip_all_module_names, set_default_func, + Type0, Type), + string.builder.append_string("ti for ", !State), mercury_format_type(TVarSet, VarNamePrint, Type, string.builder.handle, !State) ; - VarInfo = typeclass_info_var(Constraint), - string.builder.append_string("typeclass_info for ", !State), + VarInfo = typeclass_info_var(Constraint0), + strip_module_names_from_constraint(strip_all_module_names, + set_default_func, Constraint0, Constraint), + string.builder.append_string("tci for ", !State), mercury_format_constraint(TVarSet, VarNamePrint, Constraint, string.builder.handle, !State) ; diff --git a/compiler/hlds_rtti.m b/compiler/hlds_rtti.m index 21162cbe4..073d1117f 100644 --- a/compiler/hlds_rtti.m +++ b/compiler/hlds_rtti.m @@ -33,6 +33,7 @@ :- import_module assoc_list. :- import_module bool. :- import_module list. +:- import_module map. %---------------------------------------------------------------------------% @@ -160,6 +161,89 @@ % :- pred rtti_varmaps_init(rtti_varmaps::out) is det. +%---------------------------------------------------------------------------% +% +% The components of rtti_var_maps. +% + + % A tci_constraint_to_var_map records, for each type class constraint, + % which variable contains the typeclass_info for that constraint. + % XXX This is a LIMITATION: on different branches, the same constraint + % may need to be mapped to different variables. + % + % The constraints covered by this map are + % - those which are passed in as head arguments, and + % - those which are produced as existential constraints + % from calls or deconstructions. + % These are constraints for which it is safe to reuse the variable + % associated with the constraint. + % +:- type tci_constraint_to_var_map == map(prog_constraint, prog_var). + + % A tvar_to_ti_locn_map is a map which, for each type variable, + % records where the type_info for that type variable is stored. + % + % XXX This doesn't record the information that we want. For a constraint + % such as foo(list(T)) we can't properly record the location of the + % type_info for T, since it does not occupy a slot in the typeclass_info + % directly, but is inside the type_info for list(T). + % + % XXX Even the information that is recorded has the wrong key. Consider + % a conjunction between: + % + % - a call that returns an existentially typed result, and + % - a goal that uses that existentially typed variable. + % + % Let us say that the conjunction looks like + % + % gen_result(X_1, TypeInfo_for_T_2), use_result(TypeInfo_for_T_2, X_1). + % + % This conjunction can be duplicated, e.g. by switch detection (it could be + % in a switch arm that is guarded by a disjunction that handles different + % values of the switched-on variable differently) or by tabling. + % (This is what happens in Mantis bug #154.) + % + % In such cases, the renamed-apart duplicated goal would be something like + % + % gen_result(X_3, TypeInfo_for_T_4), use_result(TypeInfo_for_T_4, X_3). + % + % Yet the rtti_var_map for the procedure would say that X_3 is of the same + % type as X_1, which means that the compiler would think that X_1 and X_3 + % use the same type_info variable to represent their types. This would be + % TypeInfo_for_T_2, even though it won't exist on the execution branch + % containing the copied version of the goal. + % + % I (zs) can see two possible fixes. + % + % - First, we could have tvar_to_ti_locn_map map each tvar to one_or_more + % type_info_locns, exactly one of which would be available on every + % execution path. It would be the responsibility of other parts of the + % compiler to pick the right one. + % + % - Second, instead of mapping prog_vars to types, and the tvars in those + % types to the prog_vars holding their type_infos, we could map each + % prog_var directly to a {tvar -> typeinfo progvar} map. + % +:- type tvar_to_ti_locn_map == map(tvar, type_info_locn). + + % Every program variable which holds a type_info is a key in this map. + % The value associated with a given key is the type that the type_info + % is for. + % +:- type ti_var_to_type_map == map(prog_var, mer_type). + + % Every program variable which holds a typeclass_info is a key in this map. + % The value associated with a given key is the prog_constraint that + % the typeclass_info is for. + % +:- type tci_var_to_constraint_map == map(prog_var, prog_constraint). + + % This predicate is intended to be used *only* for HLDS dumps. + % +:- pred rtti_varmaps_components(rtti_varmaps::in, + tvar_to_ti_locn_map::out, ti_var_to_type_map::out, + tci_constraint_to_var_map::out, tci_var_to_constraint_map::out) is det. + %---------------------------------------------------------------------------% % % Update rtti_varmaps. @@ -370,7 +454,6 @@ :- import_module parse_tree.prog_type_scan. :- import_module parse_tree.prog_type_subst. -:- import_module map. :- import_module pair. :- import_module require. :- import_module set_tree234. @@ -444,78 +527,6 @@ type_info_locn_set_var(Var, typeclass_info(_, Num), typeclass_info(Var, Num)). rv_tci_var_to_constr_map :: tci_var_to_constraint_map ). - % A tci_constraint_to_var_map records, for each type class constraint, - % which variable contains the typeclass_info for that constraint. - % XXX This is a LIMITATION: on different branches, the same constraint - % may need to be mapped to different variables. - % - % The constraints covered by this map are - % - those which are passed in as head arguments, and - % - those which are produced as existential constraints - % from calls or deconstructions. - % These are constraints for which it is safe to reuse the variable - % associated with the constraint. - % -:- type tci_constraint_to_var_map == map(prog_constraint, prog_var). - - % A tvar_to_ti_locn_map is a map which, for each type variable, - % records where the type_info for that type variable is stored. - % - % XXX This doesn't record the information that we want. For a constraint - % such as foo(list(T)) we can't properly record the location of the - % type_info for T, since it does not occupy a slot in the typeclass_info - % directly, but is inside the type_info for list(T). - % - % XXX Even the information that is recorded has the wrong key. Consider - % a conjunction between: - % - % - a call that returns an existentially typed result, and - % - a goal that uses that existentially typed variable. - % - % Let us say that the conjunction looks like - % - % gen_result(X_1, TypeInfo_for_T_2), use_result(TypeInfo_for_T_2, X_1). - % - % This conjunction can be duplicated, e.g. by switch detection (it could be - % in a switch arm that is guarded by a disjunction that handles different - % values of the switched-on variable differently) or by tabling. - % (This is what happens in Mantis bug #154.) - % - % In such cases, the renamed-apart duplicated goal would be something like - % - % gen_result(X_3, TypeInfo_for_T_4), use_result(TypeInfo_for_T_4, X_3). - % - % Yet the rtti_var_map for the procedure would say that X_3 is of the same - % type as X_1, which means that the compiler would think that X_1 and X_3 - % use the same type_info variable to represent their types. This would be - % TypeInfo_for_T_2, even though it won't exist on the execution branch - % containing the copied version of the goal. - % - % I (zs) can see two possible fixes. - % - % - First, we could have tvar_to_ti_locn_map map each tvar to one_or_more - % type_info_locns, exactly one of which would be available on every - % execution path. It would be the responsibility of other parts of the - % compiler to pick the right one. - % - % - Second, instead of mapping prog_vars to types, and the tvars in those - % types to the prog_vars holding their type_infos, we could map each - % prog_var directly to a {tvar -> typeinfo progvar} map. - % -:- type tvar_to_ti_locn_map == map(tvar, type_info_locn). - - % Every program variable which holds a type_info is a key in this map. - % The value associated with a given key is the type that the type_info - % is for. - % -:- type ti_var_to_type_map == map(prog_var, mer_type). - - % Every program variable which holds a typeclass_info is a key in this map. - % The value associated with a given key is the prog_constraint that - % the typeclass_info is for. - % -:- type tci_var_to_constraint_map == map(prog_var, prog_constraint). - %---------------------------------------------------------------------------% rtti_varmaps_init(RttiVarMaps) :- @@ -528,6 +539,13 @@ rtti_varmaps_init(RttiVarMaps) :- %---------------------------------------------------------------------------% +rtti_varmaps_components(RttiVarMaps, TVarToLocnMap, TIVarToTypeMap, + ConstraintToVarMap, VarToConstraintMap) :- + RttiVarMaps = rtti_varmaps(TVarToLocnMap, TIVarToTypeMap, + ConstraintToVarMap, VarToConstraintMap). + +%---------------------------------------------------------------------------% + rtti_det_insert_type_info_locn(TVar, Locn, !RttiVarMaps) :- TVarToLocnMap0 = !.RttiVarMaps ^ rv_tv_to_ti_locn_map, map.det_insert(TVar, Locn, TVarToLocnMap0, TVarToLocnMap), @@ -1008,17 +1026,6 @@ check_whether_typeclass_records_are_complete(RttiVarMaps, MaybeComplete) :- ( if map.is_empty(VarToConstraintMap) then MaybeComplete = typeclass_records_are_complete else - trace [io(!IO)] ( - map.to_sorted_assoc_list(VarToConstraintMap0, VarToConstraintAL0), - map.to_sorted_assoc_list(VarToConstraintMap, VarToConstraintAL), - io.stderr_stream(StdErr, !IO), - io.write_string(StdErr, "\nVarToConstraintAL0:\n", !IO), - list.foldl(io.write_line(StdErr), VarToConstraintAL0, !IO), - io.nl(StdErr, !IO), - io.write_string(StdErr, "\nVarToConstraintAL:\n", !IO), - list.foldl(io.write_line(StdErr), VarToConstraintAL, !IO), - io.nl(StdErr, !IO) - ), MaybeComplete = typeclass_records_are_not_complete ). diff --git a/compiler/prog_type.m b/compiler/prog_type.m index 71d39d5b7..4e25ccde5 100644 --- a/compiler/prog_type.m +++ b/compiler/prog_type.m @@ -88,6 +88,9 @@ :- pred strip_module_names_from_type_list(strip_what_module_names::in, maybe_set_default_func::in, list(mer_type)::in, list(mer_type)::out) is det. +:- pred strip_module_names_from_constraint(strip_what_module_names::in, + maybe_set_default_func::in, + prog_constraint::in, prog_constraint::out) is det. %---------------------------------------------------------------------------% @@ -356,6 +359,14 @@ strip_module_names_from_type_list(StripWhat, SetDefaultFunc, Types0, Types) :- list.map(strip_module_names_from_type(StripWhat, SetDefaultFunc), Types0, Types). +strip_module_names_from_constraint(StripWhat, SetDefaultFunc, + Constraint0, Constraint) :- + Constraint0 = constraint(ClassSymName0, ArgTypes0), + strip_module_names_from_sym_name(StripWhat, ClassSymName0, ClassSymName), + list.map(strip_module_names_from_type(StripWhat, SetDefaultFunc), + ArgTypes0, ArgTypes), + Constraint = constraint(ClassSymName, ArgTypes). + %---------------------------------------------------------------------------% builtin_type_ctors_with_no_hlds_type_defn = [