diff --git a/NEWS b/NEWS index 9caa794c0..d60a955ee 100644 --- a/NEWS +++ b/NEWS @@ -512,10 +512,12 @@ Changes to the Mercury standard library * The following predicates and functions have been added: - - func `sorted_keys/1` - - pred `sorted_keys/2` - func `keys_as_set/1` - pred `keys_as_set/2` + - func `reverse_add/3` + - pred `reverse_add/4` + - func `sorted_keys/1` + - pred `sorted_keys/2` ### Changes to the `string` module diff --git a/compiler/builtin_ops.m b/compiler/builtin_ops.m index 99322cce0..c5fae4a1a 100644 --- a/compiler/builtin_ops.m +++ b/compiler/builtin_ops.m @@ -339,7 +339,6 @@ builtin_translation(ModuleName, PredName, ProcNum, Args, Code) :- ), ProcNum = 0, Args = [X, Y], Code = test(binary(CmpOp, leaf(X), leaf(Y))) - ; PredName = "pointer_equal", ProcNum = 0, % The arity of this predicate is two during parsing, @@ -348,6 +347,9 @@ builtin_translation(ModuleName, PredName, ProcNum, Args, Code) :- ; Args = [_TypeInfo, X, Y] ), Code = test(binary(pointer_equal_conservative, leaf(X), leaf(Y))) + ; + PredName = "partial_inst_copy", ProcNum = 0, Args = [X, Y], + Code = assign(Y, leaf(X)) ) ; ModuleName = "term_size_prof_builtin", diff --git a/compiler/dead_proc_elim.m b/compiler/dead_proc_elim.m index 494892979..9189c9d91 100644 --- a/compiler/dead_proc_elim.m +++ b/compiler/dead_proc_elim.m @@ -142,6 +142,7 @@ :- import_module libs.options. :- import_module mdbcomp.builtin_modules. :- import_module parse_tree.prog_item. % undesirable dependency +:- import_module transform_hlds.direct_arg_in_out. :- import_module assoc_list. :- import_module bool. @@ -1479,13 +1480,20 @@ dead_pred_elim_initialize(PredId, DeadInfo0, DeadInfo) :- % Don't eliminate preds from builtin modules, since later % passes of the compiler may introduce calls to them % (e.g. polymorphism.m needs unify/2 and friends). + % XXX This is too broad. The later disjuncts here try to do + % a much more precise job. any_mercury_builtin_module(PredModule) ; % Simplify can't introduce calls to this predicate or function % if we eliminate it here. is_std_lib_module_name(PredModule, PredModuleName), - simplify_may_introduce_calls(PredModuleName, PredName, - PredArity) + ( + simplify_may_introduce_calls(PredModuleName, PredName, + PredArity) + ; + daio_may_introduce_calls(PredModuleName, PredName, + PredArity) + ) ; % Try-goal expansion may introduce calls to predicates in % `exception'. diff --git a/compiler/direct_arg_in_out.m b/compiler/direct_arg_in_out.m index e69de29bb..2fff65aa0 100644 --- a/compiler/direct_arg_in_out.m +++ b/compiler/direct_arg_in_out.m @@ -0,0 +1,2016 @@ +%---------------------------------------------------------------------------% +% vim: ft=mercury ts=4 sw=4 et +%---------------------------------------------------------------------------% +% Copyright (C) 2020 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: direct_arg_in_out.m. +% Main author: zs. +% +% This module addresses a problem that can arise when a procedure fills in +% one or more fields in an argument that was originally passed to it +% in a partially instantated form. +% +% In the vast majority of cases, such arguments need no special handling. +% The caller passes a tagged pointer to a partially-filled-in heap cell, +% and the callee simply fills in the parts of the heap cell corresponding +% to the field or fields that it instantiates. When the callee returns, +% the caller will find those fields filled in. +% +% The problem arises when the function symbol whose field is being filled in +% has the direct_arg representation. This representation is applicable +% only to function symbols with a single argument, and only when the argument +% type's representation guarantees that the argument's value will contain +% all zeroes in its primary tag bits. In such cases, the compiler +% represents the function with a direct_arg_tag(N) cons tag, which means that +% the representation of this function symbol, applied to its single argument, +% will be the value of the argument, with the guaranteed-to-be-zero bits +% in the argument value replaced by N. (This primary tag value may, or may not, +% be needed to distinguish this function symbol from any other function symbols +% in the whole term's type.) +% +% The problem that this module handles is that when a callee fills in +% the argument value of such a term, this update affects only the callee's +% own local variables. It does *not* affect any heap cells, nor anything +% else that the caller can see. Without compensation for this effect, +% the translated program will contain a bug. (See test cases gh72[ab...].m +% in tests/hard_coded.) This module is the needed compenstation. +% +% Since the problem is that instantations of such partial terms +% are not visible in the caller, the solution is to *make* them visible +% in the caller. +% +% The first part of the solution is to have the compiler find all arguments +% in all procedures that are subject to this problem. This is true for +% an argument variable V with initial inst I and final inst F if +% +% - I is not ground, +% - F further instantiates one of the arguments of one of the function symbols +% in V's type, and +% - at least one of those function symbols is represented by a direct arg tag. +% +% We call such arguments "daio arguments" (direct arg in out), and +% we call procedures that have any daio arguments "daio procedures". +% +% The second part is to modify the argument lists of daio procedures +% to replace each daio argument V with a pair or arguments, V and V', +% where V' is a clone of V. In the updated argument list, we change +% the mode of V from I -> F to I -> clobbered, and we give the clone +% variable V' the mode free -> F. The idea is that at the end of the +% procedure body, we will assign V to V', and that the caller will pick up +% the updated value of V from the argument position of V', since this will be +% an output argument. Due to the change in signature, we do this modification +% in a clone of the original procedure, leaving the original unchanged. +% +% The third part of the solution is to consistently modify all procedure +% bodies to implement that idea. When we find a call to a daio procedure, +% we create clones of all its daio variables, update the argument vector +% to pass the clones of the daio arguments as well, redirect the call +% to the daio clone of the callee procedure, we ensure that we never again +% refer to the original, pre-clone version of each such daio variable. +% In straight-line code that follows such calls, we can achieve this +% by simple substitution, but we also have to handle situations in which +% a branched control structure (if-then-else, disjunction, switch or +% atomic goal) may need to clone different sets of daio variables in its +% different branches. We ensure that the code following the branched +% control structure gets a consistent view of every daio variable by, +% for each daio variable that is updated in any branch (call it X0), +% picking the variable representing the final version in one branch (say X5), +% and copying the final version of that original variable in every other branch +% (say X1, X2 etc, or X0 itself) to this same variable (X5). We also ensure +% that the original version (X0 in this example) is clobbered in every branch, +% even the ones that do not mention it at all, since this is required to ensure +% that the different branches have consistent instmap_deltas. +% +% Note that this whole transformation is needed only if the set of daio +% procedures is not empty, but, for the vast majority of modules being +% compiled, this set *will* be empty. mercury_compile_middle_passes.m, +% the one module that can invoke do_direct_arg_in_out_transform_in_module, +% does so only if the set is non-empty. To minimize the cost of computing +% the set of daio procedures, we do not have a separate pass for it. +% Instead, we compute it in two parts. For almost all procedures, we +% test whether they are daio procedures in simplify_proc.m, as part of +% the tasks we do at the end of the compiler front end. However, the +% procedures that implement lambda expressions do not yet exist as separate +% procedures at that time, so we get lambda.m to do the same test +% (using the same predicate, find_and_record_any_direct_arg_in_out_posns) +% on the procedures it creates. +% +% This optimization is one reason why mercury_compile_middle_passes.m invokes +% this module after the lambda expansion transformation. Another reason is that +% it allows us to transform higher order calls the same way as we do plain +% calls, provided we transform every reference to a daio procedure in +% unifications that create closures to the clone of that daio procedure. +% (The arguments that we put inside closures cannot be daio arguments, +% since such arguments must be ground.) +% +%---------------------------------------------------------------------------% + +:- module transform_hlds.direct_arg_in_out. +:- interface. + +:- import_module hlds. +:- import_module hlds.hlds_module. +:- import_module hlds.hlds_pred. +:- import_module hlds.vartypes. +:- import_module parse_tree. +:- import_module parse_tree.error_util. +:- import_module parse_tree.prog_data. + +:- import_module list. + +%---------------------% + + % find_and_record_any_direct_arg_in_out_posns(PredId, ProcId, VarTypes, + % Vars, Modes, !ModuleInfo): + % + % Given a procedure proc(PredId, ProcId) whose arguments Vars have + % the types recorded in VarTypes and the modes recorded in Modes, + % find out whether any of their arguments are daio arguments. + % If yes, then update the module_info to record that this procedure + % is a daio procedure with the computed set of daio arguments. + % This record will be used by do_direct_arg_in_out_transform_in_module + % to perform the transformation described at the top of this module. + % + % This predicate is intended to be called from simplify_proc.m and from + % lambda.m, as also described above. + % +:- pred find_and_record_any_direct_arg_in_out_posns(pred_id::in, proc_id::in, + vartypes::in, list(prog_var)::in, list(mer_mode)::in, + module_info::in, module_info::out) is det. + +%---------------------% + + % Implement the transformation described at the top-of-module module + % comment above. + % +:- pred do_direct_arg_in_out_transform_in_module(direct_arg_proc_map::in, + module_info::in, module_info::out, list(error_spec)::out) is det. + +%---------------------% + + % daio_may_introduce_calls(ModuleName, PredName, Arity): + % + % Succeed iff this module may introduce calls to the predicate + % PredName/Arity in the standard library module ModuleName. + % dead_proc_elim.m calls this predicate to avoid deleting + % predicates that are unused when it is first run, but which may have + % calls to them added later on, when this module is invoked. + % +:- pred daio_may_introduce_calls(string::in, string::in, arity::in) is semidet. + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- implementation. + +:- import_module check_hlds. +:- import_module check_hlds.inst_util. +:- import_module check_hlds.mode_util. +:- import_module hlds.goal_util. +:- import_module hlds.hlds_class. +:- import_module hlds.hlds_data. +:- import_module hlds.hlds_error_util. +:- import_module hlds.hlds_goal. +:- import_module hlds.hlds_out. +:- import_module hlds.hlds_out.hlds_out_goal. +:- import_module hlds.hlds_rtti. +:- import_module hlds.instmap. +:- import_module hlds.make_goal. +:- import_module hlds.pred_table. +:- import_module hlds.quantification. +:- import_module libs. +:- import_module libs.globals. +:- import_module mdbcomp. +:- import_module mdbcomp.builtin_modules. +:- import_module mdbcomp.sym_name. +:- import_module parse_tree.prog_rename. +:- import_module parse_tree.prog_type. +:- import_module parse_tree.set_of_var. + +:- import_module assoc_list. +:- import_module bimap. +:- import_module bool. +:- import_module cord. +:- import_module int. +:- import_module io. +:- import_module map. +:- import_module maybe. +:- import_module one_or_more. +:- import_module pair. +:- import_module require. +:- import_module set. +:- import_module string. +:- import_module term. +:- import_module varset. + +%---------------------------------------------------------------------------% + +find_and_record_any_direct_arg_in_out_posns(PredId, ProcId, VarTypes, + Vars, Modes, !ModuleInfo) :- + find_direct_arg_in_out_posns(!.ModuleInfo, VarTypes, 1, Vars, Modes, + DirectArgInOutPosns, ProblemPosns), + ( + ProblemPosns = [], + ( + DirectArgInOutPosns = [] + ; + DirectArgInOutPosns = [HeadPosn | TailPosns], + OoMDirectArgInOutPosns = one_or_more(HeadPosn, TailPosns), + module_info_get_direct_arg_proc_map(!.ModuleInfo, + DirectArgProcMap0), + DirectArgProc = direct_arg_clone_proc(OoMDirectArgInOutPosns), + map.det_insert(proc(PredId, ProcId), DirectArgProc, + DirectArgProcMap0, DirectArgProcMap), + module_info_set_direct_arg_proc_map(DirectArgProcMap, !ModuleInfo) + ) + ; + ProblemPosns = [HeadPosn | TailPosns], + OoMDirectArgPosns = one_or_more(HeadPosn, TailPosns), + module_info_get_direct_arg_proc_map(!.ModuleInfo, DirectArgProcMap0), + DirectArgProc = direct_arg_problem_proc(OoMDirectArgPosns, + DirectArgInOutPosns), + map.det_insert(proc(PredId, ProcId), DirectArgProc, + DirectArgProcMap0, DirectArgProcMap), + module_info_set_direct_arg_proc_map(DirectArgProcMap, !ModuleInfo) + ). + + % Given a procedure's headvars and their modes, return + % + % - the list of argument positions that need to be cloned, because + % their type says that some of their function symbols use the direct arg + % tag, and their mode says that this procedure fills in the argument(s) + % of one or more of those function symbols, and + % + % - the list of problem argument positions, whose modes do not contain the + % information we need to decide whether or not they need to be cloned. + % +:- pred find_direct_arg_in_out_posns(module_info::in, vartypes::in, + int::in, list(prog_var)::in, list(mer_mode)::in, + list(int)::out, list(int)::out) is det. + +find_direct_arg_in_out_posns(_, _, _, [], [], [], []). +find_direct_arg_in_out_posns(_, _, _, [], [_ | _], _, _) :- + unexpected($pred, "list length mismatch"). +find_direct_arg_in_out_posns(_, _, _, [_ | _], [], _, _) :- + unexpected($pred, "list length mismatch"). +find_direct_arg_in_out_posns(ModuleInfo, VarTypes, CurArgNum, + [Var | Vars], [Mode | Modes], DirectArgInOutPosns, ProblemPosns) :- + find_direct_arg_in_out_posns(ModuleInfo, VarTypes, CurArgNum + 1, + Vars, Modes, TailDirectArgInOutPosns, TailProblemPosns), + is_direct_arg_in_out_posn(ModuleInfo, VarTypes, Var, Mode, IsDAIO), + ( + IsDAIO = mode_is_not_daio, + DirectArgInOutPosns = TailDirectArgInOutPosns, + ProblemPosns = TailProblemPosns + ; + IsDAIO = mode_is_daio, + DirectArgInOutPosns = [CurArgNum | TailDirectArgInOutPosns], + ProblemPosns = TailProblemPosns + ; + IsDAIO = mode_may_be_daio, + DirectArgInOutPosns = TailDirectArgInOutPosns, + ProblemPosns = [CurArgNum | TailProblemPosns] + ). + +:- pred is_direct_arg_in_out_posn(module_info::in, vartypes::in, + prog_var::in, mer_mode::in, is_mode_daio::out) is det. + +is_direct_arg_in_out_posn(ModuleInfo, VarTypes, Var, Mode, IsDAIO) :- + module_info_get_type_table(ModuleInfo, TypeTable), + lookup_var_type(VarTypes, Var, Type), + ( if + type_to_ctor(Type, TypeCtor), + search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn) + then + get_type_defn_body(TypeDefn, TypeBody), + ( + TypeBody = hlds_du_type(_, _, MaybeRepn, _), + ( + MaybeRepn = no, + unexpected($pred, "MaybeRepn = no") + ; + MaybeRepn = yes(Repn) + ), + CtorRepns = Repn ^ dur_ctor_repns, + gather_direct_arg_functors(CtorRepns, [], DirectArgFunctors), + ( + DirectArgFunctors = [], + IsDAIO = mode_is_not_daio + ; + DirectArgFunctors = [_ | _], + FromToInsts = mode_to_from_to_insts(ModuleInfo, Mode), + FromToInsts = from_to_insts(FromInst0, ToInst0), + inst_expand_and_remove_constrained_inst_vars(ModuleInfo, + FromInst0, FromInst), + inst_expand_and_remove_constrained_inst_vars(ModuleInfo, + ToInst0, ToInst), + IsDAIO = mode_needs_direct_arg_in_out(ModuleInfo, + DirectArgFunctors, FromInst, ToInst) + ) + ; + ( TypeBody = hlds_eqv_type(_) + ; TypeBody = hlds_foreign_type(_) + ; TypeBody = hlds_solver_type(_) + ; TypeBody = hlds_abstract_type(_) + ), + IsDAIO = mode_is_not_daio + ) + else + % The call to type_to_ctor can fail only if Type is a type variable. + % Since this procedure does not know Var's type, it cannot have + % a type-specific mode for it. + IsDAIO = mode_is_not_daio + ). + +:- pred gather_direct_arg_functors(list(constructor_repn)::in, + list(sym_name)::in, list(sym_name)::out) is det. + +gather_direct_arg_functors([], !DirectArgFunctors). +gather_direct_arg_functors([CtorRepn | CtorRepns], !DirectArgFunctors) :- + ( if CtorRepn ^ cr_tag = direct_arg_tag(_) then + list.length(CtorRepn ^ cr_args, Arity), + % Direct arg cons ids must have arity 1. + expect(unify(Arity, 1), $pred, "direct arg functor arity != 1"), + DirectArgFunctor = CtorRepn ^ cr_name, + !:DirectArgFunctors = [DirectArgFunctor | !.DirectArgFunctors] + else + true + ), + gather_direct_arg_functors(CtorRepns, !DirectArgFunctors). + +:- type is_mode_daio + ---> mode_is_not_daio + ; mode_is_daio + ; mode_may_be_daio. + +:- func mode_needs_direct_arg_in_out(module_info, list(sym_name), + mer_inst, mer_inst) = is_mode_daio. + +mode_needs_direct_arg_in_out(ModuleInfo, DirectArgFunctors, FromInst, ToInst) + = IsDAIO :- + ( + ( FromInst = free + ; FromInst = free(_) + ; FromInst = any(_, _) + ; FromInst = not_reached + ; FromInst = ground(_, _) + ; FromInst = inst_var(_) + ; FromInst = abstract_inst(_, _) + ), + IsDAIO = mode_is_not_daio + ; + FromInst = bound(_FromUniq, _FromResults, FromBoundInsts), + some_bound_inst_has_direct_arg_free(ModuleInfo, DirectArgFunctors, + FromBoundInsts, FreeArgDirectArgFunctors), + ( + FreeArgDirectArgFunctors = [], + IsDAIO = mode_is_not_daio + ; + FreeArgDirectArgFunctors = [_ | _], + ( + ( ToInst = free + ; ToInst = free(_) + ), + % ToInst cannot be less instantiated than FromInst. + unexpected($pred, "bound to free") + ; + ToInst = abstract_inst(_, _), + % XXX In this extremely rare case, we have no idea whether + % the actual inst that this abstract inst stands for + % requires its argument to be cloned or not. We *could* + % clone all such arguments, but we have seen no need for it + % just yet. + % XXX I (zs) do not even know whether the compiler + % permits any procedure whose mode includes an abstract inst + % to pass semantic analysis, though as far as I can tell, + % the reference manual does not prohibit this. (Though it + % also does not explicitly say that it is permitted.) + % + % XXX We could return messages as error_specs, + % instead of as abort messages. + unexpected($pred, + "NYI: abstract inst in predicate mode in a module " ++ + "that uses partially-instantiated direct_arg terms") + ; + ToInst = inst_var(_), + % XXX Another instance of the problem described for + % abstract_inst. + unexpected($pred, + "NYI: inst var in predicate mode in a module " ++ + "that uses partially-instantiated direct_arg terms") + ; + ( ToInst = any(_, _) + ; ToInst = not_reached + ), + IsDAIO = mode_is_not_daio + ; + ToInst = ground(_, _), + IsDAIO = mode_is_daio + ; + ToInst = bound(_ToUniq, _ToResults, ToBoundInsts), + some_bound_inst_has_direct_arg_out(ModuleInfo, + FreeArgDirectArgFunctors, ToBoundInsts, + SomeDirectArgIsBound, CanSeeAllArgModes), + ( + CanSeeAllArgModes = cannot_see_all_arg_modes, + IsDAIO = mode_may_be_daio + ; + CanSeeAllArgModes = can_see_all_arg_modes, + ( + SomeDirectArgIsBound = no_direct_arg_is_bound, + IsDAIO = mode_is_not_daio + ; + SomeDirectArgIsBound = some_direct_arg_is_bound, + IsDAIO = mode_is_daio + ) + ) + ; + ToInst = constrained_inst_vars(_, _), + unexpected($pred, "unexpanded constrained_inst_vars") + ; + ToInst = defined_inst(_), + unexpected($pred, "unexpanded defined_inst") + ) + ) + ; + FromInst = constrained_inst_vars(_, _), + unexpected($pred, "unexpanded constrained_inst_vars") + ; + FromInst = defined_inst(_), + unexpected($pred, "unexpanded defined_inst") + ). + +:- pred some_bound_inst_has_direct_arg_free(module_info::in, + list(sym_name)::in, list(bound_inst)::in, list(sym_name)::out) is det. + +some_bound_inst_has_direct_arg_free(_, _, [], []). +some_bound_inst_has_direct_arg_free(ModuleInfo, DirectArgFunctors, + [FromBoundInst | FromBoundInsts], !:FreeArgDirectArgFunctors) :- + some_bound_inst_has_direct_arg_free(ModuleInfo, DirectArgFunctors, + FromBoundInsts, !:FreeArgDirectArgFunctors), + FromBoundInst = bound_functor(ConsId, ArgInsts0), + ( if + ConsId = cons(SymName, Arity, _TypeCtor), + Arity = 1, + list.member(SymName, DirectArgFunctors), + ArgInsts0 = [ArgInst0], + inst_expand_and_remove_constrained_inst_vars(ModuleInfo, + ArgInst0, ArgInst), + ( ArgInst = free + ; ArgInst = free(_) + ) + then + !:FreeArgDirectArgFunctors = [SymName | !.FreeArgDirectArgFunctors] + else + true + ). + +:- type is_some_direct_arg_bound + ---> no_direct_arg_is_bound + ; some_direct_arg_is_bound. + +:- type can_see_all_arg_modes + ---> cannot_see_all_arg_modes + ; can_see_all_arg_modes. + +:- pred some_bound_inst_has_direct_arg_out(module_info::in, + list(sym_name)::in, list(bound_inst)::in, + is_some_direct_arg_bound::out, can_see_all_arg_modes::out) is det. + +some_bound_inst_has_direct_arg_out(_, _, [], + no_direct_arg_is_bound, can_see_all_arg_modes). +some_bound_inst_has_direct_arg_out(ModuleInfo, FreeArgDirectArgFunctors, + [ToBoundInst | ToBoundInsts], + SomeDirectArgIsBound, CanSeeAllArgModes) :- + some_bound_inst_has_direct_arg_out(ModuleInfo, FreeArgDirectArgFunctors, + ToBoundInsts, TailSomeDirectArgIsBound, TailCanSeeAllArgModes), + ToBoundInst = bound_functor(ConsId, ArgInsts0), + ( if + ConsId = cons(SymName, Arity, _TypeCtor), + Arity = 1, + list.member(SymName, FreeArgDirectArgFunctors) + then + ( + ArgInsts0 = [ArgInst0] + ; + ( ArgInsts0 = [] + ; ArgInsts0 = [_, _ | _] + ), + unexpected($pred, "Arity = 1 but ArgInsts0 != [_]") + ), + inst_expand_and_remove_constrained_inst_vars(ModuleInfo, + ArgInst0, ArgInst), + ( + ( ArgInst = free + ; ArgInst = free(_) + ), + SomeDirectArgIsBound = TailSomeDirectArgIsBound, + CanSeeAllArgModes = TailCanSeeAllArgModes + ; + ArgInst = not_reached, + unexpected($pred, "not_reached arg in reachable term") + ; + ( ArgInst = any(_, _) + ; ArgInst = ground(_, _) + ; ArgInst = bound(_, _, _) + ), + % The arg of ConsId was free in FromInst, but it is NOT free + % in ToInst. + SomeDirectArgIsBound = some_direct_arg_is_bound, + CanSeeAllArgModes = TailCanSeeAllArgModes + ; + ( ArgInst = inst_var(_) + ; ArgInst = abstract_inst(_, _) + ), + SomeDirectArgIsBound = TailSomeDirectArgIsBound, + CanSeeAllArgModes = cannot_see_all_arg_modes + ; + ( ArgInst = constrained_inst_vars(_, _) + ; ArgInst = defined_inst(_) + ), + unexpected($pred, "unexpanded inst") + ) + else + SomeDirectArgIsBound = TailSomeDirectArgIsBound, + CanSeeAllArgModes = TailCanSeeAllArgModes + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +:- type direct_arg_proc_in_out + ---> direct_arg_proc_in_out( + pred_proc_id, + one_or_more(int) + ). + +:- type direct_arg_proc_in_out_map == + map(pred_proc_id, direct_arg_proc_in_out). + +:- type clone_in_out_map == map(pred_proc_id, one_or_more(int)). + +%---------------------------------------------------------------------------% + +do_direct_arg_in_out_transform_in_module(DirectArgProcMap, + !ModuleInfo, !:Specs) :- + % Phase one: for every daio procedure, create a clone procedure + % that includes clones every daio argument variable + % Then delete the original procedure, to ensure that later passes + % detect any references to them that were accidentally left by phase two. + map.foldl4(make_direct_arg_clone_or_spec, DirectArgProcMap, + map.init, DirectArgProcInOutMap, map.init, CloneInOutMap, + !ModuleInfo, [], !:Specs), + + % Phase two: Transform the bodies of all procedures in the module to refer + % to the clones, and not the originals, ensuring that every access to + % a daio variable is updated to refer to its most recent clone. + module_info_get_valid_pred_ids(!.ModuleInfo, PredIds), + list.foldl2( + transform_direct_arg_in_out_calls_in_pred(DirectArgProcMap, + DirectArgProcInOutMap, CloneInOutMap), + PredIds, !ModuleInfo, !Specs), + + % Phase three: replace all references to the now-deleted procedures + % in the class and instance tables with references to their clones. + module_info_get_class_table(!.ModuleInfo, ClassTable0), + map.map_values_only(transform_class(DirectArgProcInOutMap), + ClassTable0, ClassTable), + module_info_set_class_table(ClassTable, !ModuleInfo), + + module_info_get_instance_table(!.ModuleInfo, InstanceTable0), + map.map_values_only(transform_class_instances(DirectArgProcInOutMap), + InstanceTable0, InstanceTable), + module_info_set_instance_table(InstanceTable, !ModuleInfo). + +:- pred make_direct_arg_clone_or_spec(pred_proc_id::in, direct_arg_proc::in, + direct_arg_proc_in_out_map::in, direct_arg_proc_in_out_map::out, + clone_in_out_map::in, clone_in_out_map::out, + module_info::in, module_info::out, + list(error_spec)::in, list(error_spec)::out) is det. + +make_direct_arg_clone_or_spec(PredProcId, DirectArgProc, + !DirectArgInOutMap, !CloneInOutMap, !ModuleInfo, !Specs) :- + ( + DirectArgProc = direct_arg_clone_proc(OoMInOutArgs), + make_direct_arg_in_out_clone(PredProcId, OoMInOutArgs, ProcInOut, + !CloneInOutMap, !ModuleInfo, !Specs), + map.det_insert(PredProcId, ProcInOut, !DirectArgInOutMap) + ; + DirectArgProc = direct_arg_problem_proc(OoMProblemArgs, _InOutArgs), + generate_problem_proc_error(!.ModuleInfo, PredProcId, OoMProblemArgs, + Spec), + !:Specs = [Spec | !.Specs] + ). + +:- pred make_direct_arg_in_out_clone(pred_proc_id::in, one_or_more(int)::in, + direct_arg_proc_in_out::out, clone_in_out_map::in, clone_in_out_map::out, + module_info::in, module_info::out, + list(error_spec)::in, list(error_spec)::out) is det. + +make_direct_arg_in_out_clone(PredProcId, OoMInOutArgs, ProcInOut, + !CloneInOutMap, !ModuleInfo, !Specs) :- + PredProcId = proc(PredId, ProcId), + module_info_pred_info(!.ModuleInfo, PredId, PredInfo0), + pred_info_get_proc_table(PredInfo0, ProcTable0), + % We want the clone procedure to replace the original in all respects. + % We give it the same name and same proc_id as original, which will + % lead to the same name in the generated target-language code. + % We delete the originals of cloned procs to ensure that any references + % that we accidentally leave around that still refer to them after our + % transformation will be detected. + map.det_remove(ProcId, ProcInfo, ProcTable0, ProcTable), + ( if map.is_empty(ProcTable) then + % If there are no procedures left in the predicate, + % delete the predicate as well. + module_info_remove_predicate(PredId, !ModuleInfo) + else + pred_info_set_proc_table(ProcTable, PredInfo0, PredInfo), + module_info_set_pred_info(PredId, PredInfo, !ModuleInfo) + ), + + proc_prepare_to_clone(ProcInfo, HeadVars, Goal, VarSet, VarTypes, + RttiVarMaps, InstVarSet, DeclaredModes, Modes, _MaybeArgLives, + MaybeDeclaredDetism, Detism, EvalMethod, _ModeErrors, + MainContext, ItemNumber, CanProcess, _MaybeHeadModesConstr, + _DetismDecl, _CseNopullContexts, MaybeUntupleInfo, VarNameRemap, + _StateVarWarnings, DeletedCallees, IsAddressTaken, + HasForeignProcExports, HasParallelConj, HasUserEvent, HasTailCallEvent, + OisuKinds, MaybeRequireTailRecursion, RegR_HeadVars, MaybeArgPassInfo, + MaybeSpecialReturn, InitialLiveness, StackSlots, NeedsMaxfrSlot, + MaybeCallTableTip, MaybeTableIOInfo, MaybeTableAttrs, + MaybeObsoleteInFavourOf, MaybeDeepProfProcInfo, MaybeArgSizes, + MaybeTermInfo, Term2Info, MaybeExceptionInfo, MaybeTrailingInfo, + MaybeMMTablingInfo, SharingInfo, ReuseInfo), + pred_prepare_to_clone(PredInfo0, ModuleName, PredName, OrigArity, + PredOrFunc, Origin, Status, Markers, ArgTypes, + DeclTypeVarSet, TypeVarSet, ExistQVars, ClassContext, + ClausesInfo, _ProcTable, Context, CurUserDecl, GoalType, + Kinds, ExistQVarBindings, HeadTypeParams, + ClassProofs, ClassConstraintMap, UnprovenBodyConstraints, + InstGraphInfo, ArgModesMaps, PredVarNameRemap, Assertions, + ObsoleteInFavourOf, InstanceMethodArgTypes), + OoMInOutArgs = one_or_more(HeadArgPos, TailArgPosns), + clone_daio_pred_proc_args(!.ModuleInfo, 1, HeadArgPos, TailArgPosns, + ArgTypes, HeadVars, Modes, CloneArgTypes, CloneHeadVars, CloneModes, + VarSet, CloneVarSet, VarTypes, CloneVarTypes), + ( + DeclaredModes = maybe.no, + CloneDeclaredModes = maybe.no + ; + DeclaredModes = maybe.yes(_), + CloneDeclaredModes = maybe.yes(CloneModes) + ), + CloneMaybeArgLives = maybe.no, % Rebuilt on demand from modes. + CloneModeErrors = [], % All users of this field have run. + CloneMaybeHeadModesConstr = maybe.no, % This field has no current users. + CloneDetismDecl = detism_decl_none, + CloneCseNopullContexts = [], % All users of this field have run. + CloneStateVarWarnings = [], % All users of this field have run. + proc_create(CloneHeadVars, Goal, CloneVarSet, CloneVarTypes, + RttiVarMaps, InstVarSet, CloneDeclaredModes, CloneModes, + CloneMaybeArgLives, MaybeDeclaredDetism, Detism, EvalMethod, + CloneModeErrors, MainContext, ItemNumber, CanProcess, + CloneMaybeHeadModesConstr, CloneDetismDecl, CloneCseNopullContexts, + MaybeUntupleInfo, VarNameRemap, CloneStateVarWarnings, + DeletedCallees, IsAddressTaken, HasForeignProcExports, HasParallelConj, + HasUserEvent, HasTailCallEvent, OisuKinds, MaybeRequireTailRecursion, + RegR_HeadVars, MaybeArgPassInfo, MaybeSpecialReturn, InitialLiveness, + StackSlots, NeedsMaxfrSlot, MaybeCallTableTip, MaybeTableIOInfo, + MaybeTableAttrs, MaybeObsoleteInFavourOf, MaybeDeepProfProcInfo, + MaybeArgSizes, MaybeTermInfo, Term2Info, MaybeExceptionInfo, + MaybeTrailingInfo, MaybeMMTablingInfo, SharingInfo, ReuseInfo, + CloneProcInfo), + + ClonePredName = string.format("direct_arg_in_out_%d_%s", + [i(proc_id_to_int(ProcId)), s(PredName)]), + CloneOrigin = origin_transformed(transform_direct_arg_in_out, + Origin, PredId), + CloneProcTable = map.singleton(ProcId, CloneProcInfo), + pred_create(ModuleName, ClonePredName, OrigArity, PredOrFunc, + CloneOrigin, Status, Markers, CloneArgTypes, + DeclTypeVarSet, TypeVarSet, ExistQVars, ClassContext, + ClausesInfo, CloneProcTable, Context, CurUserDecl, GoalType, + Kinds, ExistQVarBindings, HeadTypeParams, + ClassProofs, ClassConstraintMap, UnprovenBodyConstraints, + InstGraphInfo, ArgModesMaps, PredVarNameRemap, Assertions, + ObsoleteInFavourOf, InstanceMethodArgTypes, ClonePredInfo), + + module_info_get_predicate_table(!.ModuleInfo, PredicateTable0), + predicate_table_insert(ClonePredInfo, ClonePredId, + PredicateTable0, PredicateTable), + module_info_set_predicate_table(PredicateTable, !ModuleInfo), + + ClonePredProcId = proc(ClonePredId, ProcId), + ProcInOut = direct_arg_proc_in_out(ClonePredProcId, OoMInOutArgs), + map.det_insert(ClonePredProcId, OoMInOutArgs, !CloneInOutMap), + + trace [compile_time(flag("daio-debug")), io(!IO)] ( + module_info_get_globals(!.ModuleInfo, Globals), + get_debug_output_stream(Globals, ModuleName, Stream, !IO), + io.format(Stream, "duplicating proc(%d, %d) %s -> %s:\n\t", + [i(pred_id_to_int(PredId)), i(proc_id_to_int(ProcId)), + s(PredName), s(ClonePredName)], !IO), + io.write_line(Stream, ProcInOut, !IO), + io.write_string(Stream, "old args: ", !IO), + io.write_line(Stream, HeadVars, !IO), + io.write_string(Stream, "new args: ", !IO), + io.write_line(Stream, CloneHeadVars, !IO) + ), + + module_info_get_pragma_exported_procs(!.ModuleInfo, ExportedProcsCord), + ExportedProcs = cord.list(ExportedProcsCord), + % We don't print the module qualifier anyway. + PredSNA = sym_name_arity(unqualified(PredName), OrigArity), + generate_error_if_cloned_proc_is_exported(PredSNA, PredId, ProcId, + ExportedProcs, !Specs). + +:- pred clone_daio_pred_proc_args(module_info::in, int::in, + int::in, list(int)::in, + list(mer_type)::in, list(prog_var)::in, list(mer_mode)::in, + list(mer_type)::out, list(prog_var)::out, list(mer_mode)::out, + prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det. + +clone_daio_pred_proc_args(ModuleInfo, CurArgNum, HeadArgPosn, TailArgPosns, + Types, Vars, Modes, CloneTypes, CloneVars, CloneModes, + !VarSet, !VarTypes) :- + ( if + Types = [HeadType | TailTypes], + Vars = [HeadVar | TailVars], + Modes = [HeadMode | TailModes] + then + ( if HeadArgPosn = CurArgNum then + % The NewVar we add to the list of headvars is only a placeholder. + % It will never be used, and after we have transformed the + % procedure body, replace_cloned_headvars will replace it + % with the variable that holds the final version of HeadVar + % in the body. The reason why we nevertheless include NewVar + % in the argument list is that + % + % (a) we have to add the type and mode of the cloned variable + % to the representation of the cloned procedure, and + % (b) many utility routines that operate on that representation + % insist, quite rightly, on the number of headvars + % matching the number of argument types and modes. + ( if varset.search_name(!.VarSet, HeadVar, HeadVarName) then + varset.new_named_var( + maybe_add_headvar_clone_suffix(HeadVarName), NewVar, + !VarSet) + else + varset.new_var(NewVar, !VarSet) + ), + add_var_type(NewVar, HeadType, !VarTypes), + daio_mode_to_mode_pair(ModuleInfo, HeadMode, + ClobberedHeadMode, CloneMode), + ( + TailArgPosns = [], + CloneTypes = [HeadType, HeadType | TailTypes], + CloneVars = [HeadVar, NewVar | TailVars], + CloneModes = [ClobberedHeadMode, CloneMode | TailModes] + ; + TailArgPosns = [HeadTailArgPosn | TailTailArgPosns], + clone_daio_pred_proc_args(ModuleInfo, CurArgNum + 1, + HeadTailArgPosn, TailTailArgPosns, + TailTypes, TailVars, TailModes, + TailCloneTypes, TailCloneVars, TailCloneModes, + !VarSet, !VarTypes), + CloneTypes = [HeadType, HeadType | TailCloneTypes], + CloneVars = [HeadVar, NewVar | TailCloneVars], + CloneModes = [ClobberedHeadMode, CloneMode | TailCloneModes] + ) + else + clone_daio_pred_proc_args(ModuleInfo, CurArgNum + 1, + HeadArgPosn, TailArgPosns, TailTypes, TailVars, TailModes, + TailCloneTypes, TailCloneVars, TailCloneModes, + !VarSet, !VarTypes), + CloneTypes = [HeadType | TailCloneTypes], + CloneVars = [HeadVar | TailCloneVars], + CloneModes = [HeadMode | TailCloneModes] + ) + else + unexpected($pred, "ran out of arguments") + ). + +:- pred daio_mode_to_mode_pair(module_info::in, mer_mode::in, + mer_mode::out, mer_mode::out) is det. + +daio_mode_to_mode_pair(ModuleInfo, Mode, ClobberedMode, CloneMode) :- + FromToInsts = mode_to_from_to_insts(ModuleInfo, Mode), + FromToInsts = from_to_insts(FromInst, ToInst), + ClobberedFromInst = clobber_daio_inst(ModuleInfo, FromInst), + ClobberedFromToInsts = from_to_insts(FromInst, ClobberedFromInst), + ClobberedMode = from_to_insts_to_mode(ClobberedFromToInsts), + CloneMode = from_to_mode(free, ToInst). + +:- func clobber_daio_inst(module_info, mer_inst) = mer_inst. + +clobber_daio_inst(ModuleInfo, Inst0) = ClobberedInst :- + inst_expand(ModuleInfo, Inst0, Inst), + ( + Inst = bound(_Uniq, TestResults, BoundInsts), + ( + TestResults = inst_test_results(_GroundNess, _ContainsAny, + _ContainsInstNames, _ContainsInstVars, _ContainsTypes, + _TypeCtorPropagated), + % None of the above six categories can be affected by + % applying clobber_daio_bound_inst to BoundInsts. + % This goal, and the switch around it, is here in case + % in the future we add a test that *can* be affected. + ClobberedTestResults = TestResults + ; + TestResults = inst_test_no_results, + ClobberedTestResults = TestResults + ; + TestResults = inst_test_results_fgtc, + ClobberedTestResults = TestResults + ), + ClobberedBoundInsts = + list.map(clobber_daio_bound_inst(ModuleInfo), BoundInsts), + ClobberedInst = bound(clobbered, ClobberedTestResults, + ClobberedBoundInsts) + ; + ( Inst = free + ; Inst = free(_) + ; Inst = ground(_, _) + ; Inst = any(_, _) + ; Inst = not_reached + ; Inst = inst_var(_) + ; Inst = abstract_inst(_, _) + ), + unexpected($pred, "inst is not a daio inst") + ; + ( Inst = constrained_inst_vars(_, _) + ; Inst = defined_inst(_) + ), + unexpected($pred, "unexpanded inst") + ). + +:- func clobber_daio_bound_inst(module_info, bound_inst) = bound_inst. + +clobber_daio_bound_inst(ModuleInfo, BoundInst) = ClobberedBoundInst :- + BoundInst = bound_functor(ConsId, ArgInsts), + ClobberedArgInsts = list.map(clobber_daio_arg_inst(ModuleInfo), ArgInsts), + ClobberedBoundInst = bound_functor(ConsId, ClobberedArgInsts). + +:- func clobber_daio_arg_inst(module_info, mer_inst) = mer_inst. + +clobber_daio_arg_inst(ModuleInfo, Inst0) = ClobberedInst :- + inst_expand(ModuleInfo, Inst0, Inst), + ( + Inst = ground(_Uniq, HOInstInfo), + ClobberedInst = ground(clobbered, HOInstInfo) + ; + ( Inst = bound(_, _, _) + ; Inst = free + ; Inst = free(_) + ), + ClobberedInst = ground(clobbered, none_or_default_func) + ; + ( Inst = any(_, _) + ; Inst = not_reached + ; Inst = inst_var(_) + ; Inst = abstract_inst(_, _) + ), + unexpected($pred, "inst is not a daio arg inst") + ; + ( Inst = constrained_inst_vars(_, _) + ; Inst = defined_inst(_) + ), + unexpected($pred, "unexpanded arg inst") + ). + +%---------------------------------------------------------------------------% + +:- pred transform_direct_arg_in_out_calls_in_pred(direct_arg_proc_map::in, + direct_arg_proc_in_out_map::in, clone_in_out_map::in, + pred_id::in, module_info::in, module_info::out, + list(error_spec)::in, list(error_spec)::out) is det. + +transform_direct_arg_in_out_calls_in_pred(DirectArgProcMap, + DirectArgProcInOutMap, CloneInOutMap, PredId, !ModuleInfo, !Specs) :- + module_info_pred_info(!.ModuleInfo, PredId, PredInfo0), + pred_info_get_proc_table(PredInfo0, ProcTable0), + map.map_foldl2( + maybe_transform_direct_arg_in_out_calls_in_proc(DirectArgProcMap, + DirectArgProcInOutMap, CloneInOutMap, PredId), + ProcTable0, ProcTable, !ModuleInfo, !Specs), + pred_info_set_proc_table(ProcTable, PredInfo0, PredInfo), + + module_info_get_preds(!.ModuleInfo, PredMap0), + map.det_update(PredId, PredInfo, PredMap0, PredMap), + module_info_set_preds(PredMap, !ModuleInfo). + +:- pred maybe_transform_direct_arg_in_out_calls_in_proc( + direct_arg_proc_map::in, direct_arg_proc_in_out_map::in, + clone_in_out_map::in, pred_id::in, proc_id::in, + proc_info::in, proc_info::out, module_info::in, module_info::out, + list(error_spec)::in, list(error_spec)::out) is det. + +maybe_transform_direct_arg_in_out_calls_in_proc(DirectArgProcMap, + DirectArgProcInOutMap, CloneInOutMap, PredId, ProcId, + !ProcInfo, !ModuleInfo, !Specs) :- + ( if proc_info_is_valid_mode(!.ProcInfo) then + transform_direct_arg_in_out_calls_in_proc(DirectArgProcMap, + DirectArgProcInOutMap, CloneInOutMap, PredId, ProcId, + !ProcInfo, !ModuleInfo, !Specs) + else + true + ). + +:- pred transform_direct_arg_in_out_calls_in_proc(direct_arg_proc_map::in, + direct_arg_proc_in_out_map::in, clone_in_out_map::in, + pred_id::in, proc_id::in, proc_info::in, proc_info::out, + module_info::in, module_info::out, + list(error_spec)::in, list(error_spec)::out) is det. + +transform_direct_arg_in_out_calls_in_proc(DirectArgProcMap, + DirectArgProcInOutMap, CloneInOutMap, PredId, ProcId, + !ProcInfo, !ModuleInfo, !Specs) :- + proc_info_get_varset(!.ProcInfo, VarSet0), + proc_info_get_vartypes(!.ProcInfo, VarTypes0), + proc_info_get_goal(!.ProcInfo, Goal0), + module_info_get_globals(!.ModuleInfo, Globals), + module_info_get_name(!.ModuleInfo, ModuleName), + PredIdInt = pred_id_to_int(PredId), + trace [compile_time(flag("daio-debug")), io(!IO)] ( + ( if (PredIdInt < 10 ; PredIdInt > 840) then + get_debug_output_stream(Globals, ModuleName, Stream, !IO), + io.format(Stream, "transforming proc(%d, %d)\n", + [i(pred_id_to_int(PredId)), i(proc_id_to_int(ProcId))], !IO), + ( if PredIdInt = 845 then + dump_goal_nl(Stream, !.ModuleInfo, VarSet0, Goal0, !IO) + else + true + ) + else + true + ) + ), + bimap.init(VarMap0), + Info0 = daio_info(!.ModuleInfo, DirectArgProcInOutMap, + VarSet0, VarTypes0, []), + proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InstMap0), + expand_daio_in_goal(Goal0, Goal, InstMap0, VarMap0, VarMap, Info0, Info), + PredProcId = proc(PredId, ProcId), + proc_info_get_headvars(!.ProcInfo, HeadVars0), + ( if map.search(CloneInOutMap, PredProcId, OoMInOutArgs) then + OoMInOutArgs = one_or_more(HeadInOutArg, TailInOutArgs), + replace_cloned_headvars(VarMap, 1, HeadInOutArg, TailInOutArgs, + HeadVars0, HeadVars), + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_debug_output_stream(Globals, ModuleName, Stream, !IO), + io.write_string(Stream, "replace_cloned_headvars:\n", !IO), + io.write_line(Stream, HeadVars0, !IO), + io.write_line(Stream, HeadVars, !IO) + ), + proc_info_set_headvars(HeadVars, !ProcInfo) + else + true + ), + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_debug_output_stream(Globals, ModuleName, Stream, !IO), + ( if PredIdInt = 973 then + io.write_string(Stream, "after transform:\n", !IO), + io.write_line(Stream, HeadVars0, !IO), + dump_goal_nl(Stream, !.ModuleInfo, VarSet, Goal, !IO) + else + true + ) + ), + Info = daio_info(_, _, VarSet, VarTypes, SeenForeignProcs), + % If any of the foreign_procs we have invoked appears in DirectArgProcMap, + % either as a procedure that needs to be cloned, or as a procedure for + % which we don't *know* whether it needs to be cloned, we generate + % an error message for it, since (a) this is easier than implementing + % and then *documenting* an argument passing mechanism for daio arguments + % to and from foreign coode, and (b) we have seen no need so far for + % *any* passing of partially-instantiated terms to or from foreign code, + % let alone any that involve direct arg tags. + % + % Since this pass is executed before any pass that does inlining, + % the only call_foreign_proc goals we should have seen is an + % invocation of *this* procedure, but we iterate over all the + % foreign procs we have seen just in case this changes in the future. + list.foldl(maybe_add_foreign_proc_error(!.ModuleInfo, DirectArgProcMap), + SeenForeignProcs, !Specs), + proc_info_set_varset(VarSet, !ProcInfo), + proc_info_set_vartypes(VarTypes, !ProcInfo), + proc_info_set_goal(Goal, !ProcInfo), + + requantify_proc_general(ordinary_nonlocals_maybe_lambda, !ProcInfo), + recompute_instmap_delta_proc(recompute_atomic_instmap_deltas, + !ProcInfo, !ModuleInfo). + + % The purpose of this predicate is described in the long comment + % about headvars in clone_daio_pred_proc_args. + % +:- pred replace_cloned_headvars(direct_arg_var_map::in, int::in, + int::in, list(int)::in, list(prog_var)::in, list(prog_var)::out) is det. + +replace_cloned_headvars(_, _, _, _, [], _) :- + unexpected($pred, "ran out of headvars"). +replace_cloned_headvars(VarMap, CurArgNum, HeadInOutArg, TailInOutArgs, + [HeadVar | TailVars0], Vars) :- + ( if CurArgNum = HeadInOutArg then + list.det_head_tail(TailVars0, _CloneVar, TailVars1), + bimap.lookup(VarMap, HeadVar, UpdatedHeadVar), + ( + TailInOutArgs = [], + Vars = [HeadVar, UpdatedHeadVar | TailVars1] + ; + TailInOutArgs = [HeadTailInOutArg | TailTailInOutArgs], + replace_cloned_headvars(VarMap, CurArgNum + 1, + HeadTailInOutArg, TailTailInOutArgs, TailVars1, TailVars), + Vars = [HeadVar, UpdatedHeadVar | TailVars] + ) + else + replace_cloned_headvars(VarMap, CurArgNum + 1, + HeadInOutArg, TailInOutArgs, TailVars0, TailVars), + Vars = [HeadVar | TailVars] + ). + +%---------------------------------------------------------------------------% + + % An entry VarA -> VarB means that VarB is the current version of VarA. + % The two vars of an entry will always be distinct; we never record + % a variable as being the current version of itself. + % + % When we first create a clone (VarB) of an original variable (VarA), + % we add an entry to this map. When we later find an update of VarB + % (to say VarC), we will update the VarA -> VarB entry to VarA -> VarC. + % Our need to be able to find VarA at that time is why this is a *bi*map. + % +:- type direct_arg_var_map == bimap(prog_var, prog_var). + +:- pred expand_daio_in_goal(hlds_goal::in, hlds_goal::out, instmap::in, + direct_arg_var_map::in, direct_arg_var_map::out, + daio_info::in, daio_info::out) is det. + +expand_daio_in_goal(Goal0, Goal, InstMap0, !VarMap, !Info) :- + Goal0 = hlds_goal(GoalExpr0, GoalInfo0), + VarRename = bimap.forward_map(!.VarMap), + rename_vars_in_goal_info(need_not_rename, VarRename, GoalInfo0, GoalInfo1), + ( + GoalExpr0 = plain_call(_, _, _, _, _, _), + rename_vars_in_goal_expr(need_not_rename, VarRename, + GoalExpr0, GoalExpr1), + GoalExpr1 = plain_call(CalleePredId, CalleeProcId, Args0, + BuiltinState, MaybeUnifyContext, _SymName), + ProcMap = !.Info ^ daio_proc_map, + CalleePredProcId = proc(CalleePredId, CalleeProcId), + ( if map.search(ProcMap, CalleePredProcId, CloneProc) then + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_daio_debug_stream(!.Info, Stream, !IO), + io.format(Stream, "call to proc(%d, %d)\n", + [i(pred_id_to_int(CalleePredId)), + i(proc_id_to_int(CalleeProcId))], !IO) + ), + CloneProc = direct_arg_proc_in_out(ClonePredProcId, OoMInOutArgs), + ClonePredProcId = proc(ClonePredId, CloneProcId), + OoMInOutArgs = one_or_more(HeadInOutArg, TailInOutArgs), + clone_in_out_args_in_plain_call(1, HeadInOutArg, TailInOutArgs, + Args0, Args, !VarMap, !Info), + ModuleInfo = !.Info ^ daio_module_info, + module_info_get_name(ModuleInfo, ModuleName), + module_info_pred_info(ModuleInfo, ClonePredId, ClonePredInfo), + pred_info_get_name(ClonePredInfo, ClonePredName), + CloneSymName = qualified(ModuleName, ClonePredName), + GoalExpr = plain_call(ClonePredId, CloneProcId, Args, + BuiltinState, MaybeUnifyContext, CloneSymName) + else + GoalExpr = GoalExpr1 + ) + ; + GoalExpr0 = generic_call(GenericCall, ArgVars0, ArgModes0, RegTypes, + Detism), + clone_in_out_args_in_generic_call(ArgVars0, ArgVars, + ArgModes0, ArgModes, !VarMap, !Info), + % The float regs pass is invoked well after this pass. + expect(unify(RegTypes, arg_reg_types_unset), $pred, + "arg reg types set"), + GoalExpr1 = generic_call(GenericCall, ArgVars, ArgModes, RegTypes, + Detism), + rename_vars_in_goal_expr(need_not_rename, VarRename, + GoalExpr1, GoalExpr) + ; + GoalExpr0 = call_foreign_proc(_, CalleePredId, CalleeProcId, + _, _, _, _), + rename_vars_in_goal_expr(need_not_rename, VarRename, + GoalExpr0, GoalExpr), + CalleePredProcId = proc(CalleePredId, CalleeProcId), + SeenForeignProcs0 = !.Info ^ daio_foreign_procs, + SeenForeignProcs = [CalleePredProcId | SeenForeignProcs0], + !Info ^ daio_foreign_procs := SeenForeignProcs + ; + GoalExpr0 = unify(LHSVar, RHS0, UnifyMode, Unification0, UnifyContext), + ( if + Unification0 = construct(_, ConsId0, _, _, _, _, _), + ConsId0 = closure_cons(ShroudedPredProcId0, EvalMethod), + ClosurePredProcId0 = unshroud_pred_proc_id(ShroudedPredProcId0), + ProcMap = !.Info ^ daio_proc_map, + map.search(ProcMap, ClosurePredProcId0, CloneProc) + then + CloneProc = direct_arg_proc_in_out(ClonePredProcId, _OoMInOutArgs), + ShroudedPredProcId = shroud_pred_proc_id(ClonePredProcId), + ConsId = closure_cons(ShroudedPredProcId, EvalMethod), + Unification = Unification0 ^ construct_cons_id := ConsId, + ( + RHS0 = rhs_functor(RHSConsId0, MaybeExistConstr0, ArgVars0), + expect(unify(RHSConsId0, ConsId0), $pred, + "closure construct cons_id mismatch"), + expect(unify(MaybeExistConstr0, is_not_exist_constr), $pred, + "closure construct is_exist_constr"), + RHS = rhs_functor(ConsId, MaybeExistConstr0, ArgVars0) + ; + ( RHS0 = rhs_var(_) + ; RHS0 = rhs_lambda_goal(_, _, _, _, _, _, _, _, _) + ), + unexpected($pred, "closure construct is not rhs_functor") + ), + GoalExpr1 = unify(LHSVar, RHS, UnifyMode, Unification, + UnifyContext) + else + GoalExpr1 = GoalExpr0 + ), + rename_vars_in_goal_expr(need_not_rename, VarRename, + GoalExpr1, GoalExpr2), + expand_daio_in_unify(GoalInfo1, GoalExpr2, GoalExpr, InstMap0, + !VarMap, !Info) + ; + GoalExpr0 = conj(ConjType, Goals0), + expand_daio_in_conj(Goals0, Goals, InstMap0, !VarMap, !Info), + GoalExpr = conj(ConjType, Goals) + ; + GoalExpr0 = disj(Goals0), + expand_daio_in_branches(GoalInfo1, InstMap0, Goals0, Goals, + !VarMap, !Info), + GoalExpr = disj(Goals) + ; + GoalExpr0 = switch(Var0, CanFail, Cases0), + rename_var(need_not_rename, VarRename, Var0, Var), + expand_daio_in_branches(GoalInfo1, InstMap0, Cases0, Cases, + !VarMap, !Info), + GoalExpr = switch(Var, CanFail, Cases) + ; + GoalExpr0 = negation(SubGoal0), + % Bindings made in negated goals are not visible to any code + % that follows the negation. + expand_daio_in_goal(SubGoal0, SubGoal, InstMap0, !.VarMap, _, !Info), + GoalExpr = negation(SubGoal) + ; + GoalExpr0 = scope(Reason, SubGoal0), + ( if + Reason = from_ground_term(_, FGT), + ( FGT = from_ground_term_construct + ; FGT = from_ground_term_deconstruct + ) + then + % SubGoal0 can't have any partially instantiated terms. + GoalExpr = GoalExpr0 + else + expand_daio_in_goal(SubGoal0, SubGoal, InstMap0, !VarMap, !Info), + GoalExpr = scope(Reason, SubGoal) + ) + ; + GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0), + expand_daio_in_if_then_else(GoalInfo1, Cond0, Cond, Then0, Then, + Else0, Else, InstMap0, !VarMap, !Info), + GoalExpr = if_then_else(Vars, Cond, Then, Else) + ; + GoalExpr0 = shorthand(ShortHand0), + ( + ShortHand0 = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars, + MainGoal0, OrElseGoals0, OrElseInners), + expand_daio_in_branches(GoalInfo1, InstMap0, + [MainGoal0 | OrElseGoals0], MainOrElseGoals, !VarMap, !Info), + list.det_head_tail(MainOrElseGoals, MainGoal, OrElseGoals), + ShortHand = atomic_goal(GoalType, Outer, Inner, MaybeOutputVars, + MainGoal, OrElseGoals, OrElseInners) + ; + ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0), + expand_daio_in_goal(SubGoal0, SubGoal, InstMap0, !VarMap, !Info), + ShortHand = try_goal(MaybeIO, ResultVar, SubGoal) + ; + ShortHand0 = bi_implication(_, _), + % These should have been expanded out by now. + unexpected($pred, "bi_implication") + ), + GoalExpr = shorthand(ShortHand) + ), + Goal = hlds_goal(GoalExpr, GoalInfo1). + +%---------------------% + +:- pred clone_in_out_args_in_plain_call(int::in, int::in, list(int)::in, + list(prog_var)::in, list(prog_var)::out, + direct_arg_var_map::in, direct_arg_var_map::out, + daio_info::in, daio_info::out) is det. + +clone_in_out_args_in_plain_call(_, _, _, [], _, !VarMap, !Info) :- + unexpected($pred, "ran out of arguments"). +clone_in_out_args_in_plain_call(CurArgNum, HeadInOutArg, TailInOutArgs, + [HeadVar0 | TailVars0], Vars, !VarMap, !Info) :- + ( if CurArgNum = HeadInOutArg then + make_new_clone_var(HeadVar0, CloneVar, !Info), + ( if bimap.reverse_search(!.VarMap, OrigVar, HeadVar0) then + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_daio_debug_stream(!.Info, Stream, !IO), + io.format(Stream, "plain update mapping %d -> %d\n", + [i(term.var_to_int(HeadVar0)), + i(term.var_to_int(CloneVar))], !IO), + io.flush_output(Stream, !IO) + ), + bimap.set(OrigVar, CloneVar, !VarMap) + else + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_daio_debug_stream(!.Info, Stream, !IO), + io.format(Stream, "plain insert mapping %d -> %d\n", + [i(term.var_to_int(HeadVar0)), + i(term.var_to_int(CloneVar))], !IO), + io.flush_output(Stream, !IO) + ), + bimap.det_insert(HeadVar0, CloneVar, !VarMap) + ), + ( + TailInOutArgs = [], + Vars = [HeadVar0, CloneVar | TailVars0] + ; + TailInOutArgs = [HeadTailInOutArg | TailTailInOutArgs], + clone_in_out_args_in_plain_call(CurArgNum + 1, + HeadTailInOutArg, TailTailInOutArgs, + TailVars0, TailVars, !VarMap, !Info), + Vars = [HeadVar0, CloneVar | TailVars] + ) + else + clone_in_out_args_in_plain_call(CurArgNum + 1, + HeadInOutArg, TailInOutArgs, TailVars0, TailVars, !VarMap, !Info), + Vars = [HeadVar0 | TailVars] + ). + +%---------------------% + +:- pred clone_in_out_args_in_generic_call( + list(prog_var)::in, list(prog_var)::out, + list(mer_mode)::in, list(mer_mode)::out, + direct_arg_var_map::in, direct_arg_var_map::out, + daio_info::in, daio_info::out) is det. + +clone_in_out_args_in_generic_call([], [], [], [], !VarMap, !Info). +clone_in_out_args_in_generic_call([], _, [_ | _], _, !VarMap, !Info) :- + unexpected($pred, "list length mismatch"). +clone_in_out_args_in_generic_call([_ | _], _, [], _, !VarMap, !Info) :- + unexpected($pred, "list length mismatch"). +clone_in_out_args_in_generic_call([HeadVar0 | TailVars0], Vars, + [HeadMode0 | TailModes0], Modes, !VarMap, !Info) :- + ModuleInfo0 = !.Info ^ daio_module_info, + VarTypes0 = !.Info ^ daio_vartypes, + is_direct_arg_in_out_posn(ModuleInfo0, VarTypes0, HeadVar0, HeadMode0, + IsDAIO), + ( + IsDAIO = mode_is_daio, + make_new_clone_var(HeadVar0, CloneVar, !Info), + ( if bimap.reverse_search(!.VarMap, OrigVar, HeadVar0) then + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_daio_debug_stream(!.Info, Stream, !IO), + io.format(Stream, "closure update mapping %d -> %d\n", + [i(term.var_to_int(HeadVar0)), + i(term.var_to_int(CloneVar))], !IO), + io.flush_output(Stream, !IO) + ), + bimap.set(OrigVar, CloneVar, !VarMap) + else + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_daio_debug_stream(!.Info, Stream, !IO), + io.format(Stream, "closure insert mapping %d -> %d\n", + [i(term.var_to_int(HeadVar0)), + i(term.var_to_int(CloneVar))], !IO), + io.flush_output(Stream, !IO) + ), + bimap.det_insert(HeadVar0, CloneVar, !VarMap) + ), + daio_mode_to_mode_pair(ModuleInfo0, HeadMode0, + ClobberedHeadMode, CloneMode), + clone_in_out_args_in_generic_call(TailVars0, TailVars, + TailModes0, TailModes, !VarMap, !Info), + Vars = [HeadVar0, CloneVar | TailVars], + Modes = [ClobberedHeadMode, CloneMode | TailModes] + ; + ( IsDAIO = mode_is_not_daio + ; IsDAIO = mode_may_be_daio + ), + % What we do in the mode_may_be_daio case does not matter, + % because the errors we generate when the callee is compiled + % will prevent the code we generate from being linked into + % an executable. + clone_in_out_args_in_generic_call(TailVars0, TailVars, + TailModes0, TailModes, !VarMap, !Info), + Vars = [HeadVar0 | TailVars], + Modes = [HeadMode0 | TailModes] + ). + +%---------------------% + +:- pred expand_daio_in_unify(hlds_goal_info::in, + hlds_goal_expr::in(goal_expr_unify), hlds_goal_expr::out, + instmap::in, direct_arg_var_map::in, direct_arg_var_map::out, + daio_info::in, daio_info::out) is det. + +expand_daio_in_unify(GoalInfo0, GoalExpr0, GoalExpr, InstMap0, + !VarMap, !Info) :- + GoalExpr0 = unify(_LHS, _RHS0, _Mode, Unification0, _Context), + ( + ( Unification0 = construct(_, _, _, _, _, _, _) + ; Unification0 = assign(_, _) + ; Unification0 = simple_test(_, _) + ), + GoalExpr = GoalExpr0 + ; + Unification0 = deconstruct(X, ConsId, _Ys, UnifyModes, + _CanFail, _CanCgc), + ModuleInfo = !.Info ^ daio_module_info, + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_daio_debug_stream(!.Info, Stream, !IO), + dump_goal_nl(Stream, ModuleInfo, !.Info ^ daio_varset, + hlds_goal(GoalExpr0, GoalInfo0), !IO), + io.flush_output(Stream, !IO) + ), + ( if + UnifyModes = [UnifyMode], + UnifyMode = unify_modes_li_lf_ri_rf(LI, LF, _RI, _RF), + ( LI = free ; LI = free(_) ), + not ( LF = free ; LF = free(_) ), + ConsId = cons(ConsIdSymName, ConsIdArity, ConsIdTypeCtor), + module_info_get_type_table(ModuleInfo, TypeTable), + search_type_ctor_defn(TypeTable, ConsIdTypeCtor, TypeDefn), + get_type_defn_body(TypeDefn, TypeBody), + TypeBody = hlds_du_type(_, _, MaybeRepn, _), + ( + MaybeRepn = no, + unexpected($pred, "MaybeRepn = no") + ; + MaybeRepn = yes(Repn) + ), + CtorRepns = Repn ^ dur_ctor_repns, + find_named_ctor_repn(CtorRepns, ConsIdSymName, ConsIdArity, + ConsIdCtorRepn), + ConsIdCtorRepn ^ cr_tag = direct_arg_tag(_Ptag) + then + make_new_clone_var(X, CloneX, !Info), + bimap.set(X, CloneX, !VarMap), + module_info_get_predicate_table(ModuleInfo, PredTable), + CopySymName = qualified(mercury_private_builtin_module, + "partial_inst_copy"), + predicate_table_lookup_pred_sym_arity_one(PredTable, + is_fully_qualified, CopySymName, 2, CopyPredId), + proc_id_to_int(CopyProcId, 0), + MaybeUnifyContext = no, + CopyGoalExpr = plain_call(CopyPredId, CopyProcId, [X, CloneX], + inline_builtin, MaybeUnifyContext, CopySymName), + Context = goal_info_get_context(GoalInfo0), + set_of_var.list_to_set([X, CloneX], NonLocals), + instmap_lookup_var(InstMap0, X, InitInstOfX), + Clobbered = ground(clobbered, none_or_default_func), + InstMapDelta = instmap_delta_from_assoc_list( + [X - Clobbered, CloneX - InitInstOfX]), + goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure, + Context, CopyGoalInfo), + CopyGoal = hlds_goal(CopyGoalExpr, CopyGoalInfo), + Goal0 = hlds_goal(GoalExpr0, GoalInfo0), + GoalExpr = conj(plain_conj, [Goal0, CopyGoal]), + trace [compile_time(flag("daio-debug")), io(!IO)] ( + get_daio_debug_stream(!.Info, Stream, !IO), + io.write_string(Stream, "CopyGoal:\n", !IO), + dump_goal_nl(Stream, ModuleInfo, !.Info ^ daio_varset, + CopyGoal, !IO), + io.flush_output(Stream, !IO) + ) + else + GoalExpr = GoalExpr0 + ) + ; + Unification0 = complicated_unify(_, _, _), + unexpected($pred, "complicated_unify") + ). + +:- pred find_named_ctor_repn(list(constructor_repn)::in, + sym_name::in, arity::in, constructor_repn::out) is det. + +find_named_ctor_repn([], _, _, _) :- + unexpected($pred, "did not find constructor"). +find_named_ctor_repn([Ctor | Ctors], SymName, Arity, SearchCtor) :- + ( if + Ctor ^ cr_name = SymName, + list.length(Ctor ^ cr_args, Arity) + then + SearchCtor = Ctor + else + find_named_ctor_repn(Ctors, SymName, Arity, SearchCtor) + ). + +%---------------------% + +:- pred expand_daio_in_conj(list(hlds_goal)::in, list(hlds_goal)::out, + instmap::in, direct_arg_var_map::in, direct_arg_var_map::out, + daio_info::in, daio_info::out) is det. + +expand_daio_in_conj([], [], _, !VarMap, !Info). +expand_daio_in_conj([Goal0 | Goals0], [Goal | Goals], InstMap0, + !VarMap, !Info) :- + expand_daio_in_goal(Goal0, Goal, InstMap0, !VarMap, !Info), + update_instmap(Goal0, InstMap0, InstMap1), + expand_daio_in_conj(Goals0, Goals, InstMap1, !VarMap, !Info). + +%---------------------% +% +% Ensure that every branch of a branched control structure ends up with +% the same variable representing the current verion of every direct-arg-in-out +% variable that is nonlocal in the branched control structure. +% (If a direct-arg-in-out variable is local to a branch, it needs no merging.) +% +% If a direct-arg-in-out variable was live before the branched control +% structure, then we merge, since it may be used after the branched +% control structure. (If it isn't used after, the merging is useless, +% but also harmless, and the goals that do the merging should be removed +% by the simplification we do on the post-transformation form of the +% procedure.) So if any branch whose end is reachable updates an +% direct-arg-in-out variable, we ensure that all such branches will end up +% with the same variable representing the current version of that original +% direct-arg-in-out variable. +% +% If a direct-arg-in-out variable was not live before the branched control +% structure, then it must be born in every branch whose end is reachable. +% In such cases as well we ensure that all branches whose end is reachable +% end up with the same variable representing the current version of that +% original direct-arg-in-out variable. +% + +:- type arm_varmap(G) + ---> arm_varmap(G, direct_arg_var_map). +:- type goal_varmap == arm_varmap(hlds_goal). +:- type case_varmap == arm_varmap(case). + +:- typeclass goal_like(G) where [ + pred end_is_reachable(G::in) is semidet, + pred append_goal(G::in, hlds_goal::in, G::out) is det, + pred expand_daio_in_goal_like_varmap(direct_arg_var_map::in, + G::in, instmap::in, arm_varmap(G)::out, + daio_info::in, daio_info::out) is det +]. + +:- instance goal_like(hlds_goal) where [ + pred(end_is_reachable/1) is goal_end_is_reachable, + pred(append_goal/3) is append_goal_to_goal, + pred(expand_daio_in_goal_like_varmap/6) is expand_daio_in_goal_varmap +]. + +:- instance goal_like(case) where [ + pred(end_is_reachable/1) is case_end_is_reachable, + pred(append_goal/3) is append_goal_to_case, + pred(expand_daio_in_goal_like_varmap/6) is expand_daio_in_case_varmap +]. + +:- pred expand_daio_in_goal_likes_varmaps(direct_arg_var_map::in, + list(G)::in, instmap::in, list(arm_varmap(G))::out, + daio_info::in, daio_info::out) is det <= goal_like(G). + +expand_daio_in_goal_likes_varmaps(_InitVarMap, [], _, [], !Info). +expand_daio_in_goal_likes_varmaps(InitVarMap, [Goal0 | Goals0], + InstMap0, [GoalVarMap | GoalsVarMaps], !Info) :- + expand_daio_in_goal_like_varmap(InitVarMap, Goal0, InstMap0, + GoalVarMap, !Info), + expand_daio_in_goal_likes_varmaps(InitVarMap, Goals0, InstMap0, + GoalsVarMaps, !Info). + +%---------------------% + +:- pred goal_end_is_reachable(hlds_goal::in) is semidet. + +goal_end_is_reachable(Goal) :- + Goal = hlds_goal(_, GoalInfo), + InstMapDelta = goal_info_get_instmap_delta(GoalInfo), + % We want to test whether the end of the branch is reachable. + % Any reachable to unreachable transition may come inside Goal, + % which is what InstMapDelta reports, or before we start executing + % Goal. However, this pass is invoked just after the simplification + % pass, and that pass removes all unreachable code, so if we get here, + % the latter should never be the case. + instmap_delta_is_reachable(InstMapDelta). + +:- pred case_end_is_reachable(case::in) is semidet. + +case_end_is_reachable(case(_, _, Goal)) :- + goal_end_is_reachable(Goal). + +%---------------------% + +:- pred append_goal_to_goal(hlds_goal::in, hlds_goal::in, + hlds_goal::out) is det. + +append_goal_to_goal(Goal0, AssignGoal, Goal) :- + Goal0 = hlds_goal(GoalExpr0, GoalInfo0), + ( if GoalExpr0 = conj(plain_conj, Conjuncts0) then + % This append could be expensive if this loop is executed many times, + % but the probability of that should be vanishingly small. + GoalExpr = conj(plain_conj, Conjuncts0 ++ [AssignGoal]) + else + GoalExpr = conj(plain_conj, [Goal0, AssignGoal]) + ), + % The nonlocals set and instmap_delta of Goal will be fixed up + % once the whole procedure body has been transformed. + Goal = hlds_goal(GoalExpr, GoalInfo0). + +:- pred append_goal_to_case(case::in, hlds_goal::in, case::out) is det. + +append_goal_to_case(Case0, AssignGoal, Case) :- + Case0 = case(MainConsId, OtherConsIds, Goal0), + append_goal_to_goal(Goal0, AssignGoal, Goal), + Case = case(MainConsId, OtherConsIds, Goal). + +%---------------------% + +:- pred expand_daio_in_goal_varmap(direct_arg_var_map::in, + hlds_goal::in, instmap::in, goal_varmap::out, + daio_info::in, daio_info::out) is det. + +expand_daio_in_goal_varmap(InitVarMap, Goal0, InstMap0, GoalVarMap, !Info) :- + expand_daio_in_goal(Goal0, Goal, InstMap0, InitVarMap, VarMap, !Info), + GoalVarMap = arm_varmap(Goal, VarMap). + +:- pred expand_daio_in_case_varmap(direct_arg_var_map::in, + case::in, instmap::in, case_varmap::out, + daio_info::in, daio_info::out) is det. + +expand_daio_in_case_varmap(InitVarMap, Case0, InstMap0, CaseVarMap, !Info) :- + Case0 = case(MainConsId, OtherConsIds, Goal0), + expand_daio_in_goal(Goal0, Goal, InstMap0, InitVarMap, VarMap, !Info), + Case = case(MainConsId, OtherConsIds, Goal), + CaseVarMap = arm_varmap(Case, VarMap). + +%---------------------% + +:- pred expand_daio_in_branches(hlds_goal_info::in, instmap::in, + list(G)::in, list(G)::out, + direct_arg_var_map::in, direct_arg_var_map::out, + daio_info::in, daio_info::out) is det <= goal_like(G). + +expand_daio_in_branches(GoalInfo0, InstMap0, Disjuncts0, Disjuncts, + InitVarMap, MergedVarMap, !Info) :- + expand_daio_in_goal_likes_varmaps(InitVarMap, + Disjuncts0, InstMap0, DisjunctsVarMaps, !Info), + NonLocals = goal_info_get_nonlocals(GoalInfo0), + VarMapVars0 = set.list_to_set(bimap.ordinates(InitVarMap)), + gather_orig_vars(DisjunctsVarMaps, VarMapVars0, VarMapVars), + set.intersect(set_of_var.bitset_to_set(NonLocals), VarMapVars, + VarsToMerge), + merge_disj_goals_varmaps(InitVarMap, set.to_sorted_list(VarsToMerge), + MergedVarMapEntries, DisjunctsVarMaps, MergedDisjunctsVarMaps, !Info), + bimap.det_from_assoc_list(MergedVarMapEntries, MergedVarMap), + Disjuncts = list.map(project_arm, MergedDisjunctsVarMaps). + +:- pred expand_daio_in_if_then_else(hlds_goal_info::in, + hlds_goal::in, hlds_goal::out, hlds_goal::in, hlds_goal::out, + hlds_goal::in, hlds_goal::out, instmap::in, + direct_arg_var_map::in, direct_arg_var_map::out, + daio_info::in, daio_info::out) is det. + +expand_daio_in_if_then_else(GoalInfo0, Cond0, Cond, Then0, Then, + Else0, Else, InstMap0, InitVarMap, MergedVarMap, !Info) :- + expand_daio_in_goal(Cond0, Cond, InstMap0, InitVarMap, CondVarMap, !Info), + update_instmap(Cond0, InstMap0, InstMap1), + expand_daio_in_goal(Then0, Then1, InstMap1, CondVarMap, ThenVarMap, !Info), + expand_daio_in_goal(Else0, Else1, InstMap0, InitVarMap, ElseVarMap, !Info), + ThenArmVarMap1 = arm_varmap(Then1, ThenVarMap), + ElseArmVarMap1 = arm_varmap(Else1, ElseVarMap), + + NonLocals = goal_info_get_nonlocals(GoalInfo0), + VarMapVars = set.list_to_set(bimap.ordinates(InitVarMap) ++ + bimap.ordinates(ThenVarMap) ++ bimap.ordinates(ElseVarMap)), + set.intersect(set_of_var.bitset_to_set(NonLocals), VarMapVars, + VarsToMerge), + merge_disj_goals_varmaps(InitVarMap, set.to_sorted_list(VarsToMerge), + MergedVarMapEntries, [ThenArmVarMap1, ElseArmVarMap1], + MergedDisjunctsVarMaps, !Info), + bimap.det_from_assoc_list(MergedVarMapEntries, MergedVarMap), + ( + MergedDisjunctsVarMaps = [arm_varmap(Then, _), arm_varmap(Else, _)] + ; + ( MergedDisjunctsVarMaps = [] + ; MergedDisjunctsVarMaps = [_] + ; MergedDisjunctsVarMaps = [_, _, _ | _] + ), + unexpected($pred, "then and else not length 2") + ). + +%---------------------% + +:- pred merge_disj_goals_varmaps(direct_arg_var_map::in, list(prog_var)::in, + assoc_list(prog_var, prog_var)::out, + list(arm_varmap(G))::in, list(arm_varmap(G))::out, + daio_info::in, daio_info::out) is det <= goal_like(G). + +merge_disj_goals_varmaps(_, [], [], !GoalsVarMaps, !Info). +merge_disj_goals_varmaps(EntryVarMap, [OrigVar | OrigVars], + [OrigVar - MergeVar | OrigMergeVars], !GoalsVarMaps, !Info) :- + ( if + bimap.search(EntryVarMap, OrigVar, EntryVar), + entry_var_is_ever_changed(OrigVar, EntryVar, !.GoalsVarMaps) = no + then + MergeVar = EntryVar + else + make_new_clone_var(OrigVar, MergeVar, !Info), + % Note that the assignment we add here would be accepted + % by mode analysis if it appeared in the source code *only* + % if OrigVar is ground. If it could still be only partially + % instantiated, as happens in e.g. tests/hard_coded/gh72.m, + % mode analysis would reject the code we create here, + % because neither of the two variables being unified here + % would be ground. However, this pass is done *after* mode analysis, + % so this is not an issue, *unless* XXX some later pass repeats + % a full mode analysis. (The recomputation of instmap deltas, + % which we invoke once the transformation of the procedure body + % is complete, does not care about such details.) + % + % The assignment we do here is semantically ok because it does not + % actually create a free-free alias between the two variables, + % since this unification is both the last appearance of (the current + % version of) OrigVar and the first appearance of MergeVar. + % Free-free alias is a problem *only* between two variables + % that can be alive at the same time. This pass ensures the + % disjointness of the two variables' lifefimes by construction, + % but (in the absence of alias tracking) mode analysis cannot + % check this. + add_assign_of_merge_var(OrigVar, MergeVar, !GoalsVarMaps) + ), + merge_disj_goals_varmaps(EntryVarMap, OrigVars, OrigMergeVars, + !GoalsVarMaps, !Info). + +:- func entry_var_is_ever_changed(prog_var, prog_var, + list(arm_varmap(G))) = bool <= goal_like(G). + +entry_var_is_ever_changed(_OrigVar, _EntryVar, []) = no. +entry_var_is_ever_changed(OrigVar, EntryVar, [GoalVarMap | GoalsVarMaps]) = + IsChanged :- + IsChangedTail = entry_var_is_ever_changed(OrigVar, EntryVar, GoalsVarMaps), + GoalVarMap = arm_varmap(Goal, VarMap), + bimap.lookup(VarMap, OrigVar, AfterVar), + ( if AfterVar = EntryVar then + IsChanged = IsChangedTail + else + ( if end_is_reachable(Goal) then + IsChanged = yes + else + IsChanged = IsChangedTail + ) + ). + +:- pred add_assign_of_merge_var(prog_var::in, prog_var::in, + list(arm_varmap(G))::in, list(arm_varmap(G))::out) is det <= goal_like(G). + +add_assign_of_merge_var(_OrigVar, _MergeVar, [], []). +add_assign_of_merge_var(OrigVar, MergeVar, + [GoalVarMap0 | GoalVarMaps0], [GoalVarMap | GoalsVarMaps]) :- + GoalVarMap0 = arm_varmap(Goal0, VarMap), + ( if end_is_reachable(Goal0) then + ( if bimap.search(VarMap, OrigVar, CurVarPrime) then + CurVar = CurVarPrime + else + CurVar = OrigVar + ), + UnifyMainContext = umc_implicit("direct_arg_in_out_call"), + UnifySubContexts = [], + make_simple_assign(MergeVar, CurVar, + UnifyMainContext, UnifySubContexts, AssignGoal), + append_goal(Goal0, AssignGoal, Goal) + else + % There is no point in adding dead code to the end of Goal0. + Goal = Goal0 + ), + GoalVarMap = arm_varmap(Goal, VarMap), + add_assign_of_merge_var(OrigVar, MergeVar, GoalVarMaps0, GoalsVarMaps). + +%---------------------% + +:- pred gather_orig_vars(list(arm_varmap(T))::in, + set(prog_var)::in, set(prog_var)::out) is det. + +gather_orig_vars([], !OrigVars). +gather_orig_vars([ArmVarMap | ArmVarMaps], !OrigVars) :- + ArmVarMap = arm_varmap(_, VarMap), + set.insert_list(bimap.ordinates(VarMap), !OrigVars), + gather_orig_vars(ArmVarMaps, !OrigVars). + +:- func project_arm(arm_varmap(T)) = T. + +project_arm(arm_varmap(Arm, _VarMap)) = Arm. + +%---------------------% + +:- pred make_new_clone_var(prog_var::in, prog_var::out, + daio_info::in, daio_info::out) is det. + +make_new_clone_var(OldVar, NewVar, !Info) :- + VarSet0 = !.Info ^ daio_varset, + VarTypes0 = !.Info ^ daio_vartypes, + ( if varset.search_name(VarSet0, OldVar, HeadVarName) then + varset.new_named_var(maybe_add_goal_clone_suffix(HeadVarName), NewVar, + VarSet0, VarSet) + else + varset.new_var(NewVar, VarSet0, VarSet) + ), + lookup_var_type(VarTypes0, OldVar, VarType), + add_var_type(NewVar, VarType, VarTypes0, VarTypes), + !Info ^ daio_varset := VarSet, + !Info ^ daio_vartypes := VarTypes. + +%---------------------------------------------------------------------------% + +:- pred transform_class(direct_arg_proc_in_out_map::in, + hlds_class_defn::in, hlds_class_defn::out) is det. + +transform_class(DirectArgProcInOutMap, Class0, Class) :- + PredProcIds0 = Class0 ^ classdefn_hlds_interface, + list.map(transform_class_instance_proc(DirectArgProcInOutMap), + PredProcIds0, PredProcIds), + Class = Class0 ^ classdefn_hlds_interface := PredProcIds. + +:- pred transform_class_instances(direct_arg_proc_in_out_map::in, + list(hlds_instance_defn)::in, list(hlds_instance_defn)::out) is det. + +transform_class_instances(DirectArgProcInOutMap, Instances0, Instances) :- + list.map(transform_class_instance(DirectArgProcInOutMap), + Instances0, Instances). + +:- pred transform_class_instance(direct_arg_proc_in_out_map::in, + hlds_instance_defn::in, hlds_instance_defn::out) is det. + +transform_class_instance(DirectArgProcInOutMap, Instance0, Instance) :- + MaybeInterface0 = Instance0 ^ instdefn_hlds_interface, + ( + MaybeInterface0 = no, + Instance = Instance0 + ; + MaybeInterface0 = yes(PredProcIds0), + list.map(transform_class_instance_proc(DirectArgProcInOutMap), + PredProcIds0, PredProcIds), + MaybeInterface = yes(PredProcIds), + Instance = Instance0 ^ instdefn_hlds_interface := MaybeInterface + ). + +:- pred transform_class_instance_proc(direct_arg_proc_in_out_map::in, + pred_proc_id::in, pred_proc_id::out) is det. + +transform_class_instance_proc(DirectArgProcInOutMap, PredProcId0, PredProcId) :- + ( if map.search(DirectArgProcInOutMap, PredProcId0, ProcInOut) then + ProcInOut = direct_arg_proc_in_out(PredProcId, _ArgPosns) + else + PredProcId = PredProcId0 + ). + +%---------------------------------------------------------------------------% + +:- type daio_info + ---> daio_info( + % These two fields remain constant during the traversal + % of a procedure body. + daio_module_info :: module_info, + daio_proc_map :: direct_arg_proc_in_out_map, + + % We update these two fields as we create new clone variables. + daio_varset :: prog_varset, + daio_vartypes :: vartypes, + + % We update this field as we find call_foreign_proc goals. + daio_foreign_procs :: list(pred_proc_id) + ). + +:- pred get_daio_debug_stream(daio_info::in, io.text_output_stream::out, + io::di, io::uo) is det. + +get_daio_debug_stream(Info, Stream, !IO) :- + ModuleInfo = Info ^ daio_module_info, + module_info_get_globals(ModuleInfo, Globals), + module_info_get_name(ModuleInfo, ModuleName), + get_debug_output_stream(Globals, ModuleName, Stream, !IO). + +%---------------------------------------------------------------------------% +% +% Debugging the transformations performed by this module is easier +% if clone variables differ from their progenitor variables not only +% in variable number, but also in the name. These functions exist to +% allow a distinguishing suffix to be added to the ends of the names +% of cloned variables. +% +% However, since the foreign language variable names used by code inside +% foreign_procs must match the original variable names used by the programmer, +% both these functions must return their arguments unchanged if we want +% passing cloned vars to foreign_procs to work. +% + +:- func maybe_add_goal_clone_suffix(string) = string. + +maybe_add_goal_clone_suffix(VarName) = VarName. + +:- func maybe_add_headvar_clone_suffix(string) = string. + +maybe_add_headvar_clone_suffix(VarName) = VarName. + +%---------------------------------------------------------------------------% + +:- pred generate_problem_proc_error(module_info::in, pred_proc_id::in, + one_or_more(int)::in, error_spec::out) is det. + +generate_problem_proc_error(ModuleInfo, PredProcId, OoMProblemArgs, Spec) :- + OoMProblemArgs = one_or_more(HeadProblemArg, TailProblemArgs), + ProcDescPieces = describe_one_proc_name(ModuleInfo, + should_not_module_qualify, PredProcId), + ( + TailProblemArgs = [], + Pieces = [words("Error: the compiler cannot implement"), + words("argument passing for the"), nth_fixed(HeadProblemArg), + words("argument of")] ++ ProcDescPieces ++ [suffix(","), + words("because the type of this argument"), + words("uses the"), quote("direct_arg"), + words("data representations optimization,"), + words("which requires special handling when"), + words("used with partially instantiated data structures,"), + words("but the mode of this argument,"), + words("containing either abstract insts or inst vars,"), + words("prevents the compiler from knowing whether"), + words("to apply this special handling or not."), nl] + ; + TailProblemArgs = [_ | _], + ProblemArgPieces = list.map((func(N) = nth_fixed(N)), + [HeadProblemArg | TailProblemArgs]), + ProblemArgListPieces = + component_list_to_pieces("and", ProblemArgPieces), + Pieces = [words("Error: the compiler cannot implement"), + words("argument passing for the")] ++ ProblemArgListPieces ++ + [words("arguments of")] ++ ProcDescPieces ++ [suffix(","), + words("because the types of these arguments"), + words("use the"), quote("direct_arg"), + words("data representations optimization,"), + words("which requires special handling when"), + words("used with partially instantiated data structures,"), + words("but the modes of these arguments,"), + words("containing either abstract insts or inst vars,"), + words("prevent the compiler from knowing whether"), + words("to apply this special handling or not."), nl] + ), + module_info_pred_proc_info(ModuleInfo, PredProcId, _PredInfo, ProcInfo), + proc_info_get_context(ProcInfo, Context), + Spec = simplest_spec($pred, severity_error, phase_direct_arg_in_out, + Context, Pieces). + +%---------------------% + +:- pred generate_error_if_cloned_proc_is_exported(sym_name_arity::in, + pred_id::in, proc_id::in, list(pragma_exported_proc)::in, + list(error_spec)::in, list(error_spec)::out) is det. + +generate_error_if_cloned_proc_is_exported(_, _, _, [], !Specs). +generate_error_if_cloned_proc_is_exported(PredSNA, PredId, ProcId, + [ExportedProc | ExportedProcs], !Specs) :- + ExportedProc = pragma_exported_proc(Lang, ExportedPredId, ExportedProcId, + ExportedName, Context), + ( if + PredId = ExportedPredId, + ProcId = ExportedProcId, + % The direct arg representation optimization works only in C, + % so we clone procedures only when targeting C. + Lang = lang_c + then + generate_foreign_export_error(PredSNA, ExportedName, Context, Spec), + !:Specs = [Spec | !.Specs] + else + generate_error_if_cloned_proc_is_exported(PredSNA, PredId, ProcId, + ExportedProcs, !Specs) + ). + +:- pred generate_foreign_export_error(sym_name_arity::in, string::in, + prog_context::in, error_spec::out) is det. + +generate_foreign_export_error(PredSNA, ExportedName, Context, Spec) :- + Pieces = [words("Error: the C code for"), + unqual_sym_name_arity(PredSNA), words("cannot be exported to C"), + words("as"), quote(ExportedName), suffix(","), + words("because"), unqual_sym_name_arity(PredSNA), words("has"), + words("a nonstandard and undocumented calling convention,"), + words("because of interactions between its use of"), + words("partially instantiated data structures"), + words("and the"), quote("direct_arg"), + words("data representations optimization."), nl], + Spec = simplest_spec($pred, severity_error, phase_direct_arg_in_out, + Context, Pieces). + +%---------------------% + +:- pred maybe_add_foreign_proc_error(module_info::in, + direct_arg_proc_map::in, pred_proc_id::in, + list(error_spec)::in, list(error_spec)::out) is det. + +maybe_add_foreign_proc_error(ModuleInfo, DirectArgProcMap, PredProcId, + !Specs) :- + ( if map.search(DirectArgProcMap, PredProcId, DirectArgProc) then + generate_foreign_proc_error(ModuleInfo, PredProcId, DirectArgProc, + Spec), + !:Specs = [Spec | !.Specs] + else + true + ). + +:- pred generate_foreign_proc_error(module_info::in, pred_proc_id::in, + direct_arg_proc::in, error_spec::out) is det. + +generate_foreign_proc_error(ModuleInfo, PredProcId, DirectArgProc, Spec) :- + StartPieces = [words("Error: a procedure implemented using a"), + pragma_decl("foreign_proc"), words("declaration"), + words("may not have any arguments"), + words("whose types use the"), quote("direct_arg"), + words("data representations optimization,"), + words("and whose modes indicate that they fill in"), + words("partially instantiated terms.")], + ProcDescPieces = describe_one_proc_name(ModuleInfo, + should_not_module_qualify, PredProcId), + OfProcDescPieces = [words("of")] ++ ProcDescPieces, + ( + DirectArgProc = direct_arg_clone_proc(OoMCloneArgs), + OoMCloneArgs = one_or_more(HeadCloneArg, TailCloneArgs), + Pieces = StartPieces ++ + args_violate_prohibition_pieces(OfProcDescPieces, + HeadCloneArg, TailCloneArgs) ++ + [suffix("."), nl] + ; + DirectArgProc = direct_arg_problem_proc(OoMProblemArgs, CloneArgs), + OoMProblemArgs = one_or_more(HeadProblemArg, TailProblemArgs), + ( + CloneArgs = [], + Pieces = StartPieces ++ + args_may_violate_prohibition_pieces(OfProcDescPieces, + HeadProblemArg, TailProblemArgs) ++ + [suffix("."), nl] + ; + CloneArgs = [HeadCloneArg | TailCloneArgs], + Pieces = StartPieces ++ + args_violate_prohibition_pieces(OfProcDescPieces, + HeadCloneArg, TailCloneArgs) ++ + [suffix(","), words("and"), lower_case_next_if_not_first] ++ + args_may_violate_prohibition_pieces(OfProcDescPieces, + HeadProblemArg, TailProblemArgs) ++ + [words("as well."), nl] + ) + ), + module_info_pred_proc_info(ModuleInfo, PredProcId, _PredInfo, ProcInfo), + proc_info_get_context(ProcInfo, Context), + Spec = simplest_spec($pred, severity_error, phase_direct_arg_in_out, + Context, Pieces). + +:- func args_violate_prohibition_pieces(list(format_component), + int, list(int)) = list(format_component). + +args_violate_prohibition_pieces(OfProcDescPieces, HeadArg, TailArgs) + = Pieces :- + ( + TailArgs = [], + Pieces = + [words("Argument"), nth_fixed(HeadArg)] ++ OfProcDescPieces ++ + [words("violates this prohibition")] + ; + TailArgs = [_ | _], + ArgPieces = list.map((func(N) = nth_fixed(N)), [HeadArg | TailArgs]), + ArgsPieces = component_list_to_pieces("and", ArgPieces), + Pieces = + [words("Arguments")] ++ ArgsPieces ++ OfProcDescPieces ++ + [words("violate this prohibition")] + ). + +:- func args_may_violate_prohibition_pieces(list(format_component), + int, list(int)) = list(format_component). + +args_may_violate_prohibition_pieces(OfProcDescPieces, HeadArg, TailArgs) + = Pieces :- + ( + TailArgs = [], + Pieces = + [words("Argument"), nth_fixed(HeadArg)] ++ OfProcDescPieces ++ + [words("may violate this prohibition")] + ; + TailArgs = [_ | _], + ArgPieces = list.map((func(N) = nth_fixed(N)), [HeadArg | TailArgs]), + ArgsPieces = component_list_to_pieces("and", ArgPieces), + Pieces = + [words("Arguments")] ++ ArgsPieces ++ OfProcDescPieces ++ + [words("may violate this prohibition")] + ). + +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% + +daio_may_introduce_calls(ModuleName, PredName, Arity) :- + ModuleName = "private_builtin", + PredName = "partial_inst_copy", Arity = 2. + +%---------------------------------------------------------------------------% +:- end_module transform_hlds.direct_arg_in_out. +%---------------------------------------------------------------------------% diff --git a/compiler/error_util.m b/compiler/error_util.m index d3b3c7a4d..02fb55773 100644 --- a/compiler/error_util.m +++ b/compiler/error_util.m @@ -192,6 +192,7 @@ ; phase_fact_table_check ; phase_oisu_check ; phase_simplify(mode_report_control) + ; phase_direct_arg_in_out ; phase_style ; phase_dead_code ; phase_termination_analysis @@ -1405,6 +1406,7 @@ get_maybe_mode_report_control(phase_detism_check) = no. get_maybe_mode_report_control(phase_fact_table_check) = no. get_maybe_mode_report_control(phase_oisu_check) = no. get_maybe_mode_report_control(phase_simplify(Control)) = yes(Control). +get_maybe_mode_report_control(phase_direct_arg_in_out) = no. get_maybe_mode_report_control(phase_style) = no. get_maybe_mode_report_control(phase_dead_code) = no. get_maybe_mode_report_control(phase_termination_analysis) = no. diff --git a/compiler/hlds_goal.m b/compiler/hlds_goal.m index cbf99b3a4..b59e8773e 100644 --- a/compiler/hlds_goal.m +++ b/compiler/hlds_goal.m @@ -960,7 +960,7 @@ :- type unify_context ---> unify_context( unify_main_context, - unify_sub_contexts + list(unify_sub_context) ). % A unify_main_context describes overall location of the @@ -1752,8 +1752,17 @@ :- pred rename_vars_in_goals(must_rename::in, prog_var_renaming::in, list(hlds_goal)::in, list(hlds_goal)::out) is det. -:- pred rename_vars_in_goal_expr(must_rename::in, prog_var_renaming::in, - hlds_goal_expr::in, hlds_goal_expr::out) is det. +:- pred rename_vars_in_goal_expr(must_rename, prog_var_renaming, + hlds_goal_expr, hlds_goal_expr). +:- mode rename_vars_in_goal_expr(in, in, + in(goal_expr_unify), out(goal_expr_unify)) is det. +:- mode rename_vars_in_goal_expr(in, in, + in(goal_expr_plain_call), out(goal_expr_plain_call)) is det. +:- mode rename_vars_in_goal_expr(in, in, + in(goal_expr_generic_call), out(goal_expr_generic_call)) is det. +:- mode rename_vars_in_goal_expr(in, in, + in(goal_expr_foreign_proc), out(goal_expr_foreign_proc)) is det. +:- mode rename_vars_in_goal_expr(in, in, in, out) is det. :- pred rename_vars_in_goal_info(must_rename::in, prog_var_renaming::in, hlds_goal_info::in, hlds_goal_info::out) is det. diff --git a/compiler/hlds_module.m b/compiler/hlds_module.m index 14f2338b6..651455266 100644 --- a/compiler/hlds_module.m +++ b/compiler/hlds_module.m @@ -57,6 +57,7 @@ :- import_module map. :- import_module maybe. :- import_module multi_map. +:- import_module one_or_more. :- import_module pair. :- import_module set. :- import_module set_tree234. @@ -136,6 +137,28 @@ pragma_info_type_spec) ). + % Once filled in by simplify_proc.m (for all non-lambda procedures) + % and by lambda.m (for procedures created to implement lambda expressions), + % this map should have an entry for every procedure that is of interest to + % direct_arg_in_out.m. A procedure may be of interest to that module + % because it has one or more arguments that it needs to clone, + % or because it has one or more arguments whose modes to not specify + % whether they need to be cloned, and for which therefore it should + % generate a "sorry, not implemented" message. In both cases, the + % one_or_more(int) specify the argument positions involved; in the latter + % case, we also record the list of arguments for which we *could* tell + % they need to be cloned. + % +:- type direct_arg_proc_map == map(pred_proc_id, direct_arg_proc). +:- type direct_arg_proc + ---> direct_arg_clone_proc( + clone_daio_args :: one_or_more(int) + ) + ; direct_arg_problem_proc( + problem_args :: one_or_more(int), + no_problem_args :: list(int) + ). + % Maps the full names of procedures (in the sense of complexity_proc_name % in complexity.m) to the number of their slot in MR_complexity_proc_table. :- type complexity_proc_map == map(string, int). @@ -310,6 +333,8 @@ has_parallel_conj::out) is det. :- pred module_info_get_has_user_event(module_info::in, has_user_event::out) is det. +:- pred module_info_get_direct_arg_proc_map(module_info::in, + direct_arg_proc_map::out) is det. :- pred module_info_get_foreign_decl_codes_user(module_info::in, cord(foreign_decl_code)::out) is det. :- pred module_info_get_foreign_decl_codes_aux(module_info::in, @@ -404,6 +429,8 @@ module_info::in, module_info::out) is det. :- pred module_info_set_has_user_event( module_info::in, module_info::out) is det. +:- pred module_info_set_direct_arg_proc_map(direct_arg_proc_map::in, + module_info::in, module_info::out) is det. :- pred module_info_set_foreign_decl_codes_user(cord(foreign_decl_code)::in, module_info::in, module_info::out) is det. :- pred module_info_set_foreign_decl_codes_aux(cord(foreign_decl_code)::in, @@ -743,7 +770,7 @@ % of the program. msi_const_struct_db :: const_struct_db, - msi_c_j_cs_fims :: c_j_cs_fims, + msi_c_j_cs_fims :: c_j_cs_fims, % List of the procs for which there is a % pragma foreign_export(...) declaration. @@ -763,6 +790,8 @@ mri_assertion_table :: assertion_table, mri_exclusive_table :: exclusive_table, + mri_direct_arg_proc_map :: direct_arg_proc_map, + mri_has_parallel_conj :: has_parallel_conj, mri_has_user_event :: has_user_event, @@ -1026,6 +1055,7 @@ module_info_init(Globals, ModuleName, ModuleNameContext, DumpBaseFileName, init_requests(ProcRequests), assertion_table_init(AssertionTable), exclusive_table_init(ExclusiveTable), + map.init(DirectArgInOutMap), HasParallelConj = has_no_parallel_conj, HasUserEvent = has_no_user_event, ForeignDeclsUser = cord.init, @@ -1094,6 +1124,7 @@ module_info_init(Globals, ModuleName, ModuleNameContext, DumpBaseFileName, ProcRequests, AssertionTable, ExclusiveTable, + DirectArgInOutMap, HasParallelConj, HasUserEvent, ForeignDeclsUser, @@ -1265,6 +1296,8 @@ module_info_get_has_parallel_conj(MI, X) :- X = MI ^ mi_rare_info ^ mri_has_parallel_conj. module_info_get_has_user_event(MI, X) :- X = MI ^ mi_rare_info ^ mri_has_user_event. +module_info_get_direct_arg_proc_map(MI, X) :- + X = MI ^ mi_rare_info ^ mri_direct_arg_proc_map. module_info_get_foreign_decl_codes_user(MI, X) :- X = MI ^ mi_rare_info ^ mri_foreign_decl_codes_user. module_info_get_foreign_decl_codes_aux(MI, X) :- @@ -1397,6 +1430,8 @@ module_info_set_has_parallel_conj(!MI) :- module_info_set_has_user_event(!MI) :- X = has_user_event, !MI ^ mi_rare_info ^ mri_has_user_event := X. +module_info_set_direct_arg_proc_map(X, !MI) :- + !MI ^ mi_rare_info ^ mri_direct_arg_proc_map := X. module_info_set_foreign_decl_codes_user(X, !MI) :- !MI ^ mi_rare_info ^ mri_foreign_decl_codes_user := X. module_info_set_foreign_decl_codes_aux(X, !MI) :- diff --git a/compiler/hlds_out_goal.m b/compiler/hlds_out_goal.m index 34da9d436..3f1eb0253 100644 --- a/compiler/hlds_out_goal.m +++ b/compiler/hlds_out_goal.m @@ -896,6 +896,11 @@ write_goal_expr(Info, Stream, ModuleInfo, VarSet, TypeQual, VarNamePrint, % Write out unifications. % + % write_goal_unify(Info, Stream, ModuleInfo, VarSet, TypeQual, + % VarNamePrint, Indent, Follow, GoalExpr, !IO): + % + % Write out a unification. + % :- pred write_goal_unify(hlds_out_info::in, io.text_output_stream::in, module_info::in, prog_varset::in, maybe_vartypes::in, var_name_print::in, int::in, string::in, hlds_goal_expr::in(goal_expr_unify), @@ -936,6 +941,13 @@ write_goal_unify(Info, Stream, ModuleInfo, VarSet, TypeQual, VarNamePrint, then true else + % XXX While Follow strings should never contain newlines, + % some callers do pass them. + ( if string.contains_char(Follow, '\n') then + true + else + io.nl(Stream, !IO) + ), write_unification(Info, Stream, ModuleInfo, VarSet, InstVarSet, VarNamePrint, Indent, Unification, !IO) ) @@ -1314,13 +1326,26 @@ write_goal_plain_call(Info, Stream, ModuleInfo, VarSet, TypeQual, ), write_indent(Stream, Indent, !IO), ( if PredId = invalid_pred_id then - % If we don't know then the call must be treated as a predicate. + % If we don't know the id of the callee yet, then treat the call + % as being to a pure predicate. This may be misleading, but any + % other assumption has a significantly higher chance of being + % misleading. PredOrFunc = pf_predicate - else - module_info_pred_info(ModuleInfo, PredId, PredInfo), - pred_info_get_purity(PredInfo, Purity), + else if + module_info_get_preds(ModuleInfo, PredTable), + map.search(PredTable, PredId, PredInfo) + then PredOrFunc = pred_info_is_pred_or_func(PredInfo), + pred_info_get_purity(PredInfo, Purity), io.write_string(Stream, purity_prefix_to_string(Purity), !IO) + else + % We should know the id of the callee, but the callee has been + % deleted *without* this call to it (and maybe others) being + % adjusted accordingly. This is a bug, so we want to draw attention + % to it, but we cannot do so effectively if this code aborts + % before we finish writing out the HLDS dump. + io.write_string(Stream, "CALL TO DELETED ", !IO), + PredOrFunc = pf_predicate ), ( PredOrFunc = pf_predicate, diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m index 2d8eed5dc..5efbea581 100644 --- a/compiler/hlds_pred.m +++ b/compiler/hlds_pred.m @@ -1,10 +1,10 @@ -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % Copyright (C) 1996-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: hlds_pred.m. % Main authors: fjh, conway. @@ -12,7 +12,7 @@ % This module defines the part of the HLDS that deals with predicates % and procedures. % -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- module hlds.hlds_pred. :- interface. @@ -82,7 +82,7 @@ :- import_module unit. :- import_module varset. -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- interface. @@ -152,6 +152,13 @@ :- type pred_info. :- type proc_info. + % These types are abstract exported to permit the proc_info fields + % of these types to be part of the argument lists of proc_prepare_to_clone + % and proc_create. + % +:- type structure_sharing_info. +:- type structure_reuse_info. + :- type proc_table == map(proc_id, proc_info). :- pred next_mode_id(proc_table::in, proc_id::out) is det. @@ -168,7 +175,7 @@ :- type pred_proc_list == list(pred_proc_id). -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- type implementation_language ---> impl_lang_mercury @@ -453,7 +460,8 @@ int ) ; transform_structure_reuse - ; transform_source_to_source_debug. + ; transform_source_to_source_debug + ; transform_direct_arg_in_out. :- type pred_creation ---> created_by_deforestation @@ -481,8 +489,11 @@ % arguments. ; origin_created(pred_creation) - % The predicate was created by the compiler, and there is no - % information available on where it came from. + % The predicate was created by the named compiler pass, + % but there is no recorded information available on what original + % predicate it was created came from. + % XXX This should be fixed, and all origin_created origins + % should be replaced with an origin_transformed origin, ; origin_assertion(string, int) % The predicate represents an assertion. @@ -573,6 +584,44 @@ set(assert_id)::in, map(prog_var, string)::in, proc_info::in, proc_id::out, pred_info::out) is det. +%---------------------% + +% pred_prepare_to_clone returns all the fields of an existing pred_info, +% while pred_create constructs a new pred_info putting the supplied values +% to each field. +% +% These predicates exist because we want keep the definition of the pred_info +% type private (to make future changes easier), but we also want to make it +% possible to create slightly modified copies of existing predicates +% with the least amount of programming work. We also want to require +% (a) programmers writing such cloning code to consider what effect +% the modification may have on *all* fields of the pred_info, and +% (b) programmers who add new fields to the pred_info to update +% all the places in the compiler that do such cloning. + +:- pred pred_prepare_to_clone(pred_info::in, + module_name::out, string::out, arity::out, pred_or_func::out, + pred_origin::out, pred_status::out, pred_markers::out, list(mer_type)::out, + tvarset::out, tvarset::out, existq_tvars::out, prog_constraints::out, + clauses_info::out, proc_table::out, prog_context::out, + maybe(cur_user_decl_info)::out, goal_type::out, tvar_kind_map::out, + tsubst::out, external_type_params::out, constraint_proof_map::out, + constraint_map::out, list(prog_constraint)::out, inst_graph_info::out, + list(arg_modes_map)::out, map(prog_var, string)::out, set(assert_id)::out, + maybe(list(sym_name_arity))::out, list(mer_type)::out) is det. + +:- pred pred_create(module_name::in, string::in, arity::in, pred_or_func::in, + pred_origin::in, pred_status::in, pred_markers::in, list(mer_type)::in, + tvarset::in, tvarset::in, existq_tvars::in, prog_constraints::in, + clauses_info::in, proc_table::in, prog_context::in, + maybe(cur_user_decl_info)::in, goal_type::in, tvar_kind_map::in, + tsubst::in, external_type_params::in, constraint_proof_map::in, + constraint_map::in, list(prog_constraint)::in, inst_graph_info::in, + list(arg_modes_map)::in, map(prog_var, string)::in, set(assert_id)::in, + maybe(list(sym_name_arity))::in, list(mer_type)::in, pred_info::out) is det. + +%---------------------% + % define_new_pred(Origin, Goal, CallGoal, Args, ExtraArgs, % InstMap, PredName, TVarSet, VarTypes, ClassContext, % TVarMap, TCVarMap, VarSet, Markers, IsAddressTaken, VarNameRemap, @@ -878,8 +927,8 @@ :- pred marker_list_to_markers(list(pred_marker)::in, pred_markers::out) is det. -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- implementation. @@ -935,7 +984,7 @@ calls_are_fully_qualified(Markers) = may_be_partially_qualified ). -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % Access stats for the pred_info structure, derived on 2014 dec 13: % @@ -1061,7 +1110,7 @@ calls_are_fully_qualified(Markers) = % (b) explicitly by the user, as opposed to by the compiler, % then this records what section the predicate declaration % is in, and whether it is a predmode declaration. - psi_cur_user_decl :: maybe(cur_user_decl_info), + psi_cur_user_decl :: maybe(cur_user_decl_info), % Whether the goals seen so far, if any, for this predicate % are clauses or foreign_code(...) pragmas. @@ -1119,8 +1168,7 @@ calls_are_fully_qualified(Markers) = % (Note that the list of possible replacements may be empty.) % In the usual case where this predicate is NOT marked % as obsolete, this will be "no". - psi_obsolete_in_favour_of :: maybe(list( - sym_name_arity)), + psi_obsolete_in_favour_of :: maybe(list(sym_name_arity)), % If this predicate is a class method implementation, this % list records the argument types before substituting the type @@ -1232,6 +1280,38 @@ pred_info_create(ModuleName, PredSymName, PredOrFunc, Context, Origin, Status, Origin, Status, Markers, ArgTypes, TypeVarSet, TypeVarSet, ExistQVars, ClassContext, ClausesInfo, ProcTable, PredSubInfo). +pred_prepare_to_clone(PredInfo, ModuleName, PredName, Arity, PredOrFunc, + Origin, Status, Markers, ArgTypes, DeclTypeVarSet, TypeVarSet, + ExistQVars, ClassContext, ClausesInfo, ProcTable, Context, + CurUserDecl, GoalType, Kinds, ExistQVarBindings, HeadTypeParams, + ClassProofs, ClassConstraintMap, UnprovenBodyConstraints, + InstGraphInfo, ArgModesMaps, VarNameRemap, Assertions, + ObsoleteInFavourOf, InstanceMethodArgTypes) :- + PredInfo = pred_info(ModuleName, PredName, Arity, PredOrFunc, + Origin, Status, Markers, ArgTypes, DeclTypeVarSet, TypeVarSet, + ExistQVars, ClassContext, ClausesInfo, ProcTable, PredSubInfo), + PredSubInfo = pred_sub_info(Context, CurUserDecl, GoalType, + Kinds, ExistQVarBindings, HeadTypeParams, + ClassProofs, ClassConstraintMap, + UnprovenBodyConstraints, InstGraphInfo, ArgModesMaps, + VarNameRemap, Assertions, ObsoleteInFavourOf, InstanceMethodArgTypes). + +pred_create(ModuleName, PredName, Arity, PredOrFunc, + Origin, Status, Markers, ArgTypes, DeclTypeVarSet, TypeVarSet, + ExistQVars, ClassContext, ClausesInfo, ProcTable, Context, + CurUserDecl, GoalType, Kinds, ExistQVarBindings, HeadTypeParams, + ClassProofs, ClassConstraintMap, UnprovenBodyConstraints, + InstGraphInfo, ArgModesMaps, VarNameRemap, Assertions, + ObsoleteInFavourOf, InstanceMethodArgTypes, PredInfo) :- + PredSubInfo = pred_sub_info(Context, CurUserDecl, GoalType, + Kinds, ExistQVarBindings, HeadTypeParams, + ClassProofs, ClassConstraintMap, + UnprovenBodyConstraints, InstGraphInfo, ArgModesMaps, + VarNameRemap, Assertions, ObsoleteInFavourOf, InstanceMethodArgTypes), + PredInfo = pred_info(ModuleName, PredName, Arity, PredOrFunc, + Origin, Status, Markers, ArgTypes, DeclTypeVarSet, TypeVarSet, + ExistQVars, ClassContext, ClausesInfo, ProcTable, PredSubInfo). + define_new_pred(Origin, Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0, SymName, TVarSet, VarTypes0, ClassContext, RttiVarMaps, VarSet0, InstVarSet, Markers, IsAddressTaken, HasParallelConj, @@ -1324,7 +1404,7 @@ compute_arg_types_modes([Var | Vars], VarTypes, InstMapInit, InstMapFinal, compute_arg_types_modes(Vars, VarTypes, InstMapInit, InstMapFinal, Types, Modes). -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % The trivial access predicates. @@ -1496,7 +1576,7 @@ pred_info_set_clauses_info(X, !PI) :- pred_info_set_proc_table(X, !PI) :- !PI ^ pi_proc_table := X. -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % The non-trivial access predicates. @@ -1791,7 +1871,7 @@ purity_to_markers(purity_pure, []). purity_to_markers(purity_semipure, [marker_is_semipure]). purity_to_markers(purity_impure, [marker_is_impure]). -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% pred_info_get_pf_sym_name_arity(PredInfo, PFSymNameArity) :- PredOrFunc = pred_info_is_pred_or_func(PredInfo), @@ -1804,7 +1884,7 @@ pred_info_get_sym_name(PredInfo, SymName) :- Name = pred_info_name(PredInfo), SymName = qualified(Module, Name). -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% init_markers(set.init). @@ -1826,8 +1906,8 @@ markers_to_marker_list(MarkerSet, Markers) :- marker_list_to_markers(Markers, MarkerSet) :- set.list_to_set(Markers, MarkerSet). -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % Various predicates for accessing the proc_info data structure, % and the types they work with. @@ -2124,6 +2204,65 @@ marker_list_to_markers(Markers, MarkerSet) :- rtti_varmaps::in, is_address_taken::in, has_parallel_conj::in, map(prog_var, string)::in, proc_info::out) is det. +%---------------------% + +% proc_prepare_to_clone returns all the fields of an existing proc_info, +% while proc_create constructs a new proc_info putting the supplied values +% to each field. +% +% These predicates exist because we want keep the definition of the proc_info +% type private (to make future changes easier), but we also want to make it +% possible to create slightly modified copies of existing procedures +% with the least amount of programming work. We also want to require +% (a) programmers writing such cloning code to consider what effect +% the modification may have on *all* fields of the proc_info, and +% (b) programmers who add new fields to the proc_info to update +% all the places in the compiler that do such cloning. + +:- pred proc_prepare_to_clone(proc_info::in, list(prog_var)::out, + hlds_goal::out, prog_varset::out, vartypes::out, rtti_varmaps::out, + inst_varset::out, maybe(list(mer_mode))::out, list(mer_mode)::out, + maybe(list(is_live))::out, maybe(determinism)::out, determinism::out, + eval_method::out, list(mode_error_info)::out, prog_context::out, int::out, + can_process::out, maybe(mode_constraint)::out, detism_decl::out, + list(prog_context)::out, maybe(untuple_proc_info)::out, + map(prog_var, string)::out, list(error_spec)::out, set(pred_proc_id)::out, + is_address_taken::out, proc_foreign_exports::out, has_parallel_conj::out, + has_user_event::out, has_tail_rec_call::out, list(oisu_pred_kind_for)::out, + maybe(require_tail_recursion)::out, set_of_progvar::out, + maybe(list(arg_info))::out, maybe(special_proc_return)::out, + liveness_info::out, stack_slots::out, needs_maxfr_slot::out, + maybe(prog_var)::out, maybe(proc_table_io_info)::out, + maybe(table_attributes)::out, maybe(list(sym_name_arity))::out, + maybe(deep_profile_proc_info)::out, maybe(arg_size_info)::out, + maybe(termination_info)::out, termination2_info::out, + maybe(proc_exception_info)::out, maybe(proc_trailing_info)::out, + maybe(proc_mm_tabling_info)::out, structure_sharing_info::out, + structure_reuse_info::out) is det. + +:- pred proc_create(list(prog_var)::in, + hlds_goal::in, prog_varset::in, vartypes::in, rtti_varmaps::in, + inst_varset::in, maybe(list(mer_mode))::in, list(mer_mode)::in, + maybe(list(is_live))::in, maybe(determinism)::in, determinism::in, + eval_method::in, list(mode_error_info)::in, prog_context::in, int::in, + can_process::in, maybe(mode_constraint)::in, detism_decl::in, + list(prog_context)::in, maybe(untuple_proc_info)::in, + map(prog_var, string)::in, list(error_spec)::in, set(pred_proc_id)::in, + is_address_taken::in, proc_foreign_exports::in, has_parallel_conj::in, + has_user_event::in, has_tail_rec_call::in, list(oisu_pred_kind_for)::in, + maybe(require_tail_recursion)::in, set_of_progvar::in, + maybe(list(arg_info))::in, maybe(special_proc_return)::in, + liveness_info::in, stack_slots::in, needs_maxfr_slot::in, + maybe(prog_var)::in, maybe(proc_table_io_info)::in, + maybe(table_attributes)::in, maybe(list(sym_name_arity))::in, + maybe(deep_profile_proc_info)::in, maybe(arg_size_info)::in, + maybe(termination_info)::in, termination2_info::in, + maybe(proc_exception_info)::in, maybe(proc_trailing_info)::in, + maybe(proc_mm_tabling_info)::in, structure_sharing_info::in, + structure_reuse_info::in, proc_info::out) is det. + +%---------------------% + :- pred proc_info_set_body(prog_varset::in, vartypes::in, list(prog_var)::in, hlds_goal::in, rtti_varmaps::in, proc_info::in, proc_info::out) is det. @@ -2573,6 +2712,10 @@ marker_list_to_markers(Markers, MarkerSet) :- % How should the proc be evaluated. /* 12 */ proc_eval_method :: eval_method, + % This field is used only by mode analysis and unique mode + % analysis. Almost all the time, it contains an empty list. + % XXX This info should be stored in a separate data structure + % maintained by mode analysis. /* 13 */ proc_mode_errors :: list(mode_error_info), /* 14 */ proc_sub_info :: proc_sub_info @@ -2598,7 +2741,7 @@ marker_list_to_markers(Markers, MarkerSet) :- % constraint system. Whether it represents the declared % or the actual mode is unclear, but since that constraint % system is obsolete, this does not much matter :-( - psi_maybe_head_modes_constr :: maybe(mode_constraint), + psi_maybe_head_modes_constr :: maybe(mode_constraint), % Was the determinism declaration explicit, or was it implicit, % as for functions? @@ -2945,7 +3088,7 @@ proc_info_init(MainContext, ItemNumber, Arity, Types, DeclaredModes, Modes, MaybeUntupleInfo = no `with_type` maybe(untuple_proc_info), % argument VarNameRemap StateVarWarnings = [], - set.init(TraceGoalProcs), + set.init(DeletedCallees), % argument IsAddressTaken HasForeignProcExports = no_foreign_exports, % argument HasParallelConj @@ -2984,7 +3127,7 @@ proc_info_init(MainContext, ItemNumber, Arity, Types, DeclaredModes, Modes, MaybeUntupleInfo, VarNameRemap, StateVarWarnings, - TraceGoalProcs, + DeletedCallees, IsAddressTaken, HasForeignProcExports, HasParallelConj, @@ -3079,7 +3222,7 @@ proc_info_create_with_declared_detism(MainContext, ItemNumber, MaybeUntupleInfo = no `with_type` maybe(untuple_proc_info), % argument VarNameRemap StateVarWarnings = [], - set.init(TraceGoalProcs), + set.init(DeletedCallees), % argument IsAddressTaken HasForeignProcExports = no_foreign_exports, % argument HasParallelConj @@ -3118,7 +3261,7 @@ proc_info_create_with_declared_detism(MainContext, ItemNumber, MaybeUntupleInfo, VarNameRemap, StateVarWarnings, - TraceGoalProcs, + DeletedCallees, IsAddressTaken, HasForeignProcExports, HasParallelConj, @@ -3177,6 +3320,137 @@ proc_info_create_with_declared_detism(MainContext, ItemNumber, ModeErrors, ProcSubInfo). +proc_prepare_to_clone(ProcInfo, HeadVars, Goal, VarSet, VarTypes, RttiVarMaps, + InstVarSet, DeclaredModes, Modes, MaybeArgLives, + MaybeDeclaredDetism, Detism, EvalMethod, ModeErrors, + MainContext, ItemNumber, CanProcess, MaybeHeadModesConstr, DetismDecl, + CseNopullContexts, MaybeUntupleInfo, VarNameRemap, StateVarWarnings, + DeletedCallees, IsAddressTaken, HasForeignProcExports, HasParallelConj, + HasUserEvent, HasTailCallEvent, OisuKinds, MaybeRequireTailRecursion, + RegR_HeadVars, MaybeArgPassInfo, MaybeSpecialReturn, InitialLiveness, + StackSlots, NeedsMaxfrSlot, MaybeCallTableTip, MaybeTableIOInfo, + MaybeTableAttrs, MaybeObsoleteInFavourOf, MaybeDeepProfProcInfo, + MaybeArgSizes, MaybeTermInfo, Term2Info, MaybeExceptionInfo, + MaybeTrailingInfo, MaybeMMTablingInfo, SharingInfo, ReuseInfo) :- + ProcInfo = proc_info( + HeadVars, + Goal, + VarSet, + VarTypes, + RttiVarMaps, + InstVarSet, + DeclaredModes, + Modes, + MaybeArgLives, + MaybeDeclaredDetism, + Detism, + EvalMethod, + ModeErrors, + ProcSubInfo), + ProcSubInfo = proc_sub_info( + MainContext, + ItemNumber, + CanProcess, + MaybeHeadModesConstr, + DetismDecl, + CseNopullContexts, + MaybeUntupleInfo, + VarNameRemap, + StateVarWarnings, + DeletedCallees, + IsAddressTaken, + HasForeignProcExports, + HasParallelConj, + HasUserEvent, + HasTailCallEvent, + OisuKinds, + MaybeRequireTailRecursion, + RegR_HeadVars, + MaybeArgPassInfo, + MaybeSpecialReturn, + InitialLiveness, + StackSlots, + NeedsMaxfrSlot, + MaybeCallTableTip, + MaybeTableIOInfo, + MaybeTableAttrs, + MaybeObsoleteInFavourOf, + MaybeDeepProfProcInfo, + MaybeArgSizes, + MaybeTermInfo, + Term2Info, + MaybeExceptionInfo, + MaybeTrailingInfo, + MaybeMMTablingInfo, + SharingInfo, + ReuseInfo). + +proc_create(HeadVars, Goal, VarSet, VarTypes, RttiVarMaps, + InstVarSet, DeclaredModes, Modes, MaybeArgLives, + MaybeDeclaredDetism, Detism, EvalMethod, ModeErrors, + MainContext, ItemNumber, CanProcess, MaybeHeadModesConstr, DetismDecl, + CseNopullContexts, MaybeUntupleInfo, VarNameRemap, StateVarWarnings, + DeletedCallees, IsAddressTaken, HasForeignProcExports, HasParallelConj, + HasUserEvent, HasTailCallEvent, OisuKinds, MaybeRequireTailRecursion, + RegR_HeadVars, MaybeArgPassInfo, MaybeSpecialReturn, InitialLiveness, + StackSlots, NeedsMaxfrSlot, MaybeCallTableTip, MaybeTableIOInfo, + MaybeTableAttrs, MaybeObsoleteInFavourOf, MaybeDeepProfProcInfo, + MaybeArgSizes, MaybeTermInfo, Term2Info, MaybeExceptionInfo, + MaybeTrailingInfo, MaybeMMTablingInfo, SharingInfo, ReuseInfo, + ProcInfo) :- + ProcSubInfo = proc_sub_info( + MainContext, + ItemNumber, + CanProcess, + MaybeHeadModesConstr, + DetismDecl, + CseNopullContexts, + MaybeUntupleInfo, + VarNameRemap, + StateVarWarnings, + DeletedCallees, + IsAddressTaken, + HasForeignProcExports, + HasParallelConj, + HasUserEvent, + HasTailCallEvent, + OisuKinds, + MaybeRequireTailRecursion, + RegR_HeadVars, + MaybeArgPassInfo, + MaybeSpecialReturn, + InitialLiveness, + StackSlots, + NeedsMaxfrSlot, + MaybeCallTableTip, + MaybeTableIOInfo, + MaybeTableAttrs, + MaybeObsoleteInFavourOf, + MaybeDeepProfProcInfo, + MaybeArgSizes, + MaybeTermInfo, + Term2Info, + MaybeExceptionInfo, + MaybeTrailingInfo, + MaybeMMTablingInfo, + SharingInfo, + ReuseInfo), + ProcInfo = proc_info( + HeadVars, + Goal, + VarSet, + VarTypes, + RttiVarMaps, + InstVarSet, + DeclaredModes, + Modes, + MaybeArgLives, + MaybeDeclaredDetism, + Detism, + EvalMethod, + ModeErrors, + ProcSubInfo). + proc_info_set_body(VarSet, VarTypes, HeadVars, Goal, RttiVarMaps, !ProcInfo) :- !ProcInfo ^ proc_prog_varset := VarSet, !ProcInfo ^ proc_var_types := VarTypes, @@ -3749,7 +4023,7 @@ var_is_of_non_dummy_type(ModuleInfo, VarTypes, Var) :- lookup_var_type(VarTypes, Var, Type), is_type_a_dummy(ModuleInfo, Type) = is_not_dummy_type. -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % Predicates to deal with record syntax. @@ -3830,7 +4104,7 @@ pred_info_is_field_access_function(ModuleInfo, PredInfo) :- is_field_access_function_name(ModuleInfo, qualified(Module, Name), FuncArity, _, _). -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% % Predicates to deal with builtins. @@ -3925,8 +4199,8 @@ is_inline_builtin(ModuleName, PredName, ProcId, Arity) :- pred_info_is_promise(PredInfo, PromiseType) :- pred_info_get_goal_type(PredInfo, goal_type_promise(PromiseType)). -%-----------------------------------------------------------------------------% -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- interface. @@ -4092,6 +4366,6 @@ eval_method_change_determinism(eval_memo(_), Detism) = Detism. eval_method_change_determinism(eval_minimal(_), Detism0) = Detism :- det_conjunction_detism(detism_semi, Detism0, Detism). -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% :- end_module hlds.hlds_pred. -%-----------------------------------------------------------------------------% +%---------------------------------------------------------------------------% diff --git a/compiler/inst_util.m b/compiler/inst_util.m index 2bd94c83d..4da1f24df 100644 --- a/compiler/inst_util.m +++ b/compiler/inst_util.m @@ -186,17 +186,23 @@ inst_expand_and_remove_constrained_inst_vars(ModuleInfo, !Inst) :- %---------------------------------------------------------------------------% abstractly_unify_inst(Live, InstA, InstB, Real, Inst, Detism, !ModuleInfo) :- - % Check whether this pair of insts is already in the unify_insts table. - module_info_get_inst_table(!.ModuleInfo, InstTable0), - inst_table_get_unify_insts(InstTable0, UnifyInstTable0), + % We avoid infinite loops by checking whether the InstA-InstB + % pair of insts is already in the unify_insts table. + % % XXX For code that uses large facts, the deeply nested insts we unify - % here means that searching UnifyInsts0 here, and updating it (twice) - % in the else case below are *extremely* expensive. In one version of - % Doug Auclair's training_cars example, the map search, insert and update - % account for 116 out the 120 clock ticks spent in this predicate, + % here means that searching the unify_insts table here, and updating it + % (twice) in the else case below are *extremely* expensive. In one version + % of Doug Auclair's training_cars example, the map search, insert and + % update account for 116 out the 120 clock ticks spent in this predicate, % i.e. they account for almost 97% of its runtime. % - % We now combine the lookup with one of the updates. + % We reduce the expense of these operations in two ways. + % + % First, we make each instance of the operation cheaper, by combing + % the lookup with one of the updates. We do this by having + % search_insert_unify_inst use map.search_insert. + % + % Second, we avoid some instances of the operation altogether. % % If either inst is free, then just unifying the two insts is likely % to be faster (and maybe *much* faster) than looking them up @@ -214,6 +220,8 @@ abstractly_unify_inst(Live, InstA, InstB, Real, Inst, Detism, !ModuleInfo) :- abstractly_unify_inst_2(Live, InstA, InstB, Real, Inst, Detism, !ModuleInfo) else + module_info_get_inst_table(!.ModuleInfo, InstTable0), + inst_table_get_unify_insts(InstTable0, UnifyInstTable0), UnifyInstInfo = unify_inst_info(Live, Real, InstA, InstB), UnifyInstName = unify_inst(Live, Real, InstA, InstB), search_insert_unify_inst(UnifyInstInfo, MaybeMaybeInst, @@ -397,8 +405,9 @@ abstractly_unify_inst_3(Live, InstA, InstB, Real, Inst, Detism, !ModuleInfo) :- Inst = InstA, Detism1 = detism_semi ; - InstResultsA = inst_test_results(GroundnessResultA, _, _, _, - _, _), + InstResultsA = inst_test_results(GroundnessResultA, + _ContainsAny, _ContainsInstNames, _ContainsInstVars, + ContainsTypes, MaybeTypeCtorPropagated), ( GroundnessResultA = inst_result_is_ground, Inst = InstA, @@ -409,13 +418,24 @@ abstractly_unify_inst_3(Live, InstA, InstB, Real, Inst, Detism, !ModuleInfo) :- ), make_ground_bound_inst_list(BoundInstsA, Live, UniqB, Real, BoundInsts, Detism1, !ModuleInfo), - Inst = bound(Uniq, InstResultsA, BoundInsts) + InstResults = inst_test_results(inst_result_is_ground, + inst_result_does_not_contain_any, + inst_result_contains_inst_names_unknown, + inst_result_contains_inst_vars_unknown, + ContainsTypes, MaybeTypeCtorPropagated), + Inst = bound(Uniq, InstResults, BoundInsts) ) ; InstResultsA = inst_test_no_results, make_ground_bound_inst_list(BoundInstsA, Live, UniqB, Real, BoundInsts, Detism1, !ModuleInfo), - Inst = bound(Uniq, InstResultsA, BoundInsts) + InstResults = inst_test_results(inst_result_is_ground, + inst_result_does_not_contain_any, + inst_result_contains_inst_names_unknown, + inst_result_contains_inst_vars_unknown, + inst_result_contains_types_unknown, + inst_result_no_type_ctor_propagated), + Inst = bound(Uniq, InstResults, BoundInsts) ), det_par_conjunction_detism(Detism1, detism_semi, Detism) ; diff --git a/compiler/lambda.m b/compiler/lambda.m index 875fa10e1..7bf5b3103 100644 --- a/compiler/lambda.m +++ b/compiler/lambda.m @@ -29,7 +29,7 @@ % '__LambdaGoal__1'(X, Y) :- q(Y, X). % % p(X) :- -% V__1 = '__LambdaGoal__1'(X) +% V__1 = closure_cons('__LambdaGoal__1')(X) % solutions(V__1, List), % ... % @@ -90,8 +90,9 @@ :- pred expand_lambdas_in_module(module_info::in, module_info::out) is det. -:- pred expand_lambdas_in_pred(pred_id::in, module_info::in, module_info::out) - is det. +%-----------------------------------------------------------------------------% + +% The following are exported for float_reg.m. :- pred expand_lambda(purity::in, ho_groundness::in, pred_or_func::in, lambda_eval_method::in, reg_wrapper_proc::in, @@ -100,10 +101,6 @@ unification::in, unify_context::in, hlds_goal_expr::out, lambda_info::in, lambda_info::out) is det. -%-----------------------------------------------------------------------------% - -% The following are exported for float_reg.m. - :- type lambda_info. :- type reg_wrapper_proc @@ -152,6 +149,8 @@ :- import_module parse_tree.prog_mode. :- import_module parse_tree.prog_type. :- import_module parse_tree.prog_util. +:- import_module transform_hlds. +:- import_module transform_hlds.direct_arg_in_out. :- import_module assoc_list. :- import_module array. @@ -175,6 +174,9 @@ expand_lambdas_in_module(!ModuleInfo) :- % Need update the dependency graph to include the lambda predicates. module_info_clobber_dependency_info(!ModuleInfo). +:- pred expand_lambdas_in_pred(pred_id::in, module_info::in, module_info::out) + is det. + expand_lambdas_in_pred(PredId, !ModuleInfo) :- module_info_pred_info(!.ModuleInfo, PredId, PredInfo), ProcIds = pred_info_valid_procids(PredInfo), @@ -519,7 +521,7 @@ expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, RegWrapperProc, % arg types, determinism, context, status, etc. for the new predicate. ArgVars = put_typeinfo_vars_first(ArgVars1, VarTypes), - list.append(ArgVars, Vars, AllArgVars), + AllArgVars = ArgVars ++ Vars, module_info_get_name(ModuleInfo0, ModuleName), OrigPredName = pred_info_name(OrigPredInfo), @@ -557,7 +559,7 @@ expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, RegWrapperProc, % Recompute the unify_modes. modes_to_unify_modes(ModuleInfo1, ArgModes1, ArgModes1, ArgUnifyModes), - list.append(ArgModes1, Modes, AllArgModes), + AllArgModes = ArgModes1 ++ Modes, lookup_var_types(VarTypes, AllArgVars, ArgTypes), list.foldl_corresponding(check_lambda_arg_type_and_mode(ModuleInfo1), ArgTypes, AllArgModes, 0, _), @@ -616,7 +618,10 @@ expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, RegWrapperProc, predicate_table_insert(PredInfo, PredId, PredicateTable0, PredicateTable), module_info_set_predicate_table(PredicateTable, - ModuleInfo1, ModuleInfo) + ModuleInfo1, ModuleInfo2), + + find_and_record_any_direct_arg_in_out_posns(PredId, ProcId, + LambdaVarTypes, AllArgVars, AllArgModes, ModuleInfo2, ModuleInfo) ), ShroudedPredProcId = shroud_pred_proc_id(proc(PredId, ProcId)), ConsId = closure_cons(ShroudedPredProcId, EvalMethod), diff --git a/compiler/layout_out.m b/compiler/layout_out.m index 54465d972..0870341c2 100644 --- a/compiler/layout_out.m +++ b/compiler/layout_out.m @@ -2595,6 +2595,7 @@ pred_transform_name(transform_stm_expansion) = "stm_expansion". pred_transform_name(transform_dnf(N)) = "dnf_" ++ int_to_string(N). pred_transform_name(transform_structure_reuse) = "structure_reuse". pred_transform_name(transform_source_to_source_debug) = "ssdebug". +pred_transform_name(transform_direct_arg_in_out) = "daio". :- func ints_to_string(list(int)) = string. diff --git a/compiler/mercury_compile_middle_passes.m b/compiler/mercury_compile_middle_passes.m index cf6a7eaac..bbaa7194c 100644 --- a/compiler/mercury_compile_middle_passes.m +++ b/compiler/mercury_compile_middle_passes.m @@ -87,6 +87,7 @@ :- import_module transform_hlds.deforest. :- import_module transform_hlds.delay_construct. :- import_module transform_hlds.dep_par_conj. +:- import_module transform_hlds.direct_arg_in_out. :- import_module transform_hlds.distance_granularity. :- import_module transform_hlds.equiv_type_hlds. :- import_module transform_hlds.exception_analysis. @@ -118,6 +119,7 @@ :- import_module transform_hlds.unused_args. :- import_module int. +:- import_module map. :- import_module maybe. :- import_module pair. :- import_module require. @@ -139,6 +141,9 @@ middle_pass(!HLDS, !DumpInfo, !Specs, !IO) :- expand_lambdas(Verbose, Stats, !HLDS, !IO), maybe_dump_hlds(!.HLDS, 110, "lambda", !DumpInfo, !IO), + maybe_do_direct_arg_in_out_transform(Verbose, Stats, !HLDS, !Specs, !IO), + maybe_dump_hlds(!.HLDS, 111, "daio", !DumpInfo, !IO), + expand_stm_goals(Verbose, Stats, !HLDS, !IO), maybe_dump_hlds(!.HLDS, 113, "stm", !DumpInfo, !IO), @@ -574,6 +579,26 @@ expand_lambdas(Verbose, Stats, !HLDS, !IO) :- %---------------------------------------------------------------------------% +:- pred maybe_do_direct_arg_in_out_transform(bool::in, bool::in, + module_info::in, module_info::out, + list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det. + +maybe_do_direct_arg_in_out_transform(Verbose, Stats, !HLDS, !Specs, !IO) :- + module_info_get_direct_arg_proc_map(!.HLDS, DirectArgProcMap), + ( if map.is_empty(DirectArgProcMap) then + true + else + maybe_write_string(Verbose, + "% Transforming direct arg in out procs...\n", !IO), + do_direct_arg_in_out_transform_in_module(DirectArgProcMap, !HLDS, + DirectArgSpecs), + !:Specs = DirectArgSpecs ++ !.Specs, + maybe_write_string(Verbose, "% done.\n", !IO), + maybe_report_stats(Stats, !IO) + ). + +%---------------------------------------------------------------------------% + :- pred expand_stm_goals(bool::in, bool::in, module_info::in, module_info::out, io::di, io::uo) is det. diff --git a/compiler/modes.m b/compiler/modes.m index 5ffd5d743..92c81ab0f 100644 --- a/compiler/modes.m +++ b/compiler/modes.m @@ -119,8 +119,8 @@ module_info::in, module_info::out, bool::out, list(error_spec)::out) is det. - % Check that the final insts of the head vars of a lambda goal - % matches their expected insts. + % Check that the actual final insts of the head vars of a lambda goal + % matches their expected final insts. % :- pred modecheck_lambda_final_insts(list(prog_var)::in, list(mer_inst)::in, hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) is det. @@ -736,6 +736,14 @@ definitely_modecheck_proc(WhatToCheck, MayChangeCalledProc, map.det_update(PredId, PredInfo, PredMap1, PredMap), module_info_set_preds(PredMap, !ModuleInfo). +:- type maybe_infer_modes + ---> do_not_infer_modes + ; do_infer_modes. + +:- type maybe_unify_pred + ---> is_not_unify_pred + ; is_unify_pred. + :- pred do_modecheck_proc(how_to_check_goal::in, may_change_called_proc::in, pred_id::in, pred_info::in, proc_id::in, proc_info::in, proc_info::out, clauses_info::out, module_info::in, module_info::out, @@ -746,14 +754,14 @@ do_modecheck_proc(WhatToCheck, MayChangeCalledProc, !ModuleInfo, !Changed, ErrorAndWarningSpecs) :- pred_info_get_markers(PredInfo0, Markers), ( if check_marker(Markers, marker_infer_modes) then - InferModes = yes + InferModes = do_infer_modes else - InferModes = no + InferModes = do_not_infer_modes ), ( if is_unify_pred(PredInfo0) then - IsUnifyPred = yes + IsUnifyPred = is_unify_pred else - IsUnifyPred = no + IsUnifyPred = is_not_unify_pred ), pred_info_get_origin(PredInfo0, Origin), @@ -800,20 +808,20 @@ do_modecheck_proc(WhatToCheck, MayChangeCalledProc, mode_list_get_final_insts(!.ModuleInfo, ArgModes0, ArgFinalInsts0), - modecheck_proc_body(!.ModuleInfo, WhatToCheck, InferModes, - Markers, IsUnifyPred, PredId, ProcId, Body0, Body, HeadVars, + modecheck_proc_body(!.ModuleInfo, WhatToCheck, InferModes, IsUnifyPred, + Markers, PredId, ProcId, Body0, Body, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts, !ModeInfo), mode_info_get_errors(!.ModeInfo, ModeErrors), ( - InferModes = yes, + InferModes = do_infer_modes, % For inferred predicates, we don't report the error(s) here; % instead we just save them in the proc_info, thus marking that % procedure as invalid. proc_info_set_mode_errors(ModeErrors, !ProcInfo), ErrorAndWarningSpecs = [] ; - InferModes = no, + InferModes = do_not_infer_modes, ( if Origin = origin_mutable(_, _, _) then % The only mode error that may occur in the automatically % generated auxiliary predicates for a mutable is an @@ -874,16 +882,16 @@ do_modecheck_proc(WhatToCheck, MayChangeCalledProc, ). :- pred modecheck_proc_body(module_info::in, how_to_check_goal::in, - bool::in, pred_markers::in, bool::in, pred_id::in, proc_id::in, - hlds_goal::in, hlds_goal::out, list(prog_var)::in, instmap::in, - list(mer_inst)::in, list(mer_inst)::out, mode_info::in, mode_info::out) - is det. + maybe_infer_modes::in, maybe_unify_pred::in, pred_markers::in, + pred_id::in, proc_id::in, hlds_goal::in, hlds_goal::out, + list(prog_var)::in, instmap::in, list(mer_inst)::in, list(mer_inst)::out, + mode_info::in, mode_info::out) is det. -modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers, IsUnifyPred, +modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, IsUnifyPred, Markers, PredId, ProcId, Body0, Body, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts, ModeInfo0, ModeInfo) :- - do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers, - IsUnifyPred, PredId, ProcId, Body0, Body1, HeadVars, InstMap0, + do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, IsUnifyPred, + Markers, PredId, ProcId, Body0, Body1, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts1, ModeInfo0, ModeInfo1), mode_info_get_errors(ModeInfo1, ModeErrors1), ( @@ -909,7 +917,7 @@ modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers, IsUnifyPred, mode_info_set_make_ground_terms_unique(make_ground_terms_unique, ModeInfo0, ModeInfo2), do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, - Markers, IsUnifyPred, PredId, ProcId, Body0, Body, HeadVars, + IsUnifyPred, Markers, PredId, ProcId, Body0, Body, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts, ModeInfo2, ModeInfo) ; HadFromGroundTerm = did_not_have_from_ground_term_scope, @@ -922,19 +930,19 @@ modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers, IsUnifyPred, ). :- pred do_modecheck_proc_body(module_info::in, how_to_check_goal::in, - bool::in, pred_markers::in, bool::in, pred_id::in, proc_id::in, - hlds_goal::in, hlds_goal::out, list(prog_var)::in, instmap::in, - list(mer_inst)::in, list(mer_inst)::out, mode_info::in, mode_info::out) - is det. + maybe_infer_modes::in, maybe_unify_pred::in, pred_markers::in, + pred_id::in, proc_id::in, hlds_goal::in, hlds_goal::out, + list(prog_var)::in, instmap::in, list(mer_inst)::in, list(mer_inst)::out, + mode_info::in, mode_info::out) is det. -do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers, - IsUnifyPred, PredId, ProcId, Body0, Body, HeadVars, InstMap0, +do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, IsUnifyPred, + Markers, PredId, ProcId, Body0, Body, HeadVars, InstMap0, ArgFinalInsts0, ArgFinalInsts, !ModeInfo) :- string.format("procedure_%d_%d", [i(pred_id_to_int(PredId)), i(proc_id_to_int(ProcId))], CheckpointMsg), ( if - InferModes = no, + InferModes = do_not_infer_modes, check_marker(Markers, marker_mode_check_clauses), Body0 = hlds_goal(BodyGoalExpr0, BodyGoalInfo0), ( @@ -1047,14 +1055,14 @@ do_modecheck_proc_body(ModuleInfo, WhatToCheck, InferModes, Markers, % Check that final insts match those specified in the mode declaration. ( - IsUnifyPred = no, + IsUnifyPred = is_not_unify_pred, GroundMatchesBound = ground_matches_bound_if_complete ; - IsUnifyPred = yes, + IsUnifyPred = is_unify_pred, GroundMatchesBound = ground_matches_bound_always ), - modecheck_final_insts_gmb(HeadVars, InferModes, GroundMatchesBound, - ArgFinalInsts0, ArgFinalInsts, Body1, Body, !ModeInfo) + modecheck_final_insts_gmb(InferModes, GroundMatchesBound, + HeadVars, ArgFinalInsts0, ArgFinalInsts, Body1, Body, !ModeInfo) ). %-----------------------------------------------------------------------------% @@ -1223,8 +1231,8 @@ modecheck_clause_disj(CheckpointMsg, HeadVars, InstMap0, ArgFinalInsts0, mode_checkpoint(exit, CheckpointMsg, !ModeInfo), % Check that final insts match those specified in the mode declaration. - modecheck_final_insts(HeadVars, no, ArgFinalInsts0, _ArgFinalInsts, - Disjunct1, Disjunct, !ModeInfo). + modecheck_final_insts(do_not_infer_modes, HeadVars, + ArgFinalInsts0, _ArgFinalInsts, Disjunct1, Disjunct, !ModeInfo). :- pred modecheck_clause_switch(string::in, list(prog_var)::in, instmap::in, list(mer_inst)::in, prog_var::in, case::in, case::out, @@ -1256,8 +1264,8 @@ modecheck_clause_switch(CheckpointMsg, HeadVars, InstMap0, ArgFinalInsts0, mode_checkpoint(exit, CheckpointMsg, !ModeInfo), % Check that final insts match those specified in the mode declaration. - modecheck_final_insts(HeadVars, no, ArgFinalInsts0, - _ArgFinalInsts, Goal2, Goal, !ModeInfo), + modecheck_final_insts(do_not_infer_modes, HeadVars, + ArgFinalInsts0, _ArgFinalInsts, Goal2, Goal, !ModeInfo), Case = case(MainConsId, OtherConsIds, Goal). :- pred unique_modecheck_clause_disj(string::in, list(prog_var)::in, @@ -1277,8 +1285,8 @@ unique_modecheck_clause_disj(CheckpointMsg, HeadVars, InstMap0, ArgFinalInsts0, mode_checkpoint(exit, CheckpointMsg, !ModeInfo), % Check that final insts match those specified in the mode declaration. - modecheck_final_insts(HeadVars, no, ArgFinalInsts0, - _ArgFinalInsts, Disjunct1, Disjunct, !ModeInfo). + modecheck_final_insts(do_not_infer_modes, HeadVars, + ArgFinalInsts0, _ArgFinalInsts, Disjunct1, Disjunct, !ModeInfo). :- pred unique_modecheck_clause_switch(string::in, list(prog_var)::in, instmap::in, list(mer_inst)::in, prog_var::in, case::in, case::out, @@ -1308,8 +1316,8 @@ unique_modecheck_clause_switch(CheckpointMsg, HeadVars, InstMap0, mode_checkpoint(exit, CheckpointMsg, !ModeInfo), % Check that final insts match those specified in the mode declaration. - modecheck_final_insts(HeadVars, no, ArgFinalInsts0, _ArgFinalInsts, - Goal2, Goal, !ModeInfo), + modecheck_final_insts(do_not_infer_modes, HeadVars, + ArgFinalInsts0, _ArgFinalInsts, Goal2, Goal, !ModeInfo), Case = case(MainConsId, OtherConsIds, Goal). %-----------------------------------------------------------------------------% @@ -1319,26 +1327,26 @@ modecheck_lambda_final_insts(HeadVars, ArgFinalInsts, !Goal, !ModeInfo) :- % % For lambda expressions, modes must always be declared; % we never infer them. - InferModes = no, - modecheck_final_insts(HeadVars, InferModes, ArgFinalInsts, _NewFinalInsts, - !Goal, !ModeInfo). + modecheck_final_insts(do_not_infer_modes, HeadVars, + ArgFinalInsts, _NewFinalInsts, !Goal, !ModeInfo). % Check that the final insts of the head vars match their expected insts. % -:- pred modecheck_final_insts(list(prog_var)::in, bool::in, +:- pred modecheck_final_insts(maybe_infer_modes::in, list(prog_var)::in, list(mer_inst)::in, list(mer_inst)::out, hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) is det. -modecheck_final_insts(HeadVars, InferModes, !FinalInsts, !Body, !ModeInfo) :- - modecheck_final_insts_gmb(HeadVars, InferModes, - ground_matches_bound_if_complete, !FinalInsts, !Body, !ModeInfo). +modecheck_final_insts(InferModes, HeadVars, !FinalInsts, !Body, !ModeInfo) :- + modecheck_final_insts_gmb(InferModes, ground_matches_bound_if_complete, + HeadVars, !FinalInsts, !Body, !ModeInfo). -:- pred modecheck_final_insts_gmb(list(prog_var)::in, bool::in, - ground_matches_bound::in, list(mer_inst)::in, list(mer_inst)::out, +:- pred modecheck_final_insts_gmb(maybe_infer_modes::in, + ground_matches_bound::in, list(prog_var)::in, + list(mer_inst)::in, list(mer_inst)::out, hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) is det. -modecheck_final_insts_gmb(HeadVars, InferModes, GroundMatchesBound, - FinalInsts0, FinalInsts, Body0, Body, !ModeInfo) :- +modecheck_final_insts_gmb(InferModes, GroundMatchesBound, + HeadVars, FinalInsts0, FinalInsts, Body0, Body, !ModeInfo) :- mode_info_get_module_info(!.ModeInfo, ModuleInfo), mode_info_get_errors(!.ModeInfo, Errors), % If there were any mode errors, use an unreachable instmap. @@ -1360,31 +1368,30 @@ modecheck_final_insts_gmb(HeadVars, InferModes, GroundMatchesBound, mode_info_get_instmap(!.ModeInfo, InstMap) ), mode_info_get_var_types(!.ModeInfo, VarTypes), - instmap_lookup_vars(InstMap, HeadVars, VarFinalInsts1), + instmap_lookup_vars(InstMap, HeadVars, VarFinalInsts0), lookup_var_types(VarTypes, HeadVars, ArgTypes), ( - InferModes = yes, - normalise_insts(ModuleInfo, ArgTypes, VarFinalInsts1, VarFinalInsts2), - + InferModes = do_infer_modes, % Make sure we set the final insts of any variables which % we assumed were dead to `clobbered'. - mode_info_get_pred_id(!.ModeInfo, PredId), mode_info_get_proc_id(!.ModeInfo, ProcId), module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo), proc_info_arglives(ProcInfo, ModuleInfo, ArgLives), - maybe_clobber_insts(VarFinalInsts2, ArgLives, FinalInsts), - check_final_insts(HeadVars, FinalInsts0, FinalInsts, InferModes, - GroundMatchesBound, 1, ModuleInfo, Body0, Body, no, Changed1, - !ModeInfo), + normalise_insts(ModuleInfo, ArgTypes, VarFinalInsts0, VarFinalInsts1), + maybe_clobber_insts(VarFinalInsts1, ArgLives, VarFinalInsts2), + check_final_insts(InferModes, GroundMatchesBound, + HeadVars, VarFinalInsts2, FinalInsts0, 1, Body0, Body, + no, Changed1, !ModeInfo), + FinalInsts = VarFinalInsts2, mode_info_get_changed_flag(!.ModeInfo, Changed2), bool.or_list([Changed0, Changed1, Changed2], Changed), mode_info_set_changed_flag(Changed, !ModeInfo) ; - InferModes = no, - check_final_insts(HeadVars, FinalInsts0, VarFinalInsts1, InferModes, - GroundMatchesBound, 1, ModuleInfo, Body0, Body, no, _Changed1, - !ModeInfo), + InferModes = do_not_infer_modes, + check_final_insts(InferModes, GroundMatchesBound, + HeadVars, VarFinalInsts0, FinalInsts0, 1, Body0, Body, + no, _Changed1, !ModeInfo), FinalInsts = FinalInsts0 ). @@ -1406,29 +1413,30 @@ maybe_clobber_insts([Inst0 | Insts0], [IsLive | IsLives], [Inst | Insts]) :- ), maybe_clobber_insts(Insts0, IsLives, Insts). -:- pred check_final_insts(list(prog_var)::in, - list(mer_inst)::in, list(mer_inst)::in, bool::in, ground_matches_bound::in, - int::in, module_info::in, hlds_goal::in, hlds_goal::out, - bool::in, bool::out, mode_info::in, mode_info::out) is det. +:- pred check_final_insts(maybe_infer_modes::in, ground_matches_bound::in, + list(prog_var)::in, list(mer_inst)::in, list(mer_inst)::in, int::in, + hlds_goal::in, hlds_goal::out, bool::in, bool::out, + mode_info::in, mode_info::out) is det. -check_final_insts(Vars, Insts, VarInsts, InferModes, GroundMatchesBound, - ArgNum, ModuleInfo, !Goal, !Changed, !ModeInfo) :- +check_final_insts(InferModes, GroundMatchesBound, + Vars, VarInsts, ExpectedInsts, ArgNum, !Goal, !Changed, !ModeInfo) :- ( if Vars = [], - Insts = [], - VarInsts = [] + VarInsts = [], + ExpectedInsts = [] then true else if - Vars = [Var | VarsTail], - Insts = [Inst | InstsTail], - VarInsts = [VarInst | VarInstsTail] + Vars = [HeadVar | TailVars], + VarInsts = [HeadVarInst | TailVarInsts], + ExpectedInsts = [HeadExpectedInst | TailExpectedInsts] then + mode_info_get_module_info(!.ModeInfo, ModuleInfo), mode_info_get_var_types(!.ModeInfo, VarTypes), - lookup_var_type(VarTypes, Var, Type), + lookup_var_type(VarTypes, HeadVar, Type), ( if - inst_matches_final_gmb(VarInst, Inst, Type, ModuleInfo, - GroundMatchesBound) + inst_matches_final_gmb(HeadVarInst, HeadExpectedInst, Type, + ModuleInfo, GroundMatchesBound) then true else @@ -1437,13 +1445,14 @@ check_final_insts(Vars, Insts, VarInsts, InferModes, GroundMatchesBound, % If we are inferring the mode, then don't report an error, % just set changed to yes to make sure that we will do % another fixpoint pass. - InferModes = yes + InferModes = do_infer_modes ; - InferModes = no, + InferModes = do_not_infer_modes, % XXX This might need to be reconsidered now we have % unique modes. ( if - inst_matches_initial(VarInst, Inst, Type, ModuleInfo) + inst_matches_initial(HeadVarInst, HeadExpectedInst, + Type, ModuleInfo) then Reason = too_instantiated else if @@ -1460,8 +1469,9 @@ check_final_insts(Vars, Insts, VarInsts, InferModes, GroundMatchesBound, % information with information about how bound a variable % is. In the extremely common case that Inst is `ground', % we need only the latter, but we can't get it by itself. - ( Inst = ground(shared, none_or_default_func) - ; inst_matches_initial(Inst, VarInst, Type, ModuleInfo) + ( HeadExpectedInst = ground(shared, none_or_default_func) + ; inst_matches_initial(HeadExpectedInst, HeadVarInst, + Type, ModuleInfo) ) then Reason = not_instantiated_enough @@ -1470,13 +1480,13 @@ check_final_insts(Vars, Insts, VarInsts, InferModes, GroundMatchesBound, Reason = wrongly_instantiated ), set_of_var.init(WaitingVars), - ModeError = mode_error_final_inst(ArgNum, Var, VarInst, - Inst, Reason), + ModeError = mode_error_final_inst(ArgNum, HeadVar, HeadVarInst, + HeadExpectedInst, Reason), mode_info_error(WaitingVars, ModeError, !ModeInfo) ) ), - check_final_insts(VarsTail, InstsTail, VarInstsTail, - InferModes, GroundMatchesBound, ArgNum + 1, ModuleInfo, + check_final_insts(InferModes, GroundMatchesBound, + TailVars, TailVarInsts, TailExpectedInsts, ArgNum + 1, !Goal, !Changed, !ModeInfo) else unexpected($pred, "length mismatch") diff --git a/compiler/notes/compiler_design.html b/compiler/notes/compiler_design.html index dbca3b502..5375aab06 100644 --- a/compiler/notes/compiler_design.html +++ b/compiler/notes/compiler_design.html @@ -1248,20 +1248,38 @@ can change the evaluation methods of some procedures to eval_table_io, so it should come before any passes that require definitive evaluation methods (e.g. inlining).
-XXX Is there any good reason why lambda.m comes after table_gen.m? -
+This pass has to come after both +(a) the simplification pass at the end of semantic analysis, and +(b) the lambda expansion pass, +since it is these passes that record for it +which arguments of which procedures have this problem. +