mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-16 01:43:35 +00:00
Code Issues Projects Releases Wiki Activity
Files
faffe6c42ceb7dbc19a33529035529f29f04ada6
mercury/compiler/erl_code_util.m
Zoltan Somogyi 62ec97d443 Report imports shadowed by other imports. 
If a module has two or more import_module or use_module declarations
for the same module, (typically, but not always, one being in its interface
and one in its implementation), generate an informational message about
each redundant declaration if --warn-unused-imports is enabled.

compiler/hlds_module.m:
    We used to record the set of imported/used modules, and the set of
    modules imported/used in the interface of the current module. However,
    these sets

    - did not record the distinction between imports and uses;
    - did not allow distinction between single and multiple imports/uses;
    - did not record the locations of the imports/uses.

    The first distinction was needed only by module_qual.m, which *did*
    pay attention to it; the other two were not needed at all.

    To generate messages for imports/uses shadowing other imports/uses,
    we need all three, so change the data structure storing such information
    for *direct* imports to one that records all three of the above kinds
    of information. (For imports made by read-in interface and optimization
    files, the old set of modules approach is fine, and this diff leaves
    the set of thus *indirectly* imported module names alone.)

compiler/unused_imports.m:
    Use the extra information now available to generate a
    severity_informational message about any import or use that is made
    redundant by an earlier, more general import or use.

    Fix two bugs in the code that generated warnings for just plain unused
    modules.

    (1) It did not consider that a use of the builtin type char justified
    an import of char.m, but without that import, the type is not visible.

    (2) It scanned cons_ids in goals in procedure bodies, but did not scan
    cons_ids that have been put into the const_struct_db. (I did not update
    the code here when I added the const_struct_db.)

    Also, add a (hopefully temporary) workaround for a bug in
    make_hlds_passes.m, which is noted below.

    However, there are at least three problems that prevent us from enabling
    --warn-unused-imports by default.

    (1) In some places, the import of a module is used only by clauses for
    a predicate that also has foreign procs. When compiled in a grade that
    selects one of those foreign_procs as the implementation of the predicate,
    the clauses are discarded *without* being added to the HLDS at all.
    This leads unused_imports.m to generate an uncalled-for warning in such
    cases. To fix this, we would need to preserve the Mercury clauses for
    *all* predicates, even those with foreign procs, and do all the semantic
    checks on them before throwing them away. (I tried to do this once, and
    failed, but the task should be easier after the item list change.)

    (2) We have two pieces of code to generate import warnings. The one in
    unused_imports.m operates on the HLDS after type and mode checking,
    while module_qual.m operates on the parse tree before the creation of
    the HLDS. The former is more powerful, since it knows e.g. what types and
    modes are used in the bodies of predicates, and hence can generate warnings
    about an import being unused *anywhere* in a module, as opposed to just
    unused in its interface.

    If --warn-unused-imports is enabled, we will get two separate set of
    reports about an interface import being unused in the interface,
    *unless* we get a type or mode error, in which case unused_imports.m
    won't be invoked. But in case we do get such errors, we don't want to
    throw away the warnings from module_qual.m. We could store them and
    throw them away only after we know we won't need them, or just get
    the two modules to generate identical error_specs for each warning,
    so that the sort_and_remove_dups of the error specs will do the
    throwing away for us for free, if we get that far.

    (3) The valid/bug100.m test case was added as a regression test for a bug
    that was fixed in module_qual.m. However the bug is still present in
    unused_imports.m.

compiler/make_hlds_passes.m:
    Give hlds_module.m the extra information it now needs for each item_avail.

    Add an XXX for a bug that cannot be fixed right now: the setting of
    the status of abstract instances to abstract_imported. (The "abstract"
    part is correct; the "imported" part may not be.)

compiler/intermod.m:
compiler/try_expand.m:
compiler/xml_documentation.m:
    Conform to the change in hlds_module.m.

compiler/module_qual.m:
    Update the documentation of the relationship of this module
    with unused_imports.m.

compiler/hlds_data.m:
    Document a problem with the status of instance definitions.

compiler/hlds_out_module.m:
    Update the code that prints out the module_info to conform to the change
    to hlds_module.m.

    Print status information about instances, which was needed to diagnose
    one of the bugs in unused_imports.m. Format the output for instances
    nicer.

compiler/prog_item.m:
    Add a convenience predicate.

compiler/prog_data.m:
    Remove a type synonym that makes things harder to understand, not easier.

compiler/modules.m:
    Delete an XXX that asks for the feature this diff implements.
    Add another XXX about how that feature could be improved.

compiler/Mercury.options.m:
    Add some more modules to the list of modules on which the compiler
    should be invoked with --no-warn-unused-imports.

compiler/*.m:
library/*.m:
mdbcomp/*.m:
browser/*.m:
deep_profiler/*.m:
mfilterjavac/*.m:
    Delete unneeded imports. Many of these shadow other imports, and some
    are just plain unneeded, as shown by --warn-unused-imports. In a few
    modules, there were a *lot* of unneeded imports, but most had just
    one or two.

    In a few cases, removing an import from a module, because it *itself*
    does not need it, required adding that same import to those of its
    submodules which *do* need it.

    In a few cases, conform to other changes above.

tests/invalid/Mercury.options:
    Test the generation of messages about import shadowing on the existing
    import_in_parent.m test case (although it was also tested very thoroughly
    when giving me the information needed for the deletion of all the
    unneeded imports above).

tests/*/*.{m,*exp}:
    Delete unneeded imports, and update any expected error messages
    to expect the now-smaller line numbers.
2015-08-25 00:38:49 +10:00

1011 lines
33 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2007-2008, 2010-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: erl_code_util.m.
% Main author: wangp.
%
% This module is part of the Erlang code generator.
%
%-----------------------------------------------------------------------------%
:- module erl_backend.erl_code_util.
:- interface.
:- import_module erl_backend.elds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.instmap.
:- import_module hlds.vartypes.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.set_of_var.
:- import_module list.
:- import_module maybe.
:- import_module set.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% The `erl_gen_info' ADT.
%
% The `erl_gen_info' type holds information used during
% ELDS code generation for a given procedure.
%
:- type erl_gen_info.
% Initialize the erl_gen_info, so that it is ready for generating code
% for the given procedure.
%
:- func erl_gen_info_init(module_info, pred_id, proc_id) = erl_gen_info.
:- pred erl_gen_info_get_module_info(erl_gen_info::in, module_info::out)
is det.
:- pred erl_gen_info_get_varset(erl_gen_info::in, prog_varset::out) is det.
:- pred erl_gen_info_get_var_types(erl_gen_info::in, vartypes::out) is det.
:- pred erl_gen_info_get_input_vars(erl_gen_info::in, prog_vars::out) is det.
:- pred erl_gen_info_get_output_vars(erl_gen_info::in, prog_vars::out) is det.
% Create a new variable.
%
:- pred erl_gen_info_new_named_var(string::in, prog_var::out,
erl_gen_info::in, erl_gen_info::out) is det.
% Create multiple new variables.
%
:- pred erl_gen_info_new_vars(int::in, prog_vars::out,
erl_gen_info::in, erl_gen_info::out) is det.
% Create multiple new variables, which have names beginning with
% underscores.
%
:- pred erl_gen_info_new_anonymous_vars(int::in, prog_vars::out,
erl_gen_info::in, erl_gen_info::out) is det.
% Lookup the types of a list of variables.
%
:- pred erl_variable_types(erl_gen_info::in, prog_vars::in,
list(mer_type)::out) is det.
% Lookup the type of a variable.
%
:- pred erl_variable_type(erl_gen_info::in, prog_var::in, mer_type::out)
is det.
% Add the given string as the name of an environment variable used by
% the function being generated.
%
:- pred erl_gen_info_add_env_var_name(string::in,
erl_gen_info::in, erl_gen_info::out) is det.
% Get the names of the used environment variables.
%
:- pred erl_gen_info_get_env_vars(erl_gen_info::in, set(string)::out) is det.
%-----------------------------------------------------------------------------%
%
% Various utility routines used for ELDS code generation
%
:- type opt_dummy_args
---> opt_dummy_args
; no_opt_dummy_args.
% erl_gen_arg_list(ModuleInfo, OptDummyArgs, Vars, VarTypes, VarModes,
% InputVars, OutputVars)
%
% Separate procedure call arguments into inputs and output variables.
% If OptDummyArgs is `opt_dummy_args' then variables which are of dummy
% types or have argument mode `top_unused' will be ignored, i.e. not appear
% in either InputVars or OutputVars.
%
:- pred erl_gen_arg_list(module_info::in, opt_dummy_args::in,
list(T)::in, list(mer_type)::in, list(mer_mode)::in,
list(T)::out, list(T)::out) is det.
% As above but takes arg_modes instead of mer_modes.
%
:- pred erl_gen_arg_list_arg_modes(module_info::in, opt_dummy_args::in,
list(T)::in, list(mer_type)::in, list(arg_mode)::in,
list(T)::out, list(T)::out) is det.
% erl_fix_success_expr(InstMap, Goal, MaybeExpr0, MaybeExpr, !Info)
%
% Success expressions may contain assignments. Assignments to local
% variables may be incorrect or raise warnings from the Erlang compiler if
% a success expression is duplicated. Hence we rename away local variables
% when duplicating a success expression.
%
% This predicate renames any local variables appearing in the success
% expression (if any) to fresh variables, where local variables are those
% which are not bound in InstMap and not bound within Goal.
%
:- pred erl_fix_success_expr(instmap::in, hlds_goal::in,
maybe(elds_expr)::in, maybe(elds_expr)::out,
erl_gen_info::in, erl_gen_info::out) is det.
% Return the set of non-dummy variables non-local to a goal which are bound
% by that goal.
%
:- pred erl_bound_nonlocals_in_goal(erl_gen_info::in, instmap::in,
hlds_goal::in, set_of_progvar::out) is det.
% erl_bind_unbound_vars(Info, VarsToBind, Goal, InstMap, !Statement)
%
% For any variables in VarsToBind which are not bound in Goal, add
% assignment expressions to !Statement. This is necessary to ensure that
% all branches of ELDS code bind the same variables, to avoid warnings from
% the Erlang compiler when one branch doesn't bind all the variables
% because it has determinism `erroneous'. The values given to the
% variables do not matter since this is only done to appease the
% Erlang compiler.
%
% VarsToBind must not include dummy variables.
%
:- pred erl_bind_unbound_vars(erl_gen_info::in, set_of_progvar::in,
hlds_goal::in, instmap::in, elds_expr::in, elds_expr::out) is det.
% erl_var_or_dummy_replacement(ModuleInfo, VarTypes, DummyRepl, Var) = Expr
%
% Return DummyRepl if Var is of a dummy type, otherwise return
% Var.
%
:- func erl_var_or_dummy_replacement(module_info, vartypes, elds_term,
prog_var) = elds_expr.
% erl_create_renaming(Vars, Subst, !Info):
%
% Create a substitution for each variable in Vars to a fresh variable.
%
:- pred erl_create_renaming(prog_vars::in, prog_var_renaming::out,
erl_gen_info::in, erl_gen_info::out) is det.
% erl_rename_vars_in_expr(Subn, Expr0, Expr):
%
% Substitute every occurrence of any variable for a substitute that appears
% in the mapping Subn. Variables which do not appear in Subn are left
% unsubstituted.
%
:- pred erl_rename_vars_in_expr(prog_var_renaming::in,
elds_expr::in, elds_expr::out) is det.
% erl_rename_vars_in_expr_except(KeepVars, Expr0, Expr, !Info):
%
% Rename all variables in Expr0 to fresh variables, except for the
% variables in the set KeepVars.
%
:- pred erl_rename_vars_in_expr_except(set_of_progvar::in,
elds_expr::in, elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
% erl_expr_vars(Expr, Vars)
%
% Vars is the set of variables appearing in Expr.
%
:- pred erl_expr_vars(elds_expr::in, set_of_progvar::out) is det.
% Return a rough indication of the "size" of an expression, where each
% simple constant has a value of 1. This is used to decide if an
% expression is too big to duplicate.
%
:- func erl_expr_size(elds_expr) = int.
% maybe_simplify_nested_cases(Expr0, Expr)
%
% Simplify Expr0 if it is a case expression of a specific form, otherwise
% return it unchanged. (See a later comment for the form.)
%
:- pred maybe_simplify_nested_cases(elds_expr::in, elds_expr::out) is det.
%-----------------------------------------------------------------------------%
:- func erl_base_typeclass_info_method_offset = int.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.goal_util.
:- import_module int.
:- import_module map.
:- import_module require.
:- import_module term.
:- import_module varset.
%-----------------------------------------------------------------------------%
%
% The definition of the `erl_gen_info' ADT.
%
% The `erl_gen_info' type holds information used during Erlang code generation
% for a given procedure.
:- type erl_gen_info
---> erl_gen_info(
% These fields remain constant for each procedure,
% except for the varset and the set of environment variables,
% which can be added to.
egi_module_info :: module_info,
egi_pred_id :: pred_id,
egi_proc_id :: proc_id,
egi_varset :: prog_varset,
egi_var_types :: vartypes,
% input_vars and output_vars do not include variables of dummy
% types.
egi_input_vars :: list(prog_var),
egi_output_vars :: list(prog_var),
% Set of environment variables used by this procedure.
egi_env_var_names :: set(string)
).
erl_gen_info_init(ModuleInfo, PredId, ProcId) = Info :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
proc_info_get_headvars(ProcInfo, HeadVars),
proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_vartypes(ProcInfo, VarTypes),
proc_info_get_argmodes(ProcInfo, HeadModes),
pred_info_get_arg_types(PredInfo, HeadTypes),
erl_gen_arg_list(ModuleInfo, opt_dummy_args,
HeadVars, HeadTypes, HeadModes, InputVars, OutputVars),
EnvVars = set.init,
Info = erl_gen_info(
ModuleInfo,
PredId,
ProcId,
VarSet,
VarTypes,
InputVars,
OutputVars,
EnvVars
).
erl_gen_info_get_module_info(Info, Info ^ egi_module_info).
erl_gen_info_get_varset(Info, Info ^ egi_varset).
erl_gen_info_get_var_types(Info, Info ^ egi_var_types).
erl_gen_info_get_input_vars(Info, Info ^ egi_input_vars).
erl_gen_info_get_output_vars(Info, Info ^ egi_output_vars).
:- pred erl_gen_info_set_varset(prog_varset::in,
erl_gen_info::in, erl_gen_info::out) is det.
erl_gen_info_set_varset(VarSet, !Info) :-
!Info ^ egi_varset := VarSet.
erl_gen_info_new_named_var(Name, NewVar, !Info) :-
erl_gen_info_get_varset(!.Info, VarSet0),
varset.new_named_var(Name, NewVar, VarSet0, VarSet),
erl_gen_info_set_varset(VarSet, !Info).
erl_gen_info_new_vars(Num, NewVars, !Info) :-
erl_gen_info_get_varset(!.Info, VarSet0),
varset.new_vars(Num, NewVars, VarSet0, VarSet),
erl_gen_info_set_varset(VarSet, !Info).
erl_gen_info_new_anonymous_vars(Num, NewVars, !Info) :-
erl_gen_info_get_varset(!.Info, VarSet0),
list.map_foldl(erl_gen_info_new_anonymous_var, 1 .. Num, NewVars,
VarSet0, VarSet),
erl_gen_info_set_varset(VarSet, !Info).
:- pred erl_gen_info_new_anonymous_var(int::in, prog_var::out,
prog_varset::in, prog_varset::out) is det.
erl_gen_info_new_anonymous_var(_Num, NewVar, !VarSet) :-
varset.new_named_var("_", NewVar, !VarSet).
erl_variable_types(Info, Vars, Types) :-
list.map(erl_variable_type(Info), Vars, Types).
erl_variable_type(Info, Var, Type) :-
erl_gen_info_get_var_types(Info, VarTypes),
lookup_var_type(VarTypes, Var, Type).
erl_gen_info_add_env_var_name(Name, !Info) :-
EnvVarNames0 = !.Info ^ egi_env_var_names,
set.insert(Name, EnvVarNames0, EnvVarNames),
!Info ^ egi_env_var_names := EnvVarNames.
erl_gen_info_get_env_vars(Info, Info ^ egi_env_var_names).
%-----------------------------------------------------------------------------%
%
% Various utility routines used for ELDS code generation
%
% XXX arg_info.partition_* does a similar thing but returns sets instead
% of lists
%
erl_gen_arg_list(ModuleInfo, OptDummyArgs, VarNames, ArgTypes, Modes,
Inputs, Outputs) :-
modes_to_arg_modes(ModuleInfo, Modes, ArgTypes, ArgModes),
erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
VarNames, ArgTypes, ArgModes, Inputs, Outputs).
erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
VarNames, ArgTypes, ArgModes, Inputs, Outputs) :-
(
VarNames = [],
ArgTypes = [],
ArgModes = []
->
Inputs = [],
Outputs = []
;
VarNames = [VarName | VarNames1],
ArgTypes = [ArgType | ArgTypes1],
ArgModes = [ArgMode | ArgModes1]
->
erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
VarNames1, ArgTypes1, ArgModes1, Inputs1, Outputs1),
(
OptDummyArgs = opt_dummy_args,
% Exclude arguments of type io.state etc.
% Also exclude those with arg_mode `top_unused'.
( check_dummy_type(ModuleInfo, ArgType) = is_dummy_type
; ArgMode = top_unused
)
->
Inputs = Inputs1,
Outputs = Outputs1
;
(
ArgMode = top_in,
% It's an input argument.
Inputs = [VarName | Inputs1],
Outputs = Outputs1
;
( ArgMode = top_out
; ArgMode = top_unused
),
% It's an output argument.
Inputs = Inputs1,
Outputs = [VarName | Outputs1]
)
)
;
unexpected($module, $pred, "length mismatch")
).
%-----------------------------------------------------------------------------%
erl_fix_success_expr(InstMap0, Goal, MaybeExpr0, MaybeExpr, !Info) :-
(
MaybeExpr0 = yes(Expr0),
erl_gen_info_get_module_info(!.Info, ModuleInfo),
update_instmap(Goal, InstMap0, InstMap),
instmap_bound_vars(InstMap, ModuleInfo, BoundVars),
erl_rename_vars_in_expr_except(BoundVars, Expr0, Expr, !Info),
MaybeExpr = yes(Expr)
;
MaybeExpr0 = no,
MaybeExpr = no
).
%-----------------------------------------------------------------------------%
erl_bound_nonlocals_in_goal(Info, InstMap, Goal, BoundNonLocals) :-
erl_gen_info_get_module_info(Info, ModuleInfo),
erl_gen_info_get_var_types(Info, VarTypes),
Goal = hlds_goal(_, GoalInfo),
NonLocals = goal_info_get_nonlocals(GoalInfo),
InstmapDelta = goal_info_get_instmap_delta(GoalInfo),
BoundNonLocals = set_of_var.filter(
is_bound_and_not_dummy(ModuleInfo, VarTypes, InstMap, InstmapDelta),
NonLocals).
:- pred is_bound_and_not_dummy(module_info::in, vartypes::in, instmap::in,
instmap_delta::in, prog_var::in) is semidet.
is_bound_and_not_dummy(ModuleInfo, VarTypes, InstMap, InstmapDelta, Var) :-
var_is_bound_in_instmap_delta(ModuleInfo, InstMap, InstmapDelta, Var),
lookup_var_type(VarTypes, Var, Type),
check_dummy_type(ModuleInfo, Type) = is_not_dummy_type.
erl_bind_unbound_vars(Info, VarsToBind, Goal, InstMap,
Statement0, Statement) :-
erl_bound_nonlocals_in_goal(Info, InstMap, Goal, Bound),
NotBound = set_of_var.difference(VarsToBind, Bound),
( if set_of_var.is_empty(NotBound) then
Statement = Statement0
else
% We arbitrarily assign all the variables to the atom `false'.
NotBoundList = set_of_var.to_sorted_list(NotBound),
Assignments = list.map(var_eq_false, NotBoundList),
Statement = join_exprs(elds_block(Assignments), Statement0)
).
%-----------------------------------------------------------------------------%
% Simplify nested case expressions of a specific form:
%
% case % OuterCaseExpr
% (begin
% Expr ..., % InnerPreamble
% case InnerCond of % InnerCaseExpr
% P1 -> M1;
% P2 -> M2;
% ...
% PN -> MN
% end
% end)
% of
% M1 -> R1; % OuterCases
% M2 -> R2;
% ...
% MN -> RN
% end
%
% As a special case, the last pattern MN in the outer case expression may
% be replaced by _ (the anonymous variable) and still match.
%
% ===>
%
% case InnerCond of
% P1 -> R1;
% P2 -> R2;
% ...
% PN -> RN
% end
%
maybe_simplify_nested_cases(Expr0, Expr) :-
( maybe_simplify_nested_cases_2(Expr0, Expr1) ->
Expr = Expr1
;
Expr = Expr0
).
:- pred maybe_simplify_nested_cases_2(elds_expr::in, elds_expr::out)
is semidet.
maybe_simplify_nested_cases_2(OuterCaseExpr, FinalExpr) :-
OuterCaseExpr = elds_case_expr(OuterCond, OuterCases),
(
OuterCond = elds_case_expr(InnerCond, InnerCases),
InnerPreamble = []
;
OuterCond = elds_block(OuterCondExprs),
list.split_last(OuterCondExprs, InnerPreamble, InnerCaseExpr),
InnerCaseExpr = elds_case_expr(InnerCond, InnerCases)
),
match_inner_outer_cases(OuterCases, InnerCases, NewCases),
FinalExpr = elds_block(InnerPreamble ++
[elds_case_expr(InnerCond, NewCases)]).
:- pred match_inner_outer_cases(list(elds_case)::in, list(elds_case)::in,
list(elds_case)::out) is semidet.
match_inner_outer_cases([], [], []).
match_inner_outer_cases([OC | OCs], [IC | ICs], [NC | NCs]) :-
OC = elds_case(OuterPat, OuterExpr),
IC = elds_case(InnerPat, elds_term(InnerTerm)),
non_variable_term(InnerTerm),
(
% The value returned by the inner case expression should match the
% pattern in the outer case expression.
InnerTerm = OuterPat
;
% If the last outer pattern is _ then allow it to match any inner
% expression.
OuterPat = elds_anon_var,
OCs = []
),
NC = elds_case(InnerPat, OuterExpr),
match_inner_outer_cases(OCs, ICs, NCs).
:- pred non_variable_term(elds_term::in) is semidet.
non_variable_term(Term) :-
( Term = elds_char(_)
; Term = elds_int(_)
; Term = elds_float(_)
; Term = elds_binary(_)
; Term = elds_list_of_ints(_)
; Term = elds_atom_raw(_)
; Term = elds_atom(_)
; Term = elds_tuple(SubTerms),
all [SubTerm] (
list.member(elds_term(SubTerm), SubTerms)
=>
non_variable_term(SubTerm)
)
).
%-----------------------------------------------------------------------------%
erl_var_or_dummy_replacement(ModuleInfo, VarTypes, DummyVarReplacement, Var) =
(if
search_var_type(VarTypes, Var, Type),
check_dummy_type(ModuleInfo, Type) = is_dummy_type
then
elds_term(DummyVarReplacement)
else
expr_from_var(Var)
).
%-----------------------------------------------------------------------------%
erl_create_renaming(Vars, Subst, !Info) :-
erl_gen_info_get_varset(!.Info, VarSet0),
list.foldl2(erl_create_renaming_2, Vars, VarSet0, VarSet, map.init, Subst),
erl_gen_info_set_varset(VarSet, !Info).
:- pred erl_create_renaming_2(prog_var::in, prog_varset::in, prog_varset::out,
prog_var_renaming::in, prog_var_renaming::out) is det.
erl_create_renaming_2(OldVar, !VarSet, !Subst) :-
( varset.search_name(!.VarSet, OldVar, Name) ->
varset.new_named_var(Name, NewVar, !VarSet)
;
varset.new_var(NewVar, !VarSet)
),
map.det_insert(OldVar, NewVar, !Subst).
:- pred erl_rename_vars_in_exprs(prog_var_renaming::in,
list(elds_expr)::in, list(elds_expr)::out) is det.
erl_rename_vars_in_exprs(Subn, Exprs0, Exprs) :-
list.map(erl_rename_vars_in_expr(Subn), Exprs0, Exprs).
erl_rename_vars_in_expr(Subn, Expr0, Expr) :-
(
Expr0 = elds_block(Exprs0),
erl_rename_vars_in_exprs(Subn, Exprs0, Exprs),
Expr = elds_block(Exprs)
;
Expr0 = elds_term(Term0),
erl_rename_vars_in_term(Subn, Term0, Term),
Expr = elds_term(Term)
;
Expr0 = elds_eq(ExprA0, ExprB0),
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
erl_rename_vars_in_expr(Subn, ExprB0, ExprB),
Expr = elds_eq(ExprA, ExprB)
;
Expr0 = elds_unop(Op, ExprA0),
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
Expr = elds_unop(Op, ExprA)
;
Expr0 = elds_binop(Op, ExprA0, ExprB0),
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
erl_rename_vars_in_expr(Subn, ExprB0, ExprB),
Expr = elds_binop(Op, ExprA, ExprB)
;
Expr0 = elds_call(CallTarget0, ExprsB0),
erl_rename_vars_in_call_target(Subn, CallTarget0, CallTarget),
erl_rename_vars_in_exprs(Subn, ExprsB0, ExprsB),
Expr = elds_call(CallTarget, ExprsB)
;
Expr0 = elds_fun(Clause0),
erl_rename_vars_in_clause(Subn, Clause0, Clause),
Expr = elds_fun(Clause)
;
Expr0 = elds_case_expr(ExprA0, Cases0),
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
erl_rename_vars_in_cases(Subn, Cases0, Cases),
Expr = elds_case_expr(ExprA, Cases)
;
Expr0 = elds_try(ExprA0, Cases0, MaybeCatch0, MaybeAfter0),
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
erl_rename_vars_in_cases(Subn, Cases0, Cases),
(
MaybeCatch0 = yes(Catch0),
erl_rename_vars_in_catch(Subn, Catch0, Catch),
MaybeCatch = yes(Catch)
;
MaybeCatch0 = no,
MaybeCatch = no
),
(
MaybeAfter0 = yes(After0),
erl_rename_vars_in_expr(Subn, After0, After),
MaybeAfter = yes(After)
;
MaybeAfter0 = no,
MaybeAfter = no
),
Expr = elds_try(ExprA, Cases, MaybeCatch, MaybeAfter)
;
Expr0 = elds_throw(ExprA0),
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
Expr = elds_throw(ExprA)
;
Expr0 = elds_send(ExprA0, ExprB0),
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
erl_rename_vars_in_expr(Subn, ExprB0, ExprB),
Expr = elds_send(ExprA, ExprB)
;
Expr0 = elds_receive(Cases0),
erl_rename_vars_in_cases(Subn, Cases0, Cases),
Expr = elds_receive(Cases)
;
( Expr0 = elds_rtti_ref(_)
; Expr0 = elds_foreign_code(_, _)
),
Expr = Expr0
).
:- pred erl_rename_vars_in_terms(prog_var_renaming::in,
list(elds_term)::in, list(elds_term)::out) is det.
erl_rename_vars_in_terms(Subn, Terms0, Terms) :-
list.map(erl_rename_vars_in_term(Subn), Terms0, Terms).
:- pred erl_rename_vars_in_term(prog_var_renaming::in,
elds_term::in, elds_term::out) is det.
erl_rename_vars_in_term(Subn, Term0, Term) :-
(
( Term0 = elds_int(_)
; Term0 = elds_float(_)
; Term0 = elds_binary(_)
; Term0 = elds_list_of_ints(_)
; Term0 = elds_char(_)
; Term0 = elds_atom_raw(_)
; Term0 = elds_atom(_)
; Term0 = elds_anon_var
; Term0 = elds_fixed_name_var(_)
),
Term = Term0
;
Term0 = elds_tuple(Exprs0),
erl_rename_vars_in_exprs(Subn, Exprs0, Exprs),
Term = elds_tuple(Exprs)
;
Term0 = elds_var(Var0),
Var = (if map.search(Subn, Var0, Var1) then Var1 else Var0),
Term = elds_var(Var)
).
:- pred erl_rename_vars_in_call_target(prog_var_renaming::in,
elds_call_target::in, elds_call_target::out) is det.
erl_rename_vars_in_call_target(Subn, Target0, Target) :-
(
( Target0 = elds_call_plain(_)
; Target0 = elds_call_builtin(_)
),
Target = Target0
;
Target0 = elds_call_ho(Expr0),
erl_rename_vars_in_expr(Subn, Expr0, Expr),
Target = elds_call_ho(Expr)
).
:- pred erl_rename_vars_in_clause(prog_var_renaming::in,
elds_clause::in, elds_clause::out) is det.
erl_rename_vars_in_clause(Subn, Clause0, Clause) :-
Clause0 = elds_clause(Pattern0, Expr0),
erl_rename_vars_in_terms(Subn, Pattern0, Pattern),
erl_rename_vars_in_expr(Subn, Expr0, Expr),
Clause = elds_clause(Pattern, Expr).
:- pred erl_rename_vars_in_cases(prog_var_renaming::in,
list(elds_case)::in, list(elds_case)::out) is det.
erl_rename_vars_in_cases(Subn, Cases0, Cases) :-
list.map(erl_rename_vars_in_case(Subn), Cases0, Cases).
:- pred erl_rename_vars_in_case(prog_var_renaming::in,
elds_case::in, elds_case::out) is det.
erl_rename_vars_in_case(Subn, Case0, Case) :-
Case0 = elds_case(Pattern0, Expr0),
erl_rename_vars_in_term(Subn, Pattern0, Pattern),
erl_rename_vars_in_expr(Subn, Expr0, Expr),
Case = elds_case(Pattern, Expr).
:- pred erl_rename_vars_in_catch(prog_var_renaming::in,
elds_catch::in, elds_catch::out) is det.
erl_rename_vars_in_catch(Subn, Catch0, Catch) :-
Catch0 = elds_catch(PatternA0, PatternB0, Expr0),
erl_rename_vars_in_term(Subn, PatternA0, PatternA),
erl_rename_vars_in_term(Subn, PatternB0, PatternB),
erl_rename_vars_in_expr(Subn, Expr0, Expr),
Catch = elds_catch(PatternA, PatternB, Expr).
%-----------------------------------------------------------------------------%
erl_rename_vars_in_expr_except(ExceptVars, Expr0, Expr, !Info) :-
erl_expr_vars(Expr0, Vars0),
Vars = set_of_var.difference(Vars0, ExceptVars),
erl_create_renaming(set_of_var.to_sorted_list(Vars), Subn, !Info),
erl_rename_vars_in_expr(Subn, Expr0, Expr).
%-----------------------------------------------------------------------------%
erl_expr_vars(Expr, Set) :-
erl_vars_in_expr(Expr, set_of_var.init, Set).
:- pred erl_vars_in_exprs(list(elds_expr)::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_exprs(Exprs, !Set) :-
list.foldl(erl_vars_in_expr, Exprs, !Set).
:- pred erl_vars_in_expr(elds_expr::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_expr(Expr, !Set) :-
(
Expr = elds_block(Exprs),
erl_vars_in_exprs(Exprs, !Set)
;
Expr = elds_term(Term),
erl_vars_in_term(Term, !Set)
;
Expr = elds_eq(ExprA, ExprB),
erl_vars_in_expr(ExprA, !Set),
erl_vars_in_expr(ExprB, !Set)
;
Expr = elds_unop(_Op, ExprA),
erl_vars_in_expr(ExprA, !Set)
;
Expr = elds_binop(_Op, ExprA, ExprB),
erl_vars_in_expr(ExprA, !Set),
erl_vars_in_expr(ExprB, !Set)
;
Expr = elds_call(CallTarget, ExprsB),
erl_vars_in_call_target(CallTarget, !Set),
erl_vars_in_exprs(ExprsB, !Set)
;
Expr = elds_fun(Clause),
erl_vars_in_clause(Clause, !Set)
;
Expr = elds_case_expr(ExprA, Cases),
erl_vars_in_expr(ExprA, !Set),
erl_vars_in_cases(Cases, !Set)
;
Expr = elds_try(ExprA, Cases, MaybeCatch, MaybeAfter),
erl_vars_in_expr(ExprA, !Set),
erl_vars_in_cases(Cases, !Set),
(
MaybeCatch = yes(Catch),
erl_vars_in_catch(Catch, !Set)
;
MaybeCatch = no
),
(
MaybeAfter = yes(After),
erl_vars_in_expr(After, !Set)
;
MaybeAfter = no
)
;
Expr = elds_throw(ExprA),
erl_vars_in_expr(ExprA, !Set)
;
Expr = elds_send(ExprA, ExprB),
erl_vars_in_expr(ExprA, !Set),
erl_vars_in_expr(ExprB, !Set)
;
Expr = elds_receive(Cases),
erl_vars_in_cases(Cases, !Set)
;
( Expr = elds_rtti_ref(_)
; Expr = elds_foreign_code(_, _)
)
).
:- pred erl_vars_in_terms(list(elds_term)::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_terms(Terms, !Set) :-
list.foldl(erl_vars_in_term, Terms, !Set).
:- pred erl_vars_in_term(elds_term::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_term(Term, !Set) :-
(
( Term = elds_int(_)
; Term = elds_float(_)
; Term = elds_binary(_)
; Term = elds_list_of_ints(_)
; Term = elds_char(_)
; Term = elds_atom_raw(_)
; Term = elds_atom(_)
; Term = elds_anon_var
; Term = elds_fixed_name_var(_)
)
;
Term = elds_tuple(Exprs),
erl_vars_in_exprs(Exprs, !Set)
;
Term = elds_var(Var),
set_of_var.insert(Var, !Set)
).
:- pred erl_vars_in_call_target(elds_call_target::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_call_target(Target, !Set) :-
(
( Target = elds_call_plain(_)
; Target = elds_call_builtin(_)
)
;
Target = elds_call_ho(Expr),
erl_vars_in_expr(Expr, !Set)
).
:- pred erl_vars_in_clause(elds_clause::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_clause(Clause, !Set) :-
Clause = elds_clause(Pattern, Expr),
erl_vars_in_terms(Pattern, !Set),
erl_vars_in_expr(Expr, !Set).
:- pred erl_vars_in_cases(list(elds_case)::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_cases(Cases, !Set) :-
list.foldl(erl_vars_in_case, Cases, !Set).
:- pred erl_vars_in_case(elds_case::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_case(Case, !Set) :-
Case = elds_case(Pattern, Expr),
erl_vars_in_term(Pattern, !Set),
erl_vars_in_expr(Expr, !Set).
:- pred erl_vars_in_catch(elds_catch::in,
set_of_progvar::in, set_of_progvar::out) is det.
erl_vars_in_catch(Catch, !Set) :-
Catch = elds_catch(PatternA, PatternB, Expr),
erl_vars_in_term(PatternA, !Set),
erl_vars_in_term(PatternB, !Set),
erl_vars_in_expr(Expr, !Set).
%-----------------------------------------------------------------------------%
:- func erl_exprs_size(list(elds_expr)) = int.
erl_exprs_size(Exprs) = sum(list.map(erl_expr_size, Exprs)).
erl_expr_size(Expr) = Size :-
(
Expr = elds_block(Exprs),
Size = erl_exprs_size(Exprs)
;
Expr = elds_term(Term),
Size = erl_term_size(Term)
;
Expr = elds_eq(ExprA, ExprB),
Size = erl_expr_size(ExprA) + erl_expr_size(ExprB)
;
Expr = elds_unop(_Op, ExprA),
Size = erl_expr_size(ExprA)
;
Expr = elds_binop(_Op, ExprA, ExprB),
Size = erl_expr_size(ExprA) + erl_expr_size(ExprB)
;
Expr = elds_call(CallTarget, Exprs),
Size = erl_call_target_size(CallTarget) + erl_exprs_size(Exprs)
;
Expr = elds_fun(elds_clause(Terms, ExprA)),
Size = 1 + erl_terms_size(Terms) + erl_expr_size(ExprA)
;
Expr = elds_case_expr(ExprA, Cases),
Size = 1 + erl_expr_size(ExprA) + erl_cases_size(Cases)
;
Expr = elds_try(ExprA, Cases, MaybeCatch, MaybeAfter),
(
MaybeCatch = yes(elds_catch(TermA, TermB, CatchExpr)),
CatchSize = erl_term_size(TermA) + erl_term_size(TermB) +
erl_expr_size(CatchExpr)
;
MaybeCatch = no,
CatchSize = 0
),
(
MaybeAfter = yes(AfterExpr),
AfterSize = erl_expr_size(AfterExpr)
;
MaybeAfter = no,
AfterSize = 0
),
Size = 1 + erl_expr_size(ExprA) + erl_cases_size(Cases) +
CatchSize + AfterSize
;
Expr = elds_throw(ExprA),
Size = 1 + erl_expr_size(ExprA)
;
Expr = elds_send(ExprA, ExprB),
Size = 1 + erl_expr_size(ExprA) + erl_expr_size(ExprB)
;
Expr = elds_receive(Cases),
Size = 1 + erl_cases_size(Cases)
;
Expr = elds_rtti_ref(_),
Size = 1
;
Expr = elds_foreign_code(_, _),
% Arbitrary number.
Size = 10000
).
:- func erl_terms_size(list(elds_term)) = int.
erl_terms_size(Terms) = sum(list.map(erl_term_size, Terms)).
:- func erl_term_size(elds_term) = int.
erl_term_size(Term) = Size :-
(
( Term = elds_int(_)
; Term = elds_float(_)
; Term = elds_binary(_)
; Term = elds_list_of_ints(_)
; Term = elds_char(_)
; Term = elds_atom_raw(_)
; Term = elds_atom(_)
; Term = elds_var(_)
; Term = elds_anon_var
; Term = elds_fixed_name_var(_)
),
Size = 1
;
Term = elds_tuple(Exprs),
Size = 1 + erl_exprs_size(Exprs)
).
:- func erl_call_target_size(elds_call_target) = int.
erl_call_target_size(elds_call_plain(_)) = 1.
erl_call_target_size(elds_call_builtin(_)) = 1.
erl_call_target_size(elds_call_ho(Expr)) = erl_expr_size(Expr).
:- func erl_cases_size(list(elds_case)) = int.
erl_cases_size(Cases) = 1 + sum(list.map(erl_case_size, Cases)).
:- func erl_case_size(elds_case) = int.
erl_case_size(Case) = Size :-
Case = elds_case(Pattern, Expr),
Size = 1 + erl_term_size(Pattern) + erl_expr_size(Expr).
:- func sum(list(int)) = int.
sum(Xs) = list.foldl(int.plus, Xs, 0).
%-----------------------------------------------------------------------------%
% This function returns the offset to add to the method number
% for a type class method to get its field number within the
% base_typeclass_info.
% field 0 is num_extra
% field 1 is num_constraints
% field 2 is num_superclasses
% field 3 is class_arity
% field 4 is num_methods
% field 5 is the 1st method
% field 6 is the 2nd method
% etc.
% (See the base_typeclass_info type in rtti.m or the
% description in notes/type_class_transformation.html for
% more information about the layout of base_typeclass_infos.)
% Hence the offset is 4.
%
erl_base_typeclass_info_method_offset = 4.
%-----------------------------------------------------------------------------%
:- end_module erl_backend.erl_code_util.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink