%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2011-2012 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: set_of_var.m. % % A module to define the abstract data structure we use to represent % sets of variables. % %---------------------------------------------------------------------------% :- module parse_tree.set_of_var. :- interface. :- import_module parse_tree.prog_data. :- import_module bool. :- import_module list. :- import_module set. :- import_module term. :- type set_of_var(T). :- type set_of_progvar == set_of_var(prog_var_type). :- type set_of_tvar == set_of_var(tvar_type). :- func init = set_of_var(T). :- pred init(set_of_var(T)::out) is det. :- func make_singleton(var(T)) = set_of_var(T). :- pred make_singleton(var(T)::in, set_of_var(T)::out) is det. :- func count(set_of_var(T)) = int. %---------------------% % Tests. :- pred is_empty(set_of_var(T)::in) is semidet. :- pred is_non_empty(set_of_var(T)::in) is semidet. :- pred is_singleton(set_of_var(T)::in, var(T)::out) is semidet. :- pred member(set_of_var(T), var(T)). :- mode member(in, in) is semidet. :- mode member(in, out) is nondet. :- pred is_member(set_of_var(T)::in, var(T)::in, bool::out) is det. :- pred contains(set_of_var(T)::in, var(T)::in) is semidet. :- pred equal(set_of_var(T)::in, set_of_var(T)::in) is semidet. %---------------------% % Conversions. :- func list_to_set(list(var(T))) = set_of_var(T). :- func sorted_list_to_set(list(var(T))) = set_of_var(T). :- func to_sorted_list(set_of_var(T)) = list(var(T)). :- pred list_to_set(list(var(T))::in, set_of_var(T)::out) is det. :- pred sorted_list_to_set(list(var(T))::in, set_of_var(T)::out) is det. :- pred to_sorted_list(set_of_var(T)::in, list(var(T))::out) is det. :- func set_to_bitset(set(var(T))) = set_of_var(T). :- func bitset_to_set(set_of_var(T)) = set(var(T)). %---------------------% % Updates. :- pred insert(var(T)::in, set_of_var(T)::in, set_of_var(T)::out) is det. :- pred insert_list(list(var(T))::in, set_of_var(T)::in, set_of_var(T)::out) is det. :- pred delete(var(T)::in, set_of_var(T)::in, set_of_var(T)::out) is det. :- pred delete_list(list(var(T))::in, set_of_var(T)::in, set_of_var(T)::out) is det. :- pred remove(var(T)::in, set_of_var(T)::in, set_of_var(T)::out) is semidet. :- pred remove_list(list(var(T))::in, set_of_var(T)::in, set_of_var(T)::out) is semidet. :- pred remove_least(var(T)::out, set_of_var(T)::in, set_of_var(T)::out) is semidet. %---------------------% % Set operations. :- pred subset(set_of_var(T)::in, set_of_var(T)::in) is semidet. :- func union(set_of_var(T), set_of_var(T)) = set_of_var(T). :- pred union(set_of_var(T)::in, set_of_var(T)::in, set_of_var(T)::out) is det. :- func union_list(list(set_of_var(T))) = set_of_var(T). :- pred union_list(list(set_of_var(T))::in, set_of_var(T)::out) is det. :- func intersect(set_of_var(T), set_of_var(T)) = set_of_var(T). :- pred intersect(set_of_var(T)::in, set_of_var(T)::in, set_of_var(T)::out) is det. :- func intersect_list(list(set_of_var(T))) = set_of_var(T). :- pred intersect_list(list(set_of_var(T))::in, set_of_var(T)::out) is det. :- func difference(set_of_var(T), set_of_var(T)) = set_of_var(T). :- pred difference(set_of_var(T)::in, set_of_var(T)::in, set_of_var(T)::out) is det. :- pred divide(pred(var(T))::in(pred(in) is semidet), set_of_var(T)::in, set_of_var(T)::out, set_of_var(T)::out) is det. :- pred divide_by_set(set_of_var(T)::in, set_of_var(T)::in, set_of_var(T)::out, set_of_var(T)::out) is det. :- pred cartesian_product(set_of_var(T)::in, set_of_var(T)::in, list(set_of_var(T))::out) is det. :- pred cartesian_product_list(list(set_of_var(T))::in, list(set_of_var(T))::out) is det. %---------------------% % Traversals. :- pred fold(pred(var(T), Acc, Acc), set_of_var(T), Acc, Acc). :- mode fold(pred(in, in, out) is det, in, in, out) is det. :- mode fold(pred(in, in, out) is semidet, in, in, out) is semidet. :- pred fold_func((func(var(T), Acc) = Acc), set_of_var(T), Acc, Acc). :- mode fold_func(in((func(in, in) = out) is det), in, in, out) is det. % `filter(Pred, Set) = TrueSet' returns the elements of Set for which % Pred succeeds. % :- func filter(pred(var(T))::in(pred(in) is semidet), set_of_var(T)::in) = (set_of_var(T)::out) is det. :- pred filter(pred(var(T))::in(pred(in) is semidet), set_of_var(T)::in, set_of_var(T)::out) is det. % `filter(Pred, Set, TrueSet, FalseSet)' returns the elements of Set % for which Pred succeeds, and those for which it fails. % :- pred filter(pred(var(T))::in(pred(in) is semidet), set_of_var(T)::in, set_of_var(T)::out, set_of_var(T)::out) is det. % all_true(Pred, Set) succeeds iff Pred(Element) succeeds % for all the elements of Set. % :- pred all_true(pred(var(T))::in(pred(in) is semidet), set_of_var(T)::in) is semidet. %---------------------% % Graph colouring. % Find a 'good' colouring of a graph. % The predicate takes a set of sets each containing elements that touch, % and returns a set of sets each containing elements that can be assigned % the same colour, ensuring that touching elements have different colours. % ("Good" means using as few colours as possible.) % :- pred graph_colour_group_elements(set(set_of_var(T))::in, set(set_of_var(T))::out) is det. %---------------------------------------------------------------------------% :- implementation. % We want to define set_of_var as sparse_bitset for performance. % However, until we have user-specified pretty printing in the debugger, % debugging will be much easier if set_of_var is just a plain set. % The definition of the type is hidden here to make it relatively easy % to change. % % If you want to debug a new set representation, then % % - make the test_bitset.m module use the new representation instead of % sparse_bitset.m (all the operations will be run both on the new % representation and on set_ordlist, aborting on any discrepancy), % % - change every occurrence of sparse_bitset in this file that is on a line % containing MODULE to test_bitset. % % Once the representation has been proven, you can change all those occurrences % of test_bitset to the name of the module implementing the new representation. :- import_module require. :- import_module sparse_bitset. % MODULE :- type set_of_var(T) == sparse_bitset(var(T)). % MODULE %---------------------------------------------------------------------------% init = sparse_bitset.init. % MODULE init(Set) :- Set = set_of_var.init. make_singleton(Elem) = sparse_bitset.make_singleton_set(Elem). % MODULE make_singleton(Elem, Set) :- Set = set_of_var.make_singleton(Elem). count(Set) = Count :- Count = sparse_bitset.count(Set). % MODULE %---------------------% % Tests. is_empty(Set) :- sparse_bitset.is_empty(Set). % MODULE is_non_empty(Set) :- sparse_bitset.is_non_empty(Set). % MODULE is_singleton(Set, Elem) :- sparse_bitset.is_singleton(Set, Elem). % MODULE member(Set, Elem) :- sparse_bitset.member(Elem, Set). % MODULE is_member(Set, Elem, IsMember) :- ( if set_of_var.contains(Set, Elem) then IsMember = yes else IsMember = no ). contains(Set, Elem) :- sparse_bitset.contains(Set, Elem). % MODULE equal(SetA, SetB) :- sparse_bitset.equal(SetA, SetB). % MODULE %---------------------% % Conversions. list_to_set(List) = sparse_bitset.list_to_set(List). % MODULE sorted_list_to_set(List) = sparse_bitset.sorted_list_to_set(List). % MODULE to_sorted_list(Set) = sparse_bitset.to_sorted_list(Set). % MODULE list_to_set(List, Set) :- Set = set_of_var.list_to_set(List). sorted_list_to_set(List, Set) :- Set = set_of_var.sorted_list_to_set(List). to_sorted_list(Set, List) :- List = set_of_var.to_sorted_list(Set). set_to_bitset(OrdSet) = BitSet :- % We don't use from_set, since set.m itself doesn't have that. set.to_sorted_list(OrdSet, List), sparse_bitset.sorted_list_to_set(List, BitSet). % MODULE bitset_to_set(BitSet) = OrdSet :- % We don't use to_set, since set.m itself doesn't have that. sparse_bitset.to_sorted_list(BitSet, List), % MODULE set.sorted_list_to_set(List, OrdSet). %---------------------% % Updates. insert(Elem, !Set) :- sparse_bitset.insert(Elem, !Set). % MODULE insert_list(Elems, !Set) :- sparse_bitset.insert_list(Elems, !Set). % MODULE delete(Elem, !Set) :- sparse_bitset.delete(Elem, !Set). % MODULE delete_list(Elems, !Set) :- sparse_bitset.delete_list(Elems, !Set). % MODULE remove(Elem, !Set) :- sparse_bitset.remove(Elem, !Set). % MODULE remove_list(Elems, !Set) :- sparse_bitset.remove_list(Elems, !Set). % MODULE remove_least(LeastElem, !Set) :- sparse_bitset.remove_least(LeastElem, !Set). % MODULE %---------------------% % Set operations. subset(SetA, SetB) :- sparse_bitset.subset(SetA, SetB). % MODULE union(SetA, SetB) = sparse_bitset.union(SetA, SetB). % MODULE union(SetA, SetB, Set) :- sparse_bitset.union(SetA, SetB, Set). % MODULE union_list(Sets) = sparse_bitset.union_list(Sets). % MODULE union_list(Sets, Set) :- Set = sparse_bitset.union_list(Sets). % MODULE intersect(SetA, SetB) = sparse_bitset.intersect(SetA, SetB). % MODULE intersect(SetA, SetB, Set) :- sparse_bitset.intersect(SetA, SetB, Set). % MODULE intersect_list(Sets) = sparse_bitset.intersect_list(Sets). % MODULE intersect_list(Sets, Set) :- Set = sparse_bitset.intersect_list(Sets). % MODULE difference(SetA, SetB) = sparse_bitset.difference(SetA, SetB). % MODULE difference(SetA, SetB, Set) :- sparse_bitset.difference(SetA, SetB, Set). % MODULE divide(Pred, Set, InPart, OutPart) :- sparse_bitset.divide(Pred, Set, InPart, OutPart). % MODULE divide_by_set(DivideBySet, Set, InPart, OutPart) :- sparse_bitset.divide_by_set(DivideBySet, Set, InPart, OutPart). % MODULE cartesian_product(A, B, Product) :- sparse_bitset.foldl(cartesian_product2(A), B, [], Product). % MODULE :- pred cartesian_product2(set_of_var(T)::in, var(T)::in, list(set_of_var(T))::in, list(set_of_var(T))::out) is det. cartesian_product2(SetA, VarB, !Sets) :- Pred = (pred(VarA::in, SetsI0::in, SetsI::out) is det :- Set = set_of_var.list_to_set([VarA, VarB]), SetsI = [Set | SetsI0] ), set_of_var.fold(Pred, SetA, !Sets). cartesian_product_list([], []). cartesian_product_list([FirstSet | OtherSets], Product) :- list.foldl(cartesian_product_list2(FirstSet), OtherSets, [], Product). :- pred cartesian_product_list2(set_of_var(T)::in, set_of_var(T)::in, list(set_of_var(T))::in, list(set_of_var(T))::out) is det. cartesian_product_list2(A, B, SetsAcc, Product ++ SetsAcc) :- cartesian_product(A, B, Product). %---------------------% % Traversals. fold(P, Set, !Acc) :- sparse_bitset.foldl(P, Set, !Acc). % MODULE fold_func(P, Set, !Acc) :- !:Acc = sparse_bitset.foldl(P, Set, !.Acc). % MODULE filter(P, Set) = sparse_bitset.filter(P, Set). % MODULE filter(P, Set, Trues) :- Trues = sparse_bitset.filter(P, Set). % MODULE filter(P, Set, Trues, Falses) :- sparse_bitset.filter(P, Set, Trues, Falses). % MODULE all_true(P, Set) :- sparse_bitset.all_true(P, Set). % MODULE %---------------------% % Graph colouring. % The code of graph_colour_group_elements and its auxiliary predicates % is adapted from graph_colour.m. % % Note that this algorithm is NOT guaranteed to find the exact same colour % assignment as graph_colour.m. That is because the sorted list of sets that % find_all_colours iterates over is sorted by different criteria when the % elements are set(prog_var), as in graph_colour.m, and when they are % set_of_progvar, as they are here. The same is true for the set of colours % that graph_colour_group_elements returns. However, you *do* get the exact % same results if you re-sort both the input and output sets-of-sets using % the set.m set representation of the elements. graph_colour_group_elements(!.Constraints, Colours) :- set.delete(set_of_var.init, !Constraints), set.to_sorted_list(!.Constraints, ConstraintList), set_of_var.union_list(ConstraintList, AllVars), find_all_colours(ConstraintList, AllVars, ColourList), Colours = set.list_to_set(ColourList). % Iterate the assignment of a new colour until all constraints % are satisfied. % :- pred find_all_colours(list(set_of_var(T))::in, set_of_var(T)::in, list(set_of_var(T))::out) is det. find_all_colours(ConstraintList, Vars, ColourList) :- ( ConstraintList = [], ColourList = [] ; ConstraintList = [_ | _], next_colour(Vars, ConstraintList, RemainingConstraints, Colour), set_of_var.difference(Vars, Colour, RestVars), find_all_colours(RemainingConstraints, RestVars, ColourList0), ColourList = [Colour | ColourList0] ). :- pred next_colour(set_of_var(T)::in, list(set_of_var(T))::in, list(set_of_var(T))::out, set_of_var(T)::out) is det. next_colour(Vars0, ConstraintList, Remainder, SameColour) :- % Check if there are any constraints left to be satisfied. ( ConstraintList = [_ | _], % Select a variable to assign a colour, ... choose_var(Vars0, Var, Vars1), % ... and divide the constraints into those that may be the same colour % as that var and those that may not. divide_constraints(Var, ConstraintList, WereContaining, NotContaining, Vars1, RestVars), ( % See if there are sets that can share a colour with the % selected var. NotContaining = [_ | _], ( if set_of_var.is_empty(RestVars) then % There were no variables left that could share a colour, % so create a singleton set containing this variable. SameColour = set_of_var.make_singleton(Var), ResidueSets = NotContaining else % If there is at least one variable that can share a colour % with the selected variable, then recursively use the % remaining constraints to assign a colour to one of the % remaining vars, and assemble the constraint residues. next_colour(RestVars, NotContaining, ResidueSets, SameColour0), % Add this variable to the variables of the current colour. set_of_var.insert(Var, SameColour0, SameColour) ) ; NotContaining = [], % There were no more constraints which could be satisfied % by assigning any variable a colour the same as the current % variable, so create a signleton set with the current var, % and assign the residue to the empty set. SameColour = set_of_var.make_singleton(Var), ResidueSets = [] ), % The remaining constraints are the residue sets that could not be % satisfied by assigning any variable to the current colour, and the % constraints that were already satisfied by the assignment of the % current variable to this colour. list.append(ResidueSets, WereContaining, Remainder) ; % If there were no constraints, then no colours were needed. ConstraintList = [], Remainder = [], SameColour = set_of_var.init ). % Divide_constraints takes a var and a list of sets of var, and divides % the list into two lists: a list of sets containing the given variable % and a list of sets not containing that variable. The sets in the list % containing the variable have that variable removed. Additionally, a set % of variables is threaded through the computation, and any variables that % were in sets that also contained the given variables are removed from % the threaded set. % :- pred divide_constraints(var(T)::in, list(set_of_var(T))::in, list(set_of_var(T))::out, list(set_of_var(T))::out, set_of_var(T)::in, set_of_var(T)::out) is det. divide_constraints(_Var, [], [], [], !Vars). divide_constraints(Var, [S | Ss], C, NC, !Vars) :- divide_constraints(Var, Ss, C0, NC0, !Vars), ( if set_of_var.member(S, Var) then set_of_var.delete(Var, S, T), ( if set_of_var.is_empty(T) then C = C0 else C = [T | C0] ), NC = NC0, set_of_var.difference(!.Vars, T, !:Vars) else C = C0, NC = [S | NC0] ). % Choose_var/3, given a set of variables, chooses one, returns it % and the set with that variable removed. % :- pred choose_var(set_of_var(T)::in, var(T)::out, set_of_var(T)::out) is det. choose_var(Vars0, Var, Vars) :- ( if set_of_var.remove_least(VarPrime, Vars0, VarsPrime) then Var = VarPrime, Vars = VarsPrime else unexpected($pred, "no vars!") ). %---------------------------------------------------------------------------% :- end_module parse_tree.set_of_var. %---------------------------------------------------------------------------%