[m-rev.] for review: record use of reserved addresses
Zoltan Somogyi
zs at csse.unimelb.edu.au
Tue Sep 25 14:21:54 AEST 2007
For review by anyone.
Zoltan.
When deciding on the representation of a type, record whether the
representation uses reserved addresses. We already do this for reserved tags,
so not doing it for reserved addresses is an asymmetry.
compiler/hlds_data.m:
Add the required slot to the hlds_du_type function symbol.
Rename is_enum as is_mercury_enum, since now we have is_foreign_enum
as well, and is_enum is misleading.
Replace some bools with purpose-specific types.
compiler/prog_data.m:
Define those purpose-specific types. They are defined here since we
also use them in the parse tree.
compiler/add_type.m:
compiler/make_tags.m:
Record in the slot whether a type representation uses reserved
addresses.
compiler/switch_gen.m:
Use the new slot, instead of going through the tags of the cons_ids
in all the switch arms.
Convert most of an if-then-else chain to a switch.
compiler/type_util.m:
Factor out some common code, and replace some map.searches (that could
fail only if previous code screwed up) with map.lookup.
compiler/*.m:
Conform to the changes above.
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/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.70
diff -u -r1.70 add_pragma.m
--- compiler/add_pragma.m 11 Sep 2007 03:12:27 -0000 1.70
+++ compiler/add_pragma.m 24 Sep 2007 07:10:01 -0000
@@ -543,10 +543,10 @@
]
;
TypeBody0 = hlds_du_type(Body, _CtorTags0, _IsEnum0,
- MaybeUserEqComp, ReservedTag0, IsForeign)
+ MaybeUserEqComp, ReservedTag0, _ReservedAddr, IsForeign)
->
(
- ReservedTag0 = yes,
+ ReservedTag0 = uses_reserved_tag,
% Make doubly sure that we don't get any spurious warnings
% with intermodule optimization...
TypeStatus \= status_opt_imported
@@ -561,14 +561,14 @@
ErrorPieces = []
),
- % We passed all the semantic checks. Mark the type has having
+ % We passed all the semantic checks. Mark the type as having
% a reserved tag, and recompute the constructor tags.
- ReservedTag = yes,
+ ReservedTag = uses_reserved_tag,
module_info_get_globals(!.ModuleInfo, Globals),
assign_constructor_tags(Body, MaybeUserEqComp, TypeCtor,
- ReservedTag, Globals, CtorTags, EnumDummy),
+ ReservedTag, Globals, CtorTags, ReservedAddr, EnumDummy),
TypeBody = hlds_du_type(Body, CtorTags, EnumDummy, MaybeUserEqComp,
- ReservedTag, IsForeign),
+ ReservedTag, ReservedAddr, IsForeign),
hlds_data.set_type_defn_body(TypeBody, TypeDefn0, TypeDefn),
map.set(Types0, TypeCtor, TypeDefn, Types),
module_info_set_type_table(Types, !ModuleInfo)
@@ -648,9 +648,9 @@
;
% XXX How should we handle IsForeignType here?
TypeBody = hlds_du_type(Ctors, _TagValues, IsEnumOrDummy,
- _MaybeUserEq, _ReservedTag, _IsForeignType),
+ _MaybeUserEq, _ReservedTag, _ReservedAddr, _IsForeignType),
(
- ( IsEnumOrDummy = is_enum
+ ( IsEnumOrDummy = is_mercury_enum
; IsEnumOrDummy = is_foreign_enum(_)
; IsEnumOrDummy = is_dummy
),
@@ -995,7 +995,7 @@
]
;
TypeBody0 = hlds_du_type(Ctors, OldTagValues, IsEnumOrDummy0,
- MaybeUserEq, ReservedTag, IsForeignType),
+ MaybeUserEq, ReservedTag, ReservedAddr, IsForeignType),
%
% Work out what language's foreign_enum pragma we should be
% looking at for the the current compilation target language.
@@ -1006,7 +1006,7 @@
target_lang_to_foreign_enum_lang(TargetLanguage),
(
( IsEnumOrDummy0 = is_dummy
- ; IsEnumOrDummy0 = is_enum
+ ; IsEnumOrDummy0 = is_mercury_enum
),
get_type_defn_status(TypeDefn0, TypeStatus),
% Either both the type and the pragma are defined in this
@@ -1041,13 +1041,11 @@
UnmappedCtors = [],
TypeBody = hlds_du_type(Ctors, TagValues,
IsEnumOrDummy, MaybeUserEq, ReservedTag,
- IsForeignType),
- set_type_defn_body(TypeBody, TypeDefn0,
- TypeDefn),
+ ReservedAddr, IsForeignType),
+ set_type_defn_body(TypeBody, TypeDefn0, TypeDefn),
svmap.set(TypeCtor, TypeDefn, TypeTable0,
TypeTable),
- module_info_set_type_table(TypeTable,
- !ModuleInfo)
+ module_info_set_type_table(TypeTable, !ModuleInfo)
;
UnmappedCtors = [_ | _],
add_foreign_enum_unmapped_ctors_error(Context,
Index: compiler/add_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_type.m,v
retrieving revision 1.27
diff -u -r1.27 add_type.m
--- compiler/add_type.m 7 May 2007 05:21:29 -0000 1.27
+++ compiler/add_type.m 24 Sep 2007 06:39:26 -0000
@@ -89,7 +89,7 @@
(
Body0 = hlds_abstract_type(_)
;
- Body0 = hlds_du_type(_, _, _, _, _, _),
+ Body0 = hlds_du_type(_, _, _, _, _, _, _),
string.suffix(term.context_file(Context), ".int2")
% If the type definition comes from a .int2 file then
% we need to treat it as abstract. The constructors
@@ -364,7 +364,7 @@
get_type_defn_need_qualifier(TypeDefn, NeedQual),
module_info_get_globals(!.ModuleInfo, Globals),
(
- Body = hlds_du_type(ConsList, _, _, UserEqCmp, ReservedTag, _),
+ Body = hlds_du_type(ConsList, _, _, UserEqCmp, ReservedTag, _, _),
module_info_get_cons_table(!.ModuleInfo, Ctors0),
module_info_get_partial_qualifier_info(!.ModuleInfo, PQInfo),
module_info_get_ctor_field_table(!.ModuleInfo, CtorFields0),
@@ -493,7 +493,7 @@
Body = Body1 ^ du_type_is_foreign_type := yes(ForeignTypeBody)
).
merge_foreign_type_bodies(Target, MakeOptInterface,
- Body0 @ hlds_du_type(_, _, _, _, _, _),
+ Body0 @ hlds_du_type(_, _, _, _, _, _, _),
Body1 @ hlds_foreign_type(_), Body) :-
merge_foreign_type_bodies(Target, MakeOptInterface, Body1, Body0, Body).
merge_foreign_type_bodies(_, _, hlds_foreign_type(Body0),
@@ -608,13 +608,13 @@
% `:- pragma reserve_tag' declaration for this type.
% (If it turns out that there was one, then we will recompute the
% constructor tags by calling assign_constructor_tags again,
- % with ReservedTagPragma = yes, when processing the pragma.)
- ReservedTagPragma = no,
+ % with ReservedTagPragma = uses_reserved_tag, when processing the pragma.)
+ ReservedTagPragma = does_not_use_reserved_tag,
assign_constructor_tags(Body, MaybeUserEqComp, TypeCtor, ReservedTagPragma,
- Globals, CtorTags, IsEnum),
+ Globals, CtorTags, ReservedAddr, IsEnum),
IsForeign = no,
HLDSBody = hlds_du_type(Body, CtorTags, IsEnum, MaybeUserEqComp,
- ReservedTagPragma, IsForeign).
+ ReservedTagPragma, ReservedAddr, IsForeign).
convert_type_defn(parse_tree_eqv_type(Body), _, _, hlds_eqv_type(Body)).
convert_type_defn(parse_tree_solver_type(SolverTypeDetails, MaybeUserEqComp),
_, _, hlds_solver_type(SolverTypeDetails, MaybeUserEqComp)).
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.112
diff -u -r1.112 check_typeclass.m
--- compiler/check_typeclass.m 17 May 2007 03:52:39 -0000 1.112
+++ compiler/check_typeclass.m 24 Sep 2007 06:39:26 -0000
@@ -1297,7 +1297,7 @@
check_ctor_constraints(TypeTable, TypeCtor, !ModuleInfo, !Specs) :-
map.lookup(TypeTable, TypeCtor, TypeDefn),
get_type_defn_body(TypeDefn, Body),
- ( Body = hlds_du_type(Ctors, _, _, _, _, _) ->
+ ( Body = hlds_du_type(Ctors, _, _, _, _, _, _) ->
list.foldl2(check_ctor_type_ambiguities(TypeCtor, TypeDefn), Ctors,
!ModuleInfo, !Specs)
;
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.43
diff -u -r1.43 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m 7 Aug 2007 07:09:51 -0000 1.43
+++ compiler/equiv_type_hlds.m 24 Sep 2007 06:39:26 -0000
@@ -143,7 +143,7 @@
equiv_type.maybe_record_expanded_items(ModuleName, TypeCtorSymName,
!.MaybeRecompInfo, EquivTypeInfo0),
(
- Body0 = hlds_du_type(Ctors0, _, _, _, _, _),
+ Body0 = hlds_du_type(Ctors0, _, _, _, _, _, _),
equiv_type.replace_in_ctors(EqvMap, Ctors0, Ctors,
TVarSet0, TVarSet, EquivTypeInfo0, EquivTypeInfo),
Body = Body0 ^ du_type_ctors := Ctors
Index: compiler/export.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.116
diff -u -r1.116 export.m
--- compiler/export.m 11 Sep 2007 03:12:28 -0000 1.116
+++ compiler/export.m 24 Sep 2007 07:01:49 -0000
@@ -783,12 +783,12 @@
unexpected(this_file, "invalid type for foreign_export_enum")
;
TypeBody = hlds_du_type(Ctors, TagValues, IsEnumOrDummy,
- _MaybeUserEq, _ReservedTag, _IsForeignType),
+ _MaybeUserEq, _ReservedTag, _ReservedAddr, _IsForeignType),
(
IsEnumOrDummy = not_enum_or_dummy,
unexpected(this_file, "d.u. is not an enumeration.")
;
- ( IsEnumOrDummy = is_enum
+ ( IsEnumOrDummy = is_mercury_enum
; IsEnumOrDummy = is_foreign_enum(_)
; IsEnumOrDummy = is_dummy
),
Index: compiler/hlds_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_code_util.m,v
retrieving revision 1.33
diff -u -r1.33 hlds_code_util.m
--- compiler/hlds_code_util.m 1 Dec 2006 15:03:58 -0000 1.33
+++ compiler/hlds_code_util.m 24 Sep 2007 06:39:26 -0000
@@ -114,14 +114,7 @@
->
Tag = single_functor_tag
;
- % Use the type to determine the type_ctor.
- ( type_to_ctor_and_args(Type, TypeCtor0, _) ->
- TypeCtor = TypeCtor0
- ;
- % The type-checker should ensure that this never happens.
- unexpected(this_file, "cons_id_to_tag: invalid type")
- ),
-
+ type_to_ctor_det(Type, TypeCtor),
% Given the type_ctor, lookup up the constructor tag table
% for that type.
module_info_get_type_table(ModuleInfo, TypeTable),
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.116
diff -u -r1.116 hlds_data.m
--- compiler/hlds_data.m 11 Sep 2007 03:12:28 -0000 1.116
+++ compiler/hlds_data.m 24 Sep 2007 07:01:38 -0000
@@ -173,7 +173,10 @@
du_type_usereq :: maybe(unify_compare),
% Is there a `:- pragma reserve_tag' pragma for this type?
- du_type_reserved_tag :: bool,
+ du_type_reserved_tag :: uses_reserved_tag,
+
+ % Does the type representation use a reserved address?
+ du_type_reserved_addr :: uses_reserved_address,
% Are there `:- pragma foreign' type declarations for
% this type?
@@ -185,9 +188,9 @@
; hlds_abstract_type(is_solver_type).
:- type enum_or_dummy
- ---> is_enum
- ; is_dummy
+ ---> is_mercury_enum
; is_foreign_enum(foreign_language)
+ ; is_dummy
; not_enum_or_dummy.
:- type foreign_type_body
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.434
diff -u -r1.434 hlds_out.m
--- compiler/hlds_out.m 11 Sep 2007 03:12:28 -0000 1.434
+++ compiler/hlds_out.m 24 Sep 2007 07:08:49 -0000
@@ -3313,10 +3313,10 @@
io::di, io::uo) is det.
write_type_body(Indent, TVarSet, hlds_du_type(Ctors, Tags, EnumDummy,
- MaybeUserEqComp, ReservedTag, Foreign), !IO) :-
+ MaybeUserEqComp, ReservedTag, ReservedAddr, Foreign), !IO) :-
io.write_string(" --->\n", !IO),
(
- EnumDummy = is_enum,
+ EnumDummy = is_mercury_enum,
write_indent(Indent, !IO),
io.write_string("/* enumeration */\n", !IO)
;
@@ -3333,11 +3333,18 @@
EnumDummy = not_enum_or_dummy
),
(
- ReservedTag = yes,
+ ReservedTag = uses_reserved_tag,
write_indent(Indent, !IO),
io.write_string("/* reserved_tag */\n", !IO)
;
- ReservedTag = no
+ ReservedTag = does_not_use_reserved_tag
+ ),
+ (
+ ReservedAddr = uses_reserved_address,
+ write_indent(Indent, !IO),
+ io.write_string("/* reserved_address */\n", !IO)
+ ;
+ ReservedAddr = does_not_use_reserved_address
),
write_constructors(Indent, TVarSet, Ctors, Tags, !IO),
mercury_output_where_attributes(TVarSet, no, MaybeUserEqComp, !IO),
Index: compiler/inst_check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_check.m,v
retrieving revision 1.6
diff -u -r1.6 inst_check.m
--- compiler/inst_check.m 1 Nov 2006 06:32:54 -0000 1.6
+++ compiler/inst_check.m 24 Sep 2007 06:39:26 -0000
@@ -291,7 +291,7 @@
get_du_functors_for_type_def(TypeDef) = Functors :-
get_type_defn_body(TypeDef, TypeDefBody),
(
- TypeDefBody = hlds_du_type(Constructors, _, _, _, _, _),
+ TypeDefBody = hlds_du_type(Constructors, _, _, _, _, _, _),
Functors = list.map(constructor_to_sym_name_and_arity, Constructors)
;
( TypeDefBody = hlds_eqv_type(_)
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.223
diff -u -r1.223 intermod.m
--- compiler/intermod.m 11 Sep 2007 03:12:29 -0000 1.223
+++ compiler/intermod.m 24 Sep 2007 07:18:16 -0000
@@ -972,11 +972,10 @@
hlds_data.get_type_defn_body(TypeDefn0, TypeBody0),
(
TypeBody0 = hlds_du_type(Ctors, Tags, Enum, MaybeUserEqComp0,
- ReservedTag, MaybeForeign0),
+ ReservedTag, ReservedAddr, MaybeForeign0),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
- %
% Note that we don't resolve overloading for the definitions
% which won't be used on this back-end, because their unification
% and comparison predicates have not been typechecked. They are
@@ -984,7 +983,9 @@
% against a workspace for the other definitions to be present
% (e.g. when testing compiling a module to IL when the workspace
% was compiled to C).
- %
+ % XXX The above sentence doesn't make sense, and never did
+ % (even in the first CVS version in which it appears).
+
(
MaybeForeign0 = yes(ForeignTypeBody0),
have_foreign_type_for_backend(Target, ForeignTypeBody0, yes)
@@ -1002,7 +1003,7 @@
MaybeForeign = MaybeForeign0
),
TypeBody = hlds_du_type(Ctors, Tags, Enum, MaybeUserEqComp,
- ReservedTag, MaybeForeign),
+ ReservedTag, ReservedAddr, MaybeForeign),
hlds_data.set_type_defn_body(TypeBody, TypeDefn0, TypeDefn)
;
TypeBody0 = hlds_foreign_type(ForeignTypeBody0),
@@ -1267,7 +1268,7 @@
hlds_data.get_type_defn_context(TypeDefn, Context),
TypeCtor = type_ctor(Name, Arity),
(
- Body = hlds_du_type(Ctors, _, _, MaybeUserEqComp, _, _),
+ Body = hlds_du_type(Ctors, _, _, MaybeUserEqComp, _, _, _),
TypeBody = parse_tree_du_type(Ctors, MaybeUserEqComp)
;
Body = hlds_eqv_type(EqvType),
@@ -1349,7 +1350,7 @@
),
(
ReservedTag = Body ^ du_type_reserved_tag,
- ReservedTag = yes
+ ReservedTag = uses_reserved_tag
->
% The pragma_origin doesn't matter here.
mercury_output_item(item_pragma(user, pragma_reserve_tag(Name, Arity)),
@@ -1358,7 +1359,7 @@
true
),
(
- Body = hlds_du_type(_, ConsTagVals, EnumOrDummy, _, _, _),
+ Body = hlds_du_type(_, ConsTagVals, EnumOrDummy, _, _, _, _),
EnumOrDummy = is_foreign_enum(Lang)
->
map.foldl(gather_foreign_enum_value_pair, ConsTagVals, [],
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.57
diff -u -r1.57 make_tags.m
--- compiler/make_tags.m 31 Jul 2007 07:58:41 -0000 1.57
+++ compiler/make_tags.m 24 Sep 2007 07:10:19 -0000
@@ -63,7 +63,6 @@
:- import_module libs.globals.
:- import_module parse_tree.prog_data.
-:- import_module bool.
:- import_module list.
:- import_module maybe.
@@ -71,13 +70,15 @@
% ReservedTagPragma, Globals, TagValues, IsEnum):
%
% Assign a constructor tag to each constructor for a discriminated union
- % type, and determine whether the type is an enumeration type or not.
+ % type, and determine whether (a) the type representation uses reserved
+ % addresses, and (b) the type is an enumeration or dummy type.
% (`Globals' is passed because exact way in which this is done is
% dependent on a compilation option.)
%
:- pred assign_constructor_tags(list(constructor)::in,
- maybe(unify_compare)::in, type_ctor::in, bool::in,
- globals::in, cons_tag_values::out, enum_or_dummy::out) is det.
+ maybe(unify_compare)::in, type_ctor::in, uses_reserved_tag::in,
+ globals::in, cons_tag_values::out,
+ uses_reserved_address::out, enum_or_dummy::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -90,6 +91,7 @@
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
+:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module svmap.
@@ -97,7 +99,7 @@
%-----------------------------------------------------------------------------%
assign_constructor_tags(Ctors, UserEqCmp, TypeCtor, ReservedTagPragma, Globals,
- CtorTags, EnumDummy) :-
+ CtorTags, ReservedAddr, EnumDummy) :-
% Work out how many tag bits and reserved addresses we've got to play with.
globals.lookup_int_option(Globals, num_tag_bits, NumTagBits),
@@ -110,10 +112,10 @@
% Determine if we need to reserve a tag for use by HAL's Herbrand
% constraint solver. (This also disables enumerations and no_tag types.)
(
- ReservedTagPragma = yes,
+ ReservedTagPragma = uses_reserved_tag,
InitTag = 1
;
- ReservedTagPragma = no,
+ ReservedTagPragma = does_not_use_reserved_tag,
InitTag = 0
),
@@ -124,14 +126,15 @@
% must be constant, and we must be allowed to make unboxed enums.
globals.lookup_bool_option(Globals, unboxed_enums, yes),
ctors_are_all_constants(Ctors),
- ReservedTagPragma = no
+ ReservedTagPragma = does_not_use_reserved_tag
->
( Ctors = [_] ->
EnumDummy = is_dummy
;
- EnumDummy = is_enum
+ EnumDummy = is_mercury_enum
),
- assign_enum_constants(Ctors, InitTag, CtorTags0, CtorTags)
+ assign_enum_constants(Ctors, InitTag, CtorTags0, CtorTags),
+ ReservedAddr = does_not_use_reserved_address
;
EnumDummy = not_enum_or_dummy,
(
@@ -141,33 +144,37 @@
->
SingleConsId = make_cons_id_from_qualified_sym_name(SingleFunc,
[SingleArg]),
- map.set(CtorTags0, SingleConsId, no_tag, CtorTags)
+ map.set(CtorTags0, SingleConsId, no_tag, CtorTags),
+ ReservedAddr = does_not_use_reserved_address
;
NumTagBits = 0
->
(
- ReservedTagPragma = yes,
+ ReservedTagPragma = uses_reserved_tag,
% XXX Need to fix this.
% This occurs for the .NET and Java backends.
sorry("make_tags", "--reserve-tag with num_tag_bits = 0")
;
- ReservedTagPragma = no
+ ReservedTagPragma = does_not_use_reserved_tag
),
% Assign reserved addresses to the constants, if possible.
separate_out_constants(Ctors, Constants, Functors),
assign_reserved_numeric_addresses(Constants, LeftOverConstants0,
- CtorTags0, CtorTags1, 0, NumReservedAddresses),
+ CtorTags0, CtorTags1, 0, NumReservedAddresses,
+ does_not_use_reserved_address, ReservedAddr1),
(
HighLevelCode = yes,
assign_reserved_symbolic_addresses(
LeftOverConstants0, LeftOverConstants, TypeCtor,
- CtorTags1, CtorTags2, 0, NumReservedObjects)
+ CtorTags1, CtorTags2, 0, NumReservedObjects,
+ ReservedAddr1, ReservedAddr)
;
HighLevelCode = no,
% Reserved symbolic addresses are not supported for the
% LLDS back-end.
LeftOverConstants = LeftOverConstants0,
- CtorTags2 = CtorTags1
+ CtorTags2 = CtorTags1,
+ ReservedAddr = ReservedAddr1
),
% Assign shared_with_reserved_address(...) representations
% for the remaining constructors.
@@ -183,7 +190,8 @@
assign_constant_tags(Constants, CtorTags0, CtorTags1,
InitTag, NextTag),
assign_unshared_tags(Functors, NextTag, MaxTag, [],
- CtorTags1, CtorTags)
+ CtorTags1, CtorTags),
+ ReservedAddr = does_not_use_reserved_address
)
).
@@ -204,11 +212,12 @@
%
:- pred assign_reserved_numeric_addresses(
list(constructor)::in, list(constructor)::out,
- cons_tag_values::in, cons_tag_values::out, int::in, int::in) is det.
+ cons_tag_values::in, cons_tag_values::out, int::in, int::in,
+ uses_reserved_address::in, uses_reserved_address::out) is det.
-assign_reserved_numeric_addresses([], [], !CtorTags, _, _).
+assign_reserved_numeric_addresses([], [], !CtorTags, _, _, !ReservedAddr).
assign_reserved_numeric_addresses([Ctor | Rest], LeftOverConstants,
- !CtorTags, Address, NumReservedAddresses) :-
+ !CtorTags, Address, NumReservedAddresses, !ReservedAddr) :-
( Address >= NumReservedAddresses ->
LeftOverConstants = [Ctor | Rest]
;
@@ -220,8 +229,9 @@
Tag = reserved_address_tag(small_pointer(Address))
),
svmap.set(ConsId, Tag, !CtorTags),
+ !:ReservedAddr = uses_reserved_address,
assign_reserved_numeric_addresses(Rest, LeftOverConstants,
- !CtorTags, Address + 1, NumReservedAddresses)
+ !CtorTags, Address + 1, NumReservedAddresses, !ReservedAddr)
).
% Assign reserved_object(CtorName, CtorArity) representations
@@ -229,11 +239,12 @@
%
:- pred assign_reserved_symbolic_addresses(
list(constructor)::in, list(constructor)::out, type_ctor::in,
- cons_tag_values::in, cons_tag_values::out, int::in, int::in) is det.
+ cons_tag_values::in, cons_tag_values::out, int::in, int::in,
+ uses_reserved_address::in, uses_reserved_address::out) is det.
-assign_reserved_symbolic_addresses([], [], _, !CtorTags, _, _).
+assign_reserved_symbolic_addresses([], [], _, !CtorTags, _, _, !ReservedAddr).
assign_reserved_symbolic_addresses([Ctor | Ctors], LeftOverConstants, TypeCtor,
- !CtorTags, Num, Max) :-
+ !CtorTags, Num, Max, !ReservedAddr) :-
( Num >= Max ->
LeftOverConstants = [Ctor | Ctors]
;
@@ -242,8 +253,9 @@
Tag = reserved_address_tag(reserved_object(TypeCtor, Name, Arity)),
ConsId = make_cons_id_from_qualified_sym_name(Name, Args),
svmap.set(ConsId, Tag, !CtorTags),
+ !:ReservedAddr = uses_reserved_address,
assign_reserved_symbolic_addresses(Ctors, LeftOverConstants,
- TypeCtor, !CtorTags, Num + 1, Max)
+ TypeCtor, !CtorTags, Num + 1, Max, !ReservedAddr)
).
:- pred assign_constant_tags(list(constructor)::in, cons_tag_values::in,
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.70
diff -u -r1.70 ml_type_gen.m
--- compiler/ml_type_gen.m 11 Sep 2007 03:12:30 -0000 1.70
+++ compiler/ml_type_gen.m 24 Sep 2007 07:18:07 -0000
@@ -154,12 +154,12 @@
% For a description of the problems with equivalence types,
% see our BABEL'01 paper "Compiling Mercury to the .NET CLR".
ml_gen_type_2(hlds_du_type(Ctors, TagValues, EnumDummy, MaybeUserEqComp,
- _ReservedTag, _), ModuleInfo, TypeCtor, TypeDefn, !Defns) :-
+ _ReservedTag, _, _), ModuleInfo, TypeCtor, TypeDefn, !Defns) :-
% XXX we probably shouldn't ignore _ReservedTag
ml_gen_equality_members(MaybeUserEqComp, MaybeEqualityMembers),
(
- ( EnumDummy = is_foreign_enum(_)
- ; EnumDummy = is_enum
+ ( EnumDummy = is_mercury_enum
+ ; EnumDummy = is_foreign_enum(_)
),
ml_gen_enum_type(TypeCtor, TypeDefn, Ctors, TagValues,
MaybeEqualityMembers, !Defns)
@@ -1057,7 +1057,7 @@
unexpected(this_file, "ml_gen_exported_enum - invalid type (2).")
;
TypeBody = hlds_du_type(Ctors, TagValues, _IsEnumOrDummy, _MaybeUserEq,
- _ReservedTag, _IsForeignType),
+ _ReservedTag, _ReservedAddr, _IsForeignType),
list.foldl(generate_foreign_enum_constant(Mapping, TagValues),
Ctors, [], NamesAndTags),
MLDS_ExportedEnum = mlds_exported_enum(Lang, Context,
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.116
diff -u -r1.116 ml_unify_gen.m
--- compiler/ml_unify_gen.m 11 Sep 2007 03:12:30 -0000 1.116
+++ compiler/ml_unify_gen.m 24 Sep 2007 06:39:26 -0000
@@ -1793,7 +1793,9 @@
module_info_get_type_table(ModuleInfo, TypeTable),
TypeDefn = map.lookup(TypeTable, TypeCtor),
hlds_data.get_type_defn_body(TypeDefn, TypeDefnBody),
- ( TypeDefnBody = hlds_du_type(Ctors, TagValues, _, _, _ReservedTag, _) ->
+ (
+ TypeDefnBody = hlds_du_type(Ctors, TagValues, _, _, _ReservedTag, _, _)
+ ->
% XXX we probably shouldn't ignore ReservedTag here
(
some [Ctor] (
Index: compiler/post_term_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_term_analysis.m,v
retrieving revision 1.16
diff -u -r1.16 post_term_analysis.m
--- compiler/post_term_analysis.m 2 Jul 2007 05:30:30 -0000 1.16
+++ compiler/post_term_analysis.m 24 Sep 2007 06:39:26 -0000
@@ -211,7 +211,7 @@
unify_compare::out) is semidet.
get_user_unify_compare(_ModuleInfo, TypeBody, UnifyCompare) :-
- TypeBody = hlds_du_type(_, _, _, yes(UnifyCompare), _, _).
+ TypeBody = hlds_du_type(_, _, _, yes(UnifyCompare), _, _, _).
get_user_unify_compare(ModuleInfo, TypeBody, UnifyCompare) :-
TypeBody = hlds_foreign_type(ForeignTypeBody),
foreign_type_body_has_user_defined_eq_comp_pred(ModuleInfo,
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.194
diff -u -r1.194 prog_data.m
--- compiler/prog_data.m 21 Sep 2007 01:45:13 -0000 1.194
+++ compiler/prog_data.m 24 Sep 2007 06:39:26 -0000
@@ -1272,6 +1272,14 @@
%
:- type existq_tvars == list(tvar).
+:- type uses_reserved_tag
+ ---> uses_reserved_tag
+ ; does_not_use_reserved_tag.
+
+:- type uses_reserved_address
+ ---> uses_reserved_address
+ ; does_not_use_reserved_address.
+
% Types may have arbitrary assertions associated with them
% (e.g. you can define a type which represents sorted lists).
% Similarly, pred declarations can have assertions attached.
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.40
diff -u -r1.40 prog_type.m
--- compiler/prog_type.m 20 Aug 2007 03:36:04 -0000 1.40
+++ compiler/prog_type.m 24 Sep 2007 06:47:23 -0000
@@ -378,8 +378,8 @@
% reserving a tag, or if it is one of the dummy types).
%
:- pred type_with_constructors_should_be_no_tag(globals::in, type_ctor::in,
- bool::in, list(constructor)::in, maybe(unify_compare)::in, sym_name::out,
- mer_type::out, maybe(string)::out) is semidet.
+ uses_reserved_tag::in, list(constructor)::in, maybe(unify_compare)::in,
+ sym_name::out, mer_type::out, maybe(string)::out) is semidet.
% Unify (with occurs check) two types with respect to a type substitution
% and update the type bindings. The third argument is a list of type
@@ -1033,7 +1033,7 @@
type_constructors_are_no_tag_type(Ctors, SingleFunc, SingleArg,
MaybeArgName),
(
- ReserveTagPragma = no,
+ ReserveTagPragma = does_not_use_reserved_tag,
globals.lookup_bool_option(Globals, unboxed_no_tag_types, yes)
;
% Dummy types always need to be treated as no-tag types as the
Index: compiler/recompilation.usage.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.usage.m,v
retrieving revision 1.43
diff -u -r1.43 recompilation.usage.m
--- compiler/recompilation.usage.m 19 Jan 2007 07:04:29 -0000 1.43
+++ compiler/recompilation.usage.m 24 Sep 2007 06:39:26 -0000
@@ -1053,7 +1053,7 @@
:- pred find_items_used_by_type_body(hlds_type_body::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
-find_items_used_by_type_body(hlds_du_type(Ctors, _, _, _, _, _), !Info) :-
+find_items_used_by_type_body(hlds_du_type(Ctors, _, _, _, _, _, _), !Info) :-
list.foldl(find_items_used_by_ctor, Ctors, !Info).
find_items_used_by_type_body(hlds_eqv_type(Type), !Info) :-
find_items_used_by_type(Type, !Info).
Index: compiler/structure_reuse.direct.choose_reuse.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_reuse.direct.choose_reuse.m,v
retrieving revision 1.9
diff -u -r1.9 structure_reuse.direct.choose_reuse.m
--- compiler/structure_reuse.direct.choose_reuse.m 6 Jan 2007 09:23:52 -0000 1.9
+++ compiler/structure_reuse.direct.choose_reuse.m 24 Sep 2007 06:39:27 -0000
@@ -1007,7 +1007,7 @@
(
map.lookup(VarTypes, Var, Type),
type_to_type_defn_body(ModuleInfo, Type, TypeBody),
- TypeBody = hlds_du_type(_, ConsTagValues, _, _, _, _),
+ TypeBody = hlds_du_type(_, ConsTagValues, _, _, _, _, _),
map.search(ConsTagValues, ConsId, ConsTag),
MaybeSecondaryTag = get_secondary_tag(ConsTag),
MaybeSecondaryTag = yes(_)
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.103
diff -u -r1.103 switch_gen.m
--- compiler/switch_gen.m 6 Jan 2007 09:23:54 -0000 1.103
+++ compiler/switch_gen.m 24 Sep 2007 09:08:18 -0000
@@ -68,6 +68,7 @@
:- import_module hlds.goal_form.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_llds.
+:- import_module hlds.hlds_module.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module libs.tree.
@@ -78,9 +79,11 @@
:- import_module ll_backend.tag_switch.
:- import_module ll_backend.trace_gen.
:- import_module ll_backend.unify_gen.
+:- import_module parse_tree.prog_type.
:- import_module bool.
:- import_module int.
+:- import_module map.
:- import_module maybe.
:- import_module pair.
@@ -91,78 +94,95 @@
% CanFail says whether the switch covers all cases.
goal_info_get_store_map(GoalInfo, StoreMap),
- SwitchCategory = determine_switch_category(!.CI, CaseVar),
code_info.get_next_label(EndLabel, !CI),
lookup_tags(!.CI, Cases, CaseVar, TaggedCases0),
list.sort_and_remove_dups(TaggedCases0, TaggedCases),
code_info.get_globals(!.CI, Globals),
globals.lookup_bool_option(Globals, smart_indexing, Indexing),
+
+ CaseVarType = code_info.variable_type(!.CI, CaseVar),
+ type_to_ctor_det(CaseVarType, CaseVarTypeCtor),
+ code_info.get_module_info(!.CI, ModuleInfo),
+ TypeCategory = classify_type(ModuleInfo, CaseVarType),
+ SwitchCategory = switch_util.type_cat_to_switch_cat(TypeCategory),
(
- % Check for a switch on a type whose representation
- % uses reserved addresses.
- list.member(Case, TaggedCases),
- Case = extended_case(_Priority, Tag, _ConsId, _Goal),
(
- Tag = reserved_address_tag(_)
+ Indexing = no
;
- Tag = shared_with_reserved_addresses_tag(_, _)
+ module_info_get_type_table(ModuleInfo, TypeTable),
+ % The search will fail for builtin types.
+ map.search(TypeTable, CaseVarTypeCtor, CaseVarTypeDefn),
+ hlds_data.get_type_defn_body(CaseVarTypeDefn, CaseVarTypeBody),
+ CaseVarTypeBody ^ du_type_reserved_addr = uses_reserved_address
)
->
- % XXX This may be be inefficient in some cases.
+ % XXX If the type uses reserved addresses, we should try to generate
+ % code that uses the other indexing mechanisms *after* testing for the
+ % reserved addresses.
generate_all_cases(TaggedCases, CaseVar, CodeModel, CanFail, GoalInfo,
EndLabel, no, MaybeEnd, Code, !CI)
;
- Indexing = yes,
- SwitchCategory = atomic_switch,
- code_info.get_maybe_trace_info(!.CI, MaybeTraceInfo),
- MaybeTraceInfo = no,
- list.length(TaggedCases, NumCases),
- globals.lookup_int_option(Globals, lookup_switch_size, LookupSize),
- NumCases >= LookupSize,
- globals.lookup_int_option(Globals, lookup_switch_req_density,
- ReqDensity),
- is_lookup_switch(CaseVar, TaggedCases, GoalInfo, CanFail, ReqDensity,
- StoreMap, no, MaybeEndPrime, CodeModel, LookupSwitchInfo, !CI)
- ->
- MaybeEnd = MaybeEndPrime,
- generate_lookup_switch(CaseVar, StoreMap, no, LookupSwitchInfo, Code,
- !CI)
- ;
- Indexing = yes,
- SwitchCategory = atomic_switch,
- list.length(TaggedCases, NumCases),
- globals.lookup_int_option(Globals, dense_switch_size, DenseSize),
- NumCases >= DenseSize,
- globals.lookup_int_option(Globals, dense_switch_req_density,
- ReqDensity),
- cases_list_is_dense_switch(!.CI, CaseVar, TaggedCases, CanFail,
- ReqDensity, FirstVal, LastVal, CanFail1)
- ->
- generate_dense_switch(TaggedCases, FirstVal, LastVal, CaseVar,
- CodeModel, CanFail1, GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
- ;
- Indexing = yes,
- SwitchCategory = string_switch,
- list.length(TaggedCases, NumCases),
- globals.lookup_int_option(Globals, string_switch_size, StringSize),
- NumCases >= StringSize
- ->
- generate_string_switch(TaggedCases, CaseVar, CodeModel, CanFail,
- GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
- ;
- Indexing = yes,
- SwitchCategory = tag_switch,
- list.length(TaggedCases, NumCases),
- globals.lookup_int_option(Globals, tag_switch_size, TagSize),
- NumCases >= TagSize
- ->
- generate_tag_switch(TaggedCases, CaseVar, CodeModel, CanFail,
- GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
- ;
- % To generate a switch, first we flush the variable on whose tag
- % we are going to switch, then we generate the cases for the switch.
- generate_all_cases(TaggedCases, CaseVar, CodeModel, CanFail, GoalInfo,
- EndLabel, no, MaybeEnd, Code, !CI)
+ (
+ SwitchCategory = atomic_switch,
+ list.length(TaggedCases, NumCases),
+ (
+ code_info.get_maybe_trace_info(!.CI, MaybeTraceInfo),
+ MaybeTraceInfo = no,
+ globals.lookup_int_option(Globals, lookup_switch_size,
+ LookupSize),
+ NumCases >= LookupSize,
+ globals.lookup_int_option(Globals, lookup_switch_req_density,
+ ReqDensity),
+ is_lookup_switch(CaseVar, TaggedCases, GoalInfo, CanFail,
+ ReqDensity, StoreMap, no, MaybeEndPrime, CodeModel,
+ LookupSwitchInfo, !CI)
+ ->
+ MaybeEnd = MaybeEndPrime,
+ generate_lookup_switch(CaseVar, StoreMap, no, LookupSwitchInfo,
+ Code, !CI)
+ ;
+ globals.lookup_int_option(Globals, dense_switch_size,
+ DenseSize),
+ NumCases >= DenseSize,
+ globals.lookup_int_option(Globals, dense_switch_req_density,
+ ReqDensity),
+ cases_list_is_dense_switch(!.CI, CaseVar, TaggedCases, CanFail,
+ ReqDensity, FirstVal, LastVal, CanFail1)
+ ->
+ generate_dense_switch(TaggedCases, FirstVal, LastVal, CaseVar,
+ CodeModel, CanFail1, GoalInfo, EndLabel, no, MaybeEnd,
+ Code, !CI)
+ ;
+ generate_all_cases(TaggedCases, CaseVar, CodeModel, CanFail,
+ GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ )
+ ;
+ SwitchCategory = string_switch,
+ list.length(TaggedCases, NumCases),
+ globals.lookup_int_option(Globals, string_switch_size, StringSize),
+ ( NumCases >= StringSize ->
+ generate_string_switch(TaggedCases, CaseVar, CodeModel,
+ CanFail, GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ ;
+ generate_all_cases(TaggedCases, CaseVar, CodeModel, CanFail,
+ GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ )
+ ;
+ SwitchCategory = tag_switch,
+ list.length(TaggedCases, NumCases),
+ globals.lookup_int_option(Globals, tag_switch_size, TagSize),
+ ( NumCases >= TagSize ->
+ generate_tag_switch(TaggedCases, CaseVar, CodeModel, CanFail,
+ GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ ;
+ generate_all_cases(TaggedCases, CaseVar, CodeModel, CanFail,
+ GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ )
+ ;
+ SwitchCategory = other_switch,
+ generate_all_cases(TaggedCases, CaseVar, CodeModel, CanFail,
+ GoalInfo, EndLabel, no, MaybeEnd, Code, !CI)
+ )
),
code_info.after_all_branches(StoreMap, MaybeEnd, !CI).
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.138
diff -u -r1.138 table_gen.m
--- compiler/table_gen.m 21 Aug 2007 16:52:42 -0000 1.138
+++ compiler/table_gen.m 24 Sep 2007 07:22:46 -0000
@@ -2357,7 +2357,7 @@
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
Ctors = TypeBody ^ du_type_ctors,
- TypeBody ^ du_type_is_enum = is_enum,
+ TypeBody ^ du_type_is_enum = is_mercury_enum,
TypeBody ^ du_type_usereq = no
->
list.length(Ctors, EnumRange)
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.77
diff -u -r1.77 tag_switch.m
--- compiler/tag_switch.m 6 Jan 2007 09:23:54 -0000 1.77
+++ compiler/tag_switch.m 24 Sep 2007 06:39:27 -0000
@@ -576,10 +576,10 @@
string.int_to_string(LowRangeEnd, LowEndStr),
string.int_to_string(HighRangeStart, HighStartStr),
string.int_to_string(MaxPtag, HighEndStr),
- string.append_list(["fallthrough for ptags ",
- LowStartStr, " to ", LowEndStr], IfComment),
- string.append_list(["code for ptags ", HighStartStr,
- " to ", HighEndStr], LabelComment),
+ IfComment = "fallthrough for ptags " ++ LowStartStr ++
+ " to " ++ LowEndStr,
+ LabelComment = "code for ptags " ++ HighStartStr ++
+ " to " ++ HighEndStr,
LowRangeEndConst = const(llconst_int(LowRangeEnd)),
TestRval = binop(int_gt, PtagRval, LowRangeEndConst),
IfCode = node([
Index: compiler/term_norm.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_norm.m,v
retrieving revision 1.25
diff -u -r1.25 term_norm.m
--- compiler/term_norm.m 20 Aug 2007 03:36:06 -0000 1.25
+++ compiler/term_norm.m 24 Sep 2007 06:39:27 -0000
@@ -147,7 +147,7 @@
find_weights_for_type(TypeCtor - TypeDefn, !Weights) :-
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
(
- TypeBody = hlds_du_type(Constructors, _, _, _, _, _),
+ TypeBody = hlds_du_type(Constructors, _, _, _, _, _, _),
hlds_data.get_type_defn_tparams(TypeDefn, TypeParams),
list.foldl(find_weights_for_cons(TypeCtor, TypeParams),
Constructors, !Weights)
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.91
diff -u -r1.91 type_ctor_info.m
--- compiler/type_ctor_info.m 11 Sep 2007 03:12:34 -0000 1.91
+++ compiler/type_ctor_info.m 24 Sep 2007 07:21:56 -0000
@@ -361,7 +361,7 @@
Details = eqv(MaybePseudoTypeInfo)
;
TypeBody = hlds_du_type(Ctors, ConsTagMap, EnumDummy,
- MaybeUserEqComp, ReservedTag, _),
+ MaybeUserEqComp, ReservedTag, ReservedAddr, _),
(
MaybeUserEqComp = yes(_),
EqualityAxioms = user_defined
@@ -370,8 +370,8 @@
EqualityAxioms = standard
),
(
- EnumDummy = is_enum,
- make_enum_details(Ctors, ConsTagMap, ReservedTag,
+ EnumDummy = is_mercury_enum,
+ make_mercury_enum_details(Ctors, ConsTagMap, ReservedTag,
EqualityAxioms, Details)
;
EnumDummy = is_foreign_enum(Lang),
@@ -379,7 +379,7 @@
EqualityAxioms, Details)
;
EnumDummy = is_dummy,
- make_enum_details(Ctors, ConsTagMap, ReservedTag,
+ make_mercury_enum_details(Ctors, ConsTagMap, ReservedTag,
EqualityAxioms, Details)
;
EnumDummy = not_enum_or_dummy,
@@ -392,19 +392,20 @@
EqualityAxioms, Details)
;
make_du_details(Ctors, ConsTagMap, TypeArity,
- EqualityAxioms, ModuleInfo, Details)
+ EqualityAxioms, ReservedAddr, ModuleInfo, Details)
)
)
)
),
some [!Flags] (
!:Flags = set.init,
- ( TypeBody = hlds_du_type(_, _, _, _, _, _) ->
+ ( TypeBody = hlds_du_type(_, _, _, _, BodyReservedTag, _, _) ->
svset.insert(kind_of_du_flag, !Flags),
- ( TypeBody ^ du_type_reserved_tag = yes ->
+ (
+ BodyReservedTag = uses_reserved_tag,
svset.insert(reserve_tag_flag, !Flags)
;
- true
+ BodyReservedTag = does_not_use_reserved_tag
)
;
true
@@ -569,15 +570,16 @@
% Make the functor and layout tables for an enum type.
%
-:- pred make_enum_details(list(constructor)::in, cons_tag_values::in, bool::in,
- equality_axioms::in, type_ctor_details::out) is det.
+:- pred make_mercury_enum_details(list(constructor)::in, cons_tag_values::in,
+ uses_reserved_tag::in, equality_axioms::in, type_ctor_details::out) is det.
-make_enum_details(Ctors, ConsTagMap, ReserveTag, EqualityAxioms, Details) :-
+make_mercury_enum_details(Ctors, ConsTagMap, ReserveTag, EqualityAxioms,
+ Details) :-
(
- ReserveTag = yes,
+ ReserveTag = uses_reserved_tag,
unexpected(this_file, "enum with reserved tag")
;
- ReserveTag = no
+ ReserveTag = does_not_use_reserved_tag
),
make_enum_functors(Ctors, 0, ConsTagMap, EnumFunctors),
ValueMap0 = map.init,
@@ -591,7 +593,7 @@
),
FunctorNumberMap = make_functor_number_map(Ctors),
Details = enum(EqualityAxioms, EnumFunctors, ValueMap, NameMap, IsDummy,
- FunctorNumberMap).
+ FunctorNumberMap).
% Create an enum_functor structure for each functor in an enum type.
% The functors are given to us in ordinal order (since that's how the HLDS
@@ -637,16 +639,16 @@
% Make the functor and layout tables for a foreign enum type.
%
:- pred make_foreign_enum_details(foreign_language::in, list(constructor)::in,
- cons_tag_values::in, bool::in, equality_axioms::in,
+ cons_tag_values::in, uses_reserved_tag::in, equality_axioms::in,
type_ctor_details::out) is det.
make_foreign_enum_details(Lang, Ctors, ConsTagMap, ReserveTag, EqualityAxioms,
Details) :-
(
- ReserveTag = yes,
+ ReserveTag = uses_reserved_tag,
unexpected(this_file, "foreign enum with reserved tag")
;
- ReserveTag = no
+ ReserveTag = does_not_use_reserved_tag
),
make_foreign_enum_functors(Lang, Ctors, 0, ConsTagMap,
ForeignEnumFunctors),
@@ -729,10 +731,11 @@
% (including reserved_addr types).
%
:- 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.
+ equality_axioms::in, uses_reserved_address::in, module_info::in,
+ type_ctor_details::out) is det.
-make_du_details(Ctors, ConsTagMap, TypeArity, EqualityAxioms, ModuleInfo,
- Details) :-
+make_du_details(Ctors, ConsTagMap, TypeArity, EqualityAxioms, ReservedAddr,
+ ModuleInfo, Details) :-
make_maybe_res_functors(Ctors, 0, ConsTagMap, TypeArity, ModuleInfo,
MaybeResFunctors),
DuFunctors = list.filter_map(is_du_functor, MaybeResFunctors),
@@ -742,12 +745,16 @@
FunctorNumberMap = make_functor_number_map(Ctors),
(
ResFunctors = [],
+ expect(unify(ReservedAddr, does_not_use_reserved_address), this_file,
+ "make_du_details: ReservedAddr is not does_not_use_reserved_addr"),
list.foldl(make_du_name_ordered_table, DuFunctors,
map.init, DuNameOrderedMap),
Details = du(EqualityAxioms, DuFunctors, DuPtagTable, DuNameOrderedMap,
- FunctorNumberMap)
+ FunctorNumberMap)
;
ResFunctors = [_ | _],
+ expect(unify(ReservedAddr, uses_reserved_address), this_file,
+ "make_du_details: ReservedAddr is not uses_reserved_addr"),
list.foldl(make_res_name_ordered_table, MaybeResFunctors,
map.init, ResNameOrderedMap),
Details = reserved(EqualityAxioms, MaybeResFunctors,
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.182
diff -u -r1.182 type_util.m
--- compiler/type_util.m 11 Sep 2007 03:12:34 -0000 1.182
+++ compiler/type_util.m 24 Sep 2007 07:23:44 -0000
@@ -389,7 +389,7 @@
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
- TypeBody = hlds_du_type(_, _, _, _, _, _),
+ TypeBody = hlds_du_type(_, _, _, _, _, _, _),
(
TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
@@ -451,7 +451,7 @@
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
- TypeBody = hlds_du_type(_, _, _, _, _, _),
+ TypeBody = hlds_du_type(_, _, _, _, _, _, _),
(
TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
@@ -575,7 +575,7 @@
; Name = "typeclass_info"
; Name = "base_typeclass_info"
),
- \+ ( Body = hlds_du_type(_, _, _, _, _, yes(_))
+ \+ ( Body = hlds_du_type(_, _, _, _, _, _, yes(_))
; Body = hlds_foreign_type(_)
; Body = hlds_solver_type(_, _)
).
@@ -640,38 +640,22 @@
TypeCategory = type_cat_higher_order
; type_ctor_is_tuple(TypeCtor) ->
TypeCategory = type_cat_tuple
- ; type_ctor_is_enumeration(TypeCtor, ModuleInfo) ->
- TypeCategory = type_cat_enum
- ; type_ctor_is_foreign_enumeration(TypeCtor, ModuleInfo) ->
- TypeCategory = type_cat_foreign_enum
;
- TypeCategory = type_cat_user_ctor
+ module_info_get_type_table(ModuleInfo, TypeDefnTable),
+ map.lookup(TypeDefnTable, TypeCtor, TypeDefn),
+ hlds_data.get_type_defn_body(TypeDefn, TypeBody),
+ ( TypeBody ^ du_type_is_enum = is_mercury_enum ->
+ TypeCategory = type_cat_enum
+ ; TypeBody ^ du_type_is_enum = is_foreign_enum(_) ->
+ TypeCategory = type_cat_foreign_enum
+ ;
+ TypeCategory = type_cat_user_ctor
+ )
)
).
%-----------------------------------------------------------------------------%
-:- pred type_ctor_is_enumeration(type_ctor::in, module_info::in) is semidet.
-
-type_ctor_is_enumeration(TypeCtor, ModuleInfo) :-
- module_info_get_type_table(ModuleInfo, TypeDefnTable),
- map.search(TypeDefnTable, TypeCtor, TypeDefn),
- hlds_data.get_type_defn_body(TypeDefn, TypeBody),
- TypeBody ^ du_type_is_enum = is_enum.
-
-%-----------------------------------------------------------------------------%
-
-:- pred type_ctor_is_foreign_enumeration(type_ctor::in, module_info::in)
- is semidet.
-
-type_ctor_is_foreign_enumeration(TypeCtor, ModuleInfo) :-
- module_info_get_type_table(ModuleInfo, TypeDefnTable),
- map.search(TypeDefnTable, TypeCtor, TypeDefn),
- get_type_defn_body(TypeDefn, TypeBody),
- TypeBody ^ du_type_is_enum = is_foreign_enum(_).
-
-%-----------------------------------------------------------------------------%
-
update_type_may_use_atomic_alloc(ModuleInfo, Type, !MayUseAtomic) :-
(
!.MayUseAtomic = may_not_use_atomic_alloc
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.192
diff -u -r1.192 unify_proc.m
--- compiler/unify_proc.m 11 Sep 2007 03:12:35 -0000 1.192
+++ compiler/unify_proc.m 24 Sep 2007 07:08:37 -0000
@@ -540,8 +540,8 @@
MakeUnamedField = (func(ArgType) = ctor_arg(no, ArgType, Context)),
CtorArgs = list.map(MakeUnamedField, TupleArgTypes),
- Ctor = ctor(ExistQVars,
- ClassConstraints, CtorSymName, CtorArgs, Context),
+ Ctor = ctor(ExistQVars, ClassConstraints, CtorSymName, CtorArgs,
+ Context),
CtorSymName = unqualified("{}"),
ConsId = cons(CtorSymName, TupleArity),
@@ -549,10 +549,11 @@
UnifyPred = no,
IsEnum = not_enum_or_dummy,
IsForeign = no,
- ReservedTag = no,
+ ReservedTag = does_not_use_reserved_tag,
+ ReservedAddr = does_not_use_reserved_address,
IsForeign = no,
TypeBody = hlds_du_type([Ctor], ConsTagValues, IsEnum, UnifyPred,
- ReservedTag, IsForeign),
+ ReservedTag, ReservedAddr, IsForeign),
construct_type(TypeCtor, TupleArgTypes, Type),
term.context_init(Context)
@@ -778,10 +779,10 @@
Clause, !Info)
;
(
- TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _),
+ TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _, _),
(
- ( EnumDummy = is_foreign_enum(_)
- ; EnumDummy = is_enum
+ ( EnumDummy = is_mercury_enum
+ ; EnumDummy = is_foreign_enum(_)
),
make_simple_test(X, Y, umc_explicit, [], Goal),
quantify_clause_body([X, Y], Goal, Context, Clause, !Info)
@@ -986,13 +987,13 @@
"trying to create index proc for non-canonical type")
;
(
- TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _),
+ TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _, _),
(
% For enum types, the generated comparison predicate performs
% an integer comparison, and does not call the type's index
% predicate, so do not generate an index predicate for such
% types.
- EnumDummy = is_enum,
+ EnumDummy = is_mercury_enum,
unexpected(this_file,
"trying to create index proc for enum type")
;
@@ -1052,9 +1053,9 @@
Res, X, Y, Context, Clause, !Info)
;
(
- TypeBody = hlds_du_type(Ctors0, _, EnumDummy, _, _, _),
+ TypeBody = hlds_du_type(Ctors0, _, EnumDummy, _, _, _, _),
(
- ( EnumDummy = is_enum
+ ( EnumDummy = is_mercury_enum
; EnumDummy = is_foreign_enum(_)
),
generate_enum_compare_proc_body(Res, X, Y, Context, Clause,
Index: compiler/unused_imports.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unused_imports.m,v
retrieving revision 1.10
diff -u -r1.10 unused_imports.m
--- compiler/unused_imports.m 17 May 2007 03:52:56 -0000 1.10
+++ compiler/unused_imports.m 24 Sep 2007 06:39:27 -0000
@@ -195,7 +195,7 @@
( status_defined_in_this_module(ImportStatus) = yes ->
Visibility = item_visibility(ImportStatus),
(
- TypeBody = hlds_du_type(Ctors, _, _, _, _, _),
+ TypeBody = hlds_du_type(Ctors, _, _, _, _, _, _),
list.foldl(ctor_used_modules(Visibility), Ctors, !UsedModules)
;
TypeBody = hlds_eqv_type(EqvType),
Index: compiler/xml_documentation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/xml_documentation.m,v
retrieving revision 1.16
diff -u -r1.16 xml_documentation.m
--- compiler/xml_documentation.m 23 May 2007 10:09:23 -0000 1.16
+++ compiler/xml_documentation.m 24 Sep 2007 06:39:27 -0000
@@ -367,7 +367,7 @@
:- func type_xml_tag(hlds_type_body) = string.
-type_xml_tag(hlds_du_type(_, _, _, _, _, _)) = "du_type".
+type_xml_tag(hlds_du_type(_, _, _, _, _, _, _)) = "du_type".
type_xml_tag(hlds_eqv_type(_)) = "eqv_type".
type_xml_tag(hlds_foreign_type(_)) = "foreign_type".
type_xml_tag(hlds_solver_type(_, _)) = "solver_type".
@@ -381,7 +381,7 @@
:- func type_body(comments, tvarset, hlds_type_body) = list(xml).
-type_body(C, TVarset, hlds_du_type(Ctors, _, _, _, _, _)) =
+type_body(C, TVarset, hlds_du_type(Ctors, _, _, _, _, _, _)) =
[xml_list("constructors", constructor(C, TVarset), Ctors)].
type_body(_, TVarset, hlds_eqv_type(Type)) =
[elem("equivalent_type", [], [mer_type(TVarset, Type)])].
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/base64
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/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
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/log4m
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/mopenssl
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/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
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/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
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
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
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/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
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/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
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 messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list