[m-rev.] for review: pseudo-typeinfo RTTI in Mercury
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Apr 10 19:00:17 AEST 2002
For review by anyone. Maybe Pete, since it is mostly for him.
Estimated hours taken: 40
Branches: main
A step towards RTTI in Mercury.
This step redefines the representation of pseudo-typeinfos inside the compiler
to be identical to the representation we will need for efficient interpretation
of RTTI data structures in Mercury. Later steps will do likewise for
typectorinfos. In the end, we will have two implementations of RTTI:
the current low-level, very efficient one written in C, which will be used
by the C backends (both LLDS and MLDS), and a new, higher-level one
which will use Mercury data structures and Mercury predicates for
interpretation (along the lines of library/rtti_implementation.m)
for the Java and IL backends.
A large part of this change concerns the fact that pseudo-typeinfos can now
contain typeinfos as well as other pseudo-typeinfos, and they do in the
frequent case that the type of an argument is ground. Given that typeinfos
are just special cases of pseudo-typeinfos, the code for handling the two
types is usually similar, with common code factored out when relevant.
In the process of redesigning the data structures concerning (pseudo-)
typeinfos, I also fixed an old naming scheme that has become misleading.
The representation of a (pseudo-) typeinfo depends on whether the principal
type constructor is fixed arity or not. We used to denote this distinction
with the phrases first-order vs higher-order, since at first the only variable
arity type constructors were pred and func. However, this hasn't been true
since we added tuples. I have changed the naming scheme to be fixed-arity vs
variable-arity.
compiler/rtti.m:
Add new, purely Mercury data structures for representing typeinfos
and pseudo-typeinfos, designed both for efficient interpretation
and as a source for the generation of static data structures in C.
compiler/pseudo_type_info.m:
Delete the type definitions here, since they are superseded by the new
definitions in rtti.m.
Add predicates for constructing typeinfos as well as pseudo-typeinfos,
since now we need those too.
Conform to the changed data structures for (pseudo-) typeinfos.
compiler/ll_pseudo_type_info.m:
compiler/ml_closure_gen.m:
compiler/rtti_out.m:
compiler/rtti_to_mlds.m:
compiler/opt_debug.m:
compiler/type_ctor_info.m:
Conform to the changed data structures for (pseudo-) typeinfos.
compiler/mlds.m:
Since the MLDS now refers to type_infos, add their type
(mlds__type_info_type) to the list of types the MLDS knows about.
compiler/ml_code_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
Handle mlds__type_info_type.
compiler/mlds_to_gcc.m:
Conform to the changed data structures for (pseudo-) typeinfos,
and handle mlds__type_info_type.
runtime/mercury_bootstrap.h:
Override the compiler-generated names of the type_ctor_infos of the
variable arity type constructors. The MLDS backend requires these
to be module qualified; the LLDS backend requires them to be
unqualified. This is a problem because the same code now generates
the compiler's internal representation of pseudo-typeinfos for both
backends.
The temporary solution is to have the compiler generate these names
module qualified, and have these macros convert them to the unqualified
form. (The long term solution should be to always module qualify
everything, but doing that is for another change.)
runtime/mercury_type_info.h:
Change the naming scheme from first order vs higher order to fixed
arity vs variable arity.
library/construct.m:
library/deconstruct.m:
runtime/mercury.c:
runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_deep_copy_body.h:
runtime/mercury_make_type_info_body.h:
runtime/mercury_ml_expand_body.h:
runtime/mercury_tabling.c:
runtime/mercury_type_desc.c:
runtime/mercury_type_info.c:
runtime/mercury_unify_compare_body.h:
Conform to the new naming scheme.
runtime/mercury.h:
Conform to the new naming scheme.
Declare fixed and variable arity types for typeinfos as well as
pseudo-typeinfos, since pseudo-typeinfos can now refer to typeinfos.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing bytecode/test
cvs diff: Diffing compiler
Index: compiler/ll_pseudo_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ll_pseudo_type_info.m,v
retrieving revision 1.4
diff -u -b -r1.4 ll_pseudo_type_info.m
--- compiler/ll_pseudo_type_info.m 20 Mar 2002 12:36:31 -0000 1.4
+++ compiler/ll_pseudo_type_info.m 31 Mar 2002 10:06:42 -0000
@@ -69,50 +69,100 @@
ExistQTvars, PseudoRval, LldsType, C0, C) :-
pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo),
- convert_pseudo(Pseudo, PseudoRval, LldsType, C0, C).
+ convert_pseudo_type_info(Pseudo, PseudoRval, LldsType, C0, C).
-:- pred convert_pseudo(pseudo_type_info, rval, llds_type, counter, counter).
-:- mode convert_pseudo(in, out, out, in, out) is det.
+:- pred convert_pseudo_type_info(rtti_pseudo_type_info::in,
+ rval::out, llds_type::out, counter::in, counter::out) is det.
-convert_pseudo(Pseudo, Rval, LldsType, C0, C) :-
+convert_pseudo_type_info(Pseudo, Rval, LldsType, C0, C) :-
(
Pseudo = type_var(Int),
Rval = const(int_const(Int)),
LldsType = integer,
C = C0
;
- Pseudo = type_ctor_info(RttiTypeCtor),
+ Pseudo = plain_arity_zero_pseudo_type_info(RttiTypeCtor),
DataAddr = rtti_addr(RttiTypeCtor, pseudo_type_info(Pseudo)),
Rval = const(data_addr_const(DataAddr)),
LldsType = data_ptr,
C = C0
;
- Pseudo = type_info(RttiTypeCtor, Args),
- convert_compound_pseudo(RttiTypeCtor, [], Args, Rval, LldsType,
- C0, C)
+ Pseudo = plain_pseudo_type_info(RttiTypeCtor, Args),
+ convert_compound_pseudo_type_info(RttiTypeCtor, [], Args,
+ Rval, LldsType, C0, C)
;
- Pseudo = higher_order_type_info(RttiTypeCtor, Arity, Args),
+ Pseudo = var_arity_pseudo_type_info(VarArityId, Args),
+ list__length(Args, Arity),
ArityArg = yes(const(int_const(Arity))),
- convert_compound_pseudo(RttiTypeCtor, [ArityArg], Args, Rval,
- LldsType, C0, C)
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
+ convert_compound_pseudo_type_info(RttiTypeCtor, [ArityArg],
+ Args, Rval, LldsType, C0, C)
).
-:- pred convert_compound_pseudo(rtti_type_ctor, list(maybe(rval)),
- list(pseudo_type_info), rval, llds_type, counter, counter).
-:- mode convert_compound_pseudo(in, in, in, out, out, in, out) is det.
+:- pred convert_plain_type_info(rtti_type_info::in,
+ rval::out, llds_type::out, counter::in, counter::out) is det.
-convert_compound_pseudo(RttiTypeCtor, ArgRvals0, Args,
+convert_plain_type_info(TypeInfo, Rval, LldsType, C0, C) :-
+ (
+ TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
+ DataAddr = rtti_addr(RttiTypeCtor, type_info(TypeInfo)),
+ Rval = const(data_addr_const(DataAddr)),
+ LldsType = data_ptr,
+ C = C0
+ ;
+ TypeInfo = plain_type_info(RttiTypeCtor, Args),
+ convert_compound_type_info(RttiTypeCtor, [], Args,
+ Rval, LldsType, C0, C)
+ ;
+ TypeInfo = var_arity_type_info(VarArityId, Args),
+ list__length(Args, Arity),
+ ArityArg = yes(const(int_const(Arity))),
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
+ convert_compound_type_info(RttiTypeCtor, [ArityArg],
+ Args, Rval, LldsType, C0, C)
+ ).
+
+:- pred convert_compound_pseudo_type_info(rtti_type_ctor::in,
+ list(maybe(rval))::in, list(rtti_maybe_pseudo_type_info)::in,
+ rval::out, llds_type::out, counter::in, counter::out) is det.
+
+convert_compound_pseudo_type_info(RttiTypeCtor, ArgRvals0, Args,
+ Rval, LldsType, C0, C) :-
+ TypeCtorInfoData = pseudo_type_info(
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor)),
+ TypeCtorInfoDataAddr = rtti_addr(RttiTypeCtor, TypeCtorInfoData),
+ TypeCtorInfoRval = yes(const(data_addr_const(TypeCtorInfoDataAddr))),
+ LldsType = data_ptr,
+ counter__allocate(CNum, C0, C1),
+ list__map_foldl((pred(A::in, yes(AR)::out, CS0::in, CS::out) is det :-
+ (
+ A = pseudo(PTI),
+ convert_pseudo_type_info(PTI, AR, _LldsType, CS0, CS)
+ ;
+ A = plain(TI),
+ convert_plain_type_info(TI, AR, _LldsType, CS0, CS)
+ )
+ ), Args, ArgRvals1, C1, C),
+ list__append(ArgRvals0, ArgRvals1, ArgRvals),
+ Reuse = no,
+ Rval = create(0, [TypeCtorInfoRval | ArgRvals],
+ uniform(no), must_be_static, CNum, "type_info", Reuse).
+
+:- pred convert_compound_type_info(rtti_type_ctor::in, list(maybe(rval))::in,
+ list(rtti_type_info)::in, rval::out, llds_type::out,
+ counter::in, counter::out) is det.
+
+convert_compound_type_info(RttiTypeCtor, ArgRvals0, Args,
Rval, LldsType, C0, C) :-
- TypeCtorInfoPseudo = pseudo_type_info(type_ctor_info(RttiTypeCtor)),
- TypeCtorInfoDataAddr = rtti_addr(RttiTypeCtor, TypeCtorInfoPseudo),
+ TypeCtorInfoData = type_info(plain_arity_zero_type_info(RttiTypeCtor)),
+ TypeCtorInfoDataAddr = rtti_addr(RttiTypeCtor, TypeCtorInfoData),
TypeCtorInfoRval = yes(const(data_addr_const(TypeCtorInfoDataAddr))),
LldsType = data_ptr,
counter__allocate(CNum, C0, C1),
list__map_foldl((pred(A::in, yes(AR)::out, CS0::in, CS::out) is det :-
- convert_pseudo(A, AR, _LldsType, CS0, CS)
+ convert_plain_type_info(A, AR, _LldsType, CS0, CS)
), Args, ArgRvals1, C1, C),
list__append(ArgRvals0, ArgRvals1, ArgRvals),
Reuse = no,
Rval = create(0, [TypeCtorInfoRval | ArgRvals],
- uniform(no), must_be_static, CNum, "type_info",
- Reuse).
+ uniform(no), must_be_static, CNum, "type_info", Reuse).
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.9
diff -u -b -r1.9 ml_closure_gen.m
--- compiler/ml_closure_gen.m 31 Mar 2002 08:03:25 -0000 1.9
+++ compiler/ml_closure_gen.m 3 Apr 2002 06:01:05 -0000
@@ -284,40 +284,72 @@
CastArgRval = unop(box(ArgType), ArgRval),
ArgInit = init_obj(CastArgRval).
-:- pred ml_gen_pseudo_type_info_defn(module_info::in, pseudo_type_info::in,
- mlds__defns::in, mlds__defns::out) is det.
+:- pred ml_gen_maybe_pseudo_type_info_defn(module_info::in,
+ rtti_maybe_pseudo_type_info::in, mlds__defns::in, mlds__defns::out)
+ is det.
-ml_gen_pseudo_type_info_defn(ModuleInfo, Pseudo, Defns0, Defns) :-
- ml_gen_pseudo_type_info(ModuleInfo, Pseudo, _Rval, _Type,
+ml_gen_maybe_pseudo_type_info_defn(ModuleInfo, MaybePTI, Defns0, Defns) :-
+ ml_gen_maybe_pseudo_type_info(ModuleInfo, MaybePTI, _Rval, _Type,
Defns0, Defns).
-:- pred ml_gen_pseudo_type_info(module_info::in, pseudo_type_info::in,
+:- pred ml_gen_pseudo_type_info_defn(module_info::in,
+ rtti_pseudo_type_info::in, mlds__defns::in, mlds__defns::out) is det.
+
+ml_gen_pseudo_type_info_defn(ModuleInfo, PTI, Defns0, Defns) :-
+ ml_gen_pseudo_type_info(ModuleInfo, PTI, _Rval, _Type, Defns0, Defns).
+
+:- pred ml_gen_type_info_defn(module_info::in,
+ rtti_type_info::in, mlds__defns::in, mlds__defns::out) is det.
+
+ml_gen_type_info_defn(ModuleInfo, TI, Defns0, Defns) :-
+ ml_gen_type_info(ModuleInfo, TI, _Rval, _Type, Defns0, Defns).
+
+:- pred ml_gen_maybe_pseudo_type_info(module_info::in,
+ rtti_maybe_pseudo_type_info::in, mlds__rval::out, mlds__type::out,
+ mlds__defns::in, mlds__defns::out) is det.
+
+ml_gen_maybe_pseudo_type_info(ModuleInfo, MaybePseudoTypeInfo, Rval, Type,
+ MLDS_Defns0, MLDS_Defns) :-
+ (
+ MaybePseudoTypeInfo = pseudo(PseudoTypeInfo),
+ ml_gen_pseudo_type_info(ModuleInfo, PseudoTypeInfo, Rval, Type,
+ MLDS_Defns0, MLDS_Defns)
+ ;
+ MaybePseudoTypeInfo = plain(TypeInfo),
+ ml_gen_type_info(ModuleInfo, TypeInfo, Rval, Type,
+ MLDS_Defns0, MLDS_Defns)
+ ).
+
+:- pred ml_gen_pseudo_type_info(module_info::in, rtti_pseudo_type_info::in,
mlds__rval::out, mlds__type::out,
mlds__defns::in, mlds__defns::out) is det.
-ml_gen_pseudo_type_info(ModuleInfo, Pseudo, Rval, Type,
+ml_gen_pseudo_type_info(ModuleInfo, PseudoTypeInfo, Rval, Type,
MLDS_Defns0, MLDS_Defns) :-
- ( Pseudo = type_var(N) ->
+ ( PseudoTypeInfo = type_var(N) ->
% type variables are represented just as integers
Rval = const(int_const(N)),
Type = mlds__native_int_type,
MLDS_Defns = MLDS_Defns0
;
- ( Pseudo = type_ctor_info(RttiTypeId0) ->
+ (
+ PseudoTypeInfo =
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor0)
+ ->
% for zero-arity types, we just generate a
% reference to the already-existing type_ctor_info
RttiName = type_ctor_info,
- RttiTypeId0 = rtti_type_ctor(ModuleName0, _, _),
+ RttiTypeCtor0 = rtti_type_ctor(ModuleName0, _, _),
ModuleName = fixup_builtin_module(ModuleName0),
- RttiTypeId = RttiTypeId0,
+ RttiTypeCtor = RttiTypeCtor0,
MLDS_Defns = MLDS_Defns0
;
% for other types, we need to generate a definition
% of the pseudo_type_info for that type,
% in the the current module
module_info_name(ModuleInfo, ModuleName),
- RttiData = pseudo_type_info(Pseudo),
- rtti_data_to_name(RttiData, RttiTypeId, RttiName),
+ RttiData = pseudo_type_info(PseudoTypeInfo),
+ rtti_data_to_name(RttiData, RttiTypeCtor, RttiName),
RttiDefns0 = rtti_data_list_to_mlds(ModuleInfo,
[RttiData]),
% rtti_data_list_to_mlds assumes that the result
@@ -326,26 +358,76 @@
% to `local'
RttiDefns = list__map(convert_to_local, RttiDefns0),
MLDS_Defns1 = RttiDefns ++ MLDS_Defns0,
- % Generate definitions of any pseudo_type_infos
- % referenced by this pseudotypeinfo.
- list__foldl(ml_gen_pseudo_type_info_defn(ModuleInfo),
- arg_pseudo_type_infos(Pseudo),
+ % Generate definitions of any type_infos and
+ % pseudo_type_infos referenced by this
+ % pseudo_type_info.
+ list__foldl(
+ ml_gen_maybe_pseudo_type_info_defn(ModuleInfo),
+ arg_maybe_pseudo_type_infos(PseudoTypeInfo),
MLDS_Defns1, MLDS_Defns)
),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
Rval = const(data_addr_const(data_addr(MLDS_ModuleName,
- rtti(RttiTypeId, RttiName)))),
+ rtti(RttiTypeCtor, RttiName)))),
Type = mlds__rtti_type(RttiName)
).
-:- func arg_pseudo_type_infos(pseudo_type_info) = list(pseudo_type_info).
-arg_pseudo_type_infos(type_var(_)) = [].
-arg_pseudo_type_infos(type_ctor_info(_)) = [].
-arg_pseudo_type_infos(type_info(_TypeId, ArgPTIs)) = ArgPTIs.
-arg_pseudo_type_infos(higher_order_type_info(_TypeId, _Arity, ArgPTIs)) =
- ArgPTIs.
+:- pred ml_gen_type_info(module_info::in, rtti_type_info::in,
+ mlds__rval::out, mlds__type::out,
+ mlds__defns::in, mlds__defns::out) is det.
+
+ml_gen_type_info(ModuleInfo, TypeInfo, Rval, Type,
+ MLDS_Defns0, MLDS_Defns) :-
+ ( TypeInfo = plain_arity_zero_type_info(RttiTypeCtor0) ->
+ % for zero-arity types, we just generate a
+ % reference to the already-existing type_ctor_info
+ RttiName = type_ctor_info,
+ RttiTypeCtor0 = rtti_type_ctor(ModuleName0, _, _),
+ ModuleName = fixup_builtin_module(ModuleName0),
+ RttiTypeCtor = RttiTypeCtor0,
+ MLDS_Defns = MLDS_Defns0
+ ;
+ % for other types, we need to generate a definition
+ % of the type_info for that type, in the the current module
+ module_info_name(ModuleInfo, ModuleName),
+ RttiData = type_info(TypeInfo),
+ rtti_data_to_name(RttiData, RttiTypeCtor, RttiName),
+ RttiDefns0 = rtti_data_list_to_mlds(ModuleInfo, [RttiData]),
+ % rtti_data_list_to_mlds assumes that the result
+ % will be at file scope, but here we're generating it
+ % as a local, so we need to convert the access
+ % to `local'
+ RttiDefns = list__map(convert_to_local, RttiDefns0),
+ MLDS_Defns1 = RttiDefns ++ MLDS_Defns0,
+ % Generate definitions of any type_infos referenced by this
+ % type_info.
+ list__foldl(ml_gen_type_info_defn(ModuleInfo),
+ arg_type_infos(TypeInfo),
+ MLDS_Defns1, MLDS_Defns)
+ ),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ Rval = const(data_addr_const(data_addr(MLDS_ModuleName,
+ rtti(RttiTypeCtor, RttiName)))),
+ Type = mlds__rtti_type(RttiName).
+
+:- func arg_maybe_pseudo_type_infos(rtti_pseudo_type_info)
+ = list(rtti_maybe_pseudo_type_info).
+
+arg_maybe_pseudo_type_infos(type_var(_)) = [].
+arg_maybe_pseudo_type_infos(plain_arity_zero_pseudo_type_info(_)) = [].
+arg_maybe_pseudo_type_infos(plain_pseudo_type_info(_TypeCtor, ArgMPTIs))
+ = ArgMPTIs.
+arg_maybe_pseudo_type_infos(var_arity_pseudo_type_info(_VarArityId, ArgMPTIs))
+ = ArgMPTIs.
+
+:- func arg_type_infos(rtti_type_info) = list(rtti_type_info).
+
+arg_type_infos(plain_arity_zero_type_info(_)) = [].
+arg_type_infos(plain_type_info(_TypeCtor, ArgTIs)) = ArgTIs.
+arg_type_infos(var_arity_type_info(_VarArityId, ArgTIs)) = ArgTIs.
:- func convert_to_local(mlds__defn) = mlds__defn.
+
convert_to_local(mlds__defn(Name, Context, Flags0, Body)) =
mlds__defn(Name, Context, Flags, Body) :-
Flags = set_access(Flags0, local).
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.61
diff -u -b -r1.61 ml_code_util.m
--- compiler/ml_code_util.m 2 Apr 2002 16:36:11 -0000 1.61
+++ compiler/ml_code_util.m 3 Apr 2002 06:01:05 -0000
@@ -2175,6 +2175,7 @@
ml_type_might_contain_pointers(mlds__func_type(_)) = no.
ml_type_might_contain_pointers(mlds__generic_type) = yes.
ml_type_might_contain_pointers(mlds__generic_env_ptr_type) = yes.
+ml_type_might_contain_pointers(mlds__type_info_type) = yes.
ml_type_might_contain_pointers(mlds__pseudo_type_info_type) = yes.
ml_type_might_contain_pointers(mlds__cont_type(_)) = no.
ml_type_might_contain_pointers(mlds__commit_type) = no.
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.88
diff -u -b -r1.88 mlds.m
--- compiler/mlds.m 2 Apr 2002 16:36:13 -0000 1.88
+++ compiler/mlds.m 3 Apr 2002 06:01:06 -0000
@@ -677,6 +677,8 @@
% closures for higher-order code.
; mlds__generic_env_ptr_type
+ ; mlds__type_info_type
+
; mlds__pseudo_type_info_type
; mlds__rtti_type(rtti_name)
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.124
diff -u -b -r1.124 mlds_to_c.m
--- compiler/mlds_to_c.m 2 Apr 2002 16:36:13 -0000 1.124
+++ compiler/mlds_to_c.m 3 Apr 2002 06:01:06 -0000
@@ -679,6 +679,8 @@
io__write_string("MR_Word").
mlds_output_pragma_export_type(prefix, mlds__generic_env_ptr_type) -->
io__write_string("MR_Word").
+mlds_output_pragma_export_type(prefix, mlds__type_info_type) -->
+ io__write_string("MR_Word").
mlds_output_pragma_export_type(prefix, mlds__pseudo_type_info_type) -->
io__write_string("MR_Word").
mlds_output_pragma_export_type(prefix, mlds__rtti_type(_)) -->
@@ -1678,6 +1680,8 @@
io__write_string("MR_Box").
mlds_output_type_prefix(mlds__generic_env_ptr_type) -->
io__write_string("void *").
+mlds_output_type_prefix(mlds__type_info_type) -->
+ io__write_string("MR_TypeInfo").
mlds_output_type_prefix(mlds__pseudo_type_info_type) -->
io__write_string("MR_PseudoTypeInfo").
mlds_output_type_prefix(mlds__cont_type(ArgTypes)) -->
@@ -1815,6 +1819,7 @@
mlds_output_func_type_suffix(FuncParams).
mlds_output_type_suffix(mlds__generic_type, _) --> [].
mlds_output_type_suffix(mlds__generic_env_ptr_type, _) --> [].
+mlds_output_type_suffix(mlds__type_info_type, _) --> [].
mlds_output_type_suffix(mlds__pseudo_type_info_type, _) --> [].
mlds_output_type_suffix(mlds__cont_type(ArgTypes), _) -->
( { ArgTypes = [] } ->
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.68
diff -u -b -r1.68 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 2 Apr 2002 16:36:15 -0000 1.68
+++ compiler/mlds_to_gcc.m 3 Apr 2002 06:01:07 -0000
@@ -1777,6 +1777,7 @@
gcc__build_pointer_type(GCC_FuncType, GCC_FuncPtrType).
build_type(mlds__generic_type, _, _, 'MR_Box') --> [].
build_type(mlds__generic_env_ptr_type, _, _, gcc__ptr_type_node) --> [].
+build_type(mlds__type_info_type, _, _, 'MR_TypeInfo') --> [].
build_type(mlds__pseudo_type_info_type, _, _, 'MR_PseudoTypeInfo') --> [].
build_type(mlds__cont_type(ArgTypes), _, _, GCC_Type) -->
( { ArgTypes = [] } ->
@@ -2057,53 +2058,94 @@
build_rtti_type(base_typeclass_info(_, _, _), Size, GCC_Type) -->
{ MR_BaseTypeclassInfo = gcc__ptr_type_node },
build_sized_array_type(MR_BaseTypeclassInfo, Size, GCC_Type).
+build_rtti_type(type_info(TypeInfo), _, GCC_Type) -->
+ build_type_info_type(TypeInfo, GCC_Type).
build_rtti_type(pseudo_type_info(PseudoTypeInfo), _, GCC_Type) -->
build_pseudo_type_info_type(PseudoTypeInfo, GCC_Type).
build_rtti_type(type_hashcons_pointer, _, MR_TableNodePtrPtr) -->
{ MR_TableNodePtrPtr = gcc__ptr_type_node }.
-:- pred build_pseudo_type_info_type(pseudo_type_info::in,
+:- pred build_type_info_type(rtti_type_info::in,
+ gcc__type::out, io__state::di, io__state::uo) is det.
+
+build_type_info_type(plain_arity_zero_type_info(_), GCC_Type) -->
+ build_rtti_type(type_ctor_info, no_size, GCC_Type).
+build_type_info_type(plain_type_info(_TypeCtor, ArgTypes),
+ GCC_Type) -->
+ { Arity = list__length(ArgTypes) },
+ % typedef struct {
+ % MR_TypeCtorInfo MR_ti_type_ctor_info;
+ % MR_TypeInfo MR_ti_fixed_arity_arg_typeinfos[<ARITY>];
+ % } MR_FA_TypeInfo_Struct<ARITY>;
+ { MR_TypeCtorInfo = gcc__ptr_type_node },
+ gcc__build_array_type('MR_TypeInfo', Arity, MR_TypeInfoArray),
+ { StructName = string__format("MR_FA_TypeInfo_Struct%d",
+ [i(Arity)]) },
+ build_struct_type(StructName,
+ [MR_TypeCtorInfo - "MR_ti_type_ctor_info",
+ MR_TypeInfoArray - "MR_ti_fixed_arity_arg_typeinfos"],
+ GCC_Type).
+build_type_info_type(var_arity_type_info(_VarArityTypeId, ArgTypes), GCC_Type)
+ -->
+ { Arity = list__length(ArgTypes) },
+ % struct NAME {
+ % MR_TypeCtorInfo MR_ti_type_ctor_info;
+ % MR_Integer MR_ti_var_arity_arity;
+ % MR_TypeInfo MR_ti_var_arity_arg_typeinfos[ARITY];
+ % }
+ { MR_TypeCtorInfo = gcc__ptr_type_node },
+ gcc__build_array_type('MR_TypeInfo', Arity, MR_TypeInfoArray),
+ { StructName = string__format("MR_VA_TypeInfo_Struct%d",
+ [i(Arity)]) },
+ build_struct_type(StructName,
+ [MR_TypeCtorInfo - "MR_ti_type_ctor_info",
+ 'MR_Integer' - "MR_ti_var_arity_arity",
+ MR_TypeInfoArray - "MR_ti_var_arity_arg_typeinfos"],
+ GCC_Type).
+
+:- pred build_pseudo_type_info_type(rtti_pseudo_type_info::in,
gcc__type::out, io__state::di, io__state::uo) is det.
build_pseudo_type_info_type(type_var(_), _) -->
% we use small integers to represent type_vars,
% rather than pointers, so there is no pointed-to type
{ error("mlds_rtti_type: type_var") }.
-build_pseudo_type_info_type(type_ctor_info(_), GCC_Type) -->
+build_pseudo_type_info_type(plain_arity_zero_pseudo_type_info(_), GCC_Type) -->
build_rtti_type(type_ctor_info, no_size, GCC_Type).
-build_pseudo_type_info_type(type_info(_TypeCtor, ArgTypes), GCC_Type) -->
+build_pseudo_type_info_type(plain_pseudo_type_info(_TypeCtor, ArgTypes),
+ GCC_Type) -->
{ Arity = list__length(ArgTypes) },
% typedef struct {
% MR_TypeCtorInfo MR_pti_type_ctor_info;
- % MR_PseudoTypeInfo MR_pti_first_order_arg_pseudo_typeinfos[<ARITY>];
- % } MR_FO_PseudoTypeInfo_Struct<ARITY>;
+ % MR_PseudoTypeInfo MR_pti_fixed_arity_arg_pseudo_typeinfos[<ARITY>];
+ % } MR_FA_PseudoTypeInfo_Struct<ARITY>;
{ MR_TypeCtorInfo = gcc__ptr_type_node },
gcc__build_array_type('MR_PseudoTypeInfo', Arity,
MR_PseudoTypeInfoArray),
- { StructName = string__format("MR_FO_PseudoTypeInfo_Struct%d",
+ { StructName = string__format("MR_FA_PseudoTypeInfo_Struct%d",
[i(Arity)]) },
build_struct_type(StructName,
[MR_TypeCtorInfo - "MR_pti_type_ctor_info",
- MR_PseudoTypeInfoArray - "MR_pti_first_order_arg_pseudo_typeinfos"],
+ MR_PseudoTypeInfoArray - "MR_pti_fixed_arity_arg_pseudo_typeinfos"],
GCC_Type).
-build_pseudo_type_info_type(higher_order_type_info(_TypeCtor, _Arity,
+build_pseudo_type_info_type(var_arity_pseudo_type_info(_VarArityTypeId,
ArgTypes), GCC_Type) -->
{ Arity = list__length(ArgTypes) },
- % struct NAME { \
- % MR_TypeCtorInfo MR_pti_type_ctor_info; \
- % MR_Integer MR_pti_higher_order_arity; \
- % MR_PseudoTypeInfo MR_pti_higher_order_arg_pseudo_typeinfos[ARITY]; \
+ % struct NAME {
+ % MR_TypeCtorInfo MR_pti_type_ctor_info;
+ % MR_Integer MR_pti_var_arity_arity;
+ % MR_PseudoTypeInfo MR_pti_var_arity_arg_pseudo_typeinfos[ARITY];
% }
{ MR_TypeCtorInfo = gcc__ptr_type_node },
gcc__build_array_type('MR_PseudoTypeInfo', Arity,
MR_PseudoTypeInfoArray),
- { StructName = string__format("MR_HO_PseudoTypeInfo_Struct%d",
+ { StructName = string__format("MR_VA_PseudoTypeInfo_Struct%d",
[i(Arity)]) },
build_struct_type(StructName,
[MR_TypeCtorInfo - "MR_pti_type_ctor_info",
- 'MR_Integer' - "MR_pti_higher_order_arity",
+ 'MR_Integer' - "MR_pti_var_arity_arity",
MR_PseudoTypeInfoArray -
- "MR_pti_higher_order_arg_pseudo_typeinfos"],
+ "MR_pti_var_arity_arg_pseudo_typeinfos"],
GCC_Type).
:- pred build_du_exist_locn_type(gcc__type, io__state, io__state).
@@ -2315,20 +2357,21 @@
:- func fixup_rtti_name(rtti_name) = rtti_name.
fixup_rtti_name(RttiTypeCtor0) = RttiTypeCtor :-
(
- RttiTypeCtor0 = pseudo_type_info(PseudoTypeInfo0)
+ RttiTypeCtor0 = pseudo_type_info(PseudoTypeInfo)
->
RttiTypeCtor = pseudo_type_info(
- fixup_pseudo_type_info(PseudoTypeInfo0))
+ fixup_pseudo_type_info(PseudoTypeInfo))
;
RttiTypeCtor = RttiTypeCtor0
).
-:- func fixup_pseudo_type_info(pseudo_type_info) = pseudo_type_info.
+:- func fixup_pseudo_type_info(rtti_pseudo_type_info) = rtti_pseudo_type_info.
fixup_pseudo_type_info(PseudoTypeInfo0) = PseudoTypeInfo :-
(
- PseudoTypeInfo0 = type_ctor_info(RttiTypeCtor0)
+ PseudoTypeInfo0 =
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor0)
->
- PseudoTypeInfo = type_ctor_info(
+ PseudoTypeInfo = plain_arity_zero_pseudo_type_info(
fixup_rtti_type_ctor(RttiTypeCtor0))
;
PseudoTypeInfo = PseudoTypeInfo0
@@ -3422,6 +3465,7 @@
:- func 'MR_String' = gcc__type.
:- func 'MR_ConstString' = gcc__type.
:- func 'MR_Word' = gcc__type.
+:- func 'MR_TypeInfo' = gcc__type.
:- func 'MR_PseudoTypeInfo' = gcc__type.
:- func 'MR_Sectag_Locn' = gcc__type.
:- func 'MR_TypeCtorRep' = gcc__type.
@@ -3442,6 +3486,7 @@
% XXX 'MR_Word' should perhaps be unsigned, to match the C back-end
'MR_Word' = gcc__intptr_type_node.
+'MR_TypeInfo' = gcc__ptr_type_node.
'MR_PseudoTypeInfo' = gcc__ptr_type_node.
% XXX MR_Sectag_Locn and MR_TypeCtorRep are actually enums
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.111
diff -u -b -r1.111 mlds_to_il.m
--- compiler/mlds_to_il.m 2 Apr 2002 16:36:15 -0000 1.111
+++ compiler/mlds_to_il.m 3 Apr 2002 06:01:07 -0000
@@ -2962,6 +2962,9 @@
mlds_type_to_ilds_type(DataRep, mlds__array_type(ElementType)) =
ilds__type([], '[]'(mlds_type_to_ilds_type(DataRep, ElementType), [])).
+ % XXX should be checked by Tyson
+mlds_type_to_ilds_type(_, mlds__type_info_type) = il_generic_type.
+
% This is tricky. It could be an integer, or it could be
% a System.Array.
mlds_type_to_ilds_type(_, mlds__pseudo_type_info_type) = il_generic_type.
@@ -3294,8 +3297,13 @@
(
RttiName = type_ctor_info
;
+ RttiName = type_info(TypeInfo),
+ TypeInfo =
+ plain_arity_zero_type_info(RttiTypeCtor)
+ ;
RttiName = pseudo_type_info(PseudoTypeInfo),
- PseudoTypeInfo = type_ctor_info(RttiTypeCtor)
+ PseudoTypeInfo =
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor)
),
( LibModuleName0 = "builtin",
(
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.27
diff -u -b -r1.27 mlds_to_java.m
--- compiler/mlds_to_java.m 2 Apr 2002 16:36:18 -0000 1.27
+++ compiler/mlds_to_java.m 3 Apr 2002 06:01:07 -0000
@@ -1260,6 +1260,7 @@
get_java_type_initializer(mlds__func_type(_)) = "null".
get_java_type_initializer(mlds__generic_type) = "null".
get_java_type_initializer(mlds__generic_env_ptr_type) = "null".
+get_java_type_initializer(mlds__type_info_type) = "null".
get_java_type_initializer(mlds__pseudo_type_info_type) = "null".
get_java_type_initializer(mlds__rtti_type(_)) = "null".
get_java_type_initializer(mlds__unknown_type) = _ :-
@@ -1644,6 +1645,8 @@
io__write_string("java.lang.Object").
output_type(mlds__generic_env_ptr_type) -->
io__write_string("java.lang.Object").
+output_type(mlds__type_info_type) -->
+ io__write_string("mercury.runtime.TypeInfo").
output_type(mlds__pseudo_type_info_type) -->
io__write_string("mercury.runtime.PseudoTypeInfo").
output_type(mlds__cont_type(_)) -->
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.120
diff -u -b -r1.120 opt_debug.m
--- compiler/opt_debug.m 20 Mar 2002 12:37:02 -0000 1.120
+++ compiler/opt_debug.m 21 Mar 2002 00:45:37 -0000
@@ -412,7 +412,10 @@
opt_debug__dump_rtti_name(base_typeclass_info(_ModuleName, ClassId,
InstanceStr), Str) :-
llds_out__make_base_typeclass_info_name(ClassId, InstanceStr, Str).
-opt_debug__dump_rtti_name(pseudo_type_info(_Pseudo), Str) :-
+opt_debug__dump_rtti_name(type_info(_TypeInfo), Str) :-
+ % XXX should give more info than this
+ Str = "type_info".
+opt_debug__dump_rtti_name(pseudo_type_info(_PseudoTypeInfo), Str) :-
% XXX should give more info than this
Str = "pseudo_type_info".
opt_debug__dump_rtti_name(type_hashcons_pointer, Str) :-
Index: compiler/pseudo_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pseudo_type_info.m,v
retrieving revision 1.7
diff -u -b -r1.7 pseudo_type_info.m
--- compiler/pseudo_type_info.m 20 Mar 2002 12:37:15 -0000 1.7
+++ compiler/pseudo_type_info.m 31 Mar 2002 17:45:55 -0000
@@ -17,12 +17,11 @@
:- module backend_libs__pseudo_type_info.
:- interface.
:- import_module parse_tree__prog_data, backend_libs__rtti.
-:- import_module list.
% pseudo_type_info__construct_pseudo_type_info(Type,
% NumUnivQTvars, ExistQVars, PseudoTypeInfo)
%
- % Given a Mercury type (`Type'), this predicate returns an
+ % Given a Mercury type (`Type'), this predicate returns a
% representation of the pseudo type info for that type.
%
% NumUnivQTvars is either the number of universally quantified type
@@ -33,41 +32,15 @@
% quantified type variables of the constructor in question.
:- pred pseudo_type_info__construct_pseudo_type_info((type)::in,
- int::in, existq_tvars::in, pseudo_type_info::out) is det.
+ int::in, existq_tvars::in, rtti_pseudo_type_info::out) is det.
-:- type pseudo_type_info
- ---> type_var(int)
- % This represents a type variable.
- % Type variables are numbered consecutively,
- % starting from 1.
- ; type_ctor_info(
+ % pseudo_type_info__construct_type_info(Type, TypeInfo)
%
- % This represents a zero-arity type,
- % i.e. a type constructor with no arguments.
- %
- rtti_type_ctor
- )
- ; type_info(
- %
- % This represents a type with arity > zero,
- % i.e. a type constructor applied to some arguments.
- % The argument list should not be empty.
- %
- rtti_type_ctor,
- list(pseudo_type_info)
- )
- ; higher_order_type_info(
- %
- % This represents a higher-order or tuple type.
- % The rtti_type_ctor field will be pred/0,
- % func/0 or tuple/0; the real arity is
- % given in the arity field.
- %
- rtti_type_ctor,
- arity,
- list(pseudo_type_info)
- )
- .
+ % Given a ground Mercury type (`Type'), this predicate returns a
+ % representation of the type info for that type.
+
+:- pred pseudo_type_info__construct_type_info((type)::in, rtti_type_info::out)
+ is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -81,50 +54,16 @@
pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
ExistQTvars, Pseudo) :-
- (
- type_to_ctor_and_args(Type, TypeCtor, TypeArgs0)
- ->
- (
- % The argument to typeclass_info types is not
- % a type - it encodes the class constraint.
- % So we replace the argument with type `void'.
- mercury_private_builtin_module(PrivateBuiltin),
- TypeCtor = qualified(PrivateBuiltin, TName) - 1,
- ( TName = "typeclass_info"
- ; TName = "base_typeclass_info"
- )
- ->
- construct_type(unqualified("void") - 0, [], ArgType),
- TypeArgs = [ArgType]
- ;
- TypeArgs = TypeArgs0
- ),
- (
- % For higher order types: they all refer to the
- % defined pred_0 type_ctor_info, have an extra
- % argument for their real arity, and then type
- % arguments according to their types.
- % Tuples are similar -- they use the tuple_0
- % type_ctor_info.
- % polymorphism.m has a detailed explanation.
- % XXX polymorphism.m does not have a
- % detailed explanation.
- ( type_is_higher_order(Type, _, _, _) ->
- TypeName = "pred"
- ; type_is_tuple(Type, _) ->
- TypeName = "tuple"
- ;
- fail
- )
- ->
- TypeModule = unqualified(""),
- Arity = 0,
- RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName,
- Arity),
+ ( type_to_ctor_and_args(Type, TypeCtor, TypeArgs0) ->
+ canonicalize_type_args(TypeCtor, TypeArgs0, TypeArgs),
+ ( type_is_var_arity(Type, VarArityId) ->
TypeCtor = _QualTypeName - RealArity,
- pseudo_type_info__generate_args(TypeArgs,
+ pseudo_type_info__generate_pseudo_args(TypeArgs,
NumUnivQTvars, ExistQTvars, PseudoArgs),
- Pseudo = higher_order_type_info(RttiTypeCtor, RealArity,
+ require(check_var_arity(VarArityId, PseudoArgs,
+ RealArity),
+ "construct_pseudo_type_info: arity mismatch"),
+ Pseudo = var_arity_pseudo_type_info(VarArityId,
PseudoArgs)
;
TypeCtor = QualTypeName - Arity,
@@ -133,29 +72,31 @@
TypeModule),
RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName,
Arity),
- pseudo_type_info__generate_args(TypeArgs,
+ pseudo_type_info__generate_pseudo_args(TypeArgs,
NumUnivQTvars, ExistQTvars, PseudoArgs),
+ require(check_arity(PseudoArgs, Arity),
+ "construct_pseudo_type_info: arity mismatch"),
( PseudoArgs = [] ->
- Pseudo = type_ctor_info(RttiTypeCtor)
+ Pseudo = plain_arity_zero_pseudo_type_info(
+ RttiTypeCtor)
;
- Pseudo = type_info(RttiTypeCtor, PseudoArgs)
+ Pseudo = plain_pseudo_type_info(RttiTypeCtor,
+ PseudoArgs)
)
)
- ;
- type_util__var(Type, Var)
- ->
+ ; type_util__var(Type, Var) ->
% In the case of a type variable, we need to assign a
% variable number *for this constructor*, i.e. taking
% only the existentially quantified variables of
% this constructor (and not those of other functors in
% the same type) into account.
- % XXX term__var_to_int doesn't guarantee anything
- % about the ints returned (other than that they be
- % distinct for different variables), but here we are
- % relying more, specifically, on the integers being
- % allocated densely (i.e. the first N vars get integers
- % 1 to N).
+ % XXX term__var_to_int doesn't guarantee anything about the
+ % ints returned (other than that they be distinct for
+ % different variables), but here we are relying more,
+ % specifically, on the integers being allocated densely
+ % (i.e. the first N vars get integers 1 to N).
+
term__var_to_int(Var, VarInt0),
(
( VarInt0 =< NumUnivQTvars
@@ -165,7 +106,7 @@
% This is a universally quantified variable.
VarInt = VarInt0
;
- % It is existentially quantified.
+ % This is an existentially quantified variable.
(
list__nth_member_search(ExistQTvars,
Var, ExistNum0)
@@ -173,25 +114,146 @@
VarInt = ExistNum0 +
pseudo_type_info__pseudo_typeinfo_exist_var_base
;
- error("construct_pseudo_type_info: var not in list")
+ error("construct_pseudo_type_info: not in list")
)
),
require(VarInt =< pseudo_type_info__pseudo_typeinfo_max_var,
- "type_ctor_layout: type variable representation exceeds limit"),
+ "construct_pseudo_type_info: type var exceeds limit"),
Pseudo = type_var(VarInt)
;
- error("type_ctor_layout: type neither var nor non-var")
+ error("construct_pseudo_type_info: neither var nor non-var")
+ ).
+
+pseudo_type_info__construct_type_info(Type, TypeInfo) :-
+ ( type_to_ctor_and_args(Type, TypeCtor, TypeArgs0) ->
+ canonicalize_type_args(TypeCtor, TypeArgs0, TypeArgs),
+ ( type_is_var_arity(Type, VarArityId) ->
+ TypeCtor = _QualTypeName - RealArity,
+ pseudo_type_info__generate_plain_args(TypeArgs,
+ TypeInfoArgs),
+ require(check_var_arity(VarArityId, TypeInfoArgs,
+ RealArity),
+ "construct_type_info: arity mismatch"),
+ TypeInfo = var_arity_type_info(VarArityId,
+ TypeInfoArgs)
+ ;
+ TypeCtor = QualTypeName - Arity,
+ unqualify_name(QualTypeName, TypeName),
+ sym_name_get_module_name(QualTypeName, unqualified(""),
+ TypeModule),
+ RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName,
+ Arity),
+ pseudo_type_info__generate_plain_args(TypeArgs,
+ TypeInfoArgs),
+ require(check_arity(TypeInfoArgs, Arity),
+ "construct_type_info: arity mismatch"),
+ ( TypeInfoArgs = [] ->
+ TypeInfo = plain_arity_zero_type_info(
+ RttiTypeCtor)
+ ;
+ TypeInfo = plain_type_info(RttiTypeCtor,
+ TypeInfoArgs)
+ )
+ )
+ ;
+ error("construct_type_info: type is var")
+ ).
+
+:- pred check_var_arity(var_arity_ctor_id::in, list(T)::in, int::in)
+ is semidet.
+
+check_var_arity(VarArityId, Args, RealArity) :-
+ list__length(Args, NumPseudoArgs),
+ ( VarArityId = func_type_info ->
+ NumPseudoArgs = RealArity + 1
+ ;
+ NumPseudoArgs = RealArity
+ ).
+
+:- pred check_arity(list(T)::in, int::in) is semidet.
+
+check_arity(Args, RealArity) :-
+ list__length(Args, NumPseudoArgs),
+ NumPseudoArgs = RealArity.
+
+:- pred pseudo_type_info__generate_pseudo_args(list(type)::in, int::in,
+ existq_tvars::in, list(rtti_maybe_pseudo_type_info)::out) is det.
+
+pseudo_type_info__generate_pseudo_args(TypeArgs, NumUnivQTvars, ExistQTvars,
+ PseudoArgs) :-
+ list__map(pseudo_type_info__generate_pseudo_arg(NumUnivQTvars,
+ ExistQTvars),
+ TypeArgs, PseudoArgs).
+
+:- pred pseudo_type_info__generate_pseudo_arg(int::in, existq_tvars::in,
+ (type)::in, rtti_maybe_pseudo_type_info::out) is det.
+
+pseudo_type_info__generate_pseudo_arg(NumUnivQTvars, ExistQTvars,
+ TypeArg, MaybePseudoArg) :-
+ ( term__is_ground(TypeArg) ->
+ pseudo_type_info__construct_type_info(TypeArg, PseudoArg),
+ MaybePseudoArg = plain(PseudoArg)
+ ;
+ pseudo_type_info__construct_pseudo_type_info(TypeArg,
+ NumUnivQTvars, ExistQTvars, PseudoArg),
+ MaybePseudoArg = pseudo(PseudoArg)
).
-:- pred pseudo_type_info__generate_args(list(type)::in,
- int::in, existq_tvars::in, list(pseudo_type_info)::out) is det.
+:- pred pseudo_type_info__generate_plain_args(list(type)::in,
+ list(rtti_type_info)::out) is det.
-pseudo_type_info__generate_args(TypeArgs, NumUnivQTvars, ExistQTvars,
+pseudo_type_info__generate_plain_args(TypeArgs,
PseudoArgs) :-
- list__map((pred(T::in, P::out) is det :-
- pseudo_type_info__construct_pseudo_type_info(
- T, NumUnivQTvars, ExistQTvars, P)
- ), TypeArgs, PseudoArgs).
+ list__map(pseudo_type_info__construct_type_info, TypeArgs, PseudoArgs).
+
+%---------------------------------------------------------------------------%
+
+:- pred canonicalize_type_args(type_ctor::in, list(type)::in, list(type)::out)
+ is det.
+
+canonicalize_type_args(TypeCtor, TypeArgs0, TypeArgs) :-
+ (
+ % The argument to typeclass_info types is not
+ % a type - it encodes the class constraint.
+ % So we replace the argument with type `void'.
+ mercury_private_builtin_module(PrivateBuiltin),
+ TypeCtor = qualified(PrivateBuiltin, TypeName) - 1,
+ ( TypeName = "typeclass_info"
+ ; TypeName = "base_typeclass_info"
+ )
+ ->
+ construct_type(unqualified("void") - 0, [], ArgType),
+ TypeArgs = [ArgType]
+ ;
+ TypeArgs = TypeArgs0
+ ).
+
+ % Type_infos and pseudo_type_infos whose principal type
+ % constructor is a variable arity type constructor
+ % must be handled specially, in that they must include
+ % the actual arity of the given instance between the
+ % type constructor and the arguments.
+ % runtime/mercury_type_info.h has the details.
+ %
+ % All variable arity type constructors are builtins.
+ % At the moment, we have three: pred, func, and tuple.
+
+:- pred type_is_var_arity((type)::in, var_arity_ctor_id::out) is semidet.
+
+type_is_var_arity(Type, VarArityCtorId) :-
+ ( type_is_higher_order(Type, PredOrFunc, _, _) ->
+ (
+ PredOrFunc = predicate,
+ VarArityCtorId = pred_type_info
+ ;
+ PredOrFunc = function,
+ VarArityCtorId = func_type_info
+ )
+ ; type_is_tuple(Type, _) ->
+ VarArityCtorId = tuple_type_info
+ ;
+ fail
+ ).
%---------------------------------------------------------------------------%
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.17
diff -u -b -r1.17 rtti.m
--- compiler/rtti.m 20 Mar 2002 12:37:20 -0000 1.17
+++ compiler/rtti.m 10 Apr 2002 07:00:22 -0000
@@ -26,10 +26,55 @@
:- import_module parse_tree__prog_data.
:- import_module hlds__hlds_module, hlds__hlds_pred, hlds__hlds_data.
-:- import_module backend_libs__pseudo_type_info, backend_libs__code_model.
+:- import_module backend_libs__code_model.
:- import_module bool, list, std_util.
+:- type var_arity_ctor_id
+ ---> pred_type_info
+ ; func_type_info
+ ; tuple_type_info.
+
+:- type rtti_type_info
+ ---> plain_arity_zero_type_info(
+ rtti_type_ctor
+ )
+ ; plain_type_info(
+ rtti_type_ctor,
+ % This list should not be empty; if it is, one should
+ % use plain_arity_zero_type_info instead.
+ list(rtti_type_info)
+ )
+ ; var_arity_type_info(
+ var_arity_ctor_id,
+ list(rtti_type_info)
+ ).
+
+:- type rtti_pseudo_type_info
+ ---> plain_arity_zero_pseudo_type_info(
+ rtti_type_ctor
+ )
+ ; plain_pseudo_type_info(
+ rtti_type_ctor,
+ % This list should not be empty; if it is, one should
+ % use plain_arity_zero_pseudo_type_info instead.
+ list(rtti_maybe_pseudo_type_info)
+ )
+ ; var_arity_pseudo_type_info(
+ var_arity_ctor_id,
+ list(rtti_maybe_pseudo_type_info)
+ )
+ ; type_var(int).
+
+:- type rtti_maybe_pseudo_type_info
+ ---> pseudo(rtti_pseudo_type_info)
+ ; plain(rtti_type_info).
+
+:- type rtti_maybe_pseudo_type_info_or_self
+ ---> pseudo(rtti_pseudo_type_info)
+ ; plain(rtti_type_info)
+ ; self.
+
% For a given du type and a primary tag value, this says where,
% if anywhere, the secondary tag is.
:- type sectag_locn
@@ -348,7 +393,12 @@
% maybe(rtti_name), % the type's hash cons table
% maybe(rtti_proc_label)% prettyprinter
)
- ; pseudo_type_info(pseudo_type_info)
+ ; type_info(
+ rtti_type_info
+ )
+ ; pseudo_type_info(
+ rtti_pseudo_type_info
+ )
; base_typeclass_info(
module_name, % module containing instance decl.
class_id, % specifies class name & class arity
@@ -356,8 +406,7 @@
% types in the instance declaration
base_typeclass_info
- )
- .
+ ).
:- type rtti_name
---> exist_locns(int) % functor ordinal
@@ -377,7 +426,8 @@
; du_ptag_ordered_table
; reserved_addr_table
; type_ctor_info
- ; pseudo_type_info(pseudo_type_info)
+ ; type_info(rtti_type_info)
+ ; pseudo_type_info(rtti_pseudo_type_info)
; base_typeclass_info(
module_name, % module containing instance decl.
class_id, % specifies class name & class arity
@@ -413,16 +463,21 @@
methods :: list(rtti_proc_label)
).
- % convert a rtti_data to an rtti_type_ctor and an rtti_name.
+ % Convert a rtti_data to an rtti_type_ctor and an rtti_name.
% This calls error/1 if the argument is a type_var/1 rtti_data,
% since there is no rtti_type_ctor to return in that case.
:- pred rtti_data_to_name(rtti_data::in, rtti_type_ctor::out, rtti_name::out)
is det.
+ % Convert an id that specifies a kind of variable arity type_info
+ % or pseudo_type_info into the type_ctor of the canonical (arity-zero)
+ % type of that kind.
+:- func var_arity_id_to_rtti_type_ctor(var_arity_ctor_id) = rtti_type_ctor.
+
% return yes iff the specified rtti_name is an array
:- func rtti_name_has_array_type(rtti_name) = bool.
- % return yes iff the specified rtti_name should be exported
+ % Return yes iff the specified rtti_name should be exported
% for use by other modules.
:- func rtti_name_is_exported(rtti_name) = bool.
@@ -487,11 +542,21 @@
% XXX this should be in rtti_out.m
:- pred rtti__type_ctor_rep_to_string(type_ctor_rep::in, string::out) is det.
+:- func type_info_to_rtti_data(rtti_type_info) = rtti_data.
+
+:- func maybe_pseudo_type_info_to_rtti_data(rtti_maybe_pseudo_type_info)
+ = rtti_data.
+
+:- func maybe_pseudo_type_info_or_self_to_rtti_data(
+ rtti_maybe_pseudo_type_info_or_self) = rtti_data is semidet.
+
:- implementation.
+:- import_module parse_tree__prog_util. % for mercury_public_builtin_module
+:- import_module hlds__hlds_data.
+:- import_module check_hlds__type_util, check_hlds__mode_util.
:- import_module ll_backend__code_util. % for code_util__compiler_generated
:- import_module ll_backend__llds_out. % for name_mangle and sym_name_mangle
-:- import_module hlds__hlds_data, check_hlds__type_util, check_hlds__mode_util.
:- import_module string, require.
@@ -529,23 +594,46 @@
RttiTypeCtor, reserved_addr_table).
rtti_data_to_name(type_ctor_info(RttiTypeCtor, _,_,_,_,_,_,_,_),
RttiTypeCtor, type_ctor_info).
-rtti_data_to_name(base_typeclass_info(_, _, _, _), _, _) :-
- % there's no rtti_type_ctor associated with a base_typeclass_info
- error("rtti_data_to_name: base_typeclass_info").
+rtti_data_to_name(type_info(TypeInfo), RttiTypeCtor, type_info(TypeInfo)) :-
+ RttiTypeCtor = ti_get_rtti_type_ctor(TypeInfo).
rtti_data_to_name(pseudo_type_info(PseudoTypeInfo), RttiTypeCtor,
pseudo_type_info(PseudoTypeInfo)) :-
RttiTypeCtor = pti_get_rtti_type_ctor(PseudoTypeInfo).
+rtti_data_to_name(base_typeclass_info(_, _, _, _), _, _) :-
+ % there's no rtti_type_ctor associated with a base_typeclass_info
+ error("rtti_data_to_name: base_typeclass_info").
-:- func pti_get_rtti_type_ctor(pseudo_type_info) = rtti_type_ctor.
+:- func ti_get_rtti_type_ctor(rtti_type_info) = rtti_type_ctor.
-pti_get_rtti_type_ctor(type_ctor_info(RttiTypeCtor)) = RttiTypeCtor.
-pti_get_rtti_type_ctor(type_info(RttiTypeCtor, _)) = RttiTypeCtor.
-pti_get_rtti_type_ctor(higher_order_type_info(RttiTypeCtor, _, _)) =
- RttiTypeCtor.
+ti_get_rtti_type_ctor(plain_arity_zero_type_info(RttiTypeCtor))
+ = RttiTypeCtor.
+ti_get_rtti_type_ctor(plain_type_info(RttiTypeCtor, _))
+ = RttiTypeCtor.
+ti_get_rtti_type_ctor(var_arity_type_info(RttiVarArityId, _)) =
+ var_arity_id_to_rtti_type_ctor(RttiVarArityId).
+
+:- func pti_get_rtti_type_ctor(rtti_pseudo_type_info) = rtti_type_ctor.
+
+pti_get_rtti_type_ctor(plain_arity_zero_pseudo_type_info(RttiTypeCtor))
+ = RttiTypeCtor.
+pti_get_rtti_type_ctor(plain_pseudo_type_info(RttiTypeCtor, _))
+ = RttiTypeCtor.
+pti_get_rtti_type_ctor(var_arity_pseudo_type_info(RttiVarArityId, _)) =
+ var_arity_id_to_rtti_type_ctor(RttiVarArityId).
pti_get_rtti_type_ctor(type_var(_)) = _ :-
% there's no rtti_type_ctor associated with a type_var
error("rtti_data_to_name: type_var").
+var_arity_id_to_rtti_type_ctor(pred_type_info) = Ctor :-
+ mercury_public_builtin_module(Builtin),
+ Ctor = rtti_type_ctor(Builtin, "pred", 0).
+var_arity_id_to_rtti_type_ctor(func_type_info) = Ctor :-
+ mercury_public_builtin_module(Builtin),
+ Ctor = rtti_type_ctor(Builtin, "func", 0).
+var_arity_id_to_rtti_type_ctor(tuple_type_info) = Ctor :-
+ mercury_public_builtin_module(Builtin),
+ Ctor = rtti_type_ctor(Builtin, "tuple", 0).
+
rtti_name_has_array_type(exist_locns(_)) = yes.
rtti_name_has_array_type(exist_info(_)) = no.
rtti_name_has_array_type(field_names(_)) = yes.
@@ -563,6 +651,7 @@
rtti_name_has_array_type(du_ptag_ordered_table) = yes.
rtti_name_has_array_type(reserved_addr_table) = no.
rtti_name_has_array_type(type_ctor_info) = no.
+rtti_name_has_array_type(type_info(_)) = no.
rtti_name_has_array_type(pseudo_type_info(_)) = no.
rtti_name_has_array_type(base_typeclass_info(_, _, _)) = yes.
rtti_name_has_array_type(type_hashcons_pointer) = no.
@@ -584,16 +673,25 @@
rtti_name_is_exported(du_ptag_ordered_table) = no.
rtti_name_is_exported(reserved_addr_table) = no.
rtti_name_is_exported(type_ctor_info) = yes.
-rtti_name_is_exported(pseudo_type_info(Pseudo)) =
- pseudo_type_info_is_exported(Pseudo).
+rtti_name_is_exported(type_info(TypeInfo)) =
+ type_info_is_exported(TypeInfo).
+rtti_name_is_exported(pseudo_type_info(PseudoTypeInfo)) =
+ pseudo_type_info_is_exported(PseudoTypeInfo).
rtti_name_is_exported(base_typeclass_info(_, _, _)) = yes.
rtti_name_is_exported(type_hashcons_pointer) = no.
-:- func pseudo_type_info_is_exported(pseudo_type_info) = bool.
+:- func type_info_is_exported(rtti_type_info) = bool.
+
+type_info_is_exported(plain_arity_zero_type_info(_)) = yes.
+type_info_is_exported(plain_type_info(_, _)) = no.
+type_info_is_exported(var_arity_type_info(_, _)) = no.
+
+:- func pseudo_type_info_is_exported(rtti_pseudo_type_info) = bool.
+
+pseudo_type_info_is_exported(plain_arity_zero_pseudo_type_info(_)) = yes.
+pseudo_type_info_is_exported(plain_pseudo_type_info(_, _)) = no.
+pseudo_type_info_is_exported(var_arity_pseudo_type_info(_, _)) = no.
pseudo_type_info_is_exported(type_var(_)) = no.
-pseudo_type_info_is_exported(type_ctor_info(_)) = yes.
-pseudo_type_info_is_exported(type_info(_, _)) = no.
-pseudo_type_info_is_exported(higher_order_type_info(_, _, _)) = no.
rtti__make_proc_label(ModuleInfo, PredId, ProcId) = ProcLabel :-
module_info_name(ModuleInfo, ThisModule),
@@ -670,7 +768,8 @@
;
RttiName = reserved_addr_functor_desc(Ordinal),
string__int_to_string(Ordinal, O_str),
- string__append_list([ModuleName, "__reserved_addr_functor_desc_",
+ string__append_list([ModuleName,
+ "__reserved_addr_functor_desc_",
TypeName, "_", A_str, "_", O_str], Str)
;
RttiName = enum_name_ordered_table,
@@ -702,8 +801,11 @@
string__append_list([ModuleName, "__type_ctor_info_",
TypeName, "_", A_str], Str)
;
+ RttiName = type_info(TypeInfo),
+ Str = rtti__type_info_to_string(TypeInfo)
+ ;
RttiName = pseudo_type_info(PseudoTypeInfo),
- rtti__pseudo_type_info_to_string(PseudoTypeInfo, Str)
+ Str = rtti__pseudo_type_info_to_string(PseudoTypeInfo)
;
RttiName = base_typeclass_info(_ModuleName, ClassId,
InstanceStr),
@@ -723,69 +825,99 @@
:- pred rtti__mangle_rtti_type_ctor(rtti_type_ctor::in,
string::out, string::out, string::out) is det.
-rtti__mangle_rtti_type_ctor(RttiTypeCtor, ModuleName, TypeName, A_str) :-
+rtti__mangle_rtti_type_ctor(RttiTypeCtor, ModuleName, TypeName, ArityStr) :-
RttiTypeCtor = rtti_type_ctor(ModuleName0, TypeName0, TypeArity),
llds_out__sym_name_mangle(ModuleName0, ModuleName),
llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str).
+ string__int_to_string(TypeArity, ArityStr).
-:- pred rtti__pseudo_type_info_to_string(pseudo_type_info::in, string::out)
- is det.
+%-----------------------------------------------------------------------------%
+
+:- func rtti__type_info_to_string(rtti_type_info) = string.
-rtti__pseudo_type_info_to_string(PseudoTypeInfo, Str) :-
+rtti__type_info_to_string(TypeInfo) = Str :-
(
- PseudoTypeInfo = type_var(VarNum),
- string__int_to_string(VarNum, Str)
- ;
- PseudoTypeInfo = type_ctor_info(RttiTypeCtor),
+ TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
rtti__addr_to_string(RttiTypeCtor, type_ctor_info, Str)
;
- PseudoTypeInfo = type_info(RttiTypeCtor, ArgTypes),
+ TypeInfo = plain_type_info(RttiTypeCtor, Args),
rtti__mangle_rtti_type_ctor(RttiTypeCtor,
- ModuleName, TypeName, A_str),
- ATs_str = pseudo_type_list_to_string(ArgTypes),
- string__append_list([ModuleName, "__type_info_",
- TypeName, "_", A_str, ATs_str], Str)
+ ModuleName, TypeName, ArityStr),
+ ArgsStr = type_info_list_to_string(Args),
+ string__append_list([ModuleName, "__ti_",
+ TypeName, "_", ArityStr, ArgsStr], Str)
+ ;
+ TypeInfo = var_arity_type_info(VarArityId, Args),
+ RealArity = list__length(Args),
+ ArgsStr = type_info_list_to_string(Args),
+ string__int_to_string(RealArity, RealArityStr),
+ IdStr = var_arity_ctor_id_to_string(VarArityId),
+ string__append_list(["__vti_", IdStr, "_",
+ RealArityStr, ArgsStr], Str)
+ ).
+
+:- func rtti__pseudo_type_info_to_string(rtti_pseudo_type_info) = string.
+
+rtti__pseudo_type_info_to_string(PseudoTypeInfo) = Str :-
+ (
+ PseudoTypeInfo =
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor),
+ rtti__addr_to_string(RttiTypeCtor, type_ctor_info, Str)
;
- PseudoTypeInfo = higher_order_type_info(RttiTypeCtor,
- RealArity, ArgTypes),
+ PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args),
rtti__mangle_rtti_type_ctor(RttiTypeCtor,
- ModuleName, TypeName, _A_str),
- ATs_str = pseudo_type_list_to_string(ArgTypes),
- string__int_to_string(RealArity, RA_str),
- string__append_list([ModuleName, "__ho_type_info_",
- TypeName, "_", RA_str, ATs_str], Str)
+ ModuleName, TypeName, ArityStr),
+ ArgsStr = maybe_pseudo_type_info_list_to_string(Args),
+ string__append_list([ModuleName, "__pti_",
+ TypeName, "_", ArityStr, ArgsStr], Str)
+ ;
+ PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, Args),
+ RealArity = list__length(Args),
+ ArgsStr = maybe_pseudo_type_info_list_to_string(Args),
+ string__int_to_string(RealArity, RealArityStr),
+ IdStr = var_arity_ctor_id_to_string(VarArityId),
+ string__append_list(["__vpti_", IdStr, "_",
+ RealArityStr, ArgsStr], Str)
+ ;
+ PseudoTypeInfo = type_var(VarNum),
+ string__int_to_string(VarNum, Str)
).
-:- func pseudo_type_list_to_string(list(pseudo_type_info)) = string.
-pseudo_type_list_to_string(PseudoTypeList) =
- string__append_list(list__map(pseudo_type_to_string, PseudoTypeList)).
-
-:- func pseudo_type_to_string(pseudo_type_info) = string.
-pseudo_type_to_string(type_var(Int)) =
- string__append("__var_", string__int_to_string(Int)).
-pseudo_type_to_string(type_ctor_info(TypeCtor)) =
- string__append("__type0_", rtti__type_ctor_to_string(TypeCtor)).
-pseudo_type_to_string(type_info(TypeCtor, ArgTypes)) =
- string__append_list([
- "__type_", rtti__type_ctor_to_string(TypeCtor),
- pseudo_type_list_to_string(ArgTypes)
- ]).
-pseudo_type_to_string(higher_order_type_info(TypeCtor, Arity, ArgTypes)) =
- string__append_list([
- "__ho_type_", rtti__type_ctor_to_string(TypeCtor),
- "_", string__int_to_string(Arity),
- pseudo_type_list_to_string(ArgTypes)
- ]).
-
-:- func rtti__type_ctor_to_string(rtti_type_ctor) = string.
-rtti__type_ctor_to_string(RttiTypeCtor) = String :-
- rtti__mangle_rtti_type_ctor(RttiTypeCtor, ModuleName, TypeName, A_Str),
- String0 = string__append_list([ModuleName, "__", TypeName, "_", A_Str]),
- % To ensure that the mapping is one-to-one, and to make demangling
- % easier, we insert the length of the string at the start of the string.
- string__length(String0, Length),
- String = string__format("%d_%s", [i(Length), s(String0)]).
+:- func maybe_pseudo_type_info_to_string(rtti_maybe_pseudo_type_info) = string.
+
+maybe_pseudo_type_info_to_string(plain(TypeInfo)) =
+ string__append("__plain_", type_info_to_string(TypeInfo)).
+maybe_pseudo_type_info_to_string(pseudo(PseudoTypeInfo)) =
+ string__append("__pseudo_", pseudo_type_info_to_string(PseudoTypeInfo)).
+
+:- func var_arity_ctor_id_to_string(var_arity_ctor_id) = string.
+
+var_arity_ctor_id_to_string(pred_type_info) = "pred".
+var_arity_ctor_id_to_string(func_type_info) = "func".
+var_arity_ctor_id_to_string(tuple_type_info) = "tuple".
+
+%-----------------------------------------------------------------------------%
+
+:- func maybe_pseudo_type_info_list_to_string(list(rtti_maybe_pseudo_type_info))
+ = string.
+
+maybe_pseudo_type_info_list_to_string(MaybePseudoTypeInfoList) =
+ string__append_list(
+ list__map(maybe_pseudo_type_info_to_string,
+ MaybePseudoTypeInfoList)).
+
+:- func pseudo_type_info_list_to_string(list(rtti_pseudo_type_info)) = string.
+
+pseudo_type_info_list_to_string(PseudoTypeInfoList) =
+ string__append_list(
+ list__map(pseudo_type_info_to_string, PseudoTypeInfoList)).
+
+:- func type_info_list_to_string(list(rtti_type_info)) = string.
+
+type_info_list_to_string(TypeInfoList) =
+ string__append_list(list__map(type_info_to_string, TypeInfoList)).
+
+%-----------------------------------------------------------------------------%
rtti__sectag_locn_to_string(sectag_none, "MR_SECTAG_NONE").
rtti__sectag_locn_to_string(sectag_local, "MR_SECTAG_LOCAL").
@@ -818,3 +950,14 @@
rtti__type_ctor_rep_to_string(unknown,
"MR_TYPECTOR_REP_UNKNOWN").
+type_info_to_rtti_data(TypeInfo) = type_info(TypeInfo).
+
+maybe_pseudo_type_info_to_rtti_data(pseudo(PseudoTypeInfo)) =
+ pseudo_type_info(PseudoTypeInfo).
+maybe_pseudo_type_info_to_rtti_data(plain(TypeInfo)) =
+ type_info(TypeInfo).
+
+maybe_pseudo_type_info_or_self_to_rtti_data(pseudo(PseudoTypeInfo)) =
+ pseudo_type_info(PseudoTypeInfo).
+maybe_pseudo_type_info_or_self_to_rtti_data(plain(TypeInfo)) =
+ type_info(TypeInfo).
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.26
diff -u -b -r1.26 rtti_out.m
--- compiler/rtti_out.m 20 Mar 2002 12:37:20 -0000 1.26
+++ compiler/rtti_out.m 4 Apr 2002 01:53:21 -0000
@@ -474,12 +474,14 @@
% io__write_string(",\n\t"),
% output_maybe_static_code_addr(Prettyprinter),
io__write_string("\n};\n").
+output_rtti_data_defn(type_info(TypeInfo), DeclSet0, DeclSet) -->
+ output_type_info_defn(TypeInfo, DeclSet0, DeclSet).
+output_rtti_data_defn(pseudo_type_info(PseudoTypeInfo), DeclSet0, DeclSet) -->
+ output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet).
output_rtti_data_defn(base_typeclass_info(InstanceModuleName, ClassId,
InstanceString, BaseTypeClassInfo), DeclSet0, DeclSet) -->
output_base_typeclass_info_defn(InstanceModuleName, ClassId,
InstanceString, BaseTypeClassInfo, DeclSet0, DeclSet).
-output_rtti_data_defn(pseudo_type_info(Pseudo), DeclSet0, DeclSet) -->
- output_pseudo_type_info_defn(Pseudo, DeclSet0, DeclSet).
:- pred output_base_typeclass_info_defn(module_name::in, class_id::in,
string::in, base_typeclass_info::in, decl_set::in, decl_set::out,
@@ -504,49 +506,99 @@
io__write_string("\n};\n").
:- func make_maybe_code_addr(maybe(rtti_proc_label)) = maybe(code_addr).
+
make_maybe_code_addr(no) = no.
make_maybe_code_addr(yes(ProcLabel)) = yes(make_code_addr(ProcLabel)).
:- func make_code_addr(rtti_proc_label) = code_addr.
+
make_code_addr(ProcLabel) = CodeAddr :-
code_util__make_entry_label_from_rtti(ProcLabel, no, CodeAddr).
-:- pred output_pseudo_type_info_defn(pseudo_type_info, decl_set, decl_set,
- io__state, io__state).
-:- mode output_pseudo_type_info_defn(in, in, out, di, uo) is det.
+:- pred output_type_info_defn(rtti_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_pseudo_type_info_defn(type_var(_), DeclSet, DeclSet) --> [].
-output_pseudo_type_info_defn(type_ctor_info(_), DeclSet, DeclSet) --> [].
-output_pseudo_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
- { TypeInfo = type_info(RttiTypeCtor, ArgTypes) },
- { TypeCtorRttiData = pseudo_type_info(type_ctor_info(RttiTypeCtor)) },
- { ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes) },
- output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _, DeclSet0, DeclSet1),
- output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _, DeclSet1, DeclSet2),
+output_type_info_defn(plain_arity_zero_type_info(_),
+ DeclSet, DeclSet) --> [].
+output_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
+ { TypeInfo = plain_type_info(RttiTypeCtor, Args) },
+ { TypeCtorRttiData = type_info(
+ plain_arity_zero_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(type_info_to_rtti_data, Args) },
+ output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
+ DeclSet1, DeclSet2),
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ type_info(TypeInfo), DeclSet2, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeCtor, type_ctor_info),
+ io__write_string(",\n{"),
+ output_addr_of_rtti_datas(ArgRttiDatas),
+ io__write_string("}};\n").
+output_type_info_defn(TypeInfo, DeclSet0, DeclSet) -->
+ { TypeInfo = var_arity_type_info(RttiVarArityId, Args) },
+ { RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId) },
+ { TypeCtorRttiData = type_info(
+ plain_arity_zero_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(type_info_to_rtti_data, Args) },
+ output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
+ DeclSet1, DeclSet2),
+ output_generic_rtti_data_defn_start(RttiTypeCtor,
+ type_info(TypeInfo), DeclSet2, DeclSet),
+ io__write_string(" = {\n\t&"),
+ output_rtti_addr(RttiTypeCtor, type_ctor_info),
+ io__write_string(",\n\t"),
+ { list__length(Args, Arity) },
+ io__write_int(Arity),
+ io__write_string(",\n{"),
+ output_addr_of_rtti_datas(ArgRttiDatas),
+ io__write_string("}};\n").
+
+:- pred output_pseudo_type_info_defn(rtti_pseudo_type_info::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_pseudo_type_info_defn(plain_arity_zero_pseudo_type_info(_),
+ DeclSet, DeclSet) --> [].
+output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet) -->
+ { PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args) },
+ { TypeCtorRttiData = pseudo_type_info(
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args) },
+ output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
+ DeclSet1, DeclSet2),
output_generic_rtti_data_defn_start(RttiTypeCtor,
- pseudo_type_info(TypeInfo), DeclSet2, DeclSet),
+ pseudo_type_info(PseudoTypeInfo), DeclSet2, DeclSet),
io__write_string(" = {\n\t&"),
output_rtti_addr(RttiTypeCtor, type_ctor_info),
io__write_string(",\n{"),
output_addr_of_rtti_datas(ArgRttiDatas),
io__write_string("}};\n").
-output_pseudo_type_info_defn(HO_TypeInfo, DeclSet0, DeclSet) -->
- { HO_TypeInfo = higher_order_type_info(RttiTypeCtor, Arity,
- ArgTypes) },
- { TypeCtorRttiData = pseudo_type_info(type_ctor_info(RttiTypeCtor)) },
- { ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes) },
+output_pseudo_type_info_defn(PseudoTypeInfo, DeclSet0, DeclSet) -->
+ { PseudoTypeInfo = var_arity_pseudo_type_info(RttiVarArityId, Args) },
+ { RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId) },
+ { TypeCtorRttiData = pseudo_type_info(
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor)) },
+ { ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args) },
output_rtti_data_decls(TypeCtorRttiData, "", "", 0, _,
DeclSet0, DeclSet1),
- output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _, DeclSet1, DeclSet2),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
+ DeclSet1, DeclSet2),
output_generic_rtti_data_defn_start(RttiTypeCtor,
- pseudo_type_info(HO_TypeInfo), DeclSet2, DeclSet),
+ pseudo_type_info(PseudoTypeInfo), DeclSet2, DeclSet),
io__write_string(" = {\n\t&"),
output_rtti_addr(RttiTypeCtor, type_ctor_info),
io__write_string(",\n\t"),
+ { list__length(Args, Arity) },
io__write_int(Arity),
io__write_string(",\n{"),
output_addr_of_rtti_datas(ArgRttiDatas),
io__write_string("}};\n").
+output_pseudo_type_info_defn(type_var(_), DeclSet, DeclSet) --> [].
:- pred output_functors_info_decl(rtti_type_ctor::in,
type_ctor_functors_info::in, decl_set::in, decl_set::out,
@@ -739,26 +791,41 @@
:- pred output_rtti_type_decl(rtti_name::in, io__state::di, io__state::uo)
is det.
+
output_rtti_type_decl(RttiName) -->
(
%
- % Each pseudo-type-info may have a different type,
- % depending on what kind of pseudo-type-info it is,
- % and also on its arity.
+ % Each type_info and pseudo_type_info may have a different
+ % type, depending on what kind of type_info or pseudo_type_info
+ % it is, and also on its arity.
% We need to declare that type here.
%
{
- RttiName = pseudo_type_info(type_info(_, ArgTypes)),
- TypeNameBase = "MR_FO_PseudoTypeInfo_Struct",
- DefineType = "MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT"
- ;
- RttiName = pseudo_type_info(higher_order_type_info(_, _,
- ArgTypes)),
- TypeNameBase = "MR_HO_PseudoTypeInfo_Struct",
- DefineType = "MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT"
+ RttiName = type_info(TypeInfo),
+ (
+ TypeInfo = plain_type_info(_, ArgTypes),
+ TypeNameBase = "MR_FA_TypeInfo_Struct",
+ DefineType = "MR_FIXED_ARITY_TYPEINFO_STRUCT"
+ ;
+ TypeInfo = var_arity_type_info(_, ArgTypes),
+ TypeNameBase = "MR_VA_TypeInfo_Struct",
+ DefineType = "MR_VAR_ARITY_TYPEINFO_STRUCT"
+ ),
+ NumArgTypes = list__length(ArgTypes)
+ ;
+ RttiName = pseudo_type_info(PseudoTypeInfo),
+ (
+ PseudoTypeInfo = plain_pseudo_type_info(_, ArgTypes),
+ TypeNameBase = "MR_FA_PseudoTypeInfo_Struct",
+ DefineType = "MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT"
+ ;
+ PseudoTypeInfo = var_arity_pseudo_type_info(_, ArgTypes),
+ TypeNameBase = "MR_VA_PseudoTypeInfo_Struct",
+ DefineType = "MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT"
+ ),
+ NumArgTypes = list__length(ArgTypes)
}
->
- { NumArgTypes = list__length(ArgTypes) },
{ Template =
"#ifndef %s%d_GUARD
#define %s%d_GUARD
@@ -1134,16 +1201,25 @@
rtti_name_would_include_code_addr(reserved_addr_table) = no.
rtti_name_would_include_code_addr(type_ctor_info) = yes.
rtti_name_would_include_code_addr(base_typeclass_info(_, _, _)) = yes.
-rtti_name_would_include_code_addr(pseudo_type_info(Pseudo)) =
- pseudo_type_info_would_incl_code_addr(Pseudo).
+rtti_name_would_include_code_addr(type_info(TypeInfo)) =
+ type_info_would_incl_code_addr(TypeInfo).
+rtti_name_would_include_code_addr(pseudo_type_info(PseudoTypeInfo)) =
+ pseudo_type_info_would_incl_code_addr(PseudoTypeInfo).
rtti_name_would_include_code_addr(type_hashcons_pointer) = no.
-:- func pseudo_type_info_would_incl_code_addr(pseudo_type_info) = bool.
+:- func type_info_would_incl_code_addr(rtti_type_info) = bool.
+type_info_would_incl_code_addr(plain_arity_zero_type_info(_)) = yes.
+type_info_would_incl_code_addr(plain_type_info(_, _)) = no.
+type_info_would_incl_code_addr(var_arity_type_info(_, _)) = no.
+
+:- func pseudo_type_info_would_incl_code_addr(rtti_pseudo_type_info) = bool.
+
+pseudo_type_info_would_incl_code_addr(plain_arity_zero_pseudo_type_info(_))
+ = yes.
+pseudo_type_info_would_incl_code_addr(plain_pseudo_type_info(_, _)) = no.
+pseudo_type_info_would_incl_code_addr(var_arity_pseudo_type_info(_, _)) = no.
pseudo_type_info_would_incl_code_addr(type_var(_)) = no.
-pseudo_type_info_would_incl_code_addr(type_ctor_info(_)) = yes.
-pseudo_type_info_would_incl_code_addr(type_info(_, _)) = no.
-pseudo_type_info_would_incl_code_addr(higher_order_type_info(_, _, _)) = no.
rtti_name_linkage(RttiName, Linkage) :-
(
@@ -1182,27 +1258,43 @@
rtti_name_c_type(type_ctor_info, "struct MR_TypeCtorInfo_Struct",
"").
rtti_name_c_type(base_typeclass_info(_, _, _), "MR_Code *", "[]").
-rtti_name_c_type(pseudo_type_info(Pseudo), TypePrefix, TypeSuffix) :-
- pseudo_type_info_name_c_type(Pseudo, TypePrefix, TypeSuffix).
+rtti_name_c_type(type_info(TypeInfo), TypePrefix, TypeSuffix) :-
+ type_info_name_c_type(TypeInfo, TypePrefix, TypeSuffix).
+rtti_name_c_type(pseudo_type_info(PseudoTypeInfo), TypePrefix, TypeSuffix) :-
+ pseudo_type_info_name_c_type(PseudoTypeInfo, TypePrefix, TypeSuffix).
rtti_name_c_type(type_hashcons_pointer, "union MR_TableNode_Union **", "").
-:- pred pseudo_type_info_name_c_type(pseudo_type_info, string, string).
+:- pred type_info_name_c_type(rtti_type_info, string, string).
+:- mode type_info_name_c_type(in, out, out) is det.
+
+type_info_name_c_type(plain_arity_zero_type_info(_),
+ "struct MR_TypeCtorInfo_Struct", "").
+type_info_name_c_type(plain_type_info(_TypeCtor, ArgTypes),
+ TypeInfoStruct, "") :-
+ TypeInfoStruct = string__format("struct MR_FA_TypeInfo_Struct%d",
+ [i(list__length(ArgTypes))]).
+type_info_name_c_type(var_arity_type_info(_TypeCtor, ArgTypes),
+ TypeInfoStruct, "") :-
+ TypeInfoStruct = string__format("struct MR_VA_TypeInfo_Struct%d",
+ [i(list__length(ArgTypes))]).
+
+:- pred pseudo_type_info_name_c_type(rtti_pseudo_type_info, string, string).
:- mode pseudo_type_info_name_c_type(in, out, out) is det.
-pseudo_type_info_name_c_type(type_var(_), _, _) :-
- % we use small integers to represent type_vars,
- % rather than pointers, so there is no pointed-to type
- error("rtti_name_c_type: type_var").
-pseudo_type_info_name_c_type(type_ctor_info(_),
+pseudo_type_info_name_c_type(plain_arity_zero_pseudo_type_info(_),
"struct MR_TypeCtorInfo_Struct", "").
-pseudo_type_info_name_c_type(type_info(_TypeCtor, ArgTypes),
+pseudo_type_info_name_c_type(plain_pseudo_type_info(_TypeCtor, ArgTypes),
TypeInfoStruct, "") :-
- TypeInfoStruct = string__format("struct MR_FO_PseudoTypeInfo_Struct%d",
+ TypeInfoStruct = string__format("struct MR_FA_PseudoTypeInfo_Struct%d",
[i(list__length(ArgTypes))]).
-pseudo_type_info_name_c_type(higher_order_type_info(_TypeCtor, _Arity,
- ArgTypes), TypeInfoStruct, "") :-
- TypeInfoStruct = string__format("struct MR_HO_PseudoTypeInfo_Struct%d",
+pseudo_type_info_name_c_type(var_arity_pseudo_type_info(_TypeCtor, ArgTypes),
+ TypeInfoStruct, "") :-
+ TypeInfoStruct = string__format("struct MR_VA_PseudoTypeInfo_Struct%d",
[i(list__length(ArgTypes))]).
+pseudo_type_info_name_c_type(type_var(_), _, _) :-
+ % we use small integers to represent type_vars,
+ % rather than pointers, so there is no pointed-to type
+ error("pseudo_type_info_name_c_type: type_var").
%-----------------------------------------------------------------------------%
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.29
diff -u -b -r1.29 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 20 Mar 2002 12:37:21 -0000 1.29
+++ compiler/rtti_to_mlds.m 21 Mar 2002 00:45:38 -0000
@@ -280,6 +280,8 @@
gen_init_boxed_int(N5)
| MethodInitializers
]).
+gen_init_rtti_data_defn(type_info(TypeInfo), ModuleName, _, Init, []) :-
+ Init = gen_init_type_info_defn(TypeInfo, ModuleName).
gen_init_rtti_data_defn(pseudo_type_info(Pseudo), ModuleName, _, Init, []) :-
Init = gen_init_pseudo_type_info_defn(Pseudo, ModuleName).
@@ -331,30 +333,55 @@
gen_init_maybe(mlds__func_type(mlds__func_params([], [])),
gen_init_proc_id(ModuleInfo), MaybeProcLabel).
-:- func gen_init_pseudo_type_info_defn(pseudo_type_info, module_name) =
+:- func gen_init_type_info_defn(rtti_type_info, module_name) =
mlds__initializer.
-gen_init_pseudo_type_info_defn(type_var(_), _) = _ :-
- error("gen_init_pseudo_type_info_defn: type_var").
-gen_init_pseudo_type_info_defn(type_ctor_info(_), _) = _ :-
- error("gen_init_pseudo_type_info_defn: type_ctor_info").
-gen_init_pseudo_type_info_defn(type_info(RttiTypeCtor, ArgTypes), ModuleName) =
- Init :-
- ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes),
+gen_init_type_info_defn(plain_arity_zero_type_info(_), _) = _ :-
+ error("gen_init_type_info_defn: plain_arity_zero_type_info").
+gen_init_type_info_defn(plain_type_info(RttiTypeCtor, ArgTypes), ModuleName)
+ = Init :-
+ ArgRttiDatas = list__map(type_info_to_rtti_data, ArgTypes),
+ Init = init_struct([
+ gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
+ gen_init_cast_rtti_datas_array(mlds__type_info_type,
+ ModuleName, ArgRttiDatas)
+ ]).
+gen_init_type_info_defn(var_arity_type_info(VarArityId, ArgTypes), ModuleName)
+ = Init :-
+ ArgRttiDatas = list__map(type_info_to_rtti_data, ArgTypes),
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
+ Init = init_struct([
+ gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
+ gen_init_int(list__length(ArgTypes)),
+ gen_init_cast_rtti_datas_array(mlds__type_info_type,
+ ModuleName, ArgRttiDatas)
+ ]).
+
+:- func gen_init_pseudo_type_info_defn(rtti_pseudo_type_info, module_name) =
+ mlds__initializer.
+
+gen_init_pseudo_type_info_defn(plain_arity_zero_pseudo_type_info(_), _) = _ :-
+ error("gen_init_pseudo_type_info_defn: plain_arity_zero_pseudo_type_info").
+gen_init_pseudo_type_info_defn(plain_pseudo_type_info(RttiTypeCtor, ArgTypes),
+ ModuleName) = Init :-
+ ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
Init = init_struct([
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
gen_init_cast_rtti_datas_array(mlds__pseudo_type_info_type,
ModuleName, ArgRttiDatas)
]).
-gen_init_pseudo_type_info_defn(higher_order_type_info(RttiTypeCtor,
- Arity, ArgTypes), ModuleName) = Init :-
- ArgRttiDatas = list__map(func(P) = pseudo_type_info(P), ArgTypes),
+gen_init_pseudo_type_info_defn(var_arity_pseudo_type_info(VarArityId,
+ ArgTypes), ModuleName) = Init :-
+ ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, ArgTypes),
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId),
Init = init_struct([
gen_init_rtti_name(ModuleName, RttiTypeCtor, type_ctor_info),
- gen_init_int(Arity),
+ gen_init_int(list__length(ArgTypes)),
gen_init_cast_rtti_datas_array(mlds__pseudo_type_info_type,
ModuleName, ArgRttiDatas)
]).
+gen_init_pseudo_type_info_defn(type_var(_), _) = _ :-
+ error("gen_init_pseudo_type_info_defn: type_var").
:- func gen_init_ptag_layout_defn(module_name, rtti_type_ctor, du_ptag_layout)
= mlds__initializer.
@@ -459,9 +486,16 @@
% corresponding to the type which they are for.
%
(
+ (
+ RttiName = type_info(TypeInfo),
+ ( TypeInfo = plain_type_info(_, _)
+ ; TypeInfo = var_arity_type_info(_, _)
+ )
+ ;
RttiName = pseudo_type_info(PseudoTypeInfo),
- ( PseudoTypeInfo = type_info(_, _)
- ; PseudoTypeInfo = higher_order_type_info(_, _, _)
+ ( PseudoTypeInfo = plain_pseudo_type_info(_, _)
+ ; PseudoTypeInfo = var_arity_pseudo_type_info(_, _)
+ )
)
->
ModuleName = ThisModuleName,
@@ -673,24 +707,36 @@
mlds_rtti_type_name(reserved_addr_table) = "ReservedAddrTypeDesc".
mlds_rtti_type_name(type_ctor_info) = "TypeCtorInfo_Struct".
mlds_rtti_type_name(base_typeclass_info(_, _, _)) = "BaseTypeclassInfo".
-mlds_rtti_type_name(pseudo_type_info(Pseudo)) =
- mlds_pseudo_type_info_type_name(Pseudo).
+mlds_rtti_type_name(type_info(TypeInfo)) =
+ mlds_type_info_type_name(TypeInfo).
+mlds_rtti_type_name(pseudo_type_info(PseudoTypeInfo)) =
+ mlds_pseudo_type_info_type_name(PseudoTypeInfo).
mlds_rtti_type_name(type_hashcons_pointer) = "TableNodePtrPtr".
-:- func mlds_pseudo_type_info_type_name(pseudo_type_info) = string.
+:- func mlds_type_info_type_name(rtti_type_info) = string.
-mlds_pseudo_type_info_type_name(type_var(_)) = _ :-
- % we use small integers to represent type_vars,
- % rather than pointers, so there is no pointed-to type
- error("mlds_rtti_type_name: type_var").
-mlds_pseudo_type_info_type_name(type_ctor_info(_)) =
+mlds_type_info_type_name(plain_arity_zero_type_info(_)) =
"TypeCtorInfo_Struct".
-mlds_pseudo_type_info_type_name(type_info(_TypeCtor, ArgTypes)) =
- string__format("FO_PseudoTypeInfo_Struct%d",
+mlds_type_info_type_name(plain_type_info(_TypeCtor, ArgTypes)) =
+ string__format("FA_TypeInfo_Struct%d", [i(list__length(ArgTypes))]).
+mlds_type_info_type_name(var_arity_type_info(_TypeCtor,
+ ArgTypes)) =
+ string__format("VA_TypeInfo_Struct%d", [i(list__length(ArgTypes))]).
+
+:- func mlds_pseudo_type_info_type_name(rtti_pseudo_type_info) = string.
+
+mlds_pseudo_type_info_type_name(plain_arity_zero_pseudo_type_info(_)) =
+ "TypeCtorInfo_Struct".
+mlds_pseudo_type_info_type_name(plain_pseudo_type_info(_TypeCtor, ArgTypes)) =
+ string__format("FA_PseudoTypeInfo_Struct%d",
[i(list__length(ArgTypes))]).
-mlds_pseudo_type_info_type_name(higher_order_type_info(_TypeCtor, _Arity,
+mlds_pseudo_type_info_type_name(var_arity_pseudo_type_info(_TypeCtor,
ArgTypes)) =
- string__format("HO_PseudoTypeInfo_Struct%d",
+ string__format("VA_PseudoTypeInfo_Struct%d",
[i(list__length(ArgTypes))]).
+mlds_pseudo_type_info_type_name(type_var(_)) = _ :-
+ % we use small integers to represent type_vars,
+ % rather than pointers, so there is no pointed-to type
+ error("mlds_rtti_type_name: type_var").
%-----------------------------------------------------------------------------%
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.23
diff -u -b -r1.23 type_ctor_info.m
--- compiler/type_ctor_info.m 20 Mar 2002 12:37:30 -0000 1.23
+++ compiler/type_ctor_info.m 21 Mar 2002 00:45:39 -0000
@@ -348,20 +348,54 @@
% of a pseudo_type_info, and prepend them to the given
% list of rtti_data tables.
-:- pred make_pseudo_type_info_tables(pseudo_type_info,
- list(rtti_data), list(rtti_data)).
-:- mode make_pseudo_type_info_tables(in, in, out) is det.
+:- pred make_type_info_tables(rtti_type_info::in,
+ list(rtti_data)::in, list(rtti_data)::out) is det.
+make_type_info_tables(plain_arity_zero_type_info(_), Tables, Tables).
+make_type_info_tables(PseudoTypeInfo, Tables0, Tables) :-
+ PseudoTypeInfo = plain_type_info(_, Args),
+ Tables1 = [type_info(PseudoTypeInfo) | Tables0],
+ list__foldl(make_type_info_tables, Args, Tables1, Tables).
+make_type_info_tables(PseudoTypeInfo, Tables0, Tables) :-
+ PseudoTypeInfo = var_arity_type_info(_, Args),
+ Tables1 = [type_info(PseudoTypeInfo) | Tables0],
+ list__foldl(make_type_info_tables, Args, Tables1, Tables).
+
+:- pred make_pseudo_type_info_tables(rtti_pseudo_type_info::in,
+ list(rtti_data)::in, list(rtti_data)::out) is det.
+
+make_pseudo_type_info_tables(plain_arity_zero_pseudo_type_info(_),
+ Tables, Tables).
+make_pseudo_type_info_tables(PseudoTypeInfo, Tables0, Tables) :-
+ PseudoTypeInfo = plain_pseudo_type_info(_, Args),
+ Tables1 = [pseudo_type_info(PseudoTypeInfo) | Tables0],
+ list__foldl(make_maybe_pseudo_type_info_tables, Args,
+ Tables1, Tables).
+make_pseudo_type_info_tables(PseudoTypeInfo, Tables0, Tables) :-
+ PseudoTypeInfo = var_arity_pseudo_type_info(_, Args),
+ Tables1 = [pseudo_type_info(PseudoTypeInfo) | Tables0],
+ list__foldl(make_maybe_pseudo_type_info_tables, Args,
+ Tables1, Tables).
make_pseudo_type_info_tables(type_var(_), Tables, Tables).
-make_pseudo_type_info_tables(type_ctor_info(_), Tables, Tables).
-make_pseudo_type_info_tables(TypeInfo, Tables0, Tables) :-
- TypeInfo = type_info(_, Args),
- Tables1 = [pseudo_type_info(TypeInfo) | Tables0],
- list__foldl(make_pseudo_type_info_tables, Args, Tables1, Tables).
-make_pseudo_type_info_tables(HO_TypeInfo, Tables0, Tables) :-
- HO_TypeInfo = higher_order_type_info(_, _, Args),
- Tables1 = [pseudo_type_info(HO_TypeInfo) | Tables0],
- list__foldl(make_pseudo_type_info_tables, Args, Tables1, Tables).
+
+:- pred make_maybe_pseudo_type_info_tables(rtti_maybe_pseudo_type_info::in,
+ list(rtti_data)::in, list(rtti_data)::out) is det.
+
+make_maybe_pseudo_type_info_tables(pseudo(PseudoTypeInfo), Tables0, Tables) :-
+ make_pseudo_type_info_tables(PseudoTypeInfo, Tables0, Tables).
+make_maybe_pseudo_type_info_tables(plain(TypeInfo), Tables0, Tables) :-
+ make_type_info_tables(TypeInfo, Tables0, Tables).
+
+:- pred make_maybe_pseudo_type_info_or_self_tables(
+ rtti_maybe_pseudo_type_info_or_self::in,
+ list(rtti_data)::in, list(rtti_data)::out) is det.
+
+make_maybe_pseudo_type_info_or_self_tables(pseudo(PseudoTypeInfo),
+ Tables0, Tables) :-
+ make_pseudo_type_info_tables(PseudoTypeInfo, Tables0, Tables).
+make_maybe_pseudo_type_info_or_self_tables(plain(TypeInfo), Tables0, Tables) :-
+ make_type_info_tables(TypeInfo, Tables0, Tables).
+make_maybe_pseudo_type_info_or_self_tables(self, Tables, Tables).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing detail
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/exceptions
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lazy_evaluation/examples
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/opium_m
cvs diff: Diffing extras/opium_m/non-regression-tests
cvs diff: Diffing extras/opium_m/scripts
cvs diff: Diffing extras/opium_m/source
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.2
diff -u -b -r1.2 construct.m
--- library/construct.m 18 Feb 2002 07:01:03 -0000 1.2
+++ library/construct.m 13 Mar 2002 21:33:38 -0000
@@ -141,13 +141,13 @@
{
MR_save_transient_registers();
TypeInfoList = MR_type_params_vector_to_list(Arity,
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info));
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info));
MR_restore_transient_registers();
} else {
MR_save_transient_registers();
TypeInfoList = MR_pseudo_type_info_vector_to_type_info_list(
arity,
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
construct_info.arg_pseudo_type_infos);
MR_restore_transient_registers();
}
@@ -222,13 +222,13 @@
{
MR_save_transient_registers();
TypeInfoList = MR_type_params_vector_to_list(Arity,
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info));
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info));
ArgNameList = MR_list_empty();
MR_restore_transient_registers();
} else {
MR_save_transient_registers();
TypeInfoList = MR_pseudo_type_info_vector_to_type_info_list(
- arity, MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ arity, MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
construct_info.arg_pseudo_type_infos);
ArgNameList = MR_arg_name_vector_to_list(
arity, construct_info.arg_names);
@@ -467,7 +467,7 @@
int arity, i;
MR_Word arg_list;
- arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
if (arity == 0) {
new_data = (MR_Word) NULL;
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.7
diff -u -b -r1.7 deconstruct.m
--- library/deconstruct.m 12 Mar 2002 03:40:38 -0000 1.7
+++ library/deconstruct.m 13 Mar 2002 21:35:25 -0000
@@ -804,7 +804,7 @@
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
functor_desc = MR_type_ctor_functors(type_ctor_info).functors_notag;
exp_type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
functor_desc->MR_notag_functor_arg_type);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = MR_TRUE;
@@ -850,7 +850,7 @@
case MR_TYPECTOR_REP_EQUIV_GROUND:
exp_type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv);
MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = MR_TRUE;
@@ -970,7 +970,7 @@
if (MR_arg_type_may_contain_var(functor_desc, i)) {
arg_type_info = MR_create_type_info_maybe_existq(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[i],
arg_vector, functor_desc);
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing quickcheck
cvs diff: Diffing quickcheck/tutes
cvs diff: Diffing readline
cvs diff: Diffing readline/doc
cvs diff: Diffing readline/examples
cvs diff: Diffing readline/shlib
cvs diff: Diffing readline/support
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.39
diff -u -b -r1.39 mercury.c
--- runtime/mercury.c 27 Mar 2002 05:18:47 -0000 1.39
+++ runtime/mercury.c 27 Mar 2002 05:29:45 -0000
@@ -196,7 +196,7 @@
}
arity = type_ctor_info->MR_type_ctor_arity;
- params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
args = (MR_Mercury_Type_Info *) params;
switch(arity) {
@@ -265,7 +265,7 @@
}
arity = type_ctor_info->MR_type_ctor_arity;
- params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
args = (MR_Mercury_Type_Info *) params;
switch(arity) {
@@ -412,12 +412,12 @@
MR_TypeInfo arg_type_info;
type_info = (MR_TypeInfo) ti;
- arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
for (i = 0; i < arity; i++) {
/* type_infos are counted starting at one. */
arg_type_info =
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info)[i + 1];
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
result = mercury__builtin__unify_2_p_0(
(MR_Mercury_Type_Info) arg_type_info, x[i], y[i]);
if (result == MR_FALSE) {
@@ -568,12 +568,12 @@
MR_TypeInfo arg_type_info;
type_info = (MR_TypeInfo) ti;
- arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
for (i = 0; i < arity; i++) {
/* type_infos are counted starting at one. */
arg_type_info =
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info)[i + 1];
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
mercury__builtin__compare_3_p_0((MR_Mercury_Type_Info) arg_type_info,
result, x[i], y[i]);
if (*result != MR_COMPARE_EQUAL) {
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.54
diff -u -b -r1.54 mercury.h
--- runtime/mercury.h 27 Mar 2002 15:24:21 -0000 1.54
+++ runtime/mercury.h 10 Apr 2002 05:10:09 -0000
@@ -197,96 +197,181 @@
** often, so this is probably OK for now...
*/
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct1, 1);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct2, 2);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct3, 3);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct4, 4);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct5, 5);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct6, 6);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct7, 7);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct8, 8);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct9, 9);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct10, 10);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct11, 11);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct12, 12);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct13, 13);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct14, 14);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct15, 15);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct16, 16);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct17, 17);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct18, 18);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct19, 19);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_HO_PseudoTypeInfo_Struct20, 20);
-
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct1, 1);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct2, 2);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct3, 3);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct4, 4);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct5, 5);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct6, 6);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct7, 7);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct8, 8);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct9, 9);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct10, 10);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct11, 11);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct12, 12);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct13, 13);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct14, 14);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct15, 15);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct16, 16);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct17, 17);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct18, 18);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct19, 19);
-MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(MR_FO_PseudoTypeInfo_Struct20, 20);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct1, 1);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct2, 2);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct3, 3);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct4, 4);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct5, 5);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct6, 6);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct7, 7);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct8, 8);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct9, 9);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct10, 10);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct11, 11);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct12, 12);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct13, 13);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct14, 14);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct15, 15);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct16, 16);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct17, 17);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct18, 18);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct19, 19);
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_VA_PseudoTypeInfo_Struct20, 20);
+
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct1, 1);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct2, 2);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct3, 3);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct4, 4);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct5, 5);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct6, 6);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct7, 7);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct8, 8);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct9, 9);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct10, 10);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct11, 11);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct12, 12);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct13, 13);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct14, 14);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct15, 15);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct16, 16);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct17, 17);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct18, 18);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct19, 19);
+MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(MR_FA_PseudoTypeInfo_Struct20, 20);
+
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct1, 1);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct2, 2);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct3, 3);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct4, 4);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct5, 5);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct6, 6);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct7, 7);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct8, 8);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct9, 9);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct10, 10);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct11, 11);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct12, 12);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct13, 13);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct14, 14);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct15, 15);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct16, 16);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct17, 17);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct18, 18);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct19, 19);
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_VA_TypeInfo_Struct20, 20);
+
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct1, 1);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct2, 2);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct3, 3);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct4, 4);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct5, 5);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct6, 6);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct7, 7);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct8, 8);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct9, 9);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct10, 10);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct11, 11);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct12, 12);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct13, 13);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct14, 14);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct15, 15);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct16, 16);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct17, 17);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct18, 18);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct19, 19);
+MR_FIXED_ARITY_TYPEINFO_STRUCT(MR_FA_TypeInfo_Struct20, 20);
/*
** Since standard C doesn't support zero-sized arrays,
** we use the same type for unary higher-order pseudo-type-infos
** as for zero-arity higher-order pseudo-type-infos.
*/
-typedef struct MR_HO_PseudoTypeInfo_Struct1 MR_HO_PseudoTypeInfo_Struct0;
-typedef struct MR_HO_PseudoTypeInfo_Struct1 MR_HO_PseudoTypeInfo_Struct1;
-typedef struct MR_HO_PseudoTypeInfo_Struct2 MR_HO_PseudoTypeInfo_Struct2;
-typedef struct MR_HO_PseudoTypeInfo_Struct3 MR_HO_PseudoTypeInfo_Struct3;
-typedef struct MR_HO_PseudoTypeInfo_Struct4 MR_HO_PseudoTypeInfo_Struct4;
-typedef struct MR_HO_PseudoTypeInfo_Struct5 MR_HO_PseudoTypeInfo_Struct5;
-typedef struct MR_HO_PseudoTypeInfo_Struct6 MR_HO_PseudoTypeInfo_Struct6;
-typedef struct MR_HO_PseudoTypeInfo_Struct7 MR_HO_PseudoTypeInfo_Struct7;
-typedef struct MR_HO_PseudoTypeInfo_Struct8 MR_HO_PseudoTypeInfo_Struct8;
-typedef struct MR_HO_PseudoTypeInfo_Struct9 MR_HO_PseudoTypeInfo_Struct9;
-typedef struct MR_HO_PseudoTypeInfo_Struct10 MR_HO_PseudoTypeInfo_Struct10;
-typedef struct MR_HO_PseudoTypeInfo_Struct11 MR_HO_PseudoTypeInfo_Struct11;
-typedef struct MR_HO_PseudoTypeInfo_Struct12 MR_HO_PseudoTypeInfo_Struct12;
-typedef struct MR_HO_PseudoTypeInfo_Struct13 MR_HO_PseudoTypeInfo_Struct13;
-typedef struct MR_HO_PseudoTypeInfo_Struct14 MR_HO_PseudoTypeInfo_Struct14;
-typedef struct MR_HO_PseudoTypeInfo_Struct15 MR_HO_PseudoTypeInfo_Struct15;
-typedef struct MR_HO_PseudoTypeInfo_Struct16 MR_HO_PseudoTypeInfo_Struct16;
-typedef struct MR_HO_PseudoTypeInfo_Struct17 MR_HO_PseudoTypeInfo_Struct17;
-typedef struct MR_HO_PseudoTypeInfo_Struct18 MR_HO_PseudoTypeInfo_Struct18;
-typedef struct MR_HO_PseudoTypeInfo_Struct19 MR_HO_PseudoTypeInfo_Struct19;
-typedef struct MR_HO_PseudoTypeInfo_Struct20 MR_HO_PseudoTypeInfo_Struct20;
-
-typedef struct MR_FO_PseudoTypeInfo_Struct1 MR_FO_PseudoTypeInfo_Struct1;
-typedef struct MR_FO_PseudoTypeInfo_Struct2 MR_FO_PseudoTypeInfo_Struct2;
-typedef struct MR_FO_PseudoTypeInfo_Struct3 MR_FO_PseudoTypeInfo_Struct3;
-typedef struct MR_FO_PseudoTypeInfo_Struct4 MR_FO_PseudoTypeInfo_Struct4;
-typedef struct MR_FO_PseudoTypeInfo_Struct5 MR_FO_PseudoTypeInfo_Struct5;
-typedef struct MR_FO_PseudoTypeInfo_Struct6 MR_FO_PseudoTypeInfo_Struct6;
-typedef struct MR_FO_PseudoTypeInfo_Struct7 MR_FO_PseudoTypeInfo_Struct7;
-typedef struct MR_FO_PseudoTypeInfo_Struct8 MR_FO_PseudoTypeInfo_Struct8;
-typedef struct MR_FO_PseudoTypeInfo_Struct9 MR_FO_PseudoTypeInfo_Struct9;
-typedef struct MR_FO_PseudoTypeInfo_Struct10 MR_FO_PseudoTypeInfo_Struct10;
-typedef struct MR_FO_PseudoTypeInfo_Struct11 MR_FO_PseudoTypeInfo_Struct11;
-typedef struct MR_FO_PseudoTypeInfo_Struct12 MR_FO_PseudoTypeInfo_Struct12;
-typedef struct MR_FO_PseudoTypeInfo_Struct13 MR_FO_PseudoTypeInfo_Struct13;
-typedef struct MR_FO_PseudoTypeInfo_Struct14 MR_FO_PseudoTypeInfo_Struct14;
-typedef struct MR_FO_PseudoTypeInfo_Struct15 MR_FO_PseudoTypeInfo_Struct15;
-typedef struct MR_FO_PseudoTypeInfo_Struct16 MR_FO_PseudoTypeInfo_Struct16;
-typedef struct MR_FO_PseudoTypeInfo_Struct17 MR_FO_PseudoTypeInfo_Struct17;
-typedef struct MR_FO_PseudoTypeInfo_Struct18 MR_FO_PseudoTypeInfo_Struct18;
-typedef struct MR_FO_PseudoTypeInfo_Struct19 MR_FO_PseudoTypeInfo_Struct19;
-typedef struct MR_FO_PseudoTypeInfo_Struct20 MR_FO_PseudoTypeInfo_Struct20;
+typedef struct MR_VA_PseudoTypeInfo_Struct1 MR_VA_PseudoTypeInfo_Struct0;
+typedef struct MR_VA_PseudoTypeInfo_Struct1 MR_VA_PseudoTypeInfo_Struct1;
+typedef struct MR_VA_PseudoTypeInfo_Struct2 MR_VA_PseudoTypeInfo_Struct2;
+typedef struct MR_VA_PseudoTypeInfo_Struct3 MR_VA_PseudoTypeInfo_Struct3;
+typedef struct MR_VA_PseudoTypeInfo_Struct4 MR_VA_PseudoTypeInfo_Struct4;
+typedef struct MR_VA_PseudoTypeInfo_Struct5 MR_VA_PseudoTypeInfo_Struct5;
+typedef struct MR_VA_PseudoTypeInfo_Struct6 MR_VA_PseudoTypeInfo_Struct6;
+typedef struct MR_VA_PseudoTypeInfo_Struct7 MR_VA_PseudoTypeInfo_Struct7;
+typedef struct MR_VA_PseudoTypeInfo_Struct8 MR_VA_PseudoTypeInfo_Struct8;
+typedef struct MR_VA_PseudoTypeInfo_Struct9 MR_VA_PseudoTypeInfo_Struct9;
+typedef struct MR_VA_PseudoTypeInfo_Struct10 MR_VA_PseudoTypeInfo_Struct10;
+typedef struct MR_VA_PseudoTypeInfo_Struct11 MR_VA_PseudoTypeInfo_Struct11;
+typedef struct MR_VA_PseudoTypeInfo_Struct12 MR_VA_PseudoTypeInfo_Struct12;
+typedef struct MR_VA_PseudoTypeInfo_Struct13 MR_VA_PseudoTypeInfo_Struct13;
+typedef struct MR_VA_PseudoTypeInfo_Struct14 MR_VA_PseudoTypeInfo_Struct14;
+typedef struct MR_VA_PseudoTypeInfo_Struct15 MR_VA_PseudoTypeInfo_Struct15;
+typedef struct MR_VA_PseudoTypeInfo_Struct16 MR_VA_PseudoTypeInfo_Struct16;
+typedef struct MR_VA_PseudoTypeInfo_Struct17 MR_VA_PseudoTypeInfo_Struct17;
+typedef struct MR_VA_PseudoTypeInfo_Struct18 MR_VA_PseudoTypeInfo_Struct18;
+typedef struct MR_VA_PseudoTypeInfo_Struct19 MR_VA_PseudoTypeInfo_Struct19;
+typedef struct MR_VA_PseudoTypeInfo_Struct20 MR_VA_PseudoTypeInfo_Struct20;
+
+typedef struct MR_FA_PseudoTypeInfo_Struct1 MR_FA_PseudoTypeInfo_Struct1;
+typedef struct MR_FA_PseudoTypeInfo_Struct2 MR_FA_PseudoTypeInfo_Struct2;
+typedef struct MR_FA_PseudoTypeInfo_Struct3 MR_FA_PseudoTypeInfo_Struct3;
+typedef struct MR_FA_PseudoTypeInfo_Struct4 MR_FA_PseudoTypeInfo_Struct4;
+typedef struct MR_FA_PseudoTypeInfo_Struct5 MR_FA_PseudoTypeInfo_Struct5;
+typedef struct MR_FA_PseudoTypeInfo_Struct6 MR_FA_PseudoTypeInfo_Struct6;
+typedef struct MR_FA_PseudoTypeInfo_Struct7 MR_FA_PseudoTypeInfo_Struct7;
+typedef struct MR_FA_PseudoTypeInfo_Struct8 MR_FA_PseudoTypeInfo_Struct8;
+typedef struct MR_FA_PseudoTypeInfo_Struct9 MR_FA_PseudoTypeInfo_Struct9;
+typedef struct MR_FA_PseudoTypeInfo_Struct10 MR_FA_PseudoTypeInfo_Struct10;
+typedef struct MR_FA_PseudoTypeInfo_Struct11 MR_FA_PseudoTypeInfo_Struct11;
+typedef struct MR_FA_PseudoTypeInfo_Struct12 MR_FA_PseudoTypeInfo_Struct12;
+typedef struct MR_FA_PseudoTypeInfo_Struct13 MR_FA_PseudoTypeInfo_Struct13;
+typedef struct MR_FA_PseudoTypeInfo_Struct14 MR_FA_PseudoTypeInfo_Struct14;
+typedef struct MR_FA_PseudoTypeInfo_Struct15 MR_FA_PseudoTypeInfo_Struct15;
+typedef struct MR_FA_PseudoTypeInfo_Struct16 MR_FA_PseudoTypeInfo_Struct16;
+typedef struct MR_FA_PseudoTypeInfo_Struct17 MR_FA_PseudoTypeInfo_Struct17;
+typedef struct MR_FA_PseudoTypeInfo_Struct18 MR_FA_PseudoTypeInfo_Struct18;
+typedef struct MR_FA_PseudoTypeInfo_Struct19 MR_FA_PseudoTypeInfo_Struct19;
+typedef struct MR_FA_PseudoTypeInfo_Struct20 MR_FA_PseudoTypeInfo_Struct20;
+
+typedef struct MR_VA_TypeInfo_Struct1 MR_VA_TypeInfo_Struct0;
+typedef struct MR_VA_TypeInfo_Struct1 MR_VA_TypeInfo_Struct1;
+typedef struct MR_VA_TypeInfo_Struct2 MR_VA_TypeInfo_Struct2;
+typedef struct MR_VA_TypeInfo_Struct3 MR_VA_TypeInfo_Struct3;
+typedef struct MR_VA_TypeInfo_Struct4 MR_VA_TypeInfo_Struct4;
+typedef struct MR_VA_TypeInfo_Struct5 MR_VA_TypeInfo_Struct5;
+typedef struct MR_VA_TypeInfo_Struct6 MR_VA_TypeInfo_Struct6;
+typedef struct MR_VA_TypeInfo_Struct7 MR_VA_TypeInfo_Struct7;
+typedef struct MR_VA_TypeInfo_Struct8 MR_VA_TypeInfo_Struct8;
+typedef struct MR_VA_TypeInfo_Struct9 MR_VA_TypeInfo_Struct9;
+typedef struct MR_VA_TypeInfo_Struct10 MR_VA_TypeInfo_Struct10;
+typedef struct MR_VA_TypeInfo_Struct11 MR_VA_TypeInfo_Struct11;
+typedef struct MR_VA_TypeInfo_Struct12 MR_VA_TypeInfo_Struct12;
+typedef struct MR_VA_TypeInfo_Struct13 MR_VA_TypeInfo_Struct13;
+typedef struct MR_VA_TypeInfo_Struct14 MR_VA_TypeInfo_Struct14;
+typedef struct MR_VA_TypeInfo_Struct15 MR_VA_TypeInfo_Struct15;
+typedef struct MR_VA_TypeInfo_Struct16 MR_VA_TypeInfo_Struct16;
+typedef struct MR_VA_TypeInfo_Struct17 MR_VA_TypeInfo_Struct17;
+typedef struct MR_VA_TypeInfo_Struct18 MR_VA_TypeInfo_Struct18;
+typedef struct MR_VA_TypeInfo_Struct19 MR_VA_TypeInfo_Struct19;
+typedef struct MR_VA_TypeInfo_Struct20 MR_VA_TypeInfo_Struct20;
+
+typedef struct MR_FA_TypeInfo_Struct1 MR_FA_TypeInfo_Struct1;
+typedef struct MR_FA_TypeInfo_Struct2 MR_FA_TypeInfo_Struct2;
+typedef struct MR_FA_TypeInfo_Struct3 MR_FA_TypeInfo_Struct3;
+typedef struct MR_FA_TypeInfo_Struct4 MR_FA_TypeInfo_Struct4;
+typedef struct MR_FA_TypeInfo_Struct5 MR_FA_TypeInfo_Struct5;
+typedef struct MR_FA_TypeInfo_Struct6 MR_FA_TypeInfo_Struct6;
+typedef struct MR_FA_TypeInfo_Struct7 MR_FA_TypeInfo_Struct7;
+typedef struct MR_FA_TypeInfo_Struct8 MR_FA_TypeInfo_Struct8;
+typedef struct MR_FA_TypeInfo_Struct9 MR_FA_TypeInfo_Struct9;
+typedef struct MR_FA_TypeInfo_Struct10 MR_FA_TypeInfo_Struct10;
+typedef struct MR_FA_TypeInfo_Struct11 MR_FA_TypeInfo_Struct11;
+typedef struct MR_FA_TypeInfo_Struct12 MR_FA_TypeInfo_Struct12;
+typedef struct MR_FA_TypeInfo_Struct13 MR_FA_TypeInfo_Struct13;
+typedef struct MR_FA_TypeInfo_Struct14 MR_FA_TypeInfo_Struct14;
+typedef struct MR_FA_TypeInfo_Struct15 MR_FA_TypeInfo_Struct15;
+typedef struct MR_FA_TypeInfo_Struct16 MR_FA_TypeInfo_Struct16;
+typedef struct MR_FA_TypeInfo_Struct17 MR_FA_TypeInfo_Struct17;
+typedef struct MR_FA_TypeInfo_Struct18 MR_FA_TypeInfo_Struct18;
+typedef struct MR_FA_TypeInfo_Struct19 MR_FA_TypeInfo_Struct19;
+typedef struct MR_FA_TypeInfo_Struct20 MR_FA_TypeInfo_Struct20;
/*
** The chain of stack frames, used for accurate GC.
Index: runtime/mercury_bootstrap.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_bootstrap.h,v
retrieving revision 1.28
diff -u -b -r1.28 mercury_bootstrap.h
--- runtime/mercury_bootstrap.h 27 Mar 2002 07:21:45 -0000 1.28
+++ runtime/mercury_bootstrap.h 9 Apr 2002 06:57:39 -0000
@@ -16,19 +16,23 @@
#define MERCURY_BOOTSTRAP_H
/*
-** This stuff is enabled by default,
-** but you can disable it by defining MR_NO_BACKWARDS_COMPAT.
+** These will be needed until we regularize the module-qualification
+** of builtin types.
*/
-#ifndef MR_NO_BACKWARDS_COMPAT
+#define mercury_data_builtin__type_ctor_info_func_0 \
+ mercury_data___type_ctor_info_func_0
+#define mercury_data_builtin__type_ctor_info_pred_0 \
+ mercury_data___type_ctor_info_pred_0
+#define mercury_data_builtin__type_ctor_info_tuple_0 \
+ mercury_data___type_ctor_info_tuple_0
/*
-** The next two #defines are needed for bootstrapping the new type constructor
-** structure.
+** This stuff is enabled by default,
+** but you can disable it by defining MR_NO_BACKWARDS_COMPAT.
*/
-#define MR_TypeCtorInfo_struct MR_TypeCtorInfo_Struct
-#define MR_NewTypeCtorInfo_struct MR_TypeCtorInfo_Struct
+#ifndef MR_NO_BACKWARDS_COMPAT
/*
** bool, TRUE and FALSE appear in the generated code.
Index: runtime/mercury_construct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_construct.c,v
retrieving revision 1.3
diff -u -b -r1.3 mercury_construct.c
--- runtime/mercury_construct.c 27 Mar 2002 05:18:47 -0000 1.3
+++ runtime/mercury_construct.c 27 Mar 2002 05:29:45 -0000
@@ -122,13 +122,13 @@
case MR_TYPECTOR_REP_EQUIV:
return MR_get_functor_info(
MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv),
functor_number, construct_info);
case MR_TYPECTOR_REP_TUPLE:
construct_info->functor_name = "{}";
- construct_info->arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ construct_info->arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
/* Tuple types don't have pseudo-type_infos for the functors. */
construct_info->arg_pseudo_type_infos = NULL;
@@ -205,10 +205,11 @@
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)))
{
- arg_type_info = MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info)[i + 1];
+ arg_type_info =
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
} else {
arg_type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
arg_pseudo_type_infos[i]);
}
Index: runtime/mercury_deconstruct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deconstruct.c,v
retrieving revision 1.9
diff -u -b -r1.9 mercury_deconstruct.c
--- runtime/mercury_deconstruct.c 27 Mar 2002 05:18:48 -0000 1.9
+++ runtime/mercury_deconstruct.c 27 Mar 2002 05:29:45 -0000
@@ -232,7 +232,7 @@
case MR_TYPECTOR_REP_EQUIV:
eqv_type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv);
return MR_named_arg_num(eqv_type_info, term_ptr, arg_name,
arg_num_ptr);
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.52
diff -u -b -r1.52 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 27 Mar 2002 07:35:34 -0000 1.52
+++ runtime/mercury_deep_copy_body.h 28 Mar 2002 03:53:37 -0000
@@ -224,7 +224,7 @@
MR_field(0, new_data, cur_slot) = \
copy_arg(parent_data, &data_value[cur_slot], \
functor_desc, \
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR( \
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR( \
type_info), \
functor_desc->MR_du_functor_arg_types[i], \
lower_limit, upper_limit); \
@@ -269,7 +269,7 @@
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
new_data = copy_arg(NULL, data_ptr, NULL,
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_notag->
MR_notag_functor_arg_type, lower_limit, upper_limit);
break;
@@ -284,7 +284,7 @@
case MR_TYPECTOR_REP_EQUIV:
new_data = copy_arg(NULL, data_ptr, NULL,
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv,
lower_limit, upper_limit);
break;
@@ -438,7 +438,7 @@
MR_Word *new_data_ptr;
MR_TypeInfo *arg_typeinfo_vector;
- arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
if (arity == 0) {
new_data = (MR_Word) NULL;
@@ -448,7 +448,7 @@
new_data_ptr = (MR_Word *) new_data;
arg_typeinfo_vector =
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info);
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
for (i = 0; i < arity; i++) {
/* type_infos are counted from one */
new_data_ptr[i] = copy(&data_value[i],
@@ -488,7 +488,7 @@
for (i = 0; i < array_size; i++) {
new_array->elements[i] = copy_arg(NULL,
&old_array->elements[i], NULL,
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
(const MR_PseudoTypeInfo) 1, lower_limit, upper_limit);
}
new_data = (MR_Word) new_array;
@@ -502,7 +502,7 @@
for (i = 0; i < array_size; i++) {
(void) copy_arg(NULL,
&old_array->elements[i], NULL,
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
(const MR_PseudoTypeInfo) 1, lower_limit, upper_limit);
}
new_data = data;
@@ -687,19 +687,19 @@
if (MR_type_ctor_rep_is_variable_arity(
MR_type_ctor_rep(type_ctor_info)))
{
- arity = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info);
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
type_info_args =
- MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info);
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
MR_incr_saved_hp(MR_LVALUE_CAST(MR_Word, new_type_info_arena),
- MR_higher_order_type_info_size(arity));
- MR_fill_in_higher_order_type_info(new_type_info_arena,
+ MR_var_arity_type_info_size(arity));
+ MR_fill_in_var_arity_type_info(new_type_info_arena,
type_ctor_info, arity, new_type_info_args);
} else {
arity = type_ctor_info->MR_type_ctor_arity;
- type_info_args = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ type_info_args = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
MR_incr_saved_hp(MR_LVALUE_CAST(MR_Word, new_type_info_arena),
- MR_first_order_type_info_size(arity));
- MR_fill_in_first_order_type_info(new_type_info_arena,
+ MR_fixed_arity_type_info_size(arity));
+ MR_fill_in_fixed_arity_type_info(new_type_info_arena,
type_ctor_info, new_type_info_args);
}
for (i = 1; i <= arity; i++) {
Index: runtime/mercury_make_type_info_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_make_type_info_body.h,v
retrieving revision 1.8
diff -u -b -r1.8 mercury_make_type_info_body.h
--- runtime/mercury_make_type_info_body.h 25 Jan 2002 08:23:22 -0000 1.8
+++ runtime/mercury_make_type_info_body.h 12 Mar 2002 15:16:12 -0000
@@ -65,7 +65,7 @@
if (MR_type_ctor_rep_is_variable_arity(
MR_type_ctor_rep(type_ctor_info)))
{
- arity = MR_PSEUDO_TYPEINFO_GET_HIGHER_ORDER_ARITY(
+ arity = MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARITY(
pseudo_type_info);
start_region_size = 2;
} else {
Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.20
diff -u -b -r1.20 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h 27 Mar 2002 07:35:35 -0000 1.20
+++ runtime/mercury_ml_expand_body.h 28 Mar 2002 03:53:37 -0000
@@ -452,7 +452,7 @@
if (MR_arg_type_may_contain_var(functor_desc, i)) {
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[i] =
MR_create_type_info_maybe_existq(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[i],
arg_vector, functor_desc);
@@ -490,7 +490,7 @@
if (MR_arg_type_may_contain_var(functor_desc, chosen)) {
expand_info->chosen_type_info =
MR_create_type_info_maybe_existq(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
type_info),
functor_desc->MR_du_functor_arg_types[chosen],
arg_vector, functor_desc);
@@ -532,7 +532,7 @@
MR_GC_NEW_ARRAY(MR_TypeInfo, 1);
expand_info->EXPAND_ARGS_FIELD.arg_type_infos[0] =
MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_notag->
MR_notag_functor_arg_type);
#endif /* EXPAND_ARGS_FIELD */
@@ -553,7 +553,7 @@
expand_info->chosen_value_ptr = data_word_ptr;
expand_info->chosen_type_info =
MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_notag->
MR_notag_functor_arg_type);
} else {
@@ -621,7 +621,7 @@
MR_TypeInfo eqv_type_info;
eqv_type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv);
EXPAND_FUNCTION_NAME(eqv_type_info, data_word_ptr, noncanon,
EXTRA_ARGS expand_info);
@@ -829,7 +829,7 @@
break;
case MR_TYPECTOR_REP_TUPLE:
- expand_info->arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ expand_info->arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
handle_functor_name("{}");
#ifdef EXPAND_ARGS_FIELD
@@ -848,7 +848,7 @@
** the users of this vector count from zero.
*/
expand_info->EXPAND_ARGS_FIELD.arg_type_infos =
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info) + 1;
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info) + 1;
}
#endif /* EXPAND_ARGS_FIELD */
@@ -860,7 +860,7 @@
expand_info->chosen_index_exists = MR_TRUE;
expand_info->chosen_value_ptr = &arg_vector[chosen];
expand_info->chosen_type_info =
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info)[chosen + 1];
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[chosen + 1];
} else {
expand_info->chosen_index_exists = MR_FALSE;
}
@@ -936,13 +936,13 @@
MR_type_ctor_rep(data_type_ctor_info)))
{
num_args =
- MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(data_type_info);
+ MR_TYPEINFO_GET_VAR_ARITY_ARITY(data_type_info);
arg_type_infos = (MR_Word *)
- MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(data_type_info);
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(data_type_info);
} else {
num_args = data_type_ctor_info->MR_type_ctor_arity;
arg_type_infos = (MR_Word *)
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(data_type_info);
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(data_type_info);
}
expand_info->arity = num_args;
/* switch from 1-based to 0-based array indexing */
@@ -1077,7 +1077,7 @@
MR_TypeInfoParams params;
int i;
- params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
expand_info->EXPAND_ARGS_FIELD.num_extra_args = 0;
expand_info->EXPAND_ARGS_FIELD.arg_values =
&array->elements[0];
@@ -1096,7 +1096,7 @@
if (0 <= chosen && chosen < array->size) {
MR_TypeInfoParams params;
- params = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
expand_info->chosen_value_ptr = &array->elements[chosen];
expand_info->chosen_type_info = params[1];
expand_info->chosen_index_exists = MR_TRUE;
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.50
diff -u -b -r1.50 mercury_tabling.c
--- runtime/mercury_tabling.c 27 Mar 2002 05:18:50 -0000 1.50
+++ runtime/mercury_tabling.c 27 Mar 2002 05:29:46 -0000
@@ -584,13 +584,13 @@
if (MR_type_ctor_rep_is_variable_arity(
MR_type_ctor_rep(type_ctor_info)))
{
- arity = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info);
- arg_vector = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
+ arg_vector = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(
type_info);
node = MR_int_hash_lookup_or_add(node, arity);
} else {
arity = type_ctor_info->MR_type_ctor_arity;
- arg_vector = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ arg_vector = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
}
for (i = 1; i <= arity; i++) {
@@ -769,7 +769,7 @@
for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
if (MR_arg_type_may_contain_var(functor_desc, i)) {
arg_type_info = MR_make_type_info_maybe_existq(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
functor_desc->MR_du_functor_arg_types[i],
arg_vector, functor_desc, &allocated_memory_cells);
} else {
@@ -792,7 +792,7 @@
MR_TypeInfo eqv_type_info;
eqv_type_info = MR_make_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_notag->
MR_notag_functor_arg_type, &allocated_memory_cells);
MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
@@ -813,7 +813,7 @@
MR_TypeInfo eqv_type_info;
eqv_type_info = MR_make_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv,
&allocated_memory_cells);
MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
@@ -881,9 +881,9 @@
int i;
data_value = (MR_Word *) data;
- arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
arg_type_info_vector =
- MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info);
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info);
for (i = 0; i < arity; i++) {
/* type_infos are counted starting at one */
MR_DEBUG_TABLE_ANY(table, arg_type_info_vector[i + 1],
@@ -933,7 +933,7 @@
array_size = array->size;
new_type_info = MR_make_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
(MR_PseudoTypeInfo) 1, &allocated_memory_cells);
for (i = 0; i < array_size; i++) {
Index: runtime/mercury_type_desc.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_desc.c,v
retrieving revision 1.3
diff -u -b -r1.3 mercury_type_desc.c
--- runtime/mercury_type_desc.c 27 Mar 2002 05:18:51 -0000 1.3
+++ runtime/mercury_type_desc.c 27 Mar 2002 05:29:47 -0000
@@ -25,21 +25,21 @@
if (MR_TYPE_CTOR_INFO_IS_HO_PRED(type_ctor_info)) {
type_ctor_desc = MR_TYPECTOR_DESC_MAKE_PRED(
- MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info));
+ MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info));
if (! MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
MR_fatal_error("MR_make_type_ctor_desc"
" - arity out of range.");
}
} else if (MR_TYPE_CTOR_INFO_IS_HO_FUNC(type_ctor_info)) {
type_ctor_desc = MR_TYPECTOR_DESC_MAKE_FUNC(
- MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info));
+ MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info));
if (! MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
MR_fatal_error("MR_make_type_ctor_desc"
" - arity out of range.");
}
} else if (MR_TYPE_CTOR_INFO_IS_TUPLE(type_ctor_info)) {
type_ctor_desc = MR_TYPECTOR_DESC_MAKE_TUPLE(
- MR_TYPEINFO_GET_TUPLE_ARITY(type_info));
+ MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info));
if (! MR_TYPECTOR_DESC_IS_VARIABLE_ARITY(type_ctor_desc)) {
MR_fatal_error("MR_make_type_ctor_desc"
" - arity out of range.");
@@ -73,11 +73,11 @@
{
arity = MR_TYPECTOR_DESC_GET_VA_ARITY(type_ctor_desc);
*arg_type_info_list_ptr = MR_type_params_vector_to_list(arity,
- MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info));
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info));
} else {
arity = type_ctor_info->MR_type_ctor_arity;
*arg_type_info_list_ptr = MR_type_params_vector_to_list(arity,
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info));
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info));
}
}
@@ -100,10 +100,10 @@
MR_restore_transient_registers();
MR_incr_hp_atomic_msg(
MR_LVALUE_CAST(MR_Word, new_type_info_arena),
- MR_higher_order_type_info_size(arity),
+ MR_var_arity_type_info_size(arity),
"MR_make_type", "type_info");
MR_save_transient_registers();
- MR_fill_in_higher_order_type_info(new_type_info_arena,
+ MR_fill_in_var_arity_type_info(new_type_info_arena,
type_ctor_info, arity, new_type_info_args);
} else {
type_ctor_info =
@@ -117,10 +117,10 @@
MR_restore_transient_registers();
MR_incr_hp_atomic_msg(
MR_LVALUE_CAST(MR_Word, new_type_info_arena),
- MR_first_order_type_info_size(arity),
+ MR_fixed_arity_type_info_size(arity),
"MR_make_type", "type_info");
MR_save_transient_registers();
- MR_fill_in_first_order_type_info(new_type_info_arena,
+ MR_fill_in_fixed_arity_type_info(new_type_info_arena,
type_ctor_info, new_type_info_args);
}
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.50
diff -u -b -r1.50 mercury_type_info.c
--- runtime/mercury_type_info.c 27 Mar 2002 05:18:51 -0000 1.50
+++ runtime/mercury_type_info.c 27 Mar 2002 09:41:25 -0000
@@ -168,8 +168,8 @@
*/
if (MR_type_ctor_rep_is_variable_arity(MR_type_ctor_rep(tci1))) {
- num_arg_types_1 = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(ti1);
- num_arg_types_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(ti2);
+ num_arg_types_1 = MR_TYPEINFO_GET_VAR_ARITY_ARITY(ti1);
+ num_arg_types_2 = MR_TYPEINFO_GET_VAR_ARITY_ARITY(ti2);
/* Check arity */
if (num_arg_types_1 < num_arg_types_2) {
@@ -178,12 +178,12 @@
return MR_COMPARE_GREATER;
}
- arg_vector_1 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(ti1);
- arg_vector_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(ti2);
+ arg_vector_1 = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(ti1);
+ arg_vector_2 = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(ti2);
} else {
num_arg_types_1 = tci1->MR_type_ctor_arity;
- arg_vector_1 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(ti1);
- arg_vector_2 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(ti2);
+ arg_vector_1 = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti1);
+ arg_vector_2 = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti2);
}
/* compare the argument types */
@@ -253,20 +253,20 @@
*/
if (MR_type_ctor_rep_is_variable_arity(MR_type_ctor_rep(tci1))) {
- num_arg_types_1 = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(ti1);
- num_arg_types_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(ti2);
+ num_arg_types_1 = MR_TYPEINFO_GET_VAR_ARITY_ARITY(ti1);
+ num_arg_types_2 = MR_TYPEINFO_GET_VAR_ARITY_ARITY(ti2);
/* Check arity */
if (num_arg_types_1 != num_arg_types_2) {
return MR_FALSE;
}
- arg_vector_1 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(ti1);
- arg_vector_2 = MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(ti2);
+ arg_vector_1 = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(ti1);
+ arg_vector_2 = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(ti2);
} else {
num_arg_types_1 = tci1->MR_type_ctor_arity;
- arg_vector_1 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(ti1);
- arg_vector_2 = MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(ti2);
+ arg_vector_1 = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti1);
+ arg_vector_2 = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(ti2);
}
/* compare the argument types */
@@ -368,7 +368,7 @@
{
maybe_equiv_type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(
maybe_equiv_type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv);
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.88
diff -u -b -r1.88 mercury_type_info.h
--- runtime/mercury_type_info.h 27 Mar 2002 05:18:51 -0000 1.88
+++ runtime/mercury_type_info.h 4 Apr 2002 01:52:37 -0000
@@ -139,43 +139,52 @@
** for static constant typeinfos and pseudotypeinfos.
*/
-#define MR_FIRST_ORDER_TYPEINFO_STRUCT(NAME, ARITY) \
+#define MR_FIXED_ARITY_TYPEINFO_STRUCT(NAME, ARITY) \
struct NAME { \
MR_TypeCtorInfo MR_ti_type_ctor_info; \
- MR_TypeInfo MR_ti_first_order_arg_typeinfos[ARITY]; \
+ MR_TypeInfo MR_ti_fixed_arity_arg_typeinfos[ARITY]; \
}
/* Tuple types also use the higher-order type-info structure. */
-#define MR_HIGHER_ORDER_TYPEINFO_STRUCT(NAME, ARITY) \
+#define MR_VAR_ARITY_TYPEINFO_STRUCT(NAME, ARITY) \
struct NAME { \
MR_TypeCtorInfo MR_ti_type_ctor_info; \
- MR_Integer MR_ti_higher_order_arity; \
- MR_TypeInfo MR_ti_higher_order_arg_typeinfos[ARITY]; \
+ MR_Integer MR_ti_var_arity_arity; \
+ MR_TypeInfo MR_ti_var_arity_arg_typeinfos[ARITY]; \
}
-#define MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(NAME, ARITY) \
+#define MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(NAME, ARITY) \
struct NAME { \
MR_TypeCtorInfo MR_pti_type_ctor_info; \
- MR_PseudoTypeInfo MR_pti_first_order_arg_pseudo_typeinfos[ARITY]; \
+ MR_PseudoTypeInfo MR_pti_fixed_arity_arg_pseudo_typeinfos[ARITY]; \
}
/* Tuple types also use the higher-order pseude-type-info structure. */
-#define MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(NAME, ARITY) \
+#define MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(NAME, ARITY) \
struct NAME { \
MR_TypeCtorInfo MR_pti_type_ctor_info; \
- MR_Integer MR_pti_higher_order_arity; \
- MR_PseudoTypeInfo MR_pti_higher_order_arg_pseudo_typeinfos[ARITY]; \
+ MR_Integer MR_pti_var_arity_arity; \
+ MR_PseudoTypeInfo MR_pti_var_arity_arg_pseudo_typeinfos[ARITY]; \
}
/*
+** The next two #defines are needed for bootstrapping.
+*/
+
+#define MR_FIRST_ORDER_PSEUDOTYPEINFO_STRUCT(a, b) \
+ MR_FIXED_ARITY_PSEUDOTYPEINFO_STRUCT(a, b)
+#define MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(a, b) \
+ MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(a, b)
+
+/*
** Now define specific versions of these struct types,
** which are used by the MR_TypeInfo and MR_PseudoTypeInfo
** typedefs above.
*/
-MR_HIGHER_ORDER_TYPEINFO_STRUCT(MR_TypeInfo_Almost_Struct,
+MR_VAR_ARITY_TYPEINFO_STRUCT(MR_TypeInfo_Almost_Struct,
MR_VARIABLE_SIZED);
-MR_HIGHER_ORDER_PSEUDOTYPEINFO_STRUCT(MR_PseudoTypeInfo_Almost_Struct,
+MR_VAR_ARITY_PSEUDOTYPEINFO_STRUCT(MR_PseudoTypeInfo_Almost_Struct,
MR_VARIABLE_SIZED);
/*
@@ -241,42 +250,30 @@
? (pseudo_type_info)->MR_pti_type_ctor_info \
: (MR_TypeCtorInfo) (pseudo_type_info))
-#define MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info) \
- ((type_info)->MR_ti_higher_order_arity)
-
-#define MR_TYPEINFO_GET_TUPLE_ARITY(type_info) \
- MR_TYPEINFO_GET_HIGHER_ORDER_ARITY(type_info)
+#define MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info) \
+ ((type_info)->MR_ti_var_arity_arity)
-#define MR_PSEUDO_TYPEINFO_GET_HIGHER_ORDER_ARITY(pseudo_type_info) \
- ((pseudo_type_info)->MR_pti_higher_order_arity)
+#define MR_PSEUDO_TYPEINFO_GET_VAR_ARITY_ARITY(pseudo_type_info) \
+ ((pseudo_type_info)->MR_pti_var_arity_arity)
-#define MR_PSEUDO_TYPEINFO_GET_TUPLE_ARITY(pseudo_type_info) \
- MR_PSEUDO_TYPEINFO_GET_HIGHER_ORDER_ARITY(pseudo_type_info)
-
-#define MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info) \
+#define MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info) \
((MR_TypeInfoParams) &(type_info)->MR_ti_type_ctor_info)
-#define MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info) \
+#define MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info) \
((MR_TypeInfoParams) \
- &(type_info)->MR_ti_higher_order_arity)
-
-#define MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(type_info) \
- MR_TYPEINFO_GET_HIGHER_ORDER_ARG_VECTOR(type_info)
+ &(type_info)->MR_ti_var_arity_arity)
/*
** Macros for creating type_infos.
*/
-#define MR_first_order_type_info_size(arity) \
+#define MR_fixed_arity_type_info_size(arity) \
(1 + (arity))
-#define MR_higher_order_type_info_size(arity) \
+#define MR_var_arity_type_info_size(arity) \
(2 + (arity))
-#define MR_tuple_type_info_size(arity) \
- MR_higher_order_type_info_size(arity)
-
-#define MR_fill_in_first_order_type_info(arena, type_ctor_info, vector) \
+#define MR_fill_in_fixed_arity_type_info(arena, type_ctor_info, vector) \
do { \
MR_TypeInfo new_ti; \
new_ti = (MR_TypeInfo) (arena); \
@@ -284,18 +281,15 @@
(vector) = (MR_TypeInfoParams) &new_ti->MR_ti_type_ctor_info; \
} while (0)
-#define MR_fill_in_higher_order_type_info(arena, type_ctor_info, arity, vector)\
+#define MR_fill_in_var_arity_type_info(arena, type_ctor_info, arity, vector)\
do { \
MR_TypeInfo new_ti; \
new_ti = (MR_TypeInfo) (arena); \
new_ti->MR_ti_type_ctor_info = (type_ctor_info); \
- new_ti->MR_ti_higher_order_arity = (arity); \
- (vector) = (MR_TypeInfoParams) &new_ti->MR_ti_higher_order_arity;\
+ new_ti->MR_ti_var_arity_arity = (arity); \
+ (vector) = (MR_TypeInfoParams) &new_ti->MR_ti_var_arity_arity;\
} while (0)
-#define MR_fill_in_tuple_type_info(arena, type_ctor_info, arity, vector) \
- MR_fill_in_higher_order_type_info(arena, type_ctor_info, arity, vector)
-
#define MR_static_type_info_arity_0(name, ctor) \
struct { \
MR_TypeCtorInfo field1; \
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.19
diff -u -b -r1.19 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h 27 Mar 2002 05:18:52 -0000 1.19
+++ runtime/mercury_unify_compare_body.h 27 Mar 2002 05:29:47 -0000
@@ -58,7 +58,7 @@
case MR_TYPECTOR_REP_EQUIV:
MR_save_transient_hp();
type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_equiv);
MR_restore_transient_hp();
goto start_label;
@@ -73,7 +73,7 @@
case MR_TYPECTOR_REP_NOTAG:
MR_save_transient_hp();
type_info = MR_create_type_info(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).layout_notag->
MR_notag_functor_arg_type);
MR_restore_transient_hp();
@@ -262,7 +262,7 @@
if (MR_arg_type_may_contain_var(functor_desc, i)) {
MR_save_transient_hp();
arg_type_info = MR_create_type_info_maybe_existq(
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
functor_desc->MR_du_functor_arg_types[i],
x_data_value, functor_desc);
MR_restore_transient_hp();
@@ -341,7 +341,7 @@
MR_Word *args_base;
args_base = (MR_Word *)
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
MR_r1 = args_base[1];
MR_r2 = x;
MR_r3 = y;
@@ -352,7 +352,7 @@
MR_Word *args_base;
args_base = (MR_Word *)
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
MR_r1 = args_base[1];
MR_r2 = args_base[2];
MR_r3 = x;
@@ -366,7 +366,7 @@
type_arity = type_ctor_info->MR_type_ctor_arity;
args_base = (MR_Word *)
- MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info);
+ MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
MR_save_registers();
/* CompPred(...ArgTypeInfos..., Res, X, Y) * */
@@ -387,13 +387,13 @@
int type_arity;
int result;
- type_arity = MR_TYPEINFO_GET_TUPLE_ARITY(type_info);
+ type_arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
for (i = 0; i < type_arity; i++) {
MR_TypeInfo arg_type_info;
/* type_infos are counted from one */
- arg_type_info = MR_TYPEINFO_GET_TUPLE_ARG_VECTOR(
+ arg_type_info = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(
type_info)[i + 1];
#ifdef select_compare_code
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/intermod
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/submodules
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/tools
cvs diff: Diffing tests/typeclasses
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing trax
cvs diff: Diffing trial
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
More information about the reviews
mailing list