[m-rev.] diff: add option for debugging type representation choices

Julien Fischer juliensf at csse.unimelb.edu.au
Mon Nov 21 15:56:23 AEDT 2011


Branches: main

Add a new option, --debug-type-rep, that causes the compiler to print a summary
of its type representation choices.  At the moment this is restricted to
printing a summary (per module) of those types to which the direct arg functor
optimisation is applied.  In particular, the new option is useful for checking
that each module chooses to represent each type in the same way.  (I needed
this capability when isolating bug #233.)

compiler/options.m:
 	Add the new option.

compiler/make_tags.m:
 	If --debug-type-rep is enabled, the print a summary of those types
 	(and which ctors) the direct arg functor optimisation is applied to.

 	Reformat the comments at the head of this module.

doc/user_guide.texi:
 	Document the new option.

Julien.

Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.66
diff -u -r1.66 make_tags.m
--- compiler/make_tags.m	25 Jul 2011 03:32:07 -0000	1.66
+++ compiler/make_tags.m	21 Nov 2011 04:49:00 -0000
@@ -9,50 +9,43 @@
  % File: make_tags.m.
  % Main author: fjh.
  %
-% This module is where we determine the representation for
-% discriminated union types.  Each d.u. type is represented as
-% a word.  In the case of functors with arguments, we allocate
-% the arguments on the heap, and the word contains a pointer to
-% those arguments.
+% This module is where we determine the representation for discriminated union
+% types.  Each d.u. type is represented as a word.  In the case of functors
+% with arguments, we allocate the arguments on the heap, and the word contains
+% a pointer to those arguments.
  %
-% For types which are just enumerations (all the constructors
-% are constants), we just assign a different value for each
-% constructor.
+% For types which are just enumerations (all the constructors are constants),
+% we just assign a different value for each constructor.
  %
-% For types which have only one functor of arity one, there is
-% no need to store the functor, and we just store the argument
-% value directly; construction and deconstruction unifications
-% on these type are no-ops.
+% For types which have only one functor of arity one, there is no need to store
+% the functor, and we just store the argument value directly; construction and
+% deconstruction unifications on these type are no-ops.
  %
-% For other types, we use a couple of bits of the word as a
-% tag.  We split the constructors into constants and functors,
-% and assign tag zero to the constants (if any).  If there is
-% more than one constant, we distinguish between the different
-% constants by the value of the rest of the word.  Then we
-% assign one tag bit each to the first few functors.  The
-% remaining functors all get the last remaining two-bit tag.
-% These functors are distinguished by a secondary tag which is
-% the first word of the argument vector for those functors.
+% For other types, we use a couple of bits of the word as a tag.  We split the
+% constructors into constants and functors, and assign tag zero to the
+% constants (if any).  If there is more than one constant, we distinguish
+% between the different constants by the value of the rest of the word.  Then
+% we assign one tag bit each to the first few functors.  The remaining functors
+% all get the last remaining two-bit tag.  These functors are distinguished by
+% a secondary tag which is the first word of the argument vector for those
+% functors.
  %
-% If there are no tag bits available, then we try using reserved
-% addresses (e.g. NULL, (void *)1, (void *)2, etc.) instead.
-% We split the constructors into constants and functors,
-% and assign numerical reserved addresses to the first constants,
-% up to the limit set by --num-reserved-addresses.
-% After that, for the MLDS back-end, we assign symbolic reserved
-% addresses to the remaining constants, up to the limit set by
-% --num-reserved-objects; these symbolic reserved addresses
-% are the addresses of global variables that we generate specially
-% for this purpose.  Finally, the functors and any remaining
-% constants are distinguished by a secondary tag, if there are more
-% than one of them.
+% If there are no tag bits available, then we try using reserved addresses
+% (e.g. NULL, (void *)1, (void *)2, etc.) instead.  We split the constructors
+% into constants and functors, and assign numerical reserved addresses to the
+% first constants, up to the limit set by --num-reserved-addresses.  After
+% that, for the MLDS back-end, we assign symbolic reserved addresses to the
+% remaining constants, up to the limit set by --num-reserved-objects; these
+% symbolic reserved addresses are the addresses of global variables that we
+% generate specially for this purpose.  Finally, the functors and any remaining
+% constants are distinguished by a secondary tag, if there are more than one of
+% them.
  %
-% If there is a `pragma reserve_tag' declaration for the type,
-% or if the `--reserve-tag' option is set,
-% then we reserve the first primary tag (for representing
-% unbound variables).  This is used by HAL, for Herbrand constraints
-% (i.e. Prolog-style logic variables).
-% This also disables enumerations and no_tag types.
+% If there is a `pragma reserve_tag' declaration for the type, or if the
+% `--reserve-tag' option is set, then we reserve the first primary tag (for
+% representing unbound variables).  This is used by HAL, for Herbrand
+% constraints (i.e. Prolog-style logic variables).  This also disables
+% enumerations and no_tag types.
  %
  %-----------------------------------------------------------------------------%

@@ -105,14 +98,18 @@
  :- implementation.

  :- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_out.
+:- import_module hlds.hlds_out.hlds_out_util.
  :- import_module libs.globals.
  :- import_module libs.options.
  :- import_module mdbcomp.prim_data.
  :- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_out.

  :- import_module assoc_list.
  :- import_module bool.
  :- import_module int.
+:- import_module io.
  :- import_module map.
  :- import_module pair.
  :- import_module require.
@@ -445,11 +442,13 @@
              TermSizeCells = no
          ->
              module_info_get_type_table(!.HLDS, TypeTable0),
+            module_info_get_name(!.HLDS, ModuleName),
              get_all_type_ctor_defns(TypeTable0, TypeCtorsDefns),
              globals.lookup_int_option(Globals, num_tag_bits, NumTagBits),
+            globals.lookup_bool_option(Globals, debug_type_rep, DebugTypeRep),
              MaxTag = max_num_tags(NumTagBits) - 1,
-            convert_direct_arg_functors(MaxTag, TypeCtorsDefns,
-                TypeTable0, TypeTable, [], Specs),
+            convert_direct_arg_functors(ModuleName, DebugTypeRep, MaxTag,
+                TypeCtorsDefns, TypeTable0, TypeTable, [], Specs),
              module_info_set_type_table(TypeTable, !HLDS)
          ;
              % We cannot use direct arg functors in term size grades.
@@ -467,24 +466,25 @@
          Specs = []
      ).

-:- pred convert_direct_arg_functors(int::in,
+:- pred convert_direct_arg_functors(module_name::in, bool::in, int::in,
      assoc_list(type_ctor, hlds_type_defn)::in, type_table::in, type_table::out,
      list(error_spec)::in, list(error_spec)::out) is det.

-convert_direct_arg_functors(_, [], !TypeTable, !Specs).
-convert_direct_arg_functors(MaxTag, [TypeCtor - TypeDefn | TypeCtorsDefns],
-        !TypeTable, !Specs) :-
-    convert_direct_arg_functors_if_suitable(MaxTag, TypeCtor, TypeDefn,
-        !TypeTable, !Specs),
-    convert_direct_arg_functors(MaxTag, TypeCtorsDefns,
-        !TypeTable, !Specs).
+convert_direct_arg_functors(_, _, _, [], !TypeTable, !Specs).
+convert_direct_arg_functors(ModuleName, DebugTypeRep, MaxTag,
+        [TypeCtorDefn | TypeCtorsDefns], !TypeTable, !Specs) :-
+    TypeCtorDefn = TypeCtor - TypeDefn,
+    convert_direct_arg_functors_if_suitable(ModuleName, DebugTypeRep, MaxTag,
+        TypeCtor, TypeDefn, !TypeTable, !Specs),
+    convert_direct_arg_functors(ModuleName, DebugTypeRep, MaxTag,
+        TypeCtorsDefns, !TypeTable, !Specs).

-:- pred convert_direct_arg_functors_if_suitable(int::in,
-    type_ctor::in, hlds_type_defn::in, type_table::in, type_table::out,
+:- pred convert_direct_arg_functors_if_suitable(module_name::in, bool::in,
+    int::in, type_ctor::in, hlds_type_defn::in, type_table::in, type_table::out,
      list(error_spec)::in, list(error_spec)::out) is det.

-convert_direct_arg_functors_if_suitable(MaxTag, TypeCtor, TypeDefn,
-        !TypeTable, !Specs) :-
+convert_direct_arg_functors_if_suitable(ModuleName, DebugTypeRep, MaxTag,
+        TypeCtor, TypeDefn, !TypeTable, !Specs) :-
      get_type_defn_body(TypeDefn, Body),
      (
          Body = hlds_du_type(Ctors, _ConsTagValues, _MaybeCheaperTagTest,
@@ -543,6 +543,15 @@
                  DirectArgFunctorNames =
                      list.map(constructor_to_sym_name_and_arity,
                      DirectArgFunctors),
+                (
+                    DebugTypeRep = yes,
+                    trace [io(!IO)] (
+                        output_direct_arg_functor_summary(ModuleName, TypeCtor,
+                            DirectArgFunctorNames, !IO) 
+                    )
+                ;
+                    DebugTypeRep = no
+                ),
                  DirectArgBody = hlds_du_type(Ctors, DirectArgConsTagValues,
                      MaybeCheaperTagTest, DuKind, MaybeUserEqComp,
                      yes(DirectArgFunctorNames), ReservedTag, ReservedAddr,
@@ -584,7 +593,7 @@
          % Trust the `direct_arg' attribute of an imported type.
          status_is_imported(TypeStatus) = yes,
          list.contains(AssertedDirectArgCtors, ConsName / Arity)
-    ->
+    ->
          ArgCond = direct_arg_asserted
      ;
          % Tuples are always acceptable argument types as they are represented
@@ -623,9 +632,9 @@
          (
              status_defined_in_this_module(TypeStatus) = yes,
              list.contains(AssertedDirectArgCtors, ConsName / Arity)
-        ->
+        ->
              ArgCond = direct_arg_asserted
-        ;
+        ;
              ArgTypeCtor = type_ctor(ArgTypeCtorSymName, _ArgTypeCtorArity),
              sym_name_get_module_name(ArgTypeCtorSymName, ArgTypeCtorModule),
              ( TypeCtorModule = ArgTypeCtorModule ->
@@ -636,7 +645,6 @@
              )
          )
      ),
-
      check_direct_arg_cond(TypeStatus, ArgCond).

  :- type direct_arg_cond
@@ -766,6 +774,18 @@
  constructor_to_sym_name_and_arity(ctor(_, _, Name, Args, _)) =
      Name / list.length(Args).

+:- pred output_direct_arg_functor_summary(module_name::in, type_ctor::in,
+    list(sym_name_and_arity)::in, io::di, io::uo) is det.
+
+output_direct_arg_functor_summary(ModuleName, TypeCtor, DirectArgFunctorNames,
+        !IO) :-
+    write_sym_name(ModuleName, !IO),
+    io.write_string(" : ", !IO),
+    write_type_ctor(TypeCtor, !IO),
+    io.write_string(" : ", !IO),
+    io.write_list(DirectArgFunctorNames, ", ", write_sym_name_and_arity, !IO),
+    io.nl(!IO).
+
  %-----------------------------------------------------------------------------%
  %
  % Auxiliary functions and predicates.
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.708
diff -u -r1.708 options.m
--- compiler/options.m	8 Nov 2011 02:22:42 -0000	1.708
+++ compiler/options.m	21 Nov 2011 04:47:57 -0000
@@ -180,6 +180,7 @@
      ;       debug_intermodule_analysis
      ;       debug_mm_tabling_analysis
      ;       debug_indirect_reuse
+    ;       debug_type_rep

      % Output options
      ;       make_short_interface
@@ -1161,7 +1162,8 @@
      debug_mode_constraints              -   bool(no),
      debug_intermodule_analysis          -   bool(no),
      debug_mm_tabling_analysis           -   bool(no),
-    debug_indirect_reuse                -   bool(no)
+    debug_indirect_reuse                -   bool(no),
+    debug_type_rep                      -   bool(no)
  ]).
  option_defaults_2(output_option, [
      % Output Options (mutually exclusive)
@@ -2032,6 +2034,7 @@
  long_option("debug-intermodule-analysis",   debug_intermodule_analysis).
  long_option("debug-mm-tabling-analysis",    debug_mm_tabling_analysis).
  long_option("debug-indirect-reuse",         debug_indirect_reuse).
+long_option("debug-type-rep",               debug_type_rep).

  % output options (mutually exclusive)
  long_option("generate-source-file-mapping", generate_source_file_mapping).
@@ -3683,7 +3686,9 @@
          "\toption.",
          "--debug-indirect-reuse",
          "\tOutput detailed debugging traces of the indirect reuse pass of",
-        "\t`--structure-reuse' option."
+        "\t`--structure-reuse' option.",
+        "--debug-type-rep",
+        "\tOutput debugging traces of type representation choices."
  % The mode constraints code is still experimental so this option is
  % currently commented out.
  %         "--debug-mode-constraints",
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.642
diff -u -r1.642 user_guide.texi
--- doc/user_guide.texi	8 Nov 2011 23:19:49 -0000	1.642
+++ doc/user_guide.texi	21 Nov 2011 04:50:19 -0000
@@ -6771,6 +6771,11 @@
  Output detailed debugging traces of the indirect reuse pass of
  `--structure-reuse' option.

+ at sp 1
+ at item --debug-type-rep
+ at findex --debug-type-rep
+Output debugging traces of type representation choices.
+
  @end table

  @node Output options

--------------------------------------------------------------------------
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