[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