for review: suppress private_builtin:type_info/1.

Tyson Dowd trd at cs.mu.OZ.AU
Sun Aug 2 18:10:25 AEST 1998
Previous message: diff: remove dead code in polymorphism.m
Next message: [m-dev.] for review: suppress private_builtin:type_info/1.
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Hi,

This half of a change designed to allow runtime systems (e.g. the
garbage collector and debugger) to print type_infos.

Essentially, private_builtin:type_info/1 has hand defined base_type_*
structures, and handwritten special preds (the same ones that
std_util:type_info/0 previously used).

std_util:type_info/0 is defined as an abstract equivalence to
private_builtin:type_info/1.

===================================================================


Estimated hours taken: 5

Don't generate base_type_* structures or special preds for
private_builtin:type_info/1 and private_builtin:base_type_info/1.

This allows us to write definitions for it by hand.

compiler/base_type_info.m:
compiler/base_type_layout.m:
	Don't generate structures if type_id_is_hand_defined for
	that type_id.

compiler/make_hlds.m:
compiler/unify_proc.m:
	Don't generate special preds if type_id_is_hand_defined for
	that type_id.

compiler/type_util.m:
	Define type_id_is_hand_defined.


Index: compiler/base_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_type_info.m,v
retrieving revision 1.17
diff -u -r1.17 base_type_info.m
--- base_type_info.m	1998/05/25 21:48:44	1.17
+++ base_type_info.m	1998/07/31 06:53:35
@@ -39,7 +39,7 @@
 :- import_module base_typeclass_info.
 :- import_module prog_data, prog_util, prog_out.
 :- import_module hlds_data, hlds_pred, hlds_out.
-:- import_module code_util, special_pred, globals, options.
+:- import_module code_util, special_pred, type_util, globals, options.
 
 :- import_module bool, string, map, std_util, require.
 
@@ -70,7 +70,10 @@
 	TypeId = SymName - TypeArity,
 	(
 		SymName = qualified(TypeModuleName, TypeName),
-		( TypeModuleName = ModuleName ->
+		( 
+			TypeModuleName = ModuleName,
+			\+ type_id_is_hand_defined(TypeId)
+		->
 			map__lookup(TypeTable, TypeId, TypeDefn),
 			hlds_data__get_type_defn_status(TypeDefn, Status),
 			special_pred_list(Specials),
Index: compiler/base_type_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/base_type_layout.m,v
retrieving revision 1.31
diff -u -r1.31 base_type_layout.m
--- base_type_layout.m	1998/07/08 20:55:45	1.31
+++ base_type_layout.m	1998/07/31 06:47:04
@@ -285,10 +285,14 @@
 		ModuleInfo, BaseGenInfos1),
 	TypeId = SymName - TypeArity,
 	(
-		% Is this type defined in this module? 
+		% Is this type defined in this module and not hand
+		% defined?
 			
 		SymName = qualified(TypeModuleName, TypeName),
-		( TypeModuleName = ModuleName ->
+		( 
+			TypeModuleName = ModuleName,
+			\+ type_id_is_hand_defined(TypeId)
+		->
 			map__lookup(TypeTable, TypeId, TypeDefn),
 			hlds_data__get_type_defn_status(TypeDefn, Status),
 
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.269
diff -u -r1.269 make_hlds.m
--- make_hlds.m	1998/07/08 20:56:38	1.269
+++ make_hlds.m	1998/08/02 07:13:37
@@ -985,7 +985,11 @@
 		),
 		{ construct_qualified_term(Name, Args, Type) },
 		(
-			{ Body = abstract_type }
+			( 
+				{ Body = abstract_type }
+			;
+				{ type_id_is_hand_defined(TypeId) }
+			)
 		->
 			{ special_pred_list(SpecialPredIds) },
 			{ add_special_pred_decl_list(SpecialPredIds,
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.140
diff -u -r1.140 polymorphism.m
--- polymorphism.m	1998/07/30 09:00:14	1.140
+++ polymorphism.m	1998/08/01 05:11:45
@@ -2306,81 +2306,6 @@
 
 	CountUnifyGoal = CountUnify - CountGoalInfo.
 
-	% Create the unifications to initialize the special pred
-	% variables for this type:
-	%
-	%	SpecialPred1 = __Unify__<type>,
-	%	SpecialPred2 = __Index__<type>,
-	%	SpecialPred3 = __Compare__<type>.
-
-:- pred polymorphism__get_special_proc_list(
-			type, module_info, varset, map(var, type),
-			list(var), list(hlds_goal), varset, map(var, type)).
-:- mode polymorphism__get_special_proc_list(in, in, in, in,
-					out, out, out, out) is det.
-
-polymorphism__get_special_proc_list(Type, ModuleInfo, VarSet0, VarTypes0,
-		SpecialPredVars, SpecialPredGoals, VarSet, VarTypes) :-
-	special_pred_list(SpecialPreds),
-	polymorphism__get_special_proc_list_2(SpecialPreds,
-		Type, ModuleInfo, VarSet0, VarTypes0,
-		SpecialPredVars, SpecialPredGoals, VarSet, VarTypes).
-
-:- pred polymorphism__get_special_proc_list_2(list(special_pred_id),
-			type, module_info, varset, map(var, type),
-			list(var), list(hlds_goal), varset, map(var, type)).
-:- mode polymorphism__get_special_proc_list_2(in, in, in, in, in,
-					out, out, out, out) is det.
-
-polymorphism__get_special_proc_list_2([],
-		_Type, _ModuleInfo, VarSet, VarTypes,
-		[], [], VarSet, VarTypes).
-polymorphism__get_special_proc_list_2([Id | Ids],
-		Type, ModuleInfo, VarSet0, VarTypes0,
-		[Var | Vars], [Goal | Goals], VarSet, VarTypes) :-
-
-	% introduce a fresh variable of the appropriate higher-order pred type
-
-	special_pred_info(Id, Type, PredName, TypeArgs, _Modes, _Det),
-	varset__new_var(VarSet0, Var, VarSet1a),
-	string__append("Var__", PredName, VarName),
-	varset__name_var(VarSet1a, Var, VarName, VarSet1),
-	term__context_init(Context),
-	PredType = term__functor(term__atom("pred"), TypeArgs, Context),
-	map__set(VarTypes0, Var, PredType, VarTypes1),
-
-	% get the ConsId for the address of the appropriate pred
-	% for the operation specified by Id applied to Type.
-
-	classify_type(Type, ModuleInfo, TypeCategory),
-	polymorphism__get_special_proc(TypeCategory, Type, Id, ModuleInfo,
-					PredName2, PredId, ProcId),
-	ConsId = code_addr_const(PredId, ProcId),
-
-	% create a construction unification which unifies the fresh
-	% variable with the address constant obtained above
-
-	Unification = construct(Var, ConsId, [], []),
-
-	Term = functor(cons(PredName2, 0), []),
-
-	Inst = bound(unique, [functor(cons(PredName2, 0), [])]),
-	UnifyMode = (free -> Inst) - (Inst -> Inst),
-	UnifyContext = unify_context(explicit, []),
-		% XXX the UnifyContext is wrong
-	Unify = unify(Var, Term, UnifyMode, Unification, UnifyContext),
-
-	% create a goal_info for the unification
-
-	set__singleton_set(NonLocals, Var),
-	instmap_delta_from_assoc_list([Var - Inst], InstMapDelta),
-	goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
-	Goal = Unify - GoalInfo,
-
-	polymorphism__get_special_proc_list_2(Ids,
-		Type, ModuleInfo, VarSet1, VarTypes1,
-		Vars, Goals, VarSet, VarTypes).
-
 :- pred polymorphism__get_special_proc(builtin_type, type, special_pred_id,
 				module_info, sym_name, pred_id, proc_id).
 :- mode polymorphism__get_special_proc(in, in, in, in, out, out, out) is det.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.56
diff -u -r1.56 type_util.m
--- type_util.m	1998/07/08 20:57:31	1.56
+++ type_util.m	1998/08/01 05:24:06
@@ -43,6 +43,13 @@
 :- pred type_id_is_higher_order(type_id, pred_or_func).
 :- mode type_id_is_higher_order(in, out) is semidet.
 
+	% A test for types that are defined by hand (not including
+	% the builtin types).  Don't generate base_type_*
+	% for these types.
+
+:- pred type_id_is_hand_defined(type_id).
+:- mode type_id_is_hand_defined(in) is semidet.
+
 	% Given a type, determine what sort of type it is.
 
 :- pred classify_type(type, module_info, builtin_type).
@@ -229,6 +236,11 @@
 	BuiltinType \= user_type.
 
 type_util__var(term__variable(Var), Var).
+
+type_id_is_hand_defined(qualified(PrivateBuiltin, "type_info") - 1) :-
+	mercury_private_builtin_module(PrivateBuiltin).
+type_id_is_hand_defined(qualified(PrivateBuiltin, "base_type_info") - 1) :-
+	mercury_private_builtin_module(PrivateBuiltin).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.69
diff -u -r1.69 unify_proc.m
--- unify_proc.m	1998/07/08 20:57:38	1.69
+++ unify_proc.m	1998/08/02 05:28:29
@@ -213,12 +213,17 @@
 unify_proc__request_unify(UnifyId, Determinism, Context, ModuleInfo0,
 		ModuleInfo) :-
 	%
-	% check if this unification has already been requested
+	% check if this unification has already been requested, or
+	% if the proc is hand defined.
 	%
 	UnifyId = TypeId - UnifyMode,
 	(
-		unify_proc__search_mode_num(ModuleInfo0, TypeId, UnifyMode,
-			Determinism, _)
+		(
+			unify_proc__search_mode_num(ModuleInfo0, TypeId,
+				UnifyMode, Determinism, _)
+		; 
+			type_id_is_hand_defined(TypeId)
+		)
 	->
 		ModuleInfo = ModuleInfo0
 	;


-- 
       Tyson Dowd           # There isn't any reason why Linux can't be
                            # implemented as an enterprise computing solution.
     trd at cs.mu.oz.au        # Find out what you've been missing while you've
http://www.cs.mu.oz.au/~trd # been rebooting Windows NT. -- InfoWorld, 1998.
Previous message: diff: remove dead code in polymorphism.m
Next message: [m-dev.] for review: suppress private_builtin:type_info/1.
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the developers mailing list