[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