[m-rev.] for review: fix problems applying compound equality optimisation

Peter Wang wangp at students.csse.unimelb.edu.au
Mon Aug 6 16:22:21 AEST 2007


Estimated hours taken: 4
Branches: main

Fix some problems which prevented the Erlang backend from replacing
unification/comparison predicate calls by compound value comparisons when the
type of the values being compared don't have user-defined equality/comparison
predicates.

1. It failed to apply the optimisation whenever the type contained a builtin
type.

2. It didn't handle type variables in data constructors correctly, e.g. it
wouldn't apply the optimisation for the type `t(int)' where

    :- type t(K) ---> t(K).

because it did not substitute types for type variables.

3. Calls to in-in unification predicates on tuples were never optimised.

compiler/type_util.m:
	Fix the implementation of
	type_definitely_has_no_user_defined_equality_pred, which was the cause
	of problems 1 and 2 above.

	Document that type_to_type_defn fails on a builtin type.

compiler/simplify.m:
	Move the optimisation of calls to in-in unification predicates (by
	using a compound equality test) a bit earlier in process_compl_unify.
	It was previously too late for tuple values (problem 3 above).

compiler/prog_type.m:
	Fix an incorrect comment.


Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.38
diff -u -r1.38 prog_type.m
--- compiler/prog_type.m	31 Jul 2007 07:58:42 -0000	1.38
+++ compiler/prog_type.m	6 Aug 2007 05:35:41 -0000
@@ -111,7 +111,7 @@
     list(mer_type)::out) is semidet.

     % Given a non-variable type, return its type_ctor and argument types.
-    % Fail if the type is a variable.
+    % Abort if the type is a variable.
     %
 :- pred type_to_ctor_and_args_det(mer_type::in, type_ctor::out,
     list(mer_type)::out) is det.
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.214
diff -u -r1.214 simplify.m
--- compiler/simplify.m	17 Jul 2007 23:48:29 -0000	1.214
+++ compiler/simplify.m	6 Aug 2007 05:35:41 -0000
@@ -2144,6 +2144,18 @@
         globals.lookup_bool_option(Globals, can_compare_compound_values,
             CanCompareCompoundValues),
         (
+            % On the Erlang backend, it is faster for us to use builtin
+            % comparison operators on high level data structures than to
+            % deconstruct the data structure and compare the atomic
+            % constituents.  We can only do this on values of types which we
+            % know not to have user-defined equality predicates.
+            hlds_pred.in_in_unification_proc_id(ProcId),
+            CanCompareCompoundValues = yes,
+            type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type)
+        ->
+            ExtraGoals = [],
+            call_builtin_compound_eq(XVar, YVar, ModuleInfo, GoalInfo0, Call)
+        ;
             hlds_pred.in_in_unification_proc_id(ProcId),
             (
                 SpecialPreds = no
@@ -2168,18 +2180,6 @@
             call_generic_unify(TypeInfoVar, XVar, YVar, ModuleInfo, !.Info,
                 Context, GoalInfo0, Call)
         ;
-            % On the Erlang backend, it is faster for us to use builtin
-            % comparison operators on high level data structures than to
-            % deconstruct the data structure and compare the atomic
-            % constituents.  We can only do this on values of types which we
-            % know not to have user-defined equality predicates.
-            hlds_pred.in_in_unification_proc_id(ProcId),
-            CanCompareCompoundValues = yes,
-            type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type)
-        ->
-            ExtraGoals = [],
-            call_builtin_compound_eq(XVar, YVar, ModuleInfo, GoalInfo0, Call)
-        ;
             % Convert other complicated unifications into calls to
             % specific unification predicates, inserting extra typeinfo
             % arguments if necessary.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.178
diff -u -r1.178 type_util.m
--- compiler/type_util.m	3 Jul 2007 03:15:43 -0000	1.178
+++ compiler/type_util.m	6 Aug 2007 05:35:41 -0000
@@ -48,7 +48,8 @@
     % Obtain the type definition and type definition body respectively,
     % if known, for the principal type constructor of the given type.
     %
-    % Fail if the given type is a type variable.
+    % Fail if the given type is a type variable or if the type is a builtin
+    % type.
     %
 :- pred type_to_type_defn(module_info::in, mer_type::in, hlds_type_defn::out)
     is semidet.
@@ -323,6 +324,7 @@
 :- import_module int.
 :- import_module map.
 :- import_module set.
+:- import_module svset.
 :- import_module term.

 %-----------------------------------------------------------------------------%
@@ -397,40 +399,45 @@
     ).

 type_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type) :-
-    type_definitely_has_no_user_defined_equality_pred_2(ModuleInfo,
-        set.init, Type).
+    type_definitely_has_no_user_defined_eq_pred_2(ModuleInfo, Type,
+        set.init, _).

-:- pred type_definitely_has_no_user_defined_equality_pred_2(module_info::in,
-    set(mer_type)::in, mer_type::in) is semidet.
+:- pred type_definitely_has_no_user_defined_eq_pred_2(module_info::in,
+    mer_type::in, set(mer_type)::in, set(mer_type)::out) is semidet.

-type_definitely_has_no_user_defined_equality_pred_2(ModuleInfo,
-        SeenTypes0, Type) :-
-    (if set.contains(SeenTypes0, Type) then
+type_definitely_has_no_user_defined_eq_pred_2(ModuleInfo, Type, !SeenTypes) :-
+    (if set.contains(!.SeenTypes, Type) then
         % Don't loop on recursive types.
         true
     else
-        set.insert(SeenTypes0, Type, SeenTypes),
-        type_to_type_defn_body(ModuleInfo, Type, TypeBody),
-        type_body_definitely_has_no_user_defined_equality_pred(ModuleInfo,
-            SeenTypes, TypeBody),
-        type_to_ctor_and_args_det(Type, _, Args),
-        all [Arg] (
-            list.member(Arg, Args)
-        =>
-            type_definitely_has_no_user_defined_equality_pred_2(ModuleInfo,
-                SeenTypes, Arg)
+        svset.insert(Type, !SeenTypes),
+        ( Type = builtin_type(_) ->
+            true
+        ; Type = tuple_type(Args, _Kind) ->
+            list.foldl(
+                type_definitely_has_no_user_defined_eq_pred_2(ModuleInfo),
+                Args, !SeenTypes)
+        ;
+            type_to_type_defn_body(ModuleInfo, Type, TypeBody),
+            type_body_definitely_has_no_user_defined_equality_pred(ModuleInfo,
+                Type, TypeBody, !SeenTypes),
+            type_to_ctor_and_args_det(Type, _, Args),
+            list.foldl(
+                type_definitely_has_no_user_defined_eq_pred_2(ModuleInfo),
+                Args, !SeenTypes)
         )
     ).

 :- pred type_body_definitely_has_no_user_defined_equality_pred(module_info::in,
-    set(mer_type)::in, hlds_type_body::in) is semidet.
+    mer_type::in, hlds_type_body::in, set(mer_type)::in, set(mer_type)::out)
+    is semidet.

-type_body_definitely_has_no_user_defined_equality_pred(ModuleInfo, SeenTypes,
-        TypeBody) :-
+type_body_definitely_has_no_user_defined_equality_pred(ModuleInfo, Type,
+        TypeBody, !SeenTypes) :-
     module_info_get_globals(ModuleInfo, Globals),
     globals.get_target(Globals, Target),
     (
-        TypeBody = hlds_du_type(Ctors, _, _, _, _, _),
+        TypeBody = hlds_du_type(_, _, _, _, _, _),
         (
             TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody),
             have_foreign_type_for_backend(Target, ForeignTypeBody, yes)
@@ -439,21 +446,10 @@
                 ForeignTypeBody, _)
         ;
             TypeBody ^ du_type_usereq = no,
-            all [Ctor] (
-                list.member(Ctor, Ctors)
-            => (
-                % There must not be any existentially quantified type
-                % variables.
-                Ctor = ctor([], _, _, Args, _),
-                % The data constructor argument types must not have
-                % user-defined equality preds.
-                all [Arg] (
-                    list.member(ctor_arg(_, ArgType, _), Args)
-                =>
-                    type_definitely_has_no_user_defined_equality_pred_2(
-                        ModuleInfo, SeenTypes, ArgType)
-                )
-            ))
+            % type_constructors does substitution of types variables.
+            type_constructors(Type, ModuleInfo, Ctors),
+            list.foldl(ctor_definitely_has_no_user_defined_eq_pred(ModuleInfo),
+                Ctors, !SeenTypes)
         )
     ;
         TypeBody = hlds_eqv_type(EqvType),
@@ -469,6 +465,18 @@
         fail
     ).

+:- pred ctor_definitely_has_no_user_defined_eq_pred(module_info::in,
+    constructor::in, set(mer_type)::in, set(mer_type)::out) is semidet.
+
+ctor_definitely_has_no_user_defined_eq_pred(ModuleInfo, Ctor, !SeenTypes) :-
+    % There must not be any existentially quantified type variables.
+    Ctor = ctor([], _, _, Args, _),
+    % The data constructor argument types must not have user-defined equality
+    % or comparison predicates.
+    ArgTypes = list.map((func(A) = A ^ arg_type), Args),
+    list.foldl(type_definitely_has_no_user_defined_eq_pred_2(ModuleInfo),
+        ArgTypes, !SeenTypes).
+
 type_is_solver_type(ModuleInfo, Type) :-
     type_to_type_defn_body(ModuleInfo, Type, TypeBody),
     (
@@ -502,7 +510,7 @@
     %
 is_solver_type(ModuleInfo, Type) :-
     % Type_to_type_defn_body will fail for builtin types such as `int/0'.
-    % Such types are not solver types so gis_solver_type fails too.
+    % Such types are not solver types so is_solver_type fails too.
     % Type_to_type_defn_body also fails for type variables.
     type_to_type_defn_body(ModuleInfo, Type, TypeBody),
     type_body_is_solver_type(ModuleInfo, TypeBody).
--------------------------------------------------------------------------
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