[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