[m-rev.] Solver support for abstract equivalence solver types

[Ralph Becket]

Estimated hours taken: 20
Branches: main

Extend the solver types implementation to handle abstract equivalence solver
types.

compiler/goal_util.m:
	Add a version of goal_util__generate_unsafe_cast with an
	extra inst parameter (this is needed because solver types
	typically have inst any rather than ground).

compiler/modes.m:
	Export modes__construct_initialisation_call which is now
	also called from unify_proc.m.

	Fix a misleading compiler error message.

compiler/type_util.m:
	A type that is equivalent to a solver type is now also considered
	a solver type.

compiler/unify_proc.m:
	The compiler generated initialisation predicate for an abstract
	equivalence solver type first calls the initialisation predicate
	for the RHS of the type equivalence, then casts the result back
	into the type on the LHS of the type equivalence.

Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.98
diff -u -r1.98 goal_util.m
--- compiler/goal_util.m	16 Oct 2004 15:05:51 -0000	1.98
+++ compiler/goal_util.m	11 Nov 2004 08:30:00 -0000
@@ -237,6 +237,9 @@
 :- pred goal_util__generate_unsafe_cast(prog_var::in, prog_var::in,
 	prog_context::in, hlds_goal::out) is det.
 
+:- pred goal_util__generate_unsafe_cast(prog_var::in, prog_var::in,
+	(inst)::in, prog_context::in, hlds_goal::out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -1272,12 +1275,15 @@
 	Goal = GoalExpr - GoalInfo.
 
 generate_unsafe_cast(InArg, OutArg, Context, Goal) :-
+	Inst = ground(shared, none),
+	generate_unsafe_cast(InArg, OutArg, Inst, Context, Goal).
+
+generate_unsafe_cast(InArg, OutArg, Inst, Context, Goal) :-
 	set__list_to_set([InArg, OutArg], NonLocals),
-	instmap_delta_from_assoc_list([OutArg - ground(shared, none)],
-		InstMapDelta),
+	instmap_delta_from_assoc_list([OutArg - Inst], InstMapDelta),
 	goal_info_init(NonLocals, InstMapDelta, det, pure, Context, GoalInfo),
 	Goal = generic_call(unsafe_cast, [InArg, OutArg],
-		[in_mode, out_mode], det) - GoalInfo.
+		[in_mode(Inst), out_mode(Inst)], det) - GoalInfo.
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.285
diff -u -r1.285 modes.m
--- compiler/modes.m	4 Oct 2004 07:27:09 -0000	1.285
+++ compiler/modes.m	11 Nov 2004 08:23:31 -0000
@@ -323,6 +323,12 @@
 :- pred mode_context_to_unify_context(mode_info::in, mode_context::in,
 	unify_context::out) is det.
 
+	% Construct a call to initialise a free solver type variable.
+	%
+:- pred construct_initialisation_call(module_info::in, prog_var::in,
+		(type)::in, (inst)::in, prog_context::in,
+		maybe(call_unify_context)::in, hlds_goal::out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -2624,10 +2630,6 @@
 	append_extra_goals(!.ExtraGoals, NewExtraGoal, !:ExtraGoals).
 
 
-:- pred construct_initialisation_call(module_info::in, prog_var::in,
-		(type)::in, (inst)::in, prog_context::in,
-		maybe(call_unify_context)::in, hlds_goal::out) is det.
-
 construct_initialisation_call(ModuleInfo, Var, VarType, InitialInst, Context,
 		MaybeCallUnifyContext, InitVarGoal) :-
 	(
@@ -2646,8 +2648,7 @@
 		goal_info_set_instmap_delta(GoalInfo1, InstmapDelta, GoalInfo),
 		InitVarGoal = GoalExpr - GoalInfo
 	;
-		error("modes.insert_extra_initialisation_call: " ++
-			"modes.construct_initialisation_call failed")
+		error("modes.construct_initialisation_call")
 	).
 
 
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.144
diff -u -r1.144 type_util.m
--- compiler/type_util.m	16 Oct 2004 15:05:51 -0000	1.144
+++ compiler/type_util.m	12 Nov 2004 00:57:46 -0000
@@ -841,6 +841,9 @@
 		TypeBody = solver_type(_, _)
 	;
 		TypeBody = abstract_type(solver_type)
+	;
+		TypeBody = eqv_type(EqvType),
+		type_util__type_is_solver_type(ModuleInfo, EqvType)
 	).
 
 
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.140
diff -u -r1.140 unify_proc.m
--- compiler/unify_proc.m	5 Sep 2004 23:52:49 -0000	1.140
+++ compiler/unify_proc.m	11 Nov 2004 09:04:55 -0000
@@ -733,6 +733,23 @@
 		unify_proc__quantify_clauses_body([X], Goal, Context, Clauses,
 			!Info)
 	;
+		% If this is an equivalence type then we just generate a
+		% call to the initialisation pred of the type on the RHS
+		% of the equivalence and cast the result back to the type
+		% on the LHS of the equivalence.
+		TypeBody = eqv_type(EqvType)
+	->
+		goal_info_init(Context, GoalInfo),
+		unify_proc__make_fresh_named_var_from_type(EqvType,
+			"PreCast_HeadVar", 1, X0, !Info),
+		modes__construct_initialisation_call(ModuleInfo, X0, EqvType,
+			free, Context, no, InitGoal),
+		generate_unsafe_cast(X0, X, any(shared), Context, CastGoal),
+		Goal = conj([InitGoal, CastGoal]) - GoalInfo,
+		unify_proc__quantify_clauses_body([X], Goal, Context, Clauses,
+			!Info)
+	;
 		error("trying to create initialisation proc for type " ++
 			"that has no solver_type_details")
 	).
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------