for review: choose best mode, not first mode
Fergus Henderson
fjh at hydra.cs.mu.oz.au
Wed Oct 15 04:04:01 AEST 1997
Hi,
Can someone (Andrew Bromage? Peter Schachte?) please review this one?
----------------------------------------------------------------------
Estimated hours: 6
Change the way mode analysis chooses which mode of a predicate to call.
If there are multiple matching modes, choose the best one, rather
than just the first one. "Best" is determined by comparing the
argument insts and livenesses, and (if that fails) determinism
of all the modes which do match. If two modes are equal, or
incomparable, in this partial ordering, we choose the first one
(according to the order in which they were declared).
Still to do (will be committed seperately): delete the hacks in make_hlds.m
etc. that assign mode numbers with a priority based on determinism.
compiler/modecheck_call.m:
For calls to predicates with multiple modes, find all the modes
which match and select the best one, rather than just picking
the first one that matches.
compiler/det_report.m:
Export compare_determinism/3, for use by modecheck_call.m.
LIMITATIONS:
We've fixed one of the limitations: unique mode declarations
no longer have to precede non-unique mode declarations.
tests/hard_coded/Mmake:
tests/hard_coded/mode_choice.m:
tests/hard_coded/mode_choice.exp:
Some tests cases for this change.
cvs diff -N LIMITATIONS compiler/det_report.m compiler/modecheck_call.m tests/hard_coded/Mmake tests/hard_coded/mode_choice.exp tests/hard_coded/mode_choice.m
Index: LIMITATIONS
===================================================================
RCS file: /home/staff/zs/imp/mercury/LIMITATIONS,v
retrieving revision 1.11
diff -u -r1.11 LIMITATIONS
--- LIMITATIONS 1997/07/27 16:34:34 1.11
+++ LIMITATIONS 1997/10/14 16:58:24
@@ -13,9 +13,6 @@
* It is not possible to give both `cc_multi' and `multi' (or `cc_nondet'
and `nondet') determinisms for the same mode of a predicate.
-* The order of mode declarations is significant.
- Unique mode declarations must precede non-unique mode declarations.
-
* Type inference and mode inference are a bit imperfect.
We are working on eliminating all of these problems.
Index: compiler/det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.41
diff -u -r1.41 det_report.m
--- det_report.m 1997/09/27 19:44:46 1.41
+++ det_report.m 1997/10/14 14:34:03
@@ -92,6 +92,13 @@
%-----------------------------------------------------------------------------%
+:- type det_comparison ---> tighter ; sameas ; looser.
+
+:- pred compare_determinisms(determinism, determinism, det_comparison).
+:- mode compare_determinisms(in, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module hlds_data, type_util, mode_util, inst_match.
@@ -295,11 +302,6 @@
io__write_string("'.\n").
%-----------------------------------------------------------------------------%
-
-:- type det_comparison ---> tighter ; sameas ; looser.
-
-:- pred compare_determinisms(determinism, determinism, det_comparison).
-:- mode compare_determinisms(in, in, out) is det.
compare_determinisms(DeclaredDetism, InferredDetism, CmpDetism) :-
determinism_components(DeclaredDetism, DeclaredCanFail, DeclaredSolns),
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.16
diff -u -r1.16 modecheck_call.m
--- modecheck_call.m 1997/09/15 21:11:50 1.16
+++ modecheck_call.m 1997/10/14 16:52:16
@@ -52,7 +52,8 @@
:- import_module prog_data, hlds_pred, hlds_data, hlds_module, instmap, (inst).
:- import_module mode_info, mode_debug, modes, mode_util, mode_errors.
:- import_module clause_to_proc, inst_match, make_hlds.
-:- import_module map, list, bool, std_util, set.
+:- import_module det_report.
+:- import_module map, list, bool, std_util, set, require.
modecheck_higher_order_pred_call(PredVar, Args0, PredOrFunc, GoalInfo0, Goal)
-->
@@ -186,13 +187,11 @@
->
TheProcId = ProcId,
map__lookup(Procs, ProcId, ProcInfo),
- proc_info_argmodes(ProcInfo, ProcArgModes),
- proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
-
%
% Check that `ArgsVars0' have livenesses which match the
% expected livenesses.
%
+ proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
modecheck_var_list_is_live(ArgVars0, ProcArgLives0, 0,
ModeInfo0, ModeInfo1),
@@ -201,46 +200,54 @@
% initial insts, and set their new final insts (introducing
% extra unifications for implied modes, if necessary).
%
+ proc_info_argmodes(ProcInfo, ProcArgModes),
mode_list_get_initial_insts(ProcArgModes, ModuleInfo,
InitialInsts),
modecheck_var_has_inst_list(ArgVars0, InitialInsts, 0,
ModeInfo1, ModeInfo2),
- mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts),
- modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts,
- ArgVars, ExtraGoals, ModeInfo2, ModeInfo3),
- proc_info_never_succeeds(ProcInfo, NeverSucceeds),
- ( NeverSucceeds = yes ->
- instmap__init_unreachable(Instmap),
- mode_info_set_instmap(Instmap, ModeInfo3, ModeInfo)
- ;
- ModeInfo = ModeInfo3
- )
+
+ modecheck_end_of_call(ProcInfo, ArgVars0, ArgVars,
+ ExtraGoals, ModeInfo2, ModeInfo)
;
% set the current error list to empty (and
% save the old one in `OldErrors'). This is so the
- % test for `Errors = []' in call_pred_2 will work.
+ % test for `Errors = []' in find_matching_modes
+ % will work.
mode_info_get_errors(ModeInfo0, OldErrors),
mode_info_set_errors([], ModeInfo0, ModeInfo1),
- set__init(WaitingVars),
- modecheck_call_pred_2(ProcIds, PredId, Procs, ArgVars0,
- WaitingVars, TheProcId, ArgVars, ExtraGoals,
+ set__init(WaitingVars0),
+ modecheck_find_matching_modes(ProcIds, PredId, Procs, ArgVars0,
+ [], RevMatchingProcIds, WaitingVars0, WaitingVars,
ModeInfo1, ModeInfo2),
+ ( RevMatchingProcIds = [],
+ no_matching_modes(PredId, ArgVars0, WaitingVars,
+ TheProcId, ModeInfo2, ModeInfo3),
+ ArgVars = ArgVars0,
+ ExtraGoals = no_extra_goals
+ ;
+ RevMatchingProcIds = [_|_],
+ list__reverse(RevMatchingProcIds, MatchingProcIds),
+ choose_best_match(MatchingProcIds, PredId, Procs,
+ TheProcId, ModeInfo2),
+ map__lookup(Procs, TheProcId, ProcInfo),
+ modecheck_end_of_call(ProcInfo, ArgVars0, ArgVars,
+ ExtraGoals, ModeInfo2, ModeInfo3)
+ ),
+
% restore the error list, appending any new error(s)
- mode_info_get_errors(ModeInfo2, NewErrors),
+ mode_info_get_errors(ModeInfo3, NewErrors),
list__append(OldErrors, NewErrors, Errors),
- mode_info_set_errors(Errors, ModeInfo2, ModeInfo)
+ mode_info_set_errors(Errors, ModeInfo3, ModeInfo)
).
-:- pred modecheck_call_pred_2(list(proc_id), pred_id, proc_table, list(var),
- set(var), proc_id, list(var), extra_goals,
- mode_info, mode_info).
-:- mode modecheck_call_pred_2(in, in, in, in, in, out, out, out,
- mode_info_di, mode_info_uo) is det.
+:- pred no_matching_modes(pred_id, list(var), set(var), proc_id,
+ mode_info, mode_info).
+:- mode no_matching_modes(in, in, in, out, mode_info_di, mode_info_uo) is det.
-modecheck_call_pred_2([], PredId, _Procs, ArgVars, WaitingVars,
- TheProcId, ArgVars, no_extra_goals, ModeInfo0, ModeInfo) :-
+no_matching_modes(PredId, ArgVars, WaitingVars, TheProcId,
+ ModeInfo0, ModeInfo) :-
%
% There were no matching modes.
% If we're inferring modes for this called predicate, then
@@ -269,8 +276,20 @@
ModeInfo1, ModeInfo)
).
-modecheck_call_pred_2([ProcId | ProcIds], PredId, Procs, ArgVars0, WaitingVars,
- TheProcId, ArgVars, ExtraGoals, ModeInfo0, ModeInfo) :-
+:- pred modecheck_find_matching_modes(
+ list(proc_id), pred_id, proc_table, list(var),
+ list(proc_id), list(proc_id), set(var), set(var),
+ mode_info, mode_info).
+:- mode modecheck_find_matching_modes(in, in, in, in,
+ in, out, in, out, mode_info_di, mode_info_uo) is det.
+
+modecheck_find_matching_modes([], _PredId, _Procs, _ArgVars,
+ MatchingProcIds, MatchingProcIds,
+ WaitingVars, WaitingVars, ModeInfo, ModeInfo).
+
+modecheck_find_matching_modes([ProcId | ProcIds], PredId, Procs, ArgVars0,
+ MatchingProcIds0, MatchingProcIds,
+ WaitingVars0, WaitingVars, ModeInfo0, ModeInfo) :-
% find the initial insts and the final livenesses
% of the arguments for this mode of the called pred
@@ -278,7 +297,6 @@
proc_info_argmodes(ProcInfo, ProcArgModes),
mode_info_get_module_info(ModeInfo0, ModuleInfo),
proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
% check whether the livenesses of the args matches their
% expected liveness
@@ -287,35 +305,52 @@
% check whether the insts of the args matches their expected
% initial insts
+ mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
modecheck_var_has_inst_list(ArgVars0, InitialInsts, 0,
ModeInfo1, ModeInfo2),
+ % If we got an error, reset the error list
+ % and save the list of vars to wait on.
+ % Otherwise, insert the proc_id in the list of matching
+ % proc_ids.
mode_info_get_errors(ModeInfo2, Errors),
(
- % if error(s) occured, keep trying with the other modes
- % for the called pred
Errors = [FirstError | _]
->
- FirstError = mode_error_info(WaitingVars2, _, _, _),
- set__union(WaitingVars, WaitingVars2, WaitingVars3),
+ MatchingProcIds1 = MatchingProcIds0,
mode_info_set_errors([], ModeInfo2, ModeInfo3),
- modecheck_call_pred_2(ProcIds, PredId, Procs, ArgVars0,
- WaitingVars3, TheProcId, ArgVars, ExtraGoals,
- ModeInfo3, ModeInfo)
+ FirstError = mode_error_info(ErrorWaitingVars, _, _, _),
+ set__union(WaitingVars0, ErrorWaitingVars, WaitingVars1)
;
- % if there are no errors, then set their insts to the
- % final insts specified in the mode for the called pred
- mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts),
- modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts,
- ArgVars, ExtraGoals, ModeInfo2, ModeInfo3),
- TheProcId = ProcId,
- proc_info_never_succeeds(ProcInfo, NeverSucceeds),
- ( NeverSucceeds = yes ->
- instmap__init_unreachable(Instmap),
- mode_info_set_instmap(Instmap, ModeInfo3, ModeInfo)
- ;
- ModeInfo = ModeInfo3
- )
+ MatchingProcIds1 = [ProcId | MatchingProcIds0],
+ ModeInfo3 = ModeInfo2,
+ WaitingVars1 = WaitingVars0
+ ),
+
+ % keep trying with the other modes for the called pred
+ modecheck_find_matching_modes(ProcIds, PredId, Procs, ArgVars0,
+ MatchingProcIds1, MatchingProcIds,
+ WaitingVars1, WaitingVars, ModeInfo3, ModeInfo).
+
+:- pred modecheck_end_of_call(proc_info, list(var), list(var), extra_goals,
+ mode_info, mode_info).
+:- mode modecheck_end_of_call(in, in, out, out,
+ mode_info_di, mode_info_uo) is det.
+
+modecheck_end_of_call(ProcInfo, ArgVars0, ArgVars, ExtraGoals,
+ ModeInfo0, ModeInfo) :-
+ proc_info_argmodes(ProcInfo, ProcArgModes),
+ mode_info_get_module_info(ModeInfo0, ModuleInfo),
+ mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
+ mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts),
+ modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts,
+ ArgVars, ExtraGoals, ModeInfo0, ModeInfo1),
+ proc_info_never_succeeds(ProcInfo, NeverSucceeds),
+ ( NeverSucceeds = yes ->
+ instmap__init_unreachable(Instmap),
+ mode_info_set_instmap(Instmap, ModeInfo1, ModeInfo)
+ ;
+ ModeInfo = ModeInfo1
).
:- pred insert_new_mode(pred_id, list(var), proc_id, mode_info, mode_info).
@@ -398,6 +433,244 @@
),
get_var_insts_and_lives(Vars, ModeInfo, Insts, IsLives).
+
+%-----------------------------------------------------------------------------%
+
+/*
+The algorithm for choose_best_match is supposed to be equivalent
+to the following specification:
+
+ 1. Remove any modes that are strictly less instantiated or
+ less informative on input than other valid modes; eg,
+ prefer an (in, in, out) mode over an (out, in, out) mode,
+ but not necessarily over an (out, out, in) mode,
+ and prefer a (free -> ...) mode over a (any -> ...) mode,
+ and prefer a (bound(f) -> ...) mode over a (ground -> ...) mode,
+ and prefer a (... -> dead) mode over a (... -> not dead) mode.
+
+ This is a partial order.
+
+ 2. Prioritize them by determinism, according to the standard
+ partial order (best first):
+
+ erroneous
+ / \
+ det failure
+ / \ /
+ multi semidet
+ \ /
+ nondet
+
+ 3. If there are still multiple possibilities, take them in
+ declaration order.
+*/
+
+:- type match
+ ---> better
+ ; worse
+ ; same
+ ; incomparable.
+
+:- pred choose_best_match(list(proc_id), pred_id, proc_table, proc_id,
+ mode_info).
+:- mode choose_best_match(in, in, in, out,
+ mode_info_ui) is det.
+
+choose_best_match([], _, _, _, _) :-
+ error("choose_best_match: no best match").
+choose_best_match([ProcId | ProcIds], PredId, Procs, TheProcId,
+ ModeInfo) :-
+ %
+ % This ProcId is best iff there is no other proc_id which is better.
+ %
+ (
+ \+ (
+ list__member(OtherProcId, ProcIds),
+ compare_proc(OtherProcId, ProcId, better,
+ Procs, ModeInfo)
+ )
+ ->
+ TheProcId = ProcId
+ ;
+ choose_best_match(ProcIds, PredId, Procs, TheProcId, ModeInfo)
+ ).
+
+ %
+ % Given two modes of a predicate, figure out whether
+ % one of the is a better match than the other,
+ % for calls which could match either mode.
+ %
+:- pred compare_proc(proc_id, proc_id, match, proc_table, mode_info).
+:- mode compare_proc(in, in, out, in, mode_info_ui) is det.
+
+compare_proc(ProcId, OtherProcId, Compare, Procs, ModeInfo) :-
+ map__lookup(Procs, ProcId, ProcInfo),
+ map__lookup(Procs, OtherProcId, OtherProcInfo),
+ %
+ % Compare the initial insts of the arguments
+ %
+ proc_info_argmodes(ProcInfo, ProcArgModes),
+ proc_info_argmodes(OtherProcInfo, OtherProcArgModes),
+ mode_info_get_module_info(ModeInfo, ModuleInfo),
+ mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
+ mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo,
+ OtherInitialInsts),
+ compare_inst_list(InitialInsts, OtherInitialInsts, CompareInsts,
+ ModuleInfo),
+ %
+ % Compare the expected livenesses of the arguments
+ %
+ get_arg_lives(ProcArgModes, ModuleInfo, ProcArgLives),
+ get_arg_lives(OtherProcArgModes, ModuleInfo, OtherProcArgLives),
+ compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
+ %
+ % Compare the determinisms
+ %
+ proc_info_interface_determinism(ProcInfo, Detism),
+ proc_info_interface_determinism(OtherProcInfo, OtherDetism),
+ compare_determinisms(Detism, OtherDetism, CompareDet0),
+ ( CompareDet0 = tighter, CompareDet = better
+ ; CompareDet0 = looser, CompareDet = worse
+ ; CompareDet0 = sameas, CompareDet = same
+ ),
+ %
+ % Combine the results, with the insts & lives comparisons
+ % taking priority over the determinism comparison.
+ %
+ combine_results(CompareInsts, CompareLives, Compare0),
+ prioritized_combine_results(Compare0, CompareDet, Compare).
+
+:- pred compare_inst_list(list(inst), list(inst), match, module_info).
+:- mode compare_inst_list(in, in, out, in) is det.
+
+compare_inst_list([], [], same, _).
+compare_inst_list([_|_], [], _, _) :-
+ error("compare_inst_list: length mis-match").
+compare_inst_list([], [_|_], _, _) :-
+ error("compare_inst_list: length mis-match").
+compare_inst_list([InstA | InstsA], [InstB | InstsB], Result, ModuleInfo) :-
+ compare_inst(InstA, InstB, Result0, ModuleInfo),
+ compare_inst_list(InstsA, InstsB, Result1, ModuleInfo),
+ combine_results(Result0, Result1, Result).
+
+:- pred compare_liveness_list(list(is_live), list(is_live), match).
+:- mode compare_liveness_list(in, in, out) is det.
+
+compare_liveness_list([], [], same).
+compare_liveness_list([_|_], [], _) :-
+ error("compare_liveness_list: length mis-match").
+compare_liveness_list([], [_|_], _) :-
+ error("compare_liveness_list: length mis-match").
+compare_liveness_list([LiveA | LiveAs], [LiveB | LiveBs], Result) :-
+ compare_liveness(LiveA, LiveB, Result0),
+ compare_liveness_list(LiveAs, LiveBs, Result1),
+ combine_results(Result0, Result1, Result).
+
+ %
+ % compare_liveness -- prefer dead to live
+ % (if either is a valid match, then the actual argument
+ % must be dead, so prefer the mode which can take advantage
+ % of that).
+ %
+:- pred compare_liveness(is_live, is_live, match).
+:- mode compare_liveness(in, in, out) is det.
+
+compare_liveness(dead, dead, same).
+compare_liveness(dead, live, better).
+compare_liveness(live, dead, worse).
+compare_liveness(live, live, same).
+
+ %
+ % combine two results, giving priority to the first one
+ %
+:- pred prioritized_combine_results(match, match, match).
+:- mode prioritized_combine_results(in, in, out) is det.
+
+prioritized_combine_results(better, _, better).
+prioritized_combine_results(worse, _, worse).
+prioritized_combine_results(same, Result, Result).
+prioritized_combine_results(incomparable, _, incomparable).
+
+ %
+ % combine two results, giving them equal priority
+ %
+:- pred combine_results(match, match, match).
+:- mode combine_results(in, in, out) is det.
+
+combine_results(better, better, better).
+combine_results(better, same, better).
+combine_results(better, worse, incomparable).
+combine_results(better, incomparable, incomparable).
+combine_results(worse, worse, worse).
+combine_results(worse, same, worse).
+combine_results(worse, better, incomparable).
+combine_results(worse, incomparable, incomparable).
+combine_results(same, Result, Result).
+combine_results(incomparable, _, incomparable).
+
+ %
+ % Compare two initial insts, to figure out which would be a better
+ % match.
+ %
+ % More information is better:
+ % prefer bound(f) to ground
+ % prefer unique to mostly_unique or ground, and
+ % prefer mostly_unique to ground
+ % (unique > mostly_unique > shared > mostly_dead > dead)
+ % More bound is better:
+ % (if both can match, the one which is more bound
+ % is better, because it may be an exact match, whereas
+ % the other one would be an implied mode)
+ % prefer ground to free (i.e. prefer in to out)
+ % prefer ground to any (e.g. prefer in to in(any))
+ % prefer any to free (e.g. prefer any->ground to out)
+
+:- pred compare_inst(inst, inst, match, module_info).
+:- mode compare_inst(in, in, out, in) is det.
+
+compare_inst(InstA, InstB, Result, ModuleInfo) :-
+ % inst_matches_initial(A,B) succeeds iff
+ % A specifies at least as much information
+ % and at least as much binding as B --
+ % with the exception that `any' matches_initial `free'
+ % and perhaps vice versa.
+ ( inst_matches_initial(InstA, InstB, ModuleInfo) ->
+ A_mi_B = yes
+ ;
+ A_mi_B = no
+ ),
+ ( inst_matches_initial(InstB, InstA, ModuleInfo) ->
+ B_mi_A = yes
+ ;
+ B_mi_A = no
+ ),
+ ( A_mi_B = yes, B_mi_A = no, Result = better
+ ; A_mi_B = no, B_mi_A = yes, Result = worse
+ ; A_mi_B = no, B_mi_A = no, Result = incomparable
+ ; A_mi_B = yes, B_mi_A = yes,
+ %
+ % We need to further disambiguate the cases involving
+ % `any' and `free', since `any' matches_initial `free'
+ % and vice versa, but we want to prefer `any'.
+ % We use matches_final, because `free' may match_final `any',
+ % but `any' does not match_final `free'.
+ %
+ ( inst_matches_final(InstA, InstB, ModuleInfo) ->
+ A_mf_B = yes
+ ;
+ A_mf_B = no
+ ),
+ ( inst_matches_final(InstB, InstA, ModuleInfo) ->
+ B_mf_A = yes
+ ;
+ B_mf_A = no
+ ),
+ ( A_mf_B = yes, B_mf_A = no, Result = worse
+ ; A_mf_B = no, B_mf_A = yes, Result = better
+ ; A_mf_B = yes, B_mf_A = yes, Result = same
+ ; A_mf_B = no, B_mf_A = no, Result = incomparable
+ )
+ ).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
cvs diff: I know nothing about tests/hard_coded/Mmake
Index: tests/hard_coded/mode_choice.exp
===================================================================
RCS file: mode_choice.exp
diff -N mode_choice.exp
--- /dev/null Tue Jan 1 15:00:00 1980
+++ mode_choice.exp Wed Oct 15 04:00:53 1997
@@ -0,0 +1,16 @@
+T0: test1(in, out, out)
+T0b: test1(in, out, out)
+T1: test1(in, in, out)
+T2: test2(di, uo)
+T3: test2(in, out)
+T4: test2(in, out)
+T5: test3(in(any), out)
+T6: test3(out(any), out)
+T7: test4(in, out, out)
+T8:
+T9: test4(in, out, out)
+T10:
+T11: test4(out, in, out)
+T12: test5(in(a), in(ab), out)
+T13: test5(in(a), in(ab), out)
+T14: test5(in(ab), in(b), out)
Index: tests/hard_coded/mode_choice.m
===================================================================
RCS file: mode_choice.m
diff -N mode_choice.m
--- /dev/null Tue Jan 1 15:00:00 1980
+++ mode_choice.m Wed Oct 15 04:00:30 1997
@@ -0,0 +1,151 @@
+:- module mode_choice.
+:- interface.
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+
+main -->
+ ( { test1("foo", T0, T0b) } ->
+ print("T0: "), print(T0), nl,
+ print("T0b: "), print(T0b), nl
+ ;
+ print("test1: failed")
+ ),
+ ( { test1("foo", "fooie", T1) } ->
+ print("T1: "), print(T1), nl
+ ;
+ print("test1: failed")
+ ),
+ { test2("bar", T2) },
+ print("T2: "), print(T2), nl,
+ { Z = "z" },
+ { test2(Z, T3) },
+ print("T3: "), print(T3), nl,
+ { test2(Z, T4) },
+ print("T4: "), print(T4), nl,
+ { mkany(Any) },
+ { test3(Any, T5) },
+ print("T5: "), print(T5), nl,
+ { test3(_, T6) },
+ print("T6: "), print(T6), nl,
+ ( { test4("", "", T7) } ->
+ print("T7: "), print(T7), nl
+ ;
+ print("T7 failed\n")
+ ),
+ { test4("", T8, T9) },
+ print("T8: "), print(T8), nl,
+ print("T9: "), print(T9), nl,
+ { test4(T10, "", T11) },
+ print("T10: "), print(T10), nl,
+ print("T11: "), print(T11), nl,
+ { test5("a", "b", T12) },
+ print("T12: "), print(T12), nl,
+ { test5("a", "a", T13) },
+ print("T13: "), print(T13), nl,
+ { test5("b", "b", T14) },
+ print("T14: "), print(T14), nl.
+
+% prefer `in' to `out'
+
+:- pred test1(string, string, string).
+:- mode test1(in, out, out) is semidet.
+:- mode test1(in, in, out) is semidet.
+
+:- pragma c_code(test1(_A::in, B::out, C::out), will_not_call_mercury, "
+ B = C = ""test1(in, out, out)"";
+ SUCCESS_INDICATOR = TRUE;
+").
+
+:- pragma c_code(test1(_A::in, _B::in, C::out), will_not_call_mercury, "
+ C = ""test1(in, in, out)"";
+ SUCCESS_INDICATOR = TRUE;
+").
+
+% prefer `di' to `uo'
+
+:- pred test2(string, string).
+:- mode test2(in, out) is det.
+:- mode test2(di, uo) is det.
+
+:- pragma c_code(test2(_A::in, B::out), will_not_call_mercury, "
+ B = ""test2(in, out)"";
+").
+
+:- pragma c_code(test2(_A::di, B::uo), will_not_call_mercury, "
+ B = ""test2(di, uo)"";
+").
+
+/******* `ui' modes not yet supported
+% prefer `ui' to `in'
+
+:- pred test2b(string, string).
+:- mode test2b(in, out) is det.
+:- mode test2b(ui, uo) is det.
+
+:- pragma c_code(test2b(_A::in, B::out), will_not_call_mercury, "
+ B = ""test2b(in, out)"";
+").
+
+:- pragma c_code(test2(_A::ui, B::out), will_not_call_mercury, "
+ B = ""test2b(ui, out)"";
+").
+*******/
+
+:- pred mkany(string::out(any)) is det.
+:- pragma c_code(mkany(S::out(any)), will_not_call_mercury, "
+ S = NULL;
+").
+
+% prefer in(any) over out(any)
+% [i.e. any -> any beats free -> any]
+
+:- pred test3(string, string).
+:- mode test3(in(any), out) is det.
+:- mode test3(out(any), out) is det.
+
+:- pragma c_code(test3(_A::in(any), B::out), will_not_call_mercury, "
+ B = ""test3(in(any), out)"";
+").
+
+:- pragma c_code(test3(A::out(any), B::out), will_not_call_mercury, "
+ A = NULL;
+ B = ""test3(out(any), out)"";
+").
+
+% for non-comparable modes, pick the first one
+
+:- pred test4(string, string, string).
+:- mode test4(in, out, out) is det.
+:- mode test4(out, in, out) is det.
+
+:- pragma c_code(test4(_A::in, B::out, C::out), will_not_call_mercury, "
+ B = """";
+ C = ""test4(in, out, out)"";
+").
+
+:- pragma c_code(test4(A::out, _B::in, C::out), will_not_call_mercury, "
+ A = """";
+ C = ""test4(out, in, out)"";
+").
+
+% for non-comparable modes, pick the first one
+
+:- inst a == bound("a").
+:- inst b == bound("b").
+:- inst ab == bound("a" ; "b").
+
+:- pred test5(string, string, string).
+:- mode test5(in(a), in(ab), out) is det.
+:- mode test5(in(ab), in(b), out) is det.
+
+:- pragma c_code(test5(_A::in(a), _B::in(ab), C::out), will_not_call_mercury, "
+ C = ""test5(in(a), in(ab), out)"";
+").
+
+:- pragma c_code(test5(_A::in(ab), _B::in(b), C::out), will_not_call_mercury, "
+ C = ""test5(in(ab), in(b), out)"";
+").
+
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
More information about the developers
mailing list