[m-rev.] diff: treat foreign types as equivalent to c_pointer

[Peter Ross]

Hi,


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


Estimated hours taken: 4
Branches: main

compiler/type_ctor_info.m:
compiler/unify_proc.m:
    Treat foreign_types as equivalent to the c_pointer type for their
    type_ctor_info and unify and comparison procs.


Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.26
diff -u -r1.26 type_ctor_info.m
--- compiler/type_ctor_info.m	7 May 2002 11:03:13 -0000	1.26
+++ compiler/type_ctor_info.m	13 May 2002 09:41:46 -0000
@@ -254,13 +254,17 @@
 		TypeTables = [],
 		NumPtags = -1
 	;
+			% We treat foreign_types as equivalent to the
+			% type builtin__c_pointer.
 		TypeBody = foreign_type(_, _),
-		TypeCtorRep = unknown,
-		NumFunctors = -1,
-		FunctorsInfo = no_functors,
-		LayoutInfo = no_layout,
-		TypeTables = [],
-		NumPtags = -1
+		Ctxt = term__context("builtin.m", 1),
+		Type = functor(term__atom(":"), [
+				functor(term__atom("builtin"), [], Ctxt),
+				functor(term__atom("c_pointer"), [], Ctxt)],
+				Ctxt),
+		gen_layout_info_eqv_type(Type, TypeArity,
+				TypeCtorRep, NumFunctors, FunctorsInfo,
+				LayoutInfo, NumPtags, TypeTables)
 	;
 		TypeBody = eqv_type(Type),
 		( term__is_ground(Type) ->
@@ -327,6 +331,31 @@
 			)
 		)
 	).
+
+:- pred gen_layout_info_eqv_type((type)::in, int::in,
+		type_ctor_rep::out, int::out, type_ctor_functors_info::out,
+		type_ctor_layout_info::out, int::out,
+		list(rtti_data)::out) is det.
+
+gen_layout_info_eqv_type(Type, TypeArity,
+		TypeCtorRep, NumFunctors, FunctorsInfo,
+		LayoutInfo, NumPtags, TypeTables) :-
+	( term__is_ground(Type) ->
+		TypeCtorRep = equiv(equiv_type_is_ground)
+	;
+		TypeCtorRep = equiv(equiv_type_is_not_ground)
+	),
+	NumFunctors = -1,
+	FunctorsInfo = no_functors,
+	UnivTvars = TypeArity,
+		% There can be no existentially typed args to an
+		% equivalence.
+	ExistTvars = [],
+	make_pseudo_type_info_and_tables(Type,
+		UnivTvars, ExistTvars, PseudoTypeInfoRttiData,
+		[], TypeTables),
+	LayoutInfo = equiv_layout(PseudoTypeInfoRttiData),
+	NumPtags = -1.
 
 % Construct an rtti_data for a pseudo_type_info,
 % and also construct rtti_data definitions for all of the pseudo_type_infos
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.108
diff -u -r1.108 unify_proc.m
--- compiler/unify_proc.m	7 May 2002 11:03:14 -0000	1.108
+++ compiler/unify_proc.m	13 May 2002 09:41:47 -0000
@@ -738,41 +738,52 @@
 		)
 	;
 		{ TypeBody = eqv_type(EqvType) },
-		% We should check whether EqvType is a type variable,
-		% an abstract type or a concrete type.
-		% If it is type variable, then we should generate the same code
-		% we generate now. If it is an abstract type, we should call
-		% its unification procedure directly; if it is a concrete type,
-		% we should generate the body of its unification procedure
-		% inline here.
-		unify_proc__make_fresh_named_var_from_type(EqvType,
-			"Cast_HeadVar", 1, CastVar1),
-		unify_proc__make_fresh_named_var_from_type(EqvType,
-			"Cast_HeadVar", 2, CastVar2),
-		unify_proc__build_call("unsafe_type_cast", [H1, CastVar1],
-			Context, Cast1Goal),
-		unify_proc__build_call("unsafe_type_cast", [H2, CastVar2],
-			Context, Cast2Goal),
-		{ create_atomic_unification(CastVar1, var(CastVar2), Context,
-			explicit, [], UnifyGoal) },
-
-		{ goal_info_init(GoalInfo0) },
-		{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
-		{ conj_list_to_goal([Cast1Goal, Cast2Goal, UnifyGoal],
-			GoalInfo, Goal) },
-		unify_proc__quantify_clauses_body([H1, H2], Goal, Context,
-			Clauses)
+		generate_unify_clauses_eqv_type(EqvType, H1, H2,
+				Context, Clauses)
 	;
+		% We treat foreign_type as if they were an equivalent to
+		% the builtin type c_pointer.
 		{ TypeBody = foreign_type(_, _) },
-		unify_proc__build_call("nyi_foreign_type_unify", [H1, H2],
-				Context, Goal),
-		unify_proc__quantify_clauses_body([H1, H2], Goal, Context,
-			Clauses)
+		{ Ctxt = term__context("builtin.m", 1) },
+		{ Type = functor(term__atom(":"), [
+				functor(term__atom("builtin"), [], Ctxt),
+				functor(term__atom("c_pointer"), [], Ctxt)],
+				Ctxt) },
+		generate_unify_clauses_eqv_type(Type, H1, H2, Context, Clauses)
 	;
 		{ TypeBody = abstract_type },
 		{ error("trying to create unify proc for abstract type") }
 	).
 
+:- pred generate_unify_clauses_eqv_type((type)::in, prog_var::in, prog_var::in,
+		prog_context::in, list(clause)::out,
+		unify_proc_info::in, unify_proc_info::out) is det.
+
+generate_unify_clauses_eqv_type(EqvType, H1, H2, Context, Clauses) -->
+	% We should check whether EqvType is a type variable,
+	% an abstract type or a concrete type.
+	% If it is type variable, then we should generate the same code
+	% we generate now. If it is an abstract type, we should call
+	% its unification procedure directly; if it is a concrete type,
+	% we should generate the body of its unification procedure
+	% inline here.
+	unify_proc__make_fresh_named_var_from_type(EqvType,
+		"Cast_HeadVar", 1, CastVar1),
+	unify_proc__make_fresh_named_var_from_type(EqvType,
+		"Cast_HeadVar", 2, CastVar2),
+	unify_proc__build_call("unsafe_type_cast", [H1, CastVar1],
+		Context, Cast1Goal),
+	unify_proc__build_call("unsafe_type_cast", [H2, CastVar2],
+		Context, Cast2Goal),
+	{ create_atomic_unification(CastVar1, var(CastVar2), Context,
+		explicit, [], UnifyGoal) },
+
+	{ goal_info_init(GoalInfo0) },
+	{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+	{ conj_list_to_goal([Cast1Goal, Cast2Goal, UnifyGoal],
+		GoalInfo, Goal) },
+	unify_proc__quantify_clauses_body([H1, H2], Goal, Context, Clauses).
+
 	% This predicate generates the bodies of index predicates for the
 	% types that need index predicates.
 	%
@@ -871,40 +882,52 @@
 		)
 	;
 		{ TypeBody = eqv_type(EqvType) },
-		% We should check whether EqvType is a type variable,
-		% an abstract type or a concrete type.
-		% If it is type variable, then we should generate the same code
-		% we generate now. If it is an abstract type, we should call
-		% its comparison procedure directly; if it is a concrete type,
-		% we should generate the body of its comparison procedure
-		% inline here.
-		unify_proc__make_fresh_named_var_from_type(EqvType,
-			"Cast_HeadVar", 1, CastVar1),
-		unify_proc__make_fresh_named_var_from_type(EqvType,
-			"Cast_HeadVar", 2, CastVar2),
-		unify_proc__build_call("unsafe_type_cast", [H1, CastVar1],
-			Context, Cast1Goal),
-		unify_proc__build_call("unsafe_type_cast", [H2, CastVar2],
-			Context, Cast2Goal),
-		unify_proc__build_call("compare", [Res, CastVar1, CastVar2],
-			Context, CompareGoal),
-
-		{ goal_info_init(GoalInfo0) },
-		{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
-		{ conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal],
-			GoalInfo, Goal) },
-		unify_proc__quantify_clauses_body([Res, H1, H2], Goal, Context,
-			Clauses)
+		generate_compare_clauses_eqv_type(EqvType,
+				Res, H1, H2, Context, Clauses)
 	;
 		{ TypeBody = foreign_type(_, _) },
-		unify_proc__build_call("nyi_foreign_type_compare",
-				[Res, H1, H2], Context, Goal),
-		unify_proc__quantify_clauses_body([Res, H1, H2], Goal, Context,
-			Clauses)
+		{ Ctxt = term__context("builtin.m", 1) },
+		{ CPointerType = functor(term__atom(":"), [
+				functor(term__atom("builtin"), [], Ctxt),
+				functor(term__atom("c_pointer"), [], Ctxt)],
+				Ctxt) },
+		generate_compare_clauses_eqv_type(CPointerType,
+				Res, H1, H2, Context, Clauses)
 	;
 		{ TypeBody = abstract_type },
 		{ error("trying to create compare proc for abstract type") }
 	).
+
+:- pred generate_compare_clauses_eqv_type((type)::in,
+		prog_var::in, prog_var::in, prog_var::in,
+		prog_context::in, list(clause)::out,
+		unify_proc_info::in, unify_proc_info::out) is det.
+
+generate_compare_clauses_eqv_type(EqvType, Res, H1, H2, Context, Clauses) -->
+	% We should check whether EqvType is a type variable,
+	% an abstract type or a concrete type.
+	% If it is type variable, then we should generate the same code
+	% we generate now. If it is an abstract type, we should call
+	% its comparison procedure directly; if it is a concrete type,
+	% we should generate the body of its comparison procedure
+	% inline here.
+	unify_proc__make_fresh_named_var_from_type(EqvType,
+		"Cast_HeadVar", 1, CastVar1),
+	unify_proc__make_fresh_named_var_from_type(EqvType,
+		"Cast_HeadVar", 2, CastVar2),
+	unify_proc__build_call("unsafe_type_cast", [H1, CastVar1],
+		Context, Cast1Goal),
+	unify_proc__build_call("unsafe_type_cast", [H2, CastVar2],
+		Context, Cast2Goal),
+	unify_proc__build_call("compare", [Res, CastVar1, CastVar2],
+		Context, CompareGoal),
+
+	{ goal_info_init(GoalInfo0) },
+	{ goal_info_set_context(GoalInfo0, Context, GoalInfo) },
+	{ conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal],
+		GoalInfo, Goal) },
+	unify_proc__quantify_clauses_body([Res, H1, H2], Goal, Context,
+		Clauses).
 
 :- pred unify_proc__quantify_clauses_body(list(prog_var)::in, hlds_goal::in,
 	prog_context::in, list(clause)::out,

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------