[m-rev.] Allow initialisation of solver type args in constructions
Ralph Becket
rafe at cs.mu.OZ.AU
Fri Mar 11 13:04:14 AEDT 2005
Estimated hours taken: 12
Branches: main, release
Allow the initialisation of solver type variables in constructions.
compiler/modecheck_unify.m:
Disallow partial constructions (i.e. where one or more arguments
has inst free). Instead, if we are currently inserting variable
initialisation calls and all arguments of a construction are
solver types, then insert initialisation calls for them.
tests/hard_coded/Mmakefile:
tests/hard_coded/solver_construction_init_test.m:
tests/hard_coded/solver_construction_init_test.exp:
Added a test case.
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.74
diff -u -r1.74 modecheck_unify.m
--- compiler/modecheck_unify.m 21 Jan 2005 03:27:43 -0000 1.74
+++ compiler/modecheck_unify.m 11 Mar 2005 01:46:01 -0000
@@ -458,6 +458,7 @@
Unification0, UnifyContext, GoalInfo0, Goal, !ModeInfo, !IO) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
mode_info_get_how_to_check(!.ModeInfo, HowToCheckGoal),
+ mode_info_get_var_types(!.ModeInfo, VarTypes),
%
% Fully module qualify all cons_ids
@@ -467,9 +468,6 @@
mode_info_get_instmap(!.ModeInfo, InstMap0),
instmap__lookup_var(InstMap0, X0, InstOfX0),
- instmap__lookup_vars(ArgVars0, InstMap0, InstArgs),
- mode_info_var_list_is_live(!.ModeInfo, ArgVars0, LiveArgs),
- InstOfY = bound(unique, [functor(InstConsId, InstArgs)]),
(
% If the unification was originally of the form
% X = 'new f'(Y) it must be classified as a
@@ -494,6 +492,32 @@
mode_info_var_is_live(!.ModeInfo, X, LiveX),
ExtraGoals0 = no_extra_goals
),
+
+ (
+ % If we are allowed to insert solver type initialisation
+ % calls and InstOfX0 is free and all ArgVars0 are either
+ % non-free or have solver types, then we know that this
+ % is going to be a construction, so we can insert the
+ % necessary initialisation calls.
+ HowToCheckGoal \= check_unique_modes,
+ inst_match__inst_is_free(ModuleInfo0, InstOfX),
+ mode_info_may_initialise_solver_vars(!.ModeInfo),
+ instmap__lookup_vars(ArgVars0, InstMap0, InstArgs0),
+ all_arg_vars_are_non_free_or_solver_vars(ArgVars0, InstArgs0,
+ VarTypes, ModuleInfo0, ArgVarsToInit)
+ ->
+ modes__construct_initialisation_calls(ArgVarsToInit, InitGoals,
+ !ModeInfo),
+ ExtraGoals1 = extra_goals(InitGoals, [])
+ ;
+ ExtraGoals1 = no_extra_goals
+ ),
+
+ mode_info_get_instmap(!.ModeInfo, InstMap1),
+ instmap__lookup_vars(ArgVars0, InstMap1, InstArgs),
+ mode_info_var_list_is_live(!.ModeInfo, ArgVars0, LiveArgs),
+ InstOfY = bound(unique, [functor(InstConsId, InstArgs)]),
+
(
% The occur check: X = f(X) is considered a mode error
@@ -530,8 +554,9 @@
% return any old garbage
Unification = Unification0,
ArgVars = ArgVars0,
- ExtraGoals1 = no_extra_goals
+ ExtraGoals2 = no_extra_goals
;
+ not is_a_partial_construction(InstOfX, InstArgs, ModuleInfo0),
abstractly_unify_inst_functor(LiveX, InstOfX, InstConsId,
InstArgs, LiveArgs, real_unify, TypeOfX,
UnifyInst, Det1, ModuleInfo0, ModuleInfo1)
@@ -560,12 +585,11 @@
;
error("get_(inst/mode)_of_args failed")
),
- mode_info_get_var_types(!.ModeInfo, VarTypes),
categorize_unify_var_functor(ModeOfX, ModeOfXArgs, ModeArgs,
X, ConsId, ArgVars0, VarTypes, UnifyContext,
Unification0, Unification1, !ModeInfo),
split_complicated_subunifies(Unification1, Unification,
- ArgVars0, ArgVars, ExtraGoals1, !ModeInfo),
+ ArgVars0, ArgVars, ExtraGoals2, !ModeInfo),
modecheck_set_var_inst(X, Inst, yes(InstOfY), !ModeInfo),
UnifyArgInsts = list__map(func(I) = yes(I), InstOfXArgs),
(
@@ -601,7 +625,7 @@
% return any old garbage
Unification = Unification0,
ArgVars = ArgVars0,
- ExtraGoals1 = no_extra_goals
+ ExtraGoals2 = no_extra_goals
),
%
@@ -621,7 +645,7 @@
% 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_.
Goal = disj([])
@@ -637,11 +661,12 @@
% (If it did in other cases, the code would be wrong since it
% wouldn't have the correct determinism annotations.)
%
- append_extra_goals(ExtraGoals0, ExtraGoals1, ExtraGoals),
+ append_extra_goals(ExtraGoals0, ExtraGoals1, ExtraGoals01),
+ append_extra_goals(ExtraGoals01, ExtraGoals2, ExtraGoals),
(
HowToCheckGoal = check_unique_modes,
ExtraGoals \= no_extra_goals,
- instmap__is_reachable(InstMap0)
+ instmap__is_reachable(InstMap1)
->
error("unique_modes.m: re-modecheck of unification " ++
"encountered complicated sub-unifies")
@@ -652,6 +677,42 @@
[X0 | ArgVars0], [X | ArgVars], InstMap0, Goal,
!ModeInfo, !IO)
).
+
+
+:- pred all_arg_vars_are_non_free_or_solver_vars(list(prog_var)::in,
+ list(inst)::in, map(prog_var, type)::in, module_info::in,
+ list(prog_var)::out) is semidet.
+
+all_arg_vars_are_non_free_or_solver_vars([], [], _, _, []).
+
+all_arg_vars_are_non_free_or_solver_vars([], [_|_], _, _, _) :-
+ error("modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
+ "mismatch in list lengths").
+
+all_arg_vars_are_non_free_or_solver_vars([_|_], [], _, _, _) :-
+ error("modecheck_unify.all_arg_vars_are_non_free_or_solver_vars: " ++
+ "mismatch in list lengths").
+
+all_arg_vars_are_non_free_or_solver_vars([Arg | Args], [Inst | Insts],
+ VarTypes, ModuleInfo, ArgsToInit) :-
+ ( if inst_match__inst_is_free(ModuleInfo, Inst) then
+ type_is_solver_type(ModuleInfo, VarTypes ^ elem(Arg)),
+ ArgsToInit = [Arg | ArgsToInit0],
+ all_arg_vars_are_non_free_or_solver_vars(Args, Insts,
+ VarTypes, ModuleInfo, ArgsToInit0)
+ else
+ all_arg_vars_are_non_free_or_solver_vars(Args, Insts,
+ VarTypes, ModuleInfo, ArgsToInit)
+ ).
+
+
+:- pred is_a_partial_construction((inst)::in, list(inst)::in,
+ module_info::in) is semidet.
+
+is_a_partial_construction(XInst, ArgInsts, ModuleInfo) :-
+ inst_is_free(ModuleInfo, XInst),
+ list__member(ArgInst, ArgInsts),
+ inst_is_free(ModuleInfo, ArgInst).
%-----------------------------------------------------------------------------%
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.249
diff -u -r1.249 Mmakefile
--- tests/hard_coded/Mmakefile 3 Feb 2005 08:14:37 -0000 1.249
+++ tests/hard_coded/Mmakefile 11 Mar 2005 01:57:03 -0000
@@ -152,6 +152,7 @@
setjmp_test \
shift_test \
solve_quadratic \
+ solver_construction_init_test \
space \
stable_sort \
string_alignment \
Index: tests/hard_coded/solver_construction_init_test.exp
===================================================================
RCS file: tests/hard_coded/solver_construction_init_test.exp
diff -N tests/hard_coded/solver_construction_init_test.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/solver_construction_init_test.exp 11 Mar 2005 01:58:37 -0000
@@ -0,0 +1 @@
+Hello, World!
Index: tests/hard_coded/solver_construction_init_test.m
===================================================================
RCS file: tests/hard_coded/solver_construction_init_test.m
diff -N tests/hard_coded/solver_construction_init_test.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/solver_construction_init_test.m 11 Mar 2005 01:57:33 -0000
@@ -0,0 +1,45 @@
+%-----------------------------------------------------------------------------%
+% solver_construction_init_test.m
+% Ralph Becket <rafe at cs.mu.oz.au>
+% Wed Mar 9 12:24:52 EST 2005
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+%-----------------------------------------------------------------------------%
+
+:- module solver_construction_init_test.
+
+:- interface.
+
+:- import_module list, io.
+
+:- solver type t.
+
+:- func f = (list(t)::oa) is det.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- solver type t
+ where representation is int,
+ initialisation is init,
+ ground is ground,
+ any is ground.
+
+f = [_].
+
+
+:- pred init(t::oa) is det.
+:- pragma promise_pure(init/1).
+init(X) :-
+ impure X = 'representation to any t/0'(123).
+
+
+main(!IO) :-
+ io.print("Hello, World!\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list