[m-rev.] for review: ssdebug fixes
Peter Wang
novalazy at gmail.com
Wed Jun 9 11:58:05 AEST 2010
Branches: main, 10.04
Fix problems with the ssdebug transformation at higher optimisation levels
and with less conventional code.
compiler/ssdebug.m:
Transform code without relying on a determinism pass afterwards.
Handle procedures with inferred determinisms tighter than declared
determinisms, i.e. inferred semidet but declared cc_nondet, and
inferred cc_multi but declared cc_nondet. We transform the procedure
according to the inferred determinism, but in those two cases we have
to introduce promise_equivalent_solutions scopes.
Do not treat input arguments with more precise final insts,
i.e. ground >> bound(...), as if they were output arguments.
Handle procedures with existentially typed head variables. The
corresponding type_info argument is an output variable, which gets
renamed away to a temporary variable, and is only assigned just before
leaving the procedure. At the point where we build up the variable
list for the exit port, we must use the temporary variable.
Factor out common code in the four process_proc* predicates.
compiler/mercury_compile_middle_passes.m:
Remove an unnecessary determinism pass.
compiler/hlds_pred.m:
Make define_new_pred take a sym_name as the name of the predicate to
define. Thus the new predicate does not have to have the current
module as the module qualifier.
compiler/loop_inv.m:
Auxiliary predicates generated from procedures with the same name from
different modules could clash (in target code) if they had the same
line number. Retain the module qualifier from the original predicate
to distinguish between them.
However, that is still not enough to distinguish special predicates.
Use the predicate id in place of a counter to distinguish between
special predicates for different types. This should only affect
ssdebug grades; special predicates normally wouldn't contain anything
to hoist.
compiler/pd_info.m:
compiler/tupling.m:
compiler/untupling.m:
Conform to change to define_new_pred.
compiler/unused_args.m:
Simplify a bit of code.
diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m
index f6dd6fc..16ba478 100644
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -565,7 +565,7 @@
%
:- pred define_new_pred(pred_origin::in,
hlds_goal::in, hlds_goal::out, list(prog_var)::in, list(prog_var)::out,
- instmap::in, string::in, tvarset::in, vartypes::in,
+ instmap::in, sym_name::in, tvarset::in, vartypes::in,
prog_constraints::in, rtti_varmaps::in, prog_varset::in,
inst_varset::in, pred_markers::in, is_address_taken::in,
map(prog_var, string)::in, module_info::in, module_info::out,
@@ -1143,7 +1143,7 @@ pred_info_create(ModuleName, SymName, PredOrFunc, Context, Origin, Status,
ExistQVars, ClassContext, ClausesInfo, Procs, PredSubInfo).
define_new_pred(Origin, Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
- PredName, TVarSet, VarTypes0, ClassContext, RttiVarMaps,
+ SymName, TVarSet, VarTypes0, ClassContext, RttiVarMaps,
VarSet0, InstVarSet, Markers, IsAddressTaken, VarNameRemap,
ModuleInfo0, ModuleInfo, PredProcId) :-
Goal0 = hlds_goal(_GoalExpr, GoalInfo),
@@ -1181,8 +1181,9 @@ define_new_pred(Origin, Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
compute_arg_types_modes(ArgVars, VarTypes0, InstMap0, InstMap,
ArgTypes, ArgModes),
+ % XXX why does pred_info_create take a sym_name argument anyway?
module_info_get_name(ModuleInfo0, ModuleName),
- SymName = qualified(ModuleName, PredName),
+ sym_name_get_module_name_default(SymName, ModuleName, SymNameModule),
% Remove unneeded variables from the vartypes and varset.
goal_util.goal_vars(Goal0, GoalVars0),
@@ -1205,7 +1206,7 @@ define_new_pred(Origin, Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
set.init(Assertions),
- pred_info_create(ModuleName, SymName, pf_predicate, Context, Origin,
+ pred_info_create(SymNameModule, SymName, pf_predicate, Context, Origin,
ExportStatus, Markers, ArgTypes, TVarSet, ExistQVars,
ClassContext, Assertions, VarNameRemap, ProcInfo, ProcId, PredInfo),
diff --git a/compiler/loop_inv.m b/compiler/loop_inv.m
index 1b7e43d..a4e1aef 100644
--- a/compiler/loop_inv.m
+++ b/compiler/loop_inv.m
@@ -725,7 +725,6 @@ create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
AuxHeadVars = HeadVars ++ ComputedInvArgs,
- module_info_get_name(ModuleInfo0, ModuleName),
module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
PredInfo, ProcInfo),
@@ -740,19 +739,23 @@ create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
pred_info_get_origin(PredInfo, OrigOrigin),
pred_info_get_var_name_remap(PredInfo, VarNameRemap),
+ PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Context = goal_info_get_context(GoalInfo),
term.context_line(Context, Line),
- hlds_pred.proc_id_to_int(ProcId, ProcNo),
- AuxNamePrefix = string.format("loop_inv_%d", [i(ProcNo)]),
- make_pred_name_with_context(ModuleName, AuxNamePrefix,
- PredOrFunc, PredName, Line, 1, AuxPredSymName),
- (
- AuxPredSymName = unqualified(AuxPredName)
+ ( Line = 0 ->
+ % Use the predicate number to distinguish between similarly named
+ % generated predicates, e.g. special predicates.
+ Counter = pred_id_to_int(PredId)
;
- AuxPredSymName = qualified(_ModuleSpecifier, AuxPredName)
+ Counter = 1
),
+ make_pred_name_with_context(PredModule, "loop_inv",
+ PredOrFunc, PredName, Line, Counter, AuxPredSymName0),
+ hlds_pred.proc_id_to_int(ProcId, ProcNo),
+ Suffix = string.format("_%d", [i(ProcNo)]),
+ add_sym_name_suffix(AuxPredSymName0, Suffix, AuxPredSymName),
Origin = origin_transformed(transform_loop_invariant(ProcNo),
OrigOrigin, PredId),
@@ -765,7 +768,7 @@ create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
% liveness purposes.
InitialAuxInstMap,
% in - The initial instmap for the new aux proc.
- AuxPredName, % in - The name of the new aux proc.
+ AuxPredSymName, % in - The name of the new aux proc.
TVarSet, % in - ???
VarTypes, % in - The var -> type mapping for the new aux proc.
ClassContext, % in - Typeclass constraints on the new aux proc.
diff --git a/compiler/mercury_compile_middle_passes.m b/compiler/mercury_compile_middle_passes.m
index b19714a..a37b2c1 100644
--- a/compiler/mercury_compile_middle_passes.m
+++ b/compiler/mercury_compile_middle_passes.m
@@ -858,11 +858,7 @@ maybe_ssdb(Verbose, Stats, !HLDS, !IO) :-
"% Apply debugging source to source transformation ...\n", !IO),
ssdebug.transform_module(!HLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
- maybe_report_stats(Stats, !IO),
-
- % XXX This pass fixes up some incorrect determinisms after applying
- % the transformations.
- determinism_pass(!HLDS, _)
+ maybe_report_stats(Stats, !IO)
;
true
).
diff --git a/compiler/pd_info.m b/compiler/pd_info.m
index 88351fd..cba558e 100644
--- a/compiler/pd_info.m
+++ b/compiler/pd_info.m
@@ -627,14 +627,13 @@ pd_info.define_new_pred(Origin, Goal, PredProcId, CallGoal, !PDInfo) :-
counter.allocate(Count, Counter0, Counter),
pd_info_set_counter(Counter, !PDInfo),
pd_info_get_pred_info(!.PDInfo, PredInfo),
+ PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
Context = goal_info_get_context(GoalInfo),
term.context_line(Context, Line),
pd_info_get_module_info(!.PDInfo, ModuleInfo0),
- module_info_get_name(ModuleInfo0, ModuleName),
- make_pred_name_with_context(ModuleName, "DeforestationIn",
+ make_pred_name_with_context(PredModule, "DeforestationIn",
pf_predicate, PredName, Line, Count, SymName),
- Name = unqualify_name(SymName),
pd_info_get_proc_info(!.PDInfo, ProcInfo),
pred_info_get_typevarset(PredInfo, TVarSet),
@@ -648,7 +647,7 @@ pd_info.define_new_pred(Origin, Goal, PredProcId, CallGoal, !PDInfo) :-
% XXX handle the extra typeinfo arguments for
% --typeinfo-liveness properly.
hlds_pred.define_new_pred(Origin, Goal, CallGoal, Args, _ExtraArgs,
- InstMap, Name, TVarSet, VarTypes, ClassContext, RttiVarMaps,
+ InstMap, SymName, TVarSet, VarTypes, ClassContext, RttiVarMaps,
VarSet, InstVarSet, Markers, address_is_not_taken, VarNameRemap,
ModuleInfo0, ModuleInfo, PredProcId),
pd_info_set_module_info(ModuleInfo, !PDInfo).
diff --git a/compiler/ssdebug.m b/compiler/ssdebug.m
index d134d26..9e83c1a 100755
--- a/compiler/ssdebug.m
+++ b/compiler/ssdebug.m
@@ -37,11 +37,16 @@
%
% det/cc_multi:
%
+% The promise_equivalent_solutions is required if p is declared cc_nondet
+% but inferred cc_multi.
+%
% p(...) :-
% promise_<original_purity> (
% CallVarDescs = [ ... ],
% impure handle_event_call(ProcId, CallVarDescs),
-% <original body>, % renaming outputs
+% promise_equivalent_solutions [ ... ] (
+% <original body> % renaming outputs
+% ),
% ExitVarDescs = [ ... | CallVarDescs ],
% impure handle_event_exit(ProcId, ExitVarDescs, DoRetry),
% (
@@ -55,12 +60,17 @@
%
% semidet/cc_nondet:
%
+% The promise_equivalent_solutions is required only if p is declared
+% cc_nondet.
+%
% p(...) :-
% promise_<original_purity> (
% CallVarDescs = [ ... ],
-% (
% impure handle_event_call(ProcId, CallVarDescs),
+% (
+% promise_equivalent_solutions [...] (
% <original body> % renaming outputs
+% )
% ->
% ExitVarDescs = [ ... | CallVarDescs ],
% impure handle_event_exit(ProcId, ExitVarDescs, DoRetryA),
@@ -89,25 +99,26 @@
% promise_<original_purity> (
% (
% CallVarDescs = [ ... ],
-% impure handle_event_call(ProcId, CallVarDescs),
+% impure handle_event_call_nondet(ProcId, CallVarDescs),
% <original body>,
% ExitVarDescs = [ ... | CallVarDescs ],
% (
-% impure handle_event_exit(ProcId, ExitVarDescs)
+% impure handle_event_exit_nondet(ProcId, ExitVarDescs)
% % Go to fail port if retry.
% ;
% % preserve_backtrack_into,
-% impure handle_event_redo(ProcId, ExitVarDescs),
+% impure handle_event_redo_nondet(ProcId, ExitVarDescs),
% fail
% )
% ;
% % preserve_backtrack_into
-% impure handle_event_fail(ProcId, CallVarDescs, DoRetryB),
+% FailVarDescs = [ ... ],
+% impure handle_event_fail_nondet(ProcId, FailVarDescs, DoRetry),
% (
-% DoRetryB = do_retry,
+% DoRetry = do_retry,
% p(...)
% ;
-% DoRetryB = do_not_retry,
+% DoRetry = do_not_retry,
% fail
% )
% )
@@ -117,9 +128,9 @@
%
% p(...) :-
% promise_<original_purity> (
-% (
% CallVarDescs = [ ... ],
% impure handle_event_call(ProcId, CallVarDescs),
+% (
% <original body>
% ;
% % preserve_backtrack_into
@@ -414,11 +425,14 @@ create_proxy_proc(PredId, ProcId, !PredInfo, !ModuleInfo) :-
some [!ProcInfo] (
% The proxy just has to call the original procedure.
pred_info_proc_info(!.PredInfo, ProcId, !:ProcInfo),
- proc_info_get_goal(!.ProcInfo, hlds_goal(_, GoalInfo)),
proc_info_get_headvars(!.ProcInfo, Args),
pred_info_get_sym_name(!.PredInfo, SymName),
CallExpr = plain_call(PredId, ProcId, Args, not_builtin, no, SymName),
- proc_info_set_goal(hlds_goal(CallExpr, GoalInfo), !ProcInfo),
+ proc_info_get_goal(!.ProcInfo, hlds_goal(_, GoalInfo0)),
+ proc_info_interface_determinism(!.ProcInfo, Detism),
+ goal_info_set_determinism(Detism, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(CallExpr, GoalInfo),
+ proc_info_set_goal(Goal, !ProcInfo),
requantify_proc_general(ordinary_nonlocals_no_lambda, !ProcInfo),
recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
!ProcInfo, !ModuleInfo),
@@ -463,12 +477,13 @@ insert_context_update_call(ModuleInfo, Goal0, Goal, !ProcInfo) :-
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
process_proc(PredId, ProcId, _PredInfo, !ProcInfo, !ModuleInfo) :-
+ proc_info_get_argmodes(!.ProcInfo, ArgModes),
+ ( check_arguments_modes(!.ModuleInfo, ArgModes) ->
% We have different transformations for procedures of different
% determinisms.
- % XXX The definitions of the four process_proc_* predicates are very
- % similar; they look to have generated using cut-and-paste.
- % The common parts should be factored out and moved here.
+ % XXX It might be possible to factor out the common code in the four
+ % process_proc_* predicates.
proc_info_get_inferred_determinism(!.ProcInfo, Determinism),
(
@@ -492,6 +507,11 @@ process_proc(PredId, ProcId, _PredInfo, !ProcInfo, !ModuleInfo) :-
;
Determinism = detism_failure,
process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo)
+ )
+ ;
+ % In the case of a mode which is not fully input or output, the
+ % procedure is not transformed.
+ true
).
% Source-to-source transformation for a deterministic goal.
@@ -500,97 +520,84 @@ process_proc(PredId, ProcId, _PredInfo, !ProcInfo, !ModuleInfo) :-
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
- proc_info_get_goal(!.ProcInfo, BodyGoal0),
- BodyGoalInfo0 = get_hlds_goal_info(BodyGoal0),
-
- some [!PredInfo, !Varset, !Vartypes] (
- proc_info_get_varset(!.ProcInfo, !:Varset),
- proc_info_get_vartypes(!.ProcInfo, !:Vartypes),
+ some [!PredInfo, !VarSet, !VarTypes] (
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ proc_info_get_goal(!.ProcInfo, OrigBodyGoal),
+ proc_info_get_varset(!.ProcInfo, !:VarSet),
+ proc_info_get_vartypes(!.ProcInfo, !:VarTypes),
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
+ proc_info_get_argmodes(!.ProcInfo, ArgModes),
% Make the ssdb_proc_id.
- module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
make_proc_id_construction(!.ModuleInfo, !.PredInfo, ProcIdGoals,
- ProcIdVar, !Varset, !Vartypes),
-
- % Get the list of head variables and their instantiation state.
- proc_info_get_headvars(!.ProcInfo, HeadVars),
- proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
- proc_info_get_argmodes(!.ProcInfo, ListMerMode),
+ ProcIdVar, !VarSet, !VarTypes),
- ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
% Make a list which records the value for each of the head
% variables at the call port.
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
- CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, map.init, BoundVarDescsAtCall),
+ CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, map.init, BoundVarDescsAtCall),
% Generate the call to handle_event_call(ProcId, VarList).
make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
- HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
-
- % Get the InstMap at the end of the procedure.
- update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
+ HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
% In the case of a retry, the output variables will be bound by the
% retried call.
- proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
- InstantiatedVars),
- goal_info_get_instmap_delta(BodyGoalInfo0) = InstMapDelta,
- create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
- RenamingGoals, _NewVars, Renaming),
- rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
+ get_output_args(!.ModuleInfo, HeadVars, ArgModes, OutputVars),
+ rename_outputs(OutputVars, OrigBodyGoal, RenamedBodyGoal,
+ AssignOutputsGoal, Renaming, !VarSet, !VarTypes),
+
+ % If the procedure (which we call recursively on retry) is declared
+ % cc_nondet but inferred cc_multi, then we must put the original body
+ % in a single solution context.
+ proc_info_interface_determinism(!.ProcInfo, ProcDetism),
+ determinism_components(ProcDetism, CanFail, _Solns),
+ (
+ CanFail = can_fail,
+ map.apply_to_list(OutputVars, Renaming, RenamedOutputVars),
+ add_promise_equivalent_solutions(RenamedOutputVars,
+ RenamedBodyGoal, ScopedRenamedBodyGoal)
+ ;
+ CanFail = cannot_fail,
+ ScopedRenamedBodyGoal = RenamedBodyGoal
+ ),
% Make the variable list at the exit port. It's currently a
% completely new list instead of adding on to the list generated
% for the call port.
+ update_instmap(OrigBodyGoal, InitInstMap, FinalInstMap),
make_arg_list(0, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
- ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
-
- % Create DoRetry output variable.
- make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
+ ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
- % Generate the call to handle_event_exit(ProcId, VarList, DoRetry).
+ % Generate the call to handle_event_exit.
+ make_retry_var("DoRetry", RetryVar, !VarSet, !VarTypes),
make_handle_event("handle_event_exit",
[ProcIdVar, ExitArgListVar, RetryVar], HandleEventExitGoal,
- !ModuleInfo, !Varset, !Vartypes),
+ !ModuleInfo, !VarSet, !VarTypes),
% Generate the recursive call in the case of a retry.
make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
HeadVars, RecursiveGoal),
- % Organize the order of the generated code.
- goal_to_conj_list(BodyGoal1, BodyGoalList),
- % Set the determinism.
- Determinism = detism_det,
- goal_info_init(GoalInfo0),
- goal_info_set_determinism(Determinism, GoalInfo0, GoalInfoDet),
- goal_info_set_purity(purity_impure, GoalInfoDet,
- GoalInfoImpureDet),
-
- conj_list_to_goal(RenamingGoals, GoalInfoImpureDet, RenamingGoal),
% Create the switch on Retry at exit port.
- make_switch_goal(RetryVar, RecursiveGoal, RenamingGoal,
- GoalInfoImpureDet, SwitchGoal),
-
- ConjGoals = ProcIdGoals ++ CallArgListGoals ++
- [HandleEventCallGoal | BodyGoalList] ++
- ExitArgListGoals ++ [HandleEventExitGoal, SwitchGoal],
+ make_switch_goal(RetryVar, RecursiveGoal, AssignOutputsGoal,
+ SwitchGoal),
- conj_list_to_goal(ConjGoals, GoalInfoImpureDet, GoalWithoutPurity),
-
- % Add the purity scope.
- Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoDet, GoalWithoutPurity,
- Goal),
-
- commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
- !ModuleInfo, !.Varset, !.Vartypes)
- ;
- % In the case of a mode which is not fully input or output,
- % the procedure is not transformed.
- true
- )
+ % Put it all together.
+ BodyGoals = list.condense([
+ ProcIdGoals,
+ CallArgListGoals,
+ [HandleEventCallGoal],
+ [ScopedRenamedBodyGoal],
+ ExitArgListGoals,
+ [HandleEventExitGoal],
+ [SwitchGoal]
+ ]),
+ commit_goal_changes(BodyGoals, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.VarSet, !.VarTypes)
).
% Source-to-source transformation for a semidet goal.
@@ -599,151 +606,121 @@ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
- proc_info_get_goal(!.ProcInfo, BodyGoal0),
- get_hlds_goal_info(BodyGoal0) = BodyGoalInfo0,
-
- some [!PredInfo, !Varset, !Vartypes] (
- proc_info_get_varset(!.ProcInfo, !:Varset),
- proc_info_get_vartypes(!.ProcInfo, !:Vartypes),
-
- % Get the list of head variables and their initial instantiations.
+ some [!PredInfo, !VarSet, !VarTypes] (
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ proc_info_get_goal(!.ProcInfo, OrigBodyGoal),
+ proc_info_get_varset(!.ProcInfo, !:VarSet),
+ proc_info_get_vartypes(!.ProcInfo, !:VarTypes),
proc_info_get_headvars(!.ProcInfo, HeadVars),
- proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
- proc_info_get_argmodes(!.ProcInfo, ListMerMode),
-
- ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
+ proc_info_get_argmodes(!.ProcInfo, ArgModes),
% Make the ssdb_proc_id.
- module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
make_proc_id_construction(!.ModuleInfo, !.PredInfo, ProcIdGoals,
- ProcIdVar, !Varset, !Vartypes),
+ ProcIdVar, !VarSet, !VarTypes),
% Make a list which records the value for each of the head
% variables at the call port.
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
- CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, map.init, BoundVarDescsAtCall),
+ CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, map.init, BoundVarDescsAtCall),
- % Generate the call to handle_event_call(ProcId, VarList).
+ % Generate the call to handle_event_call.
make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
- HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
-
- % Get the InstMap at the end of the procedure.
- update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
+ HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
% In the case of a retry, the output variables will be bound by the
% retried call.
- proc_info_instantiated_head_vars(!.ModuleInfo, !.ProcInfo,
- InstantiatedVars),
- goal_info_get_instmap_delta(BodyGoalInfo0) = InstMapDelta,
- create_renaming(InstantiatedVars, InstMapDelta, !Varset, !Vartypes,
- RenamingGoals, _NewVars, Renaming),
- rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
+ get_output_args(!.ModuleInfo, HeadVars, ArgModes, OutputVars),
+ rename_outputs(OutputVars, OrigBodyGoal, RenamedBodyGoal,
+ AssignOutputsGoal, Renaming, !VarSet, !VarTypes),
% Make the variable list at the exit port. It's currently a
% completely new list instead of adding on to the list generated
% for the call port.
+ update_instmap(OrigBodyGoal, InitInstMap, FinalInstMap),
make_arg_list(0, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
- ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
+ ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
- % Create DoRetryA output variable
- make_retry_var("DoRetryA", RetryAVar, !Varset, !Vartypes),
-
- % Generate the call to
- % handle_event_exit(ProcId, VarList, DoRetryA).
+ % Generate the call to handle_event_exit.
+ make_retry_var("DoRetryA", RetryAVar, !VarSet, !VarTypes),
make_handle_event("handle_event_exit",
[ProcIdVar, ExitArgListVar, RetryAVar], HandleEventExitGoal,
- !ModuleInfo, !Varset, !Vartypes),
+ !ModuleInfo, !VarSet, !VarTypes),
- % Generate the recursive call in the case of a retry
+ % Generate the recursive call in the case of a retry.
make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
HeadVars, RecursiveGoal),
% Generate the list of arguments at the fail port.
make_arg_list(0, InitInstMap, [], Renaming, FailArgListVar,
- FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
+ FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
- % Create DoRetryB output variable
- make_retry_var("DoRetryB", RetryBVar, !Varset, !Vartypes),
-
- % Generate the call to
- % handle_event_fail(ProcId, VarList, DoRetryB).
+ % Generate the call to handle_event_fail.
+ make_retry_var("DoRetryB", RetryBVar, !VarSet, !VarTypes),
make_handle_event("handle_event_fail",
[ProcIdVar, FailArgListVar, RetryBVar], HandleEventFailGoal,
- !ModuleInfo, !Varset, !Vartypes),
-
- make_fail_call(FailGoal, !.ModuleInfo),
+ !ModuleInfo, !VarSet, !VarTypes),
- % Organize the order of the generated code.
+ proc_info_interface_determinism(!.ProcInfo, ProcDetism),
+ ImpureGoalInfo = impure_goal_info(ProcDetism),
- % Get a flattened goal to avoid nested conjuction.
- goal_to_conj_list(BodyGoal1, BodyGoalList),
- GoalsCond = BodyGoalList,
+ % The condition of the if-then-else is the original body with renamed
+ % output variables. Introduce a promise_equivalent_solutions scope to
+ % put it into a single solution context if the procedure (which we call
+ % recursively later) was declared to have more solutions.
+ determinism_components(ProcDetism, _CanFail, Solns),
+ (
+ Solns = at_most_one,
+ CondGoal = RenamedBodyGoal
+ ;
+ Solns = at_most_many_cc,
+ map.apply_to_list(OutputVars, Renaming, RenamedOutputVars),
+ add_promise_equivalent_solutions(RenamedOutputVars,
+ RenamedBodyGoal, CondGoal)
+ ;
+ ( Solns = at_most_zero
+ ; Solns = at_most_many
+ ),
+ unexpected(this_file,
+ "process_proc_semi: wrong number of solutions")
+ ),
- % Create the switch on DoRetryA at exit port.
- goal_info_init(GoalInfo0),
- goal_info_set_purity(purity_impure, GoalInfo0, GoalInfoImpure),
- goal_list_purity(GoalsCond, PurityCond),
- goal_list_determinism(GoalsCond, DetismCond),
- goal_info_set_determinism(DetismCond, GoalInfo0,
- GoalInfoCondDet),
- goal_info_set_purity(PurityCond, GoalInfoCondDet,
- GoalInfoCondPurDet),
-
- SemiDet = detism_semi,
- goal_info_set_determinism(SemiDet, GoalInfo0, GoalInfoSemiDet),
- goal_info_set_purity(purity_impure, GoalInfoSemiDet,
- GoalInfoImpureSemiDet),
- goal_info_set_determinism(detism_det, GoalInfoImpure,
- GoalInfoImpureDet),
- conj_list_to_goal(RenamingGoals, GoalInfoImpureDet, RenamingGoal),
-
- % Create the switch on DoRetryA at exit port.
- make_switch_goal(RetryAVar, RecursiveGoal, RenamingGoal,
- GoalInfoImpureSemiDet, SwitchExitPortGoal),
- % Create the switch on DoRetryB at fail port.
- make_switch_goal(RetryBVar, RecursiveGoal, FailGoal,
- GoalInfoImpureSemiDet, SwitchFailPortGoal),
-
- GoalsThen = ExitArgListGoals ++
- [HandleEventExitGoal, SwitchExitPortGoal],
- GoalsElse = FailArgListGoals ++
- [HandleEventFailGoal, SwitchFailPortGoal],
-
- goal_info_set_determinism(detism_semi, GoalInfoImpure,
- GoalInfoThen),
- goal_info_set_determinism(detism_semi, GoalInfoImpure,
- GoalInfoElse),
-
- IteExistVars = [],
- conj_list_to_goal(GoalsCond, GoalInfoCondPurDet, CondGoal),
- ThenGoal = hlds_goal(conj(plain_conj, GoalsThen), GoalInfoThen),
- ElseGoal = hlds_goal(conj(plain_conj, GoalsElse), GoalInfoElse),
-
- CallVarGoal = ProcIdGoals ++ CallArgListGoals ++
+ % Create the `then' branch.
+ make_switch_goal(RetryAVar, RecursiveGoal, AssignOutputsGoal,
+ SwitchExitPortGoal),
+ GoalsThen = list.condense([
+ ExitArgListGoals,
+ [HandleEventExitGoal],
+ [SwitchExitPortGoal]
+ ]),
+ ThenGoal = hlds_goal(conj(plain_conj, GoalsThen), ImpureGoalInfo),
+
+ % Create the `else' branch.
+ make_switch_goal(RetryBVar, RecursiveGoal, fail_goal,
+ SwitchFailPortGoal),
+ GoalsElse = list.condense([
+ FailArgListGoals,
+ [HandleEventFailGoal],
+ [SwitchFailPortGoal]
+ ]),
+ ElseGoal = hlds_goal(conj(plain_conj, GoalsElse), ImpureGoalInfo),
+
+ % Put it all together.
+ OrigBodyGoal = hlds_goal(_, OrigGoalInfo),
+ goal_info_set_determinism(ProcDetism, OrigGoalInfo, IteGoalInfo),
+ IteGoal = hlds_goal(if_then_else([], CondGoal, ThenGoal, ElseGoal),
+ IteGoalInfo),
+ BodyGoals = list.condense([
+ ProcIdGoals,
+ CallArgListGoals,
[HandleEventCallGoal],
- % XXX not sure about determinism in an if-then-else.
- GoalITE = hlds_goal(if_then_else(IteExistVars, CondGoal, ThenGoal,
- ElseGoal), GoalInfoCondPurDet),
-
- ConjGoal = CallVarGoal ++ [GoalITE],
- GoalWithoutPurity = hlds_goal(conj(plain_conj, ConjGoal),
- GoalInfoCondPurDet),
-
- % Add the purity scope.
- Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoSemiDet, GoalWithoutPurity,
- Goal),
-
- commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
- !ModuleInfo, !.Varset, !.Vartypes)
- ;
- % In the case of a mode which is not fully input or output,
- % the procedure is not transformed.
- true
- )
+ [IteGoal]
+ ]),
+ commit_goal_changes(BodyGoals, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.VarSet, !.VarTypes)
).
% Source-to-source transformation for a nondeterministic procedure.
@@ -752,136 +729,90 @@ process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
- proc_info_get_goal(!.ProcInfo, BodyGoal0),
- get_hlds_goal_info(BodyGoal0) = BodyGoalInfo0,
-
- some [!PredInfo, !Varset, !Vartypes] (
- proc_info_get_varset(!.ProcInfo, !:Varset),
- proc_info_get_vartypes(!.ProcInfo, !:Vartypes),
-
- % Make the ssdb_proc_id.
+ some [!PredInfo, !VarSet, !VarTypes] (
module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
- make_proc_id_construction(!.ModuleInfo, !.PredInfo, ProcIdGoals,
- ProcIdVar, !Varset, !Vartypes),
-
- % Get the list of head variables and their instantiation state.
+ proc_info_get_goal(!.ProcInfo, OrigBodyGoal),
+ proc_info_get_varset(!.ProcInfo, !:VarSet),
+ proc_info_get_vartypes(!.ProcInfo, !:VarTypes),
proc_info_get_headvars(!.ProcInfo, HeadVars),
- proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
- proc_info_get_argmodes(!.ProcInfo, ListMerMode),
- ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
+ % Make the ssdb_proc_id.
+ make_proc_id_construction(!.ModuleInfo, !.PredInfo, ProcIdGoals,
+ ProcIdVar, !VarSet, !VarTypes),
% Make a list which records the value for each of the head
% variables at the call port.
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InitInstMap),
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
- CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, map.init, BoundVarDescsAtCall),
+ CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, map.init, BoundVarDescsAtCall),
- % Generate the call to handle_event_call(ProcId, VarList).
+ % Generate the call to handle_event_call.
make_handle_event("handle_event_call_nondet",
[ProcIdVar, CallArgListVar],
- HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
-
- % Get the InstMap at the end of the procedure.
- update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
+ HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
% Make the variable list at the exit port. It's currently a
% completely new list instead of adding on to the list generated
% for the call port.
+ update_instmap(OrigBodyGoal, InitInstMap, FinalInstMap),
make_arg_list(0, FinalInstMap, HeadVars, map.init, ExitArgListVar,
- ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
+ ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
+
+ proc_info_interface_determinism(!.ProcInfo, ProcDetism),
- % Generate the call to handle_event_exit_nondet(ProcId, VarList).
+ % Create the disjunct that handles call, exit and redo ports.
make_handle_event("handle_event_exit_nondet",
[ProcIdVar, ExitArgListVar],
- HandleEventExitGoal, !ModuleInfo, !Varset, !Vartypes),
+ HandleEventExitGoal, !ModuleInfo, !VarSet, !VarTypes),
+ ExitDisjunct = HandleEventExitGoal,
- % Generate the call to handle_event_redo(ProcId, VarList).
make_handle_event("handle_event_redo_nondet",
[ProcIdVar, ExitArgListVar],
- HandleEventRedoGoal, !ModuleInfo, !Varset, !Vartypes),
-
- % Generate the list of argument at the fail port.
- make_arg_list(0, InitInstMap, [], map.init, FailArgListVar,
- FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
-
- % Create DoRetry output variable
- make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
-
- % Generate the call to
- % handle_event_fail_nondet(ProcId, VarList, DoRetry).
+ HandleEventRedoGoal, !ModuleInfo, !VarSet, !VarTypes),
+ RedoDisjunct = hlds_goal(conj(plain_conj,
+ [HandleEventRedoGoal, fail_goal]),
+ impure_backtrack_goal_info(detism_failure)),
+
+ ExitOrRedoGoal = hlds_goal(disj([ExitDisjunct, RedoDisjunct]),
+ impure_goal_info(detism_non)),
+ CallExitRedoDisjunctGoals = list.condense([
+ CallArgListGoals,
+ [HandleEventCallGoal],
+ [OrigBodyGoal],
+ ExitArgListGoals,
+ [ExitOrRedoGoal]
+ ]),
+ CallExitRedoDisjunct = hlds_goal(
+ conj(plain_conj, CallExitRedoDisjunctGoals),
+ impure_goal_info(ProcDetism)),
+
+ % Create the disjunct that handles the fail port.
+ FailArgListVar = CallArgListVar,
+ FailArgListGoals = CallArgListGoals,
+ make_retry_var("DoRetry", RetryVar, !VarSet, !VarTypes),
make_handle_event("handle_event_fail_nondet",
[ProcIdVar, FailArgListVar, RetryVar],
- HandleEventFailGoal, !ModuleInfo, !Varset, !Vartypes),
-
- make_fail_call(FailGoal, !.ModuleInfo),
-
- % Organize the order of the generated code.
- % Get a flattened goal to avoid nested conjuction.
- goal_to_conj_list(BodyGoal0, BodyGoalList0),
- CallVarGoal0 = CallArgListGoals ++
- [HandleEventCallGoal | BodyGoalList0] ++ ExitArgListGoals,
- goal_info_init(GoalInfo0),
- conj_list_to_goal(CallVarGoal0, GoalInfo0, CallVarGoal1),
- goal_to_conj_list(CallVarGoal1, CallVarGoal),
-
- % Generate the recursive call in the case of a retry
+ HandleEventFailGoal, !ModuleInfo, !VarSet, !VarTypes),
make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
HeadVars, RecursiveGoal),
-
- Det = detism_det,
- FailDet = detism_failure,
- NonDet = detism_non,
- goal_info_set_purity(purity_impure, GoalInfo0, GoalInfoImpure),
- goal_info_set_determinism(Det, GoalInfoImpure, GoalInfoImpureDet),
- goal_info_set_determinism(FailDet, GoalInfoImpure,
- GoalInfoImpureFailDet),
- goal_info_set_determinism(NonDet, GoalInfoImpure,
- GoalInfoImpureNonDet),
- goal_list_determinism(BodyGoalList0, Detism),
- goal_info_set_determinism(Detism, GoalInfo0, GoalInfoDetism),
- goal_info_set_determinism(Detism, GoalInfoImpure,
- GoalInfoImpureDetism),
-
- % Create the switch on DoRetry at fail port.
- make_switch_goal(RetryVar, RecursiveGoal, FailGoal,
- GoalInfoImpureNonDet, SwitchFailPortGoal),
-
- ConjGoal11 = hlds_goal(conj(plain_conj,
- [HandleEventExitGoal]), GoalInfoImpureDet),
- ConjGoal120 = hlds_goal(conj(plain_conj,
- [HandleEventRedoGoal, FailGoal]), GoalInfoImpureFailDet),
- goal_add_feature(feature_preserve_backtrack_into, ConjGoal120,
- ConjGoal12),
-
- DisjGoal1 = hlds_goal(disj([ConjGoal11, ConjGoal12]),
- GoalInfoImpureDetism),
-
- ConjGoal21 = hlds_goal(conj(plain_conj,
- CallVarGoal ++ [DisjGoal1]), GoalInfoImpureDetism),
- ConjGoal220 = hlds_goal(conj(plain_conj, FailArgListGoals ++
- [HandleEventFailGoal, SwitchFailPortGoal]),
- GoalInfoImpureNonDet),
- goal_add_feature(feature_preserve_backtrack_into, ConjGoal220,
- ConjGoal22),
- DisjGoal2 = hlds_goal(disj([ConjGoal21, ConjGoal22]),
- GoalInfoImpureDetism),
-
- GoalWithoutPurity = hlds_goal(conj(plain_conj,
- ProcIdGoals ++ [DisjGoal2]), GoalInfoImpureDetism),
-
- % Add the purity scope.
- Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoDetism, GoalWithoutPurity,
- Goal),
-
- commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
- !ModuleInfo, !.Varset, !.Vartypes)
- ;
- true
- )
+ make_switch_goal(RetryVar, RecursiveGoal, fail_goal,
+ SwitchFailPortGoal),
+ FailDisjunctGoals = list.condense([
+ FailArgListGoals,
+ [HandleEventFailGoal],
+ [SwitchFailPortGoal]
+ ]),
+ FailDisjunct = hlds_goal(conj(plain_conj, FailDisjunctGoals),
+ impure_backtrack_goal_info(ProcDetism)),
+
+ % Put it together.
+ BodyDisj = hlds_goal(disj([CallExitRedoDisjunct, FailDisjunct]),
+ impure_goal_info(ProcDetism)),
+ BodyGoals = ProcIdGoals ++ [BodyDisj],
+ commit_goal_changes(BodyGoals, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.VarSet, !.VarTypes)
).
% Source-to-source transformation for a failure procedure.
@@ -890,161 +821,130 @@ process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
- proc_info_get_goal(!.ProcInfo, BodyGoal0),
- BodyGoalInfo0 = get_hlds_goal_info(BodyGoal0),
-
- some [!PredInfo, !Varset, !Vartypes] (
- proc_info_get_varset(!.ProcInfo, !:Varset),
- proc_info_get_vartypes(!.ProcInfo, !:Vartypes),
- proc_info_get_argmodes(!.ProcInfo, ListMerMode),
+ some [!PredInfo, !VarSet, !VarTypes] (
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ proc_info_get_goal(!.ProcInfo, OrigBodyGoal),
+ proc_info_get_varset(!.ProcInfo, !:VarSet),
+ proc_info_get_vartypes(!.ProcInfo, !:VarTypes),
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
- ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
% Make the ssdb_proc_id.
- module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
make_proc_id_construction(!.ModuleInfo, !.PredInfo, ProcIdGoals,
- ProcIdVar, !Varset, !Vartypes),
-
- % Get the list of head variables and their instantiation state.
- proc_info_get_headvars(!.ProcInfo, HeadVars),
- proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo,
- InitInstMap),
+ ProcIdVar, !VarSet, !VarTypes),
% Make a list which records the value for each of the head
% variables at the call port.
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo,
+ InitInstMap),
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
- CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, map.init, BoundVarDescsAtCall),
+ CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, map.init, _BoundVarDescsAtCall),
- % Generate the call to handle_event_call(ProcId, VarList).
+ % Generate the call to handle_event_call.
make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
- HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
-
- % Make the variable list at the exit port. It's currently a
- % completely new list instead of adding on to the list generated
- % for the call port.
- make_arg_list(0, InitInstMap, [], map.init, FailArgListVar,
- FailArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtFail),
-
- % Create DoRetry output variable.
- make_retry_var("DoRetry", RetryVar, !Varset, !Vartypes),
+ HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
- % Generate the call to handle_event_exit(ProcId, VarList, DoRetry).
+ % Generate the call to handle_event_fail.
+ FailArgListVar = CallArgListVar,
+ make_retry_var("DoRetry", RetryVar, !VarSet, !VarTypes),
make_handle_event("handle_event_fail",
[ProcIdVar, FailArgListVar, RetryVar],
- HandleEventFailGoal, !ModuleInfo, !Varset, !Vartypes),
-
- make_fail_call(FailGoal, !.ModuleInfo),
+ HandleEventFailGoal, !ModuleInfo, !VarSet, !VarTypes),
% Generate the recursive call in the case of a retry.
make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
HeadVars, RecursiveGoal),
- % Organize the order of the generated code.
-
- goal_to_conj_list(BodyGoal0, BodyGoalList),
- % Set the determinism.
- Determinism = detism_failure,
- goal_info_init(GoalInfo0),
- goal_info_set_determinism(Determinism, GoalInfo0, GoalInfoFail),
- goal_info_set_purity(purity_impure, GoalInfoFail,
- GoalInfoImpureFail),
-
% Create the switch on Retry at fail port.
- make_switch_goal(RetryVar, RecursiveGoal, FailGoal,
- GoalInfoImpureFail, SwitchGoal),
-
- ConjGoal1 = hlds_goal(conj(plain_conj, BodyGoalList),
- GoalInfoImpureFail),
- ConjGoal20 = hlds_goal(conj(plain_conj, FailArgListGoals ++
- [HandleEventFailGoal, SwitchGoal]), GoalInfoImpureFail),
- goal_add_feature(feature_preserve_backtrack_into, ConjGoal20,
- ConjGoal2),
-
- DisjGoal = hlds_goal(disj([ConjGoal1, ConjGoal2]),
- GoalInfoImpureFail),
-
- ConjGoals = ProcIdGoals ++ CallArgListGoals ++
- [HandleEventCallGoal, DisjGoal],
-
- conj_list_to_goal(ConjGoals, GoalInfoImpureFail,
- GoalWithoutPurity),
-
- % Add the purity scope.
- Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoFail, GoalWithoutPurity,
- Goal),
-
- commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
- !ModuleInfo, !.Varset, !.Vartypes)
- ;
- true
- )
+ make_switch_goal(RetryVar, RecursiveGoal, fail_goal, SwitchGoal),
+
+ % Put it all together.
+ proc_info_interface_determinism(!.ProcInfo, ProcDetism),
+ FailDisjunct = hlds_goal(
+ conj(plain_conj, [HandleEventFailGoal, SwitchGoal]),
+ impure_backtrack_goal_info(ProcDetism)),
+ DisjGoal = hlds_goal(disj([OrigBodyGoal, FailDisjunct]),
+ impure_goal_info(ProcDetism)),
+ BodyGoals = list.condense([
+ ProcIdGoals,
+ CallArgListGoals,
+ [HandleEventCallGoal],
+ [DisjGoal]
+ ]),
+ commit_goal_changes(BodyGoals, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.VarSet, !.VarTypes)
).
% Source-to-source transformation for an erroneous procedure.
- % XXX ERRONEOUS procedure have currently just a call port.
%
:- pred process_proc_erroneous(pred_id::in, proc_id::in,
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
process_proc_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
- proc_info_get_goal(!.ProcInfo, BodyGoal0),
- BodyGoalInfo0 = get_hlds_goal_info(BodyGoal0),
-
- some [!PredInfo, !Varset, !Vartypes] (
- proc_info_get_varset(!.ProcInfo, !:Varset),
- proc_info_get_vartypes(!.ProcInfo, !:Vartypes),
- proc_info_get_argmodes(!.ProcInfo, ListMerMode),
-
- ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
+ some [!PredInfo, !VarSet, !VarTypes] (
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ proc_info_get_goal(!.ProcInfo, OrigBodyGoal),
+ proc_info_get_varset(!.ProcInfo, !:VarSet),
+ proc_info_get_vartypes(!.ProcInfo, !:VarTypes),
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
% Make the ssdb_proc_id.
- module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
make_proc_id_construction(!.ModuleInfo, !.PredInfo, ProcIdGoals,
- ProcIdVar, !Varset, !Vartypes),
-
- % Get the list of head variables and their instantiation state.
- proc_info_get_headvars(!.ProcInfo, HeadVars),
- proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo,
- InitInstMap),
+ ProcIdVar, !VarSet, !VarTypes),
% Make a list which records the value for each of the head
% variables at the call port.
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo,
+ InitInstMap),
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
- CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, map.init, _BoundVarDescsAtCall),
+ CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, map.init, _BoundVarDescsAtCall),
% Generate the call to handle_event_call(ProcId, VarList).
make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
- HandleEventCallGoal, !ModuleInfo, !Varset, !Vartypes),
+ HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
- % Organize the order of the generated code.
- goal_to_conj_list(BodyGoal0, BodyGoalList),
- % Set the determinism.
- DeterminismErr = detism_erroneous,
- goal_info_init(GoalInfo0),
- goal_info_set_determinism(DeterminismErr, GoalInfo0,
- GoalInfoErr),
- goal_info_set_purity(purity_impure, GoalInfoErr,
- GoalInfoImpureErr),
+ % Put it all together.
+ BodyGoals = list.condense([
+ ProcIdGoals,
+ CallArgListGoals,
+ [HandleEventCallGoal],
+ [OrigBodyGoal]
+ ]),
+ commit_goal_changes(BodyGoals, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, !.VarSet, !.VarTypes)
+ ).
- ConjGoals = ProcIdGoals ++ CallArgListGoals ++
- [HandleEventCallGoal | BodyGoalList],
+:- pred get_output_args(module_info::in, list(prog_var)::in,
+ list(mer_mode)::in, list(prog_var)::out) is det.
- conj_list_to_goal(ConjGoals, GoalInfoImpureErr, GoalWithoutPurity),
+get_output_args(ModuleInfo, HeadVars, ArgModes, OutputVars) :-
+ F = (func(Var, Mode) = Var is semidet :-
+ mode_is_output(ModuleInfo, Mode)
+ ),
+ OutputVars = list.filter_map_corresponding(F, HeadVars, ArgModes).
- % Add the purity scope.
- Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoErr, GoalWithoutPurity,
- Goal),
+:- pred rename_outputs(list(prog_var)::in, hlds_goal::in, hlds_goal::out,
+ hlds_goal::out, prog_var_renaming::out, prog_varset::in, prog_varset::out,
+ vartypes::in, vartypes::out) is det.
- commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
- !ModuleInfo, !.Varset, !.Vartypes)
- ;
- true
- )
- ).
+rename_outputs(OutputVars, !Goal, UnifyGoal, Renaming, !VarSet, !VarTypes) :-
+ GoalInfo0 = get_hlds_goal_info(!.Goal),
+ InstMapDelta = goal_info_get_instmap_delta(GoalInfo0),
+ create_renaming(OutputVars, InstMapDelta, !VarSet, !VarTypes,
+ UnifyGoals, _NewVars, Renaming),
+ goal_info_init(UnifyGoalInfo0),
+ goal_info_set_determinism(detism_det, UnifyGoalInfo0, UnifyGoalInfo),
+ conj_list_to_goal(UnifyGoals, UnifyGoalInfo, UnifyGoal),
+ rename_some_vars_in_goal(Renaming, !Goal).
+
+:- pred add_promise_equivalent_solutions(list(prog_var)::in,
+ hlds_goal::in, hlds_goal::out) is det.
+
+add_promise_equivalent_solutions(OutputVars, Goal0, Goal) :-
+ Goal0 = hlds_goal(_, GoalInfo),
+ Reason = promise_solutions(OutputVars, equivalent_solutions),
+ Goal = hlds_goal(scope(Reason, Goal0), GoalInfo).
%-----------------------------------------------------------------------------%
@@ -1077,11 +977,14 @@ make_recursive_call(PredInfo, ModuleInfo, PredId, ProcId, HeadVars, Goal) :-
% is doing, ie binding the head vars.
pred_info_proc_info(PredInfo, ProcId, ProcInfo),
proc_info_get_goal(ProcInfo, BodyGoal0),
- GoalInfoHG = get_hlds_goal_info(BodyGoal0),
+ GoalInfoHG0 = get_hlds_goal_info(BodyGoal0),
+
+ proc_info_interface_determinism(ProcInfo, Determinism),
+ goal_info_set_determinism(Determinism, GoalInfoHG0, GoalInfoHG),
Goal = hlds_goal(GoalExpr, GoalInfoHG).
- % make_switch_goal(SwitchVar, SwitchCase1, SwitchCase2, GoalInfo, Goal).
+ % make_switch_goal(SwitchVar, RecursiveGoal, FailGoal, Goal).
%
% Create an output Goal, which is a switch with following pattern :
% (
@@ -1093,10 +996,9 @@ make_recursive_call(PredInfo, ModuleInfo, PredId, ProcId, HeadVars, Goal) :-
% )
%
:- pred make_switch_goal(prog_var::in, hlds_goal::in, hlds_goal::in,
- hlds_goal_info::in, hlds_goal::out) is det.
+ hlds_goal::out) is det.
-make_switch_goal(SwitchVar, DoRetryGoal, DoNotRetryGoal, GoalInfo,
- SwitchGoal) :-
+make_switch_goal(SwitchVar, DoRetryGoal, DoNotRetryGoal, SwitchGoal) :-
SSDBModule = mercury_ssdb_builtin_module,
RetryTypeSymName = qualified(SSDBModule, "ssdb_retry"),
RetryTypeCtor = type_ctor(RetryTypeSymName, 0),
@@ -1108,31 +1010,42 @@ make_switch_goal(SwitchVar, DoRetryGoal, DoNotRetryGoal, GoalInfo,
CaseDoNotRetry = case(ConsIdDoNotRetry, [], DoNotRetryGoal),
SwitchGoalExpr = switch(SwitchVar, cannot_fail,
[CaseDoRetry, CaseDoNotRetry]),
- SwitchGoal = hlds_goal(SwitchGoalExpr, GoalInfo).
- % wrap_with_purity_scope(Purity, GoalInfo, Goal0, Goal):
- %
- % The Goal0 is wrap with the Purity to give Goal.
- %
-:- pred wrap_with_purity_scope(purity::in, hlds_goal_info::in, hlds_goal::in,
- hlds_goal::out) is det.
+ RetryGoalInfo = get_hlds_goal_info(DoRetryGoal),
+ NoRetryGoalInfo = get_hlds_goal_info(DoNotRetryGoal),
+ RetryDetism = goal_info_get_determinism(RetryGoalInfo),
+ NoRetryDetism = goal_info_get_determinism(NoRetryGoalInfo),
-wrap_with_purity_scope(Purity, GoalInfo0, GoalWithoutPurity, Goal) :-
- goal_info_set_purity(Purity, GoalInfo0, GoalInfo),
- ScopeReason = promise_purity(Purity),
- Goal = hlds_goal(scope(ScopeReason, GoalWithoutPurity), GoalInfo).
+ det_switch_detism(RetryDetism, NoRetryDetism, SwitchDetism),
+
+ goal_info_init(GoalInfo0),
+ goal_info_set_determinism(SwitchDetism, GoalInfo0, GoalInfo1),
+ goal_info_set_purity(purity_impure, GoalInfo1, GoalInfo),
+
+ SwitchGoal = hlds_goal(SwitchGoalExpr, GoalInfo).
% Update the proc_info and pred_info with the result of the
% source-to-source transformation.
%
-:- pred commit_goal_changes(hlds_goal::in, pred_id::in, proc_id::in,
+:- pred commit_goal_changes(list(hlds_goal)::in, pred_id::in, proc_id::in,
pred_info::in, proc_info::in, proc_info::out,
module_info::in, module_info::out, prog_varset::in, vartypes::in) is det.
-commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo, !ModuleInfo,
- Varset, Vartypes) :-
- proc_info_set_varset(Varset, !ProcInfo),
- proc_info_set_vartypes(Vartypes, !ProcInfo),
+commit_goal_changes(ConjGoals, PredId, ProcId, !.PredInfo, !ProcInfo,
+ !ModuleInfo, VarSet, VarTypes) :-
+ goal_list_determinism(ConjGoals, ConjDetism),
+ ConjGoalInfo = impure_goal_info(ConjDetism),
+ Conj = hlds_goal(conj(plain_conj, ConjGoals), ConjGoalInfo),
+
+ proc_info_get_goal(!.ProcInfo, hlds_goal(_, OrigGoalInfo)),
+ proc_info_interface_determinism(!.ProcInfo, ProcDetism),
+ % This is needed due to the determinism of the recursive call.
+ goal_info_set_determinism(ProcDetism, OrigGoalInfo, ScopeGoalInfo),
+ Purity = goal_info_get_purity(OrigGoalInfo),
+ Goal = hlds_goal(scope(promise_purity(Purity), Conj), ScopeGoalInfo),
+
+ proc_info_set_varset(VarSet, !ProcInfo),
+ proc_info_set_vartypes(VarTypes, !ProcInfo),
proc_info_set_goal(Goal, !ProcInfo),
requantify_proc_general(ordinary_nonlocals_no_lambda, !ProcInfo),
recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
@@ -1141,6 +1054,20 @@ commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo, !ModuleInfo,
repuritycheck_proc(!.ModuleInfo, proc(PredId, ProcId), !PredInfo),
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo).
+:- func impure_goal_info(determinism) = hlds_goal_info.
+
+impure_goal_info(Detism) = GoalInfo :-
+ goal_info_init(GoalInfo0),
+ goal_info_set_purity(purity_impure, GoalInfo0, GoalInfo1),
+ goal_info_set_determinism(Detism, GoalInfo1, GoalInfo).
+
+:- func impure_backtrack_goal_info(determinism) = hlds_goal_info.
+
+impure_backtrack_goal_info(Detism) = GoalInfo :-
+ GoalInfo0 = impure_goal_info(Detism),
+ goal_info_add_feature(feature_preserve_backtrack_into,
+ GoalInfo0, GoalInfo).
+
%-----------------------------------------------------------------------------%
% Build the following goal : handle_event_EVENT(ProcId, Arguments).
@@ -1152,7 +1079,7 @@ commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo, !ModuleInfo,
vartypes::in, vartypes::out) is det.
make_handle_event(HandleTypeString, Arguments, HandleEventGoal, !ModuleInfo,
- !Varset, !Vartypes) :-
+ !VarSet, !VarTypes) :-
SSDBModule = mercury_ssdb_builtin_module,
Features = [],
Context = term.context_init,
@@ -1162,7 +1089,7 @@ make_handle_event(HandleTypeString, Arguments, HandleEventGoal, !ModuleInfo,
HandleEventGoal).
% make_proc_id_construction(ModuleInfo, PredInfo, Goals, Var,
- % !Varset, !Vartypes)
+ % !VarSet, !VarTypes)
%
% Returns a set of goals, Goals, which build the ssdb_proc_id structure
% for the given pred and proc infos. The Var returned holds the
@@ -1173,7 +1100,7 @@ make_handle_event(HandleTypeString, Arguments, HandleEventGoal, !ModuleInfo,
vartypes::in, vartypes::out) is det.
make_proc_id_construction(ModuleInfo, PredInfo, Goals, ProcIdVar,
- !Varset, !Vartypes) :-
+ !VarSet, !VarTypes) :-
pred_info_get_origin(PredInfo, Origin),
(
Origin = origin_transformed(transform_source_to_source_debug, _,
@@ -1189,36 +1116,23 @@ make_proc_id_construction(ModuleInfo, PredInfo, Goals, ProcIdVar,
PredName = pred_info_name(OrigPredInfo),
make_string_const_construction_alloc(ModuleName, yes("ModuleName"),
- ConstructModuleName, ModuleNameVar, !Varset, !Vartypes),
+ ConstructModuleName, ModuleNameVar, !VarSet, !VarTypes),
make_string_const_construction_alloc(PredName, yes("PredName"),
- ConstructPredName, PredNameVar, !Varset, !Vartypes),
+ ConstructPredName, PredNameVar, !VarSet, !VarTypes),
SSDBModule = mercury_ssdb_builtin_module,
TypeCtor = type_ctor(qualified(SSDBModule, "ssdb_proc_id"), 0),
- svvarset.new_named_var("ProcId", ProcIdVar, !Varset),
+ svvarset.new_named_var("ProcId", ProcIdVar, !VarSet),
ConsId = cons(qualified(SSDBModule, "ssdb_proc_id"), 2, TypeCtor),
construct_type(TypeCtor, [], ProcIdType),
- svmap.det_insert(ProcIdVar, ProcIdType, !Vartypes),
+ svmap.det_insert(ProcIdVar, ProcIdType, !VarTypes),
construct_functor(ProcIdVar, ConsId, [ModuleNameVar, PredNameVar],
ConstructProcIdGoal),
Goals = [ConstructModuleName, ConstructPredName, ConstructProcIdGoal].
- % make_fail_call(FailGoal, ModuleInfo)
- %
- % Construct the fail goal.
- %
-:- pred make_fail_call(hlds_goal::out, module_info::in) is det.
-
-make_fail_call(FailGoal, ModuleInfo) :-
- Features = [],
- Context = term.context_init,
- goal_util.generate_simple_call(mercury_public_builtin_module,
- "false", pf_predicate, only_mode, detism_failure, purity_pure, [],
- Features, instmap_delta_bind_no_var, ModuleInfo, Context, FailGoal).
-
% Detect if all argument's mode are fully input or output.
% XXX Other mode than fully input or output are not handled for the
% moment. So the code of these procedures will not be generated.
@@ -1242,7 +1156,7 @@ check_arguments_modes(ModuleInfo, HeadModes) :-
%
% make_arg_list(Pos, InstMap, Vars, RenamedVar, FullListVar, Goals,
- % !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes, !BoundedVarDesc)
+ % !ModuleInfo, !ProcInfo, !PredInfo, !VarSet, !VarTypes, !BoundedVarDesc)
%
% Processes each variable in Vars creating a list(var_value) named
% FullListVar which records the value of each of the variables. Vars points
@@ -1265,22 +1179,22 @@ check_arguments_modes(ModuleInfo, HeadModes) :-
map(prog_var, prog_var)::in, map(prog_var, prog_var)::out) is det.
make_arg_list(_Pos, _InstMap, [], _Renaming, OutVar, [Goal], !ModuleInfo,
- !ProcInfo, !PredInfo, !Varset, !Vartypes, !BoundVarDescs) :-
- svvarset.new_named_var("EmptyVarList", OutVar, !Varset),
- svmap.det_insert(OutVar, list_var_value_type, !Vartypes),
+ !ProcInfo, !PredInfo, !VarSet, !VarTypes, !BoundVarDescs) :-
+ svvarset.new_named_var("EmptyVarList", OutVar, !VarSet),
+ svmap.det_insert(OutVar, list_var_value_type, !VarTypes),
ListTypeSymName = qualified(mercury_list_module, "list"),
ListTypeCtor = type_ctor(ListTypeSymName, 1),
ConsId = cons(qualified(mercury_list_module, "[]" ), 0, ListTypeCtor),
construct_functor(OutVar, ConsId, [], Goal).
make_arg_list(Pos0, InstMap, [ProgVar | ProgVars], Renaming, OutVar,
- Goals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes,
+ Goals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet, !VarTypes,
!BoundVarDescs) :-
Pos = Pos0 + 1,
make_arg_list(Pos, InstMap, ProgVars, Renaming, OutVar0, Goals0,
- !ModuleInfo, !ProcInfo, !PredInfo, !Varset, !Vartypes, !BoundVarDescs),
+ !ModuleInfo, !ProcInfo, !PredInfo, !VarSet, !VarTypes, !BoundVarDescs),
- map.lookup(!.Vartypes, ProgVar, ProgVarType),
+ map.lookup(!.VarTypes, ProgVar, ProgVarType),
(
( ProgVarType = io_state_type
; ProgVarType = io_io_type
@@ -1299,12 +1213,12 @@ make_arg_list(Pos0, InstMap, [ProgVar | ProgVars], Renaming, OutVar,
VarDesc = ExistingVarDesc
;
make_var_value(InstMap, ProgVar, Renaming, VarDesc, Pos0,
- ValueGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
- !Vartypes, !BoundVarDescs)
+ ValueGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
+ !VarTypes, !BoundVarDescs)
),
- svvarset.new_named_var("FullListVar", OutVar, !Varset),
- svmap.det_insert(OutVar, list_var_value_type, !Vartypes),
+ svvarset.new_named_var("FullListVar", OutVar, !VarSet),
+ svmap.det_insert(OutVar, list_var_value_type, !VarTypes),
ListTypeSymName = qualified(mercury_list_module, "list"),
ListTypeCtor = type_ctor(ListTypeSymName, 1),
ConsId = cons(qualified(unqualified("list"), "[|]" ), 2, ListTypeCtor),
@@ -1369,7 +1283,7 @@ make_var_value(InstMap, VarToInspect, Renaming, VarDesc, VarPos, Goals,
term.context_init(Context),
map.lookup(!.VarTypes, VarToInspect, MerType),
polymorphism_make_type_info_var(MerType, Context, TypeInfoVar,
- TypeInfoGoal, PolyInfo0, PolyInfo),
+ TypeInfoGoals0, PolyInfo0, PolyInfo),
poly_info_extract(PolyInfo, !PredInfo, !ProcInfo, !:ModuleInfo),
proc_info_get_varset(!.ProcInfo, !:VarSet),
@@ -1390,7 +1304,15 @@ make_var_value(InstMap, VarToInspect, Renaming, VarDesc, VarPos, Goals,
construct_functor(VarDesc, ConsId, [TypeInfoVar, VarNameVar,
VarPosVar, RenamedVar], ConstructVarGoal)
),
- Goals = [ConstructVarName, ConstructVarPos | TypeInfoGoal] ++
+
+ % The type_info of an existentally typed variable is an output, so
+ % could be renamed away. The exit port handler is called before the
+ % assignment of the original type_info variable, so we need to use the
+ % renamed variable here.
+ rename_vars_in_goals(need_not_rename, Renaming, TypeInfoGoals0,
+ TypeInfoGoals),
+
+ Goals = [ConstructVarName, ConstructVarPos | TypeInfoGoals] ++
[ConstructVarGoal],
svmap.det_insert(VarToInspect, VarDesc, !BoundVarDescs)
;
diff --git a/compiler/tupling.m b/compiler/tupling.m
index 7a59ac3..cc2de4a 100644
--- a/compiler/tupling.m
+++ b/compiler/tupling.m
@@ -737,8 +737,6 @@ insert_proc_start_deconstruction(Goal0, Goal, !VarSet, !VarTypes,
create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, Counter,
AuxPredProcId, CallAux, ModuleInfo0, ModuleInfo) :-
- module_info_get_name(ModuleInfo0, ModuleName),
-
proc_info_get_headvars(ProcInfo, AuxHeadVars),
proc_info_get_goal(ProcInfo, Goal @ hlds_goal(_GoalExpr, GoalInfo)),
proc_info_get_initial_instmap(ProcInfo, ModuleInfo0,
@@ -753,19 +751,16 @@ create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, Counter,
pred_info_get_origin(PredInfo, OrigOrigin),
pred_info_get_var_name_remap(PredInfo, VarNameRemap),
+ PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Context = goal_info_get_context(GoalInfo),
term.context_line(Context, Line),
- proc_id_to_int(ProcId, ProcNo),
- AuxNamePrefix = string.format("tupling_%d", [i(ProcNo)]),
- make_pred_name_with_context(ModuleName, AuxNamePrefix,
- PredOrFunc, PredName, Line, Counter, AuxPredSymName),
- (
- AuxPredSymName = unqualified(AuxPredName)
- ;
- AuxPredSymName = qualified(_ModuleSpecifier, AuxPredName)
- ),
+ make_pred_name_with_context(PredModule, "tupling",
+ PredOrFunc, PredName, Line, Counter, AuxPredSymName0),
+ hlds_pred.proc_id_to_int(ProcId, ProcNo),
+ Suffix = string.format("_%d", [i(ProcNo)]),
+ add_sym_name_suffix(AuxPredSymName0, Suffix, AuxPredSymName),
Origin = origin_transformed(transform_tuple(ProcNo), OrigOrigin, PredId),
hlds_pred.define_new_pred(
@@ -775,7 +770,7 @@ create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, Counter,
AuxHeadVars, % in
_ExtraArgs, % out
InitialAuxInstMap, % in
- AuxPredName, % in
+ AuxPredSymName, % in
TVarSet, % in
VarTypes, % in
ClassContext, % in
diff --git a/compiler/untupling.m b/compiler/untupling.m
index 9862e3d..ab2c8ea 100644
--- a/compiler/untupling.m
+++ b/compiler/untupling.m
@@ -410,8 +410,6 @@ build_untuple_map([_| _], [], !_) :-
create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, Counter,
AuxPredId, AuxProcId, CallAux, AuxPredInfo, AuxProcInfo,
!ModuleInfo) :-
- module_info_get_name(!.ModuleInfo, ModuleName),
-
proc_info_get_headvars(ProcInfo, AuxHeadVars),
proc_info_get_goal(ProcInfo, Goal @ hlds_goal(_GoalExpr, GoalInfo)),
proc_info_get_initial_instmap(ProcInfo, !.ModuleInfo, InitialAuxInstMap),
@@ -425,23 +423,20 @@ create_aux_pred(PredId, ProcId, PredInfo, ProcInfo, Counter,
pred_info_get_origin(PredInfo, OrigOrigin),
pred_info_get_var_name_remap(PredInfo, VarNameRemap),
+ PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Context = goal_info_get_context(GoalInfo),
term.context_line(Context, Line),
+ make_pred_name_with_context(PredModule, "untupling",
+ PredOrFunc, PredName, Line, Counter, AuxPredSymName0),
proc_id_to_int(ProcId, ProcNo),
- AuxNamePrefix = string.format("untupling_%d", [i(ProcNo)]),
- make_pred_name_with_context(ModuleName, AuxNamePrefix,
- PredOrFunc, PredName, Line, Counter, AuxPredSymName),
- (
- AuxPredSymName = unqualified(AuxPredName)
- ;
- AuxPredSymName = qualified(_ModuleSpecifier, AuxPredName)
- ),
+ Suffix = string.format("_%d", [i(ProcNo)]),
+ add_sym_name_suffix(AuxPredSymName0, Suffix, AuxPredSymName),
Origin = origin_transformed(transform_untuple(ProcNo), OrigOrigin, PredId),
hlds_pred.define_new_pred(Origin, Goal, CallAux, AuxHeadVars, _ExtraArgs,
- InitialAuxInstMap, AuxPredName, TVarSet, VarTypes, ClassContext,
+ InitialAuxInstMap, AuxPredSymName, TVarSet, VarTypes, ClassContext,
RttiVarMaps, VarSet, InstVarSet, Markers, address_is_not_taken,
VarNameRemap, !ModuleInfo, proc(AuxPredId, AuxProcId)),
diff --git a/compiler/unused_args.m b/compiler/unused_args.m
index 82c239d..376c281 100644
--- a/compiler/unused_args.m
+++ b/compiler/unused_args.m
@@ -1140,8 +1140,7 @@ make_new_pred_info(ModuleInfo, UnusedArgs, Status, proc(PredId, ProcId),
TypeName = type_ctor_name(ModuleInfo, TypeCtor),
TypeArity = type_ctor_arity(ModuleInfo, TypeCtor),
string.int_to_string(TypeArity, TypeArityStr),
- TypeModuleString0 = sym_name_to_string(TypeModule),
- string.replace_all(TypeModuleString0, ".", "__", TypeModuleString),
+ TypeModuleString = sym_name_to_string_sep(TypeModule, "__"),
string.append_list([Name0, "_", TypeModuleString, "__", TypeName,
"_", TypeArityStr], Name1)
;
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list