[m-rev.] diff: remove dependency on type_info arg

[Mark Brown]

On 02-Sep-2005, Mark Brown <mark at cs.mu.OZ.AU> wrote:
> With this change it is now possible to replace the arguments of type_info/1
> with `void' and still pass bootcheck.  Zoltan, you can now proceed with
> the change to remove the arguments of type_info/1 and typclass_info/1.

Actually, there was one spot I missed.  Some code in polymorphism.m which
is called for solver types was building type_info types independently of
the main body of this module.

This is for review by Ralph.

Cheers,
Mark.

Estimated hours taken: 3
Branches: main

More work to ensure the type_info argument is not referred to anywhere.  This
also fixes a problem with the handling of poly_infos which are created for
inititialisation predicates.

compiler/modes.m:
	Construct the poly_info using the caller pred_info and proc_info.
	It is the caller that is updated with new program and type variables,
	not the callee.

	Pass the callee pred_info and proc_info as separate arguments to
	polymorphism__process_new_call, but don't return new versions
	since they should not be updated.

	Update the module_info with the new pred_info and proc_info for the
	caller.  Update the mode_info with the new info for the caller.

compiler/polymorphism.m:
	Delete the predicate create_poly_info_for_new_call.  It is not used
	any more, and could only be used to build an inconsistent poly_info
	anyway.

	Add two arguments to process_new_call, for the callee pred_info and
	proc_info.  Calculate the appropriate type substitution by renaming
	apart and then unifying the callee argument types with the call
	argument types.  Calculate the type_infos to pass by looking up the
	callee rtti_varmaps to determine which callee type variables the
	type_infos are for, and then applying the above type substitution.
	(We also check that none of the extra arguments are for
	typeclass_infos, which are not supported at the moment.)

Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.309
diff -u -r1.309 modes.m
--- compiler/modes.m	30 Aug 2005 04:11:55 -0000	1.309
+++ compiler/modes.m	5 Sep 2005 05:15:50 -0000
@@ -3168,30 +3168,57 @@
     maybe(call_unify_context)::in, hlds_goal::out,
     mode_info::in, mode_info::out) is semidet.
 
-build_call(ModuleName, PredName, ArgVars, NonLocals, InstmapDelta, Context,
-        CallUnifyContext, Goal, !ModeInfo) :-
+build_call(CalleeModuleName, CalleePredName, ArgVars, NonLocals, InstmapDelta,
+        Context, CallUnifyContext, Goal, !ModeInfo) :-
     mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
+
+        % Get the pred_info and proc_info for the procedure we are calling.
+        %
     module_info_get_predicate_table(ModuleInfo0, PredicateTable),
     list__length(ArgVars, Arity),
     predicate_table_search_pred_m_n_a(PredicateTable, is_fully_qualified,
-        ModuleName, PredName, Arity, [PredId]),
-    ProcNo = 0, % first mode
-    hlds_pred__proc_id_to_int(ProcId, ProcNo),
+        CalleeModuleName, CalleePredName, Arity, [CalleePredId]),
+    CalleeProcNo = 0, % first mode
+    hlds_pred__proc_id_to_int(CalleeProcId, CalleeProcNo),
+    module_info_pred_proc_info(ModuleInfo0, CalleePredId, CalleeProcId,
+        CalleePredInfo, CalleeProcInfo),
+
+        % Get the relevant information for the procedure we are transforming
+        % (ie, the caller).
+        %
+    mode_info_get_predid(!.ModeInfo, PredId),
+    mode_info_get_procid(!.ModeInfo, ProcId),
     module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, PredInfo0,
         ProcInfo0),
-    mode_info_get_varset(!.ModeInfo, VarSet0),
-    mode_info_get_var_types(!.ModeInfo, VarTypes0),
-    polymorphism__create_poly_info_for_new_call(ModuleInfo0, PredInfo0,
-        ProcInfo0, VarSet0, VarTypes0, PolyInfo0),
+
+        % Create a poly_info for the caller.
+        %
+    polymorphism__create_poly_info(ModuleInfo0, PredInfo0, ProcInfo0,
+        PolyInfo0),
+
+        % Create a goal_info for the call.
+        %
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo1),
     goal_info_set_nonlocals(NonLocals, GoalInfo1, GoalInfo2),
     goal_info_set_instmap_delta(InstmapDelta, GoalInfo2, GoalInfo),
-    polymorphism__process_new_call(PredId, ProcId, ArgVars, not_builtin,
-        CallUnifyContext, qualified(ModuleName, PredName),
-        GoalInfo, Goal, PolyInfo0, PolyInfo),
-    polymorphism__poly_info_extract(PolyInfo, PredInfo0, _PredInfo,
-        ProcInfo0, ProcInfo, ModuleInfo),
+
+        % Do the transformation for this call goal.
+        %
+    SymName = qualified(CalleeModuleName, CalleePredName),
+    polymorphism__process_new_call(CalleePredInfo, CalleeProcInfo,
+        CalleePredId, CalleeProcId, ArgVars, not_builtin, CallUnifyContext,
+        SymName, GoalInfo, Goal, PolyInfo0, PolyInfo),
+
+        % Update the information in the predicate table.
+        %
+    polymorphism__poly_info_extract(PolyInfo, PredInfo0, PredInfo,
+        ProcInfo0, ProcInfo, ModuleInfo1),
+    module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
+        ModuleInfo1, ModuleInfo),
+
+        % Update the information in the mode_info.
+        %
     proc_info_varset(ProcInfo, VarSet),
     proc_info_vartypes(ProcInfo, VarTypes),
     mode_info_set_varset(VarSet, !ModeInfo),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.270
diff -u -r1.270 polymorphism.m
--- compiler/polymorphism.m	30 Aug 2005 04:11:56 -0000	1.270
+++ compiler/polymorphism.m	5 Sep 2005 05:19:08 -0000
@@ -208,10 +208,10 @@
 % XXX This predicate does not yet handle calls whose arguments include
 % existentially quantified types or type class constraints.
 
-:- pred polymorphism__process_new_call(pred_id::in, proc_id::in,
-	list(prog_var)::in, builtin_state::in, maybe(call_unify_context)::in,
-	sym_name::in, hlds_goal_info::in, hlds_goal::out,
-	poly_info::in, poly_info::out) is det.
+:- pred polymorphism__process_new_call(pred_info::in, proc_info::in,
+	pred_id::in, proc_id::in, list(prog_var)::in, builtin_state::in,
+	maybe(call_unify_context)::in, sym_name::in, hlds_goal_info::in,
+	hlds_goal::out, poly_info::in, poly_info::out) is det.
 
 % Given a list of types, create a list of variables to hold the type_info
 % for those types, and create a list of goals to initialize those type_info
@@ -254,13 +254,6 @@
 :- pred create_poly_info(module_info::in, pred_info::in,
 	proc_info::in, poly_info::out) is det.
 
-	% Extract some fields from a pred_info and proc_info and use them to
-	% create a poly_info, for use by the polymorphism transformation for
-	% transforming a new call goal.
-	%
-:- pred create_poly_info_for_new_call(module_info::in, pred_info::in,
-	proc_info::in, prog_varset::in, vartypes::in, poly_info::out) is det.
-
 	% Update the fields in a pred_info and proc_info with
 	% the values in a poly_info.
 :- pred poly_info_extract(poly_info::in, pred_info::in, pred_info::out,
@@ -1922,53 +1915,71 @@
 % XXX This predicate does not yet handle calls whose arguments include
 % existentially quantified types or type class constraints.
 
-polymorphism__process_new_call(PredId, ProcId, CallArgs0, BuiltinState,
-		MaybeCallUnifyContext, SymName, GoalInfo0, Goal, !Info) :-
-	poly_info_get_var_types(!.Info, CallVarTypes),
-	poly_info_get_typevarset(!.Info, CallTypeVarSet0),
-	poly_info_get_pred_info(!.Info, PredInfo),
-	pred_info_arg_types(PredInfo, PredArgTypes),
-
-		% Work out the types of the provided call args.
-		%
-	CallArgTypes0 = map__apply_to_list(CallArgs0, CallVarTypes),
+polymorphism__process_new_call(CalleePredInfo, CalleeProcInfo, PredId, ProcId,
+		CallArgs0, BuiltinState, MaybeCallUnifyContext, SymName,
+		GoalInfo0, Goal, !Info) :-
+	poly_info_get_typevarset(!.Info, TVarSet0),
+	poly_info_get_var_types(!.Info, VarTypes0),
+	ActualArgTypes0 = map__apply_to_list(CallArgs0, VarTypes0),
+	pred_info_arg_types(CalleePredInfo, PredTVarSet, _PredExistQVars,
+		PredArgTypes),
+	proc_info_headvars(CalleeProcInfo, CalleeHeadVars),
+	proc_info_rtti_varmaps(CalleeProcInfo, CalleeRttiVarMaps),
 
 		% Work out how many type_info args we need to prepend.
 		%
-	NCallArgs0 = list__length(CallArgTypes0),
+	NCallArgs0 = list__length(ActualArgTypes0),
 	NPredArgs  = list__length(PredArgTypes),
 	NExtraArgs = NPredArgs - NCallArgs0,
+	(
+		list__drop(NExtraArgs, PredArgTypes, OrigPredArgTypes0),
+		list__take(NExtraArgs, CalleeHeadVars, CalleeExtraHeadVars0)
+	->
+		OrigPredArgTypes = OrigPredArgTypes0,
+		CalleeExtraHeadVars = CalleeExtraHeadVars0
+	;
+		unexpected(this_file, "process_new_call: extra args not found")
+	),
 
-		% Construct a fresh type var for each extra type_info
-		% we need to prepend.
+		% Work out the bindings of type variables in the call.
 		%
-		% That is, for every such type_info we construct a new
-		% type variable ExtraTypeTypeVar which we will bind to a
-		% term private_builtin.type_info(ExtraArgTypeParam),
-		% where ExtraArgTypeParam is also a new type variable.
-		%
-	varset__new_vars(CallTypeVarSet0, NExtraArgs, ExtraArgTypeVars,
-		CallTypeVarSet1),
-	list__map2_foldl(bind_type_var_to_type_info_wrapper,
-		ExtraArgTypeVars, ExtraArgTypes0, ExtraArgTypeParams0,
-		CallTypeVarSet1, _CallTypeVarSet),
-
-		% Prepend the list of types to the call arg types and unify
-		% the resulting list with the pred arg types.  This should
-		% result in the earlier fresh ExtraArgTypeParams being unified
-		% with the types for which we need to construct type_infos.
-		%
-	CallArgTypes = ExtraArgTypes0 ++ CallArgTypes0,
-	unify_corresponding_types(PredArgTypes, CallArgTypes,
-		map__init, Substitution),
-	ExtraArgTypeParams = term__apply_rec_substitution_to_list(
-				ExtraArgTypeParams0, Substitution),
+	varset__merge_subst(TVarSet0, PredTVarSet, TVarSet,
+		PredToParentTSubst),
+	term__apply_substitution_to_list(OrigPredArgTypes, PredToParentTSubst,
+		OrigParentArgTypes),
+	type_list_subsumes_det(OrigParentArgTypes, ActualArgTypes0,
+		ParentToActualTSubst),
+	poly_info_set_typevarset(TVarSet, !Info),
+
+		% Look up the type variables that the type_infos in the
+		% caller are for, and apply the type bindings to calculate
+		% the types that the caller should pass type_infos for.
+		%
+	GetTypeInfoTypes = (pred(ProgVar::in, TypeInfoType::out) is det :-
+			rtti_varmaps_var_info(CalleeRttiVarMaps, ProgVar,
+				VarInfo),
+			(
+				VarInfo = type_info_var(TypeInfoType)
+			;
+				VarInfo = typeclass_info_var(_),
+				unexpected(this_file, "unsupported: " ++
+					"constraints on initialisation preds")
+			;
+				VarInfo = non_rtti_var,
+				unexpected(this_file, "missing rtti_var_info"
+					++ " for initialisation pred")
+			)
+		),
+	list__map(GetTypeInfoTypes, CalleeExtraHeadVars, PredTypeInfoTypes),
+	term__apply_substitution_to_list(PredTypeInfoTypes, PredToParentTSubst,
+		ParentTypeInfoTypes),
+	term__apply_rec_substitution_to_list(ParentTypeInfoTypes,
+		ParentToActualTSubst, ActualTypeInfoTypes),
 
-		% And finally construct the type_info goals and args we
-		% need to prepend to complete the call.
+		% Construct goals to make the required type_infos.
 		%
 	Ctxt = term__context_init,
-	make_type_info_vars(ExtraArgTypeParams, Ctxt, ExtraArgs, ExtraGoals,
+	make_type_info_vars(ActualTypeInfoTypes, Ctxt, ExtraArgs, ExtraGoals,
 		!Info),
 	CallArgs = ExtraArgs ++ CallArgs0,
 	goal_info_get_nonlocals(GoalInfo0, NonLocals0),
@@ -1980,25 +1991,6 @@
 	CallGoal = CallGoalExpr - GoalInfo,
 	conj_list_to_goal(ExtraGoals ++ [CallGoal], GoalInfo, Goal).
 
-
-	% bind_type_var_to_type_info_wrapper(X, Type, Param, VarSet0, VarSet)
-	% constructs a new type var Param and binds X to the Type form of
-	% `private_builtin.type_info(Param)'.
-	%
-:- pred bind_type_var_to_type_info_wrapper(tvar::in, (type)::out, (type)::out,
-	tvarset::in, tvarset::out) is det.
-
-bind_type_var_to_type_info_wrapper(X, Type, Param, TVarSet0, TVarSet) :-
-	varset__new_var(TVarSet0, Y, TVarSet1),
-	Param = variable(Y),
-	Ctxt  = term__context_init,
-	Type  = functor(atom("."),
-			[ functor(atom("private_builtin"), [], Ctxt),
-			  functor(atom("type_info"), [Param], Ctxt) ],
-			Ctxt),
-	varset__bind_var(TVarSet1, X, Type, TVarSet).
-
-
 :- pred unify_corresponding_types(list(type)::in, list(type)::in, 
 		tsubst::in, tsubst::out) is det.
 
@@ -3465,17 +3457,6 @@
 	PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, RttiVarMaps,
 		Proofs, ConstraintMap, PredInfo, ModuleInfo).
 
-	% create_poly_info creates a poly_info for a call.
-	% (See also init_poly_info.)
-create_poly_info_for_new_call(ModuleInfo, PredInfo, ProcInfo, VarSet, VarTypes,
-		PolyInfo) :-
-	pred_info_typevarset(PredInfo, TypeVarSet),
-	pred_info_get_constraint_proofs(PredInfo, Proofs),
-	pred_info_get_constraint_map(PredInfo, ConstraintMap),
-	proc_info_rtti_varmaps(ProcInfo, RttiVarMaps),
-	PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, RttiVarMaps,
-		Proofs, ConstraintMap, PredInfo, ModuleInfo).
-
 poly_info_extract(Info, !PredInfo, !ProcInfo, ModuleInfo) :-
 	Info = poly_info(VarSet, VarTypes, TypeVarSet, RttiVarMaps, _Proofs,
 		_ConstraintMap, _OldPredInfo, ModuleInfo),
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------