[m-rev.] for post-commit review: eqvclass.divide_equivalence_classes
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Mar 13 14:59:50 AEDT 2006
library/eqvclass.m:
Add a function for use by the scanner generator.
library/multi_map.m:
Fix typo in comment.
NEWS:
Mention the new function.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.402
diff -u -b -r1.402 NEWS
--- NEWS 8 Mar 2006 02:25:26 -0000 1.402
+++ NEWS 13 Mar 2006 03:55:06 -0000
@@ -201,6 +201,9 @@
Changes to the Mercury standard library:
+* We have added the function `divide_equivalence_classes' to the `eqvclass'
+ module.
+
* We have added an `injection' module, for reversible maps that are injective.
* We have added list.foldl_corresponding/5, list.foldl2_corresponding/7,
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/eqvclass.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/eqvclass.m,v
retrieving revision 1.20
diff -u -b -r1.20 eqvclass.m
--- library/eqvclass.m 7 Mar 2006 22:23:43 -0000 1.20
+++ library/eqvclass.m 11 Mar 2006 11:27:13 -0000
@@ -139,6 +139,14 @@
%
:- func eqvclass.remove_equivalent_elements(eqvclass(T), T) = eqvclass(T).
+ % Given a function, divide each partition in the original equivalence class
+ % so that two elements of the original partition end up in the same
+ % partition in the new equivalence class if and only if the function maps
+ % them to the same value.
+ %
+:- func eqvclass.divide_equivalence_classes(func(T) = U, eqvclass(T))
+ = eqvclass(T).
+
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
@@ -203,6 +211,7 @@
map.det_insert(PartitionMap0, Id, Partition, PartitionMap),
!:EqvClass = eqvclass(Counter, PartitionMap, ElementMap).
+eqvclass.ensure_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
% The following code is logically equivalent to this code:
%
% eqvclass.ensure_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
@@ -217,8 +226,6 @@
% However, the above code allocates significantly more memory than the code
% below, because it can create an equivalence class for an element and then
% just throw that equivalence class away.
-
-eqvclass.ensure_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
ElementMap0 = EqvClass0 ^ keys,
( map.search(ElementMap0, ElementA, IdA) ->
( map.search(ElementMap0, ElementB, IdB) ->
@@ -257,10 +264,10 @@
)
).
+eqvclass.new_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
% This code is the same as eqvclass.ensure_equivalence, with the
% exception that we abort if IdA = IdB in EqvClass0.
-eqvclass.new_equivalence(EqvClass0, ElementA, ElementB, EqvClass) :-
ElementMap0 = EqvClass0 ^ keys,
( map.search(ElementMap0, ElementA, IdA) ->
( map.search(ElementMap0, ElementB, IdB) ->
@@ -309,8 +316,7 @@
eqvclass.ensure_corresponding_equivalences(T1, T2, !EqvClass).
eqvclass.ensure_corresponding_equivalences(L1, L2, EqvClass0) = EqvClass :-
- eqvclass.ensure_corresponding_equivalences(L1, L2,
- EqvClass0, EqvClass).
+ eqvclass.ensure_corresponding_equivalences(L1, L2, EqvClass0, EqvClass).
:- pred eqvclass.add_equivalence(partition_id::in, partition_id::in,
eqvclass(T)::in, eqvclass(T)::out) is det.
@@ -486,4 +492,67 @@
;
P = P0,
E = E0
+ ).
+
+divide_equivalence_classes(F, E0) = E :-
+ E0 = eqvclass(Counter0, Partitions0, Keys0),
+ map.foldl3(divide_equivalence_classes_2(F), Partitions0,
+ Counter0, Counter, Partitions0, Partitions, Keys0, Keys),
+ E = eqvclass(Counter, Partitions, Keys).
+
+:- pred divide_equivalence_classes_2((func(T) = U)::in,
+ partition_id::in, set(T)::in,
+ counter::in, counter::out,
+ map(partition_id, set(T))::in, map(partition_id, set(T))::out,
+ map(T, partition_id)::in, map(T, partition_id)::out) is det.
+
+divide_equivalence_classes_2(F, Id, ItemSet, !Counter, !Partitions, !Keys) :-
+ set.to_sorted_list(ItemSet, ItemList),
+ (
+ ItemList = [],
+ error("divide_equivalence_classes_2: empty partition")
+ ;
+ ItemList = [Item | Items],
+ MainValue = F(Item),
+ map.init(Map0),
+ map.det_insert(Map0, MainValue, Id, Map1),
+ list.foldl4(divide_equivalence_classes_3(F, Id), Items,
+ Map1, _Map, !Counter, !Partitions, !Keys)
+ ).
+
+:- pred divide_equivalence_classes_3((func(T) = U)::in, partition_id::in,
+ T::in, map(U, partition_id)::in, map(U, partition_id)::out,
+ counter::in, counter::out,
+ map(partition_id, set(T))::in, map(partition_id, set(T))::out,
+ map(T, partition_id)::in, map(T, partition_id)::out) is det.
+
+divide_equivalence_classes_3(F, MainId, Item, !Map, !Counter, !Partitions,
+ !Keys) :-
+ Value = F(Item),
+ ( map.search(!.Map, Value, Id) ->
+ ( Id = MainId ->
+ true
+ ;
+ map.lookup(!.Partitions, MainId, MainSet0),
+ set.delete(MainSet0, Item, MainSet),
+ svmap.det_update(MainId, MainSet, !Partitions),
+
+ map.lookup(!.Partitions, Id, Set0),
+ set.insert(Set0, Item, Set),
+ svmap.det_update(Id, Set, !Partitions),
+
+ svmap.det_update(Item, Id, !Keys)
+ )
+ ;
+ counter.allocate(NewId, !Counter),
+ svmap.det_insert(Value, NewId, !Map),
+
+ map.lookup(!.Partitions, MainId, MainSet0),
+ set.delete(MainSet0, Item, MainSet),
+ svmap.det_update(MainId, MainSet, !Partitions),
+
+ Set = set.make_singleton_set(Item),
+ svmap.det_insert(NewId, Set, !Partitions),
+
+ svmap.det_update(Item, NewId, !Keys)
).
Index: library/multi_map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/multi_map.m,v
retrieving revision 1.20
diff -u -b -r1.20 multi_map.m
--- library/multi_map.m 7 Mar 2006 22:23:46 -0000 1.20
+++ library/multi_map.m 11 Mar 2006 11:47:19 -0000
@@ -121,7 +121,7 @@
:- pred multi_map.keys(multi_map(K, _V)::in, list(K)::out) is det.
% Given a multi_map, return a list of all the data values in the
- % multi_map
+ % multi_map.
%
:- func multi_map.values(multi_map(_K, V)) = list(V).
:- pred multi_map.values(multi_map(_K, V)::in, list(V)::out) is det.
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list