diff: improve support for `any' insts
Fergus Henderson
fjh at murlibobo.cs.mu.OZ.AU
Fri Jan 16 17:29:49 AEDT 1998
Here's the final version of this change that I plan to commit.
The changes to modecheck_call.m, dead_proc_elim.m and extras/clpr/samples
are new. The other changes have already been reviewed previously
by Peter Schachte.
Regarding Peter's comment about the use of <foo>_init_any,
I agree that this is not an elegant interface. Unfortunately
doing a nicer interface would take too much work.
For the moment, I think we should treat this as an
internal feature of the compiler, for use by `cfloat.m'.
We should not document it in the language reference manual.
------------------------------------------------------------------------------
Estimated hours taken: 16
Extend the support for `any' insts. In particular, allow users to pass
a variable with inst `free' to a procedure that expects an argument of
inst `any' without needing to explicitly initialize it with a call to
cfloat__init/1 or the like.
compiler/inst_match.m:
compiler/modes.m:
Allow `free' insts to be passed where `any' insts are expected.
This is basically a special case of implied modes.
We insert code to initialize the variable to inst `any' by
calling `<mod>:<type>_init_any'/1, where `<mod>:<type>' is
the type of the variable.
compiler/modes.m:
compiler/modecheck_unify.m:
Change the `extra_goals' type to allow goals to be inserted
before the main goal, as well as appended after it.
This is needed for inserting calls to `<mod>:<type>_init_any'/1.
compiler/dead_proc_elim.m:
Don't eliminate `<foo>_init_any/1' predicates, since modes.m
may insert calls to them.
compiler/modecheck_call.m:
Change the algorithm for choosing which mode to call so that
it takes the inst of the actual argument into account
when choosing between pairs of initial insts such as
`free' and `any'. This is necessary now that `free'
can be passed to `any' and vice versa. Without this change,
mode analysis picks the wrong modes.
extras/clpr/cfloat.m:
Add `cfloat__cfloat_init_any/1'.
extras/clpr/samples/fib.m:
extras/clpr/samples/mortgage.m:
extras/clpr/samples/sum_list.m:
Delete some calls to cfloat__init/1 that are now unnecessary.
extras/clpr/samples/mortgage.exp:
Update the expected output, because the `_v<n>' variable
numbers have changed -- we now create fewer solver variables
for this test case.
cvs diff compiler/dead_proc_elim.m compiler/inst_match.m compiler/modecheck_call.m compiler/modecheck_unify.m compiler/modes.m extras/clpr/cfloat.m extras/clpr/samples/fib.m extras/clpr/samples/mortgage.exp extras/clpr/samples/mortgage.m extras/clpr/samples/sum_list.m
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.33
diff -u -r1.33 dead_proc_elim.m
--- 1.33 1997/12/19 03:06:11
+++ dead_proc_elim.m 1998/01/16 06:25:25
@@ -49,7 +49,7 @@
:- implementation.
:- import_module hlds_pred, hlds_goal, hlds_data, prog_data, llds.
:- import_module passes_aux, globals, options, code_util.
-:- import_module int, list, set, queue, map, bool, std_util, require.
+:- import_module int, string, list, set, queue, map, bool, std_util, require.
%-----------------------------------------------------------------------------%
@@ -680,6 +680,8 @@
module_info_pred_info(ModuleInfo, PredId, PredInfo),
(
pred_info_module(PredInfo, PredModule),
+ pred_info_name(PredInfo, PredName),
+ pred_info_arity(PredInfo, PredArity),
(
% Don't eliminate special preds since they won't
% be actually called from the HLDS until after
@@ -695,9 +697,14 @@
% aren't used.
\+ pred_info_is_imported(PredInfo),
\+ pred_info_import_status(PredInfo, opt_imported)
+ ;
+ % Don't eliminate <foo>_init_any/1 predicates;
+ % modes.m may insert calls to them to initialize
+ % variables from inst `free' to inst `any'.
+ string__remove_suffix(PredName, "_init_any"),
+ PredArity = 1
)
->
- pred_info_name(PredInfo, PredName),
set__insert(NeededNames0, qualified(PredModule, PredName),
NeededNames),
queue__put(Q0, PredId, Q)
Index: compiler/inst_match.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_match.m,v
retrieving revision 1.38
diff -u -r1.38 inst_match.m
--- 1.38 1997/09/29 06:12:36
+++ inst_match.m 1998/01/15 18:52:46
@@ -12,13 +12,15 @@
/*
The handling of `any' insts is not complete. (See also inst_util.m)
-It would be nice to allow `free' to match `any', but right now we don't.
+It would be nice to allow `free' to match `any', but right now we
+only allow a few special cases of that.
The reason is that although the mode analysis would be pretty
straight-forward, generating the correct code is quite a bit trickier.
modes.m would have to be changed to handle the implicit
conversions from `free'/`bound'/`ground' to `any' at
(1) procedure calls (this is just an extension of implied modes)
+ currently we support only the easy cases of this
(2) the end of branched goals
(3) the end of predicates.
@@ -291,21 +293,11 @@
inst_matches_initial_3(any(UniqA), any(UniqB), _, _) :-
unique_matches_initial(UniqA, UniqB).
inst_matches_initial_3(any(_), free, _, _).
-inst_matches_initial_3(free, any(Uniq), _, _) :-
- /* we do not yet allow `free' to match `any',
- unless the `any' is `clobbered_any' or `mostly_clobbered_any' */
- ( Uniq = clobbered ; Uniq = mostly_clobbered ).
+inst_matches_initial_3(free, any(_), _, _).
inst_matches_initial_3(free, free, _, _).
inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), ModuleInfo, _) :-
unique_matches_initial(UniqA, UniqB),
- bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo),
- /* we do not yet allow `free' to match `any',
- unless the `any' is `clobbered_any' or `mostly_clobbered_any' */
- ( ( UniqB = clobbered ; UniqB = mostly_clobbered ) ->
- true
- ;
- bound_inst_list_is_ground_or_any(ListA, ModuleInfo)
- ).
+ bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo).
inst_matches_initial_3(bound(_Uniq, _List), free, _, _).
inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo,
Expansions) :-
@@ -526,14 +518,18 @@
inst_matches_final_3(any(UniqA), any(UniqB), _, _) :-
unique_matches_final(UniqA, UniqB).
inst_matches_final_3(free, any(Uniq), _, _) :-
- /* we do not yet allow `free' to match `any',
- unless the `any' is `clobbered_any' or `mostly_clobbered_any' */
+ % We do not yet allow `free' to match `any',
+ % unless the `any' is `clobbered_any' or `mostly_clobbered_any'.
+ % Amoung other things, changing this would break compare_inst
+ % in modecheck_call.m.
( Uniq = clobbered ; Uniq = mostly_clobbered ).
inst_matches_final_3(free, free, _, _).
inst_matches_final_3(bound(UniqA, ListA), any(UniqB), ModuleInfo, _) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo),
- /* we do not yet allow `free' to match `any' */
+ % We do not yet allow `free' to match `any'.
+ % Amoung other things, changing this would break compare_inst
+ % in modecheck_call.m.
bound_inst_list_is_ground_or_any(ListA, ModuleInfo).
inst_matches_final_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo,
Expansions) :-
Index: compiler/modecheck_call.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_call.m,v
retrieving revision 1.20
diff -u -r1.20 modecheck_call.m
--- 1.20 1998/01/05 07:26:17
+++ modecheck_call.m 1998/01/15 19:06:43
@@ -241,7 +241,7 @@
RevMatchingProcIds = [_|_],
list__reverse(RevMatchingProcIds, MatchingProcIds),
choose_best_match(MatchingProcIds, PredId, Procs,
- TheProcId, ModeInfo2),
+ ArgVars0, TheProcId, ModeInfo2),
map__lookup(Procs, TheProcId, ProcInfo),
modecheck_end_of_call(ProcInfo, ArgVars0, ArgVars,
ExtraGoals, ModeInfo2, ModeInfo3)
@@ -450,6 +450,7 @@
pred_info_procedures(PredInfo, Procs),
map__lookup(Procs, ProcId, ProcInfo),
map__lookup(Procs, OtherProcId, OtherProcInfo),
+
%
% Compare the initial insts of the arguments
%
@@ -458,9 +459,10 @@
mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo,
OtherInitialInsts),
- compare_inst_list(InitialInsts, OtherInitialInsts, CompareInsts,
- ModuleInfo),
+ compare_inst_list(InitialInsts, OtherInitialInsts, no,
+ CompareInsts, ModuleInfo),
CompareInsts = same,
+
%
% Compare the expected livenesses of the arguments
%
@@ -468,6 +470,7 @@
get_arg_lives(OtherProcArgModes, ModuleInfo, OtherProcArgLives),
compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
CompareLives = same,
+
%
% Compare the determinisms --
% If both are cc_, or if both are not cc_,
@@ -491,13 +494,16 @@
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 (ground -> ...) 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.
+ Also prefer a (any -> ...) mode over a (free -> ...) mode,
+ unless the actual argument is free, in which case prefer
+ the (free -> ...) mode.
- 2. Prioritize them by determinism, according to the standard
+ 2. If neither is prefered over the other by step 1, then
+ prioritize them by determinism, according to the standard
partial order (best first):
erroneous
@@ -518,14 +524,14 @@
; 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,
+:- pred choose_best_match(list(proc_id), pred_id, proc_table, list(var),
+ proc_id, mode_info).
+:- mode choose_best_match(in, in, in, in, out,
mode_info_ui) is det.
-choose_best_match([], _, _, _, _) :-
+choose_best_match([], _, _, _, _, _) :-
error("choose_best_match: no best match").
-choose_best_match([ProcId | ProcIds], PredId, Procs, TheProcId,
+choose_best_match([ProcId | ProcIds], PredId, Procs, ArgVars, TheProcId,
ModeInfo) :-
%
% This ProcId is best iff there is no other proc_id which is better.
@@ -533,13 +539,14 @@
(
\+ (
list__member(OtherProcId, ProcIds),
- compare_proc(OtherProcId, ProcId, better,
+ compare_proc(OtherProcId, ProcId, ArgVars, better,
Procs, ModeInfo)
)
->
TheProcId = ProcId
;
- choose_best_match(ProcIds, PredId, Procs, TheProcId, ModeInfo)
+ choose_best_match(ProcIds, PredId, Procs, ArgVars, TheProcId,
+ ModeInfo)
).
%
@@ -550,10 +557,10 @@
% The code for this is similar to the code for
% modes_are_indistiguisable/4 above.
%
-:- pred compare_proc(proc_id, proc_id, match, proc_table, mode_info).
-:- mode compare_proc(in, in, out, in, mode_info_ui) is det.
+:- pred compare_proc(proc_id, proc_id, list(var), match, proc_table, mode_info).
+:- mode compare_proc(in, in, in, out, in, mode_info_ui) is det.
-compare_proc(ProcId, OtherProcId, Compare, Procs, ModeInfo) :-
+compare_proc(ProcId, OtherProcId, ArgVars, Compare, Procs, ModeInfo) :-
map__lookup(Procs, ProcId, ProcInfo),
map__lookup(Procs, OtherProcId, OtherProcInfo),
%
@@ -565,8 +572,9 @@
mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts),
mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo,
OtherInitialInsts),
- compare_inst_list(InitialInsts, OtherInitialInsts, CompareInsts,
- ModuleInfo),
+ get_var_insts_and_lives(ArgVars, ModeInfo, ArgInitialInsts, _ArgLives),
+ compare_inst_list(InitialInsts, OtherInitialInsts, yes(ArgInitialInsts),
+ CompareInsts, ModuleInfo),
%
% Compare the expected livenesses of the arguments
%
@@ -590,17 +598,31 @@
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.
+:- pred compare_inst_list(list(inst), list(inst), maybe(list(inst)), match,
+ module_info).
+:- mode compare_inst_list(in, in, in, out, in) is det.
+
+compare_inst_list(InstsA, InstsB, ArgInsts, Result, ModuleInfo) :-
+ ( compare_inst_list_2(InstsA, InstsB, ArgInsts, Result0, ModuleInfo) ->
+ Result = Result0
+ ;
+ error("compare_inst_list: length mis-match")
+ ).
-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),
+:- pred compare_inst_list_2(list(inst), list(inst), maybe(list(inst)), match,
+ module_info).
+:- mode compare_inst_list_2(in, in, in, out, in) is semidet.
+
+compare_inst_list_2([], [], _, same, _).
+compare_inst_list_2([InstA | InstsA], [InstB | InstsB],
+ no, Result, ModuleInfo) :-
+ compare_inst(InstA, InstB, no, Result0, ModuleInfo),
+ compare_inst_list_2(InstsA, InstsB, no, Result1, ModuleInfo),
+ combine_results(Result0, Result1, Result).
+compare_inst_list_2([InstA | InstsA], [InstB | InstsB],
+ yes([ArgInst|ArgInsts]), Result, ModuleInfo) :-
+ compare_inst(InstA, InstB, yes(ArgInst), Result0, ModuleInfo),
+ compare_inst_list_2(InstsA, InstsB, yes(ArgInsts), Result1, ModuleInfo),
combine_results(Result0, Result1, Result).
:- pred compare_liveness_list(list(is_live), list(is_live), match).
@@ -675,10 +697,10 @@
% 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.
+:- pred compare_inst(inst, inst, maybe(inst), match, module_info).
+:- mode compare_inst(in, in, in, out, in) is det.
-compare_inst(InstA, InstB, Result, ModuleInfo) :-
+compare_inst(InstA, InstB, MaybeArgInst, Result, ModuleInfo) :-
% inst_matches_initial(A,B) succeeds iff
% A specifies at least as much information
% and at least as much binding as B --
@@ -701,24 +723,59 @@
%
% 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'.
+ % and vice versa. For these cases, we want to take
+ % the actual inst of the argument into account:
+ % if the argument is `free', we should prefer `free',
+ % but otherwise, we should prefer `any'.
%
- ( inst_matches_final(InstA, InstB, ModuleInfo) ->
- A_mf_B = yes
+ (
+ MaybeArgInst = no,
+ Result0 = same
;
- A_mf_B = no
+ MaybeArgInst = yes(ArgInst),
+ (
+ inst_matches_final(ArgInst, InstA, ModuleInfo)
+ ->
+ Arg_mf_A = yes
+ ;
+ Arg_mf_A = no
+ ),
+ (
+ inst_matches_final(ArgInst, InstB, ModuleInfo)
+ ->
+ Arg_mf_B = yes
+ ;
+ Arg_mf_B = no
+ ),
+ ( Arg_mf_A = yes, Arg_mf_B = no, Result0 = better
+ ; Arg_mf_A = no, Arg_mf_B = yes, Result0 = worse
+ ; Arg_mf_A = yes, Arg_mf_B = yes, Result0 = same
+ ; Arg_mf_A = no, Arg_mf_B = no, Result0 = same
+ )
),
- ( inst_matches_final(InstB, InstA, ModuleInfo) ->
- B_mf_A = yes
+ ( Result0 = same ->
+ %
+ % if the actual arg inst is not available,
+ % or comparing with the arg inst doesn't help,
+ % then compare the two proc insts
+ %
+ ( 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 = better
+ ; A_mf_B = no, B_mf_A = yes, Result = worse
+ ; A_mf_B = no, B_mf_A = no, Result = incomparable
+ ; A_mf_B = yes, B_mf_A = yes, Result = same
+ )
;
- 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
+ Result = Result0
)
).
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.24
diff -u -r1.24 modecheck_unify.m
--- 1.24 1997/10/13 10:24:18
+++ modecheck_unify.m 1997/10/15 18:03:59
@@ -759,8 +759,8 @@
% insert the new unification at
% the start of the extra goals
- ExtraGoals0 = extra_goals(InstMapAfterMain,
- [NewUnifyGoal - GoalInfo]),
+ ExtraGoals0 = extra_goals([], after_goals(InstMapAfterMain,
+ [NewUnifyGoal - GoalInfo])),
% recursive call to handle the remaining variables...
split_complicated_subunifies_2(Vars0, UniModes0,
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.213
diff -u -r1.213 modes.m
--- 1.213 1998/01/05 07:26:19
+++ modes.m 1998/01/16 05:46:45
@@ -265,6 +265,14 @@
:- type extra_goals
---> no_extra_goals
; extra_goals(
+ list(hlds_goal), % goals to insert before
+ % the main goal
+ after_goals % goals to append after
+ % the main goal
+ ).
+:- type after_goals
+ ---> no_after_goals
+ ; after_goals(
instmap, % instmap at end of main goal
list(hlds_goal) % goals to append after
% the main goal
@@ -1005,33 +1013,62 @@
set__to_sorted_list(NonLocals, Vars).
append_extra_goals(no_extra_goals, ExtraGoals, ExtraGoals).
-append_extra_goals(extra_goals(InstMap, AfterGoals),
- no_extra_goals, extra_goals(InstMap, AfterGoals)).
-append_extra_goals(extra_goals(InstMap0, AfterGoals0),
- extra_goals(_InstMap1, AfterGoals1),
- extra_goals(InstMap, AfterGoals)) :-
+append_extra_goals(extra_goals(BeforeGoals, AfterGoals),
+ no_extra_goals, extra_goals(BeforeGoals, AfterGoals)).
+append_extra_goals(extra_goals(BeforeGoals0, AfterGoals0),
+ extra_goals(BeforeGoals1, AfterGoals1),
+ extra_goals(BeforeGoals, AfterGoals)) :-
+ list__append(BeforeGoals0, BeforeGoals1, BeforeGoals),
+ append_after_goals(AfterGoals0, AfterGoals1, AfterGoals).
+
+:- pred append_after_goals(after_goals, after_goals, after_goals).
+:- mode append_after_goals(in, in, out) is det.
+
+append_after_goals(no_after_goals, AfterGoals, AfterGoals).
+append_after_goals(after_goals(InstMap, AfterGoals),
+ no_after_goals, after_goals(InstMap, AfterGoals)).
+append_after_goals(after_goals(InstMap0, AfterGoals0),
+ after_goals(_InstMap1, AfterGoals1),
+ after_goals(InstMap, AfterGoals)) :-
InstMap = InstMap0,
list__append(AfterGoals0, AfterGoals1, AfterGoals).
handle_extra_goals(MainGoal, ExtraGoals, GoalInfo0, Args0, Args,
- InstMapAtStart, _ModeInfo, Goal) :-
+ InstMapAtStart, ModeInfo, Goal) :-
% did we introduced any extra variables (and code)?
(
ExtraGoals = no_extra_goals,
Goal = MainGoal % no
;
- ExtraGoals = extra_goals(InstMapAfterMain, AfterGoals0),
+ ExtraGoals = extra_goals(BeforeGoals0, AfterGoalsInfo0),
+
+ % if there were any goals to be appended after the main goal,
+ % get them and the instmap after the main goal.
+ % If there are no goals to be append after the main goal, then
+ % the current instmap in the mode_info is the instmap
+ % after the main goal.
+ (
+ AfterGoalsInfo0 = after_goals(InstMapAfterMain,
+ AfterGoals0)
+ ;
+ AfterGoalsInfo0 = no_after_goals,
+ mode_info_get_instmap(ModeInfo, InstMapAtEnd),
+ InstMapAfterMain = InstMapAtEnd,
+ AfterGoals0 = []
+ ),
%
% We need to be careful to update the delta-instmaps
% correctly, using the appropriate instmaps:
%
% % InstMapAtStart is here
+ % BeforeGoals,
+ % % we don't know the instmap here,
+ % % but as it happens we don't need it
% main goal,
% % InstMapAfterMain is here
% AfterGoals
- % % _InstMapAtEnd (= the instmap from _ModeInfo)
- % % is here, but as it happens we don't need it
+ % % InstMapAtEnd (from the ModeInfo) is here
%
% recompute the new set of non-local variables for the main goal
@@ -1051,8 +1088,9 @@
% combine the main goal and the extra goals into a conjunction
Goal0 = MainGoal - GoalInfo,
goal_info_get_context(GoalInfo0, Context),
+ handle_extra_goals_contexts(BeforeGoals0, Context, BeforeGoals),
handle_extra_goals_contexts(AfterGoals0, Context, AfterGoals),
- GoalList = [Goal0 | AfterGoals],
+ list__append(BeforeGoals, [Goal0 | AfterGoals], GoalList),
Goal = conj(GoalList)
).
@@ -1563,15 +1601,17 @@
:- mode handle_implied_mode(in, in, in, in, in, in, out, in, out,
mode_info_di, mode_info_uo) is det.
-handle_implied_mode(Var0, VarInst0, VarInst, InitialInst, FinalInst, Det,
+handle_implied_mode(Var0, VarInst0, VarInst, InitialInst0, FinalInst, Det,
Var, ExtraGoals0, ExtraGoals, ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ inst_expand(ModuleInfo0, InitialInst0, InitialInst),
+ inst_expand(ModuleInfo0, VarInst0, VarInst1),
(
% If the initial inst of the variable matches_final
% the initial inst specified in the pred's mode declaration,
% then it's not a call to an implied mode, it's an exact
% match with a genuine mode.
- inst_matches_final(VarInst0, InitialInst, ModuleInfo0)
+ inst_matches_final(VarInst1, InitialInst, ModuleInfo0)
->
Var = Var0,
ExtraGoals = ExtraGoals0,
@@ -1582,7 +1622,69 @@
% instantiated vars, since that would require
% doing a partially instantiated deep copy, and we
% don't know how to do that yet.
- ( inst_is_bound(ModuleInfo0, InitialInst) ->
+ (
+ InitialInst = any(_),
+ inst_is_free(ModuleInfo0, VarInst1)
+ ->
+ % This is the simple case of implied `any' modes,
+ % where the declared mode was `any -> ...'
+ % and the argument passed was `free'
+
+ Var = Var0,
+
+ % Create code to initialize the variable to
+ % inst `any', by calling <mod>:<type>_init_any/1,
+ % where <mod>:<type> is the type of the variable.
+ % XXX We ought to use a more elegant method
+ % XXX than hard-coding the name `<foo>_init_any'.
+
+ mode_info_get_var_types(ModeInfo0, VarTypes0),
+ map__lookup(VarTypes0, Var, VarType),
+
+ mode_info_get_context(ModeInfo0, Context),
+ mode_info_get_mode_context(ModeInfo0, ModeContext),
+ mode_context_to_unify_context(ModeContext, ModeInfo0,
+ UnifyContext),
+ CallUnifyContext = yes(call_unify_context(
+ Var, var(Var), UnifyContext)),
+ (
+ type_to_type_id(VarType, TypeId, _TypeArgs),
+ TypeId = qualified(TypeModule, TypeName) -
+ _TypeArity,
+ string__append(TypeName, "_init_any", PredName),
+ modes__build_call(TypeModule, PredName, [Var],
+ Context, CallUnifyContext, ModuleInfo0,
+ BeforeGoal - GoalInfo0)
+ ->
+ set__singleton_set(NonLocals, Var),
+ goal_info_set_nonlocals(GoalInfo0,
+ NonLocals, GoalInfo1),
+ InstmapDeltaAL = [Var - InitialInst],
+ instmap_delta_from_assoc_list(InstmapDeltaAL,
+ InstmapDelta),
+ goal_info_set_instmap_delta(GoalInfo1,
+ InstmapDelta, GoalInfo),
+ NewExtraGoal = extra_goals(
+ [BeforeGoal - GoalInfo],
+ no_after_goals),
+ append_extra_goals(ExtraGoals0, NewExtraGoal,
+ ExtraGoals),
+ ModeInfo0 = ModeInfo
+ ;
+ % If the type is a type variable,
+ % or there isn't any <mod>:<type>_init_any/1
+ % predicate, then give up.
+ ExtraGoals = ExtraGoals0,
+ set__singleton_set(WaitingVars, Var0),
+ mode_info_error(WaitingVars,
+ mode_error_implied_mode(Var0, VarInst0,
+ InitialInst),
+ ModeInfo0, ModeInfo
+ )
+ )
+ ;
+ inst_is_bound(ModuleInfo0, InitialInst)
+ ->
% This is the case we can't handle
Var = Var0,
ExtraGoals = ExtraGoals0,
@@ -1647,12 +1749,33 @@
% append the goals together in the appropriate order:
% ExtraGoals0, then NewUnify
- NewUnifyExtraGoal = extra_goals(InstMapAfterMain,
- [NewUnifyGoal - GoalInfo]),
+ NewUnifyExtraGoal = extra_goals([], after_goals(
+ InstMapAfterMain,
+ [NewUnifyGoal - GoalInfo])),
append_extra_goals(ExtraGoals0, NewUnifyExtraGoal,
ExtraGoals)
)
).
+
+:- pred modes__build_call(string, string, list(var),
+ term__context, maybe(call_unify_context), module_info,
+ hlds_goal).
+:- mode modes__build_call(in, in, in, in, in, in, out) is semidet.
+
+modes__build_call(Module, Name, ArgVars, Context, CallUnifyContext, ModuleInfo,
+ Goal) :-
+ module_info_get_predicate_table(ModuleInfo, PredicateTable),
+ list__length(ArgVars, Arity),
+ predicate_table_search_pred_m_n_a(PredicateTable, Module, Name, Arity,
+ [PredId]),
+ hlds_pred__proc_id_to_int(ModeId, 10000), % first mode, must be `det'
+ Call = call(PredId, ModeId, ArgVars, not_builtin, CallUnifyContext,
+ qualified(Module, Name)),
+ goal_info_init(GoalInfo0),
+ goal_info_set_context(GoalInfo0, Context, GoalInfo),
+ Goal = Call - GoalInfo.
+
+%-----------------------------------------------------------------------------%
mode_context_to_unify_context(unify(UnifyContext, _), _, UnifyContext).
mode_context_to_unify_context(call(PredId, Arg), ModeInfo,
Index: extras/clpr/cfloat.m
===================================================================
RCS file: /home/mercury1/repository/clpr/cfloat.m,v
retrieving revision 1.16
diff -u -r1.16 cfloat.m
--- 1.16 1997/10/12 13:32:47
+++ cfloat.m 1998/01/15 19:28:09
@@ -68,14 +68,12 @@
:- mode '=='(ca, ca) is semidet.
:- mode '=='(co, ca) is det.
:- mode '=='(ca, co) is det.
-:- mode '=='(co, co) is det.
% disequality
:- pred \==(cfloat, cfloat).
:- mode \==(ca, ca) is semidet.
:- mode \==(co, ca) is det.
:- mode \==(ca, co) is det.
-:- mode \==(co, co) is det.
% addition
:- func '+'(cfloat, cfloat) = cfloat.
@@ -83,10 +81,6 @@
:- mode '+'(ca, co) = ca is det.
:- mode '+'(co, ca) = ca is det.
:- mode '+'(ca, ca) = co is det.
-:- mode '+'(co, co) = ca is det.
-:- mode '+'(ca, co) = co is det.
-:- mode '+'(co, ca) = co is det.
-:- mode '+'(co, co) = co is det.
% subtraction
:- func '-'(cfloat, cfloat) = cfloat.
@@ -94,10 +88,6 @@
:- mode '-'(ca, co) = ca is det.
:- mode '-'(co, ca) = ca is det.
:- mode '-'(ca, ca) = co is det.
-:- mode '-'(co, co) = ca is det.
-:- mode '-'(ca, co) = co is det.
-:- mode '-'(co, ca) = co is det.
-:- mode '-'(co, co) = co is det.
% multiplication
:- func '*'(cfloat, cfloat) = cfloat.
@@ -237,14 +227,12 @@
:- mode cfloat__eq(ca, ca) is semidet.
:- mode cfloat__eq(co, ca) is det.
:- mode cfloat__eq(ca, co) is det.
-:- mode cfloat__eq(co, co) is det.
% X \= Y
:- pred cfloat__diseq(cfloat, cfloat).
:- mode cfloat__diseq(ca, ca) is semidet.
:- mode cfloat__diseq(co, ca) is det.
:- mode cfloat__diseq(ca, co) is det.
-:- mode cfloat__diseq(co, co) is det.
% cfloat__plus(X, Y, Z) is true iff X+Y=Z
:- pred cfloat__plus(cfloat, cfloat, cfloat).
@@ -252,10 +240,6 @@
:- mode cfloat__plus(ca, co, ca) is det.
:- mode cfloat__plus(co, ca, ca) is det.
:- mode cfloat__plus(ca, ca, co) is det.
-:- mode cfloat__plus(co, co, ca) is det.
-:- mode cfloat__plus(ca, co, co) is det.
-:- mode cfloat__plus(co, ca, co) is det.
-:- mode cfloat__plus(co, co, co) is det.
% cfloat__minus(X, Y, Z) is true iff X-Y=Z
:- pred cfloat__minus(cfloat, cfloat, cfloat).
@@ -263,10 +247,6 @@
:- mode cfloat__minus(ca, co, ca) is det.
:- mode cfloat__minus(co, ca, ca) is det.
:- mode cfloat__minus(ca, ca, co) is det.
-:- mode cfloat__minus(co, co, ca) is det.
-:- mode cfloat__minus(ca, co, co) is det.
-:- mode cfloat__minus(co, ca, co) is det.
-:- mode cfloat__minus(co, co, co) is det.
% X*Y=Z
:- pred cfloat__mult(cfloat, cfloat, cfloat).
@@ -299,14 +279,12 @@
:- mode cfloat__plus_float(ca, in, ca) is semidet.
:- mode cfloat__plus_float(co, in, ca) is det.
:- mode cfloat__plus_float(ca, in, co) is det.
-:- mode cfloat__plus_float(co, in, co) is det.
% X-Y=Z
:- pred cfloat__minus_float(cfloat, float, cfloat).
:- mode cfloat__minus_float(ca, in, ca) is semidet.
:- mode cfloat__minus_float(co, in, ca) is det.
:- mode cfloat__minus_float(ca, in, co) is det.
-:- mode cfloat__minus_float(co, in, co) is det.
% X*Y=Z
:- pred cfloat__mult_float(cfloat, float, cfloat).
@@ -364,6 +342,11 @@
X * Y = Z :- cfloat__mult(X, Y, Z).
X / Y = Z :- Y \== 0.0, X = Y * Z.
+% XXX this is a work-around for a bug;
+% without this, it doesn't work if you compile
+% with intermodule optimization enabled.
+:- pragma no_inline(cfloat_init_any/1).
+
cfloat__cfloat_init_any(Svar) :- cfloat__init(Svar).
%----------------------------------------------------------------------------%
@@ -959,36 +942,11 @@
ML_cfloat_init_solver_var(Svar2);
(void) ML_cfloat_plus(Svar1, Svar2, Svar3);
").
-:- pragma c_code(cfloat__plus(Svar1::ca, Svar2::co, Svar3::co),
- "
- ML_cfloat_init_solver_var(Svar2);
- ML_cfloat_init_solver_var(Svar3);
- (void) ML_cfloat_plus(Svar1, Svar2, Svar3);
- ").
:- pragma c_code(cfloat__plus(Svar1::co, Svar2::ca, Svar3::ca),
"
ML_cfloat_init_solver_var(Svar1);
(void) ML_cfloat_plus(Svar1, Svar2, Svar3);
").
-:- pragma c_code(cfloat__plus(Svar1::co, Svar2::ca, Svar3::co),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar3);
- (void) ML_cfloat_plus(Svar1, Svar2, Svar3);
- ").
-:- pragma c_code(cfloat__plus(Svar1::co, Svar2::co, Svar3::ca),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar2);
- (void) ML_cfloat_plus(Svar1, Svar2, Svar3);
- ").
-:- pragma c_code(cfloat__plus(Svar1::co, Svar2::co, Svar3::co),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar2);
- ML_cfloat_init_solver_var(Svar3);
- (void) ML_cfloat_plus(Svar1, Svar2, Svar3);
- ").
:- pragma c_code(cfloat__plus_float(Svar1::ca, Val::in, Svar2::ca),
"
@@ -1004,12 +962,6 @@
ML_cfloat_init_solver_var(Svar2);
(void) ML_cfloat_plus_float(Svar1, Val, Svar2);
").
-:- pragma c_code(cfloat__plus_float(Svar1::co, Val::in, Svar2::co),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar2);
- (void) ML_cfloat_plus_float(Svar1, Val, Svar2);
- ").
:- pragma c_code(cfloat__minus(Svar1::ca, Svar2::ca, Svar3::ca),
@@ -1026,36 +978,11 @@
ML_cfloat_init_solver_var(Svar2);
(void) ML_cfloat_minus(Svar1, Svar2, Svar3);
").
-:- pragma c_code(cfloat__minus(Svar1::ca, Svar2::co, Svar3::co),
- "
- ML_cfloat_init_solver_var(Svar2);
- ML_cfloat_init_solver_var(Svar3);
- (void) ML_cfloat_minus(Svar1, Svar2, Svar3);
- ").
:- pragma c_code(cfloat__minus(Svar1::co, Svar2::ca, Svar3::ca),
"
ML_cfloat_init_solver_var(Svar1);
(void) ML_cfloat_minus(Svar1, Svar2, Svar3);
").
-:- pragma c_code(cfloat__minus(Svar1::co, Svar2::ca, Svar3::co),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar3);
- (void) ML_cfloat_minus(Svar1, Svar2, Svar3);
- ").
-:- pragma c_code(cfloat__minus(Svar1::co, Svar2::co, Svar3::ca),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar2);
- (void) ML_cfloat_minus(Svar1, Svar2, Svar3);
- ").
-:- pragma c_code(cfloat__minus(Svar1::co, Svar2::co, Svar3::co),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar2);
- ML_cfloat_init_solver_var(Svar3);
- (void) ML_cfloat_minus(Svar1, Svar2, Svar3);
- ").
:- pragma c_code(cfloat__minus_float(Svar1::ca, Val::in, Svar2::ca),
"
@@ -1071,12 +998,6 @@
ML_cfloat_init_solver_var(Svar2);
(void) ML_cfloat_minus_float(Svar1, Val, Svar2);
").
-:- pragma c_code(cfloat__minus_float(Svar1::co, Val::in, Svar2::co),
- "
- ML_cfloat_init_solver_var(Svar1);
- ML_cfloat_init_solver_var(Svar2);
- (void) ML_cfloat_minus_float(Svar1, Val, Svar2);
- ").
:- pragma c_code(cfloat__mult(Svar1::ca, Svar2::ca, Svar3::ca),
@@ -1181,11 +1102,6 @@
"
Svar2 = Svar1;
").
-:- pragma c_code(cfloat__eq(Svar1::co, Svar2::co),
- "
- ML_cfloat_init_solver_var(Svar1);
- Svar2 = Svar1;
- ").
:- pragma c_code(cfloat__eq_float(Svar::ca, Val::in),
"
@@ -1212,14 +1128,6 @@
:- pragma c_code(cfloat__diseq(Svar1::ca, Svar2::co),
"{
bool result;
- ML_cfloat_init_solver_var(Svar2);
- ML_cfloat_diseq(Svar1, Svar2, result);
- (void) result; /* result not used */
- }").
-:- pragma c_code(cfloat__diseq(Svar1::co, Svar2::co),
- "{
- bool result;
- ML_cfloat_init_solver_var(Svar1);
ML_cfloat_init_solver_var(Svar2);
ML_cfloat_diseq(Svar1, Svar2, result);
(void) result; /* result not used */
Index: extras/clpr/samples/fib.m
===================================================================
RCS file: /home/mercury1/repository/clpr/samples/fib.m,v
retrieving revision 1.1
diff -u -r1.1 fib.m
--- 1.1 1997/09/03 10:37:29
+++ fib.m 1998/01/16 05:37:05
@@ -11,7 +11,6 @@
:- import_module require, int.
main -->
- { cfloat__init(X) },
{ W == 14.0 },
(
{ fib(W, X) }
@@ -24,7 +23,6 @@
io__write_string("oops\nFib(14) died\n")
),
- { cfloat__init(Y) },
{ Z == 610.0 },
(
{ fib(Y, Z) }
Index: extras/clpr/samples/mortgage.m
===================================================================
RCS file: /home/mercury1/repository/clpr/samples/mortgage.m,v
retrieving revision 1.1
diff -u -r1.1 mortgage.m
--- 1.1 1997/09/03 10:37:35
+++ mortgage.m 1998/01/16 05:37:05
@@ -20,7 +20,6 @@
main1 --> dump_one_solution(goal1).
goal1([P,T,I,B,M], ["P", "T", "I", "B", "M"]) :-
- cfloat__init(M),
P == 999999.0,
T == 360.0,
I == 0.01,
@@ -30,7 +29,6 @@
main2 --> dump_one_solution(goal2).
goal2([P,T,I,B,M], ["P", "T", "I", "B", "M"]) :-
- cfloat__init(M),
P == 999999.0,
T == 360.0,
I == 0.01,
Index: extras/clpr/samples/sum_list.m
===================================================================
RCS file: /home/mercury1/repository/clpr/samples/sum_list.m,v
retrieving revision 1.2
diff -u -r1.2 sum_list.m
--- 1.2 1997/09/14 12:03:51
+++ sum_list.m 1998/01/16 05:37:05
@@ -15,7 +15,6 @@
:- pred goal(list(cfloat)::list_co, list(string)::out) is semidet.
goal([Result], ["Result"]) :-
make_cfloat_list(40, TheList),
- cfloat__init(Result),
sum_list(TheList, Result),
set_list_to_val(1.0, TheList).
--
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