[m-dev.] .NET back-end test results

[Peter Ross]

fjh wrote:
> B3
> - tests/general/interpreter fails, due to problem with equivalence types;
>   the argument types for the unify & compare predicates for equivalence
types
>   are invalid (undefined)
>   Likewise for lots of others (FAILED.UNDEFINED_CLASS)
>

This is the start of my fix for the problem B3 (FAILED.UNDEFINED)
class by trying to expand out the equivalence types for the special
predicates when producing the special predicates.

Anyone see problems with this approach or can think of another
approach?

Index: make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.425
diff -u -r1.425 make_hlds.m
--- make_hlds.m 24 Oct 2002 04:36:45 -0000 1.425
+++ make_hlds.m 6 Nov 2002 16:33:55 -0000
@@ -3520,8 +3520,10 @@
    Module0, TVarSet, Type, TypeCtor, Context, Status0,
    Module) :-
  module_info_name(Module0, ModuleName),
+ module_info_types(Module0, TypeTable),
  PredName = unqualified(Name),
- special_pred_info(SpecialPredId, Type, Name, ArgTypes, ArgModes, Det),
+ special_pred_info(TypeTable, SpecialPredId,
+   Type, Name, ArgTypes, ArgModes, Det),
  special_pred_name_arity(SpecialPredId, _, _, Arity),
  Cond `with_type` condition = true,
  clauses_info_init(Arity, ClausesInfo0),
Index: special_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/special_pred.m,v
retrieving revision 1.33
diff -u -r1.33 special_pred.m
--- special_pred.m 30 Jun 2002 17:06:40 -0000 1.33
+++ special_pred.m 6 Nov 2002 16:33:57 -0000
@@ -33,9 +33,9 @@
  % unification is actually `det', however we need to pretend it
  % is `semidet' so that it can be called correctly from the
  % polymorphic `unify' procedure.
-:- pred special_pred_info(special_pred_id, type, string, list(type),
+:- pred special_pred_info(type_table, special_pred_id, type, string,
list(type),
    list(mode), determinism).
-:- mode special_pred_info(in, in, out, out, out, out) is det.
+:- mode special_pred_info(in, in, in, out, out, out, out) is det.

  % special_pred_name_arity(SpecialPredType, GenericPredName,
  %  TypeSpecificVersionPredName, Arity):
@@ -119,16 +119,21 @@
  % mode num for special procs is always 0 (the first mode)
 special_pred_mode_num(_, 0).

-special_pred_info(unify, Type, "__Unify__", [Type, Type], [In, In],
semidet) :-
+special_pred_info(TypeTable, unify, Type, "__Unify__",
+  [ExpandedType, ExpandedType], [In, In], semidet) :-
+ ExpandedType = expand_equivalence_type(TypeTable, Type),
  in_mode(In).

-special_pred_info(index, Type, "__Index__", [Type, IntType], [In, Out],
det) :-
+special_pred_info(TypeTable, index, Type, "__Index__",
+  [ExpandedType, IntType], [In, Out], det) :-
+ ExpandedType = expand_equivalence_type(TypeTable, Type),
  construct_type(unqualified("int") - 0, [], IntType),
  in_mode(In),
  out_mode(Out).

-special_pred_info(compare, Type,
-   "__Compare__", [ResType, Type, Type], [Uo, In, In], det) :-
+special_pred_info(TypeTable, compare, Type, "__Compare__",
+  [ResType, ExpandedType, ExpandedType], [Uo, In, In], det) :-
+ ExpandedType = expand_equivalence_type(TypeTable, Type),
  mercury_public_builtin_module(PublicBuiltin),
  construct_type(qualified(PublicBuiltin, "comparison_result") - 0,
        [], ResType),
Index: type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.109
diff -u -r1.109 type_util.m
--- type_util.m 1 Nov 2002 07:06:59 -0000 1.109
+++ type_util.m 6 Nov 2002 16:33:58 -0000
@@ -468,6 +468,9 @@
 :- pred get_unconstrained_tvars(list(tvar), list(class_constraint),
list(tvar)).
 :- mode get_unconstrained_tvars(in, in, out) is det.

+ % Expand an equivalence type into its base representation.
+:- func expand_equivalence_type(type_table, (type)) = (type).
+

%---------------------------------------------------------------------------
--%

  % If possible, get the argument types for the cons_id.
@@ -489,6 +492,7 @@

 :- import_module parse_tree__prog_io, parse_tree__prog_io_goal.
 :- import_module parse_tree__prog_util, libs__options, libs__globals.
+:- import_module hlds__error_util.
 :- import_module bool, char, int, string.
 :- import_module assoc_list, require, varset.

@@ -1740,5 +1744,40 @@
  ;
   list__duplicate(Arity, no, MaybeTypes)
  ).
+
+%--------------------------------------------------------------------------
---%
+
+expand_equivalence_type(TypeTable, Type0) = Type :-
+ (
+  type_to_ctor_and_args(Type0, TypeCtor, _),
+  map__search(TypeTable, TypeCtor, TypeDefn)
+ ->
+  hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+  ( TypeBody = eqv_type(EqvType) ->
+   Type = expand_equivalence_type(TypeTable, EqvType)
+  ;
+   Type = Type0
+  )
+ ;
+  Type = Type0
+ ).
+ /*
+ ( type_to_ctor_and_args(Type0, TypeCtor, _) ->
+  map__lookup(TypeTable, TypeCtor, TypeDefn)
+ ;
+  unexpected(this_file, "type_to_ctor_and_args failed")
+ ),
+ hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+ ( TypeBody = eqv_type(EqvType) ->
+  Type = expand_equivalence_type(TypeTable, EqvType)
+ ;
+  Type = Type0
+ ).
+ */
+
+%--------------------------------------------------------------------------
---%
+
+:- func this_file = string.
+this_file = "type_util.m".


%---------------------------------------------------------------------------
--%
Index: unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.112
diff -u -r1.112 unify_proc.m
--- unify_proc.m 22 Jul 2002 06:29:52 -0000 1.112
+++ unify_proc.m 6 Nov 2002 16:34:01 -0000
@@ -673,7 +673,8 @@

 unify_proc__generate_clause_info(SpecialPredId, Type, TypeBody, Context,
   ModuleInfo, ClauseInfo) :-
- special_pred_info(SpecialPredId, Type,
+ module_info_types(ModuleInfo, TypeTable),
+ special_pred_info(TypeTable, SpecialPredId, Type,
   _PredName, ArgTypes, _Modes, _Det),
  unify_proc__info_init(ModuleInfo, VarTypeInfo0),
  unify_proc__make_fresh_named_vars_from_types(ArgTypes, "HeadVar__", 1,


--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------