[m-rev.] diff: speed up common.m worst case
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Jan 24 13:35:21 AEDT 2005
compiler/common.m:
Make this pass significantly more efficient when operating on
predicates with many opportunities for reusing common structures.
The speed when compiling the six largest compiler modules is virtually
unaffected, but the time to compile a module generated by caribou
has dropped from 79 seconds to 56, a 30% reduction.
The main change is avoiding repeated computations. Instead of storing
the types of available structures and checking their type constructors
each time they are looked at, compute the type constructor just once.
Document the main data structure in significantly more detail than
before.
Switch to four-space indentation. Some predicates have so many levels
of indentation that this is the only way to allow a reasonable amount
of code on each line.
compiler/simplify.m:
Conform to the changed interface of common.m. Some minor cleanups.
library/eqvclass.m:
Improve the speed of the basic operation of adding new equivalences
by avoiding the creation of new equivalence classes and then destroying
them immediately.
Make it possible for the caller (in our case, common.m) to speed up a
sequence of equivalence tests by performing the common part of those
tests just once.
(The diff is with -b, so what looks like bad indentation isn't.)
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/common.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/common.m,v
retrieving revision 1.74
diff -u -b -r1.74 common.m
--- compiler/common.m 21 Jan 2005 03:27:36 -0000 1.74
+++ compiler/common.m 21 Jan 2005 03:36:07 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1995-2005 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.
@@ -65,16 +67,16 @@
hlds_goal_expr::in, hlds_goal_expr::out,
simplify_info::in, simplify_info::out) is det.
- % succeeds if the two variables are equivalent
+ % Succeeds if the two variables are equivalent
% according to the specified equivalence class.
:- pred common__vars_are_equivalent(prog_var::in, prog_var::in,
common_info::in) is semidet.
% Assorted stuff used here that simplify.m doesn't need to know about.
:- type common_info.
+:- func common_info_init = common_info.
-:- pred common_info_init(common_info::out) is det.
-
+ % Clear the list of structs seen since the last stack flush.
:- pred common_info_clear_structs(common_info::in, common_info::out) is det.
%---------------------------------------------------------------------------%
@@ -97,41 +99,123 @@
:- import_module parse_tree__prog_type.
:- import_module transform_hlds__pd_cost.
-:- import_module bool, map, set, eqvclass, require, std_util, string, term.
+:- import_module bool, map, svmap, set, eqvclass, sveqvclass.
+:- import_module require, std_util, string, term.
-:- type structure
- ---> structure(prog_var, type, cons_id, list(prog_var)).
+ % The var_eqv field records information about which sets of variables
+ % are known to be equivalent, usually because they have been unified.
+ % This is useful when eliminating duplicate unifications and when
+ % eliminating duplicate calls.
+ %
+ % The all_structs and since_call_structs fields record information
+ % about the memory cells available for reuse. The all_structs field
+ % has info about all the cells available at the current program point.
+ % The since_call_structs field contains info about the subset of these
+ % cells that have been seen since the last stack flush, which is
+ % usually a call.
+ %
+ % The reason why we make the distinction between structs seen before
+ % the last call and structs seen after is best explained by these two
+ % program fragments:
+ %
+ % fragment 1:
+ % X => f(A1, A2, A3, A4),
+ % X => f(B1, B2, B3, B4),
+ %
+ % fragment 2:
+ % X => f(A1, A2, A3, A4),
+ % p(...),
+ % X => f(B1, B2, B3, B4),
+ %
+ % In fragment 1, we want to replace the second deconstruction with
+ % the assignments B1 = A1, ... B4 = A4, since this can avoid the
+ % second check of X's function symbol. (If the inst of X at the start
+ % of the second unification is `bound(f(...))', we can dispense with
+ % this test anyway, but if the two unifications are brought together
+ % by inlining, then X's inst then may simply be `ground'.)
+ %
+ % In fragment 2, we don't want make the same transformation, because
+ % doing so would require storing A1 ... A4 across the call instead of
+ % just X.
+ %
+ % If the second unification were a construction instead of a
+ % deconstruction, we want to make the transformation in both cases,
+ % because the heap allocation we thus avoid is quite expensive,
+ % and because it actually reduces the number of stack slots we need
+ % across the call (X instead of A1 .. A4). The exception is
+ % constructions using function symbols of arity zero, which we
+ % never need to eliminate. We process unifications with constants
+ % only to update our information about variable equivalences: after
+ % X = c and Y = c, X and Y are equivalent.
+ %
+ % The seen_calls field records which calls we have seen, which we use
+ % to eliminate duplicate calls.
-:- type call_args
- ---> call_args(prog_context, list(prog_var), list(prog_var)).
- % input, output args. For higher-order calls,
- % the closure is the first input argument.
+:- type common_info
+ ---> common_info(
+ var_eqv :: eqvclass(prog_var),
+ all_structs :: struct_map,
+ since_call_structs :: struct_map,
+ seen_calls :: seen_calls
+ ).
+
+ % A struct_map maps a principal type constructor and a cons_id of that
+ % type to information about cells involving that cons_id.
+ %
+ % The reason why we need the principal type constructors is that two
+ % syntactially identical structures have compatible representations
+ % if and only if their principal type constructors are the same.
+ % For example, if we have
+ %
+ % :- type maybe_err(T) --> ok(T) ; err(string).
+ %
+ % :- pred p(maybe_err(foo)::in, maybe_err(bar)::out) is semidet.
+ % p(err(X), err(X)).
+ %
+ % then we want to reuse the `err(X)' in the first arg rather than
+ % constructing a new copy of it for the second arg.
+ % The two occurrences of `err(X)' have types `maybe_err(int)'
+ % and `maybe(float)', but we know that they have the same
+ % representation.
+ %
+ % We put the cons_id first in the pair because there are more cons_ids
+ % than type constructors, and hence comparisons involving cons_ids are
+ % more likely to fail. This should ensure that failed comparisons in map
+ % searches fail as soon as possible.
+
+:- type cons_id_map == map(cons_id, structures).
+:- type struct_map == map(type_ctor, cons_id_map).
+
+ % Given a unification X = f(Y1, ... Yn), we record its availability for
+ % reuse by creating structure(X, [Y1, ... Yn]), and putting it at the
+ % front of the list of structures for the entry for f and X's type_ctor.
+
+:- type structures == list(structure).
+:- type structure
+ ---> structure(prog_var, list(prog_var)).
-:- type struct_map == map(cons_id, list(structure)).
:- type seen_calls == map(seen_call_id, list(call_args)).
-:- type common_info
- ---> common(
- eqvclass(prog_var),
- struct_map, % all structs seen.
- struct_map, % structs seen since the last call.
- seen_calls
+:- type call_args
+ ---> call_args(
+ prog_context, % The context of the call, for use in
+ % warnings about % duplicate calls.
+ list(prog_var), % The input arguments. For higher-order
+ % calls, the closure is the first input
+ % argument.
+ list(prog_var) % The output arguments.
).
%---------------------------------------------------------------------------%
-common_info_init(CommonInfo) :-
+common_info_init = CommonInfo :-
eqvclass__init(VarEqv0),
map__init(StructMap0),
map__init(SeenCalls0),
- CommonInfo = common(VarEqv0, StructMap0, StructMap0, SeenCalls0).
+ CommonInfo = common_info(VarEqv0, StructMap0, StructMap0, SeenCalls0).
- % Clear structs seen since the last call. Replacing deconstructions
- % of these structs with assignments after the call would cause an
- % increase in the number of stack slots required.
-common_info_clear_structs(common(VarEqv, StructMap, _, SeenCalls),
- common(VarEqv, StructMap, Empty, SeenCalls)) :-
- map__init(Empty).
+ % Clear structs seen since the last call.
+common_info_clear_structs(Info, Info ^ since_call_structs := map__init).
%---------------------------------------------------------------------------%
@@ -154,29 +238,42 @@
Goal = Goal0,
GoalInfo = GoalInfo0
;
- % common__generate_assign assumes that the
- % output variable is in the instmap_delta, which
- % will not be true if the variable is a local.
- % The optimization is pointless in that case.
+ TypeCtor = lookup_var_type_ctor(!.Info, Var),
+ simplify_info_get_common_info(!.Info, CommonInfo0),
+ VarEqv0 = CommonInfo0 ^ var_eqv,
+ list__map_foldl(eqvclass__ensure_element_partition_id,
+ ArgVars, ArgVarIds, VarEqv0, VarEqv1),
+ AllStructMap0 = CommonInfo0 ^ all_structs,
+ SinceCallStructMap0 = CommonInfo0 ^ since_call_structs,
+ (
+ % common__generate_assign assumes that the output variable
+ % is in the instmap_delta, which will not be true if the
+ % variable is local to the unification. The optimization
+ % is pointless in that case.
goal_info_get_instmap_delta(GoalInfo0, InstMapDelta),
instmap_delta_search_var(InstMapDelta, Var, _),
- common__find_matching_cell(Var, ConsId, ArgVars,
- construction, !.Info, OldStruct)
- ->
- OldStruct = structure(OldVar, _, _, _),
- ( ArgVars = [] ->
- % Constants don't use memory, so there's
- % no point optimizing away their
- % construction -- in fact, doing so
+
+ map__search(AllStructMap0, TypeCtor, ConsIdMap0),
+ map__search(ConsIdMap0, ConsId, Structs),
+ find_matching_cell_construct(Structs, VarEqv1, ArgVarIds,
+ OldStruct)
+ ->
+ OldStruct = structure(OldVar, _),
+ sveqvclass__ensure_equivalence(Var, OldVar, VarEqv1, VarEqv),
+ CommonInfo = CommonInfo0 ^ var_eqv := VarEqv,
+ simplify_info_set_common_info(CommonInfo, !Info),
+ (
+ ArgVars = [],
+ % Constants don't use memory, so there's no point in
+ % optimizing away their construction; in fact, doing so
% could cause more stack usage.
- common__record_equivalence(Var, OldVar,
- !Info),
Goal = Goal0,
GoalInfo = GoalInfo0
;
+ ArgVars = [_ | _],
UniMode = ((free - Inst) -> (Inst - Inst)),
- common__generate_assign(Var, OldVar, UniMode,
- GoalInfo0, Goal - GoalInfo, !Info),
+ common__generate_assign(Var, OldVar, UniMode, GoalInfo0,
+ Goal - GoalInfo, !Info),
simplify_info_set_requantify(!Info),
pd_cost__goal(Goal0 - GoalInfo0, Cost),
simplify_info_incr_cost_delta(Cost, !Info)
@@ -184,11 +281,19 @@
;
Goal = Goal0,
GoalInfo = GoalInfo0,
- common__record_cell(Var, ConsId, ArgVars, !Info)
+ Struct = structure(Var, ArgVars),
+ common__do_record_cell(TypeCtor, ConsId, Struct,
+ AllStructMap0, AllStructMap),
+ common__do_record_cell(TypeCtor, ConsId, Struct,
+ SinceCallStructMap0, SinceCallStructMap),
+ CommonInfo = (((CommonInfo0 ^ var_eqv := VarEqv1)
+ ^ all_structs := AllStructMap)
+ ^ since_call_structs := SinceCallStructMap),
+ simplify_info_set_common_info(CommonInfo, !Info)
+ )
)
;
- Unification0 = deconstruct(Var, ConsId,
- ArgVars, UniModes, CanFail, _),
+ Unification0 = deconstruct(Var, ConsId, ArgVars, UniModes, CanFail, _),
simplify_info_get_module_info(!.Info, ModuleInfo),
(
% Don't optimise partially instantiated
@@ -203,28 +308,53 @@
->
Goal = Goal0
;
+ TypeCtor = lookup_var_type_ctor(!.Info, Var),
+ simplify_info_get_common_info(!.Info, CommonInfo0),
+ VarEqv0 = CommonInfo0 ^ var_eqv,
+ eqvclass__ensure_element_partition_id(Var, VarId,
+ VarEqv0, VarEqv1),
+ AllStructMap0 = CommonInfo0 ^ all_structs,
+ SinceCallStructMap0 = CommonInfo0 ^ since_call_structs,
+ (
% Do not delete deconstruction unifications inserted by
% stack_opt.m, which has done a more comprehensive cost
% analysis than common.m can do.
\+ goal_info_has_feature(GoalInfo, stack_opt),
- common__find_matching_cell(Var, ConsId, ArgVars,
- deconstruction, !.Info, OldStruct)
- ->
- OldStruct = structure(_, _, _, OldArgVars),
+
+ map__search(SinceCallStructMap0, TypeCtor, ConsIdMap0),
+ map__search(ConsIdMap0, ConsId, Structs),
+ find_matching_cell_deconstruct(Structs, VarEqv1, VarId,
+ OldStruct)
+ ->
+ OldStruct = structure(_, OldArgVars),
+ eqvclass__ensure_corresponding_equivalences(ArgVars,
+ OldArgVars, VarEqv1, VarEqv),
+ CommonInfo = CommonInfo0 ^ var_eqv := VarEqv,
+ simplify_info_set_common_info(CommonInfo, !Info),
common__create_output_unifications(GoalInfo0, ArgVars,
OldArgVars, UniModes, Goals, !Info),
Goal = conj(Goals),
pd_cost__goal(Goal0 - GoalInfo0, Cost),
simplify_info_incr_cost_delta(Cost, !Info),
simplify_info_set_requantify(!Info),
- ( CanFail = can_fail ->
+ (
+ CanFail = can_fail,
simplify_info_set_rerun_det(!Info)
;
- true
+ CanFail = cannot_fail
)
;
Goal = Goal0,
- common__record_cell(Var, ConsId, ArgVars, !Info)
+ Struct = structure(Var, ArgVars),
+ common__do_record_cell(TypeCtor, ConsId, Struct,
+ AllStructMap0, AllStructMap),
+ common__do_record_cell(TypeCtor, ConsId, Struct,
+ SinceCallStructMap0, SinceCallStructMap),
+ CommonInfo = (((CommonInfo0 ^ var_eqv := VarEqv1)
+ ^ all_structs := AllStructMap)
+ ^ since_call_structs := SinceCallStructMap),
+ simplify_info_set_common_info(CommonInfo, !Info)
+ )
),
GoalInfo = GoalInfo0
;
@@ -243,152 +373,77 @@
GoalInfo = GoalInfo0
).
-%---------------------------------------------------------------------------%
-
-:- type unification_type
- ---> deconstruction
- ; construction.
-
-:- pred common__find_matching_cell(prog_var::in, cons_id::in,
- list(prog_var)::in, unification_type::in, simplify_info::in,
- structure::out) is semidet.
+:- func lookup_var_type_ctor(simplify_info, prog_var) = type_ctor.
-common__find_matching_cell(Var, ConsId, ArgVars, UniType, Info, OldStruct) :-
- simplify_info_get_common_info(Info, CommonInfo),
+lookup_var_type_ctor(Info, Var) = TypeCtor :-
simplify_info_get_var_types(Info, VarTypes),
- CommonInfo = common(VarEqv, StructMapAll, StructMapSinceLastFlush, _),
- (
- UniType = construction,
- StructMapToUse = StructMapAll
- ;
- % For deconstructions, using the arguments of a cell
- % created before the last stack flush would cause more
- % variables to be saved on the stack.
- UniType = deconstruction,
- StructMapToUse = StructMapSinceLastFlush
- ),
- map__search(StructMapToUse, ConsId, Structs),
- common__find_matching_cell_2(Structs, Var, ConsId, ArgVars, UniType,
- VarEqv, VarTypes, OldStruct).
-
-:- pred common__find_matching_cell_2(list(structure)::in, prog_var::in,
- cons_id::in, list(prog_var)::in, unification_type::in,
- eqvclass(prog_var)::in, vartypes::in, structure::out) is semidet.
-
-common__find_matching_cell_2([Struct | Structs], Var, ConsId, ArgVars,
- UniType, VarEqv, VarTypes, OldStruct) :-
- Struct = structure(OldVar, StructType, StructConsId, StructArgVars),
- (
- % Are the arguments the same (or equivalent) variables?
- ConsId = StructConsId,
- (
- UniType = construction,
- common__var_lists_are_equiv(ArgVars,
- StructArgVars, VarEqv),
-
- % Two structures of the same shape may have different
- % types and therefore different representations.
- map__lookup(VarTypes, Var, VarType),
- common__compatible_types(VarType, StructType)
- ;
- UniType = deconstruction,
- common__vars_are_equiv(Var, OldVar, VarEqv)
- )
- ->
- OldStruct = Struct
- ;
- common__find_matching_cell_2(Structs, Var, ConsId, ArgVars,
- UniType, VarEqv, VarTypes, OldStruct)
+ map__lookup(VarTypes, Var, Type),
+ ( type_to_ctor_and_args(Type, TypeCtorPrime, _) ->
+ TypeCtor = TypeCtorPrime
+ ;
+ % If we unify a variable with a function symbol, we *must* know
+ % what the principal type constructor of its type is.
+ error("lookup_var_type_ctor: cannot find type_ctor")
).
%---------------------------------------------------------------------------%
- % Two structures have compatible representations if the top
- % level of their types are unifiable. % For example, if we have
- %
- % :- type maybe_err(T) --> ok(T) ; err(string).
- %
- % :- pred p(maybe_err(foo)::in, maybe_err(bar)::out) is semidet.
- % p(err(X), err(X)).
- %
- % then we want to reuse the `err(X)' in the first arg rather than
- % constructing a new copy of it for the second arg.
- % The two occurrences of `err(X)' have types `maybe_err(int)'
- % and `maybe(float)', but we know that they have the same
- % representation.
+:- pred find_matching_cell_construct(structures::in, eqvclass(prog_var)::in,
+ list(partition_id)::in, structure::out) is semidet.
-:- pred common__compatible_types((type)::in, (type)::in) is semidet.
+find_matching_cell_construct([Struct | Structs], VarEqv, ArgVarIds, Match) :-
+ Struct = structure(_Var, Vars),
+ ( common__ids_vars_match(ArgVarIds, Vars, VarEqv) ->
+ Match = Struct
+ ;
+ find_matching_cell_construct(Structs, VarEqv, ArgVarIds, Match)
+ ).
-common__compatible_types(Type1, Type2) :-
- type_to_ctor_and_args(Type1, TypeCtor1, _),
- type_to_ctor_and_args(Type2, TypeCtor2, _),
- TypeCtor1 = TypeCtor2.
+:- pred find_matching_cell_deconstruct(structures::in, eqvclass(prog_var)::in,
+ partition_id::in, structure::out) is semidet.
-%---------------------------------------------------------------------------%
+find_matching_cell_deconstruct([Struct | Structs], VarEqv, VarId, Match) :-
+ Struct = structure(Var, _Vars),
+ ( common__id_var_match(VarId, Var, VarEqv) ->
+ Match = Struct
+ ;
+ find_matching_cell_deconstruct(Structs, VarEqv, VarId, Match)
+ ).
- % succeeds if the two lists of variables are equivalent
- % according to the specified equivalence class.
-:- pred common__var_lists_are_equiv(list(prog_var)::in, list(prog_var)::in,
+:- pred common__ids_vars_match(list(partition_id)::in, list(prog_var)::in,
eqvclass(prog_var)::in) is semidet.
-common__var_lists_are_equiv([], [], _VarEqv).
-common__var_lists_are_equiv([X | Xs], [Y | Ys], VarEqv) :-
- common__vars_are_equiv(X, Y, VarEqv),
- common__var_lists_are_equiv(Xs, Ys, VarEqv).
-
-common__vars_are_equivalent(X, Y, CommonInfo) :-
- CommonInfo = common(EqvVars, _, _, _),
- common__vars_are_equiv(X, Y, EqvVars).
+common__ids_vars_match([], [], _VarEqv).
+common__ids_vars_match([Id | Ids], [Var | Vars], VarEqv) :-
+ common__id_var_match(Id, Var, VarEqv),
+ common__ids_vars_match(Ids, Vars, VarEqv).
- % succeeds if the two variables are equivalent
- % according to the specified equivalence class.
-:- pred common__vars_are_equiv(prog_var::in, prog_var::in,
+:- pragma inline(common__id_var_match/3).
+:- pred common__id_var_match(partition_id::in, prog_var::in,
eqvclass(prog_var)::in) is semidet.
-common__vars_are_equiv(X, Y, VarEqv) :-
- (
- X = Y
- ;
- eqvclass__is_member(VarEqv, X),
- eqvclass__is_member(VarEqv, Y),
- eqvclass__same_eqvclass(VarEqv, X, Y)
- ).
+common__id_var_match(Id, Var, VarEqv) :-
+ eqvclass__partition_id(VarEqv, Var, VarId),
+ Id = VarId.
%---------------------------------------------------------------------------%
-:- pred common__record_cell(prog_var::in, cons_id::in, list(prog_var)::in,
- simplify_info::in, simplify_info::out) is det.
-
-common__record_cell(Var, ConsId, ArgVars, !Info) :-
- simplify_info_get_common_info(!.Info, CommonInfo0),
- simplify_info_get_var_types(!.Info, VarTypes),
- CommonInfo0 = common(VarEqv, StructMapAll0,
- StructMapLastCall0, SeenCalls),
- map__lookup(VarTypes, Var, VarType),
- Struct = structure(Var, VarType, ConsId, ArgVars),
- common__do_record_cell(ConsId, Struct, StructMapAll0, StructMapAll),
- common__do_record_cell(ConsId, Struct,
- StructMapLastCall0, StructMapLastCall),
- CommonInfo = common(VarEqv, StructMapAll,
- StructMapLastCall, SeenCalls),
- simplify_info_set_common_info(CommonInfo, !Info).
-
-:- pred common__do_record_cell(cons_id::in, structure::in,
+:- pred common__do_record_cell(type_ctor::in, cons_id::in, structure::in,
struct_map::in, struct_map::out) is det.
-common__do_record_cell(ConsId, Struct, StructMap0, StructMap) :-
- ( map__search(StructMap0, ConsId, StructList0Prime) ->
- StructList0 = StructList0Prime
+common__do_record_cell(TypeCtor, ConsId, Struct, !StructMap) :-
+ ( map__search(!.StructMap, TypeCtor, ConsIdMap0) ->
+ ( map__search(ConsIdMap0, ConsId, Structs0) ->
+ Structs = [Struct | Structs0],
+ map__det_update(ConsIdMap0, ConsId, Structs, ConsIdMap)
;
- StructList0 = []
+ map__det_insert(ConsIdMap0, ConsId, [Struct], ConsIdMap)
),
-
- % Insert the new cell at the front of the list. If it hides
- % an equivalent cell, at least the reuse of this cell will
- % require saving its address over fewer calls.
-
- StructList = [Struct | StructList0],
- map__set(StructMap0, ConsId, StructList, StructMap).
+ svmap__det_update(TypeCtor, ConsIdMap, !StructMap)
+ ;
+ map__det_insert(map__init, ConsId, [Struct], ConsIdMap),
+ svmap__det_insert(TypeCtor, ConsIdMap, !StructMap)
+ ).
%---------------------------------------------------------------------------%
@@ -397,9 +452,9 @@
common__record_equivalence(Var1, Var2, !Info) :-
simplify_info_get_common_info(!.Info, CommonInfo0),
- CommonInfo0 = common(VarEqv0, StructMap0, StructMap1, SeenCalls),
+ VarEqv0 = CommonInfo0 ^ var_eqv,
eqvclass__ensure_equivalence(VarEqv0, Var1, Var2, VarEqv),
- CommonInfo = common(VarEqv, StructMap0, StructMap1, SeenCalls),
+ CommonInfo = CommonInfo0 ^ var_eqv := VarEqv,
simplify_info_set_common_info(CommonInfo, !Info).
%---------------------------------------------------------------------------%
@@ -411,11 +466,10 @@
common__check_call_detism(Det),
simplify_info_get_var_types(!.Info, VarTypes),
simplify_info_get_module_info(!.Info, ModuleInfo),
- module_info_pred_proc_info(ModuleInfo, PredId,
- ProcId, _, ProcInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_argmodes(ProcInfo, ArgModes),
- common__partition_call_args(VarTypes, ModuleInfo, ArgModes,
- Args, InputArgs, OutputArgs, OutputModes)
+ common__partition_call_args(VarTypes, ModuleInfo, ArgModes, Args,
+ InputArgs, OutputArgs, OutputModes)
->
common__optimise_call_2(seen_call(PredId, ProcId), InputArgs,
OutputArgs, OutputModes, GoalInfo, Goal0, Goal, !Info)
@@ -432,9 +486,8 @@
common__partition_call_args(VarTypes, ModuleInfo, Modes, Args,
InputArgs, OutputArgs, OutputModes)
->
- common__optimise_call_2(higher_order_call,
- [Closure | InputArgs], OutputArgs, OutputModes,
- GoalInfo, Goal0, Goal, !Info)
+ common__optimise_call_2(higher_order_call, [Closure | InputArgs],
+ OutputArgs, OutputModes, GoalInfo, Goal0, Goal, !Info)
;
Goal = Goal0
).
@@ -457,19 +510,17 @@
common__optimise_call_2(SeenCall, InputArgs, OutputArgs, Modes, GoalInfo,
Goal0, Goal, !Info) :-
simplify_info_get_common_info(!.Info, CommonInfo0),
- CommonInfo0 = common(Eqv0, Structs0, Structs1, SeenCalls0),
+ Eqv0 = CommonInfo0 ^ var_eqv,
+ SeenCalls0 = CommonInfo0 ^ seen_calls,
+ ( map__search(SeenCalls0, SeenCall, SeenCallsList0) ->
(
- map__search(SeenCalls0, SeenCall, SeenCallsList0)
- ->
- ( common__find_previous_call(SeenCallsList0, InputArgs,
- Eqv0, OutputArgs2, PrevContext)
+ common__find_previous_call(SeenCallsList0, InputArgs, Eqv0,
+ OutputArgs2, PrevContext)
->
simplify_info_get_module_info(!.Info, ModuleInfo),
- mode_util__modes_to_uni_modes(Modes, Modes, ModuleInfo,
- UniModes),
+ mode_util__modes_to_uni_modes(Modes, Modes, ModuleInfo, UniModes),
common__create_output_unifications(GoalInfo,
- OutputArgs, OutputArgs2, UniModes, Goals,
- !Info),
+ OutputArgs, OutputArgs2, UniModes, Goals, !Info),
Goal = conj(Goals),
simplify_info_get_var_types(!.Info, VarTypes),
(
@@ -477,23 +528,18 @@
% Don't warn for cases such as:
% set__init(Set1 : set(int)),
% set__init(Set2 : set(float)).
- map__apply_to_list(OutputArgs, VarTypes,
- OutputArgTypes1),
- map__apply_to_list(OutputArgs2, VarTypes,
- OutputArgTypes2),
+ map__apply_to_list(OutputArgs, VarTypes, OutputArgTypes1),
+ map__apply_to_list(OutputArgs2, VarTypes, OutputArgTypes2),
common__types_match_exactly_list(
OutputArgTypes1, OutputArgTypes2)
->
goal_info_get_context(GoalInfo, Context),
simplify_info_do_add_msg(
- duplicate_call(SeenCall, PrevContext,
- Context),
- !Info)
+ duplicate_call(SeenCall, PrevContext, Context), !Info)
;
true
),
- CommonInfo = common(Eqv0, Structs0, Structs1,
- SeenCalls0),
+ CommonInfo = CommonInfo0,
pd_cost__goal(Goal0 - GoalInfo, Cost),
simplify_info_incr_cost_delta(Cost, !Info),
simplify_info_set_requantify(!Info),
@@ -508,15 +554,14 @@
ThisCall = call_args(Context, InputArgs, OutputArgs),
map__det_update(SeenCalls0, SeenCall,
[ThisCall | SeenCallsList0], SeenCalls),
- CommonInfo = common(Eqv0, Structs0,
- Structs1, SeenCalls),
+ CommonInfo = CommonInfo0 ^ seen_calls := SeenCalls,
Goal = Goal0
)
;
goal_info_get_context(GoalInfo, Context),
ThisCall = call_args(Context, InputArgs, OutputArgs),
map__det_insert(SeenCalls0, SeenCall, [ThisCall], SeenCalls),
- CommonInfo = common(Eqv0, Structs0, Structs1, SeenCalls),
+ CommonInfo = CommonInfo0 ^ seen_calls := SeenCalls,
Goal = Goal0
),
simplify_info_set_common_info(CommonInfo, !Info).
@@ -586,6 +631,35 @@
%---------------------------------------------------------------------------%
+ % succeeds if the two lists of variables are equivalent
+ % according to the specified equivalence class.
+:- pred common__var_lists_are_equiv(list(prog_var)::in, list(prog_var)::in,
+ eqvclass(prog_var)::in) is semidet.
+
+common__var_lists_are_equiv([], [], _VarEqv).
+common__var_lists_are_equiv([X | Xs], [Y | Ys], VarEqv) :-
+ common__vars_are_equiv(X, Y, VarEqv),
+ common__var_lists_are_equiv(Xs, Ys, VarEqv).
+
+common__vars_are_equivalent(X, Y, CommonInfo) :-
+ EqvVars = CommonInfo ^ var_eqv,
+ common__vars_are_equiv(X, Y, EqvVars).
+
+ % succeeds if the two variables are equivalent
+ % according to the specified equivalence class.
+:- pred common__vars_are_equiv(prog_var::in, prog_var::in,
+ eqvclass(prog_var)::in) is semidet.
+
+common__vars_are_equiv(X, Y, VarEqv) :-
+ (
+ X = Y
+ ;
+ eqvclass__partition_id(VarEqv, X, Id),
+ eqvclass__partition_id(VarEqv, Y, Id)
+ ).
+
+%---------------------------------------------------------------------------%
+
:- pred common__create_output_unifications(hlds_goal_info::in,
list(prog_var)::in, list(prog_var)::in, list(uni_mode)::in,
list(hlds_goal)::out, simplify_info::in,
@@ -610,11 +684,11 @@
% with a partially instantiated deconstruction.
OutputArg \= OldOutputArg
->
- common__generate_assign(OutputArg, OldOutputArg,
- UniMode, GoalInfo, Goal, !Info),
+ common__generate_assign(OutputArg, OldOutputArg, UniMode, GoalInfo,
+ Goal, !Info),
common__create_output_unifications(GoalInfo,
- OutputArgsTail, OldOutputArgsTail,
- UniModesTail, GoalsTail, !Info),
+ OutputArgsTail, OldOutputArgsTail, UniModesTail,
+ GoalsTail, !Info),
Goals = [Goal | GoalsTail]
;
common__create_output_unifications(GoalInfo,
@@ -634,8 +708,8 @@
%---------------------------------------------------------------------------%
:- pred common__generate_assign(prog_var::in, prog_var::in, uni_mode::in,
- hlds_goal_info::in, hlds_goal::out,
- simplify_info::in, simplify_info::out) is det.
+ hlds_goal_info::in, hlds_goal::out, simplify_info::in, simplify_info::out)
+ is det.
common__generate_assign(ToVar, FromVar, UniMode, _, Goal, !Info) :-
simplify_info_get_var_types(!.Info, VarTypes),
@@ -645,8 +719,7 @@
set__list_to_set([ToVar, FromVar], NonLocals),
UniMode = ((_ - ToVarInst0) -> (_ - ToVarInst)),
( common__types_match_exactly(ToVarType, FromVarType) ->
- UnifyMode = (ToVarInst0 -> ToVarInst) -
- (ToVarInst -> ToVarInst),
+ UnifyMode = (ToVarInst0 -> ToVarInst) - (ToVarInst -> ToVarInst),
UnifyContext = unify_context(explicit, []),
GoalExpr = unify(ToVar, var(FromVar), UnifyMode,
assign(ToVar, FromVar), UnifyContext)
@@ -659,8 +732,7 @@
% since the call to the type cast hides the equivalence of
% the input and output.
Modes = [(ToVarInst -> ToVarInst), (free -> ToVarInst)],
- GoalExpr = generic_call(unsafe_cast, [FromVar, ToVar],
- Modes, det)
+ GoalExpr = generic_call(unsafe_cast, [FromVar, ToVar], Modes, det)
),
% `ToVar' may not appear in the original instmap_delta,
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.136
diff -u -b -r1.136 simplify.m
--- compiler/simplify.m 21 Jan 2005 03:27:48 -0000 1.136
+++ compiler/simplify.m 21 Jan 2005 03:32:38 -0000
@@ -516,7 +516,7 @@
;
%
% Conjunctions that cannot produce solutions may nevertheless
- % contain nondet and multidet goals. If this happens, the
+ % contain nondet and multi goals. If this happens, the
% conjunction is put inside a `some' to appease the code
% generator.
%
@@ -771,7 +771,7 @@
simplify__goal_2(Goal0, Goal, GoalInfo0, GoalInfo, !Info) :-
Goal0 = unify(LT0, RT0, M, U0, C),
(
- % A unification of the form X = X can safely be
+ % A unification of the form X = X can be safely
% optimised away.
RT0 = var(LT0)
@@ -793,8 +793,7 @@
% Don't attempt to pass structs into lambda_goals,
% since that could change the curried non-locals of the
% lambda_goal, and that would be difficult to fix up.
- common_info_init(Common2),
- simplify_info_set_common_info(Common2, !Info),
+ simplify_info_set_common_info(common_info_init, !Info),
% Don't attempt to pass structs out of lambda_goals.
simplify__goal(LambdaGoal0, LambdaGoal, !Info),
@@ -1673,18 +1672,17 @@
simplify_info::in, simplify_info::out) is det.
simplify__maybe_wrap_goal(OuterGoalInfo, InnerGoalInfo,
- Goal1, Goal, GoalInfo, Info0, Info) :-
+ Goal1, Goal, GoalInfo, !Info) :-
(
goal_info_get_determinism(InnerGoalInfo, Det),
goal_info_get_determinism(OuterGoalInfo, Det)
->
Goal = Goal1,
- GoalInfo = InnerGoalInfo,
- Info = Info0
+ GoalInfo = InnerGoalInfo
;
Goal = some([], can_remove, Goal1 - InnerGoalInfo),
GoalInfo = OuterGoalInfo,
- simplify_info_set_rerun_det(Info0, Info)
+ simplify_info_set_rerun_det(!Info)
).
%-----------------------------------------------------------------------------%
@@ -1719,7 +1717,8 @@
;
Goal1 = _ - GoalInfo1,
goal_info_get_determinism(GoalInfo1, Detism1),
- determinism_components(Detism1, _, at_most_zero)
+ determinism_components(Detism1, _,
+ at_most_zero)
)
->
simplify__conjoin_goal_and_rev_goal_list(Goal1,
@@ -2234,12 +2233,11 @@
typeclass_info_varmap :: typeclass_info_varmap
).
-simplify_info_init(DetInfo, Simplifications0, InstMap,
- VarSet, InstVarSet, TVarMap, TCVarMap, Info) :-
- common_info_init(CommonInfo),
+simplify_info_init(DetInfo, Simplifications0, InstMap, VarSet, InstVarSet,
+ TVarMap, TCVarMap, Info) :-
set__init(Msgs),
set__list_to_set(Simplifications0, Simplifications),
- Info = simplify_info(DetInfo, Msgs, Simplifications, CommonInfo,
+ Info = simplify_info(DetInfo, Msgs, Simplifications, common_info_init,
InstMap, VarSet, InstVarSet, no, no, no, 0, 0,
TVarMap, TCVarMap).
@@ -2247,15 +2245,14 @@
:- pred simplify_info_reinit(set(simplification)::in, instmap::in,
simplify_info::in, simplify_info::out) is det.
-simplify_info_reinit(Simplifications, InstMap0) -->
- { common_info_init(Common) },
- ^simplifications := Simplifications,
- ^common_info := Common,
- ^instmap := InstMap0,
- ^requantify := no,
- ^recompute_atomic := no,
- ^rerun_det := no,
- ^lambdas := 0.
+simplify_info_reinit(Simplifications, InstMap0, !Info) :-
+ !:Info = !.Info ^ simplifications := Simplifications,
+ !:Info = !.Info ^ common_info := common_info_init,
+ !:Info = !.Info ^ instmap := InstMap0,
+ !:Info = !.Info ^ requantify := no,
+ !:Info = !.Info ^ recompute_atomic := no,
+ !:Info = !.Info ^ rerun_det := no,
+ !:Info = !.Info ^ lambdas := 0.
% exported for common.m
:- interface.
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/eqvclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/eqvclass.m,v
retrieving revision 1.15
diff -u -b -r1.15 eqvclass.m
--- library/eqvclass.m 14 Jan 2005 06:04:22 -0000 1.15
+++ library/eqvclass.m 20 Jan 2005 04:46:27 -0000
@@ -1,4 +1,6 @@
%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
% Copyright (C) 1995-1997, 1999, 2003-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
@@ -19,6 +21,7 @@
:- import_module set, list.
:- type eqvclass(T).
+:- type partition_id.
% Create an empty equivalance class.
@@ -29,6 +32,31 @@
:- pred eqvclass__is_member(eqvclass(T)::in, T::in) is semidet.
+ % If this item is known to the equivalence class, return the id of its
+ % partition. The only use that the caller can make of the partition id
+ % is to check whether two items in the same equivalence calls have the
+ % same partition id; that test will succeed if and only if the two
+ % items are in the same partition. Partition ids are not guaranteed
+ % to stay the same as an eqvclass is updated, so such comparisons will
+ % work only against the same eqvclass.
+ %
+ % If you want to check whether two items are in the same equivalence class,
+ % using eqvclass__same_eqvclass is more expressive than calling
+ % eqvclass__partition_id on both items and comparing the results.
+ % However, if you want to perform this check on X and Y1, on X and Y2,
+ % ... X and Yn, then calling eqvclass__partition_id on X just once and
+ % comparing this with the partition_ids of the Yi will be more efficient.
+
+:- pred eqvclass__partition_id(eqvclass(T)::in, T::in, partition_id::out)
+ is semidet.
+
+ % Make this item known to the equivalence class if it isn't already,
+ % and return the id of its partition. The same proviso applies with
+ % respect to partition_ids as with eqvclass__partition_id.
+
+:- pred eqvclass__ensure_element_partition_id(T::in, partition_id::out,
+ eqvclass(T)::in, eqvclass(T)::out) is det.
+
% Make an element known to the equivalence class.
% The element may already be known to the class;
% if it isn't, it is created without any equivalence relationships.
@@ -51,6 +79,11 @@
eqvclass(T)::out) is det.
:- func eqvclass__ensure_equivalence(eqvclass(T), T, T) = eqvclass(T).
+:- pred eqvclass__ensure_corresponding_equivalences(list(T)::in, list(T)::in,
+ eqvclass(T)::in, eqvclass(T)::out) is det.
+:- func eqvclass__ensure_corresponding_equivalences(list(T), list(T),
+ eqvclass(T)) = eqvclass(T).
+
% Make two elements of the equivalence class equivalent.
% It is an error if they are already equivalent.
@@ -129,13 +162,14 @@
ElementMap = EqvClass ^ keys,
map__search(ElementMap, Element, _).
-eqvclass__ensure_element(EqvClass0, Element, EqvClass) :-
- eqvclass__ensure_element_2(Element, _, EqvClass0, EqvClass).
+eqvclass__partition_id(EqvClass, Element, PartitionId) :-
+ ElementMap = EqvClass ^ keys,
+ map__search(ElementMap, Element, PartitionId).
-:- pred eqvclass__ensure_element_2(T::in, partition_id::out,
- eqvclass(T)::in, eqvclass(T)::out) is det.
+eqvclass__ensure_element(EqvClass0, Element, EqvClass) :-
+ eqvclass__ensure_element_partition_id(Element, _, EqvClass0, EqvClass).
-eqvclass__ensure_element_2(Element, Id, !EqvClass) :-
+eqvclass__ensure_element_partition_id(Element, Id, !EqvClass) :-
ElementMap = !.EqvClass ^ keys,
( map__search(ElementMap, Element, OldId) ->
Id = OldId
@@ -162,35 +196,136 @@
map__det_insert(PartitionMap0, Id, Partition, PartitionMap),
!:EqvClass = eqvclass(Counter, PartitionMap, ElementMap).
-eqvclass__ensure_equivalence(EqvClass0, Element1, Element2, EqvClass) :-
- eqvclass__ensure_element_2(Element1, Id1, EqvClass0, EqvClass1),
- eqvclass__ensure_element_2(Element2, Id2, EqvClass1, EqvClass2),
- ( Id1 = Id2 ->
- EqvClass = EqvClass2
+ % The following code is logically equivalent to this code:
+ %
+ % eqvclass__ensure_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
+ % eqvclass__ensure_element_2(ElementA, IdA, EqvClass0, EqvClass1),
+ % eqvclass__ensure_element_2(ElementB, IdB, EqvClass1, EqvClass2),
+ % ( IdA = IdB ->
+ % EqvClass = EqvClass2
+ % ;
+ % eqvclass__add_equivalence(IdA, IdB, EqvClass2, EqvClass)
+ % ).
+ %
+ % However, the above code allocates significantly more memory than the code
+ % below, because it can create an equivalence class for an element and then
+ % just throw that equivalence class away.
+
+eqvclass__ensure_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
+ ElementMap0 = EqvClass0 ^ keys,
+ ( map__search(ElementMap0, ElementA, IdA) ->
+ ( map__search(ElementMap0, ElementB, IdB) ->
+ ( IdA = IdB ->
+ EqvClass = EqvClass0
;
- eqvclass__add_equivalence(Id1, Id2, EqvClass2, EqvClass)
+ eqvclass__add_equivalence(IdA, IdB, EqvClass0, EqvClass)
+ )
+ ;
+ PartitionMap0 = EqvClass0 ^ partitions,
+ map__lookup(PartitionMap0, IdA, PartitionA),
+ set__insert(PartitionA, ElementB, Partition),
+ map__det_update(PartitionMap0, IdA, Partition, PartitionMap),
+ map__det_insert(ElementMap0, ElementB, IdA, ElementMap),
+ NextId0 = EqvClass0 ^ next_id,
+ EqvClass = eqvclass(NextId0, PartitionMap, ElementMap)
+ )
+ ;
+ ( map__search(ElementMap0, ElementB, IdB) ->
+ PartitionMap0 = EqvClass0 ^ partitions,
+ map__lookup(PartitionMap0, IdB, PartitionB),
+ set__insert(PartitionB, ElementA, Partition),
+ map__det_update(PartitionMap0, IdB, Partition, PartitionMap),
+ map__det_insert(ElementMap0, ElementA, IdB, ElementMap),
+ NextId0 = EqvClass0 ^ next_id,
+ EqvClass = eqvclass(NextId0, PartitionMap, ElementMap)
+ ;
+ NextId0 = EqvClass0 ^ next_id,
+ counter__allocate(Id, NextId0, NextId),
+ map__det_insert(ElementMap0, ElementA, Id, ElementMap1),
+ map__det_insert(ElementMap1, ElementB, Id, ElementMap),
+ PartitionMap0 = EqvClass0 ^ partitions,
+ set__list_to_set([ElementA, ElementB], Partition),
+ map__det_insert(PartitionMap0, Id, Partition, PartitionMap),
+ EqvClass = eqvclass(NextId, PartitionMap, ElementMap)
+ )
).
-eqvclass__new_equivalence(EqvClass0, Element1, Element2, EqvClass) :-
- eqvclass__ensure_element_2(Element1, Id1, EqvClass0, EqvClass1),
- eqvclass__ensure_element_2(Element2, Id2, EqvClass1, EqvClass2),
- ( Id1 = Id2 ->
+ % This code is the same as eqvclass__ensure_equivalence, with the
+ % exception that we abort if IdA = IdB in EqvClass0.
+
+eqvclass__new_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
+ ElementMap0 = EqvClass0 ^ keys,
+ ( map__search(ElementMap0, ElementA, IdA) ->
+ ( map__search(ElementMap0, ElementB, IdB) ->
+ ( IdA = IdB ->
error("two elements are already equivalent")
;
- eqvclass__add_equivalence(Id1, Id2, EqvClass2, EqvClass)
+ eqvclass__add_equivalence(IdA, IdB, EqvClass0, EqvClass)
+ )
+ ;
+ PartitionMap0 = EqvClass0 ^ partitions,
+ map__lookup(PartitionMap0, IdA, PartitionA),
+ set__insert(PartitionA, ElementB, Partition),
+ map__det_update(PartitionMap0, IdA, Partition, PartitionMap),
+ map__det_insert(ElementMap0, ElementB, IdA, ElementMap),
+ NextId0 = EqvClass0 ^ next_id,
+ EqvClass = eqvclass(NextId0, PartitionMap, ElementMap)
+ )
+ ;
+ ( map__search(ElementMap0, ElementB, IdB) ->
+ PartitionMap0 = EqvClass0 ^ partitions,
+ map__lookup(PartitionMap0, IdB, PartitionB),
+ set__insert(PartitionB, ElementA, Partition),
+ map__det_update(PartitionMap0, IdB, Partition, PartitionMap),
+ map__det_insert(ElementMap0, ElementA, IdB, ElementMap),
+ NextId0 = EqvClass0 ^ next_id,
+ EqvClass = eqvclass(NextId0, PartitionMap, ElementMap)
+ ;
+ NextId0 = EqvClass0 ^ next_id,
+ counter__allocate(Id, NextId0, NextId),
+ map__det_insert(ElementMap0, ElementA, Id, ElementMap1),
+ map__det_insert(ElementMap1, ElementB, Id, ElementMap),
+ PartitionMap0 = EqvClass0 ^ partitions,
+ set__list_to_set([ElementA, ElementB], Partition),
+ map__det_insert(PartitionMap0, Id, Partition, PartitionMap),
+ EqvClass = eqvclass(NextId, PartitionMap, ElementMap)
+ )
).
+eqvclass__ensure_corresponding_equivalences([], [], !EqvClass).
+eqvclass__ensure_corresponding_equivalences([], [_ | _], !EqvClass) :-
+ error("eqvclass__ensure_corresponding_equivalences: list mismatch").
+eqvclass__ensure_corresponding_equivalences([_ | _], [], !EqvClass) :-
+ error("eqvclass__ensure_corresponding_equivalences: list mismatch").
+eqvclass__ensure_corresponding_equivalences([H1 | T1], [H2 | T2], !EqvClass) :-
+ eqvclass__ensure_equivalence(!.EqvClass, H1, H2, !:EqvClass),
+ eqvclass__ensure_corresponding_equivalences(T1, T2, !EqvClass).
+
+eqvclass__ensure_corresponding_equivalences(L1, L2, EqvClass0) = EqvClass :-
+ eqvclass__ensure_corresponding_equivalences(L1, L2,
+ EqvClass0, EqvClass).
+
:- pred eqvclass__add_equivalence(partition_id::in, partition_id::in,
eqvclass(T)::in, eqvclass(T)::out) is det.
-eqvclass__add_equivalence(Id1, Id2, EqvClass0, EqvClass) :-
+eqvclass__add_equivalence(IdA, IdB, EqvClass0, EqvClass) :-
EqvClass0 = eqvclass(NextId0, PartitionMap0, ElementMap0),
- map__det_remove(PartitionMap0, Id2, Partition2, PartitionMap1),
- map__lookup(PartitionMap1, Id1, Partition1),
- set__union(Partition1, Partition2, Partition),
- map__set(PartitionMap1, Id1, Partition, PartitionMap),
- set__to_sorted_list(Partition2, Elements2),
- eqvclass__change_partition(Elements2, Id1, ElementMap0, ElementMap),
+ map__lookup(PartitionMap0, IdA, PartitionA),
+ map__lookup(PartitionMap0, IdB, PartitionB),
+ % We want eqvclass__change_partition to loop over the smaller set.
+ ( set__count(PartitionA) < set__count(PartitionB) ->
+ map__delete(PartitionMap0, IdA, PartitionMap1),
+ set__union(PartitionB, PartitionA, Partition),
+ map__set(PartitionMap1, IdB, Partition, PartitionMap),
+ set__to_sorted_list(PartitionA, ElementsA),
+ eqvclass__change_partition(ElementsA, IdB, ElementMap0, ElementMap)
+ ;
+ map__delete(PartitionMap0, IdB, PartitionMap1),
+ set__union(PartitionA, PartitionB, Partition),
+ map__set(PartitionMap1, IdA, Partition, PartitionMap),
+ set__to_sorted_list(PartitionB, ElementsB),
+ eqvclass__change_partition(ElementsB, IdA, ElementMap0, ElementMap)
+ ),
EqvClass = eqvclass(NextId0, PartitionMap, ElementMap).
:- pred eqvclass__change_partition(list(T)::in, partition_id::in,
@@ -280,8 +415,7 @@
PartitionMap0 = PartitionMap
;
counter__allocate(Id, Counter0, Counter),
- eqvclass__make_partition(Elements, Id,
- ElementMap0, ElementMap),
+ eqvclass__make_partition(Elements, Id, ElementMap0, ElementMap),
map__det_insert(PartitionMap0, Id, Partition, PartitionMap)
),
EqvClass = eqvclass(Counter, PartitionMap, ElementMap).
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: 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