[m-rev.] diff: construct__num_functors for IL backend

[Peter Ross]

Hi,


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


Estimated hours taken: 2
Branches: main

Implement construct__num_functors in Mercury.

libray/rtti_implementation.m:
	Implement num_functors in Mercury.
	Make type_info and type_ctor_info be synonyms for type_desc
	and type_ctor_desc, seeing that they are.

library/construct.m:
	Call the rtti_implementation version of num_functors.


Index: construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.8
diff -u -r1.8 construct.m
--- construct.m	21 Nov 2002 15:14:43 -0000	1.8
+++ construct.m	20 Dec 2002 16:08:15 -0000
@@ -86,6 +86,8 @@
 
 :- implementation.
 
+:- use_module rtti_implementation.
+
 :- pragma foreign_decl("C", "
 
 #include ""mercury_type_desc.h""
@@ -102,10 +104,7 @@
 	MR_restore_transient_registers();
 }").
 
-num_functors(_) = _ :-
-	% This version is only used for back-ends for which there is no
-	% matching foreign_proc version.
-	private_builtin__sorry("construct__num_functors").
+num_functors(TypeDesc) = rtti_implementation__num_functors(TypeDesc).
 
 :- pragma foreign_proc("C",
 	get_functor(TypeDesc::in, FunctorNumber::in, FunctorName::out,
Index: rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.35
diff -u -r1.35 rtti_implementation.m
--- rtti_implementation.m	3 Dec 2002 11:25:36 -0000	1.35
+++ rtti_implementation.m	20 Dec 2002 16:08:15 -0000
@@ -32,11 +32,10 @@
 :- import_module deconstruct, list.
 
 :- use_module std_util.
+:- use_module type_desc.
 
-	% Our type_info and type_ctor_info implementations are both
-	% abstract types.
-:- type type_info.
-:- type type_ctor_info.
+:- type type_info == type_desc__type_desc.
+:- type type_ctor_info == type_desc__type_ctor_desc.
 
 :- func get_type_info(T::unused) = (type_info::out) is det.
 
@@ -65,6 +64,12 @@
 :- func unsafe_cast(T1::in) = (T2::out) is det.
 
 %-----------------------------------------------------------------------------%
+%
+% Implementations for use from construct.
+
+:- func num_functors(type_desc__type_desc) = int.
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -123,14 +128,109 @@
 
 	% We keep all the other types abstract.
 
-:- type type_ctor_info ---> type_ctor_info(c_pointer).
-:- type type_info ---> type_info(c_pointer).
 :- type compare_pred ---> compare_pred(c_pointer).
 :- type type_functors ---> type_functors(c_pointer).
 :- type type_layout ---> type_layout(c_pointer).
 :- type pred_type ---> pred_type(c_pointer).
 :- type pseudo_type_info ---> pred_type(c_pointer).
 
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% Implementation of the interface to construct.
+%
+
+	% See MR_get_num_functors in runtime/mercury_construct.c
+num_functors(TypeInfo) = NumFunctors :-
+	TypeCtorInfo = get_type_ctor_info(TypeInfo),
+	TypeCtorRep = TypeCtorInfo ^ type_ctor_rep,
+	( TypeCtorRep = du,
+		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
+	; TypeCtorRep = du_usereq,
+		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
+	; TypeCtorRep = reserved_addr,
+		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
+	; TypeCtorRep = reserved_addr_usereq,
+		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
+	; TypeCtorRep = enum,
+		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
+	; TypeCtorRep = enum_usereq,
+		NumFunctors = TypeCtorInfo ^ type_ctor_num_functors
+
+	; TypeCtorRep = notag,
+		NumFunctors = 1
+	; TypeCtorRep = notag_usereq,
+		NumFunctors = 1
+	; TypeCtorRep = notag_ground,
+		NumFunctors = 1
+	; TypeCtorRep = notag_ground_usereq,
+		NumFunctors = 1
+	; TypeCtorRep = tuple,
+		NumFunctors = 1
+	; TypeCtorRep = univ,
+		NumFunctors = 1
+
+	; TypeCtorRep = equiv_ground,
+		error("rtti_implementation num_functors for equiv types")
+	; TypeCtorRep = equiv,
+		error("rtti_implementation num_functors for equiv types")
+
+	; TypeCtorRep = int,
+		NumFunctors = -1
+	; TypeCtorRep = char,
+		NumFunctors = -1
+	; TypeCtorRep = float,
+		NumFunctors = -1
+	; TypeCtorRep = string,
+		NumFunctors = -1
+	; TypeCtorRep = (func),
+		NumFunctors = -1
+	; TypeCtorRep = (pred),
+		NumFunctors = -1
+	; TypeCtorRep = void,
+		NumFunctors = -1
+	; TypeCtorRep = c_pointer,
+		NumFunctors = -1
+	; TypeCtorRep = typeinfo,
+		NumFunctors = -1
+	; TypeCtorRep = type_ctor_info,
+		NumFunctors = -1
+	; TypeCtorRep = type_desc,
+		NumFunctors = -1
+	; TypeCtorRep = type_ctor_desc,
+		NumFunctors = -1
+	; TypeCtorRep = typeclassinfo,
+		NumFunctors = -1
+	; TypeCtorRep = base_typeclass_info,
+		NumFunctors = -1
+	; TypeCtorRep = array,
+		NumFunctors = -1
+	; TypeCtorRep = succip,
+		NumFunctors = -1
+	; TypeCtorRep = hp,
+		NumFunctors = -1
+	; TypeCtorRep = curfr,
+		NumFunctors = -1
+	; TypeCtorRep = maxfr,
+		NumFunctors = -1
+	; TypeCtorRep = redofr,
+		NumFunctors = -1
+	; TypeCtorRep = redoip,
+		NumFunctors = -1
+	; TypeCtorRep = trail_ptr,
+		NumFunctors = -1
+	; TypeCtorRep = ticket,
+		NumFunctors = -1
+	; TypeCtorRep = foreign,
+		NumFunctors = -1
+
+	; TypeCtorRep = unknown,
+		error("num_functors: unknown type_ctor_rep")
+	).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
 :- pragma foreign_proc("C#",
 	get_type_info(_T::unused) = (TypeInfo::out),
 	[will_not_call_mercury, promise_pure, thread_safe],
@@ -1778,6 +1878,22 @@
 	% This version is only used for back-ends for which there is no
 	% matching foreign_proc version.
 	private_builtin__sorry("type_layout").
+
+:- func type_ctor_num_functors(type_ctor_info) = int.
+
+:- pragma foreign_proc("C#",
+	type_ctor_num_functors(TypeCtorInfo::in) = (TypeLayout::out),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+	TypeLayout = (int)
+		TypeCtorInfo[(int)
+			type_ctor_info_field_nums.type_ctor_num_functors];
+").
+
+type_ctor_num_functors(_) = _ :-
+	% This version is only used for back-ends for which there is no
+	% matching foreign_proc version.
+	private_builtin__sorry("type_ctor_num_functors").
 
 :- pragma foreign_proc("C",
 	unsafe_cast(VarIn::in) = (VarOut::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
--------------------------------------------------------------------------