[m-rev.] for review: fix existentially quantified constructor unification
Simon Taylor
stayl at cs.mu.OZ.AU
Sun Jul 21 18:37:20 AEST 2002
Estimated hours taken: 5
Branches: main
Fix a bug which caused type-incorrect HLDS to be generated by mode
analysis, which then caused a compiler abort in simplification.
In the code below, mode analysis must treat the headvar unification
as a construction followed by a var-var unification. If it is treated
as a deconstruction, the argument unifications will be ill-typed.
:- type t ---> some [T] f(T) => enum(T).
:- pred p(t::in) is semidet.
p('new f'(1)).
compiler/modecheck_unify.m:
Make sure unifications with a RHS of the form 'new f(X)'
are always classified as constructions.
compiler/hlds_goal.m:
compiler/*.m:
Add a field to var-functor unifications which identifies
those which must be treated as constructions.
compiler/polymorphism.m:
Fill in the field.
tests/hard_coded/Mmakefile:
tests/hard_coded/unify_existq_cons.{m,exp}:
Test case.
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.18
diff -u -u -r1.18 assertion.m
--- compiler/assertion.m 28 Mar 2002 03:42:41 -0000 1.18
+++ compiler/assertion.m 21 Jul 2002 04:22:18 -0000
@@ -441,7 +441,7 @@
single_construction(unify(_, UnifyRhs, _, _, _) - _,
cons(QualifiedSymName, Arity)) :-
- UnifyRhs = functor(cons(UnqualifiedSymName, Arity), _),
+ UnifyRhs = functor(cons(UnqualifiedSymName, Arity), _, _),
match_sym_name(UnqualifiedSymName, QualifiedSymName).
%
@@ -461,7 +461,7 @@
P = (pred(G::in) is semidet :-
not (
G = unify(_, UnifyRhs, _, _, _) - _,
- UnifyRhs = functor(_, _)
+ UnifyRhs = functor(_, _, _)
)
),
list__filter(P, Unifications, [])
@@ -599,7 +599,7 @@
equal_unification(var(A), var(B), Subst0, Subst) :-
equal_vars([A], [B], Subst0, Subst).
-equal_unification(functor(ConsId, VarsA), functor(ConsId, VarsB),
+equal_unification(functor(ConsId, E, VarsA), functor(ConsId, E, VarsB),
Subst0, Subst) :-
equal_vars(VarsA, VarsB, Subst0, Subst).
equal_unification(lambda_goal(PredOrFunc, EvalMethod, FixModes, NLVarsA, LVarsA,
@@ -812,7 +812,7 @@
module_info::out, io__state::di, io__state::uo) is det.
assertion__in_interface_check_unify_rhs(var(_), _, _, _, Module, Module) --> [].
-assertion__in_interface_check_unify_rhs(functor(ConsId, _), Var, Context,
+assertion__in_interface_check_unify_rhs(functor(ConsId, _, _), Var, Context,
PredInfo, Module0, Module) -->
{ pred_info_clauses_info(PredInfo, ClausesInfo) },
{ clauses_info_vartypes(ClausesInfo, VarTypes) },
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.72
diff -u -u -r1.72 cse_detection.m
--- compiler/cse_detection.m 28 Mar 2002 03:42:50 -0000 1.72
+++ compiler/cse_detection.m 21 Jul 2002 03:37:29 -0000
@@ -601,7 +601,7 @@
->
Unif = deconstruct(Var, Consid, Args, Submodes, CanFail,
CanCGC),
- ( Term = functor(_, _) ->
+ ( Term = functor(_, _, _) ->
GoalExpr1 = unify(Var, Term, Umode, Unif, Ucontext)
;
error("non-functor unify in construct_common_unify")
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.71
diff -u -u -r1.71 dead_proc_elim.m
--- compiler/dead_proc_elim.m 28 Mar 2002 03:42:51 -0000 1.71
+++ compiler/dead_proc_elim.m 21 Jul 2002 04:22:30 -0000
@@ -890,7 +890,7 @@
dead_pred_info::in, dead_pred_info::out) is det.
pre_modecheck_examine_unify_rhs(var(_)) --> [].
-pre_modecheck_examine_unify_rhs(functor(Functor, _)) -->
+pre_modecheck_examine_unify_rhs(functor(Functor, _, _)) -->
( { Functor = cons(Name, _) } ->
dead_pred_info_add_pred_name(Name)
;
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.9
diff -u -u -r1.9 deep_profiling.m
--- compiler/deep_profiling.m 9 May 2002 16:30:51 -0000 1.9
+++ compiler/deep_profiling.m 21 Jul 2002 04:22:59 -0000
@@ -1622,7 +1622,7 @@
InstMapDelta),
Determinism = det,
goal_info_init(NonLocals, InstMapDelta, Determinism, GoalInfo),
- Goal = unify(Var, functor(ConsId, []),
+ Goal = unify(Var, functor(ConsId, no, []),
(free -> Ground) - (Ground -> Ground),
construct(Var, ConsId, [], [], construct_statically([]),
cell_is_shared, no),
@@ -1639,7 +1639,7 @@
goal_info_init(NonLocals, InstMapDelta, Determinism, GoalInfo),
ArgMode = ((free - Ground) -> (Ground - Ground)),
list__duplicate(Length, ArgMode, ArgModes),
- Goal = unify(Var, functor(ConsId, Args),
+ Goal = unify(Var, functor(ConsId, no, Args),
(free -> Ground) - (Ground -> Ground),
construct(Var, ConsId, Args, ArgModes,
construct_statically([]), cell_is_shared, no),
Index: compiler/det_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_util.m,v
retrieving revision 1.22
diff -u -u -r1.22 det_util.m
--- compiler/det_util.m 20 Mar 2002 12:36:06 -0000 1.22
+++ compiler/det_util.m 21 Jul 2002 04:21:30 -0000
@@ -121,7 +121,7 @@
interpret_unify(X, var(Y), Subst0, Subst) :-
term__unify(term__variable(X), term__variable(Y),
Subst0, Subst).
-interpret_unify(X, functor(ConsId, ArgVars), Subst0, Subst) :-
+interpret_unify(X, functor(ConsId, _, ArgVars), Subst0, Subst) :-
term__var_list_to_term_list(ArgVars, ArgTerms),
cons_id_and_args_to_term(ConsId, ArgTerms, RhsTerm),
term__unify(term__variable(X), RhsTerm, Subst0, Subst).
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.76
diff -u -u -r1.76 goal_util.m
--- compiler/goal_util.m 28 Mar 2002 03:42:55 -0000 1.76
+++ compiler/goal_util.m 21 Jul 2002 04:23:31 -0000
@@ -440,8 +440,8 @@
goal_util__rename_unify_rhs(var(Var0), Must, Subn, var(Var)) :-
goal_util__rename_var(Var0, Must, Subn, Var).
-goal_util__rename_unify_rhs(functor(Functor, ArgVars0), Must, Subn,
- functor(Functor, ArgVars)) :-
+goal_util__rename_unify_rhs(functor(Functor, E, ArgVars0), Must, Subn,
+ functor(Functor, E, ArgVars)) :-
goal_util__rename_var_list(ArgVars0, Must, Subn, ArgVars).
goal_util__rename_unify_rhs(
lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals0,
@@ -661,7 +661,7 @@
goal_util__rhs_goal_vars(var(X), Set0, Set) :-
set__insert(Set0, X, Set).
-goal_util__rhs_goal_vars(functor(_Functor, ArgVars), Set0, Set) :-
+goal_util__rhs_goal_vars(functor(_Functor, _, ArgVars), Set0, Set) :-
set__insert_list(Set0, ArgVars, Set).
goal_util__rhs_goal_vars(
lambda_goal(_, _, _, NonLocals, LambdaVars, _M, _D, Goal - _),
@@ -1018,7 +1018,7 @@
UnifyContext = unify_context(explicit, []),
Unification = deconstruct(Var, ConsId, ArgVars, UniModes,
can_fail, no),
- ExtraGoal = unify(Var, functor(ConsId, ArgVars),
+ ExtraGoal = unify(Var, functor(ConsId, no, ArgVars),
UniMode, Unification, UnifyContext),
set__singleton_set(NonLocals, Var),
instmap_delta_init_reachable(ExtraInstMapDelta0),
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.96
diff -u -u -r1.96 higher_order.m
--- compiler/higher_order.m 28 Mar 2002 03:42:57 -0000 1.96
+++ compiler/higher_order.m 21 Jul 2002 04:23:59 -0000
@@ -1154,7 +1154,7 @@
{ Unify = construct(LVar, NewConsId,
NewArgs, UniModes, HowToConstruct,
CellIsUnique, MaybeExprn) },
- { Goal2 = unify(LVar, functor(NewConsId, NewArgs),
+ { Goal2 = unify(LVar, functor(NewConsId, no, NewArgs),
UniMode, Unify, Context) },
% Make sure any constants in the
@@ -2237,7 +2237,7 @@
instmap_delta_from_assoc_list([UnwrappedArg - ground(shared, none)],
InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, Context, GoalInfo),
- Goal = unify(Arg, functor(ConsId, [UnwrappedArg]), In - Out,
+ Goal = unify(Arg, functor(ConsId, no, [UnwrappedArg]), In - Out,
deconstruct(Arg, ConsId, [UnwrappedArg], UniModes,
cannot_fail, no),
unify_context(explicit, [])) - GoalInfo.
@@ -3032,7 +3032,7 @@
ConstInstMapDelta),
goal_info_init(ConstNonLocals, ConstInstMapDelta,
det, ConstGoalInfo),
- RHS = functor(ConsId, CurriedHeadVars1),
+ RHS = functor(ConsId, no, CurriedHeadVars1),
UniMode = (free -> ConstInst) - (ConstInst -> ConstInst),
ConstGoal = unify(LVar, RHS, UniMode,
construct(LVar, ConsId, CurriedHeadVars1, UniModes,
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.96
diff -u -u -r1.96 hlds_goal.m
--- compiler/hlds_goal.m 9 Jul 2002 01:29:17 -0000 1.96
+++ compiler/hlds_goal.m 21 Jul 2002 04:24:33 -0000
@@ -290,7 +290,17 @@
% simple_test/complicated_unify).
:- type unify_rhs
---> var(prog_var)
- ; functor(cons_id, list(prog_var))
+ ; functor(
+ cons_id,
+ is_existential_construction,
+ % The `is_existential_construction'
+ % field is only used after
+ % polymorphism.m strips off
+ % the `new ' prefix from
+ % existentially typed constructions.
+
+ list(prog_var)
+ )
; lambda_goal(
pred_or_func,
lambda_eval_method,
@@ -306,6 +316,9 @@
hlds_goal
).
+ % Was the constructor originally of the form 'new ctor'(...).
+:- type is_existential_construction == bool.
+
:- type unification
% A construction unification is a unification with a functor
% or lambda expression which binds the LHS variable,
@@ -1657,7 +1670,7 @@
make_const_construction(Var, cons(unqualified(String), 0), Goal).
make_const_construction(Var, ConsId, Goal - GoalInfo) :-
- RHS = functor(ConsId, []),
+ RHS = functor(ConsId, no, []),
Inst = bound(unique, [functor(ConsId, [])]),
Mode = (free -> Inst) - (Inst -> Inst),
RLExprnId = no,
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.286
diff -u -u -r1.286 hlds_out.m
--- compiler/hlds_out.m 9 Jul 2002 01:29:19 -0000 1.286
+++ compiler/hlds_out.m 21 Jul 2002 04:56:40 -0000
@@ -263,6 +263,7 @@
% HLDS modules.
:- import_module hlds__special_pred, hlds__instmap, hlds__hlds_llds.
:- import_module check_hlds__purity, check_hlds__check_typeclass.
+:- import_module check_hlds__type_util.
:- import_module transform_hlds__termination, transform_hlds__term_errors.
% RL back-end modules (XXX should avoid using those here).
@@ -2209,8 +2210,15 @@
hlds_out__write_unify_rhs_3(var(Var), _, VarSet, _, AppendVarnums, _, _, _) -->
mercury_output_var(Var, VarSet, AppendVarnums).
-hlds_out__write_unify_rhs_3(functor(ConsId, ArgVars), ModuleInfo, VarSet, _,
- AppendVarnums, _Indent, MaybeType, TypeQual) -->
+hlds_out__write_unify_rhs_3(functor(ConsId0, IsExistConstruct, ArgVars),
+ ModuleInfo, VarSet, _, AppendVarnums, _Indent,
+ MaybeType, TypeQual) -->
+ { IsExistConstruct = yes, ConsId0 = cons(SymName0, Arity) ->
+ remove_new_prefix(SymName, SymName0),
+ ConsId = cons(SymName, Arity)
+ ;
+ ConsId = ConsId0
+ },
hlds_out__write_functor_cons_id(ConsId, ArgVars, VarSet, ModuleInfo,
AppendVarnums),
( { MaybeType = yes(Type), TypeQual = yes(TVarSet, _) } ->
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.122
diff -u -u -r1.122 intermod.m
--- compiler/intermod.m 30 Jun 2002 17:06:18 -0000 1.122
+++ compiler/intermod.m 21 Jul 2002 04:58:53 -0000
@@ -706,8 +706,8 @@
% Fully module-qualify the right-hand-side of a unification.
% For function calls and higher-order terms, call intermod__add_proc
% so that the predicate or function will be exported if necessary.
-intermod__module_qualify_unify_rhs(_LVar, functor(Functor, Vars),
- functor(Functor, Vars), DoWrite) -->
+intermod__module_qualify_unify_rhs(_LVar, functor(Functor, E, Vars),
+ functor(Functor, E, Vars), DoWrite) -->
(
%
% Is this a higher-order predicate or higher-order function
@@ -1593,7 +1593,7 @@
RHS = var(RHSVar),
RHSTerm = term__variable(RHSVar)
;
- RHS = functor(ConsId, Args),
+ RHS = functor(ConsId, _, Args),
term__context_init(Context),
(
ConsId = int_const(Int),
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.77
diff -u -u -r1.77 lambda.m
--- compiler/lambda.m 28 Mar 2002 03:43:07 -0000 1.77
+++ compiler/lambda.m 21 Jul 2002 04:40:52 -0000
@@ -575,7 +575,7 @@
ModuleInfo)
),
ConsId = pred_const(PredId, ProcId, EvalMethod),
- Functor = functor(ConsId, ArgVars),
+ Functor = functor(ConsId, no, ArgVars),
RLExprnId = no,
Unification = construct(Var, ConsId, ArgVars, UniModes,
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.30
diff -u -u -r1.30 magic.m
--- compiler/magic.m 28 Mar 2002 03:43:11 -0000 1.30
+++ compiler/magic.m 21 Jul 2002 03:31:35 -0000
@@ -1281,7 +1281,7 @@
construct_dynamically, cell_is_unique, RLExprnId),
Context = unify_context(explicit, []),
goal_info_init(NonLocals, Delta, det, GoalInfo),
- Goal = unify(Var, functor(ConsId, []), UnifyMode, Uni, Context) -
+ Goal = unify(Var, functor(ConsId, no, []), UnifyMode, Uni, Context) -
GoalInfo.
%-----------------------------------------------------------------------------%
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.22
diff -u -u -r1.22 magic_util.m
--- compiler/magic_util.m 30 Jun 2002 17:06:19 -0000 1.22
+++ compiler/magic_util.m 21 Jul 2002 03:33:41 -0000
@@ -489,8 +489,8 @@
{ pred_info_module(CallPredInfo, PredModule) },
{ pred_info_name(CallPredInfo, PredName) },
{ list__length(InputVars, Arity) },
- { Rhs = functor(cons(qualified(PredModule, PredName),
- Arity), InputVars) },
+ { Rhs = functor(cons(qualified(PredModule, PredName), Arity),
+ no, InputVars) },
{ RLExprnId = no },
{ Uni = construct(Var, ConsId, InputVars, Modes,
@@ -829,7 +829,7 @@
{ pred_info_name(PredInfo, SuppName) },
{ list__length(LambdaInputs, SuppArity) },
{ Rhs = functor(cons(qualified(SuppModule, SuppName),
- SuppArity), LambdaInputs) },
+ SuppArity), no, LambdaInputs) },
{ RLExprnId = no },
{ Unify = construct(InputVar,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.417
diff -u -u -r1.417 make_hlds.m
--- compiler/make_hlds.m 19 Jul 2002 10:40:19 -0000 1.417
+++ compiler/make_hlds.m 21 Jul 2002 04:50:37 -0000
@@ -5178,8 +5178,8 @@
warn_singletons([X, Y], NonLocals, QuantVars, VarSet,
Context, CallPredId).
-warn_singletons_in_unify(X, functor(_ConsId, Vars), GoalInfo, QuantVars, VarSet,
- CallPredId, _) -->
+warn_singletons_in_unify(X, functor(_ConsId, _, Vars), GoalInfo,
+ QuantVars, VarSet, CallPredId, _) -->
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
{ goal_info_get_context(GoalInfo, Context) },
warn_singletons([X | Vars], NonLocals, QuantVars, VarSet,
@@ -6583,7 +6583,7 @@
field_access_function_name(AccessType, FieldName, FuncName),
list__length(Args, Arity),
Functor = cons(FuncName, Arity),
- make_atomic_unification(RetArg, functor(Functor, Args),
+ make_atomic_unification(RetArg, functor(Functor, no, Args),
Context, MainContext, SubContext, Goal, Info0, Info).
:- type field_list == assoc_list(ctor_field_name, list(prog_term)).
@@ -7765,7 +7765,7 @@
{ FunctorArgs = Args }
),
( { FunctorArgs = [] } ->
- { make_atomic_unification(X, functor(ConsId, []),
+ { make_atomic_unification(X, functor(ConsId, no, []),
Context, MainContext, SubContext, Goal0,
Info0, Info) },
{ Goal0 = GoalExpr - GoalInfo0 },
@@ -7778,7 +7778,7 @@
{ make_fresh_arg_vars(FunctorArgs, VarSet1,
HeadVars, VarSet2) },
{ make_atomic_unification(X,
- functor(ConsId, HeadVars), Context,
+ functor(ConsId, no, HeadVars), Context,
MainContext, SubContext, Goal0,
Info0, Info1) },
{ ArgContext = functor(ConsId,
@@ -8056,7 +8056,7 @@
ConsId = cons(SymName, Arity),
goal_info_get_context(GoalInfo, Context),
hlds_goal__create_atomic_unification(RetArg,
- functor(ConsId, FuncArgs), Context,
+ functor(ConsId, no, FuncArgs), Context,
explicit, [], GoalExpr - _),
Goal = GoalExpr - GoalInfo
).
@@ -8075,7 +8075,7 @@
Rhs = lambda_goal(_, _, _, _, _, _, _, _),
Info = Info0
;
- Rhs = functor(ConsId, _),
+ Rhs = functor(ConsId, _, _),
record_used_functor(ConsId, Info0, Info)
),
hlds_goal__create_atomic_unification(Var, Rhs, Context,
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.51
diff -u -u -r1.51 modecheck_unify.m
--- compiler/modecheck_unify.m 28 Mar 2002 03:43:22 -0000 1.51
+++ compiler/modecheck_unify.m 21 Jul 2002 08:07:27 -0000
@@ -108,8 +108,9 @@
Unify = unify(X, var(Y), Modes, Unification, UnifyContext)
).
-modecheck_unification(X0, functor(ConsId0, ArgVars0), Unification0,
- UnifyContext, GoalInfo0, Goal, ModeInfo0, ModeInfo) :-
+modecheck_unification(X0, functor(ConsId0, IsExistConstruction, ArgVars0),
+ Unification0, UnifyContext, GoalInfo0, Goal,
+ ModeInfo0, ModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
mode_info_get_var_types(ModeInfo0, VarTypes0),
map__lookup(VarTypes0, X0, TypeOfX),
@@ -157,9 +158,9 @@
% It's not a higher-order pred unification - just
% call modecheck_unify_functor to do the ordinary thing.
%
- modecheck_unify_functor(X0, TypeOfX,
- ConsId0, ArgVars0, Unification0, UnifyContext,
- GoalInfo0, Goal, ModeInfo0, ModeInfo)
+ modecheck_unify_functor(X0, TypeOfX, ConsId0,
+ IsExistConstruction, ArgVars0, Unification0,
+ UnifyContext, GoalInfo0, Goal, ModeInfo0, ModeInfo)
).
modecheck_unification(X,
@@ -393,15 +394,16 @@
RHS = RHS0
).
-:- pred modecheck_unify_functor(prog_var, (type), cons_id, list(prog_var),
+:- pred modecheck_unify_functor(prog_var, (type), cons_id,
+ is_existential_construction, list(prog_var),
unification, unify_context, hlds_goal_info, hlds_goal_expr,
mode_info, mode_info).
-:- mode modecheck_unify_functor(in, in, in, in, in, in, in,
+:- mode modecheck_unify_functor(in, in, in, in, in, in, in, in,
out, mode_info_di, mode_info_uo) is det.
-modecheck_unify_functor(X, TypeOfX, ConsId0, ArgVars0, Unification0,
- UnifyContext, GoalInfo0, Goal, ModeInfo0,
- FinalModeInfo) :-
+modecheck_unify_functor(X0, TypeOfX, ConsId0, IsExistConstruction, ArgVars0,
+ Unification0, UnifyContext, GoalInfo0, Goal,
+ ModeInfo0, FinalModeInfo) :-
mode_info_get_module_info(ModeInfo0, ModuleInfo0),
mode_info_get_how_to_check(ModeInfo0, HowToCheckGoal),
@@ -441,12 +443,38 @@
InstConsId = ConsId
),
mode_info_get_instmap(ModeInfo0, InstMap0),
- instmap__lookup_var(InstMap0, X, InstOfX),
+ instmap__lookup_var(InstMap0, X0, InstOfX0),
instmap__lookup_vars(ArgVars0, InstMap0, InstArgs),
- mode_info_var_is_live(ModeInfo0, X, LiveX),
mode_info_var_list_is_live(ArgVars0, ModeInfo0, LiveArgs),
InstOfY = bound(unique, [functor(InstConsId, InstArgs)]),
(
+ % If the unification was originally of the form
+ % X = 'new f'(Y) it must be classified as a
+ % construction. If it were classified as a
+ % deconstruction, the argument unifications would
+ % be ill-typed.
+ IsExistConstruction = yes,
+ \+ inst_is_free(ModuleInfo0, InstOfX0)
+ ->
+ % To make sure the unification is classified as
+ % a construction, if X is already bound, we must
+ % add a unification with an extra variable:
+ % Z = 'new f'(Y),
+ % X = Z.
+
+ InstOfX = free,
+ LiveX = live,
+ make_complicated_sub_unify(X0, X, ExtraGoals0,
+ ModeInfo0, ModeInfo1)
+ ;
+ InstOfX = InstOfX0,
+ X = X0,
+ mode_info_var_is_live(ModeInfo0, X, LiveX),
+ ExtraGoals0 = no_extra_goals,
+ ModeInfo1 = ModeInfo0
+ ),
+ (
+
% The occur check: X = f(X) is considered a mode error
% unless X is ground. (Actually it wouldn't be that
% hard to generate code for it - it always fails! -
@@ -460,7 +488,7 @@
mode_info_error(WaitingVars,
mode_error_unify_var_functor(X, InstConsId, ArgVars0,
InstOfX, InstArgs),
- ModeInfo0, ModeInfo1
+ ModeInfo1, ModeInfo2
),
Inst = not_reached,
Det = erroneous,
@@ -472,16 +500,16 @@
ModeOfX = (InstOfX -> Inst),
ModeOfY = (InstOfY -> Inst),
Mode = ModeOfX - ModeOfY,
- modecheck_set_var_inst(X, Inst, ModeInfo1, ModeInfo2),
- ( bind_args(Inst, ArgVars0, ModeInfo2, ModeInfo3) ->
- ModeInfo = ModeInfo3
+ modecheck_set_var_inst(X, Inst, ModeInfo2, ModeInfo3),
+ ( bind_args(Inst, ArgVars0, ModeInfo3, ModeInfo4) ->
+ ModeInfo = ModeInfo4
;
error("bind_args failed")
),
% return any old garbage
Unification = Unification0,
ArgVars = ArgVars0,
- ExtraGoals = no_extra_goals
+ ExtraGoals1 = no_extra_goals
;
abstractly_unify_inst_functor(LiveX, InstOfX, InstConsId,
InstArgs, LiveArgs, real_unify, ModuleInfo0,
@@ -489,7 +517,7 @@
->
Inst = UnifyInst,
Det = Det1,
- mode_info_set_module_info(ModeInfo0, ModuleInfo1, ModeInfo1),
+ mode_info_set_module_info(ModeInfo1, ModuleInfo1, ModeInfo2),
ModeOfX = (InstOfX -> Inst),
ModeOfY = (InstOfY -> Inst),
Mode = ModeOfX - ModeOfY,
@@ -509,17 +537,17 @@
;
error("get_(inst/mode)_of_args failed")
),
- mode_info_get_var_types(ModeInfo1, VarTypes),
+ mode_info_get_var_types(ModeInfo2, VarTypes),
categorize_unify_var_functor(ModeOfX, ModeOfXArgs, ModeArgs,
X, ConsId, ArgVars0, VarTypes, UnifyContext,
- Unification0, ModeInfo1,
- Unification1, ModeInfo2),
+ Unification0, ModeInfo2,
+ Unification1, ModeInfo3),
split_complicated_subunifies(Unification1, ArgVars0,
- Unification, ArgVars, ExtraGoals,
- ModeInfo2, ModeInfo3),
- modecheck_set_var_inst(X, Inst, ModeInfo3, ModeInfo4),
- ( bind_args(Inst, ArgVars, ModeInfo4, ModeInfo5) ->
- ModeInfo = ModeInfo5
+ Unification, ArgVars, ExtraGoals1,
+ ModeInfo3, ModeInfo4),
+ modecheck_set_var_inst(X, Inst, ModeInfo4, ModeInfo5),
+ ( bind_args(Inst, ArgVars, ModeInfo5, ModeInfo6) ->
+ ModeInfo = ModeInfo6
;
error("bind_args failed")
)
@@ -528,7 +556,7 @@
mode_info_error(WaitingVars,
mode_error_unify_var_functor(X, InstConsId, ArgVars0,
InstOfX, InstArgs),
- ModeInfo0, ModeInfo1
+ ModeInfo1, ModeInfo2
),
% If we get an error, set the inst to not_reached
% to avoid cascading errors
@@ -540,16 +568,16 @@
ModeOfX = (InstOfX -> Inst),
ModeOfY = (InstOfY -> Inst),
Mode = ModeOfX - ModeOfY,
- modecheck_set_var_inst(X, Inst, ModeInfo1, ModeInfo2),
- ( bind_args(Inst, ArgVars0, ModeInfo2, ModeInfo3) ->
- ModeInfo = ModeInfo3
+ modecheck_set_var_inst(X, Inst, ModeInfo2, ModeInfo3),
+ ( bind_args(Inst, ArgVars0, ModeInfo3, ModeInfo4) ->
+ ModeInfo = ModeInfo4
;
error("bind_args failed")
),
% return any old garbage
Unification = Unification0,
ArgVars = ArgVars0,
- ExtraGoals = no_extra_goals
+ ExtraGoals1 = no_extra_goals
),
%
@@ -559,8 +587,8 @@
% them with `fail'.
%
(
- Unification = construct(ConstructTarget, _, _, _, _, _, _),
- mode_info_var_is_live(ModeInfo, ConstructTarget, dead)
+ Unification = construct(_, _, _, _, _, _, _),
+ LiveX = dead
->
Goal = conj([]),
FinalModeInfo = ModeInfo
@@ -576,10 +604,9 @@
Goal = disj([]),
FinalModeInfo = ModeInfo
;
- Functor = functor(ConsId, ArgVars),
+ Functor = functor(ConsId, IsExistConstruction, ArgVars),
Unify = unify(X, Functor, Mode, Unification,
UnifyContext),
- X = X0,
%
% modecheck_unification sometimes needs to introduce
% new goals to handle complicated sub-unifications
@@ -589,6 +616,7 @@
% (If it did in other cases, the code would be wrong since it
% wouldn't have the correct determinism annotations.)
%
+ append_extra_goals(ExtraGoals0, ExtraGoals1, ExtraGoals),
(
HowToCheckGoal = check_unique_modes,
ExtraGoals \= no_extra_goals,
@@ -657,24 +685,12 @@
mode_to_arg_mode(ModuleInfo, ModeX, VarType, top_in),
mode_to_arg_mode(ModuleInfo, ModeY, VarType, top_in)
->
- % introduce a new variable `Var'
- mode_info_get_varset(ModeInfo0, VarSet0),
- mode_info_get_var_types(ModeInfo0, VarTypes0),
- varset__new_var(VarSet0, Var, VarSet),
- map__set(VarTypes0, Var, VarType, VarTypes),
- mode_info_set_varset(VarSet, ModeInfo0, ModeInfo1),
- mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo2),
-
- modecheck_unify__create_var_var_unification(Var0, Var,
- VarType, ModeInfo2, ExtraGoal),
-
- % insert the new unification at
- % the start of the extra goals
- ExtraGoals0 = extra_goals([], [ExtraGoal]),
+ make_complicated_sub_unify(Var0, Var, ExtraGoals0,
+ ModeInfo0, ModeInfo1),
% recursive call to handle the remaining variables...
split_complicated_subunifies_2(Vars0, UniModes0,
- Vars1, ExtraGoals1, ModeInfo2, ModeInfo),
+ Vars1, ExtraGoals1, ModeInfo1, ModeInfo),
Vars = [Var | Vars1],
append_extra_goals(ExtraGoals0, ExtraGoals1, ExtraGoals)
;
@@ -683,6 +699,27 @@
Vars = [Var0 | Vars1]
).
+:- pred make_complicated_sub_unify(prog_var::in, prog_var::out,
+ extra_goals::out, mode_info::mode_info_di,
+ mode_info::mode_info_uo) is det.
+
+make_complicated_sub_unify(Var0, Var, ExtraGoals0, ModeInfo0, ModeInfo) :-
+ % introduce a new variable `Var'
+ mode_info_get_varset(ModeInfo0, VarSet0),
+ mode_info_get_var_types(ModeInfo0, VarTypes0),
+ varset__new_var(VarSet0, Var, VarSet),
+ map__lookup(VarTypes0, Var0, VarType),
+ map__set(VarTypes0, Var, VarType, VarTypes),
+ mode_info_set_varset(VarSet, ModeInfo0, ModeInfo1),
+ mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo),
+
+ modecheck_unify__create_var_var_unification(Var0, Var,
+ VarType, ModeInfo, ExtraGoal),
+
+ % insert the new unification at
+ % the start of the extra goals
+ ExtraGoals0 = extra_goals([], [ExtraGoal]).
+
modecheck_unify__create_var_var_unification(Var0, Var, Type, ModeInfo,
Goal - GoalInfo) :-
mode_info_get_context(ModeInfo, Context),
@@ -1031,7 +1068,7 @@
RHS = functor(
cons(qualified(PredModule, PredName),
Arity),
- ArgVars)
+ no, ArgVars)
;
error("categorize_unify_var_lambda - \
reintroduced lambda goal")
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.226
diff -u -u -r1.226 polymorphism.m
--- compiler/polymorphism.m 21 Jul 2002 03:09:59 -0000 1.226
+++ compiler/polymorphism.m 21 Jul 2002 04:42:45 -0000
@@ -1204,7 +1204,7 @@
{ Goal = unify(XVar, Y, Mode, Unification,
UnifyContext) - GoalInfo }
;
- { Y = functor(ConsId, Args) },
+ { Y = functor(ConsId, _, Args) },
polymorphism__process_unify_functor(XVar, ConsId, Args, Mode,
Unification0, UnifyContext, GoalInfo0, Goal)
;
@@ -1416,8 +1416,8 @@
polymorphism__unification_typeinfos(TypeOfX, Unification0,
GoalInfo1, Unification, GoalInfo, PolyInfo1, PolyInfo),
- Unify = unify(X0, functor(ConsId, ArgVars), Mode0,
- Unification, UnifyContext) - GoalInfo,
+ Unify = unify(X0, functor(ConsId, IsConstruction, ArgVars),
+ Mode0, Unification, UnifyContext) - GoalInfo,
list__append(ExtraGoals, [Unify], GoalList),
conj_list_to_goal(GoalList, GoalInfo0, Goal)
;
@@ -1428,7 +1428,7 @@
%
polymorphism__unification_typeinfos(TypeOfX, Unification0,
GoalInfo0, Unification, GoalInfo, PolyInfo0, PolyInfo),
- Goal = unify(X0, functor(ConsId0, ArgVars0), Mode0,
+ Goal = unify(X0, functor(ConsId0, no, ArgVars0), Mode0,
Unification, UnifyContext) - GoalInfo
).
@@ -1456,7 +1456,7 @@
CallUnifyContext = call_unify_context(X0,
functor(cons(QualifiedPName, list__length(ArgVars0)),
- ArgVars0),
+ no, ArgVars0),
UnifyContext),
LambdaGoalExpr = call(PredId, ProcId, Args, not_builtin,
yes(CallUnifyContext), QualifiedPName),
@@ -2475,7 +2475,7 @@
InstanceString),
ConsId = base_typeclass_info_const(InstanceModuleName, ClassId,
InstanceNum, InstanceString),
- BaseTypeClassInfoTerm = functor(ConsId, []),
+ BaseTypeClassInfoTerm = functor(ConsId, no, []),
% create the construction unification to initialize the variable
RLExprnId = no,
@@ -2501,7 +2501,7 @@
mercury_private_builtin_module(PrivateBuiltin),
NewConsId = cons(qualified(PrivateBuiltin, "typeclass_info"), 1),
NewArgVars = [BaseVar|ArgVars],
- TypeClassInfoTerm = functor(NewConsId, NewArgVars),
+ TypeClassInfoTerm = functor(NewConsId, no, NewArgVars),
% introduce a new variable
polymorphism__new_typeclass_info_var(VarSet1, VarTypes1,
@@ -2875,7 +2875,7 @@
CountUnification = construct(CountVar, CountConsId, [], [],
construct_dynamically, cell_is_shared, RLExprnId),
- CountTerm = functor(CountConsId, []),
+ CountTerm = functor(CountConsId, no, []),
CountInst = bound(unique, [functor(int_const(Num), [])]),
CountUnifyMode = (free -> CountInst) - (CountInst -> CountInst),
CountUnifyContext = unify_context(explicit, []),
@@ -2976,7 +2976,7 @@
mercury_private_builtin_module(PrivateBuiltin),
ConsId = cons(qualified(PrivateBuiltin, Symbol), 1),
- TypeInfoTerm = functor(ConsId, ArgVars),
+ TypeInfoTerm = functor(ConsId, no, ArgVars),
% introduce a new variable
polymorphism__new_type_info_var_raw(Type, Symbol, typeinfo_prefix,
@@ -3035,7 +3035,7 @@
type_util__type_ctor_name(ModuleInfo, TypeCtor, TypeName),
TypeCtor = _ - Arity,
ConsId = type_ctor_info_const(ModuleName, TypeName, Arity),
- TypeInfoTerm = functor(ConsId, []),
+ TypeInfoTerm = functor(ConsId, no, []),
% introduce a new variable
polymorphism__new_type_info_var_raw(Type, "type_ctor_info",
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.40
diff -u -u -r1.40 post_typecheck.m
--- compiler/post_typecheck.m 14 Jul 2002 15:12:38 -0000 1.40
+++ compiler/post_typecheck.m 21 Jul 2002 04:45:57 -0000
@@ -1246,7 +1246,7 @@
invalid_proc_id(ProcId),
list__append(ArgVars0, [X0], ArgVars),
FuncCallUnifyContext = call_unify_context(X0,
- functor(ConsId0, ArgVars0), UnifyContext),
+ functor(ConsId0, no, ArgVars0), UnifyContext),
FuncCall = call(PredId, ProcId, ArgVars, not_builtin,
yes(FuncCallUnifyContext), QualifiedFuncName),
@@ -1281,7 +1281,7 @@
->
get_proc_id(ModuleInfo, PredId, ProcId),
ConsId = pred_const(PredId, ProcId, EvalMethod),
- Goal = unify(X0, functor(ConsId, ArgVars0), Mode0,
+ Goal = unify(X0, functor(ConsId, no, ArgVars0), Mode0,
Unification0, UnifyContext) - GoalInfo0,
PredInfo = PredInfo0,
VarTypes = VarTypes0,
@@ -1338,7 +1338,7 @@
;
ConsId = ConsId0
),
- Goal = unify(X0, functor(ConsId, ArgVars0), Mode0,
+ Goal = unify(X0, functor(ConsId, no, ArgVars0), Mode0,
Unification0, UnifyContext) - GoalInfo0
).
@@ -1461,7 +1461,7 @@
goal_info_get_nonlocals(OldGoalInfo, RestrictNonLocals),
create_atomic_unification_with_nonlocals(TermInputVar,
- functor(ConsId, ArgVars), OldGoalInfo,
+ functor(ConsId, no, ArgVars), OldGoalInfo,
RestrictNonLocals, [FieldVar, TermInputVar],
UnifyContext, FunctorGoal),
FunctorGoal = GoalExpr - _.
@@ -1505,7 +1505,7 @@
DeconstructRestrictNonLocals),
create_atomic_unification_with_nonlocals(TermInputVar,
- functor(ConsId0, DeconstructArgs), OldGoalInfo,
+ functor(ConsId0, no, DeconstructArgs), OldGoalInfo,
DeconstructRestrictNonLocals, [TermInputVar | DeconstructArgs],
UnifyContext, DeconstructGoal),
@@ -1532,7 +1532,7 @@
),
create_atomic_unification_with_nonlocals(TermOutputVar,
- functor(ConsId, ConstructArgs), OldGoalInfo,
+ functor(ConsId, no, ConstructArgs), OldGoalInfo,
ConstructRestrictNonLocals, [TermOutputVar | ConstructArgs],
UnifyContext, ConstructGoal),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.47
diff -u -u -r1.47 purity.m
--- compiler/purity.m 14 Jul 2002 15:12:39 -0000 1.47
+++ compiler/purity.m 21 Jul 2002 04:46:14 -0000
@@ -691,7 +691,7 @@
{ GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext) },
{ ActualPurity = pure }
;
- { RHS0 = functor(ConsId, Args) }
+ { RHS0 = functor(ConsId, _, Args) }
->
RunPostTypecheck =^ run_post_typecheck,
(
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.82
diff -u -u -r1.82 quantification.m
--- compiler/quantification.m 28 Mar 2002 03:43:34 -0000 1.82
+++ compiler/quantification.m 21 Jul 2002 04:57:46 -0000
@@ -605,8 +605,8 @@
var(X), Unification) -->
{ singleton_set(Vars, X) },
quantification__set_nonlocals(Vars).
-implicitly_quantify_unify_rhs(functor(Functor, ArgVars), Reuse, Unification, _,
- functor(Functor, ArgVars), Unification) -->
+implicitly_quantify_unify_rhs(functor(_, _, ArgVars) @ RHS, Reuse,
+ Unification, _, RHS, Unification) -->
quantification__get_nonlocals_to_recompute(NonLocalsToRecompute),
{
NonLocalsToRecompute = code_gen_nonlocals,
@@ -1029,7 +1029,7 @@
Set0, LambdaSet, Set, LambdaSet) :-
insert(Set0, Y, Set).
quantification__unify_rhs_vars(NonLocalsToRecompute,
- functor(_Functor, ArgVars), Reuse,
+ functor(_Functor, _, ArgVars), Reuse,
Set0, LambdaSet, Set, LambdaSet) :-
(
NonLocalsToRecompute = code_gen_nonlocals,
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.104
diff -u -u -r1.104 simplify.m
--- compiler/simplify.m 5 Jun 2002 16:41:13 -0000 1.104
+++ compiler/simplify.m 21 Jul 2002 04:48:15 -0000
@@ -1917,7 +1917,7 @@
UnifyContext = unify_context(explicit, []),
Unification = deconstruct(Var, ConsId,
ArgVars, UniModes, can_fail, no),
- ExtraGoal = unify(Var, functor(ConsId, ArgVars),
+ ExtraGoal = unify(Var, functor(ConsId, no, ArgVars),
UniMode, Unification, UnifyContext),
set__singleton_set(NonLocals, Var),
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.321
diff -u -u -r1.321 typecheck.m
--- compiler/typecheck.m 9 Jul 2002 01:29:59 -0000 1.321
+++ compiler/typecheck.m 21 Jul 2002 04:48:36 -0000
@@ -828,7 +828,7 @@
adjust_func_arity(function, FuncArity, PredArity),
FuncSymName = qualified(FuncModule, FuncName),
create_atomic_unification(FuncRetVal,
- functor(cons(FuncSymName, FuncArity), FuncArgs),
+ functor(cons(FuncSymName, FuncArity), no, FuncArgs),
Context, explicit, [], Goal0),
Goal0 = GoalExpr - GoalInfo0,
set__list_to_set(HeadVars, NonLocals),
@@ -2389,7 +2389,7 @@
typecheck_unification(X, var(Y), var(Y)) -->
typecheck_unify_var_var(X, Y).
-typecheck_unification(X, functor(F, As), functor(F, As)) -->
+typecheck_unification(X, functor(F, E, As), functor(F, E, As)) -->
=(OrigTypeCheckInfo),
{ typecheck_info_get_type_assign_set(OrigTypeCheckInfo,
OrigTypeAssignSet) },
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.111
diff -u -u -r1.111 unify_proc.m
--- compiler/unify_proc.m 30 Jun 2002 17:06:45 -0000 1.111
+++ compiler/unify_proc.m 21 Jul 2002 04:49:48 -0000
@@ -986,10 +986,10 @@
unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars1),
unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars2),
{ create_atomic_unification(
- H1, functor(FunctorConsId, Vars1), Context, explicit, [],
+ H1, functor(FunctorConsId, no, Vars1), Context, explicit, [],
UnifyH1_Goal) },
{ create_atomic_unification(
- H2, functor(FunctorConsId, Vars2), Context, explicit, [],
+ H2, functor(FunctorConsId, no, Vars2), Context, explicit, [],
UnifyH2_Goal) },
unify_proc__unify_var_lists(ArgTypes, ExistQTVars, Vars1, Vars2,
UnifyArgs_Goal),
@@ -1035,10 +1035,10 @@
{ FunctorConsId = cons(FunctorName, FunctorArity) },
unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, ArgVars),
{ create_atomic_unification(
- X, functor(FunctorConsId, ArgVars), Context, explicit, [],
+ X, functor(FunctorConsId, no, ArgVars), Context, explicit, [],
UnifyX_Goal) },
{ create_atomic_unification(
- Index, functor(int_const(N), []), Context, explicit, [],
+ Index, functor(int_const(N), no, []), Context, explicit, [],
UnifyIndex_Goal) },
{ GoalList = [UnifyX_Goal, UnifyIndex_Goal] },
{ goal_info_init(GoalInfo0) },
@@ -1245,12 +1245,12 @@
Call_Greater_Than),
{ create_atomic_unification(
- Res, functor(cons(unqualified("<"), 0), []),
+ Res, functor(cons(unqualified("<"), 0), no, []),
Context, explicit, [],
Return_Less_Than) },
{ create_atomic_unification(
- Res, functor(cons(unqualified(">"), 0), []),
+ Res, functor(cons(unqualified(">"), 0), no, []),
Context, explicit, [],
Return_Greater_Than) },
@@ -1322,10 +1322,10 @@
unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars1),
unify_proc__make_fresh_vars(ArgTypes, ExistQTVars, Vars2),
{ create_atomic_unification(
- X, functor(FunctorConsId, Vars1), Context, explicit, [],
+ X, functor(FunctorConsId, no, Vars1), Context, explicit, [],
UnifyX_Goal) },
{ create_atomic_unification(
- Y, functor(FunctorConsId, Vars2), Context, explicit, [],
+ Y, functor(FunctorConsId, no, Vars2), Context, explicit, [],
UnifyY_Goal) },
unify_proc__compare_args(ArgTypes, ExistQTVars, Vars1, Vars2,
R, Context, CompareArgs_Goal),
@@ -1350,13 +1350,13 @@
unify_proc__make_fresh_vars(ArgTypes1, ExistQTVars1, Vars1),
unify_proc__make_fresh_vars(ArgTypes2, ExistQTVars2, Vars2),
{ create_atomic_unification(
- X, functor(FunctorConsId1, Vars1), Context, explicit, [],
+ X, functor(FunctorConsId1, no, Vars1), Context, explicit, [],
UnifyX_Goal) },
{ create_atomic_unification(
- Y, functor(FunctorConsId2, Vars2), Context, explicit, [],
+ Y, functor(FunctorConsId2, no, Vars2), Context, explicit, [],
UnifyY_Goal) },
{ create_atomic_unification(
- R, functor(cons(unqualified(CompareOp), 0), []),
+ R, functor(cons(unqualified(CompareOp), 0), no, []),
Context, explicit, [],
ReturnResult) },
{ GoalList = [UnifyX_Goal, UnifyY_Goal, ReturnResult] },
@@ -1411,7 +1411,7 @@
unify_proc__compare_args_2([], _, [], [], R, Context, Return_Equal) -->
{ create_atomic_unification(
- R, functor(cons(unqualified("="), 0), []),
+ R, functor(cons(unqualified("="), 0), no, []),
Context, explicit, [],
Return_Equal) }.
unify_proc__compare_args_2([_Name - Type|ArgTypes], ExistQTVars, [X|Xs], [Y|Ys],
@@ -1446,7 +1446,7 @@
Do_Comparison),
{ create_atomic_unification(
- R1, functor(cons(unqualified("="), 0), []),
+ R1, functor(cons(unqualified("="), 0), no, []),
Context, explicit, [],
Check_Equal) },
{ Check_Not_Equal = not(Check_Equal) - GoalInfo },
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.158
diff -u -u -r1.158 Mmakefile
--- tests/hard_coded/Mmakefile 16 Jul 2002 08:10:47 -0000 1.158
+++ tests/hard_coded/Mmakefile 21 Jul 2002 06:35:27 -0000
@@ -147,6 +147,7 @@
type_to_term_bug \
unify_expression \
unify_typeinfo_bug \
+ unify_existq_cons \
unused_float_box_test \
user_defined_equality2 \
write \
Index: tests/hard_coded/unify_existq_cons.exp
===================================================================
RCS file: tests/hard_coded/unify_existq_cons.exp
diff -N tests/hard_coded/unify_existq_cons.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/unify_existq_cons.exp 21 Jul 2002 06:38:19 -0000
@@ -0,0 +1 @@
+test succeeded
Index: tests/hard_coded/unify_existq_cons.m
===================================================================
RCS file: tests/hard_coded/unify_existq_cons.m
diff -N tests/hard_coded/unify_existq_cons.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/unify_existq_cons.m 21 Jul 2002 06:38:02 -0000
@@ -0,0 +1,33 @@
+:- module unify_existq_cons.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module enum, char, int.
+
+:- type tc
+ ---> some [T] tc(T) => enum(T).
+
+main -->
+ (
+ { p('new tc'('a'))
+ ; p('new tc'(2))
+ }
+ ->
+ io__write_string("test failed\n")
+ ;
+ io__write_string("test succeeded\n")
+ ).
+
+:- pred p(tc::in) is semidet.
+
+% Mode analysis must treat the headvar unification here as a construction
+% followed by a var-var unification. If it treats it as a deconstruction
+% the argument unifications will be ill-typed.
+p('new tc'(1)).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list