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

[Ralph Becket]

This relative diff addresses Zoltan's review comments and fixes a bug to
do with the compiler-generated declarations for the special preds for
imported types (this caused the compiler to abort on one of my solver
types test programs).

Estimated hours taken: 50
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 two
	extra inst parameters (needed because solver types
	typically have inst any rather than ground).

compiler/make_hlds.m:
	Fixed a bug whereby the declarations for special preds for imported
	types were incorrectly being module qualified using the name of the
	*importing* module.

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.

Relative diff:
diff -u compiler/goal_util.m compiler/goal_util.m
--- compiler/goal_util.m	11 Nov 2004 08:30:00 -0000
+++ compiler/goal_util.m	16 Nov 2004 05:14:30 -0000
@@ -238,7 +238,7 @@
 	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.
+	(inst)::in, (inst)::in, prog_context::in, hlds_goal::out) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -1275,15 +1275,15 @@
 	Goal = GoalExpr - GoalInfo.
 
 generate_unsafe_cast(InArg, OutArg, Context, Goal) :-
-	Inst = ground(shared, none),
-	generate_unsafe_cast(InArg, OutArg, Inst, Context, Goal).
+	Ground = ground(shared, none),
+	generate_unsafe_cast(InArg, OutArg, Ground, Ground, Context, Goal).
 
-generate_unsafe_cast(InArg, OutArg, Inst, Context, Goal) :-
+generate_unsafe_cast(InArg, OutArg, InInst, OutInst, Context, Goal) :-
 	set__list_to_set([InArg, OutArg], NonLocals),
-	instmap_delta_from_assoc_list([OutArg - Inst], InstMapDelta),
+	instmap_delta_from_assoc_list([OutArg - OutInst], InstMapDelta),
 	goal_info_init(NonLocals, InstMapDelta, det, pure, Context, GoalInfo),
 	Goal = generic_call(unsafe_cast, [InArg, OutArg],
-		[in_mode(Inst), out_mode(Inst)], det) - GoalInfo.
+		[in_mode(InInst), out_mode(OutInst)], det) - GoalInfo.
 
 %-----------------------------------------------------------------------------%
 
diff -u compiler/modes.m compiler/modes.m
--- compiler/modes.m	11 Nov 2004 08:23:31 -0000
+++ compiler/modes.m	17 Nov 2004 06:39:38 -0000
@@ -2653,11 +2653,11 @@
 
 
 :- pred modes__build_call(module_name::in, string::in, list(prog_var)::in,
-	prog_context::in, maybe(call_unify_context)::in,
-	module_info::in, hlds_goal::out) is semidet.
+	prog_context::in, maybe(call_unify_context)::in, module_info::in,
+	hlds_goal::out) is semidet.
 
-modes__build_call(Module, Name, ArgVars, Context, CallUnifyContext,
-		ModuleInfo, Goal) :-
+modes__build_call(Module, Name, ArgVars, Context,
+		CallUnifyContext, ModuleInfo, Goal) :-
 	module_info_get_predicate_table(ModuleInfo, PredicateTable),
 	list__length(ArgVars, Arity),
 	predicate_table_search_pred_m_n_a(PredicateTable, is_fully_qualified,
diff -u compiler/unify_proc.m compiler/unify_proc.m
--- compiler/unify_proc.m	11 Nov 2004 09:04:55 -0000
+++ compiler/unify_proc.m	17 Nov 2004 06:40:33 -0000
@@ -733,7 +733,44 @@
 		unify_proc__quantify_clauses_body([X], Goal, Context, Clauses,
 			!Info)
 	;
-		error("trying to create initialisation proc for type " ++
+		% 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),
+		(
+			type_to_ctor_and_args(EqvType, TypeCtor0, _TypeArgs)
+		->
+			TypeCtor = TypeCtor0
+		;
+			error("unify_proc__generate_initialise_clauses: " ++
+				"type_to_ctor_and_args failed")
+		),
+		PredName = special_pred__special_pred_name(initialise,
+				TypeCtor),
+		hlds_module__module_info_name(ModuleInfo, ModuleName),
+		TypeCtor = TypeSymName - _TypeArity,
+		sym_name_get_module_name(TypeSymName, ModuleName,
+			TypeModuleName),
+		InitPred = qualified(TypeModuleName, PredName),
+		PredId   = invalid_pred_id,
+		ModeId   = invalid_proc_id,
+		InitCall = call(PredId, ModeId, [X0], not_builtin, no,
+				InitPred),
+		InitGoal = InitCall - GoalInfo,
+
+		Any = any(shared),
+		generate_unsafe_cast(X0, X, Any, Any, Context, CastGoal),
+		Goal = conj([InitGoal, CastGoal]) - GoalInfo,
+		unify_proc__quantify_clauses_body([X], Goal, Context, Clauses,
+			!Info)
+	;
+		error("unify_proc__generate_initialise_clauses: " ++
+			"trying to create initialisation proc for type " ++
 			"that has no solver_type_details")
 	).
 
only in patch2:
--- compiler/make_hlds.m	5 Nov 2004 05:39:05 -0000	1.485
+++ compiler/make_hlds.m	17 Nov 2004 06:14:45 -0000
@@ -4248,7 +4248,9 @@
 	module_info_name(!.Module, ModuleName),
 	special_pred_interface(SpecialPredId, Type, ArgTypes, ArgModes, Det),
 	Name = special_pred_name(SpecialPredId, TypeCtor),
-	PredName = unqualified(Name),
+	TypeCtor = TypeSymName - _TypeArity,
+	sym_name_get_module_name(TypeSymName, ModuleName, TypeModuleName),
+	PredName = qualified(TypeModuleName, Name),
 	special_pred_name_arity(SpecialPredId, _, Arity),
 	clauses_info_init(Arity, ClausesInfo0),
 	adjust_special_pred_status(SpecialPredId, Status0, Status),
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------