[m-rev.] diff/for review: step 1 of fixing eliminating type_info/1's argument
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Sep 19 15:16:33 AEST 2005
This is step 1 of eliminating the arguments of the type_ctor_info, type_info,
base_typeclass_info and typeclass_info type constructors. This step doesn't
delete those arity-1 type constructors yet; that will be done in step 2.
This delay due to bootstrapping issues: installed compilers still generate
references to those type constructors. However, after this change, compilers
will instead generate references to arity-0 versions of those types named
zero_type_ctor_info, zero_type_info, zero_base_typeclass_info and
zero_typeclass_info.
library/private_builtin.m:
Add the new type constructors.
For each predicate that operates on the old arity-1 type constructors,
add a version that operates on the new type arity-0 onstructors,
and whose implementation is identical.
runtime/mercury_builtin_types.m:
Add the unify and compare predicates of the new type constructors.
runtime/mercury_wrapper.[ch]:
runtime/mercury_init.h:
util/mkinit.c:
Change the C type of the variable that holds the types of type_infos
and pseudo_type_infos, since their representation is now simpler
(no dummy argument).
trace/mercury_trace_vars.c:
Modify data structures that recognize the four old types to recognize
their new variants as well.
compiler/higher_order.m:
compiler/polymorphism.m:
Generate references to the new versions of predicates that manipulate
type_infos and typeclass_infos.
compiler/hlds_pred.m:
compiler/ml_code_util.m:
compiler/type_ctor_info.m:
Modify predicates that recognize the four old types to recognize their
new variants as well.
compiler/type_util.m:
Modify the predicates that construct the types of type_infos
to create references to the new arity-0 type constructors.
Modify predicates that recognize the four old types to recognize their
new variants as well.
Delete the predicate whose job was to replace the dummy arguments
of the arity-1 type constructors with the void type, since it is not
needed anymore.
Delete the unused predicate cell_type_name.
compiler/stack_layout.m:
Fix comment.
compiler/size_prof.m:
Conform to the changes in type_util.
compiler/pseudo_type_info.m:
Conform to the changes in type_util.
Convert to four-space indentation.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
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 compiler
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.136
diff -u -b -r1.136 higher_order.m
--- compiler/higher_order.m 13 Sep 2005 04:56:02 -0000 1.136
+++ compiler/higher_order.m 17 Sep 2005 13:29:13 -0000
@@ -986,7 +986,7 @@
MakeResultType = polymorphism.build_typeclass_info_type,
get_typeclass_info_args(ModuleInfo, TypeClassInfoVar,
- "instance_constraint_from_typeclass_info", MakeResultType,
+ "zero_instance_constraint_from_typeclass_info", MakeResultType,
InstanceConstraints, Index, Goals, Vars, !ProcInfo).
% Build calls to
@@ -1004,7 +1004,7 @@
UnconstrainedTVarTypes, Index, Goals, Vars, !ProcInfo) :-
MakeResultType = polymorphism.build_type_info_type,
get_typeclass_info_args(ModuleInfo, TypeClassInfoVar,
- "unconstrained_type_info_from_typeclass_info",
+ "zero_unconstrained_type_info_from_typeclass_info",
MakeResultType, UnconstrainedTVarTypes,
Index, Goals, Vars, !ProcInfo).
@@ -1016,8 +1016,7 @@
get_typeclass_info_args(ModuleInfo, TypeClassInfoVar, PredName, MakeResultType,
Args, Index, Goals, Vars, !ProcInfo) :-
lookup_builtin_pred_proc_id(ModuleInfo, mercury_private_builtin_module,
- PredName, predicate, 3, only_mode, ExtractArgPredId,
- ExtractArgProcId),
+ PredName, predicate, 3, only_mode, ExtractArgPredId, ExtractArgProcId),
get_typeclass_info_args_2(TypeClassInfoVar, ExtractArgPredId,
ExtractArgProcId,
qualified(mercury_private_builtin_module, PredName),
@@ -1030,8 +1029,7 @@
get_typeclass_info_args_2(_, _, _, _, _, [], _, [], [], !ProcInfo).
get_typeclass_info_args_2(TypeClassInfoVar, PredId, ProcId, SymName,
- MakeResultType, [Arg | Args], Index,
- [IndexGoal, CallGoal | Goals],
+ MakeResultType, [Arg | Args], Index, [IndexGoal, CallGoal | Goals],
[ResultVar | Vars], !ProcInfo) :-
MakeResultType(Arg, ResultType),
proc_info_create_var_from_type(ResultType, no, ResultVar, !ProcInfo),
@@ -1892,8 +1890,7 @@
;
Manipulator = superclass_from_typeclass_info,
list.length(Constraints, NumConstraints),
- % polymorphism.m adds the number of
- % type_infos to the index.
+ % Polymorphism.m adds the number of type_infos to the index.
Index = Index0 + NumConstraints
;
Manipulator = instance_constraint_from_typeclass_info,
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.179
diff -u -b -r1.179 hlds_pred.m
--- compiler/hlds_pred.m 16 Sep 2005 05:42:51 -0000 1.179
+++ compiler/hlds_pred.m 17 Sep 2005 16:50:44 -0000
@@ -525,8 +525,8 @@
map__set(Map0, Constraint, ProgVar, Map),
!:VarMaps = !.VarMaps ^ tci_varmap := Map
;
- unexpected(this_file, "rtti_reuse_typeclass_info_var: "
- ++ "variable not known")
+ unexpected(this_file,
+ "rtti_reuse_typeclass_info_var: variable not known")
).
rtti_det_insert_type_info_type(ProgVar, Type, !VarMaps) :-
@@ -3406,12 +3406,22 @@
no_type_info_builtin_2(private_builtin, "store_at_ref", 2).
no_type_info_builtin_2(private_builtin, "unsafe_type_cast", 2).
no_type_info_builtin_2(builtin, "unsafe_promise_unique", 2).
-no_type_info_builtin_2(private_builtin, "superclass_from_typeclass_info", 3).
+no_type_info_builtin_2(private_builtin,
+ "superclass_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin,
"instance_constraint_from_typeclass_info", 3).
-no_type_info_builtin_2(private_builtin, "type_info_from_typeclass_info", 3).
+no_type_info_builtin_2(private_builtin,
+ "type_info_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin,
"unconstrained_type_info_from_typeclass_info", 3).
+no_type_info_builtin_2(private_builtin,
+ "zero_superclass_from_typeclass_info", 3).
+no_type_info_builtin_2(private_builtin,
+ "zero_instance_constraint_from_typeclass_info", 3).
+no_type_info_builtin_2(private_builtin,
+ "zero_type_info_from_typeclass_info", 3).
+no_type_info_builtin_2(private_builtin,
+ "zero_unconstrained_type_info_from_typeclass_info", 3).
no_type_info_builtin_2(table_builtin, "table_restore_any_answer", 3).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_enum", 4).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_typeinfo", 3).
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.93
diff -u -b -r1.93 ml_code_util.m
--- compiler/ml_code_util.m 13 Sep 2005 01:19:56 -0000 1.93
+++ compiler/ml_code_util.m 17 Sep 2005 16:03:50 -0000
@@ -2003,6 +2003,10 @@
; Name = "type_ctor_info", RealType = c_pointer_type
; Name = "typeclass_info", RealType = sample_typeclass_info_type
; Name = "base_typeclass_info", RealType = c_pointer_type
+ ; Name = "zero_type_info", RealType = sample_type_info_type
+ ; Name = "zero_type_ctor_info", RealType = c_pointer_type
+ ; Name = "zero_typeclass_info", RealType = sample_typeclass_info_type
+ ; Name = "zero_base_typeclass_info", RealType = c_pointer_type
).
% Generate code to call to `private_builtin__gc_trace'
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.36
diff -u -b -r1.36 ml_util.m
--- compiler/ml_util.m 13 Sep 2005 01:19:57 -0000 1.36
+++ compiler/ml_util.m 17 Sep 2005 16:05:37 -0000
@@ -626,6 +626,10 @@
; TypeName = qualified(PrivateBuiltin, "type_ctor_info")
; TypeName = qualified(PrivateBuiltin, "typeclass_info")
; TypeName = qualified(PrivateBuiltin, "type_info")
+ ; TypeName = qualified(PrivateBuiltin, "zero_base_typeclass_info")
+ ; TypeName = qualified(PrivateBuiltin, "zero_type_ctor_info")
+ ; TypeName = qualified(PrivateBuiltin, "zero_typeclass_info")
+ ; TypeName = qualified(PrivateBuiltin, "zero_type_info")
% Use lowlevel types for all types in rtti_implementation
% as this allows as to add new types needed to manipulate
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.274
diff -u -b -r1.274 polymorphism.m
--- compiler/polymorphism.m 13 Sep 2005 04:56:10 -0000 1.274
+++ compiler/polymorphism.m 18 Sep 2005 08:54:56 -0000
@@ -850,12 +850,14 @@
UnconstrainedTVars2),
list__remove_dups(UnconstrainedTVars2, UnconstrainedTVars),
- ( ExistQVars = [] ->
+ (
+ ExistQVars = [],
% optimize common case
UnconstrainedUnivTVars = UnconstrainedTVars,
UnconstrainedExistTVars = [],
ExistHeadTypeInfoVars = []
;
+ ExistQVars = [_ | _],
list__delete_elems(UnconstrainedTVars, ExistQVars,
UnconstrainedUnivTVars),
list__delete_elems(UnconstrainedTVars, UnconstrainedUnivTVars,
@@ -2389,12 +2391,9 @@
% We extract the superclass typeclass_info by inserting a call
% to superclass_from_typeclass_info in private_builtin.
- % Note that superclass_from_typeclass_info does not need
- % extra type_info arguments even though its declaration
- % is polymorphic.
goal_util__generate_simple_call(mercury_private_builtin_module,
- "superclass_from_typeclass_info", predicate, only_mode, det,
- [SubClassVar, IndexVar, Var], [], [], ModuleInfo,
+ "zero_superclass_from_typeclass_info", predicate, only_mode,
+ det, [SubClassVar, IndexVar, Var], [], [], ModuleInfo,
term__context_init, SuperClassGoal),
!:ExtraGoals = [SuperClassGoal, IndexGoal | !.ExtraGoals].
@@ -2800,8 +2799,7 @@
% a type_info, we need to adjust its type.
% Since type_ctor_info_const cons_ids are handled
% specially, this should not cause problems.
- polymorphism__build_type_info_type_2(type_info,
- TypeInfoType),
+ TypeInfoType = type_info_type,
map__det_update(!.VarTypes, TypeCtorVar, TypeInfoType,
!:VarTypes),
Var = TypeCtorVar,
@@ -3011,8 +3009,7 @@
),
string__append(Prefix, VarNumStr, Name),
varset__name_var(!.VarSet, Var, Name, !:VarSet),
- polymorphism__build_type_info_type_2(Kind, TypeInfoType),
- map__set(!.VarTypes, Var, TypeInfoType, !:VarTypes).
+ map__set(!.VarTypes, Var, type_info_type, !:VarTypes).
:- func typeinfo_prefix = string.
@@ -3071,8 +3068,8 @@
polymorphism__new_type_info_var_raw(Type, type_info, TypeInfoVar,
!VarSet, !VarTypes, !RttiVarMaps),
goal_util__generate_simple_call(mercury_private_builtin_module,
- "type_info_from_typeclass_info", predicate, only_mode, det,
- [TypeClassInfoVar, IndexVar, TypeInfoVar], [],
+ "zero_type_info_from_typeclass_info", predicate, only_mode,
+ det, [TypeClassInfoVar, IndexVar, TypeInfoVar], [],
[TypeInfoVar - ground(shared, none)], ModuleInfo,
term__context_init, CallGoal),
Goals = [IndexGoal, CallGoal].
@@ -3203,24 +3200,36 @@
% Note: we no longer store meaningful information in the argument
% of typeclass_info/1.
PrivateBuiltin = mercury_private_builtin_module,
- TypeclassInfoTypeName = qualified(PrivateBuiltin, "typeclass_info"),
- DictionaryType = defined(TypeclassInfoTypeName, [void_type], star).
+ TypeclassInfoTypeName =
+ qualified(PrivateBuiltin, "zero_typeclass_info"),
+ DictionaryType = defined(TypeclassInfoTypeName, [], star).
%---------------------------------------------------------------------------%
polymorphism__type_is_typeclass_info(TypeClassInfoType) :-
PrivateBuiltin = mercury_private_builtin_module,
+ (
type_to_ctor_and_args(TypeClassInfoType,
qualified(PrivateBuiltin, "typeclass_info") - 1,
- [_ConstraintTerm]).
+ [_ConstraintTerm])
+ ;
+ type_to_ctor_and_args(TypeClassInfoType,
+ qualified(PrivateBuiltin, "zero_typeclass_info") - 0,
+ [])
+ ).
polymorphism__type_is_type_info_or_ctor_type(TypeInfoType) :-
type_to_ctor_and_args(TypeInfoType,
- qualified(mercury_private_builtin_module, TypeName) - 1,
- [_Type]),
- ( TypeName = "type_info" ; TypeName = "type_ctor_info" ).
+ qualified(mercury_private_builtin_module, TypeName) - Arity,
+ Args),
+ ( TypeName = "type_info", Args = [_], Arity = 1
+ ; TypeName = "type_ctor_info", Args = [_], Arity = 1
+ ; TypeName = "zero_type_info", Args = [], Arity = 0
+ ; TypeName = "zero_type_ctor_info", Args = [], Arity = 0
+ ).
polymorphism__build_type_info_type(Type, TypeInfoType) :-
+ % XXX TypeInfoType = type_ctor_info_type.
( type_has_variable_arity_ctor(Type, _, _) ->
% We cannot use a plain type_ctor_info because we need to
% record the arity.
@@ -3264,10 +3273,19 @@
PredName = "type_info_from_typeclass_info",
TypeClassManipulator = type_info_from_typeclass_info
;
+ PredName = "zero_type_info_from_typeclass_info",
+ TypeClassManipulator = type_info_from_typeclass_info
+ ;
PredName = "superclass_from_typeclass_info",
TypeClassManipulator = superclass_from_typeclass_info
;
+ PredName = "zero_superclass_from_typeclass_info",
+ TypeClassManipulator = superclass_from_typeclass_info
+ ;
PredName = "instance_constraint_from_typeclass_info",
+ TypeClassManipulator = instance_constraint_from_typeclass_info
+ ;
+ PredName = "zero_instance_constraint_from_typeclass_info",
TypeClassManipulator = instance_constraint_from_typeclass_info
).
Index: compiler/pseudo_type_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/pseudo_type_info.m,v
retrieving revision 1.17
diff -u -b -r1.17 pseudo_type_info.m
--- compiler/pseudo_type_info.m 12 Sep 2005 05:24:23 -0000 1.17
+++ compiler/pseudo_type_info.m 18 Sep 2005 06:10:46 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1996-2000,2002-2003, 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -20,11 +22,11 @@
:- import_module backend_libs__rtti.
:- import_module parse_tree__prog_data.
- % pseudo_type_info__construct_pseudo_type_info(Type,
- % NumUnivQTvars, ExistQVars, PseudoTypeInfo)
+ % construct_pseudo_type_info(Type, NumUnivQTvars, ExistQVars,
+ % PseudoTypeInfo):
%
- % Given a Mercury type (`Type'), this predicate returns a
- % representation of the pseudo type info for that type.
+ % 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
% variables of the enclosing type (so that all universally quantified
@@ -32,28 +34,27 @@
% or is the special value -1, meaning that all variables in the type
% are universally quantified. ExistQVars is the list of existentially
% quantified type variables of the constructor in question.
+ %
+:- pred construct_pseudo_type_info((type)::in, int::in, existq_tvars::in,
+ rtti_pseudo_type_info::out) is det.
-:- pred pseudo_type_info__construct_pseudo_type_info((type)::in,
- int::in, existq_tvars::in, rtti_pseudo_type_info::out) is det.
-
- % pseudo_type_info__construct_type_info(Type, TypeInfo)
+ % construct_type_info(Type, TypeInfo):
%
% Given a ground Mercury type (`Type'), this predicate returns a
% representation of the type info for that type.
+ %
+:- pred construct_type_info((type)::in, rtti_type_info::out) is det.
-:- pred pseudo_type_info__construct_type_info((type)::in, rtti_type_info::out)
- is det.
-
- % pseudo_type_info__construct_maybe_pseudo_type_info(Type,
- % NumUnivQTvars, ExistQVars, MaybePseudoTypeInfo)
+ % construct_maybe_pseudo_type_info(Type, NumUnivQTvars, ExistQVars,
+ % MaybePseudoTypeInfo):
%
% Given a Mercury type (`Type'), this predicate checks whether it is
% ground or not. If it is ground, it returns a typeinfo for it; if it
% is not ground, it returns a pseudo type info for it. The arguments
- % are the same as for pseudo_type_info__construct_pseudo_type_info.
-
-:- pred pseudo_type_info__construct_maybe_pseudo_type_info((type)::in,
- int::in, existq_tvars::in, rtti_maybe_pseudo_type_info::out) is det.
+ % are the same as for construct_pseudo_type_info.
+ %
+:- pred construct_maybe_pseudo_type_info((type)::in, int::in, existq_tvars::in,
+ rtti_maybe_pseudo_type_info::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -62,6 +63,7 @@
:- import_module check_hlds__type_util.
:- import_module mdbcomp__prim_data.
+:- import_module parse_tree__error_util.
:- import_module parse_tree__prog_util.
:- import_module parse_tree__prog_type.
@@ -73,49 +75,44 @@
%---------------------------------------------------------------------------%
-pseudo_type_info__construct_maybe_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, MaybePseudoTypeInfo) :-
+construct_maybe_pseudo_type_info(Type, NumUnivQTvars, ExistQTvars,
+ MaybePseudoTypeInfo) :-
( type_is_ground(Type) ->
- pseudo_type_info__construct_type_info(Type, TypeInfo),
+ construct_type_info(Type, TypeInfo),
MaybePseudoTypeInfo = plain(TypeInfo)
;
- pseudo_type_info__construct_pseudo_type_info(Type,
- NumUnivQTvars, ExistQTvars, PseudoTypeInfo),
+ construct_pseudo_type_info(Type, NumUnivQTvars, ExistQTvars,
+ PseudoTypeInfo),
MaybePseudoTypeInfo = pseudo(PseudoTypeInfo)
).
-pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
- ExistQTvars, PseudoTypeInfo) :-
- ( type_to_ctor_and_args(Type, TypeCtor, TypeArgs0) ->
- canonicalize_type_args(TypeCtor, TypeArgs0, TypeArgs),
+construct_pseudo_type_info(Type, NumUnivQTvars, ExistQTvars, PseudoTypeInfo) :-
+ ( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) ->
( type_is_var_arity(Type, VarArityId) ->
TypeCtor = _QualTypeName - RealArity,
- pseudo_type_info__generate_pseudo_args(TypeArgs,
- NumUnivQTvars, ExistQTvars, PseudoArgs),
- require(check_var_arity(VarArityId, PseudoArgs,
- RealArity),
- "construct_pseudo_type_info: arity mismatch"),
- PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId,
- PseudoArgs)
+ generate_pseudo_args(TypeArgs, NumUnivQTvars, ExistQTvars,
+ PseudoArgs),
+ require(check_var_arity(VarArityId, PseudoArgs, RealArity),
+ "construct_pseudo_type_info: var arity mismatch"),
+ PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, PseudoArgs)
;
TypeCtor = QualTypeName - Arity,
unqualify_name(QualTypeName, TypeName),
- sym_name_get_module_name(QualTypeName,
- unqualified("builtin"), TypeModule),
- RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName,
- Arity),
- pseudo_type_info__generate_pseudo_args(TypeArgs,
- NumUnivQTvars, ExistQTvars, PseudoArgs),
+ sym_name_get_module_name(QualTypeName, unqualified("builtin"),
+ TypeModule),
+ RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName, Arity),
+ generate_pseudo_args(TypeArgs, NumUnivQTvars, ExistQTvars,
+ PseudoArgs),
require(check_arity(PseudoArgs, Arity),
"construct_pseudo_type_info: arity mismatch"),
- ( PseudoArgs = [] ->
+ (
+ PseudoArgs = [],
PseudoTypeInfo =
- plain_arity_zero_pseudo_type_info(
- RttiTypeCtor)
+ plain_arity_zero_pseudo_type_info(RttiTypeCtor)
;
+ PseudoArgs = [_ | _],
PseudoTypeInfo =
- plain_pseudo_type_info(RttiTypeCtor,
- PseudoArgs)
+ plain_pseudo_type_info(RttiTypeCtor, PseudoArgs)
)
)
; Type = variable(Var, _) ->
@@ -141,56 +138,48 @@
VarInt = VarInt0
;
% This is an existentially quantified variable.
- (
- list__nth_member_search(ExistQTvars,
- Var, ExistNum0)
- ->
- VarInt = ExistNum0 +
- pseudo_type_info__pseudo_typeinfo_exist_var_base
+ ( list__nth_member_search(ExistQTvars, Var, ExistNum0) ->
+ VarInt = ExistNum0 + pseudo_typeinfo_exist_var_base
;
- error("construct_pseudo_type_info: not in list")
+ unexpected(this_file,
+ "construct_pseudo_type_info: not in list")
)
),
- require(VarInt =< pseudo_type_info__pseudo_typeinfo_max_var,
+ require(VarInt =< pseudo_typeinfo_max_var,
"construct_pseudo_type_info: type var exceeds limit"),
PseudoTypeInfo = type_var(VarInt)
;
- error("construct_pseudo_type_info: neither var nor non-var")
+ unexpected(this_file,
+ "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),
+construct_type_info(Type, TypeInfo) :-
+ ( type_to_ctor_and_args(Type, TypeCtor, 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),
+ generate_plain_args(TypeArgs, TypeInfoArgs),
+ require(check_var_arity(VarArityId, TypeInfoArgs, RealArity),
"construct_type_info: arity mismatch"),
- TypeInfo = var_arity_type_info(VarArityId,
- TypeInfoArgs)
+ TypeInfo = var_arity_type_info(VarArityId, TypeInfoArgs)
;
TypeCtor = QualTypeName - Arity,
unqualify_name(QualTypeName, TypeName),
- sym_name_get_module_name(QualTypeName,
- unqualified("builtin"), TypeModule),
- RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName,
- Arity),
- pseudo_type_info__generate_plain_args(TypeArgs,
- TypeInfoArgs),
+ sym_name_get_module_name(QualTypeName, unqualified("builtin"),
+ TypeModule),
+ RttiTypeCtor = rtti_type_ctor(TypeModule, TypeName, Arity),
+ generate_plain_args(TypeArgs, TypeInfoArgs),
require(check_arity(TypeInfoArgs, Arity),
"construct_type_info: arity mismatch"),
- ( TypeInfoArgs = [] ->
- TypeInfo = plain_arity_zero_type_info(
- RttiTypeCtor)
+ (
+ TypeInfoArgs = [],
+ TypeInfo = plain_arity_zero_type_info(RttiTypeCtor)
;
- TypeInfo = plain_type_info(RttiTypeCtor,
- TypeInfoArgs)
+ TypeInfoArgs = [_ | _],
+ TypeInfo = plain_type_info(RttiTypeCtor, TypeInfoArgs)
)
)
;
- error("construct_type_info: type is var")
+ unexpected(this_file, "construct_type_info: type is var")
).
:- pred check_var_arity(var_arity_ctor_id::in, list(T)::in, int::in)
@@ -210,49 +199,43 @@
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.
+:- pred 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),
+generate_pseudo_args(TypeArgs, NumUnivQTvars, ExistQTvars, PseudoArgs) :-
+ list__map(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.
+:- pred 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) :-
+generate_pseudo_arg(NumUnivQTvars, ExistQTvars, TypeArg, MaybePseudoArg) :-
( type_is_ground(TypeArg) ->
- pseudo_type_info__construct_type_info(TypeArg, PseudoArg),
+ construct_type_info(TypeArg, PseudoArg),
MaybePseudoArg = plain(PseudoArg)
;
- pseudo_type_info__construct_pseudo_type_info(TypeArg,
- NumUnivQTvars, ExistQTvars, PseudoArg),
+ construct_pseudo_type_info(TypeArg, NumUnivQTvars, ExistQTvars,
+ PseudoArg),
MaybePseudoArg = pseudo(PseudoArg)
).
-:- pred pseudo_type_info__generate_plain_args(list(type)::in,
- list(rtti_type_info)::out) is det.
+:- pred generate_plain_args(list(type)::in, list(rtti_type_info)::out) is det.
-pseudo_type_info__generate_plain_args(TypeArgs,
- PseudoArgs) :-
- list__map(pseudo_type_info__construct_type_info, TypeArgs, PseudoArgs).
+generate_plain_args(TypeArgs, PseudoArgs) :-
+ list__map(construct_type_info, TypeArgs, PseudoArgs).
%---------------------------------------------------------------------------%
- % 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.
+ % 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.
+ % All variable arity type constructors are builtins. At the moment,
+ % we have three: pred, func, and tuple.
% XXX FIXME we should also encode purity in the RTTI!
-
+ %
:- pred type_is_var_arity((type)::in, var_arity_ctor_id::out) is semidet.
type_is_var_arity(Type, VarArityCtorId) :-
@@ -275,16 +258,23 @@
% This number corresponds to MR_PSEUDOTYPEINFO_MAX_VAR in
% runtime/mercury_type_info.h, and must be kept in sync with it.
% The documentation is located there as well.
+ %
+:- func pseudo_typeinfo_max_var = int.
-:- func pseudo_type_info__pseudo_typeinfo_max_var = int.
-
-pseudo_type_info__pseudo_typeinfo_max_var = 1024.
+pseudo_typeinfo_max_var = 1024.
% This number corresponds to MR_PSEUDOTYPEINFO_EXIST_VAR_BASE in
% runtime/mercury_type_info.h, and must be kept in sync with it.
% The documentation is located there as well.
-:- func pseudo_type_info__pseudo_typeinfo_exist_var_base = int.
+ %
+:- func pseudo_typeinfo_exist_var_base = int.
+
+pseudo_typeinfo_exist_var_base = 512.
+
+%---------------------------------------------------------------------------%
+
+:- func this_file = string.
-pseudo_type_info__pseudo_typeinfo_exist_var_base = 512.
+this_file = "pseudo_type_info.m".
%---------------------------------------------------------------------------%
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.22
diff -u -b -r1.22 size_prof.m
--- compiler/size_prof.m 13 Sep 2005 04:56:11 -0000 1.22
+++ compiler/size_prof.m 18 Sep 2005 06:11:02 -0000
@@ -845,8 +845,7 @@
; type_has_variable_arity_ctor(Type, TypeCtor, ArgTypes) ->
construct_type_info(Context, Type, TypeCtor, ArgTypes, yes,
TypeInfoVar, TypeInfoGoals, !Info)
- ; type_to_ctor_and_args(Type, TypeCtor, ArgTypes0) ->
- canonicalize_type_args(TypeCtor, ArgTypes0, ArgTypes),
+ ; type_to_ctor_and_args(Type, TypeCtor, ArgTypes) ->
(
ArgTypes = [],
make_type_ctor_info(TypeCtor, [], TypeCtorVar, TypeCtorGoals,
@@ -874,31 +873,28 @@
VarTypes1 = VarTypes0
;
RttiVarMaps0 = !.Info ^ rtti_varmaps,
- polymorphism__new_type_info_var_raw(Type,
- type_info, TypeInfoVar,
- VarSet0, VarSet1, VarTypes0, VarTypes1,
+ polymorphism__new_type_info_var_raw(Type, type_info,
+ TypeInfoVar, VarSet0, VarSet1, VarTypes0, VarTypes1,
RttiVarMaps0, RttiVarMaps),
!:Info = !.Info ^ rtti_varmaps := RttiVarMaps
),
- make_int_const_construction(Slot,
- yes("TypeClassInfoSlot"), SlotGoal, SlotVar,
- VarTypes1, VarTypes, VarSet1, VarSet),
+ make_int_const_construction(Slot, yes("TypeClassInfoSlot"),
+ SlotGoal, SlotVar, VarTypes1, VarTypes, VarSet1, VarSet),
!:Info = !.Info ^ varset := VarSet,
!:Info = !.Info ^ vartypes := VarTypes,
PrivateBuiltin = mercury_private_builtin_module,
goal_util__generate_simple_call(PrivateBuiltin,
- "type_info_from_typeclass_info", predicate,
- only_mode, det,
- [TypeClassInfoVar, SlotVar, TypeInfoVar], [],
+ "zero_type_info_from_typeclass_info", predicate, only_mode,
+ det, [TypeClassInfoVar, SlotVar, TypeInfoVar], [],
[TypeInfoVar - ground(shared, none)],
!.Info ^ module_info, Context, ExtractGoal),
record_type_info_var(Type, TypeInfoVar, !Info),
TypeInfoGoals = [SlotGoal, ExtractGoal]
)
;
- % type_to_ctor_and_args can fail only if Type is a type
- % variable, or acts like one. The tests in our callers should
- % have filtered out both cases.
+ % Type_to_ctor_and_args can fail only if Type is a type variable,
+ % or acts like one. The tests in our callers should have filtered
+ % out both cases.
unexpected(this_file, "size_prof__make_type_info: cannot happen")
).
@@ -1301,6 +1297,10 @@
; VarTypeCtorName = "type_ctor_info"
; VarTypeCtorName = "typeclass_info"
; VarTypeCtorName = "base_typeclass_info"
+ ; VarTypeCtorName = "zero_type_info"
+ ; VarTypeCtorName = "zero_type_ctor_info"
+ ; VarTypeCtorName = "zero_typeclass_info"
+ ; VarTypeCtorName = "zero_base_typeclass_info"
).
%---------------------------------------------------------------------------%
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.103
diff -u -b -r1.103 stack_layout.m
--- compiler/stack_layout.m 26 May 2005 00:17:03 -0000 1.103
+++ compiler/stack_layout.m 17 Sep 2005 13:26:31 -0000
@@ -1426,7 +1426,7 @@
% In this case, accessing the type_info requires indirection.
% The address of the typeclass_info is given as an lval, and
% the location of the typeinfo within the typeclass_info as an index;
- % private_builtin:type_info_from_typeclass_info interprets the index.
+ % private_builtin.type_info_from_typeclass_info interprets the index.
%
% This one level of indirection is sufficient, since type_infos
% cannot be nested inside typeclass_infos any deeper than this.
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.66
diff -u -b -r1.66 type_ctor_info.m
--- compiler/type_ctor_info.m 12 Sep 2005 05:24:26 -0000 1.66
+++ compiler/type_ctor_info.m 17 Sep 2005 16:26:25 -0000
@@ -96,7 +96,7 @@
%---------------------------------------------------------------------------%
-type_ctor_info__generate_hlds(!ModuleInfo) :-
+generate_hlds(!ModuleInfo) :-
module_info_name(!.ModuleInfo, ModuleName),
module_info_types(!.ModuleInfo, TypeTable),
map__keys(TypeTable, TypeCtors0),
@@ -108,22 +108,21 @@
;
TypeCtors = TypeCtors0
),
- type_ctor_info__gen_type_ctor_gen_infos(TypeCtors, TypeTable,
- ModuleName, !.ModuleInfo, TypeCtorGenInfos),
+ gen_type_ctor_gen_infos(TypeCtors, TypeTable, ModuleName, !.ModuleInfo,
+ TypeCtorGenInfos),
module_info_set_type_ctor_gen_infos(TypeCtorGenInfos, !ModuleInfo).
% Given a list of the ids of all the types in the type table, find the
% types defined in this module, and return a type_ctor_gen_info for each.
%
-:- pred type_ctor_info__gen_type_ctor_gen_infos(list(type_ctor)::in,
- type_table::in, module_name::in, module_info::in,
- list(type_ctor_gen_info)::out) is det.
-
-type_ctor_info__gen_type_ctor_gen_infos([], _, _, _, []).
-type_ctor_info__gen_type_ctor_gen_infos([TypeCtor | TypeCtors], TypeTable,
- ModuleName, ModuleInfo, TypeCtorGenInfos) :-
- type_ctor_info__gen_type_ctor_gen_infos(TypeCtors, TypeTable,
- ModuleName, ModuleInfo, TypeCtorGenInfos1),
+:- pred gen_type_ctor_gen_infos(list(type_ctor)::in, type_table::in,
+ module_name::in, module_info::in, list(type_ctor_gen_info)::out) is det.
+
+gen_type_ctor_gen_infos([], _, _, _, []).
+gen_type_ctor_gen_infos([TypeCtor | TypeCtors], TypeTable, ModuleName,
+ ModuleInfo, TypeCtorGenInfos) :-
+ gen_type_ctor_gen_infos(TypeCtors, TypeTable, ModuleName, ModuleInfo,
+ TypeCtorGenInfos1),
TypeCtor = SymName - TypeArity,
(
SymName = qualified(TypeModuleName, TypeName),
@@ -132,18 +131,16 @@
create_type_ctor_gen(ModuleInfo, TypeTable, TypeCtor,
TypeModuleName, TypeName, TypeArity, TypeDefn)
->
- type_ctor_info__gen_type_ctor_gen_info(TypeCtor,
- TypeName, TypeArity, TypeDefn,
+ gen_type_ctor_gen_info(TypeCtor, TypeName, TypeArity, TypeDefn,
ModuleName, ModuleInfo, TypeCtorGenInfo),
- TypeCtorGenInfos =
- [TypeCtorGenInfo | TypeCtorGenInfos1]
+ TypeCtorGenInfos = [TypeCtorGenInfo | TypeCtorGenInfos1]
;
TypeCtorGenInfos = TypeCtorGenInfos1
)
;
SymName = unqualified(TypeName),
Msg = "unqualified type " ++ TypeName ++ "found in type_ctor_info",
- error(Msg)
+ unexpected(this_file, Msg)
).
% Should we create a type_ctor_info for the given type constructor?
@@ -216,12 +213,12 @@
hlds_data__set_type_defn(TVarSet, Params, Kinds, Body, ImportStatus, no,
NeedQualifier, Context, TypeDefn).
-:- pred type_ctor_info__gen_type_ctor_gen_info(type_ctor::in, string::in,
- int::in, hlds_type_defn::in, module_name::in, module_info::in,
+:- pred gen_type_ctor_gen_info(type_ctor::in, string::in, int::in,
+ hlds_type_defn::in, module_name::in, module_info::in,
type_ctor_gen_info::out) is det.
-type_ctor_info__gen_type_ctor_gen_info(TypeCtor, TypeName, TypeArity, TypeDefn,
- ModuleName, ModuleInfo, TypeCtorGenInfo) :-
+gen_type_ctor_gen_info(TypeCtor, TypeName, TypeArity, TypeDefn, ModuleName,
+ ModuleInfo, TypeCtorGenInfo) :-
hlds_data__get_type_defn_status(TypeDefn, Status),
module_info_globals(ModuleInfo, Globals),
module_info_get_special_pred_map(ModuleInfo, SpecMap),
@@ -256,43 +253,38 @@
%---------------------------------------------------------------------------%
-type_ctor_info__generate_rtti(ModuleInfo, Tables) :-
+generate_rtti(ModuleInfo, Tables) :-
module_info_type_ctor_gen_infos(ModuleInfo, TypeCtorGenInfos),
- type_ctor_info__construct_type_ctor_infos(TypeCtorGenInfos,
- ModuleInfo, [], Dynamic, [], Static0),
+ construct_type_ctor_infos(TypeCtorGenInfos, ModuleInfo,
+ [], Dynamic, [], Static0),
% The same pseudo_type_info may be generated in several places; we need
% to eliminate duplicates here, to avoid duplicate definition errors
% in the generated C code.
Static = list__remove_dups(Static0),
list__append(Dynamic, Static, Tables).
-:- pred type_ctor_info__construct_type_ctor_infos(
- list(type_ctor_gen_info)::in, module_info::in,
+:- pred construct_type_ctor_infos(list(type_ctor_gen_info)::in,
+ module_info::in,
list(rtti_data)::in, list(rtti_data)::out,
list(rtti_data)::in, list(rtti_data)::out) is det.
-type_ctor_info__construct_type_ctor_infos([], _ModuleInfo, !Dynamic, !Static).
-type_ctor_info__construct_type_ctor_infos([TypeCtorGenInfo | TypeCtorGenInfos],
+construct_type_ctor_infos([], _ModuleInfo, !Dynamic, !Static).
+construct_type_ctor_infos([TypeCtorGenInfo | TypeCtorGenInfos],
ModuleInfo, !Dynamic, !Static) :-
- type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo, ModuleInfo,
- TypeCtorCModule),
+ construct_type_ctor_info(TypeCtorGenInfo, ModuleInfo, TypeCtorCModule),
!:Dynamic = [TypeCtorCModule | !.Dynamic],
- type_ctor_info__construct_type_ctor_infos(TypeCtorGenInfos, ModuleInfo,
- !Dynamic, !Static).
+ construct_type_ctor_infos(TypeCtorGenInfos, ModuleInfo, !Dynamic, !Static).
% Generate RTTI information for the given type.
%
-:- pred type_ctor_info__construct_type_ctor_info(type_ctor_gen_info::in,
- module_info::in, rtti_data::out) is det.
+:- pred construct_type_ctor_info(type_ctor_gen_info::in, module_info::in,
+ rtti_data::out) is det.
-type_ctor_info__construct_type_ctor_info(TypeCtorGenInfo, ModuleInfo,
- RttiData) :-
+construct_type_ctor_info(TypeCtorGenInfo, ModuleInfo, RttiData) :-
TypeCtorGenInfo = type_ctor_gen_info(_TypeCtor, ModuleName, TypeName,
TypeArity, _Status, HldsDefn, UnifyPredProcId, ComparePredProcId),
- type_ctor_info__make_rtti_proc_label(UnifyPredProcId, ModuleInfo,
- UnifyProcLabel),
- type_ctor_info__make_rtti_proc_label(ComparePredProcId, ModuleInfo,
- CompareProcLabel),
+ make_rtti_proc_label(UnifyPredProcId, ModuleInfo, UnifyProcLabel),
+ make_rtti_proc_label(ComparePredProcId, ModuleInfo, CompareProcLabel),
type_to_univ(UnifyProcLabel, UnifyUniv),
type_to_univ(CompareProcLabel, CompareUniv),
module_info_globals(ModuleInfo, Globals),
@@ -305,7 +297,7 @@
TypeBody = abstract_type(_),
\+ compiler_generated_rtti_for_builtins(ModuleInfo)
->
- error("type_ctor_info__gen_type_ctor_data: abstract_type")
+ unexpected(this_file, "gen_type_ctor_data: abstract_type")
;
true
),
@@ -326,13 +318,12 @@
;
(
TypeBody = abstract_type(_),
- error("type_ctor_info__gen_type_ctor_data: abstract_type")
+ unexpected(this_file, "gen_type_ctor_data: abstract_type")
;
% We treat solver_types as being equivalent to their representation
% types for RTTI purposes. Which may cause problems with construct,
% similar to those for abstract types.
- TypeBody = solver_type(SolverTypeDetails,
- _MaybeUserEqComp),
+ TypeBody = solver_type(SolverTypeDetails, _MaybeUserEqComp),
RepnType = SolverTypeDetails ^ representation_type,
% There can be no existentially typed args to an equivalence.
UnivTvars = TypeArity,
@@ -373,19 +364,19 @@
),
(
Enum = yes,
- type_ctor_info__make_enum_details(Ctors, ConsTagMap,
- ReservedTag, EqualityAxioms, Details)
+ make_enum_details(Ctors, ConsTagMap, ReservedTag,
+ EqualityAxioms, Details)
;
Enum = no,
(
type_constructors_should_be_no_tag(Ctors, ReservedTag,
Globals, Name, ArgType, MaybeArgName)
->
- type_ctor_info__make_notag_details(TypeArity, Name,
- ArgType, MaybeArgName, EqualityAxioms, Details)
+ make_notag_details(TypeArity, Name, ArgType, MaybeArgName,
+ EqualityAxioms, Details)
;
- type_ctor_info__make_du_details(Ctors, ConsTagMap,
- TypeArity, EqualityAxioms, ModuleInfo, Details)
+ make_du_details(Ctors, ConsTagMap, TypeArity,
+ EqualityAxioms, ModuleInfo, Details)
)
)
)
@@ -410,6 +401,10 @@
; TypeName = "type_ctor_info"
; TypeName = "typeclass_info"
; TypeName = "base_typeclass_info"
+ ; TypeName = "zero_type_info"
+ ; TypeName = "zero_type_ctor_info"
+ ; TypeName = "zero_typeclass_info"
+ ; TypeName = "zero_base_typeclass_info"
)
->
svset__insert(typeinfo_fake_arity_flag, !Flags)
@@ -447,6 +442,11 @@
impl_type_ctor("private_builtin", "typeclass_info", 1, typeclass_info).
impl_type_ctor("private_builtin", "base_typeclass_info", 1,
base_typeclass_info).
+impl_type_ctor("private_builtin", "zero_type_ctor_info", 0, type_ctor_info).
+impl_type_ctor("private_builtin", "zero_type_info", 0, type_info).
+impl_type_ctor("private_builtin", "zero_typeclass_info", 0, typeclass_info).
+impl_type_ctor("private_builtin", "zero_base_typeclass_info", 0,
+ base_typeclass_info).
impl_type_ctor("private_builtin", "heap_pointer", 0, hp).
impl_type_ctor("private_builtin", "succip", 0, succip).
impl_type_ctor("private_builtin", "curfr", 0, curfr).
@@ -456,10 +456,10 @@
impl_type_ctor("private_builtin", "ticket", 0, ticket).
impl_type_ctor("table_builtin", "ml_subgoal", 0, subgoal).
-:- pred type_ctor_info__make_rtti_proc_label(pred_proc_id::in, module_info::in,
+:- pred make_rtti_proc_label(pred_proc_id::in, module_info::in,
rtti_proc_label::out) is det.
-type_ctor_info__make_rtti_proc_label(PredProcId, ModuleInfo, ProcLabel) :-
+make_rtti_proc_label(PredProcId, ModuleInfo, ProcLabel) :-
PredProcId = proc(PredId, ProcId),
ProcLabel = rtti__make_rtti_proc_label(ModuleInfo, PredId, ProcId).
@@ -481,10 +481,10 @@
type_ctor_info_rtti_version = 9.
-% Construct an rtti_data for a pseudo_type_info,
-% and also construct rtti_data definitions for all of the pseudo_type_infos
-% that it references and prepend them to the given list of rtti_data tables.
-
+ % Construct an rtti_data for a pseudo_type_info, and also construct
+ % rtti_data definitions for all of the pseudo_type_infos that it references
+ % and prepend them to the given list of rtti_data tables.
+ %
:- pred make_pseudo_type_info_and_tables((type)::in, int::in, existq_tvars::in,
rtti_data::out, list(rtti_data)::in, list(rtti_data)::out) is det.
@@ -549,11 +549,11 @@
% Make the functor and layout tables for a notag type.
-:- pred type_ctor_info__make_notag_details(int::in, sym_name::in, (type)::in,
+:- pred make_notag_details(int::in, sym_name::in, (type)::in,
maybe(string)::in, equality_axioms::in, type_ctor_details::out) is det.
-type_ctor_info__make_notag_details(TypeArity, SymName, ArgType, MaybeArgName,
- EqualityAxioms, Details) :-
+make_notag_details(TypeArity, SymName, ArgType, MaybeArgName, EqualityAxioms,
+ Details) :-
unqualify_name(SymName, FunctorName),
NumUnivTvars = TypeArity,
% There can be no existentially typed args to the functor in a notag type.
@@ -569,22 +569,20 @@
% Make the functor and layout tables for an enum type.
%
-:- pred type_ctor_info__make_enum_details(list(constructor)::in,
- cons_tag_values::in, bool::in, equality_axioms::in,
- type_ctor_details::out) is det.
+:- pred make_enum_details(list(constructor)::in, cons_tag_values::in, bool::in,
+ equality_axioms::in, type_ctor_details::out) is det.
-type_ctor_info__make_enum_details(Ctors, ConsTagMap, ReserveTag,
- EqualityAxioms, Details) :-
+make_enum_details(Ctors, ConsTagMap, ReserveTag, EqualityAxioms, Details) :-
(
ReserveTag = yes,
- unexpected("type_ctor_info", "enum with reserved tag")
+ unexpected(this_file, "enum with reserved tag")
;
ReserveTag = no
),
- type_ctor_info__make_enum_functors(Ctors, 0, ConsTagMap, EnumFunctors),
+ make_enum_functors(Ctors, 0, ConsTagMap, EnumFunctors),
ValueMap0 = map__init,
NameMap0 = map__init,
- list__foldl2(type_ctor_info__make_enum_maps, EnumFunctors,
+ list__foldl2(make_enum_maps, EnumFunctors,
ValueMap0, ValueMap, NameMap0, NameMap),
Details = enum(EqualityAxioms, EnumFunctors, ValueMap, NameMap).
@@ -596,12 +594,12 @@
% sort this list on functor name, which is how the type functors structure
% is constructed.
%
-:- pred type_ctor_info__make_enum_functors(list(constructor)::in,
+:- pred make_enum_functors(list(constructor)::in,
int::in, cons_tag_values::in, list(enum_functor)::out) is det.
-type_ctor_info__make_enum_functors([], _, _, []).
-type_ctor_info__make_enum_functors([Functor | Functors], NextOrdinal0,
- ConsTagMap, [EnumFunctor | EnumFunctors]) :-
+make_enum_functors([], _, _, []).
+make_enum_functors([Functor | Functors], NextOrdinal0, ConsTagMap,
+ [EnumFunctor | EnumFunctors]) :-
Functor = ctor(ExistTvars, Constraints, SymName, FunctorArgs),
require(unify(ExistTvars, []), "existential arguments in functor in enum"),
require(unify(Constraints, []), "class constraints on functor in enum"),
@@ -613,14 +611,13 @@
"mismatch on constant assigned to functor in enum"),
unqualify_name(SymName, FunctorName),
EnumFunctor = enum_functor(FunctorName, NextOrdinal0),
- type_ctor_info__make_enum_functors(Functors, NextOrdinal0 + 1,
- ConsTagMap, EnumFunctors).
+ make_enum_functors(Functors, NextOrdinal0 + 1, ConsTagMap, EnumFunctors).
-:- pred type_ctor_info__make_enum_maps(enum_functor::in,
+:- pred make_enum_maps(enum_functor::in,
map(int, enum_functor)::in, map(int, enum_functor)::out,
map(string, enum_functor)::in, map(string, enum_functor)::out) is det.
-type_ctor_info__make_enum_maps(EnumFunctor, !ValueMap, !NameMap) :-
+make_enum_maps(EnumFunctor, !ValueMap, !NameMap) :-
EnumFunctor = enum_functor(FunctorName, Ordinal),
svmap__det_insert(Ordinal, EnumFunctor, !ValueMap),
svmap__det_insert(FunctorName, EnumFunctor, !NameMap).
@@ -647,27 +644,26 @@
% Make the functor and layout tables for a du type
% (including reserved_addr types).
%
-:- pred type_ctor_info__make_du_details(list(constructor)::in,
- cons_tag_values::in, int::in, equality_axioms::in, module_info::in,
- type_ctor_details::out) is det.
-
-type_ctor_info__make_du_details(Ctors, ConsTagMap, TypeArity, EqualityAxioms,
- ModuleInfo, Details) :-
- type_ctor_info__make_maybe_res_functors(Ctors, 0, ConsTagMap,
- TypeArity, ModuleInfo, MaybeResFunctors),
+:- pred make_du_details(list(constructor)::in, cons_tag_values::in, int::in,
+ equality_axioms::in, module_info::in, type_ctor_details::out) is det.
+
+make_du_details(Ctors, ConsTagMap, TypeArity, EqualityAxioms, ModuleInfo,
+ Details) :-
+ make_maybe_res_functors(Ctors, 0, ConsTagMap, TypeArity, ModuleInfo,
+ MaybeResFunctors),
DuFunctors = list__filter_map(is_du_functor, MaybeResFunctors),
ResFunctors = list__filter_map(is_reserved_functor, MaybeResFunctors),
- list__foldl(type_ctor_info__make_du_ptag_ordered_table, DuFunctors,
+ list__foldl(make_du_ptag_ordered_table, DuFunctors,
map__init, DuPtagTable),
(
ResFunctors = [],
- list__foldl(type_ctor_info__make_du_name_ordered_table,
- DuFunctors, map__init, DuNameOrderedMap),
+ list__foldl(make_du_name_ordered_table, DuFunctors,
+ map__init, DuNameOrderedMap),
Details = du(EqualityAxioms, DuFunctors, DuPtagTable, DuNameOrderedMap)
;
ResFunctors = [_ | _],
- list__foldl(type_ctor_info__make_res_name_ordered_table,
- MaybeResFunctors, map__init, ResNameOrderedMap),
+ list__foldl(make_res_name_ordered_table, MaybeResFunctors,
+ map__init, ResNameOrderedMap),
Details = reserved(EqualityAxioms, MaybeResFunctors,
ResFunctors, DuPtagTable, ResNameOrderedMap)
).
@@ -688,21 +684,20 @@
% TagMap groups the rttis into groups depending on their primary tags;
% this is how the type layout structure is constructed.
%
-:- pred type_ctor_info__make_maybe_res_functors(list(constructor)::in,
- int::in, cons_tag_values::in, int::in, module_info::in,
+:- pred make_maybe_res_functors(list(constructor)::in, int::in,
+ cons_tag_values::in, int::in, module_info::in,
list(maybe_reserved_functor)::out) is det.
-type_ctor_info__make_maybe_res_functors([], _, _, _, _, []).
-type_ctor_info__make_maybe_res_functors([Functor | Functors], NextOrdinal,
- ConsTagMap, TypeArity, ModuleInfo,
- [MaybeResFunctor | MaybeResFunctors]) :-
+make_maybe_res_functors([], _, _, _, _, []).
+make_maybe_res_functors([Functor | Functors], NextOrdinal, ConsTagMap,
+ TypeArity, ModuleInfo, [MaybeResFunctor | MaybeResFunctors]) :-
Functor = ctor(ExistTvars, Constraints, SymName, ConstructorArgs),
list__length(ConstructorArgs, Arity),
unqualify_name(SymName, FunctorName),
ConsId = make_cons_id_from_qualified_sym_name(SymName, ConstructorArgs),
map__lookup(ConsTagMap, ConsId, ConsTag),
- type_ctor_info__process_cons_tag(ConsTag, ConsRep),
- list__map(type_ctor_info__generate_du_arg_info(TypeArity, ExistTvars),
+ process_cons_tag(ConsTag, ConsRep),
+ list__map(generate_du_arg_info(TypeArity, ExistTvars),
ConstructorArgs, ArgInfos),
(
ExistTvars = [],
@@ -710,8 +705,7 @@
;
ExistTvars = [_ | _],
module_info_classes(ModuleInfo, ClassTable),
- type_ctor_info__generate_exist_into(ExistTvars, Constraints,
- ClassTable, ExistInfo),
+ generate_exist_into(ExistTvars, Constraints, ClassTable, ExistInfo),
MaybeExistInfo = yes(ExistInfo)
),
(
@@ -730,13 +724,12 @@
ResFunctor = reserved_functor(FunctorName, NextOrdinal, ResRep),
MaybeResFunctor = res_func(ResFunctor)
),
- type_ctor_info__make_maybe_res_functors(Functors, NextOrdinal + 1,
- ConsTagMap, TypeArity, ModuleInfo, MaybeResFunctors).
+ make_maybe_res_functors(Functors, NextOrdinal + 1, ConsTagMap, TypeArity,
+ ModuleInfo, MaybeResFunctors).
-:- pred type_ctor_info__process_cons_tag(cons_tag::in, maybe_reserved_rep::out)
- is det.
+:- pred process_cons_tag(cons_tag::in, maybe_reserved_rep::out) is det.
-type_ctor_info__process_cons_tag(ConsTag, ConsRep) :-
+process_cons_tag(ConsTag, ConsRep) :-
(
( ConsTag = single_functor, ConsPtag = 0
; ConsTag = unshared_tag(ConsPtag)
@@ -760,16 +753,15 @@
->
% Here we can just ignore the fact that this cons_tag is
% shared with reserved addresses.
- type_ctor_info__process_cons_tag(ThisTag, ConsRep)
+ process_cons_tag(ThisTag, ConsRep)
;
unexpected(this_file, "bad cons_tag for du function symbol")
).
-:- pred type_ctor_info__generate_du_arg_info(int::in, existq_tvars::in,
- constructor_arg::in, du_arg_info::out) is det.
+:- pred generate_du_arg_info(int::in, existq_tvars::in, constructor_arg::in,
+ du_arg_info::out) is det.
-type_ctor_info__generate_du_arg_info(NumUnivTvars, ExistTvars, ConstructorArg,
- ArgInfo) :-
+generate_du_arg_info(NumUnivTvars, ExistTvars, ConstructorArg, ArgInfo) :-
ConstructorArg = MaybeArgSymName - ArgType,
(
MaybeArgSymName = yes(SymName),
@@ -795,19 +787,18 @@
% This function gives the size of the MR_du_functor_arg_type_contains_var
% field of the C type MR_DuFunctorDesc in bits.
%
-:- func type_ctor_info__contains_var_bit_vector_size = int.
+:- func contains_var_bit_vector_size = int.
-type_ctor_info__contains_var_bit_vector_size = 16.
+contains_var_bit_vector_size = 16.
% Construct the RTTI structures that record information about the locations
% of the typeinfos describing the types of the existentially typed
% arguments of a functor.
%
-:- pred type_ctor_info__generate_exist_into(list(tvar)::in,
- list(prog_constraint)::in, class_table::in, exist_info::out) is det.
+:- pred generate_exist_into(list(tvar)::in, list(prog_constraint)::in,
+ class_table::in, exist_info::out) is det.
-type_ctor_info__generate_exist_into(ExistTvars, Constraints, ClassTable,
- ExistInfo) :-
+generate_exist_into(ExistTvars, Constraints, ClassTable, ExistInfo) :-
list__map((pred(C::in, Ts::out) is det :- C = constraint(_, Ts)),
Constraints, ConstrainedTvars0),
list__condense(ConstrainedTvars0, ConstrainedTvars1),
@@ -866,10 +857,10 @@
%---------------------------------------------------------------------------%
-:- pred type_ctor_info__make_du_ptag_ordered_table(du_functor::in,
- map(int, sectag_table)::in, map(int, sectag_table)::out) is det.
+:- pred make_du_ptag_ordered_table(du_functor::in, map(int, sectag_table)::in,
+ map(int, sectag_table)::out) is det.
-type_ctor_info__make_du_ptag_ordered_table(DuFunctor, !PtagTable) :-
+make_du_ptag_ordered_table(DuFunctor, !PtagTable) :-
DuRep = DuFunctor ^ du_rep,
(
DuRep = du_ll_rep(Ptag, SectagAndLocn),
@@ -900,14 +891,14 @@
)
;
DuRep = du_hl_rep(_),
- error("type_ctor_info__make_du_ptag_ordered_table: du_hl_rep")
+ unexpected(this_file, "make_du_ptag_ordered_table: du_hl_rep")
).
-:- pred type_ctor_info__make_du_name_ordered_table(du_functor::in,
+:- pred make_du_name_ordered_table(du_functor::in,
map(string, map(int, du_functor))::in,
map(string, map(int, du_functor))::out) is det.
-type_ctor_info__make_du_name_ordered_table(DuFunctor, !NameTable) :-
+make_du_name_ordered_table(DuFunctor, !NameTable) :-
Name = DuFunctor ^ du_name,
Arity = DuFunctor ^ du_orig_arity,
( map__search(!.NameTable, Name, NameMap0) ->
@@ -918,11 +909,11 @@
svmap__det_insert(Name, NameMap, !NameTable)
).
-:- pred type_ctor_info__make_res_name_ordered_table(maybe_reserved_functor::in,
+:- pred make_res_name_ordered_table(maybe_reserved_functor::in,
map(string, map(int, maybe_reserved_functor))::in,
map(string, map(int, maybe_reserved_functor))::out) is det.
-type_ctor_info__make_res_name_ordered_table(MaybeResFunctor, !NameTable) :-
+make_res_name_ordered_table(MaybeResFunctor, !NameTable) :-
(
MaybeResFunctor = du_func(DuFunctor),
Name = DuFunctor ^ du_name,
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.153
diff -u -b -r1.153 type_util.m
--- compiler/type_util.m 12 Sep 2005 05:24:26 -0000 1.153
+++ compiler/type_util.m 18 Sep 2005 05:33:39 -0000
@@ -183,9 +183,6 @@
; void_type
; user_ctor_type.
-:- pred canonicalize_type_args(type_ctor::in, list(type)::in, list(type)::out)
- is det.
-
% Construct builtin types.
:- func int_type = (type).
:- func string_type = (type).
@@ -491,8 +488,6 @@
:- func cell_inst_cons_id(polymorphism_cell, int) = cons_id.
-:- func cell_type_name(polymorphism_cell) = string.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -555,11 +550,15 @@
type_ctor_is_array(qualified(unqualified("array"), "array") - 1).
type_ctor_has_hand_defined_rtti(Type, Body) :-
- Type = qualified(mercury_private_builtin_module, Name) - 1,
- ( Name = "type_info"
- ; Name = "type_ctor_info"
- ; Name = "typeclass_info"
- ; Name = "base_typeclass_info"
+ Type = qualified(mercury_private_builtin_module, Name) - Arity,
+ ( Name = "type_info", Arity = 1
+ ; Name = "type_ctor_info", Arity = 1
+ ; Name = "typeclass_info", Arity = 1
+ ; Name = "base_typeclass_info", Arity = 1
+ ; Name = "zero_type_info", Arity = 0
+ ; Name = "zero_type_ctor_info", Arity = 0
+ ; Name = "zero_typeclass_info", Arity = 0
+ ; Name = "zero_base_typeclass_info", Arity = 0
),
\+ ( Body = du_type(_, _, _, _, _, yes(_))
; Body = foreign_type(_)
@@ -571,12 +570,16 @@
is_introduced_type_info_type_ctor(TypeCtor).
is_introduced_type_info_type_ctor(TypeCtor) :-
- TypeCtor = qualified(PrivateBuiltin, Name) - 1,
+ TypeCtor = qualified(PrivateBuiltin, Name) - Arity,
mercury_private_builtin_module(PrivateBuiltin),
- ( Name = "type_info"
- ; Name = "type_ctor_info"
- ; Name = "typeclass_info"
- ; Name = "base_typeclass_info"
+ ( Name = "type_info", Arity = 1
+ ; Name = "type_ctor_info", Arity = 1
+ ; Name = "typeclass_info", Arity = 1
+ ; Name = "base_typeclass_info", Arity = 1
+ ; Name = "zero_type_info", Arity = 0
+ ; Name = "zero_type_ctor_info", Arity = 0
+ ; Name = "zero_typeclass_info", Arity = 0
+ ; Name = "zero_base_typeclass_info", Arity = 0
).
is_introduced_type_info_type_category(int_type) = no.
@@ -637,6 +640,14 @@
TypeCategory = typeclass_info_type
; TypeCtor = qualified(PrivateBuiltin, "base_typeclass_info") - 1 ->
TypeCategory = base_typeclass_info_type
+ ; TypeCtor = qualified(PrivateBuiltin, "zero_type_info") - 0 ->
+ TypeCategory = type_info_type
+ ; TypeCtor = qualified(PrivateBuiltin, "zero_type_ctor_info") - 0 ->
+ TypeCategory = type_ctor_info_type
+ ; TypeCtor = qualified(PrivateBuiltin, "zero_typeclass_info") - 0 ->
+ TypeCategory = typeclass_info_type
+ ; TypeCtor = qualified(PrivateBuiltin, "zero_base_typeclass_info") - 0 ->
+ TypeCategory = base_typeclass_info_type
; type_ctor_is_higher_order(TypeCtor, _, _, _) ->
TypeCategory = higher_order_type
; type_ctor_is_tuple(TypeCtor) ->
@@ -813,22 +824,6 @@
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
TypeBody ^ du_type_is_enum = yes.
-canonicalize_type_args(TypeCtor, TypeArgs0, TypeArgs) :-
- (
- % The arguments of typeclass_info/base_typeclass_info types
- % are not a type - they encode class constraints.
- % The arguments of type_ctor_info types are not types;
- % they are type constructors.
- % The arguments of type_info types are not true arguments:
- % they specify the type the type_info represents.
- % So we replace all these arguments with type `void'.
- is_introduced_type_info_type_ctor(TypeCtor)
- ->
- TypeArgs = [void_type]
- ;
- TypeArgs = TypeArgs0
- ).
-
int_type = builtin(int).
string_type = builtin(string).
@@ -859,13 +854,13 @@
mercury_public_builtin_module(BuiltinModule),
Name = qualified(BuiltinModule, "comparison_result").
-type_info_type = defined(Name, [void_type], star) :-
+type_info_type = defined(Name, [], star) :-
mercury_private_builtin_module(BuiltinModule),
- Name = qualified(BuiltinModule, "type_info").
+ Name = qualified(BuiltinModule, "zero_type_info").
-type_ctor_info_type = defined(Name, [void_type], star) :-
+type_ctor_info_type = defined(Name, [], star) :-
mercury_private_builtin_module(BuiltinModule),
- Name = qualified(BuiltinModule, "type_ctor_info").
+ Name = qualified(BuiltinModule, "zero_type_ctor_info").
aditi_state_type = defined(Name, [], star) :-
aditi_public_builtin_module(BuiltinModule),
@@ -965,9 +960,10 @@
hlds_data__get_type_defn_tparams(TypeDefn, TypeParams),
% XXX handle ExistQVars
- ( ExistQVars0 = [] ->
- true
+ (
+ ExistQVars0 = []
;
+ ExistQVars0 = [_ | _],
(
EQVarAction = abort_on_exist_qvar,
error("get_cons_id_arg_types: " ++
@@ -1143,6 +1139,10 @@
name_is_type_info("type_ctor_info").
name_is_type_info("typeclass_info").
name_is_type_info("base_typeclass_info").
+name_is_type_info("zero_type_info").
+name_is_type_info("zero_type_ctor_info").
+name_is_type_info("zero_typeclass_info").
+name_is_type_info("zero_base_typeclass_info").
% If the sym_name is in the private_builtin module, unqualify it,
% otherwise fail.
@@ -1887,9 +1887,6 @@
),
PrivateBuiltin = mercury_private_builtin_module,
InstConsId = cons(qualified(PrivateBuiltin, Symbol), Arity).
-
-cell_type_name(type_info_cell(_)) = "type_info".
-cell_type_name(typeclass_info_cell) = "typeclass_info".
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
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/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
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/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/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/solver_types
cvs diff: Diffing extras/solver_types/library
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 extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.142
diff -u -b -r1.142 private_builtin.m
--- library/private_builtin.m 16 Sep 2005 14:49:26 -0000 1.142
+++ library/private_builtin.m 19 Sep 2005 04:46:48 -0000
@@ -281,8 +281,7 @@
% The actual arities of these two function symbols are variable;
% they depend on the number of type parameters of the type represented
- % by the type_info, and how many predicates we associate with each
- % type.
+ % by the type_info, and how many predicates we associate with each type.
%
% Note that, since these types look to the compiler as though they
% are candidates to become no_tag types, special code is required
@@ -291,6 +290,9 @@
:- type type_info(T) ---> type_info(type_ctor_info(T) /*, ... */).
:- type type_ctor_info(T) ---> type_ctor_info(int /*, ... */).
+:- type zero_type_info.
+:- type zero_type_ctor_info.
+
% The type variable in these types isn't really a type variable,
% it is a place for polymorphism.m to put a representation of the
% class constraint about which the typeclass_info carries information.
@@ -303,6 +305,9 @@
/*, ... */).
:- type base_typeclass_info(_) ---> typeclass_info(int /*, ... */).
+:- type zero_typeclass_info.
+:- type zero_base_typeclass_info.
+
% The following types are used by compiler/ml_code_util.m as the types
% used for copying type_info/1 and typeclass_info/1 types.
% XXX Document me better
@@ -320,6 +325,8 @@
%
:- pred type_info_from_typeclass_info(typeclass_info(_)::in, int::in,
type_info(T)::out) is det.
+:- pred zero_type_info_from_typeclass_info(zero_typeclass_info::in, int::in,
+ zero_type_info::out) is det.
% unconstrained_type_info_from_typeclass_info(TypeClassInfo,
% Index, TypeInfo):
@@ -329,6 +336,8 @@
%
:- pred unconstrained_type_info_from_typeclass_info(typeclass_info(_)::in,
int::in, type_info(_)::out) is det.
+:- pred zero_unconstrained_type_info_from_typeclass_info(
+ zero_typeclass_info::in, int::in, zero_type_info::out) is det.
% superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass):
%
@@ -337,6 +346,8 @@
%
:- pred superclass_from_typeclass_info(typeclass_info(_)::in,
int::in, typeclass_info(_)::out) is det.
+:- pred zero_superclass_from_typeclass_info(zero_typeclass_info::in,
+ int::in, zero_typeclass_info::out) is det.
% instance_constraint_from_typeclass_info(TypeClassInfo, Index,
% InstanceConstraintTypeClassInfo):
@@ -349,6 +360,8 @@
%
:- pred instance_constraint_from_typeclass_info(typeclass_info(_)::in,
int::in, typeclass_info(_)::out) is det.
+:- pred zero_instance_constraint_from_typeclass_info(zero_typeclass_info::in,
+ int::in, zero_typeclass_info::out) is det.
% N.B. interface continued below.
@@ -566,6 +579,14 @@
").
:- pragma foreign_proc("C",
+ zero_type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
+ TypeInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeInfo = MR_typeclass_info_param_type_info(TypeClassInfo, Index);
+").
+
+:- pragma foreign_proc("C",
unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
Index::in, TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -574,6 +595,14 @@
").
:- pragma foreign_proc("C",
+ zero_unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
+ Index::in, TypeInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeInfo = MR_typeclass_info_instance_tvar_type_info(TypeClassInfo, Index);
+").
+
+:- pragma foreign_proc("C",
superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
TypeClassInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -583,6 +612,15 @@
").
:- pragma foreign_proc("C",
+ zero_superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
+ TypeClassInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeClassInfo =
+ MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
+").
+
+:- pragma foreign_proc("C",
instance_constraint_from_typeclass_info(TypeClassInfo0::in,
Index::in, TypeClassInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -591,6 +629,15 @@
MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
").
+:- pragma foreign_proc("C",
+ zero_instance_constraint_from_typeclass_info(TypeClassInfo0::in,
+ Index::in, TypeClassInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeClassInfo =
+ MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
+").
+
:- pragma foreign_proc("C#",
type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
TypeInfo::out),
@@ -1154,19 +1201,15 @@
const MR_TypeCtorInfo ML_type_ctor_info_for_univ =
&MR_TYPE_CTOR_INFO_NAME(std_util, univ, 0);
-const MR_FA_TypeInfo_Struct1 ML_type_info_for_type_info = {
- &MR_TYPE_CTOR_INFO_NAME(private_builtin, type_info, 1),
- { (MR_TypeInfo) &MR_TYPE_CTOR_INFO_NAME(builtin, void, 0) }
-};
+const MR_TypeCtorInfo ML_type_info_for_type_info =
+ &MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_info, 0);
-const MR_FA_TypeInfo_Struct1 ML_type_info_for_pseudo_type_info = {
+const MR_TypeCtorInfo ML_type_info_for_pseudo_type_info =
/*
** For the time being, we handle pseudo_type_infos the same way
** as we handle type_infos.
*/
- &MR_TYPE_CTOR_INFO_NAME(private_builtin, type_info, 1),
- { (MR_TypeInfo) &MR_TYPE_CTOR_INFO_NAME(builtin, void, 0) }
-};
+ &MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_info, 0);
const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_univ = {
&MR_TYPE_CTOR_INFO_NAME(list, list, 1),
@@ -1343,8 +1386,7 @@
"").
:- pragma foreign_proc(il,
semip,
- [will_not_call_mercury, thread_safe, promise_semipure,
- max_stack_size(0)],
+ [will_not_call_mercury, thread_safe, promise_semipure, max_stack_size(0)],
"").
:- pragma foreign_proc("Java",
semip,
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_builtin_types.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_builtin_types.c,v
retrieving revision 1.13
diff -u -b -r1.13 mercury_builtin_types.c
--- runtime/mercury_builtin_types.c 9 Jun 2005 08:43:09 -0000 1.13
+++ runtime/mercury_builtin_types.c 19 Sep 2005 00:29:46 -0000
@@ -82,6 +82,15 @@
MR_DEFINE_TYPE_CTOR_INFO_FLAG(private_builtin, typeclass_info, 1,
TYPECLASSINFO, MR_TYPE_CTOR_FLAG_TYPEINFO_FAKE_ARITY);
+MR_DEFINE_TYPE_CTOR_INFO(private_builtin, zero_type_ctor_info, 0,
+ TYPECTORINFO);
+MR_DEFINE_TYPE_CTOR_INFO(private_builtin, zero_type_info, 0,
+ TYPEINFO);
+MR_DEFINE_TYPE_CTOR_INFO(private_builtin, zero_base_typeclass_info, 0,
+ BASETYPECLASSINFO);
+MR_DEFINE_TYPE_CTOR_INFO(private_builtin, zero_typeclass_info, 0,
+ TYPECLASSINFO);
+
MR_DEFINE_TYPE_CTOR_INFO(type_desc, type_ctor_desc, 0, TYPECTORDESC);
MR_DEFINE_TYPE_CTOR_INFO(type_desc, pseudo_type_desc, 0, PSEUDOTYPEDESC);
MR_DEFINE_TYPE_CTOR_INFO(type_desc, type_desc, 0, TYPEDESC);
@@ -248,6 +257,39 @@
return MR_TRUE;
}
+MR_bool MR_CALL
+mercury__private_builtin____Unify____zero_type_ctor_info_0_0(
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y)
+{
+ return MR_unify_type_ctor_info((MR_TypeCtorInfo) x,
+ (MR_TypeCtorInfo) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____zero_type_info_0_0(
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
+{
+ return MR_unify_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____zero_typeclass_info_0_0(
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
+{
+ MR_fatal_error("called unify/2 for `typeclass_info' type");
+
+ return MR_TRUE;
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____zero_base_typeclass_info_0_0(
+ MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y)
+{
+ MR_SORRY("unify for base_typeclass_info");
+
+ return MR_TRUE;
+}
+
/*---------------------------------------------------------------------------*/
/*
@@ -405,6 +447,39 @@
MR_SORRY("compare for base_typeclass_info");
}
+void MR_CALL
+mercury__private_builtin____Compare____zero_type_ctor_info_0_0(
+ MR_Comparison_Result *result,
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y)
+{
+ *result = MR_compare_type_ctor_info((MR_TypeCtorInfo) x,
+ (MR_TypeCtorInfo) y);
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____zero_type_info_0_0(
+ MR_Comparison_Result *result,
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
+{
+ *result = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____zero_typeclass_info_0_0(
+ MR_Comparison_Result *result,
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
+{
+ MR_fatal_error("called compare/3 for `typeclass_info' type");
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____zero_base_typeclass_info_0_0(
+ MR_Comparison_Result *result,
+ MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y)
+{
+ MR_SORRY("compare for base_typeclass_info");
+}
+
/*---------------------------------------------------------------------------*/
/*
@@ -548,6 +623,39 @@
(MR_Mercury_Base_TypeClass_Info) y);
}
+MR_bool MR_CALL
+mercury__private_builtin__do_unify__zero_type_ctor_info_0_0(
+ MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____zero_type_ctor_info_0_0(
+ (MR_Mercury_Type_Ctor_Info) x, (MR_Mercury_Type_Ctor_Info) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin__do_unify__zero_type_info_0_0(
+ MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____zero_type_info_0_0(
+ (MR_Mercury_Type_Info) x, (MR_Mercury_Type_Info) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin__do_unify__zero_typeclass_info_0_0(
+ MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____zero_typeclass_info_0_0(
+ (MR_Mercury_TypeClass_Info) x, (MR_Mercury_TypeClass_Info) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin__do_unify__zero_base_typeclass_info_0_0(
+ MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____zero_base_typeclass_info_0_0(
+ (MR_Mercury_Base_TypeClass_Info) x,
+ (MR_Mercury_Base_TypeClass_Info) y);
+}
+
/*---------------------------------------------------------------------------*/
/*
@@ -704,6 +812,42 @@
(MR_Mercury_Base_TypeClass_Info) y);
}
+void MR_CALL
+mercury__private_builtin__do_compare__zero_type_ctor_info_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____zero_type_ctor_info_0_0(
+ result,
+ (MR_Mercury_Type_Ctor_Info) x, (MR_Mercury_Type_Ctor_Info) y);
+}
+
+void MR_CALL
+mercury__private_builtin__do_compare__zero_type_info_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____zero_type_info_0_0(
+ result, (MR_Mercury_Type_Info) x, (MR_Mercury_Type_Info) y);
+}
+
+void MR_CALL
+mercury__private_builtin__do_compare__zero_typeclass_info_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____zero_typeclass_info_0_0(
+ result,
+ (MR_Mercury_TypeClass_Info) x, (MR_Mercury_TypeClass_Info) y);
+}
+
+void MR_CALL
+mercury__private_builtin__do_compare__zero_base_typeclass_info_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____zero_base_typeclass_info_0_0(
+ result,
+ (MR_Mercury_Base_TypeClass_Info) x,
+ (MR_Mercury_Base_TypeClass_Info) y);
+}
+
#else /* ! MR_HIGHLEVEL_CODE */
MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc mercury_builtin_types;
@@ -778,6 +922,10 @@
MR_UNIFY_COMPARE_REP_DECLS(private_builtin, type_info, 1)
MR_UNIFY_COMPARE_REP_DECLS(private_builtin, base_typeclass_info, 1)
MR_UNIFY_COMPARE_REP_DECLS(private_builtin, typeclass_info, 1)
+MR_UNIFY_COMPARE_REP_DECLS(private_builtin, zero_type_ctor_info, 0)
+MR_UNIFY_COMPARE_REP_DECLS(private_builtin, zero_type_info, 0)
+MR_UNIFY_COMPARE_REP_DECLS(private_builtin, zero_base_typeclass_info, 0)
+MR_UNIFY_COMPARE_REP_DECLS(private_builtin, zero_typeclass_info, 0)
MR_UNIFY_COMPARE_REP_DECLS(type_desc, type_ctor_desc, 0);
MR_UNIFY_COMPARE_REP_DECLS(type_desc, pseudo_type_desc, 0);
MR_UNIFY_COMPARE_REP_DECLS(type_desc, type_desc, 0);
@@ -806,6 +954,10 @@
MR_UNIFY_COMPARE_REP_DEFNS(private_builtin, type_info, 1)
MR_UNIFY_COMPARE_REP_DEFNS(private_builtin, base_typeclass_info, 1)
MR_UNIFY_COMPARE_REP_DEFNS(private_builtin, typeclass_info, 1)
+MR_UNIFY_COMPARE_REP_DEFNS(private_builtin, zero_type_ctor_info, 0)
+MR_UNIFY_COMPARE_REP_DEFNS(private_builtin, zero_type_info, 0)
+MR_UNIFY_COMPARE_REP_DEFNS(private_builtin, zero_base_typeclass_info, 0)
+MR_UNIFY_COMPARE_REP_DEFNS(private_builtin, zero_typeclass_info, 0)
MR_UNIFY_COMPARE_REP_DEFNS(type_desc, type_ctor_desc, 0)
MR_UNIFY_COMPARE_REP_DEFNS(type_desc, pseudo_type_desc, 0)
MR_UNIFY_COMPARE_REP_DEFNS(type_desc, type_desc, 0)
@@ -881,6 +1033,10 @@
MR_DEFINE_PROC_STATIC_LAYOUTS(private_builtin, type_info, 1);
MR_DEFINE_PROC_STATIC_LAYOUTS(private_builtin, base_typeclass_info, 1);
MR_DEFINE_PROC_STATIC_LAYOUTS(private_builtin, typeclass_info, 1);
+MR_DEFINE_PROC_STATIC_LAYOUTS(private_builtin, zero_type_ctor_info, 0);
+MR_DEFINE_PROC_STATIC_LAYOUTS(private_builtin, zero_type_info, 0);
+MR_DEFINE_PROC_STATIC_LAYOUTS(private_builtin, zero_base_typeclass_info, 0);
+MR_DEFINE_PROC_STATIC_LAYOUTS(private_builtin, zero_typeclass_info, 0);
MR_DEFINE_PROC_STATIC_LAYOUTS(type_desc, type_ctor_desc, 0);
MR_DEFINE_PROC_STATIC_LAYOUTS(type_desc, pseudo_type_desc, 0);
MR_DEFINE_PROC_STATIC_LAYOUTS(type_desc, type_desc, 0);
@@ -912,6 +1068,10 @@
MR_UNIFY_COMPARE_REP_LABELS(private_builtin, type_info, 1)
MR_UNIFY_COMPARE_REP_LABELS(private_builtin, base_typeclass_info, 1)
MR_UNIFY_COMPARE_REP_LABELS(private_builtin, typeclass_info, 1)
+ MR_UNIFY_COMPARE_REP_LABELS(private_builtin, zero_type_ctor_info, 0)
+ MR_UNIFY_COMPARE_REP_LABELS(private_builtin, zero_type_info, 0)
+ MR_UNIFY_COMPARE_REP_LABELS(private_builtin, zero_base_typeclass_info, 0)
+ MR_UNIFY_COMPARE_REP_LABELS(private_builtin, zero_typeclass_info, 0)
MR_UNIFY_COMPARE_REP_LABELS(type_desc, type_ctor_desc, 0)
MR_UNIFY_COMPARE_REP_LABELS(type_desc, pseudo_type_desc, 0)
MR_UNIFY_COMPARE_REP_LABELS(type_desc, type_desc, 0)
@@ -1307,7 +1467,6 @@
#undef unify_code
#undef compare_code
-
/*****************************************************************************/
/*
@@ -1423,6 +1582,118 @@
/*****************************************************************************/
/*
+** Unify and compare of type_ctor_infos are usually handled by the generic
+** unify/2 and compare/3 predicates.
+*/
+
+#define module private_builtin
+#define type zero_type_ctor_info
+#define arity 0
+#define unify_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_ctor_info( \
+ (MR_TypeCtorInfo) MR_r1, \
+ (MR_TypeCtorInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = (comp == MR_COMPARE_EQUAL);
+#define compare_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_ctor_info( \
+ (MR_TypeCtorInfo) MR_r1, \
+ (MR_TypeCtorInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = comp;
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/*
+** Unify and compare of type_infos are usually handled by the generic
+** unify/2 and compare/3 predicates.
+*/
+
+#define module private_builtin
+#define type zero_type_info
+#define arity 0
+#define unify_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = (comp == MR_COMPARE_EQUAL);
+#define compare_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = comp;
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/*
+** Unify and compare of base_typeclass_infos are always handled by the generic
+** unify/2 and compare/3 predicates.
+*/
+
+#define module private_builtin
+#define type zero_base_typeclass_info
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `base_typeclass_info' type");
+#define compare_code MR_fatal_error("called compare/3 for `base_typeclass_info' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/*
+** Unify and compare of typeclass_infos are always handled by the generic
+** unify/2 and compare/3 predicates.
+*/
+
+#define module private_builtin
+#define type zero_typeclass_info
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `base_typeclass_info' type");
+#define compare_code MR_fatal_error("called compare/3 for `base_typeclass_info' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/*
** Unify and compare of type_ctor_descs are usually handled by the generic
** unify/2 and compare/3 predicates.
*/
@@ -1635,6 +1906,10 @@
MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, type_info, 1);
MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, base_typeclass_info, 1);
MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, typeclass_info, 1);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, zero_type_ctor_info, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, zero_type_info, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, zero_base_typeclass_info, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, zero_typeclass_info, 0);
MR_INIT_TYPE_CTOR_INFO_MNA(type_desc, type_ctor_desc, 0);
MR_INIT_TYPE_CTOR_INFO_MNA(type_desc, pseudo_type_desc, 0);
MR_INIT_TYPE_CTOR_INFO_MNA(type_desc, type_desc, 0);
@@ -1668,6 +1943,10 @@
MR_REGISTER_TYPE_CTOR_INFO(private_builtin, type_info, 1);
MR_REGISTER_TYPE_CTOR_INFO(private_builtin, base_typeclass_info, 1);
MR_REGISTER_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, zero_type_ctor_info, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, zero_type_info, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, zero_base_typeclass_info, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, zero_typeclass_info, 0);
MR_REGISTER_TYPE_CTOR_INFO(type_desc, type_ctor_desc, 0);
MR_REGISTER_TYPE_CTOR_INFO(type_desc, pseudo_type_desc, 0);
MR_REGISTER_TYPE_CTOR_INFO(type_desc, type_desc, 0);
@@ -1698,11 +1977,20 @@
MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin, ref, 1);
MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
type_ctor_info, 1);
- MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin, type_info, 1);
+ MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
+ type_info, 1);
MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
base_typeclass_info, 1);
MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
typeclass_info, 1);
+ MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
+ zero_type_ctor_info, 0);
+ MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
+ zero_type_info, 0);
+ MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
+ zero_base_typeclass_info, 0);
+ MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, private_builtin,
+ zero_typeclass_info, 0);
MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, type_desc, type_ctor_desc, 0);
MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, type_desc, pseudo_type_desc, 0);
MR_WRITE_OUT_PROC_STATIC_LAYOUTS(fp, type_desc, type_desc, 0);
Index: runtime/mercury_builtin_types.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_builtin_types.h,v
retrieving revision 1.6
diff -u -b -r1.6 mercury_builtin_types.h
--- runtime/mercury_builtin_types.h 23 Dec 2004 03:25:55 -0000 1.6
+++ runtime/mercury_builtin_types.h 19 Sep 2005 00:35:58 -0000
@@ -55,6 +55,14 @@
MR_DECLARE_TYPE_CTOR_INFO_STRUCT(
MR_TYPE_CTOR_INFO_NAME(private_builtin, base_typeclass_info, 1));
MR_DECLARE_TYPE_CTOR_INFO_STRUCT(
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_ctor_info, 0));
+MR_DECLARE_TYPE_CTOR_INFO_STRUCT(
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_info, 0));
+MR_DECLARE_TYPE_CTOR_INFO_STRUCT(
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_typeclass_info, 0));
+MR_DECLARE_TYPE_CTOR_INFO_STRUCT(
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_base_typeclass_info, 0));
+MR_DECLARE_TYPE_CTOR_INFO_STRUCT(
MR_TYPE_CTOR_INFO_NAME(type_desc, type_ctor_desc, 0));
MR_DECLARE_TYPE_CTOR_INFO_STRUCT(
MR_TYPE_CTOR_INFO_NAME(type_desc, pseudo_type_desc, 0));
@@ -104,6 +112,14 @@
MR_bool MR_CALL mercury__private_builtin____Unify____base_typeclass_info_1_0(
MR_Mercury_Type_Info type_info, MR_Mercury_Base_TypeClass_Info x,
MR_Mercury_Base_TypeClass_Info y);
+MR_bool MR_CALL mercury__private_builtin____Unify____zero_type_ctor_info_0_0(
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y);
+MR_bool MR_CALL mercury__private_builtin____Unify____zero_type_info_0_0(
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y);
+MR_bool MR_CALL mercury__private_builtin____Unify____zero_typeclass_info_0_0(
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y);
+MR_bool MR_CALL mercury__private_builtin____Unify____zero_base_typeclass_info_0_0(
+ MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y);
void MR_CALL mercury__builtin____Compare____int_0_0(
MR_Comparison_Result *result, MR_Integer x, MR_Integer y);
@@ -147,6 +163,18 @@
MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y);
void MR_CALL mercury__private_builtin____Compare____base_typeclass_info_1_0(
MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y);
+void MR_CALL mercury__private_builtin____Compare____zero_type_ctor_info_0_0(
+ MR_Comparison_Result *result,
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y);
+void MR_CALL mercury__private_builtin____Compare____zero_type_info_0_0(
+ MR_Comparison_Result *result,
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y);
+void MR_CALL mercury__private_builtin____Compare____zero_typeclass_info_0_0(
+ MR_Comparison_Result *result,
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y);
+void MR_CALL mercury__private_builtin____Compare____zero_base_typeclass_info_0_0(
+ MR_Comparison_Result *result,
MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y);
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.46
diff -u -b -r1.46 mercury_init.h
--- runtime/mercury_init.h 21 Jun 2005 03:12:02 -0000 1.46
+++ runtime/mercury_init.h 17 Sep 2005 15:46:12 -0000
@@ -130,8 +130,8 @@
/* in library/private_builtin.m */
extern const MR_TypeCtorInfo ML_type_ctor_info_for_univ;
-extern const MR_FA_TypeInfo_Struct1 ML_type_info_for_type_info;
-extern const MR_FA_TypeInfo_Struct1 ML_type_info_for_pseudo_type_info;
+extern const MR_TypeCtorInfo ML_type_info_for_type_info;
+extern const MR_TypeCtorInfo ML_type_info_for_pseudo_type_info;
extern const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_univ;
extern const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_int;
extern const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_char;
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.153
diff -u -b -r1.153 mercury_wrapper.c
--- runtime/mercury_wrapper.c 13 Sep 2005 08:25:39 -0000 1.153
+++ runtime/mercury_wrapper.c 17 Sep 2005 15:46:43 -0000
@@ -344,8 +344,8 @@
void (*MR_address_of_init_modules_required)(void);
MR_TypeCtorInfo MR_type_ctor_info_for_univ;
-MR_TypeInfo MR_type_info_for_type_info;
-MR_TypeInfo MR_type_info_for_pseudo_type_info;
+MR_TypeCtorInfo MR_type_info_for_type_info;
+MR_TypeCtorInfo MR_type_info_for_pseudo_type_info;
MR_TypeInfo MR_type_info_for_list_of_univ;
MR_TypeInfo MR_type_info_for_list_of_int;
MR_TypeInfo MR_type_info_for_list_of_char;
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.70
diff -u -b -r1.70 mercury_wrapper.h
--- runtime/mercury_wrapper.h 13 Sep 2005 08:25:40 -0000 1.70
+++ runtime/mercury_wrapper.h 17 Sep 2005 15:47:08 -0000
@@ -110,8 +110,8 @@
extern void (*MR_address_of_init_modules_required)(void);
extern MR_TypeCtorInfo MR_type_ctor_info_for_univ;
-extern MR_TypeInfo MR_type_info_for_type_info;
-extern MR_TypeInfo MR_type_info_for_pseudo_type_info;
+extern MR_TypeCtorInfo MR_type_info_for_type_info;
+extern MR_TypeCtorInfo MR_type_info_for_pseudo_type_info;
extern MR_TypeInfo MR_type_info_for_list_of_univ;
extern MR_TypeInfo MR_type_info_for_list_of_int;
extern MR_TypeInfo MR_type_info_for_list_of_char;
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 slice
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/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
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/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.64
diff -u -b -r1.64 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 1 Sep 2005 07:37:26 -0000 1.64
+++ trace/mercury_trace_vars.c 18 Sep 2005 01:41:15 -0000
@@ -171,6 +171,14 @@
extern const struct MR_TypeCtorInfo_Struct
MR_TYPE_CTOR_INFO_NAME(private_builtin, base_typeclass_info, 1);
extern const struct MR_TypeCtorInfo_Struct
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_info, 0);
+extern const struct MR_TypeCtorInfo_Struct
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_ctor_info, 0);
+extern const struct MR_TypeCtorInfo_Struct
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_typeclass_info, 0);
+extern const struct MR_TypeCtorInfo_Struct
+ MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_base_typeclass_info, 0);
+extern const struct MR_TypeCtorInfo_Struct
MR_TYPE_CTOR_INFO_NAME(std_util, type_desc, 0);
extern const struct MR_TypeCtorInfo_Struct
MR_TYPE_CTOR_INFO_NAME(std_util, type_ctor_desc, 0);
@@ -207,6 +215,8 @@
/* or their definitions are updated. XXX */
&MR_TYPE_CTOR_INFO_NAME(private_builtin, typeclass_info, 1),
&MR_TYPE_CTOR_INFO_NAME(private_builtin, base_typeclass_info, 1),
+ &MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_typeclass_info, 0),
+ &MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_base_typeclass_info, 0),
/* we ignore these because they should never be needed */
&MR_TYPE_CTOR_INFO_NAME(builtin, void, 0),
@@ -233,6 +243,8 @@
*/
&MR_TYPE_CTOR_INFO_NAME(private_builtin, type_info, 1),
&MR_TYPE_CTOR_INFO_NAME(private_builtin, type_ctor_info, 1),
+ &MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_info, 0),
+ &MR_TYPE_CTOR_INFO_NAME(private_builtin, zero_type_ctor_info, 0),
/* dummy member */
NULL
};
cvs diff: Diffing util
Index: util/mkinit.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mkinit.c,v
retrieving revision 1.103
diff -u -b -r1.103 mkinit.c
--- util/mkinit.c 12 Sep 2005 15:15:16 -0000 1.103
+++ util/mkinit.c 17 Sep 2005 17:16:39 -0000
@@ -383,9 +383,9 @@
" MR_num_complexity_procs = %d;\n"
"#endif\n"
" MR_type_ctor_info_for_univ = ML_type_ctor_info_for_univ;\n"
- " MR_type_info_for_type_info = (MR_TypeInfo)\n"
+ " MR_type_info_for_type_info = (MR_TypeCtorInfo)\n"
" &ML_type_info_for_type_info;\n"
- " MR_type_info_for_pseudo_type_info = (MR_TypeInfo)\n"
+ " MR_type_info_for_pseudo_type_info = (MR_TypeCtorInfo)\n"
" &ML_type_info_for_pseudo_type_info;\n"
" MR_type_info_for_list_of_univ = (MR_TypeInfo)\n"
" &ML_type_info_for_list_of_univ;\n"
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