[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