making cfloat__init/1 implicit
Fergus Henderson
fjh at cs.mu.oz.au
Tue Jan 13 01:18:59 AEDT 1998
On 16-Sep-1997, I wrote:
> Currently you cannot pass a variable with inst `free' to a
> procedure that expects an argument of inst `any'; instead
> you must explicitly initialize it with a call to cfloat__init/1
> or the like.
>
> The patch below would fix this. However, it turns out to
> cause more problems than it solves. The reason is that
> mode analsis ends up picking the wrong modes -- it prefers
> the semidet ones above the det ones. This causes determinism
> errors...
>
> We should fix mode analysis to use a more sane algorithm for
> picking which mode to call. Then this change can be committed.
> For now I will leave it uncommitted.
Mode analysis has since been fixed, so here it is again
(modified slightly to resolve some conflicts with other changes).
> --------------------
>
> Extend the support for `any' insts.
>
> 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.
> extras/clpr/cfloat.m:
> Add `cfloat__cfloat_init_any/1'.
cvs -n diff compiler/inst_match.m compiler/modecheck_unify.m compiler/modes.m extras/clpr/cfloat.m
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 1997/10/15 18:28:18
@@ -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) :-
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/09 04:38:59
@@ -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,64 @@
% 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.
+
+ 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)
+ ->
+ InstmapDeltaAL = [Var - InitialInst],
+ instmap_delta_from_assoc_list(InstmapDeltaAL,
+ InstmapDelta),
+ goal_info_set_instmap_delta(GoalInfo0,
+ 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 +1744,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/09 04:39:15
@@ -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).
@@ -959,36 +937,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 +957,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 +973,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 +993,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 +1097,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 +1123,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 */
--
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