diff --git a/compiler/expand_lambdas.m b/compiler/expand_lambdas.m index 45e416139..d21150f2b 100644 --- a/compiler/expand_lambdas.m +++ b/compiler/expand_lambdas.m @@ -146,6 +146,7 @@ :- import_module hlds.pred_proc_id. :- import_module hlds.pred_table. :- import_module hlds.quantification. +:- import_module hlds.restrict_var_maps. :- import_module hlds.status. :- import_module hlds.type_util. :- import_module libs. @@ -158,10 +159,8 @@ :- import_module parse_tree.prog_type_test. :- import_module transform_hlds.direct_arg_in_out. -:- import_module array. :- import_module assoc_list. :- import_module bool. -:- import_module int. :- import_module list. :- import_module map. :- import_module maybe. @@ -699,243 +698,6 @@ check_lambda_arg_type_and_mode(ModuleInfo, Type, Mode, X, X) :- true ). -%---------------------------------------------------------------------------% - - % The proc_info has several maps that refer to variables. After lambda - % expansion, both the newly created procedures and the original procedure - % that they were carved out of have duplicate copies of these maps. - % This duplication is a problem because later passes (in particular, - % the equiv_types_hlds pass) iterate over the entries in these maps, - % and if an entry is duplicated N times, they have to process it N times. - % The task of this predicate is to eliminate unnecessary entries - % from the var_table, and this requires also eliminating them from - % the rtti_varmaps. - % - % We could in theory restrict the tvarset and the inst_varset as well, - % but since we don't iterate over those sets, there is (as yet) no need - % for this. - % -:- pred restrict_var_maps(list(prog_var)::in, hlds_goal::in, - var_table::in, var_table::out, rtti_varmaps::in, rtti_varmaps::out) is det. - -restrict_var_maps(HeadVars, Goal, !VarTable, !RttiVarMaps) :- - var_table_max_var_num(!.VarTable, MaxVarNum), - % Variable numbers go from 1 to MaxVarNum. Reserve array slots - % from 0 to MaxVarNum, since wasting the space of one array element - % is preferable to having to do a subtraction on every array lookup. - array.init(MaxVarNum + 1, no, VarUses0), - mark_vars_as_used(HeadVars, VarUses0, VarUses1), - find_used_vars_in_goal(Goal, VarUses1, VarUses), - - var_table_to_sorted_assoc_list(!.VarTable, VarTableEntries0), - filter_var_table_entries(VarTableEntries0, VarUses, - [], RevVarTableEntries), - var_table_from_rev_sorted_assoc_list(RevVarTableEntries, !:VarTable), - - restrict_rtti_varmaps(VarUses, !RttiVarMaps). - -:- pred find_used_vars_in_goal(hlds_goal::in, - array(bool)::array_di, array(bool)::array_uo) is det. - -find_used_vars_in_goal(Goal, !VarUses) :- - Goal = hlds_goal(GoalExpr, _GoalInfo), - ( - GoalExpr = unify(LHSVar, RHS, _, Unif, _), - mark_var_as_used(LHSVar, !VarUses), - ( - Unif = construct(_, _, _, _, CellToReuse, _, _), - ( if CellToReuse = reuse_cell(cell_to_reuse(ReuseVar, _, _)) then - mark_var_as_used(ReuseVar, !VarUses) - else - true - ) - ; - ( Unif = deconstruct(_, _, _, _, _, _) - ; Unif = assign(_, _) - ; Unif = simple_test(_, _) - ; Unif = complicated_unify(_, _, _) - ) - ), - find_used_vars_in_unify_rhs(RHS, !VarUses) - ; - GoalExpr = generic_call(GenericCall, ArgVars, _, _, _), - ( - GenericCall = higher_order(Var, _, _, _, _), - mark_var_as_used(Var, !VarUses) - ; - GenericCall = class_method(Var, _, _, _), - mark_var_as_used(Var, !VarUses) - ; - GenericCall = event_call(_) - ; - GenericCall = cast(_) - ), - mark_vars_as_used(ArgVars, !VarUses) - ; - GoalExpr = plain_call(_, _, ArgVars, _, MaybeCallUnifyContext, _), - mark_vars_as_used(ArgVars, !VarUses), - ( - MaybeCallUnifyContext = no - ; - MaybeCallUnifyContext = yes(CallUnifyContext), - CallUnifyContext = call_unify_context(Var, RHS, _UC), - mark_var_as_used(Var, !VarUses), - find_used_vars_in_unify_rhs(RHS, !VarUses) - ) - ; - ( GoalExpr = conj(_, Goals) - ; GoalExpr = disj(Goals) - ), - find_used_vars_in_goals(Goals, !VarUses) - ; - GoalExpr = switch(Var, _Det, Cases), - mark_var_as_used(Var, !VarUses), - find_used_vars_in_cases(Cases, !VarUses) - ; - GoalExpr = scope(Reason, SubGoal), - ( - Reason = exist_quant(Vars, _), - mark_vars_as_used(Vars, !VarUses) - ; - Reason = promise_solutions(Vars, _), - mark_vars_as_used(Vars, !VarUses) - ; - Reason = from_ground_term(Var, _), - mark_var_as_used(Var, !VarUses) - ; - Reason = loop_control(LCVar, LCSVar, _), - mark_var_as_used(LCVar, !VarUses), - mark_var_as_used(LCSVar, !VarUses) - ; - ( Reason = disable_warnings(_, _) - ; Reason = promise_purity(_) - ; Reason = barrier(_) - ; Reason = commit(_) - ; Reason = trace_goal(_, _, _, _, _) - ) - % Do nothing. - ; - ( Reason = require_detism(_) - ; Reason = require_complete_switch(_) - ; Reason = require_switch_arms_detism(_, _) - ), - % These scopes should have been deleted by now. - unexpected($pred, "unexpected scope") - ), - find_used_vars_in_goal(SubGoal, !VarUses) - ; - GoalExpr = negation(SubGoal), - find_used_vars_in_goal(SubGoal, !VarUses) - ; - GoalExpr = if_then_else(Vars, Cond, Then, Else), - mark_vars_as_used(Vars, !VarUses), - find_used_vars_in_goal(Cond, !VarUses), - find_used_vars_in_goal(Then, !VarUses), - find_used_vars_in_goal(Else, !VarUses) - ; - GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _), - ArgVars = list.map(foreign_arg_var, Args), - ExtraVars = list.map(foreign_arg_var, ExtraArgs), - mark_vars_as_used(ArgVars, !VarUses), - mark_vars_as_used(ExtraVars, !VarUses) - ; - GoalExpr = shorthand(Shorthand), - ( - Shorthand = atomic_goal(_, Outer, Inner, MaybeOutputVars, - MainGoal, OrElseGoals, _), - Outer = atomic_interface_vars(OuterDI, OuterUO), - mark_var_as_used(OuterDI, !VarUses), - mark_var_as_used(OuterUO, !VarUses), - Inner = atomic_interface_vars(InnerDI, InnerUO), - mark_var_as_used(InnerDI, !VarUses), - mark_var_as_used(InnerUO, !VarUses), - ( - MaybeOutputVars = no - ; - MaybeOutputVars = yes(OutputVars), - mark_vars_as_used(OutputVars, !VarUses) - ), - find_used_vars_in_goal(MainGoal, !VarUses), - find_used_vars_in_goals(OrElseGoals, !VarUses) - ; - Shorthand = try_goal(_, _, SubGoal), - % The IO and Result variables would be in SubGoal. - find_used_vars_in_goal(SubGoal, !VarUses) - ; - Shorthand = bi_implication(LeftGoal, RightGoal), - find_used_vars_in_goal(LeftGoal, !VarUses), - find_used_vars_in_goal(RightGoal, !VarUses) - ) - ). - -:- pred find_used_vars_in_goals(list(hlds_goal)::in, - array(bool)::array_di, array(bool)::array_uo) is det. - -find_used_vars_in_goals([], !VarUses). -find_used_vars_in_goals([Goal | Goals], !VarUses) :- - find_used_vars_in_goal(Goal, !VarUses), - find_used_vars_in_goals(Goals, !VarUses). - -:- pred find_used_vars_in_cases(list(case)::in, - array(bool)::array_di, array(bool)::array_uo) is det. - -find_used_vars_in_cases([], !VarUses). -find_used_vars_in_cases([Case | Cases], !VarUses) :- - Case = case(_, _, Goal), - find_used_vars_in_goal(Goal, !VarUses), - find_used_vars_in_cases(Cases, !VarUses). - -:- pred find_used_vars_in_unify_rhs(unify_rhs::in, - array(bool)::array_di, array(bool)::array_uo) is det. - -find_used_vars_in_unify_rhs(RHS, !VarUses) :- - ( - RHS = rhs_var(RHSVar), - mark_var_as_used(RHSVar, !VarUses) - ; - RHS = rhs_functor(_, _, ArgVars), - mark_vars_as_used(ArgVars, !VarUses) - ; - RHS = rhs_lambda_goal(_, _, _, NonLocals, ArgVarsModes, _, LambdaGoal), - assoc_list.keys(ArgVarsModes, ArgVars), - mark_vars_as_used(NonLocals, !VarUses), - mark_vars_as_used(ArgVars, !VarUses), - find_used_vars_in_goal(LambdaGoal, !VarUses) - ). - -:- pred mark_var_as_used(prog_var::in, - array(bool)::array_di, array(bool)::array_uo) is det. -:- pragma inline(pred(mark_var_as_used/3)). - -mark_var_as_used(Var, !VarUses) :- - array.set(var_to_int(Var), yes, !VarUses). - -:- pred mark_vars_as_used(list(prog_var)::in, - array(bool)::array_di, array(bool)::array_uo) is det. - -mark_vars_as_used([], !VarUses). -mark_vars_as_used([Var | Vars], !VarUses) :- - mark_var_as_used(Var, !VarUses), - mark_vars_as_used(Vars, !VarUses). - -:- pred filter_var_table_entries(assoc_list(prog_var, var_table_entry)::in, - array(bool)::in, - assoc_list(prog_var, var_table_entry)::in, - assoc_list(prog_var, var_table_entry)::out) is det. - -filter_var_table_entries([], _VarUses, !RevVarsEntries). -filter_var_table_entries([VarEntry | VarsEntries], VarUses, !RevVarsEntries) :- - VarEntry = Var - _Entry, - VarNum = var_to_int(Var), - array.unsafe_lookup(VarUses, VarNum, Used), - ( - Used = yes, - !:RevVarsEntries = [VarEntry | !.RevVarsEntries] - ; - Used = no - ), - filter_var_table_entries(VarsEntries, VarUses, !RevVarsEntries). - %---------------------------------------------------------------------------% :- type lambda_info diff --git a/compiler/hlds.m b/compiler/hlds.m index 5505a7736..eeb3f0e00 100644 --- a/compiler/hlds.m +++ b/compiler/hlds.m @@ -119,6 +119,7 @@ :- include_module mode_util. :- include_module passes_aux. :- include_module pred_name. +:- include_module restrict_var_maps. :- include_module type_classify. :- include_module type_rename. :- include_module type_util. diff --git a/compiler/hlds_out_pred.m b/compiler/hlds_out_pred.m index 3b9c698cf..7fe8f3d50 100644 --- a/compiler/hlds_out_pred.m +++ b/compiler/hlds_out_pred.m @@ -226,8 +226,9 @@ format_pred(Info, Lang, ModuleInfo, PredId, PredInfo, !State) :- FormatStringValues = one_or_more_to_list(OoMFormatStringValues), output_format_string_values(FormatStringValues, !State) ), - format_pred_types(VarNamePrint, TVarSet, VarTable, RttiVarMaps, - ProofMap, ConstraintMap, ExternalTypeParams, !State), + format_pred_types(VarNamePrint, FilledInProcIdsInfos, + TVarSet, VarTable, RttiVarMaps, ProofMap, ConstraintMap, + ExternalTypeParams, !State), format_pred_proc_var_name_remap(VarNameSrc, VarNameRemap, !State), get_clause_list_maybe_repeated(ClausesRep, Clauses), @@ -405,13 +406,23 @@ format_obsolete_in_favour_of(ObsoleteInFavourOf, !State) :- %---------------------% -:- pred format_pred_types(var_name_print::in, tvarset::in, var_table::in, - rtti_varmaps::in, constraint_proof_map::in, constraint_map::in, +:- pred format_pred_types(var_name_print::in, list(T)::in, + tvarset::in, var_table::in, rtti_varmaps::in, + constraint_proof_map::in, constraint_map::in, list(tvar)::in, string.builder.state::di, string.builder.state::uo) is det. -format_pred_types(VarNamePrint, TVarSet, VarTable, RttiVarMaps, - ProofMap, ConstraintMap, ExternalTypeParams, !State) :- - format_rtti_varmaps(TVarSet, VarTable, RttiVarMaps, !State), +format_pred_types(VarNamePrint, FilledInProcIdsInfos, TVarSet, + VarTable, RttiVarMaps, ProofMap, ConstraintMap, ExternalTypeParams, + !State) :- + ( + FilledInProcIdsInfos = [], + format_var_types(VarNamePrint, TVarSet, VarTable, !State), + format_rtti_varmaps(TVarSet, VarTable, RttiVarMaps, !State) + ; + FilledInProcIdsInfos = [_ | _] + % Do not print the var_table and rtti_varmaps, since these are + % superseded by the corresponding fields in the filled-in proc_infos. + ), ( if map.is_empty(ProofMap) then true else @@ -432,8 +443,7 @@ format_pred_types(VarNamePrint, TVarSet, VarTable, RttiVarMaps, mercury_format_vars_vs(TVarSet, VarNamePrint, ExternalTypeParams, string.builder.handle, !State), string.builder.append_string("\n", !State) - ), - format_var_types(VarNamePrint, TVarSet, VarTable, !State). + ). :- pred format_constraint_map(var_name_print::in, tvarset::in, constraint_map::in, diff --git a/compiler/hlds_out_util.m b/compiler/hlds_out_util.m index 18f6d152e..232e16d62 100644 --- a/compiler/hlds_out_util.m +++ b/compiler/hlds_out_util.m @@ -270,6 +270,7 @@ :- import_module char. :- import_module map. +:- import_module require. :- import_module term_context. :- import_module term_io. :- import_module term_subst. @@ -604,11 +605,16 @@ functor_cons_id_to_string(ModuleInfo, VarNameSrc, VarNamePrint, cons_id_dummy_type_ctor)), Str = functor_cons_id_to_string(ModuleInfo, VarNameSrc, VarNamePrint, PredConsId, ArgVars) + ; + ( ConsId = type_info_cell_constructor(_) + ; ConsId = typeclass_info_cell_constructor + ), + Atom = maybe_quoted_cons_id_and_arity_to_string(ConsId), + Str = functor_to_string(VarNameSrc, VarNamePrint, + term.atom(Atom), ArgVars) ; ( ConsId = type_ctor_info_const(_, _, _) ; ConsId = base_typeclass_info_const(_, _, _, _) - ; ConsId = type_info_cell_constructor(_) - ; ConsId = typeclass_info_cell_constructor ; ConsId = type_info_const(_) ; ConsId = typeclass_info_const(_) ; ConsId = ground_term_const(_, _) @@ -616,6 +622,7 @@ functor_cons_id_to_string(ModuleInfo, VarNameSrc, VarNamePrint, ; ConsId = table_io_entry_desc(_) ; ConsId = deep_profiling_proc_layout(_) ), + expect(unify(ArgVars, []), $pred, "ArgVars != [] comp_gen"), Str = maybe_quoted_cons_id_and_arity_to_string(ConsId) ). diff --git a/compiler/hlds_rtti.m b/compiler/hlds_rtti.m index 073d1117f..bd2c0ad59 100644 --- a/compiler/hlds_rtti.m +++ b/compiler/hlds_rtti.m @@ -317,6 +317,10 @@ % iff the variable is actually used in a procedure body, restrict the % rtti_varmaps for that procedure to the variables needed. % + % The reason for the choice of an array to convey this information + % is explained in a comment in the only caller of this predicate, + % which is in restrict_var_maps.m. + % :- pred restrict_rtti_varmaps(array(bool)::in, rtti_varmaps::in, rtti_varmaps::out) is det. diff --git a/compiler/mercury_compile_front_end.m b/compiler/mercury_compile_front_end.m index b5b92a4ab..b2bff2cce 100644 --- a/compiler/mercury_compile_front_end.m +++ b/compiler/mercury_compile_front_end.m @@ -1364,7 +1364,17 @@ maybe_simplify(ProgressStream, MaybeErrorStream, Warn, SimplifyPass, ( SimplifyPass = simplify_pass_frontend, list.cons(simptask_after_front_end, !SimpList), - list.cons(simptask_try_opt_const_structs, !SimpList) + list.cons(simptask_try_opt_const_structs, !SimpList), + globals.lookup_accumulating_option(Globals, dump_hlds, + DumpHLDSStages), + ( + DumpHLDSStages = [] + ; + DumpHLDSStages = [_ | _], + % This makes HLDS dumps both smaller and more readable + % (by reducing clutter). + list.cons(simptask_delete_dead_vars, !SimpList) + ) ; SimplifyPass = simplify_pass_post_untuple, list.cons(simptask_mark_code_model_changes, !SimpList) diff --git a/compiler/notes/compiler_design.html b/compiler/notes/compiler_design.html index fa33438a0..9c77acb08 100644 --- a/compiler/notes/compiler_design.html +++ b/compiler/notes/compiler_design.html @@ -1043,6 +1043,11 @@ as well as predicates operating on that type.
  • from_ground_term_util.m contains types and predicates for operating on from_ground_term scopes and their contents. +
  • +restrict_var_maps.m provides a mechanism +for restricting procedures' tables containing information about variables +to just the variables that occur in the procedure. +This is useful only after some part of the procedure body has been deleted.

    2. Semantic analysis and error checking

    diff --git a/compiler/restrict_var_maps.m b/compiler/restrict_var_maps.m new file mode 100644 index 000000000..5ebbb6d74 --- /dev/null +++ b/compiler/restrict_var_maps.m @@ -0,0 +1,298 @@ +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sw=4 et +%---------------------------------------------------------------------------% +% Copyright (C) 2009-2012 The University of Melbourne. +% Copyright (C) 2013-2026 The Mercury team. +% This file may only be copied under the terms of the GNU General +% Public License - see the file COPYING in the Mercury distribution. +%---------------------------------------------------------------------------% +% +% File: restrict_var_maps.m. +% Main author: zs. +% +% This module has the job of restricting a procedure's var_tables and +% rtti_varmaps structures to just the variables occurring in a its +% argument list and body goal. +% +%---------------------------------------------------------------------------% + +:- module hlds.restrict_var_maps. +:- interface. + +:- import_module hlds.hlds_goal. +:- import_module hlds.hlds_rtti. +:- import_module parse_tree. +:- import_module parse_tree.prog_data. +:- import_module parse_tree.var_table. + +:- import_module list. + +%---------------------------------------------------------------------------% + + % The proc_info has several maps that refer to variables. After lambda + % expansion, both the newly created procedures and the original procedure + % that they were carved out of have duplicate copies of these maps. + % This duplication is a problem because later passes (in particular, + % the equiv_types_hlds pass) iterate over the entries in these maps, + % and if an entry is duplicated N times, they have to process it N times. + % The task of this predicate is to eliminate unnecessary entries + % from the var_table, and this requires also eliminating them from + % the rtti_varmaps. + % + % We could in theory restrict the tvarset and the inst_varset as well, + % but since we don't iterate over those sets, there is (as yet) no need + % for this. + % +:- pred restrict_var_maps(list(prog_var)::in, hlds_goal::in, + var_table::in, var_table::out, rtti_varmaps::in, rtti_varmaps::out) is det. + +%---------------------------------------------------------------------------% + +:- implementation. + +:- import_module hlds.pred_proc_id. +:- import_module mdbcomp. +:- import_module mdbcomp.prim_data. + +:- import_module array. +:- import_module assoc_list. +:- import_module bool. +:- import_module int. +:- import_module maybe. +:- import_module pair. +:- import_module require. +:- import_module term. + +%---------------------------------------------------------------------------% + +restrict_var_maps(HeadVars, Goal, !VarTable, !RttiVarMaps) :- + % This code was added to the compiler (in what was then lambda.m) + % in 2009 in commit 62d7496a7e8cb11403b55433309edf8efb44c6b2 + % with the aim of eliminating some horrible worst-case behavior. + % + % The reason for the use here of an array of bools to represent + % whether our knowledge of which variables are used and which are not, + % instead of simply a set_of_var, is the fact that for some severe + % stress-test inputs, we judged the extra performance of this data + % structure compared to sparse bitsets to be worthwhile. + + var_table_max_var_num(!.VarTable, MaxVarNum), + % Variable numbers go from 1 to MaxVarNum. Reserve array slots + % from 0 to MaxVarNum, since wasting the space of one array element + % is preferable to having to do a subtraction on every array lookup. + array.init(MaxVarNum + 1, no, VarUses0), + mark_vars_as_used(HeadVars, VarUses0, VarUses1), + find_used_vars_in_goal(Goal, VarUses1, VarUses), + + var_table_to_sorted_assoc_list(!.VarTable, VarTableEntries0), + filter_var_table_entries(VarTableEntries0, VarUses, + [], RevVarTableEntries), + var_table_from_rev_sorted_assoc_list(RevVarTableEntries, !:VarTable), + + restrict_rtti_varmaps(VarUses, !RttiVarMaps). + +:- pred find_used_vars_in_goal(hlds_goal::in, + array(bool)::array_di, array(bool)::array_uo) is det. + +find_used_vars_in_goal(Goal, !VarUses) :- + Goal = hlds_goal(GoalExpr, _GoalInfo), + ( + GoalExpr = unify(LHSVar, RHS, _, Unif, _), + mark_var_as_used(LHSVar, !VarUses), + ( + Unif = construct(_, _, _, _, CellToReuse, _, _), + ( if CellToReuse = reuse_cell(cell_to_reuse(ReuseVar, _, _)) then + mark_var_as_used(ReuseVar, !VarUses) + else + true + ) + ; + ( Unif = deconstruct(_, _, _, _, _, _) + ; Unif = assign(_, _) + ; Unif = simple_test(_, _) + ; Unif = complicated_unify(_, _, _) + ) + ), + find_used_vars_in_unify_rhs(RHS, !VarUses) + ; + GoalExpr = generic_call(GenericCall, ArgVars, _, _, _), + ( + GenericCall = higher_order(Var, _, _, _, _), + mark_var_as_used(Var, !VarUses) + ; + GenericCall = class_method(Var, _, _, _), + mark_var_as_used(Var, !VarUses) + ; + GenericCall = event_call(_) + ; + GenericCall = cast(_) + ), + mark_vars_as_used(ArgVars, !VarUses) + ; + GoalExpr = plain_call(_, _, ArgVars, _, MaybeCallUnifyContext, _), + mark_vars_as_used(ArgVars, !VarUses), + ( + MaybeCallUnifyContext = no + ; + MaybeCallUnifyContext = yes(CallUnifyContext), + CallUnifyContext = call_unify_context(Var, RHS, _UC), + mark_var_as_used(Var, !VarUses), + find_used_vars_in_unify_rhs(RHS, !VarUses) + ) + ; + ( GoalExpr = conj(_, Goals) + ; GoalExpr = disj(Goals) + ), + find_used_vars_in_goals(Goals, !VarUses) + ; + GoalExpr = switch(Var, _Det, Cases), + mark_var_as_used(Var, !VarUses), + find_used_vars_in_cases(Cases, !VarUses) + ; + GoalExpr = scope(Reason, SubGoal), + ( + Reason = exist_quant(Vars, _), + mark_vars_as_used(Vars, !VarUses) + ; + Reason = promise_solutions(Vars, _), + mark_vars_as_used(Vars, !VarUses) + ; + Reason = from_ground_term(Var, _), + mark_var_as_used(Var, !VarUses) + ; + Reason = loop_control(LCVar, LCSVar, _), + mark_var_as_used(LCVar, !VarUses), + mark_var_as_used(LCSVar, !VarUses) + ; + ( Reason = disable_warnings(_, _) + ; Reason = promise_purity(_) + ; Reason = barrier(_) + ; Reason = commit(_) + ; Reason = trace_goal(_, _, _, _, _) + ) + % Do nothing. + ; + ( Reason = require_detism(_) + ; Reason = require_complete_switch(_) + ; Reason = require_switch_arms_detism(_, _) + ), + % These scopes should have been deleted by now. + unexpected($pred, "unexpected scope") + ), + find_used_vars_in_goal(SubGoal, !VarUses) + ; + GoalExpr = negation(SubGoal), + find_used_vars_in_goal(SubGoal, !VarUses) + ; + GoalExpr = if_then_else(Vars, Cond, Then, Else), + mark_vars_as_used(Vars, !VarUses), + find_used_vars_in_goal(Cond, !VarUses), + find_used_vars_in_goal(Then, !VarUses), + find_used_vars_in_goal(Else, !VarUses) + ; + GoalExpr = call_foreign_proc(_, _, _, Args, ExtraArgs, _, _), + ArgVars = list.map(foreign_arg_var, Args), + ExtraVars = list.map(foreign_arg_var, ExtraArgs), + mark_vars_as_used(ArgVars, !VarUses), + mark_vars_as_used(ExtraVars, !VarUses) + ; + GoalExpr = shorthand(Shorthand), + ( + Shorthand = atomic_goal(_, Outer, Inner, MaybeOutputVars, + MainGoal, OrElseGoals, _), + Outer = atomic_interface_vars(OuterDI, OuterUO), + mark_var_as_used(OuterDI, !VarUses), + mark_var_as_used(OuterUO, !VarUses), + Inner = atomic_interface_vars(InnerDI, InnerUO), + mark_var_as_used(InnerDI, !VarUses), + mark_var_as_used(InnerUO, !VarUses), + ( + MaybeOutputVars = no + ; + MaybeOutputVars = yes(OutputVars), + mark_vars_as_used(OutputVars, !VarUses) + ), + find_used_vars_in_goal(MainGoal, !VarUses), + find_used_vars_in_goals(OrElseGoals, !VarUses) + ; + Shorthand = try_goal(_, _, SubGoal), + % The IO and Result variables would be in SubGoal. + find_used_vars_in_goal(SubGoal, !VarUses) + ; + Shorthand = bi_implication(LeftGoal, RightGoal), + find_used_vars_in_goal(LeftGoal, !VarUses), + find_used_vars_in_goal(RightGoal, !VarUses) + ) + ). + +:- pred find_used_vars_in_goals(list(hlds_goal)::in, + array(bool)::array_di, array(bool)::array_uo) is det. + +find_used_vars_in_goals([], !VarUses). +find_used_vars_in_goals([Goal | Goals], !VarUses) :- + find_used_vars_in_goal(Goal, !VarUses), + find_used_vars_in_goals(Goals, !VarUses). + +:- pred find_used_vars_in_cases(list(case)::in, + array(bool)::array_di, array(bool)::array_uo) is det. + +find_used_vars_in_cases([], !VarUses). +find_used_vars_in_cases([Case | Cases], !VarUses) :- + Case = case(_, _, Goal), + find_used_vars_in_goal(Goal, !VarUses), + find_used_vars_in_cases(Cases, !VarUses). + +:- pred find_used_vars_in_unify_rhs(unify_rhs::in, + array(bool)::array_di, array(bool)::array_uo) is det. + +find_used_vars_in_unify_rhs(RHS, !VarUses) :- + ( + RHS = rhs_var(RHSVar), + mark_var_as_used(RHSVar, !VarUses) + ; + RHS = rhs_functor(_, _, ArgVars), + mark_vars_as_used(ArgVars, !VarUses) + ; + RHS = rhs_lambda_goal(_, _, _, NonLocals, ArgVarsModes, _, LambdaGoal), + assoc_list.keys(ArgVarsModes, ArgVars), + mark_vars_as_used(NonLocals, !VarUses), + mark_vars_as_used(ArgVars, !VarUses), + find_used_vars_in_goal(LambdaGoal, !VarUses) + ). + +:- pred mark_var_as_used(prog_var::in, + array(bool)::array_di, array(bool)::array_uo) is det. +:- pragma inline(pred(mark_var_as_used/3)). + +mark_var_as_used(Var, !VarUses) :- + array.set(var_to_int(Var), yes, !VarUses). + +:- pred mark_vars_as_used(list(prog_var)::in, + array(bool)::array_di, array(bool)::array_uo) is det. + +mark_vars_as_used([], !VarUses). +mark_vars_as_used([Var | Vars], !VarUses) :- + mark_var_as_used(Var, !VarUses), + mark_vars_as_used(Vars, !VarUses). + +:- pred filter_var_table_entries(assoc_list(prog_var, var_table_entry)::in, + array(bool)::in, + assoc_list(prog_var, var_table_entry)::in, + assoc_list(prog_var, var_table_entry)::out) is det. + +filter_var_table_entries([], _VarUses, !RevVarsEntries). +filter_var_table_entries([VarEntry | VarsEntries], VarUses, !RevVarsEntries) :- + VarEntry = Var - _Entry, + VarNum = var_to_int(Var), + array.unsafe_lookup(VarUses, VarNum, Used), + ( + Used = yes, + !:RevVarsEntries = [VarEntry | !.RevVarsEntries] + ; + Used = no + ), + filter_var_table_entries(VarsEntries, VarUses, !RevVarsEntries). + +%---------------------------------------------------------------------------% +:- end_module hlds.restrict_var_maps. +%---------------------------------------------------------------------------% diff --git a/compiler/simplify_goal.m b/compiler/simplify_goal.m index 28b668ffa..4ea48c33a 100644 --- a/compiler/simplify_goal.m +++ b/compiler/simplify_goal.m @@ -247,6 +247,8 @@ maybe_simplify_goal_to_true_or_fail(InstMap0, Goal0ContainsTrace, % If the goal had any non-locals, we should requantify. NonLocals0 = goal_info_get_nonlocals(GoalInfo0), + % simplify_info_set_have_we_deleted_goals(we_have_deleted_goals, + % !Info), ( if set_of_var.is_empty(NonLocals0) then true else diff --git a/compiler/simplify_info.m b/compiler/simplify_info.m index be22b19d2..62ea329eb 100644 --- a/compiler/simplify_info.m +++ b/compiler/simplify_info.m @@ -113,6 +113,12 @@ ---> do_not_rerun_det ; rerun_det. +% This type is not (yet) needed. +% +% :- type have_we_deleted_goals +% ---> we_have_not_deleted_goals +% ; we_have_deleted_goals. + :- type maybe_rerun_simplify_no_warn_simple ---> do_not_rerun_simplify_no_warn_simple ; rerun_simplify_no_warn_simple. @@ -209,6 +215,8 @@ is det. :- pred simplify_info_get_has_user_event(simplify_info::in, has_user_event::out) is det. +% :- pred simplify_info_get_have_we_deleted_goals(simplify_info::in, +% have_we_deleted_goals::out) is det. :- pred simplify_info_get_deleted_call_callees(simplify_info::in, set(pred_proc_id)::out) is det. :- pred simplify_info_get_switch_arms_to_split(simplify_info::in, @@ -245,6 +253,8 @@ simplify_info::in, simplify_info::out) is det. :- pred simplify_info_set_has_user_event(has_user_event::in, simplify_info::in, simplify_info::out) is det. +% :- pred simplify_info_set_have_we_deleted_goals(have_we_deleted_goals::in, +% simplify_info::in, simplify_info::out) is det. :- pred simplify_info_set_deleted_call_callees(set(pred_proc_id)::in, simplify_info::in, simplify_info::out) is det. :- pred simplify_info_set_switch_arms_to_split(set(switch_arm)::in, @@ -394,6 +404,10 @@ % Have we seen an event call? ssimp_has_user_event :: has_user_event, + % Have we deleted one or more goals? + % This field is not yet used. +% ssimp_deleted_goals :: have_we_deleted_goals, + % The set of predicates that we deleted calls to while % simplifying the procedure body. ssimp_deleted_call_callees :: set(pred_proc_id), @@ -452,7 +466,8 @@ simplify_info_init(ProgressStream, ModuleInfo, PredId, ProcId, ProcInfo, HasParallelConj = has_no_parallel_conj, FoundContainsTrace = no, HasUserEvent = has_no_user_event, - set.init(TraceGoalProcs), + % HaveWeDeletedGoals = we_have_not_deleted_goals, + set.init(DeletedGoalCallees), set.init(SwitchArmsToSplit), pred_info_get_status(PredInfo, PredStatus), pred_status_defined_in_this_module(PredStatus) = InThisModule, @@ -463,7 +478,8 @@ simplify_info_init(ProgressStream, ModuleInfo, PredId, ProcId, ProcInfo, SubInfo = simplify_sub_info(RttiVarMaps, ElimVars, Specs, CostDelta, AllowMsgs, HasParallelConj, FoundContainsTrace, HasUserEvent, - TraceGoalProcs, SwitchArmsToSplit, DefinedWhere, RerunSimplify), + /* HaveWeDeletedGoals, */ DeletedGoalCallees, SwitchArmsToSplit, + DefinedWhere, RerunSimplify), % SimplifyTasks % ModuleInfo @@ -569,6 +585,8 @@ simplify_info_get_found_contains_trace(Info, X) :- X = Info ^ simp_sub_info ^ ssimp_found_contains_trace. simplify_info_get_has_user_event(Info, X) :- X = Info ^ simp_sub_info ^ ssimp_has_user_event. +% simplify_info_get_have_we_deleted_goals(Info, X) :- +% X = Info ^ simp_sub_info ^ ssimp_deleted_goals. simplify_info_get_deleted_call_callees(Info, X) :- X = Info ^ simp_sub_info ^ ssimp_deleted_call_callees. simplify_info_get_switch_arms_to_split(Info, X) :- @@ -648,6 +666,15 @@ simplify_info_set_has_user_event(X, !Info) :- else !Info ^ simp_sub_info ^ ssimp_has_user_event := X ). +% simplify_info_set_have_we_deleted_goals(X, !Info) :- +% ( if +% private_builtin.pointer_equal(X, +% !.Info ^ simp_sub_info ^ ssimp_deleted_goals) +% then +% true +% else +% !Info ^ simp_sub_info ^ ssimp_deleted_goals := X +% ). simplify_info_set_deleted_call_callees(X, !Info) :- ( if private_builtin.pointer_equal(X, diff --git a/compiler/simplify_proc.m b/compiler/simplify_proc.m index b1879b2ed..dee3051ff 100644 --- a/compiler/simplify_proc.m +++ b/compiler/simplify_proc.m @@ -103,6 +103,7 @@ :- import_module hlds.passes_aux. :- import_module hlds.proc_info_types. :- import_module hlds.quantification. +:- import_module hlds.restrict_var_maps. :- import_module hlds.status. :- import_module libs. :- import_module libs.globals. @@ -336,14 +337,15 @@ simplify_proc_return_msgs(ProgressStream, SimplifyTasks0, PredId, ProcId, proc_info_set_goal(Goal, !ProcInfo), simplify_info_get_var_table(Info, VarTable0), - simplify_info_get_rtti_varmaps(Info, RttiVarMaps), + simplify_info_get_rtti_varmaps(Info, RttiVarMaps0), simplify_info_get_elim_vars(Info, ElimVarsLists0), % We sort the lists basically on the number of the first variable. list.sort(ElimVarsLists0, ElimVarsLists), list.condense(ElimVarsLists, ElimVars), delete_var_entries(ElimVars, VarTable0, VarTable1), simplify_info_get_module_info(Info, !:ModuleInfo), - % We only eliminate vars that cannot occur in RttiVarMaps. + proc_info_get_headvars(!.ProcInfo, HeadVars), + % We only eliminate vars that cannot occur in RttiVarMaps0. ( if simplify_do_after_front_end(Info) then proc_info_get_var_name_remap(!.ProcInfo, VarNameRemap), RenameVar = @@ -352,19 +354,29 @@ simplify_proc_return_msgs(ProgressStream, SimplifyTasks0, PredId, ProcId, E = E0 ^ vte_name := N, update_var_entry(V, E, VT0, VT) ), - map.foldl(RenameVar, VarNameRemap, VarTable1, VarTable), + map.foldl(RenameVar, VarNameRemap, VarTable1, VarTable2), proc_info_set_var_name_remap(map.init, !ProcInfo), - proc_info_get_headvars(!.ProcInfo, HeadVars), proc_info_get_argmodes(!.ProcInfo, ArgModes), - find_and_record_any_direct_arg_in_out_posns(PredId, ProcId, VarTable, + 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, - RttiVarMaps, !.Specs, _) + RttiVarMaps0, !.Specs, _) else - VarTable = VarTable1 + VarTable2 = VarTable1 + ), + simplify_info_get_simplify_tasks(Info, Tasks), + MaybeDeleteDeadVars = Tasks ^ do_delete_dead_vars, + ( + MaybeDeleteDeadVars = do_not_delete_dead_vars, + VarTable = VarTable2, + RttiVarMaps = RttiVarMaps0 + ; + MaybeDeleteDeadVars = delete_dead_vars, + restrict_var_maps(HeadVars, Goal, + VarTable2, VarTable, RttiVarMaps0, RttiVarMaps) ), proc_info_set_var_table(VarTable, !ProcInfo), proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo), diff --git a/compiler/simplify_tasks.m b/compiler/simplify_tasks.m index 08a55d7ff..77e09c936 100644 --- a/compiler/simplify_tasks.m +++ b/compiler/simplify_tasks.m @@ -104,6 +104,11 @@ ; simptask_warn_no_solution_disjunct % Warn about disjuncts that can have no solution. + ; simptask_delete_dead_vars + % Delete from varsets, var_tables and rtti_varmaps in proc_infos + % any (program) variables that do not occur either in the + % procedure's argument list or in its body goal. + ; simptask_split_switch_arms. % Invoke split_switch_arms.m to perform its transformation, % if the main part of simplification discovers that it has @@ -170,6 +175,10 @@ ---> do_not_warn_no_soln_disjunct ; warn_no_soln_disjunct. +:- type maybe_delete_dead_vars + ---> do_not_delete_dead_vars + ; delete_dead_vars. + :- type maybe_opt_split_switch_arms ---> do_not_opt_split_switch_arms ; split_opt_switch_arms. @@ -203,6 +212,7 @@ do_ignore_par_conjunctions :: maybe_ignore_par_conjs, do_warn_suspicious_recursion :: maybe_warn_suspicious_rec, do_warn_no_solution_disjunct :: maybe_warn_no_soln_disjunct, + do_delete_dead_vars :: maybe_delete_dead_vars, do_switch_split_arms :: maybe_split_switch_arms ). @@ -243,7 +253,8 @@ simplify_tasks_to_list(SimplifyTasks) = !:List :- MergeCodeAfterSwitch, ElimRemovableScopes, OptDuplicateCalls, ConstantProp, OptCommonStructs, OptExtraStructs, TryOptConstStructs, _OptConstStructs, IgnoreParConjs, - WarnSuspiciousRecursion, WarnNoSolutionDisjunct, SplitSwitchArms), + WarnSuspiciousRecursion, WarnNoSolutionDisjunct, DeleteDeadVars, + SplitSwitchArms), !:List = [], ( if WarnDodgySimple = warn_dodgy_simple_code then list.cons(simptask_warn_dodgy_simple_code, !List) else true ), @@ -281,6 +292,8 @@ simplify_tasks_to_list(SimplifyTasks) = !:List :- then list.cons(simptask_warn_suspicious_recursion, !List) else true ), ( if WarnNoSolutionDisjunct = warn_no_soln_disjunct then list.cons(simptask_warn_no_solution_disjunct, !List) else true ), + ( if DeleteDeadVars = delete_dead_vars + then list.cons(simptask_delete_dead_vars, !List) else true ), ( if SplitSwitchArms = split_switch_arms then list.cons(simptask_split_switch_arms, !List) else true ). @@ -331,6 +344,8 @@ list_to_simplify_tasks(Globals, List) = Tasks :- then warn_suspicious_rec else do_not_warn_suspicious_rec ), ( if list.member(simptask_warn_no_solution_disjunct, List) then warn_no_soln_disjunct else do_not_warn_no_soln_disjunct ), + ( if list.member(simptask_delete_dead_vars, List) + then delete_dead_vars else do_not_delete_dead_vars ), ( if list.member(simptask_split_switch_arms, List) then split_switch_arms else do_not_split_switch_arms ) ). @@ -376,6 +391,7 @@ find_simplify_tasks(Globals, WarnThisPass, SimplifyTasks) :- globals.lookup_bool_option(Globals, warn_suspicious_recursion, WarnSuspiciousRecursion), SplitSwitchArms = OptTuple ^ ot_split_switch_arms, + DeleteDeadVars = do_not_delete_dead_vars, SimplifyTasks = simplify_tasks( ( if WarnDodgySimple = yes, WarnThisPass = generate_warnings @@ -406,6 +422,7 @@ find_simplify_tasks(Globals, WarnThisPass, SimplifyTasks) :- % about simple code that happens to have its own disabling mechanism. ( if WarnDodgySimple = yes, WarnThisPass = generate_warnings then warn_no_soln_disjunct else do_not_warn_no_soln_disjunct ), + DeleteDeadVars, SplitSwitchArms ).