[m-rev.] diff: turn tree_bitset integrity checking code into trace goals

[Julien Fischer]

Estimated hour taken: 0.4
Branches: main

Turn the commented-out integrity checking code for tree_bitsets into
trace goals with a compile time condition.

library/tree_bitset.m:
 	Make the above change.

Julien.

Index: library/tree_bitset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree_bitset.m,v
retrieving revision 1.2
diff -u -r1.2 tree_bitset.m
--- library/tree_bitset.m	27 Dec 2006 03:59:28 -0000	1.2
+++ library/tree_bitset.m	12 Oct 2007 04:50:02 -0000
@@ -500,24 +500,22 @@
  % here thus guarantees that we never return any malformed tree_bitsets.
  %
  % If you want to use the integrity checking version of wrap_tree_bitset,
-% you'll probably also want to use the integrity checking version of equal,
-% and enable the integrity checking code in expand_range. Search for the
-% keyword CHECK_INTEGRITY.
+% then you will need to compile this module with the following flag:
+%           --trace-flag="tree-bitset-integrity"

  :- func wrap_tree_bitset(node_list) = tree_bitset(T).
  :- pragma inline(wrap_tree_bitset/1).

  wrap_tree_bitset(NodeList) = Set :-
+    trace [compile_time(flag("tree-bitset-interity"))] (
+        ( integrity(no, NodeList) = no -> 
+            error("wrap_tree_bitset: integrity failed")
+        ;
+            true
+        )
+    ),
      Set = tree_bitset(NodeList).

-% CHECK_INTEGRITY
-% wrap_tree_bitset(NodeList) = Set :-
-%     ( integrity(no, NodeList) = no ->
-%         error("wrap_tree_bitset: integrity failed")
-%     ;
-%         Set = tree_bitset(NodeList)
-%     ).
-
  :- func integrity(maybe(pair(int)), node_list) = bool.

  integrity(MaybeBounds, NodeList) = OK :-
@@ -683,17 +681,19 @@

  expand_range(Index, SubNodes, CurLevel, CurInitOffset, CurLimitOffset,
          TopNode, TopLevel) :-
-% CHECK_INTEGRITY
-%   (
-%       Range = unchecked_left_shift(bits_per_int, CurLevel * bits_per_level),
-%       ( CurLimitOffset - CurInitOffset = Range ->
-%           true
-%       ;
-%           error("tree_bitset.m: expand_range: bad range for level")
-%       )
-%   ;
-%       true
-%   ),
+    trace [compile_time(flag("tree-bitset-integrity"))] (
+        (
+            Range = unchecked_left_shift(bits_per_int,
+                CurLevel * bits_per_level),
+            ( CurLimitOffset - CurInitOffset = Range ->
+                true
+            ; 
+                error("tree_bitset.m: expand_range: bad range for level")
+            )
+        ;
+            true
+        )
+    ),
      CurNode = interior_node(CurInitOffset, CurLimitOffset, SubNodes),
      range_of_parent_node(CurInitOffset, CurLevel,
          ParentInitOffset, ParentLimitOffset),
@@ -830,25 +830,23 @@
  empty(init).

  equal(SetA, SetB) :-
+    trace [compile_time(flag("tree-bitset-interity"))] (
+        (
+            ListA = to_sorted_list(SetA),
+            ListB = to_sorted_list(SetB),
+            (
+                 SetA = SetB
+            <=>
+                 ListA = ListB
+            )
+         ->
+             true
+        ;
+             error("tree_bitset.m: equal: set and list equality differ")
+        )
+    ),
      SetA = SetB.

-% CHECK_INTEGRITY
-% equal(SetA, SetB) :-
-%     (
-%         to_sorted_list(SetA, ListA),
-%         to_sorted_list(SetB, ListB),
-%         (
-%             SetA = SetB
-%         <=>
-%             ListA = ListB
-%         )
-%     ->
-%         true
-%     ;
-%         error("tree_bitset.m: equal: set and list equality differ")
-%     )
-%     SetA = SetB.
-
  %-----------------------------------------------------------------------------%

  to_sorted_list(Set) = foldr(list.cons, Set, []).

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------