[m-dev.] for review: polymorphic ground insts [1/3]
David Overton
dmo at ender.cs.mu.oz.au
Wed Feb 9 13:39:28 AEDT 2000
Index: compiler/accumulator.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/accumulator.m,v
retrieving revision 1.8
diff -u -r1.8 accumulator.m
--- compiler/accumulator.m 2000/01/10 00:43:42 1.8
+++ compiler/accumulator.m 2000/01/19 04:25:26
@@ -606,6 +606,7 @@
proc_info_typeinfo_varmap(ProcInfo, TVarMap),
proc_info_typeclass_info_varmap(ProcInfo, TCVarsMap),
proc_info_is_address_taken(ProcInfo, IsAddressTaken),
+ proc_info_inst_varset(ProcInfo, InstVarSet),
accumulator__extra_vars_for_recursive_call(PreDP, DP, C, Vars),
@@ -622,9 +623,9 @@
list__map(map__lookup(VarTypes), NewHeadVars, NewTypes),
- proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
- Context, TVarMap, TCVarsMap, IsAddressTaken,
- NewProcInfo).
+ proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet,
+ Detism, Goal, Context, TVarMap, TCVarsMap, IsAddressTaken,
+ NewProcInfo).
%
% accumulator__new_acc_var(Hs, IM, VS0, VT0, HstoAs0, HstoAs,
@@ -663,7 +664,7 @@
% However this will no longer handle partially
% instantiated data structures.
% instmap__lookup_var(InstMap, Var, Inst),
- Inst = ground(shared, no),
+ Inst = ground(shared, none),
inst_lists_to_mode_list([Inst], [Inst], Mode),
list__append(Mode, Modes0, Modes).
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.29
diff -u -r1.29 check_typeclass.m
--- compiler/check_typeclass.m 1999/12/03 12:54:54 1.29
+++ compiler/check_typeclass.m 2000/02/03 05:25:31
@@ -1,5 +1,5 @@
%---------------------------------------------------------------------------%
-% Copyright (C) 1996-1999 The University of Melbourne.
+% Copyright (C) 1996-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
@@ -223,7 +223,7 @@
% arguments.
class_constraints, % Constraints from
% class method.
- list(pair(list(mode), determinism)), % Modes and
+ list(modes_and_detism), % Modes and
% determinisms of the
% required procs.
error_messages, % Error messages
@@ -284,7 +284,9 @@
proc_info_argmodes(ProcInfo, Modes),
proc_info_interface_determinism(ProcInfo,
Detism),
- ModesAndDetism = Modes - Detism
+ proc_info_inst_varset(ProcInfo, InstVarSet),
+ ModesAndDetism = modes_and_detism(Modes,
+ InstVarSet, Detism)
)),
ProcIds,
ArgModes),
@@ -308,6 +310,9 @@
_ExistQVars, _ArgTypes, _ClassContext, _ArgModes, Errors,
_ArgTypeVars, _Status, _PredOrFunc).
+:- type modes_and_detism
+ ---> modes_and_detism(list(mode), inst_varset, determinism).
+
:- pred check_instance_pred_procs(class_id, list(tvar), sym_name,
hlds_instance_defn, hlds_instance_defn,
instance_method_info, instance_method_info).
@@ -551,9 +556,9 @@
AddProc = lambda([ModeAndDet::in, NewProcId::out,
OldPredInfo::in, NewPredInfo::out] is det,
(
- ModeAndDet = Modes - Det,
- add_new_proc(OldPredInfo, PredArity, Modes, yes(Modes), no,
- yes(Det), Context, address_is_taken,
+ ModeAndDet = modes_and_detism(Modes, InstVarSet, Det),
+ add_new_proc(OldPredInfo, InstVarSet, PredArity, Modes,
+ yes(Modes), no, yes(Det), Context, address_is_taken,
NewPredInfo, NewProcId)
)),
list__map_foldl(AddProc, ArgModes, InstanceProcIds,
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.26
diff -u -r1.26 clause_to_proc.m
--- compiler/clause_to_proc.m 1999/08/31 05:25:29 1.26
+++ compiler/clause_to_proc.m 2000/02/03 05:25:34
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1995-1999 The University of Melbourne.
+% Copyright (C) 1995-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -50,7 +50,7 @@
:- import_module hlds_goal, hlds_data, prog_data, mode_util, make_hlds, purity.
:- import_module globals.
-:- import_module bool, int, set, map.
+:- import_module bool, int, set, map, varset.
maybe_add_default_func_modes([], Preds, Preds).
maybe_add_default_func_modes([PredId | PredIds], Preds0, Preds) :-
@@ -87,7 +87,9 @@
Determinism = det,
pred_info_context(PredInfo0, Context),
MaybePredArgLives = no,
- add_new_proc(PredInfo0, PredArity, PredArgModes,
+ varset__init(InstVarSet),
+ % No inst_vars in default func mode.
+ add_new_proc(PredInfo0, InstVarSet, PredArity, PredArgModes,
yes(PredArgModes), MaybePredArgLives, yes(Determinism),
Context, address_is_not_taken, PredInfo, ProcId),
MaybeProcId = yes(ProcId)
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.12
diff -u -r1.12 deforest.m
--- compiler/deforest.m 1999/10/25 03:48:42 1.12
+++ compiler/deforest.m 2000/02/03 05:27:39
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1999 University of Melbourne.
+% Copyright (C) 1999-2000 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -122,8 +122,9 @@
{ proc_info_get_initial_instmap(ProcInfo3,
ModuleInfo2, InstMap0) },
{ proc_info_vartypes(ProcInfo3, VarTypes) },
- { recompute_instmap_delta(yes, Goal3, Goal,
- VarTypes, InstMap0, ModuleInfo2, ModuleInfo3) },
+ { proc_info_inst_varset(ProcInfo3, InstVarSet) },
+ { recompute_instmap_delta(yes, Goal3, Goal, VarTypes,
+ InstVarSet, InstMap0, ModuleInfo2, ModuleInfo3) },
pd_info_set_module_info(ModuleInfo3),
pd_info_get_pred_info(PredInfo),
Index: compiler/dnf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dnf.m,v
retrieving revision 1.39
diff -u -r1.39 dnf.m
--- compiler/dnf.m 2000/01/13 06:15:21 1.39
+++ compiler/dnf.m 2000/01/19 04:31:36
@@ -147,11 +147,12 @@
pred_info_get_aditi_owner(PredInfo0, Owner),
proc_info_goal(ProcInfo0, Goal0),
proc_info_varset(ProcInfo0, VarSet),
+ proc_info_inst_varset(ProcInfo0, InstVarSet),
proc_info_vartypes(ProcInfo0, VarTypes),
proc_info_typeinfo_varmap(ProcInfo0, TVarMap),
proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap),
DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext,
- VarSet, Markers, TVarMap, TCVarMap, Owner),
+ VarSet, InstVarSet, Markers, TVarMap, TCVarMap, Owner),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap),
dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic,
@@ -166,6 +167,7 @@
map(prog_var, type),
class_constraints,
prog_varset,
+ inst_varset,
pred_markers,
map(tvar, type_info_locn),
map(class_constraint, prog_var),
@@ -389,7 +391,7 @@
dnf__define_new_pred(Goal0, Goal, InstMap0, PredName, DnfInfo,
ModuleInfo0, ModuleInfo, PredId) :-
DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext,
- VarSet, Markers, TVarMap, TCVarMap, Owner),
+ VarSet, InstVarSet, Markers, TVarMap, TCVarMap, Owner),
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_nonlocals(GoalInfo, NonLocals),
set__to_sorted_list(NonLocals, ArgVars),
@@ -398,7 +400,7 @@
% that are not part of the goal.
hlds_pred__define_new_pred(Goal0, Goal, ArgVars, _, InstMap0, PredName,
TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap,
- VarSet, Markers, Owner, address_is_not_taken,
+ VarSet, InstVarSet, Markers, Owner, address_is_not_taken,
ModuleInfo0, ModuleInfo, PredProcId),
PredProcId = proc(PredId, _).
Index: compiler/follow_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.54
diff -u -r1.54 follow_code.m
--- compiler/follow_code.m 1999/10/25 03:48:48 1.54
+++ compiler/follow_code.m 2000/02/03 05:25:49
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1994-1999 The University of Melbourne.
+% Copyright (C) 1994-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -57,8 +57,9 @@
Varset0, VarTypes0, Goal2, Varset, VarTypes, _Warnings),
proc_info_get_initial_instmap(ProcInfo0,
ModuleInfo0, InstMap0),
- recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstMap0,
- ModuleInfo0, ModuleInfo)
+ proc_info_inst_varset(ProcInfo0, InstVarSet),
+ recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstVarSet,
+ InstMap0, ModuleInfo0, ModuleInfo)
;
Goal = Goal0,
Varset = Varset0,
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.61
diff -u -r1.61 higher_order.m
--- compiler/higher_order.m 2000/01/13 06:15:24 1.61
+++ compiler/higher_order.m 2000/01/27 05:04:34
@@ -392,8 +392,9 @@
RecomputeAtomic = no,
proc_info_get_initial_instmap(ProcInfo2, ModuleInfo0, InstMap),
proc_info_vartypes(ProcInfo2, VarTypes),
+ proc_info_inst_varset(ProcInfo2, InstVarSet),
recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3,
- VarTypes, InstMap, ModuleInfo0, ModuleInfo),
+ VarTypes, InstVarSet, InstMap, ModuleInfo0, ModuleInfo),
proc_info_set_goal(ProcInfo2, Goal3, ProcInfo),
Info = info(A, B, C, D, E, ProcInfo, ModuleInfo, H, Changed)
;
@@ -885,7 +886,7 @@
set__list_to_set(Args, NonLocals),
instmap_delta_init_reachable(InstMapDelta0),
instmap_delta_insert(InstMapDelta0, ArgTypeClassInfoVar,
- ground(shared, no), InstMapDelta),
+ ground(shared, none), InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
CallGoal = call(PredId, ProcId, Args, not_builtin,
MaybeContext, SymName) - GoalInfo,
@@ -1684,7 +1685,7 @@
NewCallArgs = [ComparisonResult,
UnwrappedArg1, UnwrappedArg2],
instmap_delta_from_assoc_list(
- [ComparisonResult - ground(shared, no)],
+ [ComparisonResult - ground(shared, none)],
InstMapDelta),
Detism = det,
% Build a new call with the unwrapped arguments.
@@ -1723,13 +1724,13 @@
proc_info_create_var_from_type(ProcInfo0, WrappedType, UnwrappedArg,
ProcInfo),
ConsId = cons(Constructor, 1),
- UniModes = [(ground(shared, no) - free) ->
- (ground(shared, no) - ground(shared, no))],
+ UniModes = [(ground(shared, none) - free) ->
+ (ground(shared, none) - ground(shared, none))],
in_mode(In),
out_mode(Out),
set__list_to_set([Arg, UnwrappedArg], NonLocals),
% This will be recomputed later.
- instmap_delta_from_assoc_list([UnwrappedArg - ground(shared, no)],
+ instmap_delta_from_assoc_list([UnwrappedArg - ground(shared, none)],
InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
Goal = unify(Arg, functor(ConsId, [UnwrappedArg]), In - Out,
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.71
diff -u -r1.71 hlds_pred.m
--- compiler/hlds_pred.m 2000/02/08 15:07:46 1.71
+++ compiler/hlds_pred.m 2000/02/09 00:27:06
@@ -452,10 +452,10 @@
:- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(prog_var),
list(prog_var), instmap, string, tvarset, vartypes,
class_constraints, type_info_varmap, typeclass_info_varmap,
- prog_varset, pred_markers, aditi_owner, is_address_taken,
- module_info, module_info, pred_proc_id).
+ prog_varset, inst_varset, pred_markers, aditi_owner,
+ is_address_taken, module_info, module_info, pred_proc_id).
:- mode hlds_pred__define_new_pred(in, out, in, out, in, in, in, in, in,
- in, in, in, in, in, in, in, out, out) is det.
+ in, in, in, in, in, in, in, in, out, out) is det.
% Various predicates for accessing the information stored in the
% pred_id and pred_info data structures.
@@ -1227,7 +1227,7 @@
hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0,
PredName, TVarSet, VarTypes0, ClassContext, TVarMap, TCVarMap,
- VarSet0, Markers, Owner, IsAddressTaken,
+ VarSet0, InstVarSet, Markers, Owner, IsAddressTaken,
ModuleInfo0, ModuleInfo, PredProcId) :-
Goal0 = _GoalExpr - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
@@ -1279,8 +1279,9 @@
TermInfo = no
),
- proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, Detism, Goal0,
- Context, TVarMap, TCVarMap, IsAddressTaken, ProcInfo0),
+ proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, InstVarSet,
+ Detism, Goal0, Context, TVarMap, TCVarMap, IsAddressTaken,
+ ProcInfo0),
proc_info_set_maybe_termination_info(ProcInfo0, TermInfo, ProcInfo),
set__init(Assertions),
@@ -1329,18 +1330,19 @@
:- mode proc_info_init(in, in, in, in, in, in, in, in, out) is det.
:- pred proc_info_set(maybe(determinism), prog_varset, vartypes,
- list(prog_var), list(mode), maybe(list(is_live)), hlds_goal,
- prog_context, stack_slots, determinism, bool, list(arg_info),
- liveness_info, type_info_varmap, typeclass_info_varmap,
- maybe(arg_size_info), maybe(termination_info), is_address_taken,
- proc_info).
-:- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in,
- in, in, in, in, out) is det.
+ list(prog_var), list(mode), inst_varset, maybe(list(is_live)),
+ hlds_goal, prog_context, stack_slots, determinism, bool,
+ list(arg_info), liveness_info, type_info_varmap,
+ typeclass_info_varmap, maybe(arg_size_info),
+ maybe(termination_info), is_address_taken, proc_info).
+:- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in,
+ in, in, in, in, in, in, in, out) is det.
:- pred proc_info_create(prog_varset, vartypes, list(prog_var),
- list(mode), determinism, hlds_goal, prog_context,
+ list(mode), inst_varset, determinism, hlds_goal, prog_context,
type_info_varmap, typeclass_info_varmap, is_address_taken, proc_info).
-:- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, out) is det.
+:- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, in, out)
+ is det.
:- pred proc_info_set_body(proc_info, prog_varset, vartypes,
list(prog_var), hlds_goal, type_info_varmap,
@@ -1390,6 +1392,12 @@
:- pred proc_info_set_argmodes(proc_info, list(mode), proc_info).
:- mode proc_info_set_argmodes(in, in, out) is det.
+:- pred proc_info_inst_varset(proc_info, inst_varset).
+:- mode proc_info_inst_varset(in, out) is det.
+
+:- pred proc_info_set_inst_varset(proc_info, inst_varset, proc_info).
+:- mode proc_info_set_inst_varset(in, in, out) is det.
+
:- pred proc_info_arglives(proc_info, module_info, list(is_live)).
:- mode proc_info_arglives(in, in, out) is det.
@@ -1540,54 +1548,60 @@
:- type proc_info
---> procedure(
- maybe(determinism),
+ declared_determinism :: maybe(determinism),
% _declared_ determinism
% or `no' if there was no detism decl
- prog_varset, % variable names
- vartypes, % variable types
- list(prog_var), % head vars
- list(mode), % modes of args
- maybe(list(is_live)),
+ varset :: prog_varset, % variable names
+ vartypes :: vartypes, % variable types
+ headvars :: list(prog_var), % head vars
+ argmodes :: list(mode), % modes of args
+ inst_varset :: inst_varset,
+ maybe_arglives :: maybe(list(is_live)),
% liveness (in the mode analysis sense)
% of the arguments
- hlds_goal, % Body
- prog_context,
+ goal :: hlds_goal, % Body
+ context :: prog_context,
% The context of the `:- mode' decl
% (or the context of the first clause,
% if there was no mode declaration).
- stack_slots, % stack allocations
- determinism, % _inferred_ determinism
- bool, % no if we must not process this
+ stack_slots :: stack_slots, % stack allocations
+ inferred_determinism :: determinism,
+ % _inferred_ determinism
+ can_process :: bool,
+ % no if we must not process this
% procedure yet (used to delay
% mode checking etc. for complicated
% modes of unification procs until
% the end of the unique_modes pass.)
- list(arg_info), % calling convention of each arg:
+ arg_info :: list(arg_info),
+ % calling convention of each arg:
% information computed by arg_info.m
% (based on the modes etc.)
% and used by code generation
% to determine how each argument
% should be passed.
- liveness_info, % the initial liveness,
+ liveness_info :: liveness_info,
+ % the initial liveness,
% for code generation
- type_info_varmap,
+ typeinfo_varmap :: type_info_varmap,
% typeinfo vars for type parameters
- typeclass_info_varmap,
+ typeclass_info_varmap :: typeclass_info_varmap,
% typeclass_info vars for class
% constraints
- eval_method, % how should the proc be evaluated
- maybe(arg_size_info),
+ eval_method :: eval_method,
+ % how should the proc be evaluated
+ maybe_arg_size_info :: maybe(arg_size_info),
% Information about the relative sizes
% of the input and output args of the
% procedure. Set by termination
% analysis.
- maybe(termination_info),
+ maybe_termination_info :: maybe(termination_info),
% The termination properties of the
% procedure. Set by termination
% analysis.
- maybe(list(mode)),
+ maybe_declared_argmodes :: maybe(list(mode)),
% declared modes of arguments.
- is_address_taken,
+ is_address_taken :: is_address_taken,
% Is the address of this procedure
% taken? If yes, we will need to use
% typeinfo liveness for them, so that
@@ -1598,7 +1612,7 @@
% must be considered as having its
% address taken, since it is possible
% that some other module may do so.
- maybe(rl_exprn_id)
+ rl_exprn_id :: maybe(rl_exprn_id)
% For predicates with an
% `aditi_top_down' marker, which are
% executed top-down on the Aditi side
@@ -1619,6 +1633,7 @@
varset__init(BodyVarSet0),
make_n_fresh_vars("HeadVar__", Arity, BodyVarSet0,
HeadVars, BodyVarSet),
+ varset__init(InstVarSet),
map__from_corresponding_lists(HeadVars, Types, BodyTypes),
InferredDet = erroneous,
map__init(StackSlots),
@@ -1631,40 +1646,46 @@
map__init(TCVarsMap),
RLExprn = no,
NewProc = procedure(
- MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives,
- ClauseBody, MContext, StackSlots, InferredDet, CanProcess,
- ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, eval_normal,
- no, no, DeclaredModes, IsAddressTaken, RLExprn
+ MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, InstVarSet,
+ MaybeArgLives, ClauseBody, MContext, StackSlots,
+ InferredDet, CanProcess, ArgInfo, InitialLiveness,
+ TVarsMap, TCVarsMap, eval_normal, no, no, DeclaredModes,
+ IsAddressTaken, RLExprn
).
proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
- HeadLives, Goal, Context, StackSlots, InferredDetism,
- CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, ArgSizes,
- Termination, IsAddressTaken, ProcInfo) :-
+ InstVarSet, HeadLives, Goal, Context, StackSlots,
+ InferredDetism, CanProcess, ArgInfo, Liveness, TVarMap,
+ TCVarsMap, ArgSizes, Termination, IsAddressTaken,
+ ProcInfo) :-
RLExprn = no,
ProcInfo = procedure(
- DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
- HeadLives, Goal, Context, StackSlots, InferredDetism,
- CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, eval_normal,
- ArgSizes, Termination, no, IsAddressTaken, RLExprn).
+ DeclaredDetism, BodyVarSet, BodyTypes, HeadVars,
+ HeadModes, InstVarSet, HeadLives, Goal, Context,
+ StackSlots, InferredDetism, CanProcess, ArgInfo,
+ Liveness, TVarMap, TCVarsMap, eval_normal, ArgSizes,
+ Termination, no, IsAddressTaken, RLExprn).
-proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal,
- Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :-
+proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet, Detism,
+ Goal, Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :-
map__init(StackSlots),
set__init(Liveness),
MaybeHeadLives = no,
RLExprn = no,
ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes,
- MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [],
- Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no,
- IsAddressTaken, RLExprn).
+ InstVarSet, MaybeHeadLives, Goal, Context, StackSlots,
+ Detism, yes, [], Liveness, TVarMap, TCVarsMap,
+ eval_normal, no, no, no, IsAddressTaken, RLExprn).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal,
TI_VarMap, TCI_VarMap, ProcInfo) :-
- ProcInfo0 = procedure(A, _, _, _, E, F, _,
- H, I, J, K, L, M, _, _, P, Q, R, S, T, U),
- ProcInfo = procedure(A, VarSet, VarTypes, HeadVars, E, F, Goal,
- H, I, J, K, L, M, TI_VarMap, TCI_VarMap, P, Q, R, S, T, U).
+ ProcInfo = ((((((ProcInfo0
+ ^varset := VarSet)
+ ^vartypes := VarTypes)
+ ^headvars := HeadVars)
+ ^goal := Goal)
+ ^typeinfo_varmap := TI_VarMap)
+ ^typeclass_info_varmap := TCI_VarMap).
proc_info_interface_determinism(ProcInfo, Determinism) :-
proc_info_declared_determinism(ProcInfo, MaybeDeterminism),
@@ -1719,91 +1740,51 @@
;
proc_info_argmodes(ProcInfo, ArgModes)
).
+
+proc_info_declared_determinism(ProcInfo, ProcInfo^declared_determinism).
+
+proc_info_varset(ProcInfo, ProcInfo^varset).
+
+proc_info_vartypes(ProcInfo, ProcInfo^vartypes).
+
+proc_info_headvars(ProcInfo, ProcInfo^headvars).
+
+proc_info_argmodes(ProcInfo, ProcInfo^argmodes).
+
+proc_info_inst_varset(ProcInfo, ProcInfo^inst_varset).
+
+proc_info_maybe_arglives(ProcInfo, ProcInfo^maybe_arglives).
+
+proc_info_goal(ProcInfo, ProcInfo^goal).
+
+proc_info_context(ProcInfo, ProcInfo^context).
+
+proc_info_stack_slots(ProcInfo, ProcInfo^stack_slots).
+
+proc_info_inferred_determinism(ProcInfo, ProcInfo^inferred_determinism).
+
+proc_info_can_process(ProcInfo, ProcInfo^can_process).
+
+proc_info_arg_info(ProcInfo, ProcInfo^arg_info).
+
+proc_info_liveness_info(ProcInfo, ProcInfo^liveness_info).
+
+proc_info_typeinfo_varmap(ProcInfo, ProcInfo^typeinfo_varmap).
+
+proc_info_typeclass_info_varmap(ProcInfo, ProcInfo^typeclass_info_varmap).
+
+proc_info_eval_method(ProcInfo, ProcInfo^eval_method).
+
+proc_info_get_maybe_arg_size_info(ProcInfo, ProcInfo^maybe_arg_size_info).
-proc_info_declared_determinism(ProcInfo, A) :-
- ProcInfo = procedure(A, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_varset(ProcInfo, B) :-
- ProcInfo = procedure(_, B, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_vartypes(ProcInfo, C) :-
- ProcInfo = procedure(_, _, C, _, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_headvars(ProcInfo, D) :-
- ProcInfo = procedure(_, _, _, D, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_argmodes(ProcInfo, E) :-
- ProcInfo = procedure(_, _, _, _, E, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_maybe_arglives(ProcInfo, F) :-
- ProcInfo = procedure(_, _, _, _, _, F, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_goal(ProcInfo, G) :-
- ProcInfo = procedure(_, _, _, _, _, _, G, _, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_context(ProcInfo, H) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, H, _, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_stack_slots(ProcInfo, I) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, I, _, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_inferred_determinism(ProcInfo, J) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, J, _, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_can_process(ProcInfo, K) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, K, _, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_arg_info(ProcInfo, L) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, L, _, _, _, _,
- _, _, _, _, _).
-
-proc_info_liveness_info(ProcInfo, M) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, M, _, _, _,
- _, _, _, _, _).
-
-proc_info_typeinfo_varmap(ProcInfo, N) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, N, _, _,
- _, _, _, _, _).
-
-proc_info_typeclass_info_varmap(ProcInfo, O) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, O, _,
- _, _, _, _, _).
-
-proc_info_eval_method(ProcInfo, P) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, P,
- _, _, _, _, _).
-
-proc_info_get_maybe_arg_size_info(ProcInfo, Q) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
- Q, _, _, _, _).
-
-proc_info_get_maybe_termination_info(ProcInfo, R) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
- _, R, _, _, _).
-
-proc_info_maybe_declared_argmodes(ProcInfo, S) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, S, _, _).
-
-proc_info_is_address_taken(ProcInfo, T) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, T, _).
-
-proc_info_get_rl_exprn_id(ProcInfo, U) :-
- ProcInfo = procedure(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
- _, _, _, _, U).
+proc_info_get_maybe_termination_info(ProcInfo, ProcInfo^maybe_termination_info).
+proc_info_maybe_declared_argmodes(ProcInfo, ProcInfo^maybe_declared_argmodes).
+
+proc_info_is_address_taken(ProcInfo, ProcInfo^is_address_taken).
+
+proc_info_get_rl_exprn_id(ProcInfo, ProcInfo^rl_exprn_id).
+
% :- type proc_info
% ---> procedure(
% A maybe(determinism),
@@ -1869,114 +1850,48 @@
% % expression, for which this is an
% % identifier. See rl_update.m.
% ).
+
+proc_info_set_varset(ProcInfo, X, ProcInfo^varset := X).
+
+proc_info_set_vartypes(ProcInfo, X, ProcInfo^vartypes := X).
+
+proc_info_set_headvars(ProcInfo, X, ProcInfo^headvars := X).
+
+proc_info_set_argmodes(ProcInfo, X, ProcInfo^argmodes := X).
+
+proc_info_set_inst_varset(ProcInfo, X, ProcInfo^inst_varset := X).
+
+proc_info_set_maybe_arglives(ProcInfo, X, ProcInfo^maybe_arglives := X).
+
+proc_info_set_goal(ProcInfo, X, ProcInfo^goal := X).
+
+proc_info_set_stack_slots(ProcInfo, X, ProcInfo^stack_slots := X).
+
+proc_info_set_inferred_determinism(ProcInfo, X,
+ ProcInfo^inferred_determinism := X).
+
+proc_info_set_can_process(ProcInfo, X, ProcInfo^can_process := X).
+
+proc_info_set_arg_info(ProcInfo, X, ProcInfo^arg_info := X).
+
+proc_info_set_liveness_info(ProcInfo, X, ProcInfo^liveness_info := X).
+
+proc_info_set_typeinfo_varmap(ProcInfo, X, ProcInfo^typeinfo_varmap := X).
+
+proc_info_set_typeclass_info_varmap(ProcInfo, X,
+ ProcInfo^typeclass_info_varmap := X).
+
+proc_info_set_eval_method(ProcInfo, X, ProcInfo^eval_method := X).
+
+proc_info_set_maybe_arg_size_info(ProcInfo, X,
+ ProcInfo^maybe_arg_size_info := X).
+
+proc_info_set_maybe_termination_info(ProcInfo, X,
+ ProcInfo^maybe_termination_info := X).
+
+proc_info_set_rl_exprn_id(ProcInfo, X, ProcInfo^rl_exprn_id := yes(X)).
-proc_info_set_varset(ProcInfo0, B, ProcInfo) :-
- ProcInfo0 = procedure(A, _, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_vartypes(ProcInfo0, C, ProcInfo) :-
- ProcInfo0 = procedure(A, B, _, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_headvars(ProcInfo0, D, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, _, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_argmodes(ProcInfo0, E, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, _, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_maybe_arglives(ProcInfo0, F, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, _, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_goal(ProcInfo0, G, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, _, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_stack_slots(ProcInfo0, I, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, _, J, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_inferred_determinism(ProcInfo0, J, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, _, K, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_can_process(ProcInfo0, K, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, _, L, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_arg_info(ProcInfo0, L, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, _, M, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_liveness_info(ProcInfo0, M, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, _, N, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_typeinfo_varmap(ProcInfo0, N, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, _, O,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_typeclass_info_varmap(ProcInfo0, O, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, _,
- P, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_eval_method(ProcInfo0, P, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- _, Q, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_maybe_arg_size_info(ProcInfo0, Q, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, _, R, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_maybe_termination_info(ProcInfo0, R, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, _, S, T, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_address_taken(ProcInfo0, T, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, _, U),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, U).
-
-proc_info_set_rl_exprn_id(ProcInfo0, U, ProcInfo) :-
- ProcInfo0 = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, _),
- ProcInfo = procedure(A, B, C, D, E, F, G, H, I, J, K, L, M, N, O,
- P, Q, R, S, T, yes(U)).
+proc_info_set_address_taken(ProcInfo, X, ProcInfo^is_address_taken := X).
proc_info_get_typeinfo_vars_setwise(ProcInfo, Vars, TypeInfoVars) :-
set__to_sorted_list(Vars, VarList),
Index: compiler/inst.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst.m,v
retrieving revision 1.6
diff -u -r1.6 inst.m
--- compiler/inst.m 1999/07/08 05:08:52 1.6
+++ compiler/inst.m 2000/02/04 00:04:23
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1997, 1999 The University of Melbourne.
+% Copyright (C) 1997, 2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -23,7 +23,7 @@
% `abstract_cons_id' and use that here instead of `cons_id'.
:- import_module prog_data, hlds_data.
-:- import_module list, std_util.
+:- import_module list, map.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -34,7 +34,7 @@
; free(type)
; bound(uniqueness, list(bound_inst))
% The list(bound_inst) must be sorted
- ; ground(uniqueness, maybe(pred_inst_info))
+ ; ground(uniqueness, ground_inst_info)
% The pred_inst_info is used for
% higher-order pred modes
; not_reached
@@ -65,6 +65,11 @@
% on backtracking, so we will need to
% restore the old value on backtracking
+:- type ground_inst_info
+ ---> higher_order(pred_inst_info)
+ ; constrained_inst_var(inst_var)
+ ; none.
+
% higher-order predicate terms are given the inst
% `ground(shared, yes(PredInstInfo))'
% where the PredInstInfo contains the extra modes and the determinism
@@ -88,6 +93,8 @@
).
:- type bound_inst ---> functor(cons_id, list(inst)).
+
+:- type inst_var_sub == map(inst_var, inst).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/inst_match.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst_match.m,v
retrieving revision 1.43
diff -u -r1.43 inst_match.m
--- compiler/inst_match.m 1998/11/20 04:07:55 1.43
+++ compiler/inst_match.m 2000/02/08 04:57:39
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1995-1998 The University of Melbourne.
+% Copyright (C) 1995-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -53,9 +53,13 @@
%-----------------------------------------------------------------------------%
-:- pred inst_matches_initial(inst, inst, module_info).
-:- mode inst_matches_initial(in, in, in) is semidet.
+:- pred inst_matches_initial(inst, inst, type, module_info).
+:- mode inst_matches_initial(in, in, in, in) is semidet.
+:- pred inst_matches_initial(inst, inst, type, module_info, module_info,
+ inst_var_sub, inst_var_sub).
+:- mode inst_matches_initial(in, in, in, in, out, in, out) is semidet.
+
:- pred inst_matches_final(inst, inst, module_info).
:- mode inst_matches_final(in, in, in) is semidet.
@@ -255,103 +259,315 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_data, mode_util, prog_data, inst_util.
+:- import_module hlds_data, mode_util, prog_data, inst_util, type_util.
:- import_module list, set, map, term, std_util, require.
+
+inst_matches_initial(InstA, InstB, Type, ModuleInfo) :-
+ map__init(Sub0),
+ inst_matches_initial(InstA, InstB, Type, ModuleInfo, _, Sub0, _).
-inst_matches_initial(InstA, InstB, ModuleInfo) :-
+inst_matches_initial(InstA, InstB, Type, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
set__init(Expansions),
- inst_matches_initial_2(InstA, InstB, ModuleInfo, Expansions).
+ inst_matches_initial_2(InstA, InstB, yes(Type), Expansions, ModuleInfo0,
+ ModuleInfo, Sub0, Sub).
:- type expansions == set(pair(inst)).
-:- pred inst_matches_initial_2(inst, inst, module_info, expansions).
-:- mode inst_matches_initial_2(in, in, in, in) is semidet.
+:- pred inst_matches_initial_2(inst, inst, maybe(type), expansions,
+ module_info, module_info, inst_var_sub, inst_var_sub).
+:- mode inst_matches_initial_2(in, in, in, in, in, out, in, out) is semidet.
-inst_matches_initial_2(InstA, InstB, ModuleInfo, Expansions) :-
+inst_matches_initial_2(InstA, InstB, Type, Expansions, ModuleInfo0, ModuleInfo,
+ Sub0, Sub) :-
ThisExpansion = InstA - InstB,
( set__member(ThisExpansion, Expansions) ->
- true
+ Sub = Sub0,
+ ModuleInfo = ModuleInfo0
/*********
% does this test improve efficiency??
; InstA = InstB ->
true
**********/
;
- inst_expand(ModuleInfo, InstA, InstA2),
- inst_expand(ModuleInfo, InstB, InstB2),
+ inst_expand(ModuleInfo0, InstA, InstA2),
+ inst_expand(ModuleInfo0, InstB, InstB2),
set__insert(Expansions, ThisExpansion, Expansions2),
- inst_matches_initial_3(InstA2, InstB2, ModuleInfo, Expansions2)
+ inst_matches_initial_3(InstA2, InstB2, Type, Expansions2,
+ ModuleInfo0, ModuleInfo, Sub0, Sub)
).
-:- pred inst_matches_initial_3(inst, inst, module_info, expansions).
-:- mode inst_matches_initial_3(in, in, in, in) is semidet.
+:- pred inst_matches_initial_3(inst, inst, maybe(type), expansions,
+ module_info, module_info, inst_var_sub, inst_var_sub).
+:- mode inst_matches_initial_3(in, in, in, in, in, out, in, out) is semidet.
% To avoid infinite regress, we assume that
% inst_matches_initial is true for any pairs of insts which
% occur in `Expansions'.
-inst_matches_initial_3(any(UniqA), any(UniqB), _, _) :-
+inst_matches_initial_3(any(UniqA), any(UniqB), _, _, M, M, S, S) :-
unique_matches_initial(UniqA, UniqB).
-inst_matches_initial_3(any(_), free, _, _).
-inst_matches_initial_3(free, any(_), _, _).
-inst_matches_initial_3(free, free, _, _).
-inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), ModuleInfo, _) :-
+inst_matches_initial_3(any(_), free, _, _, M, M, S, S).
+inst_matches_initial_3(free, any(_), _, _, M, M, S, S).
+inst_matches_initial_3(free, free, _, _, M, M, S, S).
+inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), _, _,
+ ModuleInfo, ModuleInfo, S, S) :-
unique_matches_initial(UniqA, UniqB),
bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo).
-inst_matches_initial_3(bound(_Uniq, _List), free, _, _).
-inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo,
- Expansions) :-
+inst_matches_initial_3(bound(_Uniq, _List), free, _, _, M, M, S, S).
+inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB), Type,
+ Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
unique_matches_initial(UniqA, UniqB),
- bound_inst_list_matches_initial(ListA, ListB, ModuleInfo, Expansions).
-inst_matches_initial_3(bound(UniqA, ListA), ground(UniqB, no), ModuleInfo, _) :-
+ bound_inst_list_matches_initial(ListA, ListB, Type, Expansions,
+ ModuleInfo0, ModuleInfo, Sub0, Sub).
+inst_matches_initial_3(bound(UniqA, ListA), ground(UniqB, none), _, _,
+ ModuleInfo, ModuleInfo, S, S) :-
unique_matches_initial(UniqA, UniqB),
bound_inst_list_is_ground(ListA, ModuleInfo),
bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo).
-inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), ModuleInfo, _) :-
+inst_matches_initial_3(bound(UniqA, ListA),
+ ground(UniqB, constrained_inst_var(V)), _, _,
+ ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ unique_matches_initial(UniqA, UniqB),
+ bound_inst_list_is_ground(ListA, ModuleInfo0),
+ bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo0),
+ abstractly_unify_inst(live, bound(UniqA, ListA), ground(UniqB, none),
+ fake_unify, ModuleInfo0, Inst, _Det, ModuleInfo1),
+ update_inst_var_sub(V, Inst, ModuleInfo1, ModuleInfo, Sub0, Sub).
+inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), _, _, ModuleInfo,
+ ModuleInfo, S, S) :-
Uniq = unique,
bound_inst_list_is_ground(List, ModuleInfo),
bound_inst_list_is_unique(List, ModuleInfo).
-inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), ModuleInfo, _) :-
+inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), _, _, ModuleInfo,
+ ModuleInfo, S, S) :-
Uniq = mostly_unique,
bound_inst_list_is_ground(List, ModuleInfo),
bound_inst_list_is_mostly_unique(List, ModuleInfo).
-inst_matches_initial_3(ground(UniqA, _PredInst), any(UniqB), _, _) :-
+inst_matches_initial_3(ground(UniqA, _PredInst), any(UniqB), _, _, M, M, S, S)
+ :-
unique_matches_initial(UniqA, UniqB).
-inst_matches_initial_3(ground(_Uniq, _PredInst), free, _, _).
-inst_matches_initial_3(ground(UniqA, _), bound(UniqB, List), ModuleInfo, _) :-
+inst_matches_initial_3(ground(_Uniq, _PredInst), free, _, _, M, M, S, S).
+inst_matches_initial_3(ground(UniqA, GII), bound(UniqB, List), MaybeType,
+ Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ MaybeType = yes(Type),
+ % We can only check this case properly if the type is known.
+ GII \= constrained_inst_var(_),
+ % Don't overly constrain the inst_var.
unique_matches_initial(UniqA, UniqB),
- uniq_matches_bound_inst_list(UniqA, List, ModuleInfo),
- fail. % XXX BUG! should fail only if
- % List does not include all the constructors for the type,
- % or if List contains some not_reached insts.
- % Should succeed if List contains all the constructors
- % for the type. Problem is we don't know what the type was :-(
-inst_matches_initial_3(ground(UniqA, PredInstA), ground(UniqB, PredInstB),
- ModuleInfo, _) :-
- maybe_pred_inst_matches_initial(PredInstA, PredInstB, ModuleInfo),
- unique_matches_initial(UniqA, UniqB).
-inst_matches_initial_3(ground(_UniqA, no), abstract_inst(_,_), _, _) :-
+ bound_inst_list_is_complete_for_type(set__init, ModuleInfo0, List,
+ Type),
+ ground_matches_initial_bound_inst_list(UniqA, List, yes(Type),
+ Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub).
+inst_matches_initial_3(ground(UniqA, GroundInstInfoA),
+ ground(UniqB, GroundInstInfoB), Type, Expansions,
+ ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ unique_matches_initial(UniqA, UniqB),
+ ground_inst_info_matches_initial(GroundInstInfoA, GroundInstInfoB,
+ UniqA, UniqB, Type, Expansions, ModuleInfo0, ModuleInfo,
+ Sub0, Sub).
+inst_matches_initial_3(ground(_UniqA, none), abstract_inst(_,_),_,_,_,_,_,_) :-
% I don't know what this should do.
% Abstract insts aren't really supported.
error("inst_matches_initial(ground, abstract_inst) == ??").
-inst_matches_initial_3(abstract_inst(_,_), any(shared), _, _).
-inst_matches_initial_3(abstract_inst(_,_), free, _, _).
+inst_matches_initial_3(abstract_inst(_,_), any(shared), _, _, M, M, S, S).
+inst_matches_initial_3(abstract_inst(_,_), free, _, _, M, M, S, S).
inst_matches_initial_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
- ModuleInfo, Expansions) :-
- inst_list_matches_initial(ArgsA, ArgsB, ModuleInfo, Expansions).
-inst_matches_initial_3(not_reached, _, _, _).
+ _Type, Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ list__duplicate(length(ArgsA), no, MaybeTypes),
+ % XXX how do we get the argument types for an abstract inst?
+ inst_list_matches_initial(ArgsA, ArgsB, MaybeTypes, Expansions,
+ ModuleInfo0, ModuleInfo, Sub0, Sub).
+inst_matches_initial_3(not_reached, _, _, _, M, M, S, S).
%-----------------------------------------------------------------------------%
-:- pred maybe_pred_inst_matches_initial(maybe(pred_inst_info),
- maybe(pred_inst_info), module_info).
-:- mode maybe_pred_inst_matches_initial(in, in, in) is semidet.
+:- pred ground_matches_initial_bound_inst_list(uniqueness, list(bound_inst),
+ maybe(type), expansions, module_info, module_info,
+ inst_var_sub, inst_var_sub).
+:- mode ground_matches_initial_bound_inst_list(in, in, in, in, in, out,
+ in, out) is semidet.
+
+ground_matches_initial_bound_inst_list(_, [], _, _, M, M, S, S).
+ground_matches_initial_bound_inst_list(Uniq, [functor(ConsId, Args) | List],
+ MaybeType, Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ maybe_get_arg_types(ModuleInfo0, MaybeType, ConsId, MaybeTypes),
+ ground_matches_initial_inst_list(Uniq, Args, MaybeTypes, Expansions,
+ ModuleInfo0, ModuleInfo1, Sub0, Sub1),
+ ground_matches_initial_bound_inst_list(Uniq, List, MaybeType,
+ Expansions, ModuleInfo1, ModuleInfo, Sub1, Sub).
+
+:- pred ground_matches_initial_inst_list(uniqueness, list(inst),
+ list(maybe(type)), expansions, module_info, module_info,
+ inst_var_sub, inst_var_sub).
+:- mode ground_matches_initial_inst_list(in, in, in, in, in, out, in, out)
+ is semidet.
+
+ground_matches_initial_inst_list(_, [], [], _, M, M, S, S).
+ground_matches_initial_inst_list(Uniq, [Inst | Insts], [Type | Types],
+ Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ inst_matches_initial_2(ground(Uniq, none), Inst, Type, Expansions,
+ ModuleInfo0, ModuleInfo1, Sub0, Sub1),
+ ground_matches_initial_inst_list(Uniq, Insts, Types, Expansions,
+ ModuleInfo1, ModuleInfo, Sub1, Sub).
-maybe_pred_inst_matches_initial(no, no, _).
-maybe_pred_inst_matches_initial(yes(_), no, _).
-maybe_pred_inst_matches_initial(yes(PredInstA), yes(PredInstB), ModuleInfo) :-
- pred_inst_matches(PredInstA, PredInstB, ModuleInfo).
+%-----------------------------------------------------------------------------%
+
+:- pred bound_inst_list_is_complete_for_type(set(inst_name), module_info,
+ list(bound_inst), type).
+:- mode bound_inst_list_is_complete_for_type(in, in, in, in) is semidet.
+
+bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, BoundInsts, Type)
+ :-
+ % Is this a type for which cons_ids are recorded in the type_table?
+ type_util__cons_id_arg_types(ModuleInfo, Type, _, _),
+
+ % Is there a bound_inst for each cons_id in the type_table?
+ all [ConsId, ArgTypes] (
+ type_util__cons_id_arg_types(ModuleInfo, Type, ConsId,
+ ArgTypes)
+ =>
+ (
+ list__member(functor(ConsId0, ArgInsts), BoundInsts),
+ % Cons_ids returned from type_util__cons_id_arg_types
+ % are not module-qualified so we need to call
+ % equivalent_cons_ids instead of just using `=/2'.
+ equivalent_cons_ids(ConsId0, ConsId),
+ list__map(inst_is_complete_for_type(Expansions,
+ ModuleInfo), ArgInsts, ArgTypes)
+ )
+ ).
+
+:- pred inst_is_complete_for_type(set(inst_name), module_info, inst, type).
+:- mode inst_is_complete_for_type(in, in, in, in) is semidet.
+
+inst_is_complete_for_type(Expansions, ModuleInfo, Inst, Type) :-
+ ( Inst = defined_inst(InstName) ->
+ ( set__member(InstName, Expansions) ->
+ true
+ ;
+ inst_lookup(ModuleInfo, InstName, ExpandedInst),
+ inst_is_complete_for_type(Expansions `insert` InstName,
+ ModuleInfo, ExpandedInst, Type)
+ )
+ ; Inst = bound(_, List) ->
+ bound_inst_list_is_complete_for_type(Expansions, ModuleInfo,
+ List, Type)
+ ;
+ true
+ ).
+
+:- pred equivalent_cons_ids(cons_id, cons_id).
+:- mode equivalent_cons_ids(in, in) is semidet.
+
+equivalent_cons_ids(ConsIdA, ConsIdB) :-
+ (
+ ConsIdA = cons(NameA, ArityA),
+ ConsIdB = cons(NameB, ArityB)
+ ->
+ ArityA = ArityB,
+ equivalent_sym_names(NameA, NameB)
+ ;
+ ConsIdA = ConsIdB
+ ).
+:- pred equivalent_sym_names(sym_name, sym_name).
+:- mode equivalent_sym_names(in, in) is semidet.
+
+equivalent_sym_names(unqualified(S), unqualified(S)).
+equivalent_sym_names(qualified(_, S), unqualified(S)).
+equivalent_sym_names(unqualified(S), qualified(_, S)).
+equivalent_sym_names(qualified(QualA, S), qualified(QualB, S)) :-
+ equivalent_sym_names(QualA, QualB).
+
+%-----------------------------------------------------------------------------%
+
+:- pred update_inst_var_sub(inst_var, inst, module_info, module_info,
+ inst_var_sub, inst_var_sub).
+:- mode update_inst_var_sub(in, in, in, out, in, out) is semidet.
+
+update_inst_var_sub(V, InstA, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ ( map__search(Sub0, V, InstB) ->
+ inst_merge(InstA, InstB, ModuleInfo0, Inst, ModuleInfo),
+ map__det_update(Sub0, V, Inst, Sub)
+ ;
+ ModuleInfo = ModuleInfo0,
+ map__det_insert(Sub0, V, InstA, Sub)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred ground_inst_info_matches_initial(ground_inst_info, ground_inst_info,
+ uniqueness, uniqueness, maybe(type), expansions,
+ module_info, module_info, inst_var_sub, inst_var_sub).
+:- mode ground_inst_info_matches_initial(in, in, in, in, in, in, in, out, in,
+ out) is semidet.
+
+ground_inst_info_matches_initial(_, none, _, _, _, _, M, M) --> [].
+ground_inst_info_matches_initial(higher_order(PredInstA),
+ higher_order(PredInstB), _, _, Type, Expansions,
+ ModuleInfo0, ModuleInfo) -->
+ pred_inst_matches_initial(PredInstA, PredInstB, Type, Expansions,
+ ModuleInfo0, ModuleInfo).
+ground_inst_info_matches_initial(GroundInstInfoA, constrained_inst_var(V),
+ UniqA, UniqB, _, _, ModuleInfo0, ModuleInfo) -->
+ { GroundInstInfoA = constrained_inst_var(_) ->
+ Inst = ground(UniqA, GroundInstInfoA),
+ ModuleInfo1 = ModuleInfo0
+ ;
+ abstractly_unify_inst(live, ground(UniqA, GroundInstInfoA),
+ ground(UniqB, none), fake_unify, ModuleInfo0, Inst,
+ _Det, ModuleInfo1)
+ },
+ update_inst_var_sub(V, Inst, ModuleInfo1, ModuleInfo).
+
+:- pred pred_inst_matches_initial(pred_inst_info, pred_inst_info, maybe(type),
+ expansions, module_info, module_info, inst_var_sub, inst_var_sub).
+:- mode pred_inst_matches_initial(in, in, in, in, in, out, in, out) is semidet.
+
+pred_inst_matches_initial(pred_inst_info(PredOrFunc, ModesA, Det),
+ pred_inst_info(PredOrFunc, ModesB, Det), MaybeType,
+ Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ (
+ MaybeType = yes(Type),
+ type_is_higher_order(Type, _, _, Types)
+ ->
+ list__map(pred(T::in, yes(T)::out) is det, Types, MaybeTypes)
+ ;
+ list__duplicate(length(ModesA), no, MaybeTypes)
+ ),
+ pred_inst_argmodes_matches_initial(ModesA, ModesB, MaybeTypes,
+ Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub),
+ mode_list_apply_substitution(ModesA, Sub, ModesASub),
+ mode_list_apply_substitution(ModesB, Sub, ModesBSub),
+ pred_inst_argmodes_matches(ModesASub, ModesBSub, ModuleInfo,
+ Expansions).
+
+ % pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions):
+ % succeeds if the initial insts of ModesB specify at least as
+ % much information as, and the same binding as, the initial
+ % insts of ModesA; and the final insts of ModesA specify at
+ % least as much information as, and the same binding as, the
+ % final insts of ModesB. Any inst pairs in Expansions are assumed
+ % to match_final each other.
+ %
+:- pred pred_inst_argmodes_matches_initial(list(mode), list(mode),
+ list(maybe(type)), expansions, module_info, module_info,
+ inst_var_sub, inst_var_sub).
+:- mode pred_inst_argmodes_matches_initial(in, in, in, in, in, out, in, out)
+ is semidet.
+
+pred_inst_argmodes_matches_initial([], [], [], _, M, M, S, S).
+pred_inst_argmodes_matches_initial([ModeA|ModeAs], [ModeB|ModeBs],
+ [Type|Types], Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ mode_get_insts(ModuleInfo0, ModeA, InitialA, FinalA),
+ mode_get_insts(ModuleInfo0, ModeB, InitialB, FinalB),
+ inst_matches_initial_2(InitialA, InitialB, Type, Expansions,
+ ModuleInfo0, ModuleInfo1, Sub0, Sub1),
+ inst_matches_initial_2(FinalA, FinalB, Type, Expansions,
+ ModuleInfo1, ModuleInfo2, Sub1, Sub2),
+ pred_inst_argmodes_matches_initial(ModeAs, ModeBs, Types, Expansions,
+ ModuleInfo2, ModuleInfo, Sub2, Sub).
+
pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :-
set__init(Expansions),
pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
@@ -449,16 +665,23 @@
% are sorted.
:- pred bound_inst_list_matches_initial(list(bound_inst), list(bound_inst),
- module_info, expansions).
-:- mode bound_inst_list_matches_initial(in, in, in, in) is semidet.
-
-bound_inst_list_matches_initial([], _, _, _).
-bound_inst_list_matches_initial([X|Xs], [Y|Ys], ModuleInfo, Expansions) :-
+ maybe(type), expansions, module_info, module_info,
+ inst_var_sub, inst_var_sub).
+:- mode bound_inst_list_matches_initial(in, in, in, in, in, out, in, out)
+ is semidet.
+
+bound_inst_list_matches_initial([], _, _, _, M, M, S, S).
+bound_inst_list_matches_initial([X|Xs], [Y|Ys], MaybeType, Expansions,
+ ModuleInfo0, ModuleInfo, Sub0, Sub) :-
X = functor(ConsIdX, ArgsX),
Y = functor(ConsIdY, ArgsY),
( ConsIdX = ConsIdY ->
- inst_list_matches_initial(ArgsX, ArgsY, ModuleInfo, Expansions),
- bound_inst_list_matches_initial(Xs, Ys, ModuleInfo, Expansions)
+ maybe_get_arg_types(ModuleInfo0, MaybeType, ConsIdX,
+ MaybeTypes),
+ inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes, Expansions,
+ ModuleInfo0, ModuleInfo1, Sub0, Sub1),
+ bound_inst_list_matches_initial(Xs, Ys, MaybeType, Expansions,
+ ModuleInfo1, ModuleInfo, Sub1, Sub)
;
compare(>, ConsIdX, ConsIdY),
% ConsIdY does not occur in [X|Xs].
@@ -466,19 +689,49 @@
% for the args of ConsIdY, and hence
% automatically matches_initial Y. We just need to
% check that [X|Xs] matches_initial Ys.
- bound_inst_list_matches_initial([X|Xs], Ys, ModuleInfo,
- Expansions)
+ bound_inst_list_matches_initial([X|Xs], Ys, MaybeType,
+ Expansions, ModuleInfo0, ModuleInfo, Sub0, Sub)
).
-
-:- pred inst_list_matches_initial(list(inst), list(inst), module_info,
- expansions).
-:- mode inst_list_matches_initial(in, in, in, in) is semidet.
-inst_list_matches_initial([], [], _, _).
-inst_list_matches_initial([X|Xs], [Y|Ys], ModuleInfo, Expansions) :-
- inst_matches_initial_2(X, Y, ModuleInfo, Expansions),
- inst_list_matches_initial(Xs, Ys, ModuleInfo, Expansions).
-
+:- pred inst_list_matches_initial(list(inst), list(inst), list(maybe(type)),
+ expansions, module_info, module_info, inst_var_sub, inst_var_sub).
+:- mode inst_list_matches_initial(in, in, in, in, in, out, in, out) is semidet.
+
+inst_list_matches_initial([], [], [], _, M, M, S, S).
+inst_list_matches_initial([X|Xs], [Y|Ys], [Type | Types], Expansions,
+ ModuleInfo0, ModuleInfo, Sub0, Sub) :-
+ inst_matches_initial_2(X, Y, Type, Expansions, ModuleInfo0, ModuleInfo1,
+ Sub0, Sub1),
+ inst_list_matches_initial(Xs, Ys, Types, Expansions, ModuleInfo1,
+ ModuleInfo, Sub1, Sub).
+
+:- pred maybe_get_arg_types(module_info, maybe(type), cons_id,
+ list(maybe(type))).
+:- mode maybe_get_arg_types(in, in, in, out) is det.
+
+maybe_get_arg_types(ModuleInfo, MaybeType, ConsId0, MaybeTypes) :-
+ ( ConsId0 = cons(SymName, Arity) ->
+ ( SymName = qualified(_, Name) ->
+ % type_util__get_cons_id_arg_types expects an
+ % unqualified cons_id.
+ ConsId = cons(unqualified(Name), Arity)
+ ;
+ ConsId = ConsId0
+ ),
+ (
+ MaybeType = yes(Type),
+ type_util__get_cons_id_arg_types(ModuleInfo, Type,
+ ConsId, Types),
+ list__length(Types, Arity)
+ ->
+ list__map(pred(T::in, yes(T)::out) is det, Types,
+ MaybeTypes)
+ ;
+ list__duplicate(Arity, no, MaybeTypes)
+ )
+ ;
+ MaybeTypes = []
+ ).
%-----------------------------------------------------------------------------%
inst_expand(ModuleInfo, Inst0, Inst) :-
@@ -535,7 +788,7 @@
Expansions) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_final(ListA, ListB, ModuleInfo, Expansions).
-inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, no), ModuleInfo,
+inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, none), ModuleInfo,
_Exps) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_is_ground(ListA, ModuleInfo),
@@ -551,9 +804,9 @@
% insts in ListB, or if ListB does not contain a complete list
% of all the constructors for the type in question.
%%% error("not implemented: `ground' matches_final `bound(...)'").
-inst_matches_final_3(ground(UniqA, PredInstA), ground(UniqB, PredInstB),
- ModuleInfo, Expansions) :-
- maybe_pred_inst_matches_final(PredInstA, PredInstB,
+inst_matches_final_3(ground(UniqA, GroundInstInfoA),
+ ground(UniqB, GroundInstInfoB), ModuleInfo, Expansions) :-
+ ground_inst_info_matches_final(GroundInstInfoA, GroundInstInfoB,
ModuleInfo, Expansions),
unique_matches_final(UniqA, UniqB).
inst_matches_final_2(abstract_inst(_, _), any(shared), _, _).
@@ -562,15 +815,17 @@
inst_list_matches_final(ArgsA, ArgsB, ModuleInfo, Expansions).
inst_matches_final_3(not_reached, _, _, _).
-:- pred maybe_pred_inst_matches_final(maybe(pred_inst_info),
- maybe(pred_inst_info), module_info, expansions).
-:- mode maybe_pred_inst_matches_final(in, in, in, in) is semidet.
-
-maybe_pred_inst_matches_final(no, no, _, _).
-maybe_pred_inst_matches_final(yes(_), no, _, _).
-maybe_pred_inst_matches_final(yes(PredInstA), yes(PredInstB),
- ModuleInfo, Expansions) :-
+:- pred ground_inst_info_matches_final(ground_inst_info, ground_inst_info,
+ module_info, expansions).
+:- mode ground_inst_info_matches_final(in, in, in, in) is semidet.
+
+ground_inst_info_matches_final(_, none, _, _).
+ground_inst_info_matches_final(higher_order(PredInstA),
+ higher_order(PredInstB), ModuleInfo, Expansions) :-
pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
+ground_inst_info_matches_final(constrained_inst_var(I),
+ constrained_inst_var(I), _, _).
+
:- pred inst_list_matches_final(list(inst), list(inst), module_info,
expansions).
@@ -640,9 +895,12 @@
inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), ModuleInfo,
Expansions) :-
bound_inst_list_matches_binding(ListA, ListB, ModuleInfo, Expansions).
-inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, no), ModuleInfo,
+inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, none), ModuleInfo,
_Exps) :-
bound_inst_list_is_ground(ListA, ModuleInfo).
+inst_matches_binding_3(bound(_UniqA, ListA),
+ ground(_UniqB, constrained_inst_var(_)), ModuleInfo, _Exps) :-
+ bound_inst_list_is_ground(ListA, ModuleInfo).
inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), ModuleInfo,
_Exps) :-
bound_inst_list_is_ground(ListB, ModuleInfo).
@@ -650,22 +908,25 @@
% insts in ListB, or if ListB does not contain a complete list
% of all the constructors for the type in question.
%%% error("not implemented: `ground' matches_binding `bound(...)'").
-inst_matches_binding_3(ground(_UniqA, PredInstA), ground(_UniqB, PredInstB),
- ModuleInfo, _) :-
- pred_inst_matches_binding(PredInstA, PredInstB, ModuleInfo).
+inst_matches_binding_3(ground(_UniqA, GroundInstInfoA),
+ ground(_UniqB, GroundInstInfoB), ModuleInfo, _) :-
+ ground_inst_info_matches_binding(GroundInstInfoA, GroundInstInfoB,
+ ModuleInfo).
inst_matches_binding_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
ModuleInfo, Expansions) :-
inst_list_matches_binding(ArgsA, ArgsB, ModuleInfo, Expansions).
inst_matches_binding_3(not_reached, _, _, _).
-:- pred pred_inst_matches_binding(maybe(pred_inst_info), maybe(pred_inst_info),
+:- pred ground_inst_info_matches_binding(ground_inst_info, ground_inst_info,
module_info).
-:- mode pred_inst_matches_binding(in, in, in) is semidet.
+:- mode ground_inst_info_matches_binding(in, in, in) is semidet.
-pred_inst_matches_binding(no, no, _).
-pred_inst_matches_binding(yes(_), no, _).
-pred_inst_matches_binding(yes(PredInstA), yes(PredInstB), ModuleInfo) :-
+ground_inst_info_matches_binding(_, none, _).
+ground_inst_info_matches_binding(higher_order(PredInstA),
+ higher_order(PredInstB), ModuleInfo) :-
pred_inst_matches(PredInstA, PredInstB, ModuleInfo).
+ground_inst_info_matches_binding(constrained_inst_var(_),
+ constrained_inst_var(_), _). % AAA
:- pred inst_list_matches_binding(list(inst), list(inst), module_info,
expansions).
@@ -1256,9 +1517,9 @@
InstVar) :-
bound_inst_list_contains_inst_var(ArgInsts, ModuleInfo, Expansions,
InstVar).
-inst_contains_inst_var_2(ground(_Uniq, PredInstInfo), ModuleInfo, Expansions,
+inst_contains_inst_var_2(ground(_Uniq, GroundInstInfo), ModuleInfo, Expansions,
InstVar) :-
- PredInstInfo = yes(pred_inst_info(_PredOrFunc, Modes, _Det)),
+ GroundInstInfo = higher_order(pred_inst_info(_PredOrFunc, Modes, _Det)),
mode_list_contains_inst_var_2(Modes, ModuleInfo, Expansions, InstVar).
inst_contains_inst_var_2(abstract_inst(_Name, ArgInsts), ModuleInfo, Expansions,
InstVar) :-
Index: compiler/inst_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inst_util.m,v
retrieving revision 1.12
diff -u -r1.12 inst_util.m
--- compiler/inst_util.m 1999/06/23 04:17:43 1.12
+++ compiler/inst_util.m 2000/02/04 00:04:23
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1997-1999 The University of Melbourne.
+% Copyright (C) 1997-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -256,42 +256,66 @@
bound_inst_list_is_ground(List, M).
***/
-abstractly_unify_inst_3(live, ground(UniqX, yes(PredInst)), any(UniqY), Real, M,
- ground(Uniq, yes(PredInst)), semidet, M) :-
+abstractly_unify_inst_3(live, ground(UniqX, higher_order(PredInst)),
+ any(UniqY), Real, M, ground(Uniq, higher_order(PredInst)),
+ semidet, M) :-
Real = fake_unify,
unify_uniq(live, Real, det, UniqX, UniqY, Uniq).
-abstractly_unify_inst_3(live, ground(Uniq0, yes(PredInst)), free, Real, M,
- ground(Uniq, yes(PredInst)), det, M) :-
+abstractly_unify_inst_3(live, ground(Uniq0, higher_order(PredInst)), free,
+ Real, M, ground(Uniq, higher_order(PredInst)), det, M) :-
unify_uniq(live, Real, det, unique, Uniq0, Uniq).
-abstractly_unify_inst_3(live, ground(UniqX, yes(_)), bound(UniqY, BoundInsts0),
- Real, M0, bound(Uniq, BoundInsts), Det, M) :-
+abstractly_unify_inst_3(live, ground(UniqX, higher_order(_)),
+ bound(UniqY, BoundInsts0), Real, M0, bound(Uniq, BoundInsts),
+ Det, M) :-
% check `Real = fake_unify' ?
unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq),
make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, M0,
BoundInsts, Det1, M),
det_par_conjunction_detism(Det1, semidet, Det).
-abstractly_unify_inst_3(live, ground(UniqA, yes(PredInstA)),
- ground(UniqB, _MaybePredInstB), Real, M,
- ground(Uniq, PredInst), semidet, M) :-
+abstractly_unify_inst_3(live, ground(UniqA, higher_order(PredInstA)),
+ ground(UniqB, _GroundInstInfoB), Real, M,
+ ground(Uniq, GroundInstInfo), semidet, M) :-
% It is an error to unify higher-order preds,
% so if Real \= fake_unify, then we must fail.
Real = fake_unify,
% In theory we should choose take the union of the
- % information specified by PredInstA and _MaybePredInstB.
+ % information specified by PredInstA and _GroundInstInfoB.
% However, since our data representation provides no
% way of doing that, and since this will only happen
% for fake_unifys, for which it shouldn't make any difference,
% we just choose the information specified by PredInstA.
- PredInst = yes(PredInstA),
+ GroundInstInfo = higher_order(PredInstA),
unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq).
-abstractly_unify_inst_3(live, ground(Uniq, no), Inst0, Real, M0,
+abstractly_unify_inst_3(live, ground(Uniq, none), Inst0, Real, M0,
Inst, Det, M) :-
make_ground_inst(Inst0, live, Uniq, Real, M0, Inst, Det, M).
+abstractly_unify_inst_3(live, ground(UniqX, constrained_inst_var(Var)),
+ any(UniqY), Real, M, ground(Uniq, constrained_inst_var(Var)),
+ semidet, M) :-
+ Real = fake_unify, % AAA
+ unify_uniq(live, Real, det, UniqX, UniqY, Uniq).
+
+abstractly_unify_inst_3(live, ground(Uniq0, constrained_inst_var(Var)), free,
+ Real, M, ground(Uniq, constrained_inst_var(Var)), det, M) :-
+ unify_uniq(live, Real, det, unique, Uniq0, Uniq).
+
+abstractly_unify_inst_3(live, ground(UniqX, constrained_inst_var(_)),
+ bound(UniqY, BoundInsts0), Real, M0, bound(Uniq, BoundInsts),
+ Det, M) :-
+ unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq),
+ make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, M0,
+ BoundInsts, Det1, M),
+ det_par_conjunction_detism(Det1, semidet, Det).
+
+abstractly_unify_inst_3(live, ground(UniqA, constrained_inst_var(_V)),
+ ground(UniqB, GII), Real, M, ground(Uniq, GII), semidet, M) :-
+ unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq).
+
% abstractly_unify_inst_3(live, abstract_inst(_,_), free, _, _, _, _, _)
% :- fail.
@@ -358,32 +382,57 @@
).
*****/
-abstractly_unify_inst_3(dead, ground(UniqX, yes(PredInst)), any(UniqY), Real, M,
- ground(Uniq, yes(PredInst)), semidet, M) :-
+abstractly_unify_inst_3(dead, ground(UniqX, higher_order(PredInst)),
+ any(UniqY), Real, M, ground(Uniq, higher_order(PredInst)),
+ semidet, M) :-
allow_unify_bound_any(Real),
unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq).
-abstractly_unify_inst_3(dead, ground(Uniq, yes(PredInst)), free, _Real, M,
- ground(Uniq, yes(PredInst)), det, M).
+abstractly_unify_inst_3(dead, ground(Uniq, higher_order(PredInst)), free,
+ _Real, M, ground(Uniq, higher_order(PredInst)), det, M).
-abstractly_unify_inst_3(dead, ground(UniqA, yes(_)), bound(UniqB, BoundInsts0),
- Real, M0, bound(Uniq, BoundInsts), Det, M) :-
+abstractly_unify_inst_3(dead, ground(UniqA, higher_order(_)),
+ bound(UniqB, BoundInsts0), Real, M0, bound(Uniq, BoundInsts),
+ Det, M) :-
unify_uniq(dead, Real, semidet, UniqA, UniqB, Uniq),
make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, M0,
BoundInsts, Det1, M),
det_par_conjunction_detism(Det1, semidet, Det).
-abstractly_unify_inst_3(dead, ground(UniqA, yes(PredInstA)),
- ground(UniqB, _MaybePredInstB), Real, M,
- ground(Uniq, PredInst), det, M) :-
+abstractly_unify_inst_3(dead, ground(UniqA, higher_order(PredInstA)),
+ ground(UniqB, _GroundInstInfoB), Real, M,
+ ground(Uniq, GroundInstInfo), det, M) :-
Real = fake_unify,
- PredInst = yes(PredInstA),
+ GroundInstInfo = higher_order(PredInstA),
unify_uniq(dead, Real, det, UniqA, UniqB, Uniq).
-abstractly_unify_inst_3(dead, ground(Uniq, no), Inst0, Real, M0,
+abstractly_unify_inst_3(dead, ground(Uniq, none), Inst0, Real, M0,
Inst, Det, M) :-
make_ground_inst(Inst0, dead, Uniq, Real, M0, Inst, Det, M).
+abstractly_unify_inst_3(dead, ground(UniqX, constrained_inst_var(Var)),
+ any(UniqY), Real, M, ground(Uniq, constrained_inst_var(Var)),
+ semidet, M) :-
+ allow_unify_bound_any(Real), % AAA
+ unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq).
+
+abstractly_unify_inst_3(dead, ground(Uniq, constrained_inst_var(Var)), free,
+ _Real, M, ground(Uniq, constrained_inst_var(Var)), det, M).
+
+abstractly_unify_inst_3(dead, ground(UniqA, constrained_inst_var(_)),
+ bound(UniqB, BoundInsts0), Real, M0, bound(Uniq, BoundInsts),
+ Det, M) :-
+ unify_uniq(dead, Real, semidet, UniqA, UniqB, Uniq),
+ make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, M0,
+ BoundInsts, Det1, M),
+ det_par_conjunction_detism(Det1, semidet, Det).
+
+abstractly_unify_inst_3(dead, ground(UniqA, constrained_inst_var(_Var)),
+ ground(UniqB, GroundInstInfo), Real, M,
+ ground(Uniq, GroundInstInfo), det, M) :-
+ Real = fake_unify,
+ unify_uniq(dead, Real, det, UniqA, UniqB, Uniq).
+
/***** abstract insts aren't really supported
abstractly_unify_inst_3(dead, abstract_inst(N,As), bound(List), Real,
ModuleInfo, Result, Det, ModuleInfo) :-
@@ -756,10 +805,10 @@
:- mode make_ground_inst(in, in, in, in, in, out, out, out) is semidet.
make_ground_inst(not_reached, _, _, _, M, not_reached, erroneous, M).
-make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, M, ground(Uniq, no),
+make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, M, ground(Uniq, none),
semidet, M) :-
unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
-make_ground_inst(free, IsLive, Uniq0, Real, M, ground(Uniq, no), det, M) :-
+make_ground_inst(free, IsLive, Uniq0, Real, M, ground(Uniq, none), det, M) :-
unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq).
make_ground_inst(free(T), IsLive, Uniq0, Real, M,
defined_inst(typed_ground(Uniq, T)), det, M) :-
@@ -770,12 +819,12 @@
make_ground_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, M0,
BoundInsts, Det1, M),
det_par_conjunction_detism(Det1, semidet, Det).
-make_ground_inst(ground(Uniq0, _PredInst), IsLive, Uniq1, Real, M,
- ground(Uniq, no), semidet, M) :-
+make_ground_inst(ground(Uniq0, _GII0), IsLive, Uniq1, Real, M,
+ ground(Uniq, none), semidet, M) :-
unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq).
make_ground_inst(inst_var(_), _, _, _, _, _, _, _) :-
error("free inst var").
-make_ground_inst(abstract_inst(_,_), _, _, _, M, ground(shared, no),
+make_ground_inst(abstract_inst(_,_), _, _, _, M, ground(shared, none),
semidet, M).
make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0,
Inst, Det, ModuleInfo) :-
@@ -1335,31 +1384,36 @@
merge_uniq(UniqA, UniqB, Uniq),
bound_inst_list_merge(ListA, ListB, ModuleInfo0, List, ModuleInfo).
inst_merge_3(bound(UniqA, ListA), ground(UniqB, _), ModuleInfo,
- ground(Uniq, no), ModuleInfo) :-
+ ground(Uniq, none), ModuleInfo) :-
merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo, Uniq),
bound_inst_list_is_ground(ListA, ModuleInfo).
inst_merge_3(ground(UniqA, _), bound(UniqB, ListB), ModuleInfo,
- ground(Uniq, no), ModuleInfo) :-
+ ground(Uniq, none), ModuleInfo) :-
merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq),
bound_inst_list_is_ground(ListB, ModuleInfo).
-inst_merge_3(ground(UniqA, MaybePredA), ground(UniqB, MaybePredB), ModuleInfo,
- ground(Uniq, MaybePred), ModuleInfo) :-
+inst_merge_3(ground(UniqA, GroundInstInfoA), ground(UniqB, GroundInstInfoB),
+ ModuleInfo, ground(Uniq, GroundInstInfo), ModuleInfo) :-
(
- MaybePredA = yes(PredA),
- MaybePredB = yes(PredB)
+ GroundInstInfoA = higher_order(PredA),
+ GroundInstInfoB = higher_order(PredB)
->
% if they specify matching pred insts, but one is more
% precise (specifies more info) than the other,
% then we want to choose the least precise one
( pred_inst_matches(PredA, PredB, ModuleInfo) ->
- MaybePred = yes(PredB)
+ GroundInstInfo = higher_order(PredB)
; pred_inst_matches(PredB, PredA, ModuleInfo) ->
- MaybePred = yes(PredA)
+ GroundInstInfo = higher_order(PredA)
;
- MaybePred = no
+ GroundInstInfo = none
)
;
- MaybePred = no
+ GroundInstInfoA = constrained_inst_var(V),
+ GroundInstInfoB = constrained_inst_var(V)
+ ->
+ GroundInstInfo = constrained_inst_var(V)
+ ;
+ GroundInstInfo = none
),
merge_uniq(UniqA, UniqB, Uniq).
inst_merge_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.60
diff -u -r1.60 lambda.m
--- compiler/lambda.m 2000/02/08 15:07:53 1.60
+++ compiler/lambda.m 2000/02/09 00:19:12
@@ -95,6 +95,7 @@
map(prog_var, type), % from the proc_info
class_constraints, % from the pred_info
tvarset, % from the proc_info
+ inst_varset, % from the proc_info
map(tvar, type_info_locn),
% from the proc_info
% (typeinfos)
@@ -176,13 +177,14 @@
proc_info_goal(ProcInfo0, Goal0),
proc_info_typeinfo_varmap(ProcInfo0, TVarMap0),
proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap0),
+ proc_info_inst_varset(ProcInfo0, InstVarSet0),
% process the goal
Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0,
- TVarMap0, TCVarMap0, Markers, PredOrFunc,
+ InstVarSet0, TVarMap0, TCVarMap0, Markers, PredOrFunc,
PredName, Owner, ModuleInfo0),
lambda__process_goal(Goal0, Goal, Info0, Info),
- Info = lambda_info(VarSet, VarTypes, Constraints, TypeVarSet,
+ Info = lambda_info(VarSet, VarTypes, Constraints, TypeVarSet, _,
TVarMap, TCVarMap, _, _, _, _, ModuleInfo),
% set the new values of the fields in proc_info and pred_info
@@ -289,8 +291,8 @@
OrigNonLocals0, LambdaGoal, Unification0, Functor,
Unification, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, _PredConstraints, TVarSet,
- TVarMap, TCVarMap, Markers, POF, OrigPredName, Owner,
- ModuleInfo0),
+ InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName,
+ Owner, ModuleInfo0),
% Calculate the constraints which apply to this lambda
% expression.
@@ -502,8 +504,8 @@
% Now construct the proc_info and pred_info for the new
% single-mode predicate, using the information computed above
- proc_info_create(VarSet, VarTypes, AllArgVars,
- AllArgModes, Detism, LambdaGoal, LambdaContext,
+ proc_info_create(VarSet, VarTypes, AllArgVars, AllArgModes,
+ InstVarSet, Detism, LambdaGoal, LambdaContext,
TVarMap, TCVarMap, address_is_taken, ProcInfo),
set__init(Assertions),
@@ -529,8 +531,8 @@
Unification = construct(Var, ConsId, ArgVars, UniModes,
VarToReuse, cell_is_unique, RLExprnId),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
- TVarMap, TCVarMap, Markers, POF, OrigPredName, Owner,
- ModuleInfo).
+ InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName,
+ Owner, ModuleInfo).
:- pred lambda__constraint_contains_vars(list(tvar), class_constraint).
:- mode lambda__constraint_contains_vars(in, in) is semidet.
Index: compiler/magic.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic.m,v
retrieving revision 1.12
diff -u -r1.12 magic.m
--- compiler/magic.m 1999/10/28 00:57:03 1.12
+++ compiler/magic.m 2000/02/03 05:25:58
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1998-1999 University of Melbourne.
+% Copyright (C) 1998-2000 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -406,7 +406,7 @@
OutputMode = (free -> OutputInst)
)) },
{ list__map(GetOutputMode, InputModes, InputRelModes) },
- { Inst = ground(unique, yes(pred_inst_info(predicate,
+ { Inst = ground(unique, higher_order(pred_inst_info(predicate,
InputRelModes, nondet))) },
{ Mode = (Inst -> Inst) },
magic__get_scc_inputs(PredProcIds, Types, Modes).
@@ -529,6 +529,7 @@
InterfaceRequired = no
},
+ { proc_info_inst_varset(ProcInfo1, InstVarSet) },
magic__adjust_args(CPredProcId, AditiPredProcId, InterfaceRequired,
Index, MagicTypes, MagicModes, PredInfo0, ProcInfo1,
InputArgTypes, InputArgModes, LocalAditiPredProcId),
@@ -540,7 +541,7 @@
% for the current procedure.
magic__create_magic_pred(CPredProcId, LocalAditiPredProcId,
MagicTypes, MagicModes, InputArgTypes, InputArgModes,
- Index)
+ InstVarSet, Index)
),
%
@@ -680,6 +681,7 @@
{ proc_info_headvars(LocalProcInfo, HeadVars) },
{ proc_info_vartypes(LocalProcInfo, VarTypes) },
{ proc_info_varset(LocalProcInfo, VarSet) },
+ { proc_info_inst_varset(LocalProcInfo, InstVarSet) },
{ pred_info_get_markers(ExportedPredInfo0, Markers) },
{ pred_info_get_aditi_owner(ExportedPredInfo0, Owner) },
@@ -689,8 +691,9 @@
{ varset__init(TVarSet) },
{ hlds_pred__define_new_pred(Goal, CallGoal, HeadVars, ExtraArgs,
InstMap, PredName, TVarSet, VarTypes, ClassContext, TVarMap,
- TCVarMap, VarSet, Markers, Owner, address_is_not_taken,
- ModuleInfo1, ModuleInfo2, LocalPredProcId) },
+ TCVarMap, VarSet, InstVarSet, Markers, Owner,
+ address_is_not_taken, ModuleInfo1, ModuleInfo2,
+ LocalPredProcId) },
{ ExtraArgs = [] ->
true
;
@@ -957,8 +960,8 @@
{ error("magic__create_input_join_proc: not db_call") }
),
- { ClosureInst = ground(shared,
- yes(pred_inst_info(predicate, MagicArgModes, nondet))) },
+ { ClosureInst = ground(shared, higher_order(
+ pred_inst_info(predicate, MagicArgModes, nondet))) },
{ ClosureMode = (ClosureInst -> ClosureInst) },
{ proc_info_set_argmodes(JoinProcInfo1,
[ClosureMode | OutputArgModes], JoinProcInfo2) },
@@ -1171,11 +1174,11 @@
% Allocate a predicate to collect the input for the current predicate.
:- pred magic__create_magic_pred(pred_proc_id::in, pred_proc_id::in,
list(type)::in, list(mode)::in, list(type)::in,
- list(mode)::in, maybe(int)::in,
+ list(mode)::in, inst_varset::in, maybe(int)::in,
magic_info::in, magic_info::out) is det.
magic__create_magic_pred(CPredProcId, PredProcId, MagicTypes, MagicModes,
- InputTypes0, InputModes0, Index) -->
+ InputTypes0, InputModes0, InstVarSet, Index) -->
magic_info_get_module_info(ModuleInfo0),
@@ -1273,8 +1276,8 @@
{ map__init(TVarMap) },
{ map__init(TCVarMap) },
- { proc_info_create(VarSet, VarTypes, AllArgs, AllArgModes, nondet,
- Goal, Context, TVarMap, TCVarMap, address_is_not_taken,
+ { proc_info_create(VarSet, VarTypes, AllArgs, AllArgModes, InstVarSet,
+ nondet, Goal, Context, TVarMap, TCVarMap, address_is_not_taken,
ProcInfo) },
%
@@ -1574,7 +1577,7 @@
{ IntroducedArgs1 = [NewArg | IntroducedArgs0] },
{ in_mode(InMode) },
{ out_mode(OutMode) },
- { Inst = ground(shared, no) },
+ { Inst = ground(shared, none) },
{ set__list_to_set([Arg, NewArg], NonLocals) },
{ instmap_delta_from_assoc_list([NewArg - Inst], Delta) },
{ goal_info_init(NonLocals, Delta, det, GoalInfo) },
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.4
diff -u -r1.4 magic_util.m
--- compiler/magic_util.m 1999/07/13 08:53:08 1.4
+++ compiler/magic_util.m 2000/02/03 05:26:02
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1998-1999 University of Melbourne.
+% Copyright (C) 1998-2000 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -785,12 +785,13 @@
(
{ SuppCall = call(SuppPredId, SuppProcId, _, _, _, _) - _ },
{ mode_get_insts(ModuleInfo, InputMode, Inst, _) },
- { Inst = ground(_, yes(PredInstInfo)) }
+ { Inst = ground(_, higher_order(PredInstInfo)) }
->
% Find the mode of the unification.
{ PredInstInfo = pred_inst_info(_, LambdaModes, _) },
{ LambdaInst = ground(shared,
- yes(pred_inst_info(predicate, LambdaModes, nondet))) },
+ higher_order(pred_inst_info(predicate, LambdaModes,
+ nondet))) },
{ UnifyMode = (free -> LambdaInst) -
(LambdaInst -> LambdaInst) },
{ mode_util__modes_to_uni_modes(LambdaModes, LambdaModes,
@@ -1038,7 +1039,7 @@
% instantiated. Any arguments that are partially
% instantiated in the initial instmap for the
% procedure will be reported there.
- Mode = (ground(shared, no) -> ground(shared, no))
+ Mode = (ground(shared, none) -> ground(shared, none))
)
)) },
{ list__map(GetSuppMode, SuppOutputArgs, SuppOutputModes) },
@@ -1055,6 +1056,7 @@
magic_info_get_module_info(ModuleInfo0),
{ proc_info_get_initial_instmap(ProcInfo, ModuleInfo0, InstMap) },
+ { proc_info_inst_varset(ProcInfo, InstVarSet) },
{ pred_info_get_aditi_owner(PredInfo, Owner) },
{ pred_info_get_markers(PredInfo, Markers0) },
{ AddMarkers = lambda([Marker::in, Ms0::in, Ms::out] is det,
@@ -1072,7 +1074,7 @@
{ unqualify_name(NewName, NewPredName) },
{ hlds_pred__define_new_pred(SuppGoal, SuppCall, SuppArgs, ExtraArgs,
InstMap, NewPredName, TVarSet, VarTypes, ClassConstraints,
- TVarMap, TCVarMap, VarSet, Markers, Owner,
+ TVarMap, TCVarMap, VarSet, InstVarSet, Markers, Owner,
address_is_not_taken, ModuleInfo0, ModuleInfo, _) },
{ ExtraArgs = [] ->
true
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.323
diff -u -r1.323 make_hlds.m
--- compiler/make_hlds.m 2000/02/08 06:59:24 1.323
+++ compiler/make_hlds.m 2000/02/09 00:19:16
@@ -37,10 +37,10 @@
bool, bool, io__state, io__state).
:- mode parse_tree_to_hlds(in, in, in, out, out, out, di, uo) is det.
-:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(mode)),
- maybe(list(is_live)), maybe(determinism),
+:- pred add_new_proc(pred_info, inst_varset, arity, list(mode),
+ maybe(list(mode)), maybe(list(is_live)), maybe(determinism),
prog_context, is_address_taken, pred_info, proc_id).
-:- mode add_new_proc(in, in, in, in, in, in, in, in, out, out) is det.
+:- mode add_new_proc(in, in, in, in, in, in, in, in, in, out, out) is det.
:- pred clauses_info_init(int::in, clauses_info::out) is det.
@@ -75,6 +75,7 @@
maybe_report_stats(Statistics),
add_item_list_decls_pass_2(Items,
item_status(local, may_be_unqualified), Module1, Module2),
+
maybe_report_stats(Statistics),
% balance the binary trees
{ module_info_optimize(Module2, Module3) },
@@ -2828,7 +2829,10 @@
ArgTypes, Cond, Context, ClausesInfo0, Status, Markers,
none, predicate, ClassContext, Proofs, Owner, PredInfo0),
ArgLives = no,
- add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes),
+ varset__init(InstVarSet),
+ % Should not be any inst vars here so it's ok to use a
+ % fresh inst_varset.
+ add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, yes(ArgModes),
ArgLives, yes(Det), Context, address_is_not_taken, PredInfo,
_),
@@ -2869,13 +2873,15 @@
Status = Status1
).
-add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives,
- MaybeDet, Context, IsAddressTaken, PredInfo, ModeId) :-
+add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, MaybeDeclaredArgModes,
+ MaybeArgLives, MaybeDet, Context, IsAddressTaken, PredInfo,
+ ModeId) :-
pred_info_procedures(PredInfo0, Procs0),
pred_info_arg_types(PredInfo0, ArgTypes),
next_mode_id(Procs0, MaybeDet, ModeId),
proc_info_init(Arity, ArgTypes, ArgModes, MaybeDeclaredArgModes,
- MaybeArgLives, MaybeDet, Context, IsAddressTaken, NewProc),
+ MaybeArgLives, MaybeDet, Context, IsAddressTaken, NewProc0),
+ proc_info_set_inst_varset(NewProc0, InstVarSet, NewProc),
map__det_insert(Procs0, ModeId, NewProc, Procs),
pred_info_set_procedures(PredInfo0, Procs, PredInfo).
@@ -2893,7 +2899,7 @@
% We should store the mode varset and the mode condition
% in the hlds - at the moment we just ignore those two arguments.
-module_add_mode(ModuleInfo0, _VarSet, PredName, Modes, MaybeDet, _Cond,
+module_add_mode(ModuleInfo0, InstVarSet, PredName, Modes, MaybeDet, _Cond,
Status, MContext, PredOrFunc, PredProcId, ModuleInfo) -->
% Lookup the pred or func declaration in the predicate table.
@@ -2924,19 +2930,20 @@
{ predicate_table_get_preds(PredicateTable1, Preds0) },
{ map__lookup(Preds0, PredId, PredInfo0) },
- module_do_add_mode(PredInfo0, Arity, Modes, MaybeDet, MContext,
- PredInfo, ProcId),
+ module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet,
+ MContext, PredInfo, ProcId),
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) },
{ module_info_set_predicate_table(ModuleInfo0, PredicateTable,
ModuleInfo) },
{ PredProcId = PredId - ProcId }.
-:- pred module_do_add_mode(pred_info, arity, list(mode), maybe(determinism),
- prog_context, pred_info, proc_id, io__state, io__state).
-:- mode module_do_add_mode(in, in, in, in, in, out, out, di, uo) is det.
+:- pred module_do_add_mode(pred_info, inst_varset, arity, list(mode),
+ maybe(determinism), prog_context, pred_info, proc_id,
+ io__state, io__state).
+:- mode module_do_add_mode(in, in, in, in, in, in, out, out, di, uo) is det.
-module_do_add_mode(PredInfo0, Arity, Modes, MaybeDet, MContext,
+module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet, MContext,
PredInfo, ProcId) -->
% check that the determinism was specified
(
@@ -2967,8 +2974,9 @@
% add the mode declaration to the pred_info for this procedure.
{ ArgLives = no },
- { add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives,
- MaybeDet, MContext, address_is_not_taken, PredInfo, ProcId) }.
+ { add_new_proc(PredInfo0, InstVarSet, Arity, Modes, yes(Modes),
+ ArgLives, MaybeDet, MContext, address_is_not_taken, PredInfo,
+ ProcId) }.
% Whenever there is a clause or mode declaration for an undeclared
% predicate, we add an implicit declaration
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
More information about the developers
mailing list