[m-rev.] diff: fix foreign enumerations and `--high-level-data'

[Julien Fischer]

Estimated hours taken: 4
Branches: main

Fix a bug where foreign enumerations were causing ml_type_gen to abort
when `--high-level-data' was enabled.

Fix another bug where mlds_to_c was emitting the wrong type for
function arguments that have a foreign enumeration type.  This also only
shows up when `--high-level-data' is enabled.

compiler/ml_type_gen.m:
 	Handle foreign tags when generating MLDS classes for enumerations.

compiler/mlds_to_c.m:
 	Emit `MR_Integer' as the corresponding C type for foreign enumerations
 	rather than the high-level data type for them.  (This is what we
 	do for normal enumerations, see the comment at mlds_to_c.m:2182 for
 	an explanation.)

 	Replace some if-then-elses with switches.

 	s/contstant/constant/

compiler/mlds.m:
 	Delete the comment about not switching on the type mlds_type/0.
 	(Not switching on types like this means the compiler cannot warn
 	us about bugs like the two above.)

Julien.

Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.68
diff -u -r1.68 ml_type_gen.m
--- compiler/ml_type_gen.m	21 Aug 2007 15:50:41 -0000	1.68
+++ compiler/ml_type_gen.m	30 Aug 2007 18:11:15 -0000
@@ -75,7 +75,6 @@
      %
  :- pred ml_tag_uses_base_class(cons_tag::in) is semidet.

-
      % Exported enumeration info in the HLDS is converted into an MLDS
      % specific representation.  The target specific code generators may
      % further transform it.
@@ -247,11 +246,32 @@
      Ctor = ctor(_ExistQTVars, _Constraints, Name, Args, _Ctxt),
      list.length(Args, Arity),
      map.lookup(ConsTagValues, cons(Name, Arity), TagVal),
-    ( TagVal = int_tag(Int) ->
+    (
+        TagVal = int_tag(Int),
          ConstValue = const(mlconst_int(Int))
      ;
+        TagVal = foreign_tag(ForeignTagValue),
+        ConstValue = const(mlconst_foreign(ForeignTagValue,
+            mlds_native_int_type))
+    ;
+        ( TagVal = string_tag(_)
+        ; TagVal = float_tag(_)
+        ; TagVal = pred_closure_tag(_, _, _)
+        ; TagVal = type_ctor_info_tag(_, _, _)
+        ; TagVal = base_typeclass_info_tag(_, _, _)
+        ; TagVal = tabling_info_tag(_, _)
+        ; TagVal = deep_profiling_proc_layout_tag(_, _)
+        ; TagVal = table_io_decl_tag(_, _)
+        ; TagVal = single_functor_tag
+        ; TagVal = unshared_tag(_)
+        ; TagVal = shared_remote_tag(_, _)
+        ; TagVal = shared_local_tag(_, _)
+        ; TagVal = no_tag
+        ; TagVal = reserved_address_tag(_)
+        ; TagVal = shared_with_reserved_addresses_tag(_, _)
+        ),
          unexpected(this_file,
-            "ml_gen_enum_constant: enum constant needs int tag")
+            "ml_gen_enum_constant: enum constant needs int or foreign tag")
      ),
      % Sanity check.
      expect(unify(Arity, 0), this_file,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.154
diff -u -r1.154 mlds.m
--- compiler/mlds.m	21 Aug 2007 17:40:32 -0000	1.154
+++ compiler/mlds.m	30 Aug 2007 18:11:15 -0000
@@ -694,9 +694,6 @@
                              % Contains these members.
              ).

-    % Note: the definition of the `mlds_type' type is subject to change.
-    % In particular, we might add new alternatives here, so try to avoid
-    % switching on this type.
  :- type mlds_type
      --->    mercury_type(
                  % Mercury data types
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.223
diff -u -r1.223 mlds_to_c.m
--- compiler/mlds_to_c.m	21 Aug 2007 17:40:33 -0000	1.223
+++ compiler/mlds_to_c.m	30 Aug 2007 18:11:15 -0000
@@ -1257,7 +1257,7 @@
          )
      ;
          unexpected(this_file,
-            "exported enumeration contstant is not mlds_data")
+            "exported enumeration constant is not mlds_data")
      ),
      io.nl(!IO).

@@ -1496,7 +1496,7 @@
      mlds_class_defn::in, io::di, io::uo) is det.

  mlds_output_class_decl(_Indent, Name, ClassDefn, !IO) :-
-    ( ClassDefn^kind = mlds_enum ->
+    ( ClassDefn ^ kind = mlds_enum ->
          io.write_string("enum ", !IO),
          mlds_output_fully_qualified_name(Name, !IO),
          io.write_string("_e", !IO)
@@ -1573,10 +1573,16 @@

      mlds_output_class_decl(Indent, Name, ClassDefn, !IO),
      io.write_string(" {\n", !IO),
-    ( Kind = mlds_enum ->
+    (
+        Kind = mlds_enum,
          mlds_output_enum_constants(Indent + 1, ClassModuleName,
              BasesAndMembers, !IO)
      ;
+        ( Kind = mlds_class
+        ; Kind = mlds_package
+        ; Kind = mlds_interface
+        ; Kind = mlds_struct
+        ),
          mlds_output_defns(Indent + 1, no, ClassModuleName,
              BasesAndMembers, !IO)
      ),
@@ -2171,7 +2177,8 @@
      % use of the C type name
      io.write_string("MR_Box", !IO).
  mlds_output_type_prefix(mlds_class_type(Name, Arity, ClassKind), !IO) :-
-    ( ClassKind = mlds_enum ->
+    (
+        ClassKind = mlds_enum,
          % We can't just use the enumeration type, since the enumeration type's
          % definition is not guaranteed to be in scope at this point. (Fixing
          % that would be somewhat complicated; it would require writing enum
@@ -2179,12 +2186,16 @@
          % not be word-sized, which would cause problems for e.g.
          % `std_util.arg/2'. So we just use `MR_Integer', and output the
          % actual enumeration type as a comment.
-
          io.write_string("MR_Integer /* actually `enum ", !IO),
          mlds_output_fully_qualified(Name, mlds_output_mangled_name, !IO),
          io.format("_%d_e", [i(Arity)], !IO),
          io.write_string("' */", !IO)
      ;
+        ( ClassKind = mlds_class
+        ; ClassKind = mlds_package
+        ; ClassKind = mlds_interface
+        ; ClassKind = mlds_struct
+        ),
          % For struct types it's OK to output an incomplete type,
          % since don't use these types directly, we only use pointers to them.
          io.write_string("struct ", !IO),
@@ -2329,9 +2340,27 @@

  mlds_output_mercury_user_type_name(TypeCtor, TypeCategory, !IO) :-
      ml_gen_type_name(TypeCtor, ClassName, ClassArity),
-    ( TypeCategory = type_cat_enum ->
+    (
+        ( TypeCategory = type_cat_enum 
+        ; TypeCategory = type_cat_foreign_enum
+        ),
          MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_enum)
      ;
+        ( TypeCategory = type_cat_int
+        ; TypeCategory = type_cat_char
+        ; TypeCategory = type_cat_string
+        ; TypeCategory = type_cat_float
+        ; TypeCategory = type_cat_higher_order
+        ; TypeCategory = type_cat_tuple
+        ; TypeCategory = type_cat_dummy
+        ; TypeCategory = type_cat_variable
+        ; TypeCategory = type_cat_type_info
+        ; TypeCategory = type_cat_type_ctor_info
+        ; TypeCategory = type_cat_typeclass_info
+        ; TypeCategory = type_cat_base_typeclass_info
+        ; TypeCategory = type_cat_void
+        ; TypeCategory = type_cat_user_ctor
+        ),
          MLDS_Type = mlds_ptr_type(
              mlds_class_type(ClassName, ClassArity, mlds_class))
      ),




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