mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 14:25:56 +00:00
17d684a11e
compiler/instmap.m:
Replace a non-state-var-friendly and a state-var-friendly pair
of predicates with just one state-var-friendly predicate.
Improve the arg order of another predicate as well.
Improve documentation.
compiler/accumulator.m:
compiler/call_gen.m:
compiler/code_loc_dep.m:
compiler/constraint.m:
compiler/cse_detection.m:
compiler/delay_construct.m:
compiler/dep_par_conj.m:
compiler/erl_code_gen.m:
compiler/erl_code_util.m:
compiler/float_regs.m:
compiler/goal_mode.m:
compiler/goal_util.m:
compiler/hlds_pred.m:
compiler/introduce_parallelism.m:
compiler/lookup_util.m:
compiler/loop_inv.m:
compiler/mode_util.m:
compiler/modecheck_unify.m:
compiler/par_conj_gen.m:
compiler/pd_info.m:
compiler/pd_util.m:
compiler/prog_rep.m:
compiler/stm_expand.m:
compiler/transform.m:
compiler/try_expand.m:
compiler/unneeded_code.m:
Conform to the change above. Delete unneeded module qualifications.
1062 lines
35 KiB
Mathematica
1062 lines
35 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% 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.
|
|
:- 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.
|
|
:- 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(top_functor_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.
|
|
:- 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_top_functor_modes(ModuleInfo, Modes, ArgTypes, TopFunctorModes),
|
|
erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
|
|
VarNames, ArgTypes, TopFunctorModes, Inputs, Outputs).
|
|
|
|
erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
|
|
VarNames, ArgTypes, TopFunctorModes, Inputs, Outputs) :-
|
|
( if
|
|
VarNames = [],
|
|
ArgTypes = [],
|
|
TopFunctorModes = []
|
|
then
|
|
Inputs = [],
|
|
Outputs = []
|
|
else if
|
|
VarNames = [VarName | VarNames1],
|
|
ArgTypes = [ArgType | ArgTypes1],
|
|
TopFunctorModes = [TopFunctorMode | TopFunctorModes1]
|
|
then
|
|
erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
|
|
VarNames1, ArgTypes1, TopFunctorModes1, Inputs1, Outputs1),
|
|
( if
|
|
OptDummyArgs = opt_dummy_args,
|
|
% Exclude arguments of type io.state etc.
|
|
% Also exclude those with arg_mode `top_unused'.
|
|
( is_type_a_dummy(ModuleInfo, ArgType) = is_dummy_type
|
|
; TopFunctorMode = top_unused
|
|
)
|
|
then
|
|
Inputs = Inputs1,
|
|
Outputs = Outputs1
|
|
else
|
|
(
|
|
TopFunctorMode = top_in,
|
|
% It's an input argument.
|
|
Inputs = [VarName | Inputs1],
|
|
Outputs = Outputs1
|
|
;
|
|
( TopFunctorMode = top_out
|
|
; TopFunctorMode = top_unused
|
|
),
|
|
% It's an output argument.
|
|
Inputs = Inputs1,
|
|
Outputs = [VarName | Outputs1]
|
|
)
|
|
)
|
|
else
|
|
unexpected($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(ModuleInfo, InstMap, 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),
|
|
is_type_a_dummy(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)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
erl_var_or_dummy_replacement(ModuleInfo, VarTypes, DummyVarReplacement, Var) =
|
|
( if
|
|
search_var_type(VarTypes, Var, Type),
|
|
is_type_a_dummy(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) :-
|
|
( if varset.search_name(!.VarSet, OldVar, Name) then
|
|
varset.new_named_var(Name, NewVar, !VarSet)
|
|
else
|
|
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_uint(_)
|
|
; Term0 = elds_int8(_)
|
|
; Term0 = elds_uint8(_)
|
|
; Term0 = elds_int16(_)
|
|
; Term0 = elds_uint16(_)
|
|
; Term0 = elds_int32(_)
|
|
; Term0 = elds_uint32(_)
|
|
; Term0 = elds_int64(_)
|
|
; Term0 = elds_uint64(_)
|
|
; 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_uint(_)
|
|
; Term = elds_int8(_)
|
|
; Term = elds_uint8(_)
|
|
; Term = elds_int16(_)
|
|
; Term = elds_uint16(_)
|
|
; Term = elds_int32(_)
|
|
; Term = elds_uint32(_)
|
|
; Term = elds_int64(_)
|
|
; Term = elds_uint64(_)
|
|
; 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_uint(_)
|
|
; Term = elds_int8(_)
|
|
; Term = elds_uint8(_)
|
|
; Term = elds_int16(_)
|
|
; Term = elds_uint16(_)
|
|
; Term = elds_int32(_)
|
|
; Term = elds_uint32(_)
|
|
; Term = elds_int64(_)
|
|
; Term = elds_uint64(_)
|
|
; 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).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
maybe_simplify_nested_cases(Expr0, Expr) :-
|
|
% 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
|
|
%
|
|
( if maybe_simplify_nested_cases_2(Expr0, Expr1) then
|
|
Expr = Expr1
|
|
else
|
|
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) :-
|
|
require_complete_switch [Term]
|
|
(
|
|
( Term = elds_char(_)
|
|
; Term = elds_int(_)
|
|
; Term = elds_uint(_)
|
|
; Term = elds_int8(_)
|
|
; Term = elds_uint8(_)
|
|
; Term = elds_int16(_)
|
|
; Term = elds_uint16(_)
|
|
; Term = elds_int32(_)
|
|
; Term = elds_uint32(_)
|
|
; Term = elds_int64(_)
|
|
; Term = elds_uint64(_)
|
|
; 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)
|
|
)
|
|
;
|
|
( Term = elds_var(_)
|
|
; Term = elds_fixed_name_var(_)
|
|
; Term = elds_anon_var
|
|
),
|
|
fail
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% 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.
|
|
%-----------------------------------------------------------------------------%
|