[m-rev.] for review: ssdb events for standard library
Peter Wang
novalazy at gmail.com
Thu May 27 14:22:41 AEST 2010
I think this change is safe for 10.04 as well.
Branches: main, 10.04
The source-to-source transformation is disabled on standard library modules
because it would introduce cyclic dependencies between ssdb.m and the standard
library. Disabling the transformation on the standard library is also useful
for maintaining decent performance. However, no events are generated for calls
to standard library procedures.
In this patch, we introduce something like shallow tracing, for standard
library procedures. Before the main ssdebug transformation, we replace calls
and closures involving standard library predicates by local proxy predicates
that simply forward the calls to the original predicates. During the main
ssdebug pass the proxies are transformed as usual, so at runtime they will
generate interface events, but in the guise of the predicates they proxy.
compiler/ssdebug.m:
Add the proxy predicates pass.
Make the main ssdebug transformation handle proxy predicates specially,
so the events look like they come from the original procedure.
Don't perform the ssdebug transformation on procedures with arguments
which are not fully input or fully output. This was previously only
done for semidet procedures.
Remove imports of unused modules.
compiler/hlds_pred.m:
Add pred_info_get_sym_name.
compiler/layout_out.m:
compiler/mercury_compile_middle_passes.m:
Conform to changes.
diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m
index 059998e..f6dd6fc 100644
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -482,7 +482,8 @@
% transformed into disjunctive normal form; this integer
% gives the part number.
)
- ; transform_structure_reuse.
+ ; transform_structure_reuse
+ ; transform_source_to_source_debug.
:- type pred_creation
---> created_by_deforestation
@@ -796,6 +797,8 @@
:- pred pred_info_get_call_id(pred_info::in, simple_call_id::out) is det.
+:- pred pred_info_get_sym_name(pred_info::in, sym_name::out) is det.
+
% Create an empty set of markers.
%
:- pred init_markers(pred_markers::out) is det.
@@ -1579,10 +1582,14 @@ pred_info_get_univ_quant_tvars(PredInfo, UnivQVars) :-
pred_info_get_call_id(PredInfo, SimpleCallId) :-
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ pred_info_get_sym_name(PredInfo, SymName),
+ Arity = pred_info_orig_arity(PredInfo),
+ SimpleCallId = simple_call_id(PredOrFunc, SymName, Arity).
+
+pred_info_get_sym_name(PredInfo, SymName) :-
Module = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
- Arity = pred_info_orig_arity(PredInfo),
- SimpleCallId = simple_call_id(PredOrFunc, qualified(Module, Name), Arity).
+ SymName = qualified(Module, Name).
%-----------------------------------------------------------------------------%
diff --git a/compiler/layout_out.m b/compiler/layout_out.m
index 8e24112..3c0c3c9 100644
--- a/compiler/layout_out.m
+++ b/compiler/layout_out.m
@@ -2380,6 +2380,7 @@ pred_transform_name(transform_table_generator) = "table_gen".
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".
:- func ints_to_string(list(int)) = string.
diff --git a/compiler/mercury_compile_middle_passes.m b/compiler/mercury_compile_middle_passes.m
index c7d3167..b19714a 100644
--- a/compiler/mercury_compile_middle_passes.m
+++ b/compiler/mercury_compile_middle_passes.m
@@ -856,15 +856,13 @@ maybe_ssdb(Verbose, Stats, !HLDS, !IO) :-
->
maybe_write_string(Verbose,
"% Apply debugging source to source transformation ...\n", !IO),
- process_all_nonimported_procs(
- update_module_io(ssdebug.process_proc), !HLDS, !IO),
+ ssdebug.transform_module(!HLDS, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO),
- % this pass fixes up some incorrect determinisms after applying
- % the transformations
- determinism_pass(!HLDS, _),
- true
+ % XXX This pass fixes up some incorrect determinisms after applying
+ % the transformations.
+ determinism_pass(!HLDS, _)
;
true
).
diff --git a/compiler/ssdebug.m b/compiler/ssdebug.m
index acb310e..207647e 100755
--- a/compiler/ssdebug.m
+++ b/compiler/ssdebug.m
@@ -7,13 +7,11 @@
%-----------------------------------------------------------------------------%
%
% Module: transform_hlds.ssdebug.m.
-% Main authors: oannet.
+% Authors: oannet, wangp.
%
% The ssdebug module does a source to source tranformation on each procedure
% which allows the procedure to be debugged.
%
-% XXX Only user-made procedures are debugged, not yet the library procedures.
-%
% Here is the transformation:
%
% original:
@@ -120,7 +118,6 @@
% )
% ).
%
-%
% detism_erroneous:
%
% p(...) :-
@@ -130,7 +127,6 @@
% <original body>
% ).
%
-%
% where CallVarDescs, ExitVarDescs are lists of var_value
%
% :- type var_value
@@ -150,6 +146,15 @@
%
% The ProcId is of type ssdb.ssdb_proc_id.
%
+% The transformation is disabled on standard library predicates, because it
+% would introduce cyclic dependencies between ssdb.m and the standard library.
+% Programs in ssdebug grades already run rather slowly, so disabling the
+% transformation on the standard library also improves the performance.
+%
+% Instead, for calls to standard library predicates, we create proxy predicates
+% in the calling module and transform those instead. So we will only get
+% events at the interface between non-library and library predicates.
+%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -157,15 +162,10 @@
:- interface.
:- import_module hlds.hlds_module.
-:- import_module hlds.hlds_pred.
:- import_module io.
- % Place the different events (call/exit/fail/redo) around each procedure to
- % allow debugging.
- %
-:- pred ssdebug.process_proc(pred_id::in, proc_id::in,
- proc_info::in, proc_info::out, module_info::in, module_info::out,
+:- pred ssdebug.transform_module(module_info::in, module_info::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -173,32 +173,28 @@
:- implementation.
-:- import_module check_hlds.modes.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.polymorphism.
:- import_module check_hlds.purity.
:- import_module hlds.goal_util.
-:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
:- import_module hlds.instmap.
+:- import_module hlds.passes_aux.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
+:- import_module libs.compiler_util.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.builtin_lib_types.
+:- import_module parse_tree.file_names.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
-:- import_module ssdb.
-
-:- import_module assoc_list.
-:- import_module bool.
:- import_module int.
:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
-:- import_module pair.
-:- import_module require.
:- import_module string.
:- import_module svmap.
:- import_module svvarset.
@@ -207,7 +203,224 @@
%-----------------------------------------------------------------------------%
-process_proc(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+ssdebug.transform_module(!ModuleInfo, !IO) :-
+ create_proxy_predicates(!ModuleInfo),
+ process_all_nonimported_procs(update_module(ssdebug.process_proc),
+ !ModuleInfo, !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Creating proxies for standard library predicates
+%
+
+:- type proxy_map == map(pred_id, maybe(pred_id)).
+
+:- pred create_proxy_predicates(module_info::in, module_info::out) is det.
+
+create_proxy_predicates(!ModuleInfo) :-
+ module_info_predids(PredIds, !ModuleInfo),
+ list.foldl2(create_proxies_in_pred, PredIds, map.init, _ProxyMap,
+ !ModuleInfo).
+
+:- pred create_proxies_in_pred(pred_id::in, proxy_map::in, proxy_map::out,
+ module_info::in, module_info::out) is det.
+
+create_proxies_in_pred(PredId, !ProxyMap, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
+ list.foldl2(create_proxies_in_proc(PredId), ProcIds, !ProxyMap,
+ !ModuleInfo).
+
+:- pred create_proxies_in_proc(pred_id::in, proc_id::in,
+ proxy_map::in, proxy_map::out, module_info::in, module_info::out) is det.
+
+create_proxies_in_proc(PredId, ProcId, !ProxyMap, !ModuleInfo) :-
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId, PredInfo,
+ ProcInfo0),
+ proc_info_get_goal(ProcInfo0, Goal0),
+ create_proxies_in_goal(Goal0, Goal, !ProxyMap, !ModuleInfo),
+ proc_info_set_goal(Goal, ProcInfo0, ProcInfo),
+ module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+ !ModuleInfo).
+
+:- pred create_proxies_in_goal(hlds_goal::in, hlds_goal::out,
+ proxy_map::in, proxy_map::out, module_info::in, module_info::out) is det.
+
+create_proxies_in_goal(!Goal, !ProxyMap, !ModuleInfo) :-
+ !.Goal = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ GoalExpr0 = unify(_, _, _, Unification0, _),
+ (
+ Unification0 = construct(_, ConsId0, _, _, _, _, _),
+ ConsId0 = closure_cons(ShroudedPredProcId, lambda_normal)
+ ->
+ PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
+ PredProcId = proc(PredId, ProcId),
+ lookup_proxy_pred(PredId, MaybeNewPredId, !ProxyMap, !ModuleInfo),
+ (
+ MaybeNewPredId = yes(NewPredId),
+ NewPredProcId = proc(NewPredId, ProcId),
+ NewShroundPredProcId = shroud_pred_proc_id(NewPredProcId),
+ ConsId = closure_cons(NewShroundPredProcId, lambda_normal),
+ Unification = Unification0 ^ construct_cons_id := ConsId,
+ GoalExpr = GoalExpr0 ^ unify_kind := Unification,
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ MaybeNewPredId = no
+ )
+ ;
+ true
+ )
+ ;
+ GoalExpr0 = plain_call(PredId, ProcId, Args, Builtin, Context,
+ _SymName),
+ (
+ Builtin = not_builtin,
+ lookup_proxy_pred(PredId, MaybeNewPredId, !ProxyMap, !ModuleInfo),
+ (
+ MaybeNewPredId = yes(NewPredId),
+ module_info_pred_info(!.ModuleInfo, NewPredId, NewPredInfo),
+ NewModuleName = pred_info_module(NewPredInfo),
+ NewPredName = pred_info_name(NewPredInfo),
+ NewSymName = qualified(NewModuleName, NewPredName),
+ GoalExpr = plain_call(NewPredId, ProcId, Args, Builtin,
+ Context, NewSymName),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ MaybeNewPredId = no
+ )
+ ;
+ Builtin = inline_builtin
+ ;
+ Builtin = out_of_line_builtin
+ )
+ ;
+ GoalExpr0 = generic_call(_, _, _, _)
+ ;
+ GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ GoalExpr0 = conj(ConjType, Goals0),
+ list.map_foldl2(create_proxies_in_goal, Goals0, Goals, !ProxyMap,
+ !ModuleInfo),
+ GoalExpr = conj(ConjType, Goals),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = disj(Goals0),
+ list.map_foldl2(create_proxies_in_goal, Goals0, Goals, !ProxyMap,
+ !ModuleInfo),
+ GoalExpr = disj(Goals),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ list.map_foldl2(create_proxies_in_case, Cases0, Cases, !ProxyMap,
+ !ModuleInfo),
+ GoalExpr = switch(Var, CanFail, Cases),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = negation(SubGoal0),
+ create_proxies_in_goal(SubGoal0, SubGoal, !ProxyMap, !ModuleInfo),
+ GoalExpr = negation(SubGoal),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ create_proxies_in_goal(SubGoal0, SubGoal, !ProxyMap, !ModuleInfo),
+ GoalExpr = scope(Reason, SubGoal),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ create_proxies_in_goal(Cond0, Cond, !ProxyMap, !ModuleInfo),
+ create_proxies_in_goal(Then0, Then, !ProxyMap, !ModuleInfo),
+ create_proxies_in_goal(Else0, Else, !ProxyMap, !ModuleInfo),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = shorthand(_),
+ % These should have been expanded out by now.
+ unexpected(this_file, "create_proxies_in_goal: unexpected shorthand")
+ ).
+
+:- pred create_proxies_in_case(case::in, case::out,
+ proxy_map::in, proxy_map::out, module_info::in, module_info::out) is det.
+
+create_proxies_in_case(Case0, Case, !ProxyMap, !ModuleInfo) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ create_proxies_in_goal(Goal0, Goal, !ProxyMap, !ModuleInfo),
+ Case = case(MainConsId, OtherConsIds, Goal).
+
+ % Look up the proxy for a predicate, creating one if appropriate.
+ %
+:- pred lookup_proxy_pred(pred_id::in, maybe(pred_id)::out,
+ proxy_map::in, proxy_map::out, module_info::in, module_info::out) is det.
+
+lookup_proxy_pred(PredId, MaybeNewPredId, !ProxyMap, !ModuleInfo) :-
+ ( map.search(!.ProxyMap, PredId, MaybeNewPredId0) ->
+ MaybeNewPredId = MaybeNewPredId0
+ ;
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ PredModule = pred_info_module(PredInfo),
+ ( mercury_std_library_module_name(PredModule) ->
+ create_proxy_pred(PredId, NewPredId, !ModuleInfo),
+ MaybeNewPredId = yes(NewPredId)
+ ;
+ MaybeNewPredId = no
+ ),
+ svmap.det_insert(PredId, MaybeNewPredId, !ProxyMap)
+ ).
+
+:- pred create_proxy_pred(pred_id::in, pred_id::out,
+ module_info::in, module_info::out) is det.
+
+create_proxy_pred(PredId, NewPredId, !ModuleInfo) :-
+ some [!PredInfo] (
+ module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
+ pred_info_set_import_status(status_local, !PredInfo),
+
+ ProcIds = pred_info_procids(!.PredInfo),
+ list.foldl2(create_proxy_proc(PredId), ProcIds, !PredInfo, !ModuleInfo),
+
+ % Change the name so that the proxy is not confused with the original.
+ Name = pred_info_name(!.PredInfo),
+ pred_info_set_name("ssdbpr_" ++ Name, !PredInfo),
+
+ % Set the predicate origin so that the later pass can find the name of
+ % the original predicate.
+ pred_info_get_origin(!.PredInfo, Origin),
+ NewOrigin = origin_transformed(transform_source_to_source_debug,
+ Origin, PredId),
+ pred_info_set_origin(NewOrigin, !PredInfo),
+
+ module_info_get_predicate_table(!.ModuleInfo, PredTable0),
+ predicate_table_insert(!.PredInfo, NewPredId, PredTable0, PredTable),
+ module_info_set_predicate_table(PredTable, !ModuleInfo)
+ ).
+
+:- pred create_proxy_proc(pred_id::in, proc_id::in,
+ pred_info::in, pred_info::out, module_info::in, module_info::out) is det.
+
+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),
+ requantify_proc_general(ordinary_nonlocals_no_lambda, !ProcInfo),
+ recompute_instmap_delta_proc(recompute_atomic_instmap_deltas,
+ !ProcInfo, !ModuleInfo),
+ pred_info_set_proc_info(ProcId, !.ProcInfo, !PredInfo)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% The main transformation
+%
+
+:- pred process_proc(pred_id::in, proc_id::in, pred_info::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
+
+process_proc(PredId, ProcId, _PredInfo, !ProcInfo, !ModuleInfo) :-
% We have different transformations for procedures of different
% determinisms.
@@ -220,32 +433,31 @@ process_proc(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
( Determinism = detism_det
; Determinism = detism_cc_multi
),
- process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
+ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo)
;
( Determinism = detism_semi
; Determinism = detism_cc_non
),
- process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
+ process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo)
;
( Determinism = detism_multi
; Determinism = detism_non
),
- process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
+ process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo)
;
Determinism = detism_erroneous,
- process_proc_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
+ process_proc_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo)
;
Determinism = detism_failure,
- process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO)
+ process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo)
).
% Source-to-source transformation for a deterministic goal.
%
:- pred process_proc_det(pred_id::in, proc_id::in,
- proc_info::in, proc_info::out, module_info::in, module_info::out,
- io::di, io::uo) is det.
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
-process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
proc_info_get_goal(!.ProcInfo, BodyGoal0),
BodyGoalInfo0 = get_hlds_goal_info(BodyGoal0),
@@ -255,15 +467,17 @@ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Make the ssdb_proc_id.
module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
- make_proc_id_construction(!.PredInfo, ProcIdGoals, ProcIdVar, !Varset,
- !Vartypes),
+ 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),
- % Make a list which records the value for each of the head variables
- % at the call port.
+ ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
+ % Make a list which records the value for each of the head
+ % variables at the call port.
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, map.init, BoundVarDescsAtCall),
@@ -284,9 +498,9 @@ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
RenamingGoals, _NewVars, Renaming),
rename_some_vars_in_goal(Renaming, BodyGoal0, BodyGoal1),
- % 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 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, FinalInstMap, HeadVars, Renaming, ExitArgListVar,
ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
@@ -300,8 +514,8 @@ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
!ModuleInfo, !Varset, !Vartypes),
% Generate the recursive call in the case of a retry.
- make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId, HeadVars,
- RecursiveGoal),
+ make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
+ HeadVars, RecursiveGoal),
% Organize the order of the generated code.
goal_to_conj_list(BodyGoal1, BodyGoalList),
@@ -309,7 +523,8 @@ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
Determinism = detism_det,
goal_info_init(GoalInfo0),
goal_info_set_determinism(Determinism, GoalInfo0, GoalInfoDet),
- goal_info_set_purity(purity_impure, GoalInfoDet, GoalInfoImpureDet),
+ goal_info_set_purity(purity_impure, GoalInfoDet,
+ GoalInfoImpureDet),
conj_list_to_goal(RenamingGoals, GoalInfoImpureDet, RenamingGoal),
% Create the switch on Retry at exit port.
@@ -324,19 +539,24 @@ process_proc_det(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Add the purity scope.
Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoDet, GoalWithoutPurity, Goal),
+ 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
+ )
).
% Source-to-source transformation for a semidet goal.
%
:- pred process_proc_semi(pred_id::in, proc_id::in,
- proc_info::in, proc_info::out, module_info::in, module_info::out,
- io::di, io::uo) is det.
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
-process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
proc_info_get_goal(!.ProcInfo, BodyGoal0),
get_hlds_goal_info(BodyGoal0) = BodyGoalInfo0,
@@ -353,8 +573,8 @@ process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Make the ssdb_proc_id.
module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
- make_proc_id_construction(!.PredInfo, ProcIdGoals, ProcIdVar,
- !Varset, !Vartypes),
+ 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.
@@ -487,10 +707,9 @@ process_proc_semi(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Source-to-source transformation for a nondeterministic procedure.
%
:- pred process_proc_nondet(pred_id::in, proc_id::in,
- proc_info::in, proc_info::out, module_info::in, module_info::out,
- io::di, io::uo) is det.
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
-process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo) :-
proc_info_get_goal(!.ProcInfo, BodyGoal0),
get_hlds_goal_info(BodyGoal0) = BodyGoalInfo0,
@@ -500,15 +719,18 @@ process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Make the ssdb_proc_id.
module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
- make_proc_id_construction(!.PredInfo, ProcIdGoals, ProcIdVar, !Varset,
- !Vartypes),
+ 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),
+
+ ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
- % Make a list which records the value for each of the head variables
- % at the call port.
+ % Make a list which records the value for each of the head
+ % variables at the call port.
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, map.init, BoundVarDescsAtCall),
@@ -521,9 +743,9 @@ process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Get the InstMap at the end of the procedure.
update_instmap(BodyGoal0, InitInstMap, FinalInstMap),
- % 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 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, FinalInstMap, HeadVars, map.init, ExitArgListVar,
ExitArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, BoundVarDescsAtCall, _BoundVarDescsAtExit),
@@ -564,8 +786,8 @@ process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
goal_to_conj_list(CallVarGoal1, CallVarGoal),
% Generate the recursive call in the case of a retry
- make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId, HeadVars,
- RecursiveGoal),
+ make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
+ HeadVars, RecursiveGoal),
Det = detism_det,
FailDet = detism_failure,
@@ -598,7 +820,8 @@ process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
ConjGoal21 = hlds_goal(conj(plain_conj,
CallVarGoal ++ [DisjGoal1]), GoalInfoImpureDetism),
ConjGoal220 = hlds_goal(conj(plain_conj, FailArgListGoals ++
- [HandleEventFailGoal, SwitchFailPortGoal]), GoalInfoImpureNonDet),
+ [HandleEventFailGoal, SwitchFailPortGoal]),
+ GoalInfoImpureNonDet),
goal_add_feature(feature_preserve_backtrack_into, ConjGoal220,
ConjGoal22),
DisjGoal2 = hlds_goal(disj([ConjGoal21, ConjGoal22]),
@@ -609,37 +832,43 @@ process_proc_nondet(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Add the purity scope.
Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoDetism, GoalWithoutPurity, Goal),
+ wrap_with_purity_scope(Purity, GoalInfoDetism, GoalWithoutPurity,
+ Goal),
commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
!ModuleInfo, !.Varset, !.Vartypes)
+ ;
+ true
+ )
).
% Source-to-source transformation for a failure procedure.
%
:- pred process_proc_failure(pred_id::in, proc_id::in,
- proc_info::in, proc_info::out, module_info::in, module_info::out,
- io::di, io::uo) is det.
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
-process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+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),
+ ( check_arguments_modes(!.ModuleInfo, ListMerMode) ->
% Make the ssdb_proc_id.
module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
- make_proc_id_construction(!.PredInfo, ProcIdGoals, ProcIdVar, !Varset,
- !Vartypes),
+ 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_initial_instmap(!.ProcInfo, !.ModuleInfo,
+ InitInstMap),
- % Make a list which records the value for each of the head variables at
- % the call port.
+ % Make a list which records the value for each of the head
+ % variables at the call port.
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, map.init, BoundVarDescsAtCall),
@@ -648,9 +877,9 @@ process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
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 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),
@@ -666,8 +895,8 @@ process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
make_fail_call(FailGoal, !.ModuleInfo),
% Generate the recursive call in the case of a retry.
- make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId, HeadVars,
- RecursiveGoal),
+ make_recursive_call(!.PredInfo, !.ModuleInfo, PredId, ProcId,
+ HeadVars, RecursiveGoal),
% Organize the order of the generated code.
@@ -676,11 +905,12 @@ process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
Determinism = detism_failure,
goal_info_init(GoalInfo0),
goal_info_set_determinism(Determinism, GoalInfo0, GoalInfoFail),
- goal_info_set_purity(purity_impure, GoalInfoFail, GoalInfoImpureFail),
+ goal_info_set_purity(purity_impure, GoalInfoFail,
+ GoalInfoImpureFail),
% Create the switch on Retry at fail port.
- make_switch_goal(RetryVar, RecursiveGoal, FailGoal, GoalInfoImpureFail,
- SwitchGoal),
+ make_switch_goal(RetryVar, RecursiveGoal, FailGoal,
+ GoalInfoImpureFail, SwitchGoal),
ConjGoal1 = hlds_goal(conj(plain_conj, BodyGoalList),
GoalInfoImpureFail),
@@ -689,47 +919,56 @@ process_proc_failure(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
goal_add_feature(feature_preserve_backtrack_into, ConjGoal20,
ConjGoal2),
- DisjGoal = hlds_goal(disj([ConjGoal1, ConjGoal2]), GoalInfoImpureFail),
+ DisjGoal = hlds_goal(disj([ConjGoal1, ConjGoal2]),
+ GoalInfoImpureFail),
ConjGoals = ProcIdGoals ++ CallArgListGoals ++
[HandleEventCallGoal, DisjGoal],
- conj_list_to_goal(ConjGoals, GoalInfoImpureFail, GoalWithoutPurity),
+ 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),
+ wrap_with_purity_scope(Purity, GoalInfoFail, GoalWithoutPurity,
+ Goal),
commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
!ModuleInfo, !.Varset, !.Vartypes)
+ ;
+ true
+ )
).
% 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,
- io::di, io::uo) is det.
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
-process_proc_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
+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) ->
% Make the ssdb_proc_id.
module_info_pred_info(!.ModuleInfo, PredId, !:PredInfo),
- make_proc_id_construction(!.PredInfo, ProcIdGoals, ProcIdVar, !Varset,
- !Vartypes),
+ 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_initial_instmap(!.ProcInfo, !.ModuleInfo,
+ InitInstMap),
- % Make a list which records the value for each of the head variables at
- % the call port.
+ % Make a list which records the value for each of the head
+ % variables at the call port.
make_arg_list(0, InitInstMap, HeadVars, map.init, CallArgListVar,
CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !Varset,
!Vartypes, map.init, _BoundVarDescsAtCall),
@@ -745,7 +984,8 @@ process_proc_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
goal_info_init(GoalInfo0),
goal_info_set_determinism(DeterminismErr, GoalInfo0,
GoalInfoErr),
- goal_info_set_purity(purity_impure, GoalInfoErr, GoalInfoImpureErr),
+ goal_info_set_purity(purity_impure, GoalInfoErr,
+ GoalInfoImpureErr),
ConjGoals = ProcIdGoals ++ CallArgListGoals ++
[HandleEventCallGoal | BodyGoalList],
@@ -754,10 +994,14 @@ process_proc_erroneous(PredId, ProcId, !ProcInfo, !ModuleInfo, !IO) :-
% Add the purity scope.
Purity = goal_info_get_purity(BodyGoalInfo0),
- wrap_with_purity_scope(Purity, GoalInfoErr, GoalWithoutPurity, Goal),
+ wrap_with_purity_scope(Purity, GoalInfoErr, GoalWithoutPurity,
+ Goal),
commit_goal_changes(Goal, PredId, ProcId, !.PredInfo, !ProcInfo,
!ModuleInfo, !.Varset, !.Vartypes)
+ ;
+ true
+ )
).
%-----------------------------------------------------------------------------%
@@ -875,20 +1119,32 @@ make_handle_event(HandleTypeString, Arguments, HandleEventGoal, !ModuleInfo,
Features, instmap_delta_bind_no_var, !.ModuleInfo, Context,
HandleEventGoal).
- % make_proc_id_construction(PredInfo, Goals, Var, !Varset, !Vartypes)
+ % make_proc_id_construction(ModuleInfo, PredInfo, Goals, Var,
+ % !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
% ssdb_proc_id.
%
-:- pred make_proc_id_construction(pred_info::in, hlds_goals::out,
- prog_var::out, prog_varset::in, prog_varset::out,
+:- pred make_proc_id_construction(module_info::in, pred_info::in,
+ hlds_goals::out, prog_var::out, prog_varset::in, prog_varset::out,
vartypes::in, vartypes::out) is det.
-make_proc_id_construction(PredInfo, Goals, ProcIdVar, !Varset, !Vartypes) :-
- SymModuleName = pred_info_module(PredInfo),
+make_proc_id_construction(ModuleInfo, PredInfo, Goals, ProcIdVar,
+ !Varset, !Vartypes) :-
+ pred_info_get_origin(PredInfo, Origin),
+ (
+ Origin = origin_transformed(transform_source_to_source_debug, _,
+ OrigPredId)
+ ->
+ % This predicate is a proxy for a standard library predicate.
+ module_info_pred_info(ModuleInfo, OrigPredId, OrigPredInfo)
+ ;
+ OrigPredInfo = PredInfo
+ ),
+ SymModuleName = pred_info_module(OrigPredInfo),
ModuleName = sym_name_to_string(SymModuleName),
- PredName = pred_info_name(PredInfo),
+ PredName = pred_info_name(OrigPredInfo),
make_string_const_construction_alloc(ModuleName, yes("ModuleName"),
ConstructModuleName, ModuleNameVar, !Varset, !Vartypes),
@@ -1106,4 +1362,11 @@ make_var_value(InstMap, VarToInspect, Renaming, VarDesc, VarPos, Goals,
).
%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "ssdebug.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module transform_hlds.ssdebug.
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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