for review: make HLDS mostly well-moded
Simon Taylor
stayl at cs.mu.OZ.AU
Wed Feb 11 00:21:05 AEDT 1998
Hi Fergus,
>
> On 09-Feb-1998, Simon Taylor <stayl at cs.mu.OZ.AU> wrote:
> > compiler/unique_modes.m
> > compiler/hlds_pred.m
> > Added proc_info_inferred_never_succeeds, which checks whether
> > the procedure never succeeds according to the inferred determinism.
> > Use it during unique_mode analysis instead of proc_info_never_succeeds,
> > which uses the declared determinism.
>
> Why?
>
> This changes which programs are considered legal programs.
> Some programs that would previously have been mode-incorrect will become
> mode-correct. At very least some rationale is needed.
tests/valid/same_length_2 is the test case which prompted this change.
proc_info_never_succeeds only uses the declared determinism, since the
inferred determinism may not be available.
The code that causes the problem is
p2(X) :-
r(X::my_output_list_skel),
q(X::my_list_skel_output)
;
r(X::my_output_list_skel),
q(X::my_list_skel_output).
Both r/1 and q/1 do not have determinism declarations. r/1
is inferred to be erroneous. proc_info_never_succeeds looks at
the declared determinism. Since there is none, it assumes that
r/1 can succeed. Since determinism analysis fills in the correct
determinism, simplify.m prunes away the call to q/1 since it
will be never reached. This means that the elements of the list X
are never bound, and unique modes reports an error.
>
> > compiler/special_pred.m
> > library/mercury_builtin.m
> > Make the uniqueness of the comparison_result argument
> > of builtin_compare_* and the automatically generated
> > comparison procedures match that of compare/3. Unique mode
> > errors will still be introduced if any of the unique modes
> > of compare/3 are used.
>
> Could you explain this in a bit more detail?
compare/3 has four modes: compare(uo, in, in), compare(uo, in, ui),
compare(uo, ui, in), compare(uo, ui, ui).
The automatically generated unification procedures implement
only the first of these modes. If one of the other modes of
compare/3 is used and an input argument is required to be
unique after the call, a unique mode error will result if
the code is modechecked after the call to compare/3 is replaced
by a call to the compiler-generated procedure.
>
> > tests/valid/unreachable_code.m
> > Add a test case for a bogus higher-order unification
> > mode error in unreachable code.
>
> Hmm, there were several things described as "bug fixes" in the log message --
> does this test case test for all of them? I'd like to see a regression
> test for each bug you fixed, if possible.
The bugs fixed were found by compiling existing test cases with
--deforestation. Test cases for these bugs are a little hard to
generate, since most unreachable code is removed before the unique
modes - something like deforestation producing unreachable code
is required. The bug in the ordering of the modes of introduced
lambda predicates can only be detected by running mode analysis
after simplification. Do you want me to add an option to do that?
>
> > call_gen__generate_class_method_call(_OuterCodeModel, TCVar, MethodNum, Args,
> > Types, Modes, Det, GoalInfo, Code) -->
> > { determinism_to_code_model(Det, InnerCodeModel) },
> > code_info__get_globals(Globals),
> > code_info__get_module_info(ModuleInfo),
> > +
> > + % XXX must be compact
> > { globals__get_args_method(Globals, ArgsMethod) },
> > { make_arg_infos(ArgsMethod, Types, Modes, InnerCodeModel, ModuleInfo,
> > ArgInfo) },
>
> Good point.
>
> The code should check this and abort if it is not true.
> (Either here, or in runtime/mercury_ho_call.c.)
>
This was checked in call_gen__generate_class_method_call_2. I've moved
the check into call_gen__generate_class_method_call, since that removes
the need to find out which args_method is being used twice.
> > -find_follow_vars_in_goal_2(unify(A,B,C,D,E), ArgsMethod, _ModuleInfo,
> > +find_follow_vars_in_goal_2(unify(A,B,C,D,E), _ModuleInfo,
> > FollowVars0, unify(A,B,C,D,E), FollowVars) :-
> > (
> > - B = var(BVar),
> > - D = complicated_unify(_Mode, CanFail)
> > - ->
> > - determinism_components(Det, CanFail, at_most_one),
> > - determinism_to_code_model(Det, CodeModel),
> > - arg_info__unify_arg_info(ArgsMethod, CodeModel, ArgInfo),
> > - find_follow_vars_from_arginfo(ArgInfo, [A, BVar], FollowVars)
> > - ;
>
> I didn't see anything about that in the log message.
> What's the rationale for this change?
Complicated unifications should have been removed before this,
so there is no need to handle them there. There is plenty of
other code that aborts on complicated unifications, so yet
another assertion is not really required here.
> > +proc_info_inferred_never_succeeds(PredInfo, ProcId, ProcInfo, Result) :-
> > + (
> > + % We don't infer determinism for imported procedures
> > + % or for class_method predicates.
> > + (
> > + pred_info_is_imported(PredInfo)
> > + ;
> > + pred_info_is_pseudo_imported(PredInfo),
> > + hlds_pred__in_in_unification_proc_id(ProcId)
> > + ;
> > + pred_info_get_markers(PredInfo, Markers),
> > + check_marker(Markers, class_method)
> > + )
> > + ->
> > + proc_info_interface_determinism(ProcInfo, Determinism)
> > + ;
> > + proc_info_inferred_determinism(ProcInfo, Determinism)
> > + ),
>
> Hmm, in the cases of imported procedures or class methods,
> won't proc_info_inferred_determinism just return the same as
> proc_info_interface_determinism anyway?
>
> In other words, couldn't you just replace the above code with
> a single call to `proc_info_inferred_determinism'?
Yes, this was the wrong place to fix this problem. I've changed
det_analysis.m to set the inferred determinism of imported
procedures and class methods to be the same as the declared determinism.
> Oh, you will have a problem with the following optimization
> in modecheck_unify.m:
> % This optimisation is safe because the only way that
> % we can analyse a unification as having no solutions
> % is that the unification always fails.
> %
> % Unifying two preds is not erroneous as far as the
> % mode checker is concerned, but a mode _error_.
> map__init(Empty),
> Goal = disj([], Empty)
> ;
>
> The problem is that by rerunning mode analysis after inlining
> you have violated the assumption documented there (the one starting
> with "This optimisation is safe because ...").
> This optimization might do the wrong thing in the case
> of user-defined equality predicates, e.g. optimizing away
> a call to error/1.
>
Won't unifications involving user-defined equality predicates have
been transformed into calls by polymorphism.m?
> > @@ -916,15 +942,47 @@
> > ;
> > % the real cons_id will be computed by polymorphism.m;
> > % we just put in a dummy one for now
> > - list__length(ArgVars, Arity),
> > ConsId = cons(unqualified("__LambdaGoal__"), Arity)
> > ),
> > mode_info_get_module_info(ModeInfo0, ModuleInfo),
> > mode_util__modes_to_uni_modes(ArgModes0, ArgModes0,
> > ModuleInfo, ArgModes),
> > + mode_info_get_instmap(ModeInfo0, InstMap),
> > + % If the instmap is unreachable, the code will
> > + % get pruned away, so don't report an error.
> > (
> > + instmap__is_unreachable(InstMap)
> > + ->
> > + ModeInfo = ModeInfo0,
> > + RHS = RHS0,
> > + Unification = construct(X, ConsId, ArgVars, ArgModes)
> > + ;
> > mode_is_output(ModuleInfo, ModeOfX)
> > ->
> > + (
> > + % lambda expressions must already have been expanded
> > + % if a pred_const is present.
> > + ConsId = pred_const(PredId, ProcId)
> > + ->
> > + (
> > + RHS0 = lambda_goal(_, _, _, _, _, Goal),
> > + Goal = call(PredId, ProcId, _, _, _, _) - _
> > + ->
> > + module_info_pred_info(ModuleInfo,
> > + PredId, PredInfo),
> > + pred_info_module(PredInfo, PredModule),
> > + pred_info_name(PredInfo, PredName),
> > + RHS = functor(
> > + cons(qualified(PredModule, PredName),
> > + Arity),
> > + ArgVars)
> > + ;
> > + error("categorize_unify_var_lambda - \
> > + reintroduced lambda goal")
> > + )
> > + ;
> > + RHS = RHS0
> > + ),
> > Unification = construct(X, ConsId, ArgVars, ArgModes),
> > ModeInfo = ModeInfo0
> > ;
>
> I found this code quite confusing. Perhaps some better documentation
> would help. What is the code trying to do?
If lambda expressions have already been expanded, rerunning mode
analysis should not recreate a lambda_goal which cannot be converted
directly back into a higher-order predicate constant. If the
instmap is unreachable, the call in the lambda-goal may have been
considered to be a call in an implied mode, in which case the
lambda_goal can't be converted back to a constant. Since the code
will be pruned by simplify.m, this doesn't matter.
Here's the new log message and a relative diff:
Estimated hours taken: 45
Assorted changes to make the HLDS type and mode correct
after lambda expansion. The HLDS is still not unique mode
correct after common structure elimination.
compiler/modecheck_unify.m
Avoid some aborts and mode errors when rerunning mode analysis,
especially those resulting from not_reached insts being treated
as bound.
compiler/unique_modes.m
compiler/hlds_pred.m
Added proc_info_inferred_never_succeeds, which checks whether
the procedure never succeeds according to the inferred determinism.
Use it during unique_mode analysis instead of proc_info_never_succeeds,
which uses the declared determinism. This is necessary if an
optimization removes code after a call to a procedure which is
declared to succeed but which is inferred to never succeed.
compiler/det_analysis.m
Make sure the inferred_determinism field of the proc_info is filled
in correctly for imported procedures and class methods.
compiler/mode_util.m
Fix a bug in recompute_instmap_delta_call to do with unreachable
instmaps.
compiler/hlds_pred.m
compiler/lambda.m
Add a field to the proc_info to record which args_method
should be used for this procedure. Procedures directly
called by do_call_*_closure must be compiled with
the `compact' argument convention to avoid the need to permute
the arguments so inputs come before outputs.
compiler/lambda.m
compiler/higher_order.m
Remove permutation of argument variables of lambda expressions
so the HLDS is type and mode correct and mode analysis can
be rerun.
compiler/arg_info.m
Added arg_info__ho_call_args_method which returns
an args_method which can always be directly called by
do_call_*_closure (`compact').
Added arg_info__args_method_is_ho_callable to check that
a given args_method can be directly called.
compiler/unify_gen.m
Abort if a closure is created for a procedure compiled
with the simple argument convention.
compiler/hlds_goal.m
compiler/lambda.m
Mode analysis was not storing the non-locals list on which the
uni_modes field of the construction of a lambda goal was computed.
If the nonlocals were renamed, the sort order could change, and
the non-locals could be incorrectly matched with the arguments
of the introduced lambda expression, causing a mode error. The
argument list is now stored.
compiler/*.m
Fill in the args_method field of proc_infos with the value
from the globals.
Handle the extra argument to the lambda_goal unify_rhs.
compiler/follow_vars.m
Remove code to handle complicated unifications, since
they should be removed by polymorphism.m.
compiler/special_pred.m
library/mercury_builtin.m
Make the uniqueness of the comparison_result argument
of builtin_compare_* and the automatically generated
comparison procedures match that of compare/3. Unique mode
errors will still be introduced if any of the unique modes
of compare/3 are used, since the compiler-generated comparison
procedures only implement the (uo, in, in) mode.
runtime/mercury_ho_call.c
Remove code in do_call_*_closure to deal with the
`simple' args_method. Since the output arguments no longer
need to be moved, the closure call is now a tailcall.
Remove some magic numbers.
tests/valid/unreachable_code.m
Add a test case for a bogus higher-order unification
mode error in unreachable code.
--- mercury_ho_call.c 1998/02/10 12:02:15 1.1
+++ mercury_ho_call.c 1998/02/10 12:18:45
@@ -17,6 +17,9 @@
** provided by the higher-order call may be input or output, and may appear
** in any order.
**
+** The procedure whose address is contained in the closure must use the
+** `compact' argument convention.
+**
** The input arguments to do_call_*_closure are the closure in r1,
** the number of additional input arguments in r2, the number of output
** arguments to expect in r3, and the additional input arguments themselves
@@ -30,6 +33,23 @@
#include "mercury_imp.h"
+ /*
+ ** Number of input arguments to do_call_*_closure,
+ ** r1 -> closure
+ ** r2 -> number of immediate input arguments.
+ ** r3 -> number of output arguments (unused).
+ */
+#define MR_HO_CALL_INPUTS 3
+
+ /*
+ ** Number of input arguments to do_call_*_class_method,
+ ** r1 -> typeclass info
+ ** r2 -> index of method in typeclass info
+ ** r3 -> number of immediate input arguments.
+ ** r4 -> number of output arguments (unused).
+ */
+#define MR_CLASS_METHOD_CALL_INPUTS 4
+
Define_extern_entry(do_call_det_closure);
Declare_label(det_closure_return);
Define_extern_entry(do_call_semidet_closure);
@@ -105,21 +125,19 @@
num_in_args = field(0, closure, 0); /* number of input args */
num_extra_args = r2; /* number of immediate input args */
- push(r3); /* The number of output args to unpack */
- push(num_in_args + num_extra_args); /* The number of input args */
- push(MR_succip);
-
save_registers();
- if (num_in_args < 3) {
+ if (num_in_args < MR_HO_CALL_INPUTS) {
for (i = 1; i <= num_extra_args; i++) {
- virtual_reg(i+num_in_args) = virtual_reg(i+3);
+ virtual_reg(i+num_in_args) =
+ virtual_reg(i+MR_HO_CALL_INPUTS);
}
- } else if (num_in_args > 3) {
+ } else if (num_in_args > MR_HO_CALL_INPUTS) {
for (i = num_extra_args; i>0; i--) {
- virtual_reg(i+num_in_args) = virtual_reg(i+3);
+ virtual_reg(i+num_in_args) =
+ virtual_reg(i+MR_HO_CALL_INPUTS);
}
- } /* else do nothing because i == 3 */
+ } /* else do nothing because i == MR_HO_CALL_INPUTS */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i) = field(0, closure, i+1); /* copy args */
@@ -127,20 +145,7 @@
restore_registers();
- call((Code *) field(0, closure, 1), LABEL(det_closure_return),
- LABEL(do_call_det_closure));
-}
- /*
- ** This is used as a return label both by do_call_det_closure and
- ** do_call_det_class_method
- */
-Define_label(det_closure_return);
-{
- MR_succip = pop(); /* restore succip */
- pop(); /* restore the input arg counter */
- pop(); /* restore the ouput arg counter */
-
- proceed();
+ tailcall((Code *) field(0, closure, 1), LABEL(do_call_det_closure));
}
Define_entry(do_call_semidet_closure);
@@ -152,21 +157,19 @@
num_in_args = field(0, closure, 0); /* number of input args */
num_extra_args = r2; /* the number of immediate input args */
- push(r3); /* The number of output args to unpack */
- push(num_in_args + num_extra_args); /* The number of input args */
- push(MR_succip);
-
save_registers();
- if (num_in_args < 3) {
+ if (num_in_args < MR_HO_CALL_INPUTS) {
for (i = 1; i <= num_extra_args; i++) {
- virtual_reg(i+num_in_args) = virtual_reg(i+3);
+ virtual_reg(i+num_in_args) =
+ virtual_reg(i+MR_HO_CALL_INPUTS);
}
- } else if (num_in_args > 3) {
+ } else if (num_in_args > MR_HO_CALL_INPUTS) {
for (i = num_extra_args; i>0; i--) {
- virtual_reg(i+num_in_args) = virtual_reg(i+3);
+ virtual_reg(i+num_in_args) =
+ virtual_reg(i+MR_HO_CALL_INPUTS);
}
- } /* else do nothing because i == 3 */
+ } /* else do nothing because i == MR_HO_CALL_INPUTS */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i) = field(0, closure, i+1); /* copy args */
@@ -174,21 +177,9 @@
restore_registers();
- call((Code *) field(0, closure, 1), LABEL(semidet_closure_return),
+ tailcall((Code *) field(0, closure, 1),
LABEL(do_call_semidet_closure));
}
- /*
- ** This is used as a return label both by do_call_semidet_closure and
- ** do_call_semidet_class_method
- */
-Define_label(semidet_closure_return);
-{
- MR_succip = pop(); /* restore succip */
- pop(); /* restore the input arg counter */
- pop(); /* restore the ouput arg counter */
-
- proceed();
-}
Define_entry(do_call_nondet_closure);
{
@@ -199,22 +190,19 @@
num_in_args = field(0, closure, 0); /* number of input args */
num_extra_args = r2; /* number of immediate input args */
- mkframe("do_call_nondet_closure", 2, ENTRY(do_fail));
- framevar(0) = r3; /* The number of output args to unpack */
- framevar(1) = num_in_args + num_extra_args;
- /* The number of input args */
-
save_registers();
- if (num_in_args < 3) {
+ if (num_in_args < MR_HO_CALL_INPUTS) {
for (i = 1; i <= num_extra_args; i++) {
- virtual_reg(i+num_in_args) = virtual_reg(i+3);
+ virtual_reg(i+num_in_args) =
+ virtual_reg(i+MR_HO_CALL_INPUTS);
}
- } else if (num_in_args > 3) {
+ } else if (num_in_args > MR_HO_CALL_INPUTS) {
for (i = num_extra_args; i > 0; i--) {
- virtual_reg(i+num_in_args) = virtual_reg(i+3);
+ virtual_reg(i+num_in_args) =
+ virtual_reg(i+MR_HO_CALL_INPUTS);
}
- } /* else do nothing because i == 3 */
+ } /* else do nothing because i == MR_HO_CALL_INPUTS */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i) = field(0, closure, i+1); /* copy args */
@@ -222,22 +210,12 @@
restore_registers();
- call((Code *) field(0, closure, 1), LABEL(nondet_closure_return),
- LABEL(do_call_nondet_closure));
-}
- /*
- ** This is used as a return label both by do_call_nondet_closure and
- ** do_call_nondet_class_method
- */
-Define_label(nondet_closure_return);
-{
- succeed();
+ tailcall((Code *) field(0, closure, 1), LABEL(do_call_nondet_closure));
}
-
/*
** r1: the typeclass_info
** r2: index of class method
@@ -255,25 +233,24 @@
num_in_args = r3; /* number of input args */
- push(r4); /* The number of output args to unpack */
- push(num_in_args); /* The number of input args */
- push(succip);
-
save_registers();
- if (num_arg_typeclass_infos < 4) {
+ if (num_arg_typeclass_infos < MR_CLASS_METHOD_CALL_INPUTS) {
/* copy to the left, from the left */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i+num_arg_typeclass_infos) =
- virtual_reg(i+4);
+ virtual_reg(i+MR_CLASS_METHOD_CALL_INPUTS);
}
- } else if (num_arg_typeclass_infos > 4) {
+ } else if (num_arg_typeclass_infos > MR_CLASS_METHOD_CALL_INPUTS) {
/* copy to the right, from the right */
for (i = num_in_args; i > 0; i--) {
virtual_reg(i+num_arg_typeclass_infos) =
- virtual_reg(i+4);
+ virtual_reg(i+MR_CLASS_METHOD_CALL_INPUTS);
}
- } /* else do nothing because num_arg_typeclass_infos == 4 */
+ } /*
+ ** else do nothing because
+ ** num_arg_typeclass_infos == MR_CLASS_METHOD_CALL_INPUTS
+ */
for (i = num_arg_typeclass_infos; i > 0; i--) {
virtual_reg(i) =
@@ -282,8 +259,7 @@
restore_registers();
- call(destination, LABEL(det_closure_return),
- LABEL(do_call_det_class_method));
+ tailcall(destination, LABEL(do_call_det_class_method));
}
Define_entry(do_call_semidet_class_method);
@@ -296,24 +272,24 @@
num_in_args = r3; /* number of input args */
- push(r4); /* The number of output args to unpack */
- push(num_in_args); /* The number of input args */
- push(succip);
-
save_registers();
- if (num_arg_typeclass_infos < 4) {
+ if (num_arg_typeclass_infos < MR_CLASS_METHOD_CALL_INPUTS) {
/* copy to the left, from the left */
for (i = 1; i <= num_in_args; i++) {
- virtual_reg(i) = virtual_reg(i+4);
+ virtual_reg(i) =
+ virtual_reg(i+MR_CLASS_METHOD_CALL_INPUTS);
}
- } else if (num_arg_typeclass_infos > 4) {
+ } else if (num_arg_typeclass_infos > MR_CLASS_METHOD_CALL_INPUTS) {
/* copy to the right, from the right */
for (i = num_in_args; i > 0; i--) {
virtual_reg(i+num_arg_typeclass_infos) =
- virtual_reg(i+4);
+ virtual_reg(i+MR_CLASS_METHOD_CALL_INPUTS);
}
- } /* else do nothing because num_arg_typeclass_infos == 4 */
+ } /*
+ ** else do nothing because
+ ** num_arg_typeclass_infos == MR_CLASS_METHOD_CALL_INPUTS
+ */
for (i = num_arg_typeclass_infos; i > 0; i--) {
virtual_reg(i) =
@@ -322,8 +298,7 @@
restore_registers();
- call(destination, LABEL(semidet_closure_return),
- LABEL(do_call_semidet_class_method));
+ tailcall(destination, LABEL(do_call_semidet_class_method));
}
Define_entry(do_call_nondet_class_method);
@@ -336,24 +311,23 @@
num_in_args = r3; /* number of input args */
- mkframe("do_call_nondet_class_method", 2, ENTRY(do_fail));
- framevar(0) = r4; /* The number of output args to unpack */
- framevar(1) = num_in_args; /* The number of input args */
-
save_registers();
- if (num_arg_typeclass_infos < 4) {
+ if (num_arg_typeclass_infos < MR_CLASS_METHOD_CALL_INPUTS) {
/* copy to the left, from the left */
for (i = 1; i <= num_in_args; i++) {
virtual_reg(i) = virtual_reg(i+4);
}
- } else if (num_arg_typeclass_infos > 4) {
+ } else if (num_arg_typeclass_infos > MR_CLASS_METHOD_CALL_INPUTS) {
/* copy to the right, from the right */
for (i = num_in_args; i > 0; i--) {
virtual_reg(i+num_arg_typeclass_infos) =
- virtual_reg(i+4);
+ virtual_reg(i+MR_CLASS_METHOD_CALL_INPUTS);
}
- } /* else do nothing because num_arg_typeclass_infos == 4 */
+ } /*
+ ** else do nothing because
+ ** num_arg_typeclass_infos == MR_CLASS_METHOD_CALL_INPUTS
+ */
for (i = num_arg_typeclass_infos; i > 0; i--) {
virtual_reg(i) =
@@ -362,8 +336,7 @@
restore_registers();
- call(destination, LABEL(nondet_closure_return),
- LABEL(do_call_nondet_class_method));
+ tailcall(destination, LABEL(do_call_nondet_class_method));
}
/*
--- arg_info.m 1998/02/10 12:20:03 1.1
+++ arg_info.m 1998/02/10 12:20:28
@@ -23,6 +23,7 @@
:- module arg_info.
:- interface.
:- import_module hlds_module, llds, globals, prog_data.
+:- import_module bool.
:- pred generate_arg_info(module_info, module_info).
:- mode generate_arg_info(in, out) is det.
@@ -34,11 +35,15 @@
module_info, list(arg_info)).
:- mode make_arg_infos(in, in, in, in, in, out) is det.
- % Return an args_method for which mercury_ho_call.c can
- % find the input arguments without permutation of the arguments
- % so that inputs come before outputs.
-:- pred arg_info__ho_callable_args_method(args_method).
-:- mode arg_info__ho_callable_args_method(out) is det.
+ % Return yes if a procedure using the given args_method
+ % can by called by do_call_*_closure.
+:- pred arg_info__args_method_is_ho_callable(globals, args_method, bool).
+:- mode arg_info__args_method_is_ho_callable(in, in, out) is det.
+
+ % Return an args_method which can be used for procedures
+ % which may be called by do_call_*_closure.
+:- pred arg_info__ho_call_args_method(globals, args_method).
+:- mode arg_info__ho_call_args_method(in, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -132,7 +137,7 @@
% register for both an input arg and an output arg.
%
% lambda.m ensures that all procedures which are called directly
- % from do_call_*_closure use the compact argument convention,
+ % from do_call_*_closure use the `compact' argument convention,
% so that mercury_ho_call.c can place the input arguments without
% knowing anything about the called procedure.
@@ -216,7 +221,10 @@
%---------------------------------------------------------------------------%
-arg_info__ho_callable_args_method(compact).
+arg_info__args_method_is_ho_callable(_, compact, yes).
+arg_info__args_method_is_ho_callable(_, simple, no).
+
+arg_info__ho_call_args_method(_, compact).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
--- bytecode_gen.m 1998/02/10 12:20:03 1.1
+++ bytecode_gen.m 1998/02/10 12:20:29
@@ -276,7 +276,8 @@
ByteInfo, Code) :-
determinism_to_code_model(Detism, CodeModel),
bytecode_gen__get_module_info(ByteInfo, ModuleInfo),
- arg_info__ho_callable_args_method(ArgsMethod),
+ module_info_globals(ModuleInfo, Globals),
+ arg_info__ho_call_args_method(Globals, ArgsMethod),
make_arg_infos(ArgsMethod, ArgTypes, ArgModes, CodeModel, ModuleInfo,
ArgInfo),
assoc_list__from_corresponding_lists(ArgVars, ArgInfo, ArgVarsInfos),
--- call_gen.m 1998/02/10 12:20:03 1.1
+++ call_gen.m 1998/02/10 12:20:29
@@ -162,7 +162,7 @@
% do_call_<detism>_closure, and pick up the outputs from the
% locations that we know runtime/mercury_ho_call.c leaves them in.
%
- % lambda.m insist that procedures which are directly
+ % lambda.m ensures that procedures which are directly
% higher-order-called use the compact argument convertion,
% so that runtime/mercury_ho_call.c doesn't have trouble
% figuring out which registers the arguments go in.
@@ -172,7 +172,8 @@
Modes, Det, GoalInfo, Code) -->
{ determinism_to_code_model(Det, CodeModel) },
code_info__get_module_info(ModuleInfo),
- { arg_info__ho_callable_args_method(ArgsMethod) },
+ { module_info_globals(ModuleInfo, Globals) },
+ { arg_info__ho_call_args_method(Globals, ArgsMethod) },
{ make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
ArgInfos) },
{ assoc_list__from_corresponding_lists(Args, ArgInfos, ArgsInfos) },
@@ -275,8 +276,12 @@
code_info__get_globals(Globals),
code_info__get_module_info(ModuleInfo),
- % XXX must be compact
{ globals__get_args_method(Globals, ArgsMethod) },
+ ( { ArgsMethod = compact } ->
+ []
+ ;
+ { error("Sorry, typeclasses with simple args_method not yet implemented") }
+ ),
{ make_arg_infos(ArgsMethod, Types, Modes, InnerCodeModel, ModuleInfo,
ArgInfo) },
{ assoc_list__from_corresponding_lists(Args, ArgInfo, ArgsAndArgInfo) },
@@ -284,23 +289,13 @@
call_gen__generate_class_method_call_2(InnerCodeModel, TCVar,
MethodNum, InVars, OutVars, GoalInfo, Code).
- % XXX This assumes compact args
:- pred call_gen__generate_class_method_call_2(code_model, var, int, list(var),
list(var), hlds_goal_info, code_tree, code_info, code_info).
:- mode call_gen__generate_class_method_call_2(in, in, in, in, in, in, out, in,
out) is det.
-call_gen__generate_class_method_call_2(CodeModel, TCVar, Index, InVars, OutVars,
- GoalInfo, Code) -->
- code_info__get_globals(Globals),
- { globals__get_args_method(Globals, ArgsMethod) },
- (
- { ArgsMethod = compact }
- ->
- []
- ;
- { error("Sorry, typeclasses with simple args_method not yet implemented") }
- ),
+call_gen__generate_class_method_call_2(CodeModel, TCVar, Index,
+ InVars, OutVars, GoalInfo, Code) -->
code_info__succip_is_used,
{ set__list_to_set(OutVars, OutArgs) },
call_gen__save_variables(OutArgs, SaveCode),
--- det_analysis.m 1998/02/10 12:20:03 1.1
+++ det_analysis.m 1998/02/10 12:42:06
@@ -110,20 +110,22 @@
determinism_pass(ModuleInfo0, ModuleInfo) -->
{ determinism_declarations(ModuleInfo0, DeclaredProcs,
- UndeclaredProcs) },
+ UndeclaredProcs, NoInferProcs) },
+ { list__foldl(set_non_inferred_proc_determinism, NoInferProcs,
+ ModuleInfo0, ModuleInfo1) },
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(debug_det, Debug),
( { UndeclaredProcs = [] } ->
- { ModuleInfo1 = ModuleInfo0 }
+ { ModuleInfo2 = ModuleInfo1 }
;
maybe_write_string(Verbose,
"% Doing determinism inference...\n"),
- global_inference_pass(ModuleInfo0, UndeclaredProcs, Debug,
- ModuleInfo1),
+ global_inference_pass(ModuleInfo1, UndeclaredProcs, Debug,
+ ModuleInfo2),
maybe_write_string(Verbose, "% done.\n")
),
maybe_write_string(Verbose, "% Doing determinism checking...\n"),
- global_final_pass(ModuleInfo1, DeclaredProcs, Debug, ModuleInfo),
+ global_final_pass(ModuleInfo2, DeclaredProcs, Debug, ModuleInfo),
maybe_write_string(Verbose, "% done.\n").
determinism_check_proc(ProcId, PredId, ModuleInfo0, ModuleInfo) -->
@@ -493,7 +495,7 @@
det_infer_goal_2(unify(LT, RT0, M, U, C), GoalInfo, InstMap0, SolnContext,
DetInfo, _, _, unify(LT, RT, M, U, C), UnifyDet, Msgs) :-
(
- RT0 = lambda_goal(PredOrFunc, NonLocalVars, Vars,
+ RT0 = lambda_goal(PredOrFunc, NonLocalVars, Vars,
Modes, LambdaDeclaredDet, Goal0)
->
(
@@ -512,7 +514,7 @@
det_check_lambda(LambdaDeclaredDet, LambdaInferredDet,
Goal, GoalInfo, DetInfo, Msgs2),
list__append(Msgs1, Msgs2, Msgs3),
- RT = lambda_goal(PredOrFunc, NonLocalVars, Vars,
+ RT = lambda_goal(PredOrFunc, NonLocalVars, Vars,
Modes, LambdaDeclaredDet, Goal)
;
RT = RT0,
@@ -988,12 +990,15 @@
% returns two lists of procedure ids, the first being those
% with determinism declarations, and the second being those without.
-:- pred determinism_declarations(module_info, pred_proc_list, pred_proc_list).
-:- mode determinism_declarations(in, out, out) is det.
+:- pred determinism_declarations(module_info, pred_proc_list,
+ pred_proc_list, pred_proc_list).
+:- mode determinism_declarations(in, out, out, out) is det.
-determinism_declarations(ModuleInfo, DeclaredProcs, UndeclaredProcs) :-
+determinism_declarations(ModuleInfo, DeclaredProcs,
+ UndeclaredProcs, NoInferProcs) :-
get_all_pred_procs(ModuleInfo, PredProcs),
- segregate_procs(ModuleInfo, PredProcs, DeclaredProcs, UndeclaredProcs).
+ segregate_procs(ModuleInfo, PredProcs, DeclaredProcs,
+ UndeclaredProcs, NoInferProcs).
% get_all_pred_procs takes a module_info and returns a list
% of all the procedures ids for that module (except class methods,
@@ -1014,20 +1019,8 @@
get_all_pred_procs_2(_Preds, [], PredProcs, PredProcs).
get_all_pred_procs_2(Preds, [PredId|PredIds], PredProcs0, PredProcs) :-
map__lookup(Preds, PredId, Pred),
- pred_info_get_markers(Pred, Markers),
- (
- % ignore class members, since their bodies are filled
- % in after this pass, and the body is gauranteed to
- % be determinism-correct. Determinism correctness of
- % the methods in an instance declaration is checked
- % separately in check_typeclass.m
- check_marker(Markers, class_method)
- ->
- PredProcs1 = PredProcs0
- ;
- pred_info_non_imported_procids(Pred, ProcIds),
- fold_pred_modes(PredId, ProcIds, PredProcs0, PredProcs1)
- ),
+ pred_info_procids(Pred, ProcIds),
+ fold_pred_modes(PredId, ProcIds, PredProcs0, PredProcs1),
get_all_pred_procs_2(Preds, PredIds, PredProcs1, PredProcs).
:- pred fold_pred_modes(pred_id, list(proc_id), pred_proc_list, pred_proc_list).
@@ -1043,37 +1036,86 @@
% UndeclaredProcs.
:- pred segregate_procs(module_info, pred_proc_list, pred_proc_list,
- pred_proc_list).
-:- mode segregate_procs(in, in, out, out) is det.
+ pred_proc_list, pred_proc_list).
+:- mode segregate_procs(in, in, out, out, out) is det.
-segregate_procs(ModuleInfo, PredProcs, DeclaredProcs, UndeclaredProcs) :-
+segregate_procs(ModuleInfo, PredProcs, DeclaredProcs,
+ UndeclaredProcs, NoInferProcs) :-
segregate_procs_2(ModuleInfo, PredProcs, [], DeclaredProcs,
- [], UndeclaredProcs).
+ [], UndeclaredProcs, [], NoInferProcs).
:- pred segregate_procs_2(module_info, pred_proc_list, pred_proc_list,
- pred_proc_list, pred_proc_list, pred_proc_list).
-:- mode segregate_procs_2(in, in, in, out, in, out) is det.
+ pred_proc_list, pred_proc_list, pred_proc_list,
+ pred_proc_list, pred_proc_list).
+:- mode segregate_procs_2(in, in, in, out, in, out, in, out) is det.
segregate_procs_2(_ModuleInfo, [], DeclaredProcs, DeclaredProcs,
- UndeclaredProcs, UndeclaredProcs).
+ UndeclaredProcs, UndeclaredProcs, NoInferProcs, NoInferProcs).
segregate_procs_2(ModuleInfo, [proc(PredId, ProcId) | PredProcs],
DeclaredProcs0, DeclaredProcs,
- UndeclaredProcs0, UndeclaredProcs) :-
+ UndeclaredProcs0, UndeclaredProcs,
+ NoInferProcs0, NoInferProcs) :-
module_info_preds(ModuleInfo, Preds),
map__lookup(Preds, PredId, Pred),
- pred_info_procedures(Pred, Procs),
- map__lookup(Procs, ProcId, Proc),
- proc_info_declared_determinism(Proc, MaybeDetism),
- (
- MaybeDetism = no,
- UndeclaredProcs1 = [proc(PredId, ProcId) | UndeclaredProcs0],
- DeclaredProcs1 = DeclaredProcs0
- ;
- MaybeDetism = yes(_),
- DeclaredProcs1 = [proc(PredId, ProcId) | DeclaredProcs0],
- UndeclaredProcs1 = UndeclaredProcs0
+ (
+ (
+ pred_info_is_imported(Pred)
+ ;
+ pred_info_is_pseudo_imported(Pred),
+ hlds_pred__in_in_unification_proc_id(ProcId)
+ ;
+ pred_info_get_markers(Pred, Markers),
+ check_marker(Markers, class_method)
+ )
+ ->
+ UndeclaredProcs1 = UndeclaredProcs0,
+ DeclaredProcs1 = DeclaredProcs0,
+ NoInferProcs1 = [proc(PredId, ProcId) | NoInferProcs0]
+ ;
+ pred_info_procedures(Pred, Procs),
+ map__lookup(Procs, ProcId, Proc),
+ proc_info_declared_determinism(Proc, MaybeDetism),
+ (
+ MaybeDetism = no,
+ UndeclaredProcs1 =
+ [proc(PredId, ProcId) | UndeclaredProcs0],
+ DeclaredProcs1 = DeclaredProcs0
+ ;
+ MaybeDetism = yes(_),
+ DeclaredProcs1 =
+ [proc(PredId, ProcId) | DeclaredProcs0],
+ UndeclaredProcs1 = UndeclaredProcs0
+ ),
+ NoInferProcs1 = NoInferProcs0
),
segregate_procs_2(ModuleInfo, PredProcs, DeclaredProcs1, DeclaredProcs,
- UndeclaredProcs1, UndeclaredProcs).
+ UndeclaredProcs1, UndeclaredProcs,
+ NoInferProcs1, NoInferProcs).
+
+ % We can't infer a tighter determinism for imported procedures or
+ % for class methods, so set the inferred determinism to be the
+ % same as the declared determinism. This can't be done easily in
+ % make_hlds.m since inter-module optimization means that the
+ % import_status of procedures isn't determined until after all
+ % items are processed.
+:- pred set_non_inferred_proc_determinism(pred_proc_id,
+ module_info, module_info).
+:- mode set_non_inferred_proc_determinism(in, in, out) is det.
+
+set_non_inferred_proc_determinism(proc(PredId, ProcId),
+ ModuleInfo0, ModuleInfo) :-
+ module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
+ pred_info_procedures(PredInfo0, Procs0),
+ map__lookup(Procs0, ProcId, ProcInfo0),
+ proc_info_declared_determinism(ProcInfo0, MaybeDet),
+ ( MaybeDet = yes(Det) ->
+ proc_info_set_inferred_determinism(ProcInfo0, Det, ProcInfo),
+ map__det_update(Procs0, ProcId, ProcInfo, Procs),
+ pred_info_set_procedures(PredInfo0, Procs, PredInfo),
+ module_info_set_pred_info(ModuleInfo0,
+ PredId, PredInfo, ModuleInfo)
+ ;
+ ModuleInfo = ModuleInfo0
+ ).
%-----------------------------------------------------------------------------%
--- follow_vars.m 1998/02/10 12:20:03 1.1
+++ follow_vars.m 1998/02/10 12:20:31
@@ -165,7 +165,8 @@
IsPredOrFunc),
FollowVars) :-
determinism_to_code_model(Det, CodeModel),
- arg_info__ho_callable_args_method(ArgsMethod),
+ module_info_globals(ModuleInfo, Globals),
+ arg_info__ho_call_args_method(Globals, ArgsMethod),
make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
ArgInfo),
find_follow_vars_from_arginfo(ArgInfo, Args, FollowVars).
@@ -182,7 +183,12 @@
FollowVars) :-
determinism_to_code_model(Det, CodeModel),
module_info_globals(ModuleInfo, Globals),
- globals__get_args_method(Globals, ArgsMethod), % XXX must be compact.
+ globals__get_args_method(Globals, ArgsMethod),
+ ( ArgsMethod = compact ->
+ true
+ ;
+ error("Sorry, typeclasses with simple args_method not yet implemented")
+ ),
make_arg_infos(ArgsMethod, Types, Modes, CodeModel, ModuleInfo,
ArgInfo),
find_follow_vars_from_arginfo(ArgInfo, Args, FollowVars).
--- hlds_pred.m 1998/02/10 12:20:03 1.1
+++ hlds_pred.m 1998/02/10 12:24:40
@@ -846,8 +846,8 @@
% Same as proc_info_never succeeds, except uses the
% inferred determinism. Don't use this before determinism
% analysis.
-:- pred proc_info_inferred_never_succeeds(pred_info, proc_id, proc_info, bool).
-:- mode proc_info_inferred_never_succeeds(in, in, in, out) is det.
+:- pred proc_info_inferred_never_succeeds(proc_info, bool).
+:- mode proc_info_inferred_never_succeeds(in, out) is det.
:- pred proc_info_varset(proc_info, varset).
:- mode proc_info_varset(in, out) is det.
@@ -1042,7 +1042,7 @@
% be set to the value of the --args
% option stored in the globals.
% lambda.m will set this field to
- % compact for procedures it creates
+ % `compact' for procedures it creates
% which must be directly callable by
% a higher_order_call goal.
).
@@ -1131,24 +1131,8 @@
)
).
-proc_info_inferred_never_succeeds(PredInfo, ProcId, ProcInfo, Result) :-
- (
- % We don't infer determinism for imported procedures
- % or for class_method predicates.
- (
- pred_info_is_imported(PredInfo)
- ;
- pred_info_is_pseudo_imported(PredInfo),
- hlds_pred__in_in_unification_proc_id(ProcId)
- ;
- pred_info_get_markers(PredInfo, Markers),
- check_marker(Markers, class_method)
- )
- ->
- proc_info_interface_determinism(ProcInfo, Determinism)
- ;
- proc_info_inferred_determinism(ProcInfo, Determinism)
- ),
+proc_info_inferred_never_succeeds(ProcInfo, Result) :-
+ proc_info_inferred_determinism(ProcInfo, Determinism),
determinism_components(Determinism, _, HowMany),
( HowMany = at_most_zero ->
Result = yes
@@ -1310,7 +1294,7 @@
% % be set to the value of the --args
% % option stored in the globals.
% % lambda.m will set this field to
-% % compact for procedures it creates
+% % `compact' for procedures it creates
% % which must be directly callable by
% % a higher_order_call goal.
% ).
--- lambda.m 1998/02/10 12:20:03 1.1
+++ lambda.m 1998/02/10 12:20:33
@@ -281,7 +281,9 @@
% check that this procedure uses an args_method which
% is always directly higher-order callable.
proc_info_args_method(Call_ProcInfo, Call_ArgsMethod),
- arg_info__ho_callable_args_method(Call_ArgsMethod),
+ module_info_globals(ModuleInfo0, Globals),
+ arg_info__args_method_is_ho_callable(Globals,
+ Call_ArgsMethod, yes),
list__remove_suffix(CallVars, Vars, InitialVars),
@@ -364,17 +366,18 @@
list__append(ArgModes1, Modes, AllArgModes),
map__apply_to_list(AllArgVars, VarTypes, ArgTypes),
- % Choose an args_method which is always directly ho_callable
- % even if the inputs don't preceed the outputs in the
- % declaration. mercury_ho_call.c requires that
- % procedures which are directly higher-order-called use
+ % Choose an args_method which is always directly callable
+ % from do_call_*_closure even if the inputs don't preceed
+ % the outputs in the declaration. mercury_ho_call.c requires
+ % that procedures which are directly higher-order-called use
% the compact args_method.
%
% Previously we permuted the argument variables so that
% inputs came before outputs, but that resulted in the
% HLDS not being type or mode correct which caused problems
% for some transformations and for rerunning mode analysis.
- arg_info__ho_callable_args_method(ArgsMethod),
+ module_info_globals(ModuleInfo1, Globals),
+ arg_info__ho_call_args_method(Globals, ArgsMethod),
% Now construct the proc_info and pred_info for the new
% single-mode predicate, using the information computed above
--- modecheck_unify.m 1998/02/10 12:20:03 1.1
+++ modecheck_unify.m 1998/02/10 12:30:12
@@ -851,9 +851,9 @@
% predicate - instead, we delay the error
% until runtime so that it only occurs if
% the compiler-generated predicate gets called.
- % We don't report an error if the instmap is
- % unreachable since not_reached counts
- % as bound.
+ % not_reached is considered bound, so the
+ % error message would be spurious if the
+ % instmap is unreachable.
mode_info_get_predid(ModeInfo0, PredId),
module_info_pred_info(ModuleInfo0, PredId,
PredInfo),
@@ -948,21 +948,24 @@
mode_util__modes_to_uni_modes(ArgModes0, ArgModes0,
ModuleInfo, ArgModes),
mode_info_get_instmap(ModeInfo0, InstMap),
- % If the instmap is unreachable, the code will
- % get pruned away, so don't report an error.
(
- instmap__is_unreachable(InstMap)
- ->
- ModeInfo = ModeInfo0,
- RHS = RHS0,
- Unification = construct(X, ConsId, ArgVars, ArgModes)
- ;
mode_is_output(ModuleInfo, ModeOfX)
->
(
- % lambda expressions must already have been expanded
- % if a pred_const is present.
- ConsId = pred_const(PredId, ProcId)
+ % If pred_consts are present, lambda expansion
+ % has already been done. Rerunning mode analysis
+ % should not produce a lambda_goal which cannot
+ % be directly converted back into a higher-order
+ % predicate constant.
+ % If the instmap is not reachable, the call
+ % may have been handled as an implied mode,
+ % since not_reached is considered to be bound.
+ % In this case the lambda_goal may not be
+ % converted back to a predicate constant, but
+ % that doesn't matter since the code will be
+ % pruned away later by simplify.m.
+ ConsId = pred_const(PredId, ProcId),
+ instmap__is_reachable(InstMap)
->
(
RHS0 = lambda_goal(_, _, _, _, _, Goal),
@@ -986,7 +989,11 @@
Unification = construct(X, ConsId, ArgVars, ArgModes),
ModeInfo = ModeInfo0
;
- % If it's a deconstruction, it is a mode error
+ instmap__is_reachable(InstMap)
+ ->
+ % If it's a deconstruction, it is a mode error.
+ % The error message would be incorrect in unreachable
+ % code, since not_reached is considered bound.
set__init(WaitingVars),
mode_info_get_var_types(ModeInfo0, VarTypes0),
map__lookup(VarTypes0, X, Type),
@@ -996,6 +1003,10 @@
Type, PredOrFunc),
ModeInfo0, ModeInfo),
% return any old garbage
+ Unification = Unification0,
+ RHS = RHS0
+ ;
+ ModeInfo = ModeInfo0,
Unification = Unification0,
RHS = RHS0
).
--- unify_gen.m 1998/02/10 12:20:03 1.1
+++ unify_gen.m 1998/02/10 12:20:39
@@ -333,10 +333,11 @@
{ pred_info_procedures(PredInfo, Procs) },
{ map__lookup(Procs, ProcId, ProcInfo) },
- % lambda.m should ensure that only predicates using the compact
- % argument passing convention occur in closures.
- { arg_info__ho_callable_args_method(ArgsMethod) },
- ( { proc_info_args_method(ProcInfo, ArgsMethod) } ->
+ % lambda.m adds wrapper procedures for procedures which don't
+ % use an args_method compatible with do_call_*_closure.
+ { proc_info_args_method(ProcInfo, ArgsMethod) },
+ { module_info_globals(ModuleInfo, Globals) },
+ ( { arg_info__args_method_is_ho_callable(Globals, ArgsMethod, yes) } ->
[]
;
{ error("unify_gen__generate_construction_2: pred constant not callable") }
--- unique_modes.m 1998/02/10 12:20:03 1.1
+++ unique_modes.m 1998/02/10 12:20:39
@@ -453,12 +453,10 @@
% first off, try using the existing mode
%
mode_info_get_module_info(ModeInfo0, ModuleInfo),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId0,
- PredInfo, ProcInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId0, _, ProcInfo),
proc_info_argmodes(ProcInfo, ProcArgModes0),
proc_info_interface_code_model(ProcInfo, CodeModel),
- proc_info_inferred_never_succeeds(PredInfo, ProcId0,
- ProcInfo, NeverSucceeds),
+ proc_info_inferred_never_succeeds(ProcInfo, NeverSucceeds),
unique_modes__check_call_modes(ArgVars, ProcArgModes0, CodeModel,
NeverSucceeds, ModeInfo1, ModeInfo2),
More information about the developers
mailing list