[m-rev.] for review: support currying multi-modes preds in special case
Peter Wang
novalazy at gmail.com
Wed Apr 16 16:18:06 AEST 2008
Estimated hours taken: 15
Branches: main
Support currying of multi-moded predicates or functions when the mode to curry
can be determined from the insts of the higher-order arguments. e.g.
mymap(P, L0, L) :-
map(wrap(P), L0, L).
:- pred wrap(...).
:- mode wrap(in(pred(...) is det), ...) is det.
:- mode wrap(in(pred(...) is cc_multi, ...) is cc_multi.
...
compiler/post_typecheck.m:
Don't abort immediately on taking the address of a multi-moded
predicate. Leave the proc_id as invalid_proc_id and handle that
in polymorphism.m.
compiler/polymorphism.m:
Convert higher order terms to lambda goals even if the proc_id is
invalid (as above) moded by arbitrarily using the first mode. Then
polymorphism can proceed as usual. Mark the goals with feature
`feature_lambda_undetermined_mode', which tells mode checking to
handle it.
Add a predicate to fix up such lambda goals once mode checking does
figure out which mode should be called.
compiler/modecheck_unify.m:
compiler/mode_errors.m:
Handle goals with the `feature_lambda_undetermined_mode'. Try to
select a unique mode for the curried predicate then fix up the lambda
goal.
compiler/hlds_goal.m:
compiler/saved_vars.m:
Add `feature_lambda_undetermined_mode'.
compiler/goal_util.m:
Add a predicate to return all the pred_ids called in a goal
with the associated argument variables.
NEWS:
doc/reference_manual.texi:
Document and announce the change.
tests/hard_coded/Mmakefile:
tests/hard_coded/multimode_addr.exp:
tests/hard_coded/multimode_addr.m:
tests/invalid/Mmakefile:
tests/invalid/multimode_addr_problems.err_exp:
tests/invalid/multimode_addr_problems.m:
Add tests.
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.488
diff -u -r1.488 NEWS
--- NEWS 3 Apr 2008 05:26:42 -0000 1.488
+++ NEWS 16 Apr 2008 06:15:15 -0000
@@ -24,6 +24,9 @@
* We now support higher-order `any' insts.
* We now support "implementation-defined literals", such as `$file', `$line',
`$pred', which are useful for producing better run-time error messages.
+* We now support currying of multi-moded predicates or functions when the
+ mode to curry can be determined from the insts of the higher-order
+ arguments.
Changes to the Mercury standard library:
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.157
diff -u -r1.157 goal_util.m
--- compiler/goal_util.m 27 Feb 2008 07:23:05 -0000 1.157
+++ compiler/goal_util.m 16 Apr 2008 06:15:15 -0000
@@ -191,6 +191,11 @@
%
:- pred predids_from_goal(hlds_goal::in, list(pred_id)::out) is det.
+ % Returns all the predids that are called along with the list of
+ % arguments.
+:- pred predids_with_args_from_goal(hlds_goal::in,
+ list({pred_id, prog_vars})::out) is det.
+
% Returns all the predids that are used in a list of goals.
%
:- pred predids_from_goals(hlds_goals::in, list(pred_id)::out) is det.
@@ -1616,6 +1621,13 @@
P = (pred(PredId::out) is nondet :- goal_calls_pred_id(Goal, PredId)),
solutions.solutions(P, PredIds).
+predids_with_args_from_goal(Goal, List) :-
+ solutions(
+ (pred({PredId, Args}::out) is nondet :-
+ goal_contains_goal(Goal, hlds_goal(SubGoal, _)),
+ SubGoal = plain_call(PredId, _, Args, _, _, _)
+ ), List).
+
pred_proc_ids_from_goal(Goal, PredProcIds) :-
P = (pred(PredProcId::out) is nondet :- goal_calls(Goal, PredProcId)),
solutions.solutions(P, PredProcIds).
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.189
diff -u -r1.189 hlds_goal.m
--- compiler/hlds_goal.m 27 Feb 2008 07:23:06 -0000 1.189
+++ compiler/hlds_goal.m 16 Apr 2008 06:15:16 -0000
@@ -571,6 +571,10 @@
rhs_lambda_goal :: hlds_goal
).
+:- inst rhs_lambda_goal
+ ---> rhs_lambda_goal(ground, ground, ground, ground, ground, ground,
+ ground, ground, ground).
+
% Was the constructor originally of the form 'new ctor'(...).
%
:- type is_existential_construction == bool.
@@ -1308,7 +1312,7 @@
% This goal contains a scope goal whose scope_reason is
% trace_goal(...).
- ; feature_pretest_equality.
+ ; feature_pretest_equality
% This goal is an if-then-else in a compiler-generated
% type-constructor-specific unify or compare predicate
% whose condition is a test of whether the two input arguments
@@ -1316,6 +1320,13 @@
% circumstances we need to strip off this pretest, and replace
% the if-then-else with just its else branch.
+ ; feature_lambda_undetermined_mode.
+ % This goal is a lambda goal converted from a higher order term
+ % for which we don't know the mode of the call to the underlying
+ % predicate. These can be produced by the polymorphism
+ % transformation but should be removed by the end of mode
+ % checking.
+
%-----------------------------------------------------------------------------%
%
% The rename_var* predicates take a structure and a mapping from var -> var
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.125
diff -u -r1.125 mode_errors.m
--- compiler/mode_errors.m 7 Apr 2008 02:32:51 -0000 1.125
+++ compiler/mode_errors.m 16 Apr 2008 06:15:16 -0000
@@ -124,6 +124,15 @@
% Some sort of error in attempt to unify a variable with lambda
% expression.
+ ; mode_error_unify_var_multimode_pred(prog_var, pred_id)
+ % Some sort of error in attempt to take address of a multi-moded
+ % predicate.
+
+ ; mode_error_unify_var_multimode_pred_undetermined(prog_var,
+ pred_id)
+ % Attempt to take address of a multi-moded predicate where we
+ % could not uniquely determine the mode to use.
+
; mode_error_conj(list(delayed_goal), schedule_culprit)
% A conjunction contains one or more unscheduleable goals;
% schedule_culprit gives the reason why they couldn't be scheduled.
@@ -310,6 +319,15 @@
Spec = mode_error_unify_var_lambda_to_spec(ModeInfo, VarA,
InstA, InstB)
;
+ ModeError = mode_error_unify_var_multimode_pred(VarA, PredId),
+ Spec = mode_error_unify_var_multimode_pred_to_spec(ModeInfo, VarA,
+ PredId)
+ ;
+ ModeError = mode_error_unify_var_multimode_pred_undetermined(VarA,
+ PredId),
+ Spec = mode_error_unify_var_multimode_pred_undetermined_to_spec(
+ ModeInfo, VarA, PredId)
+ ;
ModeError = mode_error_unify_var_functor(Var, Name, Args, Inst,
ArgInsts),
Spec = mode_error_unify_var_functor_to_spec(ModeInfo, Var, Name,
@@ -940,6 +958,68 @@
%-----------------------------------------------------------------------------%
+:- func mode_error_unify_var_multimode_pred_to_spec(mode_info, prog_var,
+ pred_id) = error_spec.
+
+mode_error_unify_var_multimode_pred_to_spec(ModeInfo, X, PredId) = Spec :-
+ Preamble = mode_info_context_preamble(ModeInfo),
+ mode_info_get_context(ModeInfo, Context),
+ mode_info_get_varset(ModeInfo, VarSet),
+ mode_info_get_module_info(ModeInfo, ModuleInfo),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ PredModule = pred_info_module(PredInfo),
+ PredName = pred_info_name(PredInfo),
+ QualifiedName = qualified(PredModule, PredName),
+ Arity = pred_info_orig_arity(PredInfo),
+ (
+ PredOrFunc = pf_predicate,
+ Arity1 = Arity
+ ;
+ PredOrFunc = pf_function,
+ Arity1 = Arity - 1
+ ),
+ Pieces = [words("mode error in unification of"),
+ words(add_quotes(mercury_var_to_string(VarSet, no, X))),
+ words("and higher-order term based on multi-moded"),
+ p_or_f(PredOrFunc), sym_name_and_arity(QualifiedName / Arity1),
+ suffix("."), nl],
+ Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
+ [simple_msg(Context, [always(Preamble ++ Pieces)])]).
+
+:- func mode_error_unify_var_multimode_pred_undetermined_to_spec(mode_info,
+ prog_var, pred_id) = error_spec.
+
+mode_error_unify_var_multimode_pred_undetermined_to_spec(ModeInfo, X, PredId)
+ = Spec :-
+ Preamble = mode_info_context_preamble(ModeInfo),
+ mode_info_get_context(ModeInfo, Context),
+ mode_info_get_varset(ModeInfo, VarSet),
+ mode_info_get_module_info(ModeInfo, ModuleInfo),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ PredModule = pred_info_module(PredInfo),
+ PredName = pred_info_name(PredInfo),
+ QualifiedName = qualified(PredModule, PredName),
+ Arity = pred_info_orig_arity(PredInfo),
+ (
+ PredOrFunc = pf_predicate,
+ Arity1 = Arity
+ ;
+ PredOrFunc = pf_function,
+ Arity1 = Arity - 1
+ ),
+ Pieces = [words("In unification of"),
+ words(add_quotes(mercury_var_to_string(VarSet, no, X))),
+ words("and higher-order term."),
+ words("Could not determine the mode of"),
+ p_or_f(PredOrFunc), sym_name_and_arity(QualifiedName / Arity1),
+ words("by the insts of the higher-order arguments only."), nl],
+ Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
+ [simple_msg(Context, [always(Preamble ++ Pieces)])]).
+
+%-----------------------------------------------------------------------------%
+
:- func mode_error_unify_var_functor_to_spec(mode_info, prog_var,
cons_id, list(prog_var), mer_inst, list(mer_inst)) = error_spec.
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.125
diff -u -r1.125 modecheck_unify.m
--- compiler/modecheck_unify.m 11 Feb 2008 21:26:05 -0000 1.125
+++ compiler/modecheck_unify.m 16 Apr 2008 06:15:16 -0000
@@ -56,6 +56,7 @@
:- import_module check_hlds.type_util.
:- import_module check_hlds.unify_proc.
:- import_module check_hlds.unique_modes.
+:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
@@ -270,7 +271,23 @@
UnifyContext, GoalInfo0, Goal, !ModeInfo, !IO)
).
-modecheck_unification_2(X, LambdaGoal, Unification0, UnifyContext, _GoalInfo,
+modecheck_unification_2(X, LambdaGoal, Unification0, UnifyContext, GoalInfo,
+ Goal, !ModeInfo, !IO) :-
+ LambdaGoal = rhs_lambda_goal(_, _, _, _, _, _, _, _, _),
+ ( goal_info_has_feature(GoalInfo, feature_lambda_undetermined_mode) ->
+ modecheck_unification_rhs_undetermined_mode_lambda(X, LambdaGoal,
+ Unification0, UnifyContext, GoalInfo, Goal, !ModeInfo, !IO)
+ ;
+ modecheck_unification_rhs_lambda(X, LambdaGoal, Unification0,
+ UnifyContext, GoalInfo, Goal, !ModeInfo, !IO)
+ ).
+
+:- pred modecheck_unification_rhs_lambda(prog_var::in,
+ unify_rhs::in(rhs_lambda_goal), unification::in, unify_context::in,
+ hlds_goal_info::in, hlds_goal_expr::out, mode_info::in, mode_info::out,
+ io::di, io::uo) is det.
+
+modecheck_unification_rhs_lambda(X, LambdaGoal, Unification0, UnifyContext, _,
unify(X, RHS, Mode, Unification, UnifyContext), !ModeInfo, !IO) :-
LambdaGoal = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
ArgVars, Vars, Modes0, Det, Goal0),
@@ -500,6 +517,53 @@
RHS = RHS0
).
+:- pred modecheck_unification_rhs_undetermined_mode_lambda(prog_var::in,
+ unify_rhs::in(rhs_lambda_goal), unification::in, unify_context::in,
+ hlds_goal_info::in, hlds_goal_expr::out, mode_info::in, mode_info::out,
+ io::di, io::uo) is det.
+
+modecheck_unification_rhs_undetermined_mode_lambda(X, LambdaGoal0, Unification,
+ UnifyContext, GoalInfo0, Goal, !ModeInfo, !IO) :-
+ LambdaGoal0 = rhs_lambda_goal(_, _, _, _, _, _, _, _, Goal0),
+ % Find out the predicate called in the lambda goal.
+ ( predids_with_args_from_goal(Goal0, [{PredId, ArgVars}]) ->
+ mode_info_get_module_info(!.ModeInfo, ModuleInfo),
+ mode_info_get_instmap(!.ModeInfo, InstMap),
+ mode_info_get_var_types(!.ModeInfo, VarTypes),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ match_modes_by_higher_order_insts(ModuleInfo, InstMap, VarTypes,
+ ArgVars, PredInfo, MatchResult),
+ (
+ ( MatchResult = possible_modes([])
+ ; MatchResult = ho_arg_not_ground
+ ),
+ mode_info_error(set.make_singleton_set(X),
+ mode_error_unify_var_multimode_pred(X, PredId), !ModeInfo),
+ % Return any old garbage.
+ Goal = true_goal_expr
+ ;
+ MatchResult = possible_modes([ProcId]),
+ fix_undetermined_mode_lambda_goal(ProcId, LambdaGoal0, LambdaGoal,
+ ModuleInfo),
+ goal_info_remove_feature(feature_lambda_undetermined_mode,
+ GoalInfo0, GoalInfo),
+ % Modecheck this unification in its new form.
+ modecheck_unification_2(X, LambdaGoal, Unification, UnifyContext,
+ GoalInfo, Goal, !ModeInfo, !IO)
+ ;
+ MatchResult = possible_modes([_, _ | _]),
+ mode_info_error(set.make_singleton_set(X),
+ mode_error_unify_var_multimode_pred_undetermined(X, PredId),
+ !ModeInfo),
+ % Return any old garbage.
+ Goal = true_goal_expr
+ )
+ ;
+ unexpected(this_file,
+ "modecheck_unification_rhs_undetermined_mode_lambda: " ++
+ "expecting single call")
+ ).
+
:- pred modecheck_unify_functor(prog_var::in, mer_type::in, cons_id::in,
is_existential_construction::in, list(prog_var)::in, unification::in,
unify_context::in, hlds_goal_info::in, hlds_goal_expr::out,
@@ -1382,6 +1446,89 @@
%-----------------------------------------------------------------------------%
+:- type match_modes_result
+ ---> possible_modes(list(proc_id))
+ ; ho_arg_not_ground.
+
+:- type match_mode_result
+ ---> ho_insts_match
+ ; ho_insts_do_not_match
+ ; ho_arg_not_ground.
+
+:- pred match_modes_by_higher_order_insts(module_info::in, instmap::in,
+ vartypes::in, prog_vars::in, pred_info::in, match_modes_result::out) is det.
+
+match_modes_by_higher_order_insts(ModuleInfo, InstMap, VarTypes, ArgVars,
+ CalleePredInfo, Result) :-
+ CalleeProcIds = pred_info_procids(CalleePredInfo),
+ match_modes_by_higher_order_insts_2(ModuleInfo, InstMap, VarTypes,
+ ArgVars, CalleePredInfo, CalleeProcIds, [], Result).
+
+:- pred match_modes_by_higher_order_insts_2(module_info::in, instmap::in,
+ vartypes::in, prog_vars::in, pred_info::in, list(proc_id)::in,
+ list(proc_id)::in, match_modes_result::out) is det.
+
+match_modes_by_higher_order_insts_2(_, _, _, _, _,
+ [], RevMatchedProcIds, Result) :-
+ Result = possible_modes(list.reverse(RevMatchedProcIds)).
+match_modes_by_higher_order_insts_2(ModuleInfo, InstMap, VarTypes,
+ ArgVars, PredInfo, [ProcId | ProcIds], RevMatchedProcIds, Result) :-
+ pred_info_proc_info(PredInfo, ProcId, ProcInfo),
+ proc_info_get_argmodes(ProcInfo, ArgModes),
+ match_mode_by_higher_order_insts(ModuleInfo, InstMap, VarTypes, ArgVars,
+ ArgModes, ProcResult),
+ (
+ ProcResult = ho_insts_match,
+ match_modes_by_higher_order_insts_2(ModuleInfo, InstMap,
+ VarTypes, ArgVars, PredInfo, ProcIds, [ProcId | RevMatchedProcIds],
+ Result)
+ ;
+ ProcResult = ho_insts_do_not_match,
+ match_modes_by_higher_order_insts_2(ModuleInfo, InstMap, VarTypes,
+ ArgVars, PredInfo, ProcIds, RevMatchedProcIds, Result)
+ ;
+ ProcResult = ho_arg_not_ground,
+ Result = ho_arg_not_ground
+ ).
+
+:- pred match_mode_by_higher_order_insts(module_info::in, instmap::in,
+ vartypes::in, prog_vars::in, list(mer_mode)::in, match_mode_result::out)
+ is det.
+
+match_mode_by_higher_order_insts(_ModuleInfo, _InstMap, _VarTypes,
+ [], _, ho_insts_match).
+match_mode_by_higher_order_insts(ModuleInfo, InstMap, VarTypes,
+ [Arg | Args], ArgModesList, Result) :-
+ (
+ ArgModesList = [ArgMode | ArgModes]
+ ;
+ ArgModesList = [],
+ unexpected(this_file,
+ "args_match_higher_order_insts: too many arguments")
+ ),
+
+ % For arguments with higher order initial insts, check if the variable in
+ % that position has a matching inst. If the variable is free then we need
+ % to delay the goal.
+ Initial = mode_get_initial_inst(ModuleInfo, ArgMode),
+ ( Initial = ground(_, higher_order(_)) ->
+ instmap.lookup_var(InstMap, Arg, ArgInst),
+ map.lookup(VarTypes, Arg, ArgType),
+ ( inst_matches_initial(ArgInst, Initial, ArgType, ModuleInfo) ->
+ match_mode_by_higher_order_insts(ModuleInfo, InstMap, VarTypes,
+ Args, ArgModes, Result)
+ ; not inst_is_ground(ModuleInfo, ArgInst) ->
+ Result = ho_arg_not_ground
+ ;
+ Result = ho_insts_do_not_match
+ )
+ ;
+ match_mode_by_higher_order_insts(ModuleInfo, InstMap, VarTypes, Args,
+ ArgModes, Result)
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred bind_args(mer_inst::in, list(prog_var)::in, list(maybe(mer_inst))::in,
mode_info::in, mode_info::out) is det.
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.332
diff -u -r1.332 polymorphism.m
--- compiler/polymorphism.m 7 Apr 2008 02:32:51 -0000 1.332
+++ compiler/polymorphism.m 16 Apr 2008 06:15:17 -0000
@@ -322,6 +322,16 @@
module_info::in, unify_rhs::out, prog_varset::in, prog_varset::out,
vartypes::in, vartypes::out) is det.
+ % fix_undetermined_mode_lambda_goal(ProcId, Functor0, Functor, ModuleInfo)
+ %
+ % This is called by mode checking when it figures out which mode that a
+ % lambda goal converted from a higher order pred term should call.
+ % Functor0 must have been produced by `convert_pred_to_lambda_goal'.
+ %
+:- pred fix_undetermined_mode_lambda_goal(proc_id::in,
+ unify_rhs::in(rhs_lambda_goal), unify_rhs::out(rhs_lambda_goal),
+ module_info::in) is det.
+
% init_type_info_var(Type, ArgVars, TypeInfoVar, TypeInfoGoal,
% !VarSet, !VarTypes) :-
%
@@ -1302,19 +1312,39 @@
% Check if variable has a higher order type.
type_is_higher_order_details(TypeOfX, Purity, _PredOrFunc, EvalMethod,
CalleeArgTypes),
- ConsId0 = pred_const(ShroudedPredProcId, _)
+ ConsId0 = pred_const(ShroudedPredProcId, _),
+ proc(PredId, ProcId0) = unshroud_pred_proc_id(ShroudedPredProcId)
->
+ % An `invalid_proc_id' means the predicate is multi-moded. We can't
+ % pick the right mode yet. Perform the rest of the transformation with
+ % any mode (the first) but mark the goal with a feature so that mode
+ % checking knows to fix it up later.
+ ( ProcId0 = invalid_proc_id ->
+ module_info_pred_info(ModuleInfo0, PredId, PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
+ (
+ ProcIds = [ProcId | _],
+ goal_info_add_feature(feature_lambda_undetermined_mode,
+ GoalInfo0, GoalInfo1)
+ ;
+ ProcIds = [],
+ unexpected(this_file,
+ "polymorphism_process_unify_functor: no modes")
+ )
+ ;
+ ProcId = ProcId0,
+ GoalInfo1 = GoalInfo0
+ ),
% Convert the higher order pred term to a lambda goal.
poly_info_get_varset(!.Info, VarSet0),
Context = goal_info_get_context(GoalInfo0),
- proc(PredId, ProcId) = unshroud_pred_proc_id(ShroudedPredProcId),
convert_pred_to_lambda_goal(Purity, EvalMethod, X0, PredId, ProcId,
- ArgVars0, CalleeArgTypes, UnifyContext, GoalInfo0, Context,
+ ArgVars0, CalleeArgTypes, UnifyContext, GoalInfo1, Context,
ModuleInfo0, Functor0, VarSet0, VarSet, VarTypes0, VarTypes),
poly_info_set_varset_and_types(VarSet, VarTypes, !Info),
% Process the unification in its new form.
polymorphism_process_unify(X0, Functor0, Mode0, Unification0,
- UnifyContext, GoalInfo0, Goal, !Info)
+ UnifyContext, GoalInfo1, Goal, !Info)
;
% Is this a construction or deconstruction of an existentially
% typed data type?
@@ -1410,13 +1440,66 @@
% Work out the modes of the introduced lambda variables and the determinism
% of the lambda goal.
+ lambda_modes_and_det(ProcInfo, LambdaVars, LambdaModes, LambdaDet),
+
+ % Construct the lambda expression.
+
+ PredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ % Higher-order values created in this fashion are always ground.
+ Groundness = ho_ground,
+ Functor = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ ArgVars0, LambdaVars, LambdaModes, LambdaDet, LambdaGoal).
+
+fix_undetermined_mode_lambda_goal(ProcId, Functor0, Functor, ModuleInfo) :-
+ Functor0 = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ ArgVars0, LambdaVars, _LambdaModes0, _LambdaDet0, LambdaGoal0),
+ LambdaGoal0 = hlds_goal(_, LambdaGoalInfo),
+ goal_to_conj_list(LambdaGoal0, LambdaGoalList0),
+ (
+ list.split_last(LambdaGoalList0, LambdaGoalButLast0, LastGoal0),
+ LastGoal0 = hlds_goal(LastGoalExpr0, LastGoalInfo0),
+ LastGoalExpr0 = plain_call(PredId0, _DummyProcId, Args0, not_builtin,
+ MaybeCallUnifyContext0, QualifiedPName0)
+ ->
+ LambdaGoalButLast = LambdaGoalButLast0,
+ LastGoalInfo = LastGoalInfo0,
+ PredId = PredId0,
+ Args = Args0,
+ MaybeCallUnifyContext = MaybeCallUnifyContext0,
+ QualifiedPName = QualifiedPName0
+ ;
+ unexpected(this_file,
+ "fix_undetermined_mode_lambda_goal: unmatched lambda goal")
+ ),
+
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
+
+ % Build up the lambda goal.
+ LastGoalExpr = plain_call(PredId, ProcId, Args, not_builtin,
+ MaybeCallUnifyContext, QualifiedPName),
+ LastGoal = hlds_goal(LastGoalExpr, LastGoalInfo),
+ conj_list_to_goal(LambdaGoalButLast ++ [LastGoal], LambdaGoalInfo,
+ LambdaGoal),
+
+ % Work out the modes of the introduced lambda variables and the determinism
+ % of the lambda goal.
+ lambda_modes_and_det(ProcInfo, LambdaVars, LambdaModes, LambdaDet),
+
+ % Construct the lambda expression.
+ Functor = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
+ ArgVars0, LambdaVars, LambdaModes, LambdaDet, LambdaGoal).
+
+:- pred lambda_modes_and_det(proc_info::in, prog_vars::in, list(mer_mode)::out,
+ determinism::out) is det.
+
+lambda_modes_and_det(ProcInfo, LambdaVars, LambdaModes, LambdaDet) :-
proc_info_get_argmodes(ProcInfo, ArgModes),
list.length(ArgModes, NumArgModes),
list.length(LambdaVars, NumLambdaVars),
- ( list.drop(NumArgModes - NumLambdaVars, ArgModes, LambdaModes0) ->
- LambdaModes = LambdaModes0
+ ( list.drop(NumArgModes - NumLambdaVars, ArgModes, LambdaModesPrime) ->
+ LambdaModes = LambdaModesPrime
;
- unexpected(this_file, "convert_pred_to_lambda_goal: list.drop failed")
+ unexpected(this_file, "lambda_modes_and_det: list.drop failed")
),
proc_info_get_declared_determinism(ProcInfo, MaybeDet),
(
@@ -1425,16 +1508,9 @@
;
MaybeDet = no,
sorry(this_file,
- "determinism inference for higher order predicate terms.")
- ),
-
- % Construct the lambda expression.
-
- PredOrFunc = pred_info_is_pred_or_func(PredInfo),
- % Higher-order values created in this fashion are always ground.
- Groundness = ho_ground,
- Functor = rhs_lambda_goal(Purity, Groundness, PredOrFunc, EvalMethod,
- ArgVars0, LambdaVars, LambdaModes, LambdaDet, LambdaGoal).
+ "lambda_modes_and_det: determinism inference for " ++
+ "higher order predicate terms.")
+ ).
:- pred create_fresh_vars(list(mer_type)::in, list(prog_var)::out,
prog_varset::in, prog_varset::out, vartypes::in, vartypes::out) is det.
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.125
diff -u -r1.125 post_typecheck.m
--- compiler/post_typecheck.m 27 Feb 2008 07:23:12 -0000 1.125
+++ compiler/post_typecheck.m 16 Apr 2008 06:15:17 -0000
@@ -1012,7 +1012,20 @@
get_pred_id(calls_are_fully_qualified(Markers), Name,
PredOrFunc, TVarSet, AllArgTypes, ModuleInfo, PredId)
->
- get_proc_id(ModuleInfo, PredId, ProcId),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_procids(PredInfo),
+ (
+ ProcIds = [ProcId0],
+ ProcId = ProcId0
+ ;
+ ProcIds = [_, _ | _],
+ % We don't know which mode to pick. Defer it until mode checking.
+ ProcId = invalid_proc_id
+ ;
+ ProcIds = [],
+ % Abort with error message.
+ get_proc_id(ModuleInfo, PredId, ProcId)
+ ),
ShroudedPredProcId = shroud_pred_proc_id(proc(PredId, ProcId)),
ConsId = pred_const(ShroudedPredProcId, EvalMethod),
GoalExpr = unify(X0, rhs_functor(ConsId, no, ArgVars0), Mode0,
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.77
diff -u -r1.77 saved_vars.m
--- compiler/saved_vars.m 27 Feb 2008 07:23:14 -0000 1.77
+++ compiler/saved_vars.m 16 Apr 2008 06:15:17 -0000
@@ -232,6 +232,7 @@
ok_to_duplicate(feature_will_not_call_mm_tabled) = yes.
ok_to_duplicate(feature_contains_trace) = yes.
ok_to_duplicate(feature_pretest_equality) = yes.
+ok_to_duplicate(feature_lambda_undetermined_mode) = yes.
% Divide a list of goals into an initial subsequence of goals
% that construct constants, and all other goals.
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.425
diff -u -r1.425 reference_manual.texi
--- doc/reference_manual.texi 3 Apr 2008 05:26:46 -0000 1.425
+++ doc/reference_manual.texi 16 Apr 2008 06:15:20 -0000
@@ -4186,6 +4186,11 @@
binds @samp{Double} to a higher-order function term of type
@samp{func(list(int)) = list(int)}.
+The restriction on not creating higher-order terms from multi-moded
+predicates or functions is lifted if the mode of the curried predicate or
+function can be determined from the insts of its higher-order curried
+arguments.
+
For higher-order predicate expressions that thread an accumulator
pair, we have syntax that allows you to use DCG notation in the
goal of the expression. For example,
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.345
diff -u -r1.345 Mmakefile
--- tests/hard_coded/Mmakefile 3 Apr 2008 05:26:47 -0000 1.345
+++ tests/hard_coded/Mmakefile 16 Apr 2008 06:15:20 -0000
@@ -148,6 +148,7 @@
mode_choice \
multi_map_test \
multimode \
+ multimode_addr \
mutable_init_order \
myset_test \
name_mangling \
Index: tests/hard_coded/multimode_addr.exp
===================================================================
RCS file: tests/hard_coded/multimode_addr.exp
diff -N tests/hard_coded/multimode_addr.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/multimode_addr.exp 16 Apr 2008 06:15:20 -0000
@@ -0,0 +1,21 @@
+TEST 1
+f2p: det, not unique
+f2p: det, not unique
+f2p: det, not unique
+f2p: det, not unique
+f2p: det, not unique
+[5, 4, 3, 2, 1]
+
+TEST 2
+f2p: det, unique
+a
+f2p: det, unique
+b
+f2p: det, unique
+c
+
+TEST 3
+f2p: semidet
+f2p: semidet
+f2p: semidet
+found a multiple of three
Index: tests/hard_coded/multimode_addr.m
===================================================================
RCS file: tests/hard_coded/multimode_addr.m
diff -N tests/hard_coded/multimode_addr.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/multimode_addr.m 16 Apr 2008 06:15:20 -0000
@@ -0,0 +1,99 @@
+% Take addresses of multimoded predicates and functions.
+
+:- module multimode_addr.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ io.write_string("TEST 1\n", !IO),
+ Rev = my_foldl(cons, 1 .. 5, []),
+ io.write(Rev, !IO),
+ io.nl(!IO),
+
+ io.write_string("\nTEST 2\n", !IO),
+ !:IO = my_foldl(echo, ["a", "b", "c"], !.IO),
+
+ io.write_string("\nTEST 3\n", !IO),
+ ( RevB = my_foldl(maybe_cons, 1 .. 5, []) ->
+ io.write(RevB, !IO),
+ io.nl(!IO)
+ ;
+ io.write_string("found a multiple of three\n", !IO)
+ ).
+
+:- func my_foldl(func(L, A) = A, list(L), A) = A.
+:- mode my_foldl(in(func(in, in) = out is semidet), in, in) = out is semidet.
+:- mode my_foldl(in(func(in, di) = uo is det), in, di) = uo is det.
+:- mode my_foldl(in(func(in, in) = out is det), in, in) = out is det.
+
+my_foldl(F, L, A0) = A :-
+ list.foldl(f2p(F), L, A0, A).
+
+% Changing the type signature causes polymorphism.m to produce a lambda goal
+% which is more than just a plain_call. It creates type_infos before the
+% actual call.
+:- func my_foldl_b(func(int, A) = A, list(int), A) = A.
+:- mode my_foldl_b(in(func(in, in) = out is semidet), in, in) = out is semidet.
+:- mode my_foldl_b(in(func(in, di) = uo is det), in, di) = uo is det.
+:- mode my_foldl_b(in(func(in, in) = out is det), in, in) = out is det.
+
+my_foldl_b(F, L, A0) = A :-
+ list.foldl(f2p(F), L, A0, A).
+
+% Some reordering.
+:- func my_foldl_silly(func(L, A) = A, list(L), A) = A.
+:- mode my_foldl_silly(in(func(in, in) = out is semidet), in, in) = out
+ is semidet.
+:- mode my_foldl_silly(in(func(in, di) = uo is det), in, di) = uo is det.
+:- mode my_foldl_silly(in(func(in, in) = out is det), in, in) = out is det.
+
+my_foldl_silly(F, L, A0) = A :-
+ list.foldl(P, L, A0, A),
+ P = f2p(F1),
+ F1 = F.
+
+:- pred f2p(func(L, A) = A, L, A, A).
+:- mode f2p(in(func(in, di) = uo is det), in, di, uo) is det.
+:- mode f2p(in(func(in, in) = out is det), in, in, out) is det.
+:- mode f2p(in(func(in, in) = out is semidet), in, in, out) is semidet.
+
+:- pragma promise_equivalent_clauses(f2p/4).
+
+f2p(F::in(func(in, di) = uo is det), L::in, A0::di, A::uo) :-
+ trace [io(!IO)] io.write_string("f2p: det, unique\n", !IO),
+ F(L, A0) = A.
+
+f2p(F::in(func(in, in) = out is det), L::in, A0::in, A::out) :-
+ trace [io(!IO)] io.write_string("f2p: det, not unique\n", !IO),
+ F(L, A0) = A.
+
+f2p(F::in(func(in, in) = out is semidet), L::in, A0::in, A::out) :-
+ trace [io(!IO)] io.write_string("f2p: semidet\n", !IO),
+ F(L, A0) = A.
+
+:- func echo(string::in, io::di) = (io::uo) is det.
+
+echo(S, IO0) = IO :-
+ io.write_string(S, IO0, IO1),
+ io.nl(IO1, IO).
+
+:- func maybe_cons(int::in, list(int)::in) = (list(int)::out) is semidet.
+
+maybe_cons(X, Xs) = [X | Xs] :-
+ mod(X, 3) \= 0.
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.229
diff -u -r1.229 Mmakefile
--- tests/invalid/Mmakefile 3 Apr 2008 05:26:48 -0000 1.229
+++ tests/invalid/Mmakefile 16 Apr 2008 06:15:20 -0000
@@ -148,6 +148,7 @@
multimode_dcg \
multimode_missing_impure \
multimode_syntax \
+ multimode_addr_problems \
multisoln_func \
nested_impl_in_int \
no_exports \
Index: tests/invalid/multimode_addr_problems.err_exp
===================================================================
RCS file: tests/invalid/multimode_addr_problems.err_exp
diff -N tests/invalid/multimode_addr_problems.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/multimode_addr_problems.err_exp 16 Apr 2008 06:15:20 -0000
@@ -0,0 +1,11 @@
+multimode_addr_problems.m:023: In clause for `main(di, uo)':
+multimode_addr_problems.m:023: In unification of `Abs' and higher-order term.
+multimode_addr_problems.m:023: Could not determine the mode of predicate
+multimode_addr_problems.m:023: `multimode_addr_problems.absolute'/2 by the
+multimode_addr_problems.m:023: insts of the higher-order arguments only.
+multimode_addr_problems.m:047: In clause for `my_foldl(in((func(in, in) = out
+multimode_addr_problems.m:047: is det)), in, in) = out':
+multimode_addr_problems.m:047: mode error in unification of `P' and
+multimode_addr_problems.m:047: higher-order term based on multi-moded
+multimode_addr_problems.m:047: predicate `multimode_addr_problems.f2p'/4.
+For more information, recompile with `-E'.
Index: tests/invalid/multimode_addr_problems.m
===================================================================
RCS file: tests/invalid/multimode_addr_problems.m
diff -N tests/invalid/multimode_addr_problems.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/multimode_addr_problems.m 16 Apr 2008 06:15:20 -0000
@@ -0,0 +1,60 @@
+% Test error messages with problems that arise trying to taking the
+% address of multi-moded predicates.
+
+:- module multimode_addr_problems.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ % The compiler can't choose which mode of absolute to use.
+ Abs = absolute,
+ Abs(3, X),
+ io.write_int(X, !IO),
+ io.nl(!IO).
+
+:- pred absolute(int, int).
+:- mode absolute(in, out) is det.
+:- mode absolute(out, in) is multi.
+
+:- pragma promise_equivalent_clauses(absolute/2).
+
+absolute(X::in, Y::out) :-
+ Y = ( X < 0 -> -X ; X).
+
+absolute(X::out, Y::in) :-
+ ( X = Y
+ ; X = -Y
+ ).
+
+:- func my_foldl(func(L, A) = A, list(L), A) = A.
+:- mode my_foldl(in(func(in, in) = out is det), in, in) = out is det.
+
+my_foldl(F, L, A0) = A :-
+ % None of the modes of f2p are usable.
+ % XXX the error message without this explicit unification is confusing.
+ P = f2p(F),
+ list.foldl(P, L, A0, A).
+
+:- pred f2p(func(L, A) = A, L, A, A).
+:- mode f2p(in(func(in, di) = uo is det), in, di, uo) is det.
+% :- mode f2p(in(func(in, in) = out is det), in, in, out) is det.
+:- mode f2p(in(func(in, in) = out is semidet), in, in, out) is semidet.
+
+f2p(F, L, A0, A) :-
+ F(L, A0) = A.
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sw=4 et wm=0 tw=0
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list