[m-dev.] for review: use bitsets in quantification
Simon Taylor
stayl at cs.mu.OZ.AU
Fri Nov 3 18:35:46 AEDT 2000
Estimated hours taken: 12
Use bitsets to store the sets of variables in quantification.
This change reduces the time taken by `mmc -C make_hlds' by
7-8%.
library/sparse_bitset.m:
An ADT for storing sets of integers.
library/enum.m:
Contains a typeclass `enum/1' describing types which
can be converted to and from integers.
library/term.m:
Add an instance declaration for `enum(var(T))'.
library/int.m:
Add a function for finding the largest multiple of
bits_per_int which is less than a given number, for
use by sparse_bitset.m.
compiler/quantification.m:
Use `sparse_bitset(prog_var)' rather than `set(prog_var)'
for all the sets of variables used while quantifying a goal,
but arrange things so that it is simple use `set(prog_var)'
when debugging.
NEWS:
Document the new modules.
tests/hard_coded/Mmakefile:
tests/hard_coded/test_sparse_bitset.m:
tests/hard_coded/bitset_tester.m:
Add some tests for predicates and functions in
sparse_bitset.m which are not used in quantification.m.
Test storing negative integers in sparse_bitsets.
Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.177
diff -u -u -r1.177 NEWS
--- NEWS 2000/11/01 07:01:21 1.177
+++ NEWS 2000/11/03 07:19:30
@@ -89,6 +89,12 @@
* There is a new library module `counter' for managing counters.
+* We've added a new library module `sparse_bitset', which implements
+ an abstract data type for storing sets of integers.
+
+* There is a new library module `enum' which contains a typeclass
+ describing types which can be converted to and from integers.
+
* Four new parametric instantiations `maybe/1', `maybe_error/1',
`pair/2' and `pair/1' have been added to the `std_util' library
module. These make it more convenient to work with non-ground
Index: compiler/quantification.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/quantification.m,v
retrieving revision 1.76
diff -u -u -r1.76 quantification.m
--- compiler/quantification.m 2000/09/07 01:46:49 1.76
+++ compiler/quantification.m 2000/11/03 06:30:52
@@ -124,6 +124,7 @@
:- import_module map, term, varset.
:- import_module std_util, bool, require.
+:- import_module enum, sparse_bitset.
% The `outside vars', `lambda outside vars', and `quant vars'
% fields are inputs; the `nonlocals' field is output; and
@@ -135,16 +136,25 @@
:- type quant_info
---> quant_info(
nonlocals_to_recompute :: nonlocals_to_recompute,
- outside :: set(prog_var),
- quant_vars :: set(prog_var),
- lambda_outside :: set(prog_var),
- nonlocals :: set(prog_var),
- seen :: set(prog_var),
+ outside :: set_of_var,
+ quant_vars :: set_of_var,
+ lambda_outside :: set_of_var,
+ nonlocals :: set_of_var,
+ seen :: set_of_var,
varset :: prog_varset,
vartypes :: vartypes,
warnings :: list(quant_warning)
).
+ % Until we have user-specified pretty printing in the
+ % debugger, debugging will be much easier if set_of_var
+ % is just `set(prog_var)'.
+ % None of the calls to the predicates and functions operating
+ % on sets in this module are module qualified so we can switch
+ % representation just by changing this line.
+%:- type set_of_var == set(prog_var).
+:- type set_of_var == sparse_bitset(prog_var).
+
% `OutsideVars' are the variables that have occurred free outside
% this goal, not counting occurrences in parallel goals
% and not counting occurrences in lambda goals,
@@ -182,7 +192,7 @@
implicitly_quantify_clause_body(RecomputeNonLocals, HeadVars, Goal0,
Varset0, VarTypes0, Goal, Varset, VarTypes, Warnings) :-
- set__list_to_set(HeadVars, OutsideVars),
+ list_to_set(HeadVars, OutsideVars),
implicitly_quantify_goal(RecomputeNonLocals, Goal0, Varset0, VarTypes0,
OutsideVars, Goal, Varset, VarTypes, Warnings).
@@ -233,8 +243,9 @@
list(quant_warning)::out) is det.
implicitly_quantify_goal_2(RecomputeNonLocals,
- Goal0, Varset0, VarTypes0, OutsideVars,
+ Goal0, Varset0, VarTypes0, OutsideVars0,
Goal, Varset, VarTypes, Warnings) :-
+ OutsideVars = set_to_bitset(OutsideVars0),
quantification__init(RecomputeNonLocals, OutsideVars,
Varset0, VarTypes0, QuantInfo0),
implicitly_quantify_goal(Goal0, Goal, QuantInfo0, QuantInfo),
@@ -256,11 +267,11 @@
% If there are any variables that are local to the goal
% which we have come across before, then we rename them
% apart.
- { quantification__goal_vars(NonLocalsToRecompute,
+ { quantification__goal_vars_bitset(NonLocalsToRecompute,
Goal0 - GoalInfo0, GoalVars0) },
- { set__difference(GoalVars0, NonLocalVars, LocalVars) },
- { set__intersect(SeenVars, LocalVars, RenameVars) },
- { \+ set__empty(RenameVars) }
+ { difference(GoalVars0, NonLocalVars, LocalVars) },
+ { intersect(SeenVars, LocalVars, RenameVars) },
+ { \+ empty(RenameVars) }
->
quantification__rename_apart(RenameVars, _, Goal1 - GoalInfo0,
Goal - GoalInfo1)
@@ -268,7 +279,8 @@
{ Goal = Goal1 },
{ GoalInfo1 = GoalInfo0 }
),
- quantification__set_goal_nonlocals(GoalInfo1, NonLocalVars, GoalInfo2),
+ quantification__set_goal_nonlocals(GoalInfo1, NonLocalVars, GoalInfo2,
+ NonLocalVarsSet),
%
% If the non-locals set has shrunk (e.g. because some optimization
% optimizes away the other occurrences of a variable, causing it
@@ -276,7 +288,8 @@
% then we may need to likewise shrink the instmap delta.
%
{ goal_info_get_instmap_delta(GoalInfo2, InstMapDelta0) },
- { instmap_delta_restrict(InstMapDelta0, NonLocalVars, InstMapDelta) },
+ { instmap_delta_restrict(InstMapDelta0,
+ NonLocalVarsSet, InstMapDelta) },
{ goal_info_set_instmap_delta(GoalInfo2, InstMapDelta, GoalInfo) }.
:- pred implicitly_quantify_goal_2(hlds_goal_expr::in, prog_context::in,
@@ -299,12 +312,12 @@
quantification__get_quant_vars(QuantVars),
% Rename apart all the quantified
% variables that occur outside this goal.
- { set__list_to_set(Vars0, QVars) },
- { set__intersect(OutsideVars, QVars, RenameVars1) },
- { set__intersect(LambdaOutsideVars, QVars, RenameVars2) },
- { set__union(RenameVars1, RenameVars2, RenameVars) },
+ { list_to_set(Vars0, QVars) },
+ { intersect(OutsideVars, QVars, RenameVars1) },
+ { intersect(LambdaOutsideVars, QVars, RenameVars2) },
+ { union(RenameVars1, RenameVars2, RenameVars) },
(
- { set__empty(RenameVars) }
+ { empty(RenameVars) }
->
{ Goal1 = Goal0 },
{ Vars = Vars0 }
@@ -315,11 +328,11 @@
{ goal_util__rename_var_list(Vars0, no, RenameMap, Vars) }
),
quantification__update_seen_vars(QVars),
- { set__insert_list(QuantVars, Vars, QuantVars1) },
+ { insert_list(QuantVars, Vars, QuantVars1) },
quantification__set_quant_vars(QuantVars1),
implicitly_quantify_goal(Goal1, Goal),
quantification__get_nonlocals(NonLocals0),
- { set__delete_list(NonLocals0, Vars, NonLocals) },
+ { delete_list(NonLocals0, Vars, NonLocals) },
quantification__set_quant_vars(QuantVars),
quantification__set_nonlocals(NonLocals).
@@ -339,7 +352,7 @@
% switch, since it has to be bound elsewhere, so we put it
% in the nonlocals here.
quantification__get_nonlocals(NonLocals0),
- { set__insert(NonLocals0, Var, NonLocals) },
+ { insert(NonLocals0, Var, NonLocals) },
quantification__set_nonlocals(NonLocals).
implicitly_quantify_goal_2(not(Goal0), _, not(Goal)) -->
@@ -349,8 +362,8 @@
% (the lambda outside vars remain unchanged)
quantification__get_quant_vars(QuantVars),
quantification__get_outside(OutsideVars),
- { set__union(OutsideVars, QuantVars, OutsideVars1) },
- { set__init(QuantVars1) },
+ { union(OutsideVars, QuantVars, OutsideVars1) },
+ { init(QuantVars1) },
quantification__set_quant_vars(QuantVars1),
quantification__set_outside(OutsideVars1),
implicitly_quantify_goal(Goal0, Goal),
@@ -367,16 +380,16 @@
quantification__get_quant_vars(QuantVars),
quantification__get_outside(OutsideVars),
quantification__get_lambda_outside(LambdaOutsideVars),
- { set__list_to_set(Vars0, QVars) },
+ { list_to_set(Vars0, QVars) },
% Rename apart those variables that
% are quantified to the cond and then
% of the i-t-e that occur outside the
% i-t-e.
- { set__intersect(OutsideVars, QVars, RenameVars1) },
- { set__intersect(LambdaOutsideVars, QVars, RenameVars2) },
- { set__union(RenameVars1, RenameVars2, RenameVars) },
+ { intersect(OutsideVars, QVars, RenameVars1) },
+ { intersect(LambdaOutsideVars, QVars, RenameVars2) },
+ { union(RenameVars1, RenameVars2, RenameVars) },
(
- { set__empty(RenameVars) }
+ { empty(RenameVars) }
->
{ Cond1 = Cond0 },
{ Then1 = Then0 },
@@ -388,19 +401,19 @@
{ goal_util__rename_vars_in_goal(Then0, RenameMap, Then1) },
{ goal_util__rename_var_list(Vars0, no, RenameMap, Vars) }
),
- { set__insert_list(QuantVars, Vars, QuantVars1) },
+ { insert_list(QuantVars, Vars, QuantVars1) },
quantification__get_nonlocals_to_recompute(NonLocalsToRecompute),
{ quantification__goal_vars(NonLocalsToRecompute,
Then1, VarsThen, LambdaVarsThen) },
- { set__union(OutsideVars, VarsThen, OutsideVars1) },
- { set__union(LambdaOutsideVars, LambdaVarsThen, LambdaOutsideVars1) },
+ { union(OutsideVars, VarsThen, OutsideVars1) },
+ { union(LambdaOutsideVars, LambdaVarsThen, LambdaOutsideVars1) },
quantification__set_quant_vars(QuantVars1),
quantification__set_outside(OutsideVars1),
quantification__set_lambda_outside(LambdaOutsideVars1),
quantification__update_seen_vars(QVars),
implicitly_quantify_goal(Cond1, Cond),
quantification__get_nonlocals(NonLocalsCond),
- { set__union(OutsideVars, NonLocalsCond, OutsideVars2) },
+ { union(OutsideVars, NonLocalsCond, OutsideVars2) },
quantification__set_outside(OutsideVars2),
quantification__set_lambda_outside(LambdaOutsideVars),
implicitly_quantify_goal(Then1, Then),
@@ -409,11 +422,11 @@
quantification__set_quant_vars(QuantVars),
implicitly_quantify_goal(Else0, Else),
quantification__get_nonlocals(NonLocalsElse),
- { set__union(NonLocalsCond, NonLocalsThen, NonLocalsIfThen) },
- { set__union(NonLocalsIfThen, NonLocalsElse, NonLocalsIfThenElse) },
- { set__intersect(NonLocalsIfThenElse, OutsideVars, NonLocalsO) },
- { set__intersect(NonLocalsIfThenElse, LambdaOutsideVars, NonLocalsL) },
- { set__union(NonLocalsO, NonLocalsL, NonLocals) },
+ { union(NonLocalsCond, NonLocalsThen, NonLocalsIfThen) },
+ { union(NonLocalsIfThen, NonLocalsElse, NonLocalsIfThenElse) },
+ { intersect(NonLocalsIfThenElse, OutsideVars, NonLocalsO) },
+ { intersect(NonLocalsIfThenElse, LambdaOutsideVars, NonLocalsL) },
+ { union(NonLocalsO, NonLocalsL, NonLocals) },
quantification__set_nonlocals(NonLocals).
implicitly_quantify_goal_2(call(A, B, HeadVars, D, E, F), _,
@@ -446,19 +459,19 @@
implicitly_quantify_unify_rhs(UnifyRHS0, CellToReuse,
Unification0, Context, UnifyRHS, Unification),
quantification__get_nonlocals(VarsUnifyRHS),
- { set__insert(VarsUnifyRHS, Var, GoalVars0) },
- { set__insert_list(GoalVars0, TypeInfoVars, GoalVars1) },
+ { insert(VarsUnifyRHS, Var, GoalVars0) },
+ { insert_list(GoalVars0, TypeInfoVars, GoalVars1) },
{ CellToReuse = yes(cell_to_reuse(ReuseVar, _, _)) ->
- set__insert(GoalVars1, ReuseVar, GoalVars)
+ insert(GoalVars1, ReuseVar, GoalVars)
;
GoalVars = GoalVars1
},
quantification__update_seen_vars(GoalVars),
- { set__intersect(GoalVars, OutsideVars, NonLocalVars1) },
- { set__intersect(GoalVars, LambdaOutsideVars, NonLocalVars2) },
- { set__union(NonLocalVars1, NonLocalVars2, NonLocalVars) },
+ { intersect(GoalVars, OutsideVars, NonLocalVars1) },
+ { intersect(GoalVars, LambdaOutsideVars, NonLocalVars2) },
+ { union(NonLocalVars1, NonLocalVars2, NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
implicitly_quantify_goal_2(pragma_foreign_code(A,B,C,D,Vars,E,F,G), _,
@@ -476,8 +489,8 @@
% so we insert the quantified vars into the outside vars set,
% and initialize the new quantified vars set to be empty
% (the lambda outside vars remain unchanged)
- { set__union(OutsideVars0, QuantVars0, OutsideVars1) },
- { set__init(QuantVars1) },
+ { union(OutsideVars0, QuantVars0, OutsideVars1) },
+ { init(QuantVars1) },
{ LambdaOutsideVars1 = LambdaOutsideVars0 },
quantification__set_quant_vars(QuantVars1),
@@ -487,8 +500,8 @@
quantification__get_nonlocals_to_recompute(NonLocalsToRecompute),
{ quantification__goal_vars(NonLocalsToRecompute,
RHS0, RHS_Vars, RHS_LambdaVars) },
- { set__union(OutsideVars1, RHS_Vars, LHS_OutsideVars) },
- { set__union(LambdaOutsideVars1, RHS_LambdaVars,
+ { union(OutsideVars1, RHS_Vars, LHS_OutsideVars) },
+ { union(LambdaOutsideVars1, RHS_LambdaVars,
LHS_LambdaOutsideVars) },
% quantify the LHS
@@ -502,7 +515,7 @@
% (We use the nonlocals rather than the more symmetric
% approach of calling quantification__goal_vars on the
% LHS goal because it is more efficient.)
- { set__union(OutsideVars1, LHS_NonLocalVars, RHS_OutsideVars) },
+ { union(OutsideVars1, LHS_NonLocalVars, RHS_OutsideVars) },
{ RHS_LambdaOutsideVars = LambdaOutsideVars1 },
% quantify the RHS
@@ -512,10 +525,10 @@
quantification__get_nonlocals(RHS_NonLocalVars),
% compute the nonlocals for this goal
- { set__union(LHS_NonLocalVars, RHS_NonLocalVars, AllNonLocalVars) },
- { set__intersect(AllNonLocalVars, OutsideVars0, NonLocalVarsO) },
- { set__intersect(AllNonLocalVars, LambdaOutsideVars0, NonLocalVarsL) },
- { set__union(NonLocalVarsO, NonLocalVarsL, NonLocalVars) },
+ { union(LHS_NonLocalVars, RHS_NonLocalVars, AllNonLocalVars) },
+ { intersect(AllNonLocalVars, OutsideVars0, NonLocalVarsO) },
+ { intersect(AllNonLocalVars, LambdaOutsideVars0, NonLocalVarsL) },
+ { union(NonLocalVarsO, NonLocalVarsL, NonLocalVars) },
quantification__set_nonlocals(NonLocalVars),
% restore the original values of various settings
@@ -549,9 +562,9 @@
% we've just duplicated.
%
{ ReverseImplication0 = not(conj([RHS, NotLHS]) - GI) - GI },
- { quantification__goal_vars(NonLocalsToRecompute,
+ { quantification__goal_vars_bitset(NonLocalsToRecompute,
ReverseImplication0, GoalVars) },
- { set__difference(GoalVars, NonLocalVars, RenameVars) },
+ { difference(GoalVars, NonLocalVars, RenameVars) },
quantification__rename_apart(RenameVars, _,
ReverseImplication0, ReverseImplication),
@@ -561,13 +574,13 @@
:- mode implicitly_quantify_atomic_goal(in, in, out) is det.
implicitly_quantify_atomic_goal(HeadVars) -->
- { set__list_to_set(HeadVars, GoalVars) },
+ { list_to_set(HeadVars, GoalVars) },
quantification__update_seen_vars(GoalVars),
quantification__get_outside(OutsideVars),
quantification__get_lambda_outside(LambdaOutsideVars),
- { set__intersect(GoalVars, OutsideVars, NonLocals1) },
- { set__intersect(GoalVars, LambdaOutsideVars, NonLocals2) },
- { set__union(NonLocals1, NonLocals2, NonLocals) },
+ { intersect(GoalVars, OutsideVars, NonLocals1) },
+ { intersect(GoalVars, LambdaOutsideVars, NonLocals2) },
+ { union(NonLocals1, NonLocals2, NonLocals) },
quantification__set_nonlocals(NonLocals).
:- pred implicitly_quantify_unify_rhs(unify_rhs, maybe(cell_to_reuse),
@@ -578,7 +591,7 @@
implicitly_quantify_unify_rhs(var(X), _, Unification, _,
var(X), Unification) -->
- { set__singleton_set(Vars, X) },
+ { singleton_set(Vars, X) },
quantification__set_nonlocals(Vars).
implicitly_quantify_unify_rhs(functor(Functor, ArgVars), Reuse, Unification, _,
functor(Functor, ArgVars), Unification) -->
@@ -590,9 +603,9 @@
% The fields taken from the reused cell aren't
% counted as code-gen nonlocals.
quantification__get_updated_fields(SetArgs, ArgVars, Vars0),
- set__list_to_set(Vars0, Vars)
+ list_to_set(Vars0, Vars)
;
- set__list_to_set(ArgVars, Vars)
+ list_to_set(ArgVars, Vars)
},
quantification__set_nonlocals(Vars).
implicitly_quantify_unify_rhs(
@@ -611,13 +624,13 @@
% variables. However, the code below does not assume this.
%
quantification__get_outside(OutsideVars0),
- { set__list_to_set(LambdaVars0, QVars) },
+ { list_to_set(LambdaVars0, QVars) },
% Figure out which variables have overlapping scopes
% because they occur outside the goal and are also
% lambda-quantified vars.
- { set__intersect(OutsideVars0, QVars, RenameVars0) },
+ { intersect(OutsideVars0, QVars, RenameVars0) },
(
- { set__empty(RenameVars0) }
+ { empty(RenameVars0) }
->
[]
;
@@ -626,9 +639,9 @@
% We need to rename apart any of the lambda vars that
% we have already seen, since they are new instances.
quantification__get_seen(Seen0),
- { set__intersect(Seen0, QVars, RenameVars1) },
+ { intersect(Seen0, QVars, RenameVars1) },
- { set__union(RenameVars0, RenameVars1, RenameVars) },
+ { union(RenameVars0, RenameVars1, RenameVars) },
quantification__rename_apart(RenameVars, RenameMap, Goal0, Goal1),
{ goal_util__rename_var_list(LambdaVars0, no, RenameMap, LambdaVars) },
@@ -636,25 +649,25 @@
% so we insert the quantified vars into the outside vars set,
% and initialize the new quantified vars set to be empty.
quantification__get_quant_vars(QuantVars0),
- { set__union(OutsideVars0, QuantVars0, OutsideVars1) },
- { set__init(QuantVars) },
+ { union(OutsideVars0, QuantVars0, OutsideVars1) },
+ { init(QuantVars) },
quantification__set_quant_vars(QuantVars),
% Add the lambda vars as outside vars, since they are
% outside of the lambda goal
- { set__insert_list(OutsideVars1, LambdaVars, OutsideVars) },
+ { insert_list(OutsideVars1, LambdaVars, OutsideVars) },
quantification__set_outside(OutsideVars),
% Set the LambdaOutsideVars set to empty, because
% variables that occur outside this lambda expression
% only in other lambda expressions should not be
% considered non-local.
quantification__get_lambda_outside(LambdaOutsideVars0),
- { set__init(LambdaOutsideVars) },
+ { init(LambdaOutsideVars) },
quantification__set_lambda_outside(LambdaOutsideVars),
implicitly_quantify_goal(Goal1, Goal),
quantification__get_nonlocals(NonLocals0),
% lambda-quantified variables are local
- { set__delete_list(NonLocals0, LambdaVars, NonLocals) },
+ { delete_list(NonLocals0, LambdaVars, NonLocals) },
quantification__set_quant_vars(QuantVars0),
quantification__set_outside(OutsideVars0),
quantification__set_lambda_outside(LambdaOutsideVars0),
@@ -669,7 +682,7 @@
{ Goal = _ - LambdaGoalInfo },
{ goal_info_get_nonlocals(LambdaGoalInfo, LambdaGoalNonLocals) },
{ IsNonLocal = lambda([V::in] is semidet, (
- set__member(V, LambdaGoalNonLocals)
+ member(V, LambdaGoalNonLocals)
)) },
{ list__filter(IsNonLocal, LambdaNonLocals0, LambdaNonLocals) },
@@ -687,7 +700,7 @@
ArgModes0, HowToConstruct, Uniq, AditiInfo)
->
map__from_corresponding_lists(Args0, ArgModes0, ArgModesMap),
- set__to_sorted_list(NonLocals, Args),
+ to_sorted_list(NonLocals, Args),
map__apply_to_list(Args, ArgModesMap, ArgModes),
Unification = construct(ConstructVar, ConsId, Args,
ArgModes, HowToConstruct, Uniq, AditiInfo)
@@ -708,12 +721,12 @@
{ get_vars(NonLocalsToRecompute, Goals0, FollowingVarsList) },
implicitly_quantify_conj_2(Goals0, FollowingVarsList, Goals).
-:- pred implicitly_quantify_conj_2(list(hlds_goal), list(pair(set(prog_var))),
+:- pred implicitly_quantify_conj_2(list(hlds_goal), list(pair(set_of_var)),
list(hlds_goal), quant_info, quant_info).
:- mode implicitly_quantify_conj_2(in, in, out, in, out) is det.
implicitly_quantify_conj_2([], _, []) -->
- { set__init(NonLocalVars) },
+ { init(NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
implicitly_quantify_conj_2([_|_], [], _, _, _) :-
error("implicitly_quantify_conj_2: length mismatch").
@@ -722,23 +735,23 @@
[Goal | Goals]) -->
quantification__get_outside(OutsideVars),
quantification__get_lambda_outside(LambdaOutsideVars),
- { set__union(OutsideVars, FollowingVars, OutsideVars1) },
- { set__union(LambdaOutsideVars, LambdaFollowingVars,
+ { union(OutsideVars, FollowingVars, OutsideVars1) },
+ { union(LambdaOutsideVars, LambdaFollowingVars,
LambdaOutsideVars1) },
quantification__set_outside(OutsideVars1),
quantification__set_lambda_outside(LambdaOutsideVars1),
implicitly_quantify_goal(Goal0, Goal),
quantification__get_nonlocals(NonLocalVars1),
- { set__union(OutsideVars, NonLocalVars1, OutsideVars2) },
+ { union(OutsideVars, NonLocalVars1, OutsideVars2) },
quantification__set_outside(OutsideVars2),
quantification__set_lambda_outside(LambdaOutsideVars),
implicitly_quantify_conj_2(Goals0, FollowingVarsList,
Goals),
quantification__get_nonlocals(NonLocalVars2),
- { set__union(NonLocalVars1, NonLocalVars2, NonLocalVarsConj) },
- { set__intersect(NonLocalVarsConj, OutsideVars, NonLocalVarsO) },
- { set__intersect(NonLocalVarsConj, LambdaOutsideVars, NonLocalVarsL) },
- { set__union(NonLocalVarsO, NonLocalVarsL, NonLocalVars) },
+ { union(NonLocalVars1, NonLocalVars2, NonLocalVarsConj) },
+ { intersect(NonLocalVarsConj, OutsideVars, NonLocalVarsO) },
+ { intersect(NonLocalVarsConj, LambdaOutsideVars, NonLocalVarsL) },
+ { union(NonLocalVarsO, NonLocalVarsL, NonLocalVars) },
quantification__set_outside(OutsideVars),
quantification__set_nonlocals(NonLocalVars).
@@ -747,14 +760,14 @@
:- mode implicitly_quantify_disj(in, out, in, out) is det.
implicitly_quantify_disj([], []) -->
- { set__init(NonLocalVars) },
+ { init(NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
implicitly_quantify_disj([Goal0 | Goals0], [Goal | Goals]) -->
implicitly_quantify_goal(Goal0, Goal),
quantification__get_nonlocals(NonLocalVars0),
implicitly_quantify_disj(Goals0, Goals),
quantification__get_nonlocals(NonLocalVars1),
- { set__union(NonLocalVars0, NonLocalVars1, NonLocalVars) },
+ { union(NonLocalVars0, NonLocalVars1, NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
:- pred implicitly_quantify_cases(list(case), list(case),
@@ -762,7 +775,7 @@
:- mode implicitly_quantify_cases(in, out, in, out) is det.
implicitly_quantify_cases([], []) -->
- { set__init(NonLocalVars) },
+ { init(NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
implicitly_quantify_cases([case(Cons, Goal0) | Cases0],
[case(Cons, Goal) | Cases]) -->
@@ -770,19 +783,19 @@
quantification__get_nonlocals(NonLocalVars0),
implicitly_quantify_cases(Cases0, Cases),
quantification__get_nonlocals(NonLocalVars1),
- { set__union(NonLocalVars0, NonLocalVars1, NonLocalVars) },
+ { union(NonLocalVars0, NonLocalVars1, NonLocalVars) },
quantification__set_nonlocals(NonLocalVars).
%-----------------------------------------------------------------------------%
% insert the given set of variables into the set of `seen' variables.
-:- pred quantification__update_seen_vars(set(prog_var), quant_info, quant_info).
+:- pred quantification__update_seen_vars(set_of_var, quant_info, quant_info).
:- mode quantification__update_seen_vars(in, in, out) is det.
quantification__update_seen_vars(NewVars) -->
quantification__get_seen(SeenVars0),
- { set__union(SeenVars0, NewVars, SeenVars) },
+ { union(SeenVars0, NewVars, SeenVars) },
quantification__set_seen(SeenVars).
%-----------------------------------------------------------------------------%
@@ -797,7 +810,7 @@
% occur in lambda goals.
:- pred get_vars(nonlocals_to_recompute, list(hlds_goal),
- list(pair(set(prog_var)))).
+ list(pair(set_of_var))).
:- mode get_vars(in, in, out) is det.
get_vars(_, [], []).
@@ -806,24 +819,24 @@
get_vars_2(NonLocalsToRecompute, Goals, Set, LambdaSet, SetPairs).
:- pred get_vars_2(nonlocals_to_recompute, list(hlds_goal),
- set(prog_var), set(prog_var), list(pair(set(prog_var)))).
+ set_of_var, set_of_var, list(pair(set_of_var))).
:- mode get_vars_2(in, in, out, out, out) is det.
get_vars_2(_, [], Set, LambdaSet, []) :-
- set__init(Set),
- set__init(LambdaSet).
+ init(Set),
+ init(LambdaSet).
get_vars_2(NonLocalsToRecompute, [Goal | Goals],
Set, LambdaSet, SetPairList) :-
get_vars_2(NonLocalsToRecompute, Goals,
Set0, LambdaSet0, SetPairList0),
quantification__goal_vars(NonLocalsToRecompute,
Goal, Set1, LambdaSet1),
- set__union(Set0, Set1, Set),
- set__union(LambdaSet0, LambdaSet1, LambdaSet),
+ union(Set0, Set1, Set),
+ union(LambdaSet0, LambdaSet1, LambdaSet),
SetPairList = [Set0 - LambdaSet0 | SetPairList0].
:- pred goal_list_vars_2(nonlocals_to_recompute, list(hlds_goal),
- set(prog_var), set(prog_var), set(prog_var), set(prog_var)).
+ set_of_var, set_of_var, set_of_var, set_of_var).
:- mode goal_list_vars_2(in, in, in, in, out, out) is det.
goal_list_vars_2(_, [], Set, LambdaSet, Set, LambdaSet).
@@ -835,7 +848,7 @@
Set1, LambdaSet1, Set, LambdaSet).
:- pred case_list_vars_2(nonlocals_to_recompute, list(case),
- set(prog_var), set(prog_var), set(prog_var), set(prog_var)).
+ set_of_var, set_of_var, set_of_var, set_of_var).
:- mode case_list_vars_2(in, in, in, in, out, out) is det.
case_list_vars_2(_, [], Set, LambdaSet, Set, LambdaSet).
@@ -851,38 +864,45 @@
% Vars is the set of variables that occur free (unquantified)
% in Goal, excluding unset fields of reconstructions if
% NonLocalsToRecompute is `code_gen_nonlocals'.
-quantification__goal_vars(NonLocalsToRecompute, Goal, BothSet) :-
- quantification__goal_vars(NonLocalsToRecompute,
- Goal, NonLambdaSet, LambdaSet),
- set__union(NonLambdaSet, LambdaSet, BothSet).
+quantification__goal_vars(NonLocalsToRecompute, Goal,
+ bitset_to_set(BothSet)) :-
+ quantification__goal_vars_bitset(NonLocalsToRecompute,
+ Goal, BothSet).
quantification__goal_vars(Goal, BothSet) :-
quantification__goal_vars(ordinary_nonlocals, Goal, BothSet).
+:- pred quantification__goal_vars_bitset(nonlocals_to_recompute::in,
+ hlds_goal::in, set_of_var::out) is det.
+
+quantification__goal_vars_bitset(NonLocalsToRecompute, Goal, BothSet) :-
+ quantification__goal_vars(NonLocalsToRecompute, Goal, Set, LambdaSet),
+ BothSet = union(Set, LambdaSet).
+
% quantification__goal_vars(Goal, NonLambdaSet, LambdaSet):
% Set is the set of variables that occur free (unquantified)
% in Goal, not counting occurrences in lambda expressions.
% LambdaSet is the set of variables that occur free (unquantified)
% in lambda expressions in Goal.
:- pred quantification__goal_vars(nonlocals_to_recompute,
- hlds_goal, set(prog_var), set(prog_var)).
+ hlds_goal, set_of_var, set_of_var).
:- mode quantification__goal_vars(in, in, out, out) is det.
quantification__goal_vars(NonLocalsToRecompute,
Goal - _GoalInfo, Set, LambdaSet) :-
- set__init(Set0),
- set__init(LambdaSet0),
+ init(Set0),
+ init(LambdaSet0),
quantification__goal_vars_2(NonLocalsToRecompute,
Goal, Set0, LambdaSet0, Set, LambdaSet).
:- pred quantification__goal_vars_2(nonlocals_to_recompute, hlds_goal_expr,
- set(prog_var), set(prog_var), set(prog_var), set(prog_var)).
+ set_of_var, set_of_var, set_of_var, set_of_var).
:- mode quantification__goal_vars_2(in, in, in, in, out, out) is det.
quantification__goal_vars_2(NonLocalsToRecompute,
unify(A, B, _, Unification, _), Set0, LambdaSet0,
Set, LambdaSet) :-
- set__insert(Set0, A, Set1),
+ insert(Set0, A, Set1),
( Unification = construct(_, _, _, _, reuse_cell(Reuse0), _, _) ->
Reuse = yes(Reuse0)
;
@@ -891,11 +911,11 @@
(
Reuse = yes(cell_to_reuse(ReuseVar, _, _))
->
- set__insert(Set1, ReuseVar, Set2)
+ insert(Set1, ReuseVar, Set2)
;
Unification = complicated_unify(_, _, TypeInfoVars)
->
- set__insert_list(Set1, TypeInfoVars, Set2)
+ insert_list(Set1, TypeInfoVars, Set2)
;
Set2 = Set1
),
@@ -905,12 +925,12 @@
quantification__goal_vars_2(_, generic_call(GenericCall, ArgVars1, _, _),
Set0, LambdaSet, Set, LambdaSet) :-
goal_util__generic_call_vars(GenericCall, ArgVars0),
- set__insert_list(Set0, ArgVars0, Set1),
- set__insert_list(Set1, ArgVars1, Set).
+ insert_list(Set0, ArgVars0, Set1),
+ insert_list(Set1, ArgVars1, Set).
quantification__goal_vars_2(_, call(_, _, ArgVars, _, _, _), Set0, LambdaSet,
Set, LambdaSet) :-
- set__insert_list(Set0, ArgVars, Set).
+ insert_list(Set0, ArgVars, Set).
quantification__goal_vars_2(NonLocalsToRecompute, conj(Goals),
Set0, LambdaSet0, Set, LambdaSet) :-
@@ -929,7 +949,7 @@
quantification__goal_vars_2(NonLocalsToRecompute, switch(Var, _Det, Cases, _),
Set0, LambdaSet0, Set, LambdaSet) :-
- set__insert(Set0, Var, Set1),
+ insert(Set0, Var, Set1),
case_list_vars_2(NonLocalsToRecompute, Cases,
Set1, LambdaSet0, Set, LambdaSet).
@@ -937,10 +957,10 @@
Set0, LambdaSet0, Set, LambdaSet) :-
quantification__goal_vars(NonLocalsToRecompute,
Goal, Set1, LambdaSet1),
- set__delete_list(Set1, Vars, Set2),
- set__delete_list(LambdaSet1, Vars, LambdaSet2),
- set__union(Set0, Set2, Set),
- set__union(LambdaSet0, LambdaSet2, LambdaSet).
+ delete_list(Set1, Vars, Set2),
+ delete_list(LambdaSet1, Vars, LambdaSet2),
+ union(Set0, Set2, Set),
+ union(LambdaSet0, LambdaSet2, LambdaSet).
quantification__goal_vars_2(NonLocalsToRecompute, not(Goal - _GoalInfo),
Set0, LambdaSet0, Set, LambdaSet) :-
@@ -955,33 +975,33 @@
% where `+' is set union and `\' is relative complement.
quantification__goal_vars(NonLocalsToRecompute, A, Set1, LambdaSet1),
quantification__goal_vars(NonLocalsToRecompute, B, Set2, LambdaSet2),
- set__union(Set1, Set2, Set3),
- set__union(LambdaSet1, LambdaSet2, LambdaSet3),
- set__delete_list(Set3, Vars, Set4),
- set__delete_list(LambdaSet3, Vars, LambdaSet4),
- set__union(Set0, Set4, Set5),
- set__union(LambdaSet0, LambdaSet4, LambdaSet5),
+ union(Set1, Set2, Set3),
+ union(LambdaSet1, LambdaSet2, LambdaSet3),
+ delete_list(Set3, Vars, Set4),
+ delete_list(LambdaSet3, Vars, LambdaSet4),
+ union(Set0, Set4, Set5),
+ union(LambdaSet0, LambdaSet4, LambdaSet5),
quantification__goal_vars(NonLocalsToRecompute, C, Set6, LambdaSet6),
- set__union(Set5, Set6, Set),
- set__union(LambdaSet5, LambdaSet6, LambdaSet).
+ union(Set5, Set6, Set),
+ union(LambdaSet5, LambdaSet6, LambdaSet).
quantification__goal_vars_2(_, pragma_foreign_code(_,_,_,_, ArgVars, _, _, _),
Set0, LambdaSet, Set, LambdaSet) :-
- set__insert_list(Set0, ArgVars, Set).
+ insert_list(Set0, ArgVars, Set).
quantification__goal_vars_2(NonLocalsToRecompute, bi_implication(LHS, RHS),
Set0, LambdaSet0, Set, LambdaSet) :-
goal_list_vars_2(NonLocalsToRecompute, [LHS, RHS],
Set0, LambdaSet0, Set, LambdaSet).
-:- pred quantification__unify_rhs_vars(nonlocals_to_recompute, unify_rhs,
- maybe(cell_to_reuse), set(prog_var), set(prog_var),
- set(prog_var), set(prog_var)).
+:- pred quantification__unify_rhs_vars(nonlocals_to_recompute,
+ unify_rhs, maybe(cell_to_reuse), set_of_var, set_of_var,
+ set_of_var, set_of_var).
:- mode quantification__unify_rhs_vars(in, in, in, in, in, out, out) is det.
-quantification__unify_rhs_vars(_, var(X), _,
+quantification__unify_rhs_vars(_, var(Y), _,
Set0, LambdaSet, Set, LambdaSet) :-
- set__insert(Set0, X, Set).
+ insert(Set0, Y, Set).
quantification__unify_rhs_vars(NonLocalsToRecompute,
functor(_Functor, ArgVars), Reuse,
Set0, LambdaSet, Set, LambdaSet) :-
@@ -992,26 +1012,26 @@
% Ignore the fields taken from the reused cell.
quantification__get_updated_fields(SetArgs, ArgVars,
ArgsToSet),
- set__insert_list(Set0, ArgsToSet, Set)
+ insert_list(Set0, ArgsToSet, Set)
;
- set__insert_list(Set0, ArgVars, Set)
+ insert_list(Set0, ArgVars, Set)
).
quantification__unify_rhs_vars(NonLocalsToRecompute,
lambda_goal(_POrF, _E, _F, _N, LambdaVars, _M, _D, Goal),
_, Set, LambdaSet0, Set, LambdaSet) :-
% Note that the NonLocals list is not counted, since all the
% variables in that list must occur in the goal.
- quantification__goal_vars(NonLocalsToRecompute, Goal, GoalVars),
- set__delete_list(GoalVars, LambdaVars, GoalVars1),
- set__union(LambdaSet0, GoalVars1, LambdaSet).
+ quantification__goal_vars_bitset(NonLocalsToRecompute, Goal, GoalVars),
+ delete_list(GoalVars, LambdaVars, GoalVars1),
+ union(LambdaSet0, GoalVars1, LambdaSet).
:- pred quantification__insert_set_fields(list(bool), list(prog_var),
- set(prog_var), set(prog_var)).
+ set_of_var, set_of_var).
:- mode quantification__insert_set_fields(in, in, in, out) is det.
quantification__insert_set_fields(SetArgs, Args, Set0, Set) :-
quantification__get_updated_fields(SetArgs, Args, ArgsToSet),
- set__insert_list(Set0, ArgsToSet, Set).
+ insert_list(Set0, ArgsToSet, Set).
:- pred quantification__get_updated_fields(list(bool),
list(prog_var), list(prog_var)).
@@ -1053,12 +1073,12 @@
%-----------------------------------------------------------------------------%
-:- pred quantification__warn_overlapping_scope(set(prog_var), prog_context,
+:- pred quantification__warn_overlapping_scope(set_of_var, prog_context,
quant_info, quant_info).
:- mode quantification__warn_overlapping_scope(in, in, in, out) is det.
quantification__warn_overlapping_scope(OverlapVars, Context) -->
- { set__to_sorted_list(OverlapVars, Vars) },
+ { to_sorted_list(OverlapVars, Vars) },
quantification__get_warnings(Warnings0),
{ Warnings = [warn_overlap(Vars, Context) | Warnings0] },
quantification__set_warnings(Warnings).
@@ -1070,7 +1090,7 @@
% and insert the mapping V->V' into RenameMap.
% Apply RenameMap to Goal0 giving Goal.
-:- pred quantification__rename_apart(set(prog_var), map(prog_var, prog_var),
+:- pred quantification__rename_apart(set_of_var, map(prog_var, prog_var),
hlds_goal, hlds_goal, quant_info, quant_info).
:- mode quantification__rename_apart(in, out, in, out, in, out) is det.
@@ -1086,14 +1106,14 @@
% renaming will have been done while recomputing
% the ordinary non-locals.
%
- { set__empty(RenameSet)
+ { empty(RenameSet)
; NonLocalsToRecompute = code_gen_nonlocals
}
->
{ map__init(RenameMap) },
{ Goal = Goal0 }
;
- { set__to_sorted_list(RenameSet, RenameList) },
+ { to_sorted_list(RenameSet, RenameList) },
quantification__get_varset(Varset0),
quantification__get_vartypes(VarTypes0),
{ map__init(RenameMap0) },
@@ -1111,7 +1131,7 @@
the seen var set down.
quantification__get_seen(SeenVars0),
{ map__values(RenameMap, NewVarsList) },
- { set__insert_list(SeenVars0, NewVarsList, SeenVars) },
+ { insert_list(SeenVars0, NewVarsList, SeenVars) },
quantification__set_seen(SeenVars).
****/
).
@@ -1119,10 +1139,20 @@
%-----------------------------------------------------------------------------%
:- pred quantification__set_goal_nonlocals(hlds_goal_info,
- set(prog_var), hlds_goal_info, quant_info, quant_info).
+ set_of_var, hlds_goal_info, quant_info, quant_info).
:- mode quantification__set_goal_nonlocals(in, in, out, in, out) is det.
quantification__set_goal_nonlocals(GoalInfo0, NonLocals, GoalInfo) -->
+ quantification__set_goal_nonlocals(GoalInfo0, NonLocals, GoalInfo, _).
+
+:- pred quantification__set_goal_nonlocals(hlds_goal_info,
+ set_of_var, hlds_goal_info, set(prog_var),
+ quant_info, quant_info).
+:- mode quantification__set_goal_nonlocals(in, in, out, out, in, out) is det.
+
+quantification__set_goal_nonlocals(GoalInfo0, NonLocals0,
+ GoalInfo, NonLocals) -->
+ { NonLocals = bitset_to_set(NonLocals0) },
quantification__get_nonlocals_to_recompute(NonLocalsToRecompute),
{
NonLocalsToRecompute = ordinary_nonlocals,
@@ -1135,38 +1165,44 @@
%-----------------------------------------------------------------------------%
+:- func bitset_to_set(set_of_var) = set(prog_var).
+:- func set_to_bitset(set(prog_var)) = set_of_var.
+
+bitset_to_set(Bitset) = set__sorted_list_to_set(to_sorted_list(Bitset)).
+set_to_bitset(Bitset) = sorted_list_to_set(set__to_sorted_list(Bitset)).
+
%-----------------------------------------------------------------------------%
-:- pred quantification__init(nonlocals_to_recompute::in, set(prog_var)::in,
+:- pred quantification__init(nonlocals_to_recompute::in, set_of_var::in,
prog_varset::in, vartypes::in, quant_info::out) is det.
quantification__init(RecomputeNonLocals, OutsideVars,
Varset, VarTypes, QuantInfo) :-
- set__init(QuantVars),
- set__init(NonLocals),
- set__init(LambdaOutsideVars),
- Seen = OutsideVars,
OverlapWarnings = [],
QuantInfo = quant_info(RecomputeNonLocals, OutsideVars, QuantVars,
LambdaOutsideVars, NonLocals, Seen, Varset, VarTypes,
- OverlapWarnings).
+ OverlapWarnings),
+ init(QuantVars),
+ init(NonLocals),
+ init(LambdaOutsideVars),
+ Seen = OutsideVars.
:- pred quantification__get_nonlocals_to_recompute(nonlocals_to_recompute::out,
quant_info::in, quant_info::out) is det.
-:- pred quantification__get_outside(set(prog_var)::out,
+:- pred quantification__get_outside(set_of_var::out,
quant_info::in, quant_info::out) is det.
-:- pred quantification__get_quant_vars(set(prog_var)::out,
+:- pred quantification__get_quant_vars(set_of_var::out,
quant_info::in, quant_info::out) is det.
-:- pred quantification__get_lambda_outside(set(prog_var)::out,
+:- pred quantification__get_lambda_outside(set_of_var::out,
quant_info::in, quant_info::out) is det.
-:- pred quantification__get_nonlocals(set(prog_var)::out,
+:- pred quantification__get_nonlocals(set_of_var::out,
quant_info::in, quant_info::out) is det.
-:- pred quantification__get_seen(set(prog_var)::out,
+:- pred quantification__get_seen(set_of_var::out,
quant_info::in, quant_info::out) is det.
:- pred quantification__get_varset(prog_varset::out,
@@ -1178,19 +1214,19 @@
:- pred quantification__get_warnings(list(quant_warning)::out,
quant_info::in, quant_info::out) is det.
-:- pred quantification__set_outside(set(prog_var)::in,
+:- pred quantification__set_outside(set_of_var::in,
quant_info::in, quant_info::out) is det.
-:- pred quantification__set_quant_vars(set(prog_var)::in,
+:- pred quantification__set_quant_vars(set_of_var::in,
quant_info::in, quant_info::out) is det.
-:- pred quantification__set_lambda_outside(set(prog_var)::in,
+:- pred quantification__set_lambda_outside(set_of_var::in,
quant_info::in, quant_info::out) is det.
-:- pred quantification__set_nonlocals(set(prog_var)::in,
+:- pred quantification__set_nonlocals(set_of_var::in,
quant_info::in, quant_info::out) is det.
-:- pred quantification__set_seen(set(prog_var)::in,
+:- pred quantification__set_seen(set_of_var::in,
quant_info::in, quant_info::out) is det.
:- pred quantification__set_varset(prog_varset::in,
Index: library/enum.m
===================================================================
RCS file: enum.m
diff -N enum.m
--- /dev/null Fri Nov 3 18:05:00 2000
+++ enum.m Fri Nov 3 18:20:15 2000
@@ -0,0 +1,39 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 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.
+%-----------------------------------------------------------------------------%
+% File: enum.m.
+% Author: stayl.
+% Stability: low.
+%
+% This module provides the typeclass `enum', which describes
+% types which can be converted to and from integers without loss
+% of information.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module enum.
+
+:- interface.
+
+:- typeclass enum(T) where [
+ func to_int(T) = int,
+ func from_int(int) = T
+].
+
+:- instance enum(int).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module std_util.
+
+:- instance enum(int) where [
+ func(to_int/1) is id,
+ func(from_int/1) is id
+].
+
+%-----------------------------------------------------------------------------%
Index: library/int.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/int.m,v
retrieving revision 1.69
diff -u -u -r1.69 int.m
--- library/int.m 2000/10/16 01:33:44 1.69
+++ library/int.m 2000/11/03 07:28:14
@@ -205,6 +205,23 @@
%-----------------------------------------------------------------------------%
+ % floor_to_multiple_of_bits_per_int(Int)
+ %
+ % Returns the largest multiple of bits_per_int which
+ % is less than or equal to `Int'.
+ %
+ % Used by sparse_bitset.m. Makes it clearer to gcc that parts
+ % of this operation can be optimized into shifts, without
+ % turning up the optimization level.
+:- func floor_to_multiple_of_bits_per_int(int) = int.
+
+ % Used by floor_to_multiple_of_bits_per_int, placed
+ % here to make sure they go in the `.opt' file.
+:- func int__div_bits_per_int(int) = int.
+:- func int__times_bits_per_int(int) = int.
+
+%-----------------------------------------------------------------------------%
+
%
% The following routines are builtins that the compiler knows about.
% Don't use them; use the functions above.
@@ -285,6 +302,16 @@
Div = Trunc - 1
).
+:- pragma inline(floor_to_multiple_of_bits_per_int/1).
+floor_to_multiple_of_bits_per_int(X) = Floor :-
+ Trunc = div_bits_per_int(X),
+ Floor0 = times_bits_per_int(Trunc),
+ ( Floor0 > X ->
+ Floor = Floor0 - bits_per_int
+ ;
+ Floor = Floor0
+ ).
+
X mod Y = X - (X div Y) * Y.
X << Y = Z :-
@@ -410,10 +437,13 @@
:- pragma c_header_code("
#include <limits.h>
+
+ #define ML_BITS_PER_INT (sizeof(MR_Integer) * CHAR_BIT)
").
-:- pragma c_code(int__max_int(Max::out), will_not_call_mercury, "
+:- pragma c_code(int__max_int(Max::out),
+ [will_not_call_mercury, thread_safe], "
if (sizeof(MR_Integer) == sizeof(int))
Max = INT_MAX;
else if (sizeof(MR_Integer) == sizeof(long))
@@ -422,7 +452,8 @@
MR_fatal_error(""Unable to figure out max integer size"");
").
-:- pragma c_code(int__min_int(Min::out), will_not_call_mercury, "
+:- pragma c_code(int__min_int(Min::out),
+ [will_not_call_mercury, thread_safe], "
if (sizeof(MR_Integer) == sizeof(int))
Min = INT_MIN;
else if (sizeof(MR_Integer) == sizeof(long))
@@ -430,9 +461,20 @@
else
MR_fatal_error(""Unable to figure out min integer size"");
").
+
+:- pragma c_code(int__bits_per_int(Bits::out),
+ [will_not_call_mercury, thread_safe], "
+ Bits = ML_BITS_PER_INT;
+").
+
+:- pragma c_code(int__div_bits_per_int(Int::in) = (Div::out),
+ [will_not_call_mercury, thread_safe], "
+ Div = Int / ML_BITS_PER_INT;
+").
-:- pragma c_code(int__bits_per_int(Bits::out), will_not_call_mercury, "
- Bits = sizeof(MR_Integer) * CHAR_BIT;
+:- pragma c_code(int__times_bits_per_int(Int::in) = (Result::out),
+ [will_not_call_mercury, thread_safe], "
+ Result = Int * ML_BITS_PER_INT;
").
%-----------------------------------------------------------------------------%
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.51
diff -u -u -r1.51 library.m
--- library/library.m 2000/10/16 01:33:46 1.51
+++ library/library.m 2000/10/30 13:26:43
@@ -30,8 +30,9 @@
:- import_module bt_array, char, counter, dir, eqvclass, float.
:- import_module math, getopt, graph, group, int.
:- import_module io, list, map, multi_map, pqueue, queue, random, relation.
-:- import_module require, set, set_bbbtree, set_ordlist, set_unordlist, stack.
-:- import_module std_util, string, term, term_io, tree234, varset.
+:- import_module require, set, set_bbbtree, set_ordlist, set_unordlist.
+:- import_module sparse_bitset, stack, std_util, string, term, term_io.
+:- import_module tree234, varset.
:- import_module store, rbtree, parser, lexer, ops.
:- import_module prolog.
:- import_module integer, rational.
Index: library/sparse_bitset.m
===================================================================
RCS file: sparse_bitset.m
diff -N sparse_bitset.m
--- /dev/null Fri Nov 3 18:05:00 2000
+++ sparse_bitset.m Fri Nov 3 18:20:36 2000
@@ -0,0 +1,726 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 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.
+%-----------------------------------------------------------------------------%
+% File: sparse_bitset.m.
+% Author: stayl
+% Stability: medium.
+%
+% This module provides an ADT for storing sets of integers.
+% If the integers are closely grouped, this representation will be
+% much more compact than that provided by set.m. Union, intersection
+% and difference are much faster. Converting to and from lists is slower.
+%
+% In the worst case, where the integers stored are not closely
+% grouped, a sparse_bitset will take more memory than an
+% ordinary set, but the operations should not be too much slower.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module sparse_bitset.
+
+:- interface.
+
+:- import_module enum, list, term.
+
+:- type sparse_bitset(T). % <= enum(T).
+
+ % Return an empty set.
+:- func init = sparse_bitset(T).
+
+:- pred empty(sparse_bitset(T)).
+:- mode empty(in) is semidet.
+:- mode empty(out) is det.
+
+ % `set__equal(SetA, SetB' is true iff `SetA' and `SetB'
+ % contain the same elements.
+:- pred equal(sparse_bitset(T), sparse_bitset(T)).
+:- mode equal(in, in) is semidet.
+
+ % `set_ordlist__list_to_set(List)' returns a set
+ % containing only the members of `List'.
+ % In the worst case this will take O(N^2) time
+ % and space. If the elements of the list are closely
+ % grouped, it will be closer to O(N).
+:- func list_to_set(list(T)) = sparse_bitset(T) <= enum(T).
+:- pragma type_spec(list_to_set/1, T = var(_)).
+:- pragma type_spec(list_to_set/1, T = int).
+
+ % `sorted_list_to_set(List)' returns a set containing
+ % only the members of `List'.
+ % `List' must be sorted.
+ % Takes O(N) time and space.
+:- func sorted_list_to_set(list(T)) = sparse_bitset(T) <= enum(T).
+:- pragma type_spec(sorted_list_to_set/1, T = var(_)).
+:- pragma type_spec(sorted_list_to_set/1, T = int).
+
+ % `set_ordlist__to_sorted_list(Set, List)' returns a list
+ % containing all the members of `Set', in sorted order.
+ % Takes O(NlogN) time and O(N) space.
+:- func to_sorted_list(sparse_bitset(T)) = list(T) <= enum(T).
+:- pragma type_spec(to_sorted_list/1, T = var(_)).
+:- pragma type_spec(to_sorted_list/1, T = int).
+
+ % `make_singleton_set(Elem)' returns a set
+ % containing just the single element `Elem'.
+:- func make_singleton_set(T) = sparse_bitset(T) <= enum(T).
+:- pragma type_spec(make_singleton_set/1, T = var(_)).
+:- pragma type_spec(make_singleton_set/1, T = int).
+
+ % `subset(SetA, SetB)' is true iff `SetA' is a subset of `SetB'.
+:- pred subset(sparse_bitset(T), sparse_bitset(T)).
+:- mode subset(in, in) is semidet.
+
+ % `superset(SetA, SetB)' is true iff `SetA' is a superset of `SetB'.
+:- pred superset(sparse_bitset(T), sparse_bitset(T)).
+:- mode superset(in, in) is semidet.
+
+ % `member(X, Set)' is true iff `X' is a member of `Set'.
+:- pred member(T, sparse_bitset(T)) <= enum(T).
+:- mode member(in, in) is semidet.
+:- pragma type_spec(member/2, T = var(_)).
+:- pragma type_spec(member/2, T = int).
+
+ % `insert(Set0, X)' returns the union
+ % of `Set0' and the set containing only `X'.
+:- func insert(sparse_bitset(T), T) = sparse_bitset(T) <= enum(T).
+:- pragma type_spec(insert/2, T = var(_)).
+:- pragma type_spec(insert/2, T = int).
+
+ % `insert_list(Set0, X)' returns the union of `Set0' and the set
+ % containing only the members of `X'.
+:- func insert_list(sparse_bitset(T), list(T)) = sparse_bitset(T) <= enum(T).
+:- pragma type_spec(insert_list/2, T = var(_)).
+:- pragma type_spec(insert_list/2, T = int).
+
+ % `delete(Set0, X)' returns the difference
+ % of `Set0' and the set containing only `X'.
+:- func delete(sparse_bitset(T), T) = sparse_bitset(T) <= enum(T).
+:- pragma type_spec(delete/2, T = var(_)).
+:- pragma type_spec(delete/2, T = int).
+
+ % `insert_list(Set0, X)' returns the union of `Set0' and the set
+ % containing only the members of `X'.
+:- func delete_list(sparse_bitset(T), list(T)) = sparse_bitset(T) <= enum(T).
+:- pragma type_spec(delete_list/2, T = var(_)).
+:- pragma type_spec(delete_list/2, T = int).
+
+ % `remove(Set0, X)' returns the difference
+ % of `Set0' and the set containing only `X',
+ % failing if `Set0' does not contain `X'.
+:- func remove(sparse_bitset(T), T) = sparse_bitset(T) <= enum(T).
+:- mode remove(in, in) = out is semidet.
+
+ % `remove_list(Set0, X)' returns the difference of `Set0'
+ % and the set containing all the elements of `X',
+ % failing if any element of `X' is not in `Set0'.
+:- func remove_list(sparse_bitset(T), list(T)) = sparse_bitset(T) <= enum(T).
+:- mode remove_list(in, in) = out is semidet.
+
+ % `remove_least(Set0, X, Set)' is true iff `X' is the
+ % least element in `Set0', and `Set' is the set which
+ % contains all the elements of `Set0' except `X'.
+:- pred remove_least(sparse_bitset(T), T, sparse_bitset(T)) <= enum(T).
+:- mode remove_least(in, out, out) is semidet.
+
+ % `union(SetA, SetB)' returns the union of `SetA' and `SetB'.
+ % The efficiency of the union operation is not sensitive
+ % to the argument ordering.
+:- func union(sparse_bitset(T), sparse_bitset(T)) = sparse_bitset(T).
+
+ % `intersect(SetA, SetB)' returns the intersection of
+ % `SetA' and `SetB'. The efficiency of the intersection
+ % operation is not sensitive to the argument ordering.
+:- func intersect(sparse_bitset(T), sparse_bitset(T)) = sparse_bitset(T).
+
+ % `difference(SetA, SetB)' returns the set containing all the
+ % elements of `SetA' except those that occur in `SetB'.
+:- func difference(sparse_bitset(T), sparse_bitset(T)) = sparse_bitset(T).
+
+ % `count(Set)' returns the number of elements in `Set'.
+:- func count(sparse_bitset(T)) = int <= enum(T).
+
+ % `fold(Func, Set, Start)' calls Func with each element
+ % of `Set' and an accumulator (with the initial value of
+ % `Start'), and returns the final value.
+ % Takes O(NlogN) time.
+:- func fold(func(T, U) = U, sparse_bitset(T), U) = U <= enum(T).
+
+%-----------------------------------------------------------------------------%
+
+ % Predicate versions of the above functions.
+
+:- pred init(sparse_bitset(T)).
+:- mode init(out) is det.
+
+:- pred list_to_set(list(T), sparse_bitset(T)) <= enum(T).
+:- mode list_to_set(in, out) is det.
+:- pragma type_spec(list_to_set/2, T = var(_)).
+:- pragma type_spec(list_to_set/2, T = int).
+
+:- pred sorted_list_to_set(list(T), sparse_bitset(T)) <= enum(T).
+:- mode sorted_list_to_set(in, out) is det.
+:- pragma type_spec(sorted_list_to_set/2, T = var(_)).
+:- pragma type_spec(sorted_list_to_set/2, T = int).
+
+:- pred to_sorted_list(sparse_bitset(T), list(T)) <= enum(T).
+:- mode to_sorted_list(in, out) is det.
+:- pragma type_spec(to_sorted_list/2, T = var(_)).
+:- pragma type_spec(to_sorted_list/2, T = int).
+
+ % Note: set.m contains the reverse mode of this predicate,
+ % but it is difficult to implement both modes using
+ % the representation in this module.
+:- pred singleton_set(sparse_bitset(T), T) <= enum(T).
+:- mode singleton_set(out, in) is det.
+:- pragma type_spec(singleton_set/2, T = var(_)).
+:- pragma type_spec(singleton_set/2, T = int).
+
+:- pred insert(sparse_bitset(T), T, sparse_bitset(T)) <= enum(T).
+:- mode insert(in, in, out) is det.
+:- pragma type_spec(insert/3, T = var(_)).
+:- pragma type_spec(insert/3, T = int).
+
+:- pred insert_list(sparse_bitset(T), list(T), sparse_bitset(T)) <= enum(T).
+:- mode insert_list(in, in, out) is det.
+:- pragma type_spec(insert_list/3, T = var(_)).
+:- pragma type_spec(insert_list/3, T = int).
+
+:- pred delete(sparse_bitset(T), T, sparse_bitset(T)) <= enum(T).
+:- mode delete(in, in, out) is det.
+:- pragma type_spec(delete/3, T = var(_)).
+:- pragma type_spec(delete/3, T = int).
+
+:- pred delete_list(sparse_bitset(T), list(T), sparse_bitset(T)) <= enum(T).
+:- mode delete_list(in, in, out) is det.
+:- pragma type_spec(delete_list/3, T = var(_)).
+:- pragma type_spec(delete_list/3, T = int).
+
+:- pred remove(sparse_bitset(T), T, sparse_bitset(T)) <= enum(T).
+:- mode remove(in, in, out) is semidet.
+
+:- pred remove_list(sparse_bitset(T), list(T), sparse_bitset(T)) <= enum(T).
+:- mode remove_list(in, in, out) is semidet.
+
+:- pred union(sparse_bitset(T), sparse_bitset(T), sparse_bitset(T)).
+:- mode union(in, in, out) is det.
+
+:- pred intersect(sparse_bitset(T), sparse_bitset(T), sparse_bitset(T)).
+:- mode intersect(in, in, out) is det.
+
+:- pred difference(sparse_bitset(T), sparse_bitset(T), sparse_bitset(T)).
+:- mode difference(in, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module list, int, require, std_util.
+
+ % The number of variables for most procedures
+ % should fit into one or two words.
+:- type sparse_bitset(T) % <= enum(T)
+ ---> sparse_bitset(bitset_impl).
+
+ % The list of elements, sorted on offset.
+ % No two elements have the same offset.
+:- type bitset_impl == list(bitset_elem).
+
+ % Cells of this type should only be
+ % constructed using make_bitset_elem/2.
+:- type bitset_elem
+ ---> bitset_elem(
+ offset :: int, % multiple of bits_per_int
+ bits :: int % bits offset .. offset + bits_per_int - 1
+ % The sparse_bitset operations all remove
+ % elements of the list with a `bits'
+ % field of zero.
+ ).
+
+%-----------------------------------------------------------------------------%
+
+init = sparse_bitset([]).
+
+empty(init).
+
+equal(X, X).
+
+%-----------------------------------------------------------------------------%
+
+ % There's a lot of code duplication between this
+ % and fold/3 below. The main difference is that
+ % fold traverses the set in sorted order, whereas
+ % to_sorted_list traverses the set in reverse order
+ % to avoid having to reverse the resulting list.
+to_sorted_list(sparse_bitset(A)) =
+ sparse_bitset__to_sorted_list_2(A).
+
+:- func to_sorted_list_2(bitset_impl) = list(T) <= enum(T).
+:- pragma type_spec(to_sorted_list_2/1, T = int).
+:- pragma type_spec(to_sorted_list_2/1, T = var(_)).
+
+to_sorted_list_2([]) = [].
+to_sorted_list_2([Data | Rest]) =
+ extract_bits(Data ^ offset, Data ^ bits, to_sorted_list_2(Rest)).
+
+ % Find the locations of the 1 bits in an int, and
+ % add them onto the front of the list.
+:- func extract_bits(int, int, list(T)) = list(T) <= enum(T).
+:- pragma type_spec(extract_bits/3, T = int).
+:- pragma type_spec(extract_bits/3, T = var(_)).
+
+extract_bits(Offset, Bits, Ints0) = Ints :-
+ Size = bits_per_int,
+ Ints = extract_bits_2(Offset, Bits, Size, Ints0).
+
+ % Do a binary search for the 1 bits in an int.
+:- func extract_bits_2(int, int, int, list(T)) = list(T) <= enum(T).
+:- pragma type_spec(extract_bits_2/4, T = int).
+:- pragma type_spec(extract_bits_2/4, T = var(_)).
+
+extract_bits_2(Offset, Bits, Size, Ints0) = Ints :-
+ ( Bits = 0 ->
+ Ints = Ints0
+ ; Size = 1 ->
+ Elem = from_int(Offset),
+ Ints = [Elem | Ints0]
+ ;
+ HalfSize = unchecked_right_shift(Size, 1),
+ Mask = mask(HalfSize),
+
+ % Extract the high-order half of the bits.
+ HighBits = Mask /\ unchecked_right_shift(Bits, HalfSize),
+ Ints1 = extract_bits_2(Offset + HalfSize,
+ HighBits, HalfSize, Ints0),
+
+ % Extract the low-order half of the bits.
+ LowBits = Mask /\ Bits,
+ Ints = extract_bits_2(Offset, LowBits, HalfSize, Ints1)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+fold(F, sparse_bitset(Set), Acc0) = fold_2(F, Set, Acc0).
+
+:- func fold_2(func(T, U) = U, bitset_impl, U) = U <= enum(T).
+
+fold_2(_, [], Acc) = Acc.
+fold_2(F, [Data | Rest], Acc0) =
+ fold_2(F, Rest, fold_bits(F, Data ^ offset, Data ^ bits, Acc0)).
+
+:- func fold_bits(func(T, U) = U, int, int, U) = U <= enum(T).
+
+fold_bits(F, Offset, Bits, Acc0) = Acc :-
+ Size = bits_per_int,
+ Acc = fold_bits_2(F, Offset, Bits, Size, Acc0).
+
+ % Do a binary search for the 1 bits in an int.
+:- func fold_bits_2(func(T, U) = U, int, int, int, U) = U <= enum(T).
+
+fold_bits_2(F, Offset, Bits, Size, Acc0) = Acc :-
+ ( Bits = 0 ->
+ Acc = Acc0
+ ; Size = 1 ->
+ Elem = from_int(Offset),
+ Acc = F(Elem, Acc0)
+ ;
+ HalfSize = unchecked_right_shift(Size, 1),
+ Mask = mask(HalfSize),
+
+ % Extract the low-order half of the bits.
+ LowBits = Mask /\ Bits,
+ Acc1 = fold_bits_2(F, Offset, LowBits, HalfSize, Acc0),
+
+ % Extract the high-order half of the bits.
+ HighBits = Mask /\ unchecked_right_shift(Bits, HalfSize),
+ Acc = fold_bits_2(F, Offset + HalfSize,
+ HighBits, HalfSize, Acc1)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+count(Set) = fold((func(_, Acc) = Acc + 1), Set, 0).
+
+%-----------------------------------------------------------------------------%
+
+make_singleton_set(A) = insert(init, A).
+
+insert(sparse_bitset(Set), Elem) =
+ sparse_bitset(insert_2(Set, enum__to_int(Elem))).
+
+:- func insert_2(bitset_impl, int) = bitset_impl.
+
+insert_2([], Index) = [make_bitset_elem(Offset, Bits)] :-
+ bits_for_index(Index, Offset, Bits).
+insert_2(Set0, Index) = Set :-
+ Set0 = [Data0 | Rest],
+ Offset0 = Data0 ^ offset,
+ ( Index < Offset0 ->
+ bits_for_index(Index, Offset, Bits),
+ Set = [make_bitset_elem(Offset, Bits) | Set0]
+ ; BitToSet = Index - Offset0, BitToSet < bits_per_int ->
+ Bits = set_bit(Data0 ^ bits, BitToSet),
+ Set = [make_bitset_elem(Offset0, Bits) | Rest]
+ ;
+ Set = [Data0 | insert_2(Rest, Index)]
+ ).
+
+insert_list(Set, List) = union(list_to_set(List), Set).
+
+%-----------------------------------------------------------------------------%
+
+delete(Set, Elem) = difference(Set, insert(init, Elem)).
+delete_list(Set, List) = difference(Set, list_to_set(List)).
+
+remove(Set0, Elem) = Set :-
+ member(Elem, Set0),
+ Set = delete(Set0, Elem).
+
+remove_list(Set0, Elems) = Set :-
+ list_to_set(Elems, ElemsSet),
+ subset(ElemsSet, Set0),
+ Set = difference(Set0, ElemsSet).
+
+%-----------------------------------------------------------------------------%
+
+remove_least(sparse_bitset(Set0), Elem, sparse_bitset(Set)) :-
+ Set0 = [First | Rest],
+ Bits0 = First ^ bits,
+ Offset = First ^ offset,
+ Bit = find_least_bit(Bits0),
+ Elem = from_int(Offset + Bit),
+ Bits = clear_bit(Bits0, Bit),
+ ( Bits = 0 ->
+ Set = Rest
+ ;
+ Set = [make_bitset_elem(Offset, Bits) | Rest]
+ ).
+
+:- func find_least_bit(int) = int.
+
+find_least_bit(Bits0) = BitNum :-
+ Size = bits_per_int,
+ BitNum0 = 0,
+ BitNum = find_least_bit_2(Bits0, Size, BitNum0).
+
+:- func find_least_bit_2(int, int, int) = int.
+
+find_least_bit_2(Bits0, Size, BitNum0) = BitNum :-
+ ( Size = 1 ->
+ % We can't get here unless the bit is a 1 bit.
+ BitNum = BitNum0
+ ;
+ HalfSize = unchecked_right_shift(Size, 1),
+ Mask = mask(HalfSize),
+
+ LowBits = Bits0 /\ Mask,
+ ( LowBits \= 0 ->
+ BitNum = find_least_bit_2(LowBits, HalfSize, BitNum0)
+ ;
+ HighBits =
+ Mask /\ unchecked_right_shift(Bits0, HalfSize),
+ BitNum = find_least_bit_2(HighBits, HalfSize,
+ BitNum0 + HalfSize)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+list_to_set(List) = sparse_bitset(list_to_set_2(List, [])).
+
+ % Each pass over the input list selects out the elements which
+ % belong in the same bitset_elem as the first element.
+ % The assumption here is that the items in the input list
+ % will have similar values, so that only a few passes
+ % will be needed.
+:- func list_to_set_2(list(T), bitset_impl) = bitset_impl <= enum(T).
+:- pragma type_spec(list_to_set_2/2, T = var(_)).
+:- pragma type_spec(list_to_set_2/2, T = int).
+
+list_to_set_2([], List) = List.
+list_to_set_2([H | T], List0) = List :-
+ bits_for_index(enum__to_int(H), Offset, Bits0),
+ list_to_set_3(T, Offset, Bits0, Bits, [], Rest),
+ List1 = insert_bitset_elem(make_bitset_elem(Offset, Bits), List0),
+ List = list_to_set_2(Rest, List1).
+
+ % Go through the list picking out the elements
+ % which belong in the same bitset_elem as the first
+ % element, returning the uncollected elements.
+:- pred list_to_set_3(list(T), int, int, int,
+ list(T), list(T)) <= enum(T).
+:- mode list_to_set_3(in, in, in, out, in, out) is det.
+:- pragma type_spec(list_to_set_3/6, T = var(_)).
+:- pragma type_spec(list_to_set_3/6, T = int).
+
+list_to_set_3([], _, Bits, Bits, Rest, Rest).
+list_to_set_3([H | T], Offset, Bits0, Bits, Rest0, Rest) :-
+ BitToSet = enum__to_int(H) - Offset,
+ ( BitToSet >= 0, BitToSet < bits_per_int ->
+ Bits2 = set_bit(Bits0, BitToSet),
+ Rest1 = Rest0
+ ;
+ Bits2 = Bits0,
+ Rest1 = [H | Rest0]
+ ),
+ list_to_set_3(T, Offset, Bits2, Bits, Rest1, Rest).
+
+ % The list of elements here is pretty much guaranteed
+ % to be small, so use an insertion sort.
+:- func insert_bitset_elem(bitset_elem, bitset_impl) = bitset_impl.
+
+insert_bitset_elem(Data, []) = [Data].
+insert_bitset_elem(Data0, [Data1 | Rest]) = List :-
+ ( Data0 ^ offset < Data1 ^ offset ->
+ List = [Data0, Data1 | Rest]
+ ;
+ List = [Data1 | insert_bitset_elem(Data0, Rest)]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+sorted_list_to_set(L) = sparse_bitset(sorted_list_to_set_2(L)).
+
+:- func sorted_list_to_set_2(list(T)) = bitset_impl <= enum(T).
+:- pragma type_spec(sorted_list_to_set_2/1, T = var(_)).
+:- pragma type_spec(sorted_list_to_set_2/1, T = int).
+
+sorted_list_to_set_2([]) = [].
+sorted_list_to_set_2([H | T]) = Set :-
+ sorted_list_to_set_3(H, T, Offset, Bits, Set0),
+ ( Bits = 0 ->
+ Set = Set0
+ ;
+ Set = [make_bitset_elem(Offset, Bits) | Set0]
+ ).
+
+:- pred sorted_list_to_set_3(T, list(T), int, int, bitset_impl) <= enum(T).
+:- mode sorted_list_to_set_3(in, in, out, out, out) is det.
+:- pragma type_spec(sorted_list_to_set_3/5, T = var(_)).
+:- pragma type_spec(sorted_list_to_set_3/5, T = int).
+
+sorted_list_to_set_3(Elem, [], Offset, Bits, []) :-
+ bits_for_index(enum__to_int(Elem), Offset, Bits).
+sorted_list_to_set_3(Elem1, [Elem2 | Elems], Offset, Bits, Rest) :-
+ sorted_list_to_set_3(Elem2, Elems, Offset0, Bits0, Rest0),
+ bits_for_index(enum__to_int(Elem1), Offset1, Bits1),
+ ( Offset1 = Offset0 ->
+ Bits = Bits1 \/ Bits0,
+ Offset = Offset1,
+ Rest = Rest0
+ ;
+ Rest = [make_bitset_elem(Offset0, Bits0) | Rest0],
+ Offset = Offset1,
+ Bits = Bits1
+ ).
+
+%-----------------------------------------------------------------------------%
+
+subset(Subset, Set) :- intersect(Set, Subset, Set).
+
+superset(SuperSet, Set) :- subset(Set, SuperSet).
+
+%-----------------------------------------------------------------------------%
+
+member(Elem, sparse_bitset(Set)) :-
+ member_2(enum__to_int(Elem), Set).
+
+:- pred member_2(int, bitset_impl).
+:- mode member_2(in, in) is semidet.
+
+member_2(Index, [Data | Rest]) :-
+ Offset = Data ^ offset,
+ Index >= Offset,
+ ( Index < Offset + bits_per_int ->
+ get_bit(Data ^ bits, Index - Offset) \= 0
+ ;
+ member_2(Index, Rest)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func rest(bitset_impl::in(bound('.'(ground, ground)))) =
+ (bitset_impl::out) is det.
+rest([_ | Rest]) = Rest.
+
+union(sparse_bitset(Set1), sparse_bitset(Set2)) =
+ sparse_bitset(union_2(Set1, Set2)).
+
+:- func union_2(bitset_impl, bitset_impl) = bitset_impl.
+
+union_2([], []) = [].
+union_2([], B) = B :-
+ B = [_ | _].
+union_2(A, []) = A :-
+ A = [_ | _].
+union_2(Set1, Set2) = Set :-
+ Set1 = [Data1 | _],
+ Set2 = [Data2 | _],
+ Offset1 = Data1 ^ offset,
+ Offset2 = Data2 ^ offset,
+ ( Offset1 = Offset2 ->
+ Elem = make_bitset_elem(Offset1,
+ (Data1 ^ bits) \/ (Data2 ^ bits)),
+ Set = [Elem | union_2(Set1 ^ rest, Set2 ^ rest)]
+ ; Offset1 < Offset2 ->
+ Set = [Data1 | union_2(Set1 ^ rest, Set2)]
+ ;
+ Set = [Data2 | union_2(Set1, Set2 ^ rest)]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+intersect(sparse_bitset(Set1), sparse_bitset(Set2)) =
+ sparse_bitset(intersect_2(Set1, Set2)).
+
+:- func intersect_2(bitset_impl, bitset_impl) = bitset_impl.
+
+intersect_2([], []) = [].
+intersect_2([], B) = [] :-
+ B = [_ | _].
+intersect_2(A, []) = [] :-
+ A = [_ | _].
+intersect_2(Set1, Set2) = Set :-
+ Set1 = [Data1 | _],
+ Set2 = [Data2 | _],
+ Offset1 = Data1 ^ offset,
+ Offset2 = Data2 ^ offset,
+ ( Offset1 = Offset2 ->
+ Bits = Data1 ^ bits /\ Data2 ^ bits,
+ ( Bits = 0 ->
+ Set = intersect_2(Set1 ^ rest, Set2 ^ rest)
+ ;
+ Set = [make_bitset_elem(Offset1, Bits) |
+ intersect_2(Set1 ^ rest, Set2 ^ rest)]
+ )
+ ; Offset1 < Offset2 ->
+ Set = intersect_2(Set1 ^ rest, Set2)
+ ;
+ Set = intersect_2(Set1, Set2 ^ rest)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+difference(sparse_bitset(Set1), sparse_bitset(Set2)) =
+ sparse_bitset(difference_2(Set1, Set2)).
+
+:- func difference_2(bitset_impl, bitset_impl) = bitset_impl.
+
+difference_2([], []) = [].
+difference_2([], B) = [] :-
+ B = [_|_].
+difference_2(A, []) = A :-
+ A = [_ | _].
+difference_2(Set1, Set2) = Set :-
+ Set1 = [Data1 | _],
+ Set2 = [Data2 | _],
+ Offset1 = Data1 ^ offset,
+ Offset2 = Data2 ^ offset,
+ ( Offset1 = Offset2 ->
+ Bits = (Data1 ^ bits) /\ \ (Data2 ^ bits),
+ ( Bits = 0 ->
+ Set = difference_2(Set1 ^ rest, Set2 ^ rest)
+ ;
+ Set = [make_bitset_elem(Offset1, Bits) |
+ difference_2(Set1 ^ rest, Set2 ^ rest)]
+ )
+ ; Offset1 < Offset2 ->
+ Set = [Data1 | difference_2(Set1 ^ rest, Set2)]
+ ;
+ Set = difference_2(Set1, Set2 ^ rest)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Return the offset of the element of a set
+ % which should contain the given element,
+ % and an int with the bit corresponding to
+ % that element set.
+:- pred bits_for_index(int, int, int).
+:- mode bits_for_index(in, out, out) is det.
+:- pragma inline(bits_for_index/3).
+
+bits_for_index(Index, Offset, Bits) :-
+ % Need to use `div' and `mod' rather than `//' and `rem'
+ % to handle negative values correctly.
+ Offset = int__floor_to_multiple_of_bits_per_int(Index),
+ BitToSet = Index - Offset,
+ Bits = set_bit(0, BitToSet).
+
+:- func get_bit(int, int) = int.
+:- pragma inline(get_bit/2).
+
+get_bit(Int, Bit) = Int /\ unchecked_left_shift(1, Bit).
+
+:- func set_bit(int, int) = int.
+:- pragma inline(set_bit/2).
+
+set_bit(Int0, Bit) = Int0 \/ unchecked_left_shift(1, Bit).
+
+:- func clear_bit(int, int) = int.
+:- pragma inline(clear_bit/2).
+
+clear_bit(Int0, Bit) = Int0 /\ \ unchecked_left_shift(1, Bit).
+
+ % `mask(N)' returns a mask which can be `and'ed with an
+ % integer to return the lower `N' bits of the integer.
+ % `N' must be less than bits_per_int.
+:- func mask(int) = int.
+:- pragma inline(mask/1).
+
+mask(N) = \ unchecked_left_shift(\ 0, N).
+
+:- func make_bitset_elem(int, int) = bitset_elem.
+:- pragma inline(make_bitset_elem/2).
+
+%make_bitset_elem(A, B) = bitset_elem(A, B).
+
+ % The bit pattern will often look like a pointer,
+ % so allocate the pairs using GC_malloc_atomic()
+ % to avoid unnecessary memory retention.
+ % Doing this slows down the compiler by about 1%,
+ % but in a library module it's better to be safe.
+ % On the other hand, the bit patterns probably cause
+ % no more memory retention than unboxed floats.
+:- pragma c_code(make_bitset_elem(A::in, B::in) = (Pair::out),
+ [will_not_call_mercury, thread_safe],
+"{
+ incr_hp_atomic_msg(Pair, 2, MR_PROC_LABEL,
+ ""sparse_bitset:bitset_elem/0"");
+ MR_field(MR_mktag(0), Pair, 0) = A;
+ MR_field(MR_mktag(0), Pair, 1) = B;
+}").
+
+%-----------------------------------------------------------------------------%
+
+init(init).
+
+singleton_set(make_singleton_set(A), A).
+
+insert(A, B, insert(A, B)).
+
+insert_list(A, B, insert_list(A, B)).
+
+delete(A, B, delete(A, B)).
+
+delete_list(A, B, delete_list(A, B)).
+
+remove(A, B, remove(A, B)).
+
+remove_list(A, B, remove_list(A, B)).
+
+list_to_set(A, list_to_set(A)).
+
+to_sorted_list(A, to_sorted_list(A)).
+
+sorted_list_to_set(A, sorted_list_to_set(A)).
+
+union(A, B, union(A, B)).
+
+intersect(A, B, intersect(A, B)).
+
+difference(A, B, difference(A, B)).
+
+%-----------------------------------------------------------------------------%
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.98
diff -u -u -r1.98 Mmakefile
--- tests/hard_coded/Mmakefile 2000/11/01 07:01:49 1.98
+++ tests/hard_coded/Mmakefile 2000/11/03 04:19:13
@@ -106,6 +106,7 @@
string_alignment_bug \
string_loop \
term_io_test \
+ test_bitset \
test_imported_no_tag \
tim_qual1 \
type_qual \
Index: tests/hard_coded/bitset_tester.m
===================================================================
RCS file: bitset_tester.m
diff -N bitset_tester.m
--- /dev/null Fri Nov 3 18:05:00 2000
+++ bitset_tester.m Fri Nov 3 17:15:43 2000
@@ -0,0 +1,394 @@
+% Test operations on bitsets by comparing the output with the output
+% from an ordinary set.
+:- module bitset_tester.
+
+:- interface.
+
+:- import_module enum, list.
+
+:- type bitset_tester(T).
+
+:- func init = bitset_tester(T).
+:- func insert(bitset_tester(T), T) = bitset_tester(T) <= enum(T).
+:- func insert_list(bitset_tester(T), list(T)) =
+ bitset_tester(T) <= enum(T).
+:- func list_to_set(list(T)) = bitset_tester(T) <= enum(T).
+:- func sorted_list_to_set(list(T)) = bitset_tester(T) <= enum(T).
+:- func delete(bitset_tester(T), T) = bitset_tester(T) <= enum(T).
+:- func delete_list(bitset_tester(T), list(T)) =
+ bitset_tester(T) <= enum(T).
+:- func remove(bitset_tester(T), T) = bitset_tester(T) <= enum(T).
+:- mode remove(in, in) = out is semidet.
+:- func remove_list(bitset_tester(T), list(T)) =
+ bitset_tester(T) <= enum(T).
+:- mode remove_list(in, in) = out is semidet.
+
+:- func to_sorted_list(bitset_tester(T)) = list(T) <= enum(T).
+
+:- func singleton_set(T) = bitset_tester(T) <= enum(T).
+
+:- func union(bitset_tester(T), bitset_tester(T)) =
+ bitset_tester(T) <= enum(T).
+:- func intersect(bitset_tester(T), bitset_tester(T)) =
+ bitset_tester(T) <= enum(T).
+:- func difference(bitset_tester(T),
+ bitset_tester(T)) = bitset_tester(T) <= enum(T).
+
+:- pred remove_least(bitset_tester(T), T, bitset_tester(T)) <= enum(T).
+:- mode remove_least(in, out, out) is semidet.
+
+:- pred subset(bitset_tester(T), bitset_tester(T)).
+:- mode subset(in, in) is semidet.
+
+:- pred superset(bitset_tester(T), bitset_tester(T)).
+:- mode superset(in, in) is semidet.
+
+:- func count(bitset_tester(T)) = int <= enum(T).
+
+:- func fold(func(T, U) = U, bitset_tester(T), U) = U <= enum(T).
+
+:- pred empty(bitset_tester(T)).
+:- mode empty(in) is semidet.
+
+:- pred member(T::in, bitset_tester(T)::in) is semidet <= enum(T).
+
+:- pred init(bitset_tester(T)::out) is det.
+:- pred singleton_set(bitset_tester(T)::out, T::in) is det <= enum(T).
+
+:- pred list_to_set(list(T)::in, bitset_tester(T)::out) is det <= enum(T).
+:- pred sorted_list_to_set(list(T)::in,
+ bitset_tester(T)::out) is det <= enum(T).
+:- pred to_sorted_list(bitset_tester(T)::in,
+ list(T)::out) is det <= enum(T).
+:- pred insert(bitset_tester(T)::in, T::in,
+ bitset_tester(T)::out) is det <= enum(T).
+:- pred insert_list(bitset_tester(T)::in,
+ list(T)::in, bitset_tester(T)::out) is det <= enum(T).
+:- pred delete(bitset_tester(T)::in, T::in,
+ bitset_tester(T)::out) is det <= enum(T).
+:- pred delete_list(bitset_tester(T)::in, list(T)::in,
+ bitset_tester(T)::out) is det <= enum(T).
+:- pred union(bitset_tester(T)::in,
+ bitset_tester(T)::in, bitset_tester(T)::out) is det <= enum(T).
+:- pred intersect(bitset_tester(T)::in,
+ bitset_tester(T)::in, bitset_tester(T)::out) is det <= enum(T).
+:- pred difference(bitset_tester(T)::in,
+ bitset_tester(T)::in, bitset_tester(T)::out) is det <= enum(T).
+
+:- implementation.
+
+:- import_module bool, list, int, require, set, std_util.
+:- import_module sparse_bitset.
+
+:- type bitset_tester(T) == pair(sparse_bitset(T), set__set(T)).
+
+%-----------------------------------------------------------------------------%
+
+init = init - init.
+
+singleton_set(A) = make_singleton_set(A) - make_singleton_set(A).
+
+init(init).
+empty(A - B) :-
+ ( empty(A) -> EmptyA = yes; EmptyA = no),
+ ( empty(B) -> EmptyB = yes; EmptyB = no),
+ ( EmptyA = EmptyB ->
+ EmptyA = yes
+ ;
+ error("empty failed")
+ ).
+singleton_set(singleton_set(A), A).
+insert(A, B, insert(A, B)).
+insert_list(A, B, insert_list(A, B)).
+delete(A, B, delete(A, B)).
+delete_list(A, B, delete_list(A, B)).
+list_to_set(A, list_to_set(A)).
+to_sorted_list(A, to_sorted_list(A)).
+sorted_list_to_set(A, sorted_list_to_set(A)).
+union(A, B, union(A, B)).
+intersect(A, B, intersect(A, B)).
+difference(A, B, difference(A, B)).
+
+%-----------------------------------------------------------------------------%
+
+to_sorted_list(A - B) = List :-
+ ListA = to_sorted_list(A),
+ ListB = set__to_sorted_list(B),
+ ( ListA = ListB ->
+ List = ListB
+ ;
+ error("to_sorted_list failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+delete(SetA - SetB, Var) = check("delete", SetA - SetB, delete(SetA, Var) - set__delete(SetB, Var)).
+
+delete_list(SetA - SetB, List) =
+ check("delete_list", SetA - SetB,
+ delete_list(SetA, List) - set__delete_list(SetB, List)).
+
+remove(SetA0 - SetB0, Elem) = Result :-
+ ( SetA1 = remove(SetA0, Elem) ->
+ ( remove(SetB0, Elem, SetB1) ->
+ SetA = SetA1,
+ SetB = SetB1
+ ;
+ error("remove succeeded unexpectedly")
+ )
+ ; set__remove(SetB0, Elem, _) ->
+ error("remove failed unexpectedly")
+ ;
+ fail
+ ),
+ Result = check("remove", SetA0 - SetB0, SetA - SetB).
+
+remove_list(SetA0 - SetB0, List) = Result :-
+ ( SetA1 = remove_list(SetA0, List) ->
+ ( set__remove_list(SetB0, List, SetB1) ->
+ SetA = SetA1,
+ SetB = SetB1
+ ;
+ error("remove succeeded unexpectedly")
+ )
+ ; set__remove_list(SetB0, List, _) ->
+ error("remove failed unexpectedly")
+ ;
+ fail
+ ),
+ Result = check("remove_list", SetA0 - SetB0, SetA - SetB).
+
+%-----------------------------------------------------------------------------%
+
+insert(SetA - SetB, Var) = check("insert", SetA - SetB,
+ insert(SetA, Var) - set__insert(SetB, Var)).
+
+%-----------------------------------------------------------------------------%
+
+insert_list(SetA - SetB, Vars) = check("insert_list", SetA - SetB, insert_list(SetA, Vars) - set__insert_list(SetB, Vars)).
+
+%-----------------------------------------------------------------------------%
+
+list_to_set(List) = check("list_to_set", init - init,
+ list_to_set(List) - set__list_to_set(List)).
+
+sorted_list_to_set(List) = check("sorted_list_to_set", init - init,
+ sorted_list_to_set(List) - set__sorted_list_to_set(List)).
+
+%-----------------------------------------------------------------------------%
+
+member(Var, SetA - SetB) :-
+ ( member(Var, SetA) -> InSetA = yes ; InSetA = no),
+ ( set__member(Var, SetB) -> InSetB = yes ; InSetB = no),
+ ( InSetA = InSetB ->
+ InSetA = yes
+ ;
+ error("member failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+fold(F, SetA - SetB, Acc0) = Acc :-
+ AccA = fold(F, SetA, Acc0),
+ AccB = fold(F, SetB, Acc0),
+ ( AccA = AccB ->
+ Acc = AccA
+ ;
+ error("bitset_tester: fold failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+count(SetA - SetB) = Count :-
+ CountA = count(SetA),
+ CountB = count(SetB),
+ ( CountA = CountB ->
+ Count = CountA
+ ;
+ error("bitset_tester: count failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+subset(SetA1 - SetB1, SetA2 - SetB2) :-
+ ( subset(SetA1, SetA2) ->
+ ( subset(SetB1, SetB2) ->
+ true
+ ;
+ error("bitset_tester: subset succeeded unexpectedly")
+ )
+ ; subset(SetB1, SetB2) ->
+ error("bitset_tester: subset failed unexpectedly")
+ ;
+ fail
+ ).
+
+superset(SetA1 - SetB1, SetA2 - SetB2) :-
+ ( superset(SetA1, SetA2) ->
+ ( superset(SetB1, SetB2) ->
+ true
+ ;
+ error("bitset_tester: superset succeeded unexpectedly")
+ )
+ ; superset(SetB1, SetB2) ->
+ error("bitset_tester: superset failed unexpectedly")
+ ;
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+union(SetA1 - SetB1, SetA2 - SetB2) =
+ check2("union", SetA1 - SetB1, SetA2 - SetB2,
+ union(SetA1, SetA2) - set__union(SetB1, SetB2)).
+
+%-----------------------------------------------------------------------------%
+
+intersect(SetA1 - SetB1, SetA2 - SetB2) =
+ check2("intersect", SetA1 - SetB1, SetA2 - SetB2,
+ intersect(SetA1, SetA2) - set__intersect(SetB1, SetB2)).
+
+%-----------------------------------------------------------------------------%
+
+difference(SetA1 - SetB1, SetA2 - SetB2) =
+ check2("difference", SetA1 - SetB1, SetA2 - SetB2,
+ difference(SetA1, SetA2) - set__difference(SetB1, SetB2)).
+
+%-----------------------------------------------------------------------------%
+
+remove_least(SetA0 - SetB0, Least, SetA - SetB) :-
+ ( remove_least(SetA0, LeastA, SetA1) ->
+ ( remove_least(SetB0, LeastB, SetB1) ->
+ ( LeastA = LeastB ->
+ SetA = SetA1,
+ SetB = SetB1,
+ Least = LeastA
+ ;
+ error("remove_least: wrong least element")
+ )
+ ;
+ error("remove_least: should be no least value")
+ )
+ ; remove_least(SetB0, _, _) ->
+ error("remove_least: failed")
+ ;
+ fail
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func check(string, bitset_tester(T), bitset_tester(T)) =
+ bitset_tester(T) <= enum(T).
+
+check(Op, Tester1, Tester) = Tester :-
+
+ Tester1 = BitSet1 - Set1,
+ BitSetSet1 =
+ sparse_bitset__sorted_list_to_set(set__to_sorted_list(Set1)),
+ Tester = BitSet - Set,
+ BitSetSet = sparse_bitset__sorted_list_to_set(set__to_sorted_list(Set)),
+ ( BitSetSet1 = BitSet1, BitSet = BitSetSet ->
+ true
+ ;
+ unsafe_perform_io(io__write_string("Error in ")),
+ unsafe_perform_io(io__write_string(Op)),
+ unsafe_perform_io(io__write_string(":\n")),
+ unsafe_perform_io(io__write_string("Set1 : ")),
+ unsafe_perform_io(io__write(Set1)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("BitSet1 : ")),
+ unsafe_perform_io(io__write(BitSetSet1)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("Result Set: ")),
+ unsafe_perform_io(io__write(Set)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("Result BitSet: ")),
+ unsafe_perform_io(io__write(BitSetSet)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ error("bitset failed")
+ ).
+
+:- func check2(string, bitset_tester(T), bitset_tester(T),
+ bitset_tester(T)) = bitset_tester(T) <= enum(T).
+
+check2(Op, Tester1, Tester2, Tester) = Result :-
+ Tester1 = BitSet1 - Set1,
+ BitSetSet1 = sparse_bitset__sorted_list_to_set(set__to_sorted_list(Set1)),
+ Tester2 = BitSet2 - Set2,
+ BitSetSet2 = sorted_list_to_set(
+ set__to_sorted_list(Set2)),
+
+ Tester = BitSet - Set,
+ BitSetSet = sparse_bitset__sorted_list_to_set(set__to_sorted_list(Set)),
+
+ ( BitSetSet1 = BitSet1, BitSetSet2 = BitSet2, BitSet = BitSetSet ->
+ Result = Tester
+ ;
+ unsafe_perform_io(io__write_string("Error in ")),
+ unsafe_perform_io(io__write_string(Op)),
+ unsafe_perform_io(io__write_string(":\n")),
+
+ unsafe_perform_io(io__write_string("Set1 : ")),
+ unsafe_perform_io(io__write(Set1)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("BitSet1 : ")),
+ unsafe_perform_io(io__write(BitSet1)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("Set2 : ")),
+ unsafe_perform_io(io__write(Set2)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("BitSet2 : ")),
+ unsafe_perform_io(io__write(BitSet2)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("Result Set: ")),
+ unsafe_perform_io(io__write(Set)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__write_string("Result BitSet: ")),
+ unsafe_perform_io(io__write(BitSet)),
+ unsafe_perform_io(io__nl),
+ unsafe_perform_io(io__nl),
+ error("bitset failed")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- import_module io.
+
+:- pred unsafe_perform_io(pred(io__state, io__state)).
+:- mode unsafe_perform_io(pred(di, uo) is det) is det.
+:- mode unsafe_perform_io(pred(di, uo) is cc_multi) is det.
+
+:- pragma c_code(
+unsafe_perform_io(P::(pred(di, uo) is det)),
+ may_call_mercury,
+"{
+ call_io_pred_det(P);
+}").
+:- pragma c_code(
+unsafe_perform_io(P::(pred(di, uo) is cc_multi)),
+ may_call_mercury,
+"{
+ call_io_pred_cc_multi(P);
+}").
+
+:- pred call_io_pred(pred(io__state, io__state), io__state, io__state).
+:- mode call_io_pred(pred(di, uo) is det, di, uo) is det.
+:- mode call_io_pred(pred(di, uo) is cc_multi, di, uo) is cc_multi.
+
+:- pragma export(call_io_pred(pred(di, uo) is det, di, uo),
+ "call_io_pred_det").
+:- pragma export(call_io_pred(pred(di, uo) is cc_multi, di, uo),
+ "call_io_pred_cc_multi").
+
+call_io_pred(P) --> P.
+
+%-----------------------------------------------------------------------------%
Index: tests/hard_coded/test_bitset.exp
===================================================================
RCS file: test_bitset.exp
diff -N test_bitset.exp
--- /dev/null Fri Nov 3 18:05:00 2000
+++ test_bitset.exp Fri Nov 3 17:21:45 2000
@@ -0,0 +1,89 @@
+List1: -59, -34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 39, 40, 42, 44, 47, 58, 59
+
+List2: -64, -61, -58, -56, -51, -49, -48, -46, -44, -40, -38, -37, -31, -30, -23, -18, -13, -4, -2, 4, 9, 11, 12, 14, 17, 21, 23, 37, 39, 42, 43, 50, 52, 53, 54, 55, 56, 57, 61, 63
+
+count: 22 40
+testing fold
+Sum of List1 = 471
+Sum of List2 = 60
+testing union
+[-64, -61, -59, -58, -56, -51, -49, -48, -46, -44, -40, -38, -37, -34, -31, -30, -23, -19, -18, -15, -13, -4, -2, 2, 4, 7, 9, 11, 12, 14, 17, 19, 21, 22, 23, 25, 28, 29, 31, 32, 36, 37, 38, 39, 40, 42, 43, 44, 47, 50, 52, 53, 54, 55, 56, 57, 58, 59, 61, 63]
+testing intersection
+[39, 42]
+testing difference
+[-59, -34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 40, 44, 47, 58, 59]
+testing remove_least_element
+-59
+[-34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 39, 40, 42, 44, 47, 58, 59]
+testing delete_list
+[-59, -34, -19, -15, 2, 7, 19, 22, 25, 28, 29, 31, 32, 36, 38, 40, 44, 47, 58, 59]
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
+count: 20 40
+testing fold
+testing union
+testing intersection
+testing difference
+testing remove_least_element
+testing delete_list
Index: tests/hard_coded/test_bitset.m
===================================================================
RCS file: test_bitset.m
diff -N test_bitset.m
--- /dev/null Fri Nov 3 18:05:00 2000
+++ test_bitset.m Fri Nov 3 17:15:18 2000
@@ -0,0 +1,152 @@
+:- module test_bitset.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module bool, enum, int, list, bitset_tester, random, require.
+
+:- func list1 = list(int).
+
+list1 = [29, 28, 31, 22, -15, 32, 19, 58, -59, 36, 7, 39, 42,
+ -34, 25, 40, 59, 2, -19, 44, 47, 38].
+
+:- func list2 = list(int).
+
+list2 = [21, 52, 23, -18, -23, 56, 11, -46, 61, -4, 63, 54, 17, -64,
+ -13, -38, 37, 4, 39, -2, 57, -56, -37, -30, -51, 12, -49,
+ -58, -31, -48, -61, 42, 53, -44, 55, 14, 9, -40, 43, 50].
+
+main -->
+ % Run one lot of tests with known input lists,
+ % to generate some visible output.
+ { Write = yes },
+ run_test(Write, list1, list2),
+
+ % Run some more tests with random input, checking
+ % the output against that of set_ordlist.
+ { Iterations = 10 },
+ { random__init(1, Supply) },
+ run_tests(Iterations, Supply).
+
+:- pred run_tests(int::in, random__supply::mdi,
+ io__state::di, io__state::uo) is det.
+
+run_tests(Iterations, Supply0) -->
+ ( { Iterations = 0 } ->
+ []
+ ;
+ { Num1 = 20 },
+ { get_random_numbers(Num1, [], List1, Supply0, Supply1) },
+ { Num2 = 40 },
+ { get_random_numbers(Num2, [], List2, Supply1, Supply) },
+
+ { Write = no },
+ run_test(Write, List1, List2),
+
+
+ run_tests(Iterations - 1, Supply)
+ ).
+
+:- pred get_random_numbers(int::in, list(int)::in, list(int)::out,
+ random__supply::mdi, random__supply::muo) is det.
+
+get_random_numbers(Num, List0, List, Supply0, Supply) :-
+ ( Num = 0 ->
+ List = List0,
+ Supply = Supply0
+ ;
+ random__random(N, Supply0, Supply1),
+ RN = N rem 128 - 64, % test negative numbers
+ get_random_numbers(Num - 1, [RN | List0], List,
+ Supply1, Supply)
+ ).
+
+:- pred run_test(bool::in, list(int)::in, list(int)::in,
+ io__state::di, io__state::uo) is det.
+
+run_test(Write, List1, List2) -->
+ ( { Write = yes } ->
+ io__write_string("List1: "),
+ io__write_list(list__sort(List1), ", ", io__write_int),
+ io__nl, io__nl,
+ io__write_string("List2: "),
+ io__write_list(list__sort(List2), ", ", io__write_int),
+ io__nl, io__nl
+ ;
+ []
+ ),
+ { Set1 = bitset_tester__list_to_set(List1) },
+ { Set2 = bitset_tester__list_to_set(List2) },
+
+ io__write_string("count: "),
+ io__write_int(count(Set1)),
+ io__write_string(" "),
+ io__write_int(count(Set2)),
+ io__nl,
+
+ io__write_string("testing fold\n"),
+ { Sum = (func(Elem, Acc) = Elem + Acc) },
+ { Result1 = fold(Sum, Set1, 0) },
+ { Result2 = fold(Sum, Set2, 0) },
+ ( { Write = yes } ->
+ io__write_string("Sum of List1 = "),
+ io__write_int(Result1),
+ io__nl,
+ io__write_string("Sum of List2 = "),
+ io__write_int(Result2),
+ io__nl
+ ;
+ []
+ ),
+
+ io__write_string("testing union\n"),
+ { Union = union(Set1, Set2) },
+ write_bitset_result(Write, Union),
+
+ io__write_string("testing intersection\n"),
+ { Intersection = intersect(Set1, Set2) },
+ write_bitset_result(Write, Intersection),
+
+ io__write_string("testing difference\n"),
+ { Difference = difference(Set1, Set2) },
+ write_bitset_result(Write, Difference),
+
+ io__write_string("testing remove_least_element\n"),
+ ( { remove_least(Set1, Least, RemovedLeast) } ->
+ ( { Write = yes } ->
+ io__write_int(Least),
+ io__nl
+ ;
+ []
+ ),
+ write_bitset_result(Write, RemovedLeast)
+ ;
+ { error("remove_least failed") }
+ ),
+
+ io__write_string("testing delete_list\n"),
+ { Delete = delete_list(Set1, List2) },
+ write_bitset_result(Write, Delete),
+
+ { require(unify(delete_list(Set1, List1),
+ init `with_type` bitset_tester(int)),
+ "delete_list_failed") }.
+
+:- pred write_bitset_result(bool::in, bitset_tester(int)::in,
+ io__state::di, io__state::uo) is det.
+:- pragma no_inline(write_bitset_result/4).
+
+write_bitset_result(Write, Set) -->
+ ( { Write = yes } ->
+ { List `with_type` list(int) = to_sorted_list(Set) },
+ io__write(List),
+ io__nl
+ ;
+ []
+ ).
+
--------------------------------------------------------------------------
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