[m-rev.] diff: renames in type_util.m

Zoltan Somogyi zs at unimelb.edu.au
Wed Apr 11 14:51:14 AEST 2012


This diff has no algorithm changes.

Zoltan.

compiler/type_util.m:
	Replace the misleading names of several predicates. The old names
	talked about testing a type, type definition or variable to see
	whether it is a solver type, when the test they actually implemented
	also succeeded if they were NOT a solver type, but contained a
	component that was a solver type.

	Add versions of some of these predicates that take only a type table,
	and not a whole module_info, as input. (The type table is the only
	part of the module_info that the old predicates actually use.)
	I have plans to use these predicates in a later diff.

	Give some other predicates better names as well.

compiler/modecheck_conj.m:
	Rename a predicate along similar lines.

compiler/cse_detection.m:
compiler/exception_analysis.m:
compiler/inst_match.m:
compiler/inst_util.m:
compiler/modecheck_unify.m:
compiler/modes.m:
compiler/simplify.m:
compiler/trailing_analysis.m:
	Conform to the above changes.

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/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
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/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.136
diff -u -b -r1.136 cse_detection.m
--- compiler/cse_detection.m	13 Feb 2012 00:11:35 -0000	1.136
+++ compiler/cse_detection.m	5 Apr 2012 03:17:50 -0000
@@ -853,7 +853,7 @@
         ModuleInfo = !.CseInfo ^ csei_module_info,
         VarTypes = !.CseInfo ^ csei_vartypes,
         map.lookup(VarTypes, Var, Type),
-        type_util.is_existq_cons(ModuleInfo, Type, ConsId)
+        cons_id_is_existq_cons(ModuleInfo, Type, ConsId)
     ->
         update_existential_data_structures(FirstOldNew, LaterOldNew, !CseInfo)
     ;
Index: compiler/exception_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/exception_analysis.m,v
retrieving revision 1.59
diff -u -b -r1.59 exception_analysis.m
--- compiler/exception_analysis.m	13 Feb 2012 00:11:37 -0000	1.59
+++ compiler/exception_analysis.m	5 Apr 2012 03:16:29 -0000
@@ -895,8 +895,9 @@
 
 check_type(ModuleInfo, Type) = Status :-
     (
-        ( is_solver_type(ModuleInfo, Type)
-        ; is_existq_type(ModuleInfo, Type))
+        ( type_is_solver_type(ModuleInfo, Type)
+        ; type_is_existq_type(ModuleInfo, Type)
+        )
      ->
         % XXX At the moment we just assume that existential types and
         % solver types result in a type exception being thrown.
Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.97
diff -u -b -r1.97 inst_match.m
--- compiler/inst_match.m	2 Apr 2012 03:58:55 -0000	1.97
+++ compiler/inst_match.m	5 Apr 2012 03:10:09 -0000
@@ -2454,7 +2454,7 @@
     uniqueness::in, ho_inst_info::in, mer_inst::out) is semidet.
 
 maybe_any_to_bound(yes(Type), ModuleInfo, Uniq, none, Inst) :-
-    \+ type_util.is_solver_type(ModuleInfo, Type),
+    \+ type_is_solver_type(ModuleInfo, Type),
     ( type_constructors(ModuleInfo, Type, Constructors) ->
         type_to_ctor_det(Type, TypeCtor),
         constructors_to_bound_any_insts(ModuleInfo, Uniq, TypeCtor,
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.68
diff -u -b -r1.68 inst_util.m
--- compiler/inst_util.m	5 Apr 2012 01:45:21 -0000	1.68
+++ compiler/inst_util.m	5 Apr 2012 03:10:43 -0000
@@ -684,7 +684,7 @@
         InstA = any(Uniq, _),
         % We only allow `any' to unify with a functor if we know that
         % the type is not a solver type.
-        \+ type_util.is_solver_type(!.ModuleInfo, Type),
+        \+ type_is_solver_type(!.ModuleInfo, Type),
         (
             Live = is_live,
             make_any_inst_list_lives(ArgInstsB, Live, ArgLives, Uniq, Real,
Index: compiler/modecheck_conj.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_conj.m,v
retrieving revision 1.9
diff -u -b -r1.9 modecheck_conj.m
--- compiler/modecheck_conj.m	26 Mar 2012 00:43:32 -0000	1.9
+++ compiler/modecheck_conj.m	5 Apr 2012 03:06:58 -0000
@@ -502,8 +502,8 @@
         NonLocals = goal_info_get_nonlocals(CondGoalInfo),
         mode_info_get_module_info(ModeInfo, ModuleInfo),
         mode_info_get_var_types(ModeInfo, VarTypes),
-        NonSolverNonLocals =
-            set_of_var.filter(non_solver_var(ModuleInfo, VarTypes), NonLocals),
+        NonSolverNonLocals = set_of_var.filter(
+            does_not_contain_solver_type(ModuleInfo, VarTypes), NonLocals),
         set_of_var.union(NonSolverNonLocals, !NonFree),
 
         candidate_init_vars_3(ModeInfo, ThenGoal, !.NonFree, NonFreeThen,
@@ -552,13 +552,14 @@
     ).
 
     % This filter pred succeeds if the given variable does not have
-    % a solver type.
+    % a solver type, or a type that may contain a solver type.
     %
-:- pred non_solver_var(module_info::in, vartypes::in, prog_var::in) is semidet.
+:- pred does_not_contain_solver_type(module_info::in, vartypes::in,
+    prog_var::in) is semidet.
 
-non_solver_var(ModuleInfo, VarTypes, Var) :-
-    VarType = VarTypes ^ det_elem(Var),
-    not type_is_solver_type(ModuleInfo, VarType).
+does_not_contain_solver_type(ModuleInfo, VarTypes, Var) :-
+    map.lookup(VarTypes, Var, VarType),
+    not type_is_or_may_contain_solver_type(ModuleInfo, VarType).
 
     % Update !NonFree and !CandidateVars given the args and modes for a call.
     %
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.144
diff -u -b -r1.144 modecheck_unify.m
--- compiler/modecheck_unify.m	26 Mar 2012 00:43:32 -0000	1.144
+++ compiler/modecheck_unify.m	11 Apr 2012 04:48:54 -0000
@@ -164,7 +164,7 @@
         mode_info_may_init_solver_vars(!.ModeInfo),
         InstOfX0   = free,
         InstOfY0   = free,
-        VarType    = VarTypes ^ elem(X),
+        map.search(VarTypes, X, VarType),
         type_is_solver_type_with_auto_init(ModuleInfo0, VarType)
     ->
         construct_initialisation_call(X, VarType, any_inst,
@@ -687,8 +687,8 @@
             list.member(InstArg, InstArgs),
             inst_is_free(ModuleInfo0, InstArg),
             list.member(ArgVar, ArgVars0),
-            map.search(VarTypes, ArgVar, ArgType),
-            type_is_solver_type(ModuleInfo0, ArgType)
+            map.lookup(VarTypes, ArgVar, ArgType),
+            type_is_or_may_contain_solver_type(ModuleInfo0, ArgType)
         ),
         abstractly_unify_inst_functor(LiveX, InstOfX, InstConsId,
             InstArgs, LiveArgs, real_unify, TypeOfX,
@@ -733,7 +733,7 @@
         % Unfortunately, the update can be very expensive. For example,
         % for a ground list with N elements, there will be N variables
         % bound to the cons cells of the list. Since the average size of the
-        % insts of these variables is on proportional to N/2, the task
+        % insts of these variables is proportional to N/2, the task
         % of recording all their insts is at least quadratic in N.
         % In practice, it can  actually be worse, because of the way the code
         % called by bind_args works. It keeps track of sets of insts seen
@@ -876,16 +876,17 @@
     unexpected($module, $pred, "mismatched list lengths").
 all_arg_vars_are_non_free_or_solver_vars([_ | _], [], _, _, _) :-
     unexpected($module, $pred, "mismatched list lengths").
-all_arg_vars_are_non_free_or_solver_vars([Arg | Args], [Inst | Insts],
-        VarTypes, ModuleInfo, ArgsToInit) :-
+all_arg_vars_are_non_free_or_solver_vars([ArgVar | ArgVars], [Inst | Insts],
+        VarTypes, ModuleInfo, ArgVarsToInit) :-
     ( inst_match.inst_is_free(ModuleInfo, Inst) ->
-        type_is_solver_type(ModuleInfo, VarTypes ^ elem(Arg)),
-        all_arg_vars_are_non_free_or_solver_vars(Args, Insts,
-            VarTypes, ModuleInfo, ArgsToInit1),
-        ArgsToInit = [Arg | ArgsToInit1]
+        map.lookup(VarTypes, ArgVar, ArgType),
+        type_is_or_may_contain_solver_type(ModuleInfo, ArgType),
+        all_arg_vars_are_non_free_or_solver_vars(ArgVars, Insts,
+            VarTypes, ModuleInfo, ArgVarsToInitTail),
+        ArgVarsToInit = [ArgVar | ArgVarsToInitTail]
     ;
-        all_arg_vars_are_non_free_or_solver_vars(Args, Insts,
-            VarTypes, ModuleInfo, ArgsToInit)
+        all_arg_vars_are_non_free_or_solver_vars(ArgVars, Insts,
+            VarTypes, ModuleInfo, ArgVarsToInit)
     ).
 
 %-----------------------------------------------------------------------------%
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.400
diff -u -b -r1.400 modes.m
--- compiler/modes.m	2 Apr 2012 03:58:55 -0000	1.400
+++ compiler/modes.m	5 Apr 2012 03:07:50 -0000
@@ -774,7 +774,8 @@
         ),
         BodyNonLocals = goal_info_get_nonlocals(BodyGoalInfo0),
         mode_info_get_var_types(!.ModeInfo, VarTypes0),
-        SolverNonLocals = list.filter(is_solver_var(VarTypes0, ModuleInfo),
+        SolverNonLocals = list.filter(
+            var_is_or_may_contain_solver_type(ModuleInfo, VarTypes0),
             set_of_var.to_sorted_list(BodyNonLocals)),
         SolverNonLocals = []
     ->
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.276
diff -u -b -r1.276 simplify.m
--- compiler/simplify.m	27 Mar 2012 23:21:28 -0000	1.276
+++ compiler/simplify.m	5 Apr 2012 03:18:03 -0000
@@ -1213,7 +1213,7 @@
 
             map.lookup(VarTypes, Var, Type),
             simplify_info_get_module_info(!.Info, ModuleInfo1),
-            ( type_util.is_existq_cons(ModuleInfo1, Type, MainConsId) ->
+            ( cons_id_is_existq_cons(ModuleInfo1, Type, MainConsId) ->
                 GoalExpr = switch(Var, SwitchCanFail, Cases),
                 NonLocals = goal_info_get_nonlocals(GoalInfo0),
                 merge_instmap_deltas(InstMap0, NonLocals, VarTypes,
Index: compiler/trailing_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trailing_analysis.m,v
retrieving revision 1.44
diff -u -b -r1.44 trailing_analysis.m
--- compiler/trailing_analysis.m	13 Feb 2012 00:11:49 -0000	1.44
+++ compiler/trailing_analysis.m	5 Apr 2012 03:14:01 -0000
@@ -762,8 +762,8 @@
 
 check_type(ModuleInfo, Type) = Status :-
     (
-        ( is_solver_type(ModuleInfo, Type)
-        ; is_existq_type(ModuleInfo, Type)
+        ( type_is_solver_type(ModuleInfo, Type)
+        ; type_is_existq_type(ModuleInfo, Type)
         )
      ->
         % XXX At the moment we just assume that existential
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.213
diff -u -b -r1.213 type_util.m
--- compiler/type_util.m	6 Sep 2011 05:20:43 -0000	1.213
+++ compiler/type_util.m	5 Apr 2012 03:29:46 -0000
@@ -53,9 +53,13 @@
     %
 :- pred type_to_type_defn(module_info::in, mer_type::in, hlds_type_defn::out)
     is semidet.
+:- pred type_to_type_defn_from_type_table(type_table::in, mer_type::in,
+    hlds_type_defn::out) is semidet.
 
 :- pred type_to_type_defn_body(module_info::in, mer_type::in,
     hlds_type_body::out) is semidet.
+:- pred type_to_type_defn_body_from_type_table(type_table::in, mer_type::in,
+    hlds_type_body::out) is semidet.
 
     % Succeed iff there was either a `where equality is <predname>' or a
     % `where comparison is <predname>' declaration for the principal type
@@ -77,24 +81,26 @@
     % Succeed iff the type (not just the principal type constructor) is known
     % to not have user-defined equality or comparison predicates.
     %
-    % If the type is a type variable, or is abstract, etc.  make the
+    % If the type is a type variable, or is abstract, etc., make the
     % conservative approximation and fail.
     %
 :- pred type_definitely_has_no_user_defined_equality_pred(module_info::in,
     mer_type::in) is semidet.
 
-:- pred is_solver_var(vartypes::in, module_info::in, prog_var::in) is semidet.
+:- pred var_is_or_may_contain_solver_type(module_info::in, vartypes::in,
+    prog_var::in) is semidet.
 
     % Succeed iff the principal type constructor for the given type is
-    % declared a solver type, or if the type is a pred or func type.  Pred
-    % and func types are considered solver types because higher-order terms
-    % that contain non-local solver variables are not ground unless all of
-    % the non-locals are ground.
+    % declared a solver type, or if the type is a pred or func type.
+    % Pred and func types are considered solver types because higher-order
+    % terms that contain non-local solver variables are not ground unless
+    % all of the non-locals are ground.
     %
     % If the type is a type variable and thus has no principal type
     % constructor, fail.
     %
-:- pred type_is_solver_type(module_info::in, mer_type::in) is semidet.
+:- pred type_is_or_may_contain_solver_type(module_info::in, mer_type::in)
+    is semidet.
 
 :- pred type_has_solver_type_details(module_info::in, mer_type::in,
     solver_type_details::out) is semidet.
@@ -108,17 +114,21 @@
 :- pred type_is_solver_type_with_auto_init(module_info::in, mer_type::in)
     is semidet.
 
-:- pred is_solver_type(module_info::in, mer_type::in) is semidet.
+:- pred type_is_solver_type(module_info::in, mer_type::in) is semidet.
+:- pred type_is_solver_type_from_type_table(type_table::in, mer_type::in)
+    is semidet.
 
     % Succeed if the type body is for a solver type.
     %
 :- pred type_body_is_solver_type(module_info::in, hlds_type_body::in)
     is semidet.
+:- pred type_body_is_solver_type_from_type_table(type_table::in,
+    hlds_type_body::in) is semidet.
 
     % Succeeds iff one or more of the type constructors for a given
     % type is existentially quantified.
     %
-:- pred is_existq_type(module_info::in, mer_type::in) is semidet.
+:- pred type_is_existq_type(module_info::in, mer_type::in) is semidet.
 
 :- type is_dummy_type
     --->    is_dummy_type
@@ -243,7 +253,7 @@
 :- pred get_existq_cons_defn(module_info::in, mer_type::in, cons_id::in,
     ctor_defn::out) is semidet.
 
-:- pred is_existq_cons(module_info::in, mer_type::in, cons_id::in)
+:- pred cons_id_is_existq_cons(module_info::in, mer_type::in, cons_id::in)
     is semidet.
 
     % Check whether a type is a no_tag type (i.e. one with only one
@@ -413,10 +423,18 @@
     type_to_ctor(Type, TypeCtor),
     search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn).
 
+type_to_type_defn_from_type_table(TypeTable, Type, TypeDefn) :-
+    type_to_ctor(Type, TypeCtor),
+    search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn).
+
 type_to_type_defn_body(ModuleInfo, Type, TypeBody) :-
     type_to_type_defn(ModuleInfo, Type, TypeDefn),
     hlds_data.get_type_defn_body(TypeDefn, TypeBody).
 
+type_to_type_defn_body_from_type_table(TypeTable, Type, TypeBody) :-
+    type_to_type_defn_from_type_table(TypeTable, Type, TypeDefn),
+    hlds_data.get_type_defn_body(TypeDefn, TypeBody).
+
 type_has_user_defined_equality_pred(ModuleInfo, Type, UserEqComp) :-
     type_to_type_defn_body(ModuleInfo, Type, TypeBody),
     type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, UserEqComp).
@@ -533,9 +551,9 @@
     list.foldl(type_definitely_has_no_user_defined_eq_pred_2(ModuleInfo),
         ArgTypes, !SeenTypes).
 
-is_solver_var(VarTypes, ModuleInfo, Var) :-
+var_is_or_may_contain_solver_type(ModuleInfo, VarTypes, Var) :-
     map.lookup(VarTypes, Var, VarType),
-    type_is_solver_type(ModuleInfo, VarType).
+    type_is_or_may_contain_solver_type(ModuleInfo, VarType).
 
 type_is_solver_type_with_auto_init(ModuleInfo, Type) :-
     type_to_type_defn_body(ModuleInfo, Type, TypeBody),
@@ -545,12 +563,12 @@
     ;
         % XXX the current implementation doesn't provide enough information
         % to determine whether abstract solver types support automatic
-        % initialisation or not.  In the absence of such information we
-        % assume that they do not.  Since we don't officially support
-        % automatic initialisation anyway this shouldn't be too much of a
-        % problem.  (In the event that we do re-add some form of support for
-        % automatic solver initialisation then we will need to make sure
-        % that this information ends up in interface files somehow.)
+        % initialisation or not. In the absence of such information we assume
+        % that they do not. Since we don't officially support automatic
+        % initialisation anyway this shouldn't be too much of a problem.
+        % (In the event that we do re-add some form of support for automatic
+        % solver initialisation then we will need to make sure that this
+        % information ends up in interface files somehow.)
         TypeBody = hlds_abstract_type(abstract_solver_type),
         fail
     ;
@@ -559,7 +577,7 @@
     type_has_solver_type_details(ModuleInfo, ActualType, SolverTypeDetails),
     SolverTypeDetails ^ std_init_pred = solver_init_automatic(_).
 
-type_is_solver_type(ModuleInfo, Type) :-
+type_is_or_may_contain_solver_type(ModuleInfo, Type) :-
     (
         type_is_higher_order(Type)
     ;
@@ -570,7 +588,7 @@
             TypeBody = hlds_abstract_type(abstract_solver_type)
         ;
             TypeBody = hlds_eqv_type(EqvType),
-            type_is_solver_type(ModuleInfo, EqvType)
+            type_is_or_may_contain_solver_type(ModuleInfo, EqvType)
         )
     ).
 
@@ -587,7 +605,7 @@
         type_has_solver_type_details(ModuleInfo, EqvType, SolverTypeDetails)
     ).
 
-is_solver_type(ModuleInfo, Type) :-
+type_is_solver_type(ModuleInfo, Type) :-
     % XXX We can't assume that type variables refer to solver types
     % because otherwise the compiler will try to construct initialisation
     % forwarding predicates for exported abstract types defined to be
@@ -601,6 +619,11 @@
     type_to_type_defn_body(ModuleInfo, Type, TypeBody),
     type_body_is_solver_type(ModuleInfo, TypeBody).
 
+type_is_solver_type_from_type_table(TypeTable, Type) :-
+    % XXX The comment in type_is_solver_type applies here as well.
+    type_to_type_defn_body_from_type_table(TypeTable, Type, TypeBody),
+    type_body_is_solver_type_from_type_table(TypeTable, TypeBody).
+
 type_body_is_solver_type(ModuleInfo, TypeBody) :-
     (
         TypeBody = hlds_solver_type(_, _)
@@ -608,10 +631,20 @@
         TypeBody = hlds_abstract_type(abstract_solver_type)
     ;
         TypeBody = hlds_eqv_type(Type),
-        is_solver_type(ModuleInfo, Type)
+        type_is_solver_type(ModuleInfo, Type)
+    ).
+
+type_body_is_solver_type_from_type_table(TypeTable, TypeBody) :-
+    (
+        TypeBody = hlds_solver_type(_, _)
+    ;
+        TypeBody = hlds_abstract_type(abstract_solver_type)
+    ;
+        TypeBody = hlds_eqv_type(Type),
+        type_is_solver_type_from_type_table(TypeTable, Type)
     ).
 
-is_existq_type(ModuleInfo, Type) :-
+type_is_existq_type(ModuleInfo, Type) :-
     type_constructors(ModuleInfo, Type, Constructors),
     some [Constructor] (
         list.member(Constructor, Constructors),
@@ -1029,11 +1062,16 @@
     ArgTypes0 = list.map(func(C) = C ^ arg_type, Args),
     apply_subst_to_type_list(TSubst, ArgTypes0, ArgTypes).
 
-:- pred is_existq_cons(module_info::in, mer_type::in, cons_id::in,
-    hlds_cons_defn::out) is semidet.
+cons_id_is_existq_cons(ModuleInfo, VarType, ConsId) :-
+    cons_id_is_existq_cons_return_defn(ModuleInfo, VarType, ConsId, _).
 
-is_existq_cons(ModuleInfo, VarType, ConsId) :-
-    is_existq_cons(ModuleInfo, VarType, ConsId, _).
+:- pred cons_id_is_existq_cons_return_defn(module_info::in, mer_type::in,
+    cons_id::in, hlds_cons_defn::out) is semidet.
+
+cons_id_is_existq_cons_return_defn(ModuleInfo, VarType, ConsId, ConsDefn) :-
+    type_to_ctor(VarType, TypeCtor),
+    get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn),
+    ConsDefn ^ cons_exist_tvars = [_ | _].
 
 get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn) :-
     % XXX We should look it up in a type_ctor-specific table, not a global one.
@@ -1050,7 +1088,7 @@
     ).
 
 get_existq_cons_defn(ModuleInfo, VarType, ConsId, CtorDefn) :-
-    is_existq_cons(ModuleInfo, VarType, ConsId, ConsDefn),
+    cons_id_is_existq_cons_return_defn(ModuleInfo, VarType, ConsId, ConsDefn),
     ConsDefn = hlds_cons_defn(_TypeCtor, TypeVarSet, TypeParams, KindMap,
         ExistQVars, Constraints, Args, _Context),
     ArgTypes = list.map(func(C) = C ^ arg_type, Args),
@@ -1060,11 +1098,6 @@
     CtorDefn = ctor_defn(TypeVarSet, ExistQVars, KindMap, Constraints,
         ArgTypes, RetType).
 
-is_existq_cons(ModuleInfo, VarType, ConsId, ConsDefn) :-
-    type_to_ctor(VarType, TypeCtor),
-    get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn),
-    ConsDefn ^ cons_exist_tvars = [_ | _].
-
 %-----------------------------------------------------------------------------%
 
 type_is_no_tag_type(ModuleInfo, Type) :-
cvs diff: Diffing compiler/notes
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/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_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glfw
cvs diff: Diffing extras/graphics/mercury_glfw/samples
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/monte
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 m4
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/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
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/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/lazy_list
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 ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
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/feedback
cvs diff: Diffing tests/feedback/mandelbrot
cvs diff: Diffing tests/feedback/mmc
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/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
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