[m-rev.] for review: higher order declarative debugging
Mark Brown
dougl at cs.mu.OZ.AU
Thu May 2 05:21:23 AEST 2002
This is for review by Zoltan. It occurred to me that it might be useful
to attach the diff between library/tree234.m and browser/tree234_cc.m,
since the latter is derived from the former. But that diff turns out
to be worse than useless, so I've left it out.
Cheers,
Mark.
Estimated hours taken: 10
Branches: main
Implement a committed choice version of 234-trees which uses
compare_representation instead of builtin compare. Use this to implement
the declarative debugger's oracle knowledge base, instead of the standard
library map. We do this because the keys used by the oracle may contain
non-canonical terms, which would cause a runtime abort if used as map
keys.
This completes the changes to the declarative debugger to support the
debugging of higher order code. (There is still a problem in that the
declarative debugger back end does not filter out external events for
higher order calls. But that is an unrelated problem, which I will
deal with separately.)
browser/tree234_cc.m:
The new sub-module of mdb, which implements the 234-trees.
browser/declarative_oracle.m:
Use the new module instead of library/map.m. Propagate the
effect of the calls to committed choice code.
browser/mdb.m:
Include the new module.
tests/debugger/declarative/Mmakefile:
Enable two old test cases, higher_order and ite_2, that now work
after this change. Add a new test case that tests closures
with some arguments applied.
tests/debugger/declarative/higher_order.exp:
tests/debugger/declarative/higher_order.inp:
tests/debugger/declarative/ite_2.exp:
tests/debugger/declarative/ite_2.inp:
Provide input and expected output for these tests.
tests/debugger/declarative/ho2.exp:
tests/debugger/declarative/ho2.inp:
tests/debugger/declarative/ho2.m:
New test case.
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.12
diff -u -r1.12 declarative_oracle.m
--- browser/declarative_oracle.m 30 Apr 2002 07:08:00 -0000 1.12
+++ browser/declarative_oracle.m 1 May 2002 18:37:48 -0000
@@ -64,12 +64,12 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module mdb__declarative_user, mdb__util.
-:- import_module bool, std_util, map, set, require.
+:- import_module mdb__declarative_user, mdb__tree234_cc, mdb__util.
+:- import_module bool, std_util, set, require.
query_oracle(Questions, Response, Oracle0, Oracle) -->
{ get_oracle_kb(Oracle0, KB0) },
- { list__filter_map(query_oracle_kb(KB0), Questions, Answers) },
+ { query_oracle_kb_list(KB0, Questions, Answers) },
(
{ Answers = [] }
->
@@ -154,26 +154,28 @@
% case that the user supplies a truth value for a
% "wrong answer" node.
%
- map(decl_atom, decl_truth),
+ decl_atom_map(decl_truth),
% Mapping from call atoms to their solution sets.
% The sets in this map are all complete---but they may
% contain wrong answers.
%
- map(decl_atom, set(decl_atom)),
+ decl_atom_map(set(decl_atom)),
% Mapping from call atoms to their solution sets.
% The sets in this map are all incomplete---there
% exists a correct solution which is not in the set.
%
- map(decl_atom, set(decl_atom)),
+ decl_atom_map(set(decl_atom)),
% Mapping from call atoms to information about which
% exceptions are possible or impossible.
%
- map(decl_atom, known_exceptions)
+ decl_atom_map(known_exceptions)
).
+:- type decl_atom_map(V) == tree234_cc(decl_atom, V).
+
:- type known_exceptions
---> known_excp(
set(univ), % Possible exceptions.
@@ -184,49 +186,49 @@
:- mode oracle_kb_init(out) is det.
oracle_kb_init(oracle_kb(G, Y, N, X)) :-
- map__init(G),
- map__init(Y),
- map__init(N),
- map__init(X).
+ tree234_cc__init(G),
+ tree234_cc__init(Y),
+ tree234_cc__init(N),
+ tree234_cc__init(X).
-:- pred get_kb_ground_map(oracle_kb, map(decl_atom, decl_truth)).
+:- pred get_kb_ground_map(oracle_kb, decl_atom_map(decl_truth)).
:- mode get_kb_ground_map(in, out) is det.
get_kb_ground_map(oracle_kb(Map, _, _, _), Map).
-:- pred set_kb_ground_map(oracle_kb, map(decl_atom, decl_truth), oracle_kb).
+:- pred set_kb_ground_map(oracle_kb, decl_atom_map(decl_truth), oracle_kb).
:- mode set_kb_ground_map(in, in, out) is det.
set_kb_ground_map(oracle_kb(_, Y, N, X), G, oracle_kb(G, Y, N, X)).
-:- pred get_kb_complete_map(oracle_kb, map(decl_atom, set(decl_atom))).
+:- pred get_kb_complete_map(oracle_kb, decl_atom_map(set(decl_atom))).
:- mode get_kb_complete_map(in, out) is det.
get_kb_complete_map(oracle_kb(_, Map, _, _), Map).
-:- pred set_kb_complete_map(oracle_kb, map(decl_atom, set(decl_atom)),
+:- pred set_kb_complete_map(oracle_kb, decl_atom_map(set(decl_atom)),
oracle_kb).
:- mode set_kb_complete_map(in, in, out) is det.
set_kb_complete_map(oracle_kb(G, _, N, X), Y, oracle_kb(G, Y, N, X)).
-:- pred get_kb_incomplete_map(oracle_kb, map(decl_atom, set(decl_atom))).
+:- pred get_kb_incomplete_map(oracle_kb, decl_atom_map(set(decl_atom))).
:- mode get_kb_incomplete_map(in, out) is det.
get_kb_incomplete_map(oracle_kb(_, _, Map, _), Map).
-:- pred set_kb_incomplete_map(oracle_kb, map(decl_atom, set(decl_atom)),
+:- pred set_kb_incomplete_map(oracle_kb, decl_atom_map(set(decl_atom)),
oracle_kb).
:- mode set_kb_incomplete_map(in, in, out) is det.
set_kb_incomplete_map(oracle_kb(G, Y, _, X), N, oracle_kb(G, Y, N, X)).
-:- pred get_kb_exceptions_map(oracle_kb, map(decl_atom, known_exceptions)).
+:- pred get_kb_exceptions_map(oracle_kb, decl_atom_map(known_exceptions)).
:- mode get_kb_exceptions_map(in, out) is det.
get_kb_exceptions_map(oracle_kb(_, _, _, Map), Map).
-:- pred set_kb_exceptions_map(oracle_kb, map(decl_atom, known_exceptions),
+:- pred set_kb_exceptions_map(oracle_kb, decl_atom_map(known_exceptions),
oracle_kb).
:- mode set_kb_exceptions_map(in, in, out) is det.
@@ -234,41 +236,85 @@
%-----------------------------------------------------------------------------%
-:- pred query_oracle_kb(oracle_kb, decl_question(T), decl_answer(T)).
-:- mode query_oracle_kb(in, in, out) is semidet.
+:- pred query_oracle_kb_list(oracle_kb, list(decl_question(T)),
+ list(decl_answer(T))).
+:- mode query_oracle_kb_list(in, in, out) is cc_multi.
+
+query_oracle_kb_list(_, [], []).
+query_oracle_kb_list(KB, [Q | Qs0], As) :-
+ query_oracle_kb_list(KB, Qs0, As0),
+ query_oracle_kb(KB, Q, MaybeA),
+ (
+ MaybeA = yes(A),
+ As = [A | As0]
+ ;
+ MaybeA = no,
+ As = As0
+ ).
+
+:- pred query_oracle_kb(oracle_kb, decl_question(T), maybe(decl_answer(T))).
+:- mode query_oracle_kb(in, in, out) is cc_multi.
-query_oracle_kb(KB, Question, truth_value(Node, Truth)) :-
+query_oracle_kb(KB, Question, Result) :-
Question = wrong_answer(Node, Atom),
get_kb_ground_map(KB, Map),
- map__search(Map, Atom, Truth).
+ tree234_cc__search(Map, Atom, MaybeTruth),
+ (
+ MaybeTruth = yes(Truth),
+ Result = yes(truth_value(Node, Truth))
+ ;
+ MaybeTruth = no,
+ Result = no
+ ).
-query_oracle_kb(KB, Question, truth_value(Node, Truth)) :-
+query_oracle_kb(KB, Question, Result) :-
Question = missing_answer(Node, Call, Solns),
set__list_to_set(Solns, Ss),
get_kb_complete_map(KB, CMap),
+ tree234_cc__search(CMap, Call, MaybeCSs),
(
- map__search(CMap, Call, CSs),
+ MaybeCSs = yes(CSs),
set__subset(CSs, Ss)
->
- Truth = yes
+ Result = yes(truth_value(Node, yes))
;
get_kb_incomplete_map(KB, IMap),
- map__search(IMap, Call, ISs),
- set__subset(Ss, ISs),
- Truth = no
+ tree234_cc__search(IMap, Call, MaybeISs),
+ (
+ MaybeISs = yes(ISs),
+ (
+ set__subset(Ss, ISs)
+ ->
+ Result = yes(truth_value(Node, no))
+ ;
+ Result = no
+ )
+ ;
+ MaybeISs = no,
+ Result = no
+ )
).
-query_oracle_kb(KB, Question, truth_value(Node, Truth)) :-
+query_oracle_kb(KB, Question, Result) :-
Question = unexpected_exception(Node, Call, Exception),
get_kb_exceptions_map(KB, XMap),
- map__search(XMap, Call, known_excp(Possible, Impossible)),
+ tree234_cc__search(XMap, Call, MaybeX),
(
- set__member(Exception, Possible)
- ->
- Truth = yes
+ MaybeX = no,
+ Result = no
;
- set__member(Exception, Impossible),
- Truth = no
+ MaybeX = yes(known_excp(Possible, Impossible)),
+ (
+ set__member(Exception, Possible)
+ ->
+ Result = yes(truth_value(Node, yes))
+ ;
+ set__member(Exception, Impossible)
+ ->
+ Result = yes(truth_value(Node, no))
+ ;
+ Result = no
+ )
).
% assert_oracle_kb/3 assumes that the asserted fact is consistent
@@ -278,30 +324,32 @@
%
:- pred assert_oracle_kb(decl_question(T), decl_answer(T), oracle_kb,
oracle_kb).
-:- mode assert_oracle_kb(in, in, in, out) is det.
+:- mode assert_oracle_kb(in, in, in, out) is cc_multi.
assert_oracle_kb(_, suspicious_subterm(_, _, _), KB, KB).
assert_oracle_kb(wrong_answer(_, Atom), truth_value(_, Truth), KB0, KB) :-
get_kb_ground_map(KB0, Map0),
- map__det_insert(Map0, Atom, Truth, Map),
+ tree234_cc__set(Map0, Atom, Truth, Map),
set_kb_ground_map(KB0, Map, KB).
assert_oracle_kb(missing_answer(_, Call, Solns), truth_value(_, yes),
KB0, KB) :-
get_kb_complete_map(KB0, Map0),
set__list_to_set(Solns, Ss0),
+ tree234_cc__search(Map0, Call, MaybeOldSs),
(
- map__search(Map0, Call, OldSs)
- ->
+ MaybeOldSs = yes(OldSs),
+ %
% The sets are both complete, so their
% intersection must be also.
%
- set__intersect(OldSs, Ss0, Ss),
- map__set(Map0, Call, Ss, Map)
+ set__intersect(OldSs, Ss0, Ss)
;
- map__det_insert(Map0, Call, Ss0, Map)
+ MaybeOldSs = no,
+ Ss = Ss0
),
+ tree234_cc__set(Map0, Call, Ss, Map),
set_kb_complete_map(KB0, Map, KB).
assert_oracle_kb(missing_answer(_, Call, Solns), truth_value(_, no), KB0, KB) :-
@@ -311,30 +359,29 @@
% XXX should also keep the old incomplete set around, too.
% It can still give us information that the new one can't.
%
- map__set(Map0, Call, Ss, Map),
+ tree234_cc__set(Map0, Call, Ss, Map),
set_kb_incomplete_map(KB0, Map, KB).
assert_oracle_kb(unexpected_exception(_, Call, Exception),
truth_value(_, Truth), KB0, KB) :-
get_kb_exceptions_map(KB0, Map0),
+ tree234_cc__search(Map0, Call, MaybeX),
(
- map__search(Map0, Call, known_excp(Possible0, Impossible0))
- ->
- Possible1 = Possible0,
- Impossible1 = Impossible0
+ MaybeX = yes(known_excp(Possible0, Impossible0))
;
- set__init(Possible1),
- set__init(Impossible1)
+ MaybeX = no,
+ set__init(Possible0),
+ set__init(Impossible0)
),
(
Truth = yes,
- set__insert(Possible1, Exception, Possible),
- Impossible = Impossible1
+ set__insert(Possible0, Exception, Possible),
+ Impossible = Impossible0
;
Truth = no,
- Possible = Possible1,
- set__insert(Impossible1, Exception, Impossible)
+ Possible = Possible0,
+ set__insert(Impossible0, Exception, Impossible)
),
- map__set(Map0, Call, known_excp(Possible, Impossible), Map),
+ tree234_cc__set(Map0, Call, known_excp(Possible, Impossible), Map),
set_kb_exceptions_map(KB0, Map, KB).
Index: browser/mdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/mdb.m,v
retrieving revision 1.5
diff -u -r1.5 mdb.m
--- browser/mdb.m 23 Feb 2001 04:14:41 -0000 1.5
+++ browser/mdb.m 1 May 2002 18:37:48 -0000
@@ -22,6 +22,7 @@
:- include_module frame, parse, util, sized_pretty.
:- include_module declarative_analyser, declarative_oracle, declarative_user.
+:- include_module tree234_cc.
% XXX these modules are more generally useful, but the
% dynamic linking library is not yet installed anywhere.
Index: browser/tree234_cc.m
===================================================================
RCS file: browser/tree234_cc.m
diff -N browser/tree234_cc.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ browser/tree234_cc.m 1 May 2002 18:37:54 -0000
@@ -0,0 +1,1167 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 1994-1997,1999-2000,2002 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+
+% tree234_cc implements a map (dictionary) using 2-3-4 trees. This is
+% a cut down version of the standard library module library/tree234.m,
+% with the additional change that it uses compare_representation instead
+% of the builtin unification and comparison predicates. It is thus able
+% to work with keys that contain non-canonical terms, such as higher order
+% terms.
+%
+% The drawback of using compare_representation is that sometimes entries
+% that have been inserted in the map will not later be found when looked
+% up. This can happen when the lookup uses a different (but equivalent)
+% representation of the key than the insertion. However, for some
+% applications (for example, the declarative debugging oracle) this
+% behaviour may be acceptable.
+%
+% A flow on effect is that most of the det predicates are now cc_multi,
+% since this is the determinism of compare_representation. Semidet
+% predicates, however, are now cc_multi. They return all outputs in a
+% maybe type, which indicates success or failure.
+%
+% main author: conway.
+% stability: medium.
+
+% Modified to use compare_representation by Mark Brown (dougl).
+
+% See library/map.m for documentation.
+
+%---------------------------------------------------------------------------%
+
+:- module mdb__tree234_cc.
+
+:- interface.
+
+:- import_module std_util.
+
+:- type tree234_cc(K, V).
+
+:- pred tree234_cc__init(tree234_cc(K, V)).
+:- mode tree234_cc__init(uo) is det.
+
+:- pred tree234_cc__is_empty(tree234_cc(K, V)).
+:- mode tree234_cc__is_empty(in) is semidet.
+
+:- pred tree234_cc__search(tree234_cc(K, V), K, maybe(V)).
+:- mode tree234_cc__search(in, in, out) is cc_multi.
+
+:- pred tree234_cc__set(tree234_cc(K, V), K, V, tree234_cc(K, V)).
+:- mode tree234_cc__set(in, in, in, out) is cc_multi.
+
+:- pred tree234_cc__delete(tree234_cc(K, V), K, tree234_cc(K, V)).
+:- mode tree234_cc__delete(in, in, out) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int, require, bool.
+
+:- type tree234_cc(K, V) --->
+ empty
+ ; two(K, V, tree234_cc(K, V), tree234_cc(K, V))
+ ; three(K, V, K, V, tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V))
+ ; four(K, V, K, V, K, V, tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), tree234_cc(K, V)).
+
+%------------------------------------------------------------------------------%
+
+tree234_cc__init(empty).
+
+tree234_cc__is_empty(Tree) :-
+ Tree = empty.
+
+%------------------------------------------------------------------------------%
+
+tree234_cc__search(T, K, MaybeV) :-
+ (
+ T = empty,
+ MaybeV = no
+ ;
+ T = two(K0, V0, T0, T1),
+ compare_representation(Result, K, K0),
+ (
+ Result = (<),
+ tree234_cc__search(T0, K, MaybeV)
+ ;
+ Result = (=),
+ MaybeV = yes(V0)
+ ;
+ Result = (>),
+ tree234_cc__search(T1, K, MaybeV)
+ )
+ ;
+ T = three(K0, V0, K1, V1, T0, T1, T2),
+ compare_representation(Result0, K, K0),
+ (
+ Result0 = (<),
+ tree234_cc__search(T0, K, MaybeV)
+ ;
+ Result0 = (=),
+ MaybeV = yes(V0)
+ ;
+ Result0 = (>),
+ compare_representation(Result1, K, K1),
+ (
+ Result1 = (<),
+ tree234_cc__search(T1, K, MaybeV)
+ ;
+ Result1 = (=),
+ MaybeV = yes(V1)
+ ;
+ Result1 = (>),
+ tree234_cc__search(T2, K, MaybeV)
+ )
+ )
+ ;
+ T = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ compare_representation(Result1, K, K1),
+ (
+ Result1 = (<),
+ compare_representation(Result0, K, K0),
+ (
+ Result0 = (<),
+ tree234_cc__search(T0, K, MaybeV)
+ ;
+ Result0 = (=),
+ MaybeV = yes(V0)
+ ;
+ Result0 = (>),
+ tree234_cc__search(T1, K, MaybeV)
+ )
+ ;
+ Result1 = (=),
+ MaybeV = yes(V1)
+ ;
+ Result1 = (>),
+ compare_representation(Result2, K, K2),
+ (
+ Result2 = (<),
+ tree234_cc__search(T2, K, MaybeV)
+ ;
+ Result2 = (=),
+ MaybeV = yes(V2)
+ ;
+ Result2 = (>),
+ tree234_cc__search(T3, K, MaybeV)
+ )
+ )
+ ).
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- inst two(K, V, T) =
+ bound(
+ two(K, V, T, T)
+ ).
+
+:- inst three(K, V, T) =
+ bound(
+ three(K, V, K, V, T, T, T)
+ ).
+
+:- inst four(K, V, T) =
+ bound(
+ four(K, V, K, V, K, V, T, T, T, T)
+ ).
+
+:- mode out_two :: out(two(ground, ground, ground)).
+
+:- mode in_two :: in(two(ground, ground, ground)).
+:- mode in_three :: in(three(ground, ground, ground)).
+:- mode in_four :: in(four(ground, ground, ground)).
+
+%------------------------------------------------------------------------------%
+
+:- pred tree234_cc__split_four(tree234_cc(K, V), K, V, tree234_cc(K, V),
+ tree234_cc(K, V)).
+:- mode tree234_cc__split_four(in_four, out, out, out_two, out_two) is det.
+
+tree234_cc__split_four(Tin, MidK, MidV, Sub0, Sub1) :-
+ Tin = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ Sub0 = two(K0, V0, T0, T1),
+ MidK = K1,
+ MidV = V1,
+ Sub1 = two(K2, V2, T2, T3).
+
+%------------------------------------------------------------------------------%
+
+% tree234_cc__set is implemented using the simple top-down approach
+% described in eg Sedgwick which splits 4 nodes into two 2 nodes on the
+% downward traversal of the tree as we search for the right place to
+% insert the new key-value pair. We know we have the right place if the
+% subtrees of the node are empty (in which case we expand the node - which
+% will always work because we already split 4 nodes into 2 nodes), or if
+% the tree itself is empty. This algorithm is O(lgN).
+
+tree234_cc__set(Tin, K, V, Tout) :-
+ (
+ Tin = empty,
+ Tout = two(K, V, empty, empty)
+ ;
+ Tin = two(_, _, _, _),
+ tree234_cc__set2(Tin, K, V, Tout)
+ ;
+ Tin = three(_, _, _, _, _, _, _),
+ tree234_cc__set3(Tin, K, V, Tout)
+ ;
+ Tin = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ compare_representation(Result1, K, K1),
+ (
+ Result1 = (<),
+ Sub0 = two(K0, V0, T0, T1),
+ Sub1 = two(K2, V2, T2, T3),
+ tree234_cc__set2(Sub0, K, V, NewSub0),
+ Tout = two(K1, V1, NewSub0, Sub1)
+ ;
+ Result1 = (=),
+ Tout = four(K0, V0, K1, V, K2, V2, T0, T1, T2, T3)
+ ;
+ Result1 = (>),
+ Sub0 = two(K0, V0, T0, T1),
+ Sub1 = two(K2, V2, T2, T3),
+ tree234_cc__set2(Sub1, K, V, NewSub1),
+ Tout = two(K1, V1, Sub0, NewSub1)
+ )
+ ).
+
+:- pred tree234_cc__set2(tree234_cc(K, V), K, V, tree234_cc(K, V)).
+:- mode tree234_cc__set2(in_two, in, in, out) is cc_multi.
+
+tree234_cc__set2(two(K0, V0, T0, T1), K, V, Tout) :-
+ (
+ T0 = empty
+ % T1 = empty implied by T0 = empty
+ ->
+ compare_representation(Result, K, K0),
+ (
+ Result = (<),
+ Tout = three(K, V, K0, V0, empty, empty, empty)
+ ;
+ Result = (=),
+ Tout = two(K, V, T0, T1)
+ ;
+ Result = (>),
+ Tout = three(K0, V0, K, V, empty, empty, empty)
+ )
+ ;
+ compare_representation(Result, K, K0),
+ (
+ Result = (<),
+ (
+ T0 = four(_, _, _, _, _, _, _, _, _, _),
+ tree234_cc__split_four(T0, MT0K, MT0V, T00,
+ T01),
+ compare_representation(Result1, K, MT0K),
+ (
+ Result1 = (<),
+ tree234_cc__set2(T00, K, V, NewT00),
+ Tout = three(MT0K, MT0V, K0, V0,
+ NewT00, T01, T1)
+ ;
+ Result1 = (=),
+ Tout = three(MT0K, V, K0, V0,
+ T00, T01, T1)
+ ;
+ Result1 = (>),
+ tree234_cc__set2(T01, K, V, NewT01),
+ Tout = three(MT0K, MT0V, K0, V0,
+ T00, NewT01, T1)
+ )
+ ;
+ T0 = three(_, _, _, _, _, _, _),
+ tree234_cc__set3(T0, K, V, NewT0),
+ Tout = two(K0, V0, NewT0, T1)
+ ;
+ T0 = two(_, _, _, _),
+ tree234_cc__set2(T0, K, V, NewT0),
+ Tout = two(K0, V0, NewT0, T1)
+ ;
+ T0 = empty,
+ NewT0 = two(K, V, empty, empty),
+ Tout = two(K0, V0, NewT0, T1)
+ )
+ ;
+ Result = (=),
+ Tout = two(K, V, T0, T1)
+ ;
+ Result = (>),
+ (
+ T1 = four(_, _, _, _, _, _, _, _, _, _),
+ tree234_cc__split_four(T1, MT1K, MT1V, T10,
+ T11),
+ compare_representation(Result1, K, MT1K),
+ (
+ Result1 = (<),
+ tree234_cc__set2(T10, K, V, NewT10),
+ Tout = three(K0, V0, MT1K, MT1V,
+ T0, NewT10, T11)
+ ;
+ Result1 = (=),
+ Tout = three(K0, V0, MT1K, V,
+ T0, T10, T11)
+ ;
+ Result1 = (>),
+ tree234_cc__set2(T11, K, V, NewT11),
+ Tout = three(K0, V0, MT1K, MT1V,
+ T0, T10, NewT11)
+ )
+ ;
+ T1 = three(_, _, _, _, _, _, _),
+ tree234_cc__set3(T1, K, V, NewT1),
+ Tout = two(K0, V0, T0, NewT1)
+ ;
+ T1 = two(_, _, _, _),
+ tree234_cc__set2(T1, K, V, NewT1),
+ Tout = two(K0, V0, T0, NewT1)
+ ;
+ T1 = empty,
+ NewT1 = two(K, V, empty, empty),
+ Tout = two(K0, V0, T0, NewT1)
+ )
+ )
+ ).
+
+:- pred tree234_cc__set3(tree234_cc(K, V), K, V, tree234_cc(K, V)).
+:- mode tree234_cc__set3(in_three, in, in, out) is cc_multi.
+
+tree234_cc__set3(three(K0, V0, K1, V1, T0, T1, T2), K, V, Tout) :-
+ (
+ T0 = empty
+ % T1 = empty implied by T0 = empty
+ % T2 = empty implied by T0 = empty
+ ->
+ compare_representation(Result0, K, K0),
+ (
+ Result0 = (<),
+ Tout = four(K, V, K0, V0, K1, V1,
+ empty, empty, empty, empty)
+ ;
+ Result0 = (=),
+ Tout = three(K0, V, K1, V1,
+ empty, empty, empty)
+ ;
+ Result0 = (>),
+ compare_representation(Result1, K, K1),
+ (
+ Result1 = (<),
+ Tout = four(K0, V0, K, V, K1, V1,
+ empty, empty, empty, empty)
+ ;
+ Result1 = (=),
+ Tout = three(K0, V0, K1, V,
+ empty, empty, empty)
+ ;
+ Result1 = (>),
+ Tout = four(K0, V0, K1, V1, K, V,
+ empty, empty, empty, empty)
+ )
+ )
+ ;
+ compare_representation(Result0, K, K0),
+ (
+ Result0 = (<),
+ (
+ T0 = four(_, _, _, _, _, _, _, _, _, _),
+ tree234_cc__split_four(T0, MT0K, MT0V, T00,
+ T01),
+ compare_representation(ResultM, K, MT0K),
+ (
+ ResultM = (<),
+ tree234_cc__set2(T00, K, V, NewT00),
+ Tout = four(MT0K, MT0V, K0, V0, K1, V1,
+ NewT00, T01, T1, T2)
+ ;
+ ResultM = (=),
+ Tout = four(MT0K, V, K0, V0, K1, V1,
+ T00, T01, T1, T2)
+ ;
+ ResultM = (>),
+ tree234_cc__set2(T01, K, V, NewT01),
+ Tout = four(MT0K, MT0V, K0, V0, K1, V1,
+ T00, NewT01, T1, T2)
+ )
+ ;
+ T0 = three(_, _, _, _, _, _, _),
+ tree234_cc__set3(T0, K, V, NewT0),
+ Tout = three(K0, V0, K1, V1, NewT0, T1, T2)
+ ;
+ T0 = two(_, _, _, _),
+ tree234_cc__set2(T0, K, V, NewT0),
+ Tout = three(K0, V0, K1, V1, NewT0, T1, T2)
+ ;
+ T0 = empty,
+ NewT0 = two(K, V, empty, empty),
+ Tout = three(K0, V0, K1, V1, NewT0, T1, T2)
+ )
+ ;
+ Result0 = (=),
+ Tout = three(K0, V, K1, V1, T0, T1, T2)
+ ;
+ Result0 = (>),
+ compare_representation(Result1, K, K1),
+ (
+ Result1 = (<),
+ (
+ T1 = four(_, _, _, _, _, _, _, _, _, _),
+ tree234_cc__split_four(T1, MT1K, MT1V,
+ T10, T11),
+ compare_representation(ResultM, K,
+ MT1K),
+ (
+ ResultM = (<),
+ tree234_cc__set2(T10, K, V,
+ NewT10),
+ Tout = four(K0, V0, MT1K, MT1V,
+ K1, V1,
+ T0, NewT10, T11, T2)
+ ;
+ ResultM = (=),
+ Tout = four(K0, V0, MT1K, V,
+ K1, V1,
+ T0, T10, T11, T2)
+ ;
+ ResultM = (>),
+ tree234_cc__set2(T11, K, V,
+ NewT11),
+ Tout = four(K0, V0, MT1K, MT1V,
+ K1, V1,
+ T0, T10, NewT11, T2)
+ )
+ ;
+ T1 = three(_, _, _, _, _, _, _),
+ tree234_cc__set3(T1, K, V, NewT1),
+ Tout = three(K0, V0, K1, V1,
+ T0, NewT1, T2)
+ ;
+ T1 = two(_, _, _, _),
+ tree234_cc__set2(T1, K, V, NewT1),
+ Tout = three(K0, V0, K1, V1,
+ T0, NewT1, T2)
+ ;
+ T1 = empty,
+ NewT1 = two(K, V, empty, empty),
+ Tout = three(K0, V0, K1, V1,
+ T0, NewT1, T2)
+ )
+ ;
+ Result1 = (=),
+ Tout = three(K0, V0, K, V, T0, T1, T2)
+ ;
+ Result1 = (>),
+ (
+ T2 = four(_, _, _, _, _, _, _, _, _, _),
+ tree234_cc__split_four(T2, MT2K, MT2V,
+ T20, T21),
+ compare_representation(ResultM, K,
+ MT2K),
+ (
+ ResultM = (<),
+ tree234_cc__set2(T20, K, V,
+ NewT20),
+ Tout = four(K0, V0, K1, V1,
+ MT2K, MT2V,
+ T0, T1, NewT20, T21)
+ ;
+ ResultM = (=),
+ Tout = four(K0, V0, K1, V1,
+ MT2K, V,
+ T0, T1, T20, T21)
+ ;
+ ResultM = (>),
+ tree234_cc__set2(T21, K, V,
+ NewT21),
+ Tout = four(K0, V0, K1, V1,
+ MT2K, MT2V,
+ T0, T1, T20, NewT21)
+ )
+ ;
+ T2 = three(_, _, _, _, _, _, _),
+ tree234_cc__set3(T2, K, V, NewT2),
+ Tout = three(K0, V0, K1, V1,
+ T0, T1, NewT2)
+ ;
+ T2 = two(_, _, _, _),
+ tree234_cc__set2(T2, K, V, NewT2),
+ Tout = three(K0, V0, K1, V1,
+ T0, T1, NewT2)
+ ;
+ T2 = empty,
+ NewT2 = two(K, V, empty, empty),
+ Tout = three(K0, V0, K1, V1,
+ T0, T1, NewT2)
+ )
+ )
+ )
+ ).
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+tree234_cc__delete(Tin, K, Tout) :-
+ tree234_cc__delete_2(Tin, K, Tout, _).
+
+ % When deleting an item from a tree, the height of the tree may be
+ % reduced by one. The last argument says whether this has occurred.
+
+:- pred tree234_cc__delete_2(tree234_cc(K, V), K, tree234_cc(K, V), bool).
+:- mode tree234_cc__delete_2(in, in, out, out) is cc_multi.
+
+tree234_cc__delete_2(Tin, K, Tout, RH) :-
+ (
+ Tin = empty,
+ Tout = empty,
+ RH = no
+ ;
+ Tin = two(K0, V0, T0, T1),
+ compare_representation(Result0, K, K0),
+ (
+ Result0 = (<),
+ tree234_cc__delete_2(T0, K, NewT0, RHT0),
+ ( RHT0 = yes ->
+ fix_2node_t0(K0, V0, NewT0, T1, Tout, RH)
+ ;
+ Tout = two(K0, V0, NewT0, T1),
+ RH = no
+ )
+ ;
+ Result0 = (=),
+ tree234_cc__remove_smallest(T1, Removed),
+ (
+ Removed = yes({ST1K, ST1V, NewT1, RHT1}),
+ ( RHT1 = yes ->
+ fix_2node_t1(ST1K, ST1V, T0, NewT1,
+ Tout, RH)
+ ;
+ Tout = two(ST1K, ST1V, T0, NewT1),
+ RH = no
+ )
+ ;
+ Removed = no,
+ % T1 must be empty
+ Tout = T0,
+ RH = yes
+ )
+ ;
+ Result0 = (>),
+ tree234_cc__delete_2(T1, K, NewT1, RHT1),
+ ( RHT1 = yes ->
+ fix_2node_t1(K0, V0, T0, NewT1, Tout, RH)
+ ;
+ Tout = two(K0, V0, T0, NewT1),
+ RH = no
+ )
+ )
+ ;
+ Tin = three(K0, V0, K1, V1, T0, T1, T2),
+ compare_representation(Result0, K, K0),
+ (
+ Result0 = (<),
+ tree234_cc__delete_2(T0, K, NewT0, RHT0),
+ ( RHT0 = yes ->
+ fix_3node_t0(K0, V0, K1, V1, NewT0, T1, T2,
+ Tout, RH)
+ ;
+ Tout = three(K0, V0, K1, V1, NewT0, T1, T2),
+ RH = no
+ )
+ ;
+ Result0 = (=),
+ tree234_cc__remove_smallest(T1, Removed),
+ (
+ Removed = yes({ST1K, ST1V, NewT1, RHT1}),
+ ( RHT1 = yes ->
+ fix_3node_t1(ST1K, ST1V, K1, V1,
+ T0, NewT1, T2, Tout, RH)
+ ;
+ Tout = three(ST1K, ST1V, K1, V1,
+ T0, NewT1, T2),
+ RH = no
+ )
+ ;
+ Removed = no,
+ % T1 must be empty
+ Tout = two(K1, V1, T0, T2),
+ RH = no
+ )
+ ;
+ Result0 = (>),
+ compare_representation(Result1, K, K1),
+ (
+ Result1 = (<),
+ tree234_cc__delete_2(T1, K, NewT1, RHT1),
+ ( RHT1 = yes ->
+ fix_3node_t1(K0, V0, K1, V1,
+ T0, NewT1, T2, Tout, RH)
+ ;
+ Tout = three(K0, V0, K1, V1,
+ T0, NewT1, T2),
+ RH = no
+ )
+ ;
+ Result1 = (=),
+ tree234_cc__remove_smallest(T2, Removed),
+ (
+ Removed = yes({ST2K, ST2V, NewT2,
+ RHT2}),
+ ( RHT2 = yes ->
+ fix_3node_t2(K0, V0, ST2K, ST2V,
+ T0, T1, NewT2, Tout, RH)
+ ;
+ Tout = three(K0, V0, ST2K, ST2V,
+ T0, T1, NewT2),
+ RH = no
+ )
+ ;
+ Removed = no,
+ % T2 must be empty
+ Tout = two(K0, V0, T0, T1),
+ RH = no
+ )
+ ;
+ Result1 = (>),
+ tree234_cc__delete_2(T2, K, NewT2, RHT2),
+ ( RHT2 = yes ->
+ fix_3node_t2(K0, V0, K1, V1,
+ T0, T1, NewT2, Tout, RH)
+ ;
+ Tout = three(K0, V0, K1, V1,
+ T0, T1, NewT2),
+ RH = no
+ )
+ )
+ )
+ ;
+ Tin = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ compare_representation(Result1, K, K1),
+ (
+ Result1 = (<),
+ compare_representation(Result0, K, K0),
+ (
+ Result0 = (<),
+ tree234_cc__delete_2(T0, K, NewT0, RHT0),
+ ( RHT0 = yes ->
+ fix_4node_t0(K0, V0, K1, V1, K2, V2,
+ NewT0, T1, T2, T3, Tout, RH)
+ ;
+ Tout = four(K0, V0, K1, V1, K2, V2,
+ NewT0, T1, T2, T3),
+ RH = no
+ )
+ ;
+ Result0 = (=),
+ tree234_cc__remove_smallest(T1, Removed),
+ (
+ Removed = yes({ST1K, ST1V, NewT1,
+ RHT1}),
+ ( RHT1 = yes ->
+ fix_4node_t1(ST1K, ST1V, K1, V1,
+ K2, V2,
+ T0, NewT1, T2, T3,
+ Tout, RH)
+ ;
+ Tout = four(ST1K, ST1V, K1, V1,
+ K2, V2,
+ T0, NewT1, T2, T3),
+ RH = no
+ )
+ ;
+ Removed = no,
+ % T1 must be empty
+ Tout = three(K1, V1, K2, V2,
+ T0, T2, T3),
+ RH = no
+ )
+ ;
+ Result0 = (>),
+ tree234_cc__delete_2(T1, K, NewT1, RHT1),
+ ( RHT1 = yes ->
+ fix_4node_t1(K0, V0, K1, V1, K2, V2,
+ T0, NewT1, T2, T3, Tout, RH)
+ ;
+ Tout = four(K0, V0, K1, V1, K2, V2,
+ T0, NewT1, T2, T3),
+ RH = no
+ )
+ )
+ ;
+ Result1 = (=),
+ tree234_cc__remove_smallest(T2, Removed),
+ (
+ Removed = yes({ST2K, ST2V, NewT2, RHT2}),
+ ( RHT2 = yes ->
+ fix_4node_t2(K0, V0, ST2K, ST2V, K2, V2,
+ T0, T1, NewT2, T3, Tout, RH)
+ ;
+ Tout = four(K0, V0, ST2K, ST2V, K2, V2,
+ T0, T1, NewT2, T3),
+ RH = no
+ )
+ ;
+ Removed = no,
+ % T2 must be empty
+ Tout = three(K0, V0, K2, V2, T0, T1, T3),
+ RH = no
+ )
+ ;
+ Result1 = (>),
+ compare_representation(Result2, K, K2),
+ (
+ Result2 = (<),
+ tree234_cc__delete_2(T2, K, NewT2, RHT2),
+ ( RHT2 = yes ->
+ fix_4node_t2(K0, V0, K1, V1, K2, V2,
+ T0, T1, NewT2, T3, Tout, RH)
+ ;
+ Tout = four(K0, V0, K1, V1, K2, V2,
+ T0, T1, NewT2, T3),
+ RH = no
+ )
+ ;
+ Result2 = (=),
+ tree234_cc__remove_smallest(T3, Removed),
+ (
+ Removed = yes({ST3K, ST3V, NewT3,
+ RHT3}),
+ ( RHT3 = yes ->
+ fix_4node_t3(K0, V0, K1, V1,
+ ST3K, ST3V,
+ T0, T1, T2, NewT3,
+ Tout, RH)
+ ;
+ Tout = four(K0, V0, K1, V1,
+ ST3K, ST3V,
+ T0, T1, T2, NewT3),
+ RH = no
+ )
+ ;
+ Removed = no,
+ % T3 must be empty
+ Tout = three(K0, V0, K1, V1,
+ T0, T1, T2),
+ RH = no
+ )
+ ;
+ Result2 = (>),
+ tree234_cc__delete_2(T3, K, NewT3, RHT3),
+ ( RHT3 = yes ->
+ fix_4node_t3(K0, V0, K1, V1, K2, V2,
+ T0, T1, T2, NewT3, Tout, RH)
+ ;
+ Tout = four(K0, V0, K1, V1, K2, V2,
+ T0, T1, T2, NewT3),
+ RH = no
+ )
+ )
+ )
+ ).
+
+%------------------------------------------------------------------------------%
+
+ % The algorithm we use similar to tree234_cc__delete, except that we
+ % always go down the left subtree.
+
+:- pred tree234_cc__remove_smallest(tree234_cc(K, V),
+ maybe({K, V, tree234_cc(K, V), bool})).
+:- mode tree234_cc__remove_smallest(in, out) is cc_multi.
+
+tree234_cc__remove_smallest(Tin, Result) :-
+ (
+ Tin = empty,
+ Result = no
+ ;
+ Tin = two(K0, V0, T0, T1),
+ (
+ T0 = empty
+ ->
+ K = K0,
+ V = V0,
+ Tout = T1,
+ RH = yes
+ ;
+ tree234_cc__remove_smallest(T0, Removed),
+ (
+ Removed = no,
+ error("remove_smallest: failure two")
+ ;
+ Removed = yes({K, V, NewT0, RHT0})
+ ),
+ ( RHT0 = yes ->
+ fix_2node_t0(K0, V0, NewT0, T1, Tout,
+ RH)
+ ;
+ Tout = two(K0, V0, NewT0, T1),
+ RH = no
+ )
+ ),
+ Result = yes({K, V, Tout, RH})
+ ;
+ Tin = three(K0, V0, K1, V1, T0, T1, T2),
+ (
+ T0 = empty
+ ->
+ K = K0,
+ V = V0,
+ Tout = two(K1, V1, T1, T2),
+ RH = no
+ ;
+ tree234_cc__remove_smallest(T0, ThreeResult),
+ (
+ ThreeResult = no,
+ error("remove_smallest: failure three")
+ ;
+ ThreeResult = yes({K, V, NewT0, RHT0})
+ ),
+ ( RHT0 = yes ->
+ fix_3node_t0(K0, V0, K1, V1, NewT0, T1,
+ T2, Tout, RH)
+ ;
+ Tout = three(K0, V0, K1, V1,
+ NewT0, T1, T2),
+ RH = no
+ )
+ ),
+ Result = yes({K, V, Tout, RH})
+ ;
+ Tin = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ (
+ T0 = empty
+ ->
+ K = K0,
+ V = V0,
+ Tout = three(K1, V1, K2, V2, T1, T2, T3),
+ RH = no
+ ;
+ tree234_cc__remove_smallest(T0, FourResult),
+ (
+ FourResult = no,
+ error("remove_smallest: failure four")
+ ;
+ FourResult = yes({K, V, NewT0, RHT0})
+ ),
+ ( RHT0 = yes ->
+ fix_4node_t0(K0, V0, K1, V1, K2, V2,
+ NewT0, T1, T2, T3, Tout, RH)
+ ;
+ Tout = four(K0, V0, K1, V1, K2, V2,
+ NewT0, T1, T2, T3),
+ RH = no
+ )
+ ),
+ Result = yes({K, V, Tout, RH})
+ ).
+
+%------------------------------------------------------------------------------%
+
+ % The input to the following group of predicates are the components
+ % of a two-, three- or four-node in which the height of the indicated
+ % subtree is one less that it should be. If it is possible to increase
+ % the height of that subtree by moving into it elements from its
+ % neighboring subtrees, do so, and return the resulting tree with RH
+ % set to no. Otherwise, return a balanced tree whose height is reduced
+ % by one, with RH set to yes to indicate the reduced height.
+
+:- pred fix_2node_t0(K, V, tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_2node_t0(in, in, in, in, out, out) is det.
+
+fix_2node_t0(K0, V0, T0, T1, Tout, RH) :-
+ (
+ % steal T1's leftmost subtree and combine it with T0
+ T1 = four(K10, V10, K11, V11, K12, V12, T10, T11, T12, T13),
+ NewT1 = three(K11, V11, K12, V12, T11, T12, T13),
+ Node = two(K0, V0, T0, T10),
+ Tout = two(K10, V10, Node, NewT1),
+ RH = no
+ ;
+ % steal T1's leftmost subtree and combine it with T0
+ T1 = three(K10, V10, K11, V11, T10, T11, T12),
+ NewT1 = two(K11, V11, T11, T12),
+ Node = two(K0, V0, T0, T10),
+ Tout = two(K10, V10, Node, NewT1),
+ RH = no
+ ;
+ % move T0 one level down and combine it with the subtrees of T1
+ % this reduces the depth of the tree
+ T1 = two(K10, V10, T10, T11),
+ Tout = three(K0, V0, K10, V10, T0, T10, T11),
+ RH = yes
+ ;
+ T1 = empty,
+ error("unbalanced 234 tree")
+ % Tout = two(K0, V0, T0, T1),
+ % RH = yes
+ ).
+
+:- pred fix_2node_t1(K, V, tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V), bool).
+:- mode fix_2node_t1(in, in, in, in, out, out) is det.
+
+fix_2node_t1(K0, V0, T0, T1, Tout, RH) :-
+ (
+ % steal T0's leftmost subtree and combine it with T1
+ T0 = four(K00, V00, K01, V01, K02, V02, T00, T01, T02, T03),
+ NewT0 = three(K00, V00, K01, V01, T00, T01, T02),
+ Node = two(K0, V0, T03, T1),
+ Tout = two(K02, V02, NewT0, Node),
+ RH = no
+ ;
+ % steal T0's leftmost subtree and combine it with T1
+ T0 = three(K00, V00, K01, V01, T00, T01, T02),
+ NewT0 = two(K00, V00, T00, T01),
+ Node = two(K0, V0, T02, T1),
+ Tout = two(K01, V01, NewT0, Node),
+ RH = no
+ ;
+ % move T1 one level down and combine it with the subtrees of T0
+ % this reduces the depth of the tree
+ T0 = two(K00, V00, T00, T01),
+ Tout = three(K00, V00, K0, V0, T00, T01, T1),
+ RH = yes
+ ;
+ T0 = empty,
+ error("unbalanced 234 tree")
+ % Tout = two(K0, V0, T0, T1),
+ % RH = yes
+ ).
+
+:- pred fix_3node_t0(K, V, K, V, tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_3node_t0(in, in, in, in, in, in, in, out, out) is det.
+
+fix_3node_t0(K0, V0, K1, V1, T0, T1, T2, Tout, RH) :-
+ (
+ % steal T1's leftmost subtree and combine it with T0
+ T1 = four(K10, V10, K11, V11, K12, V12, T10, T11, T12, T13),
+ NewT1 = three(K11, V11, K12, V12, T11, T12, T13),
+ Node = two(K0, V0, T0, T10),
+ Tout = three(K10, V10, K1, V1, Node, NewT1, T2),
+ RH = no
+ ;
+ % steal T1's leftmost subtree and combine it with T0
+ T1 = three(K10, V10, K11, V11, T10, T11, T12),
+ NewT1 = two(K11, V11, T11, T12),
+ Node = two(K0, V0, T0, T10),
+ Tout = three(K10, V10, K1, V1, Node, NewT1, T2),
+ RH = no
+ ;
+ % move T0 one level down to become the leftmost subtree of T1
+ T1 = two(K10, V10, T10, T11),
+ NewT1 = three(K0, V0, K10, V10, T0, T10, T11),
+ Tout = two(K1, V1, NewT1, T2),
+ RH = no
+ ;
+ T1 = empty,
+ error("unbalanced 234 tree")
+ % Tout = three(K0, V0, K1, V1, T0, T1, T2),
+ % The heights of T1 and T2 are unchanged
+ % RH = no
+ ).
+
+:- pred fix_3node_t1(K, V, K, V, tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_3node_t1(in, in, in, in, in, in, in, out, out) is det.
+
+fix_3node_t1(K0, V0, K1, V1, T0, T1, T2, Tout, RH) :-
+ (
+ % steal T0's rightmost subtree and combine it with T1
+ T0 = four(K00, V00, K01, V01, K02, V02, T00, T01, T02, T03),
+ NewT0 = three(K00, V00, K01, V01, T00, T01, T02),
+ Node = two(K0, V0, T03, T1),
+ Tout = three(K02, V02, K1, V1, NewT0, Node, T2),
+ RH = no
+ ;
+ % steal T0's rightmost subtree and combine it with T1
+ T0 = three(K00, V00, K01, V01, T00, T01, T02),
+ NewT0 = two(K00, V00, T00, T01),
+ Node = two(K0, V0, T02, T1),
+ Tout = three(K01, V01, K1, V1, NewT0, Node, T2),
+ RH = no
+ ;
+ % move T1 one level down to become the rightmost subtree of T0
+ T0 = two(K00, V00, T00, T01),
+ NewT0 = three(K00, V00, K0, V0, T00, T01, T1),
+ Tout = two(K1, V1, NewT0, T2),
+ RH = no
+ ;
+ T0 = empty,
+ error("unbalanced 234 tree")
+ % Tout = three(K0, V0, K1, V1, T0, T1, T2),
+ % The heights of T0 and T2 are unchanged
+ % RH = no
+ ).
+
+:- pred fix_3node_t2(K, V, K, V, tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_3node_t2(in, in, in, in, in, in, in, out, out) is det.
+
+fix_3node_t2(K0, V0, K1, V1, T0, T1, T2, Tout, RH) :-
+ (
+ % steal T1's rightmost subtree and combine it with T2
+ T1 = four(K10, V10, K11, V11, K12, V12, T10, T11, T12, T13),
+ NewT1 = three(K10, V10, K11, V11, T10, T11, T12),
+ Node = two(K1, V1, T13, T2),
+ Tout = three(K0, V0, K12, V12, T0, NewT1, Node),
+ RH = no
+ ;
+ % steal T1's rightmost subtree and combine it with T2
+ T1 = three(K10, V10, K11, V11, T10, T11, T12),
+ NewT1 = two(K10, V10, T10, T11),
+ Node = two(K1, V1, T12, T2),
+ Tout = three(K0, V0, K11, V11, T0, NewT1, Node),
+ RH = no
+ ;
+ % move T2 one level down to become the rightmost subtree of T1
+ T1 = two(K10, V10, T10, T11),
+ NewT1 = three(K10, V10, K1, V1, T10, T11, T2),
+ Tout = two(K0, V0, T0, NewT1),
+ RH = no
+ ;
+ T1 = empty,
+ error("unbalanced 234 tree")
+ % Tout = three(K0, V0, K1, V1, T0, T1, T2),
+ % The heights of T0 and T1 are unchanged
+ % RH = no
+ ).
+
+:- pred fix_4node_t0(K, V, K, V, K, V,
+ tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_4node_t0(in, in, in, in, in, in, in, in, in, in, out, out) is det.
+
+fix_4node_t0(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3, Tout, RH) :-
+ (
+ % steal T1's leftmost subtree and combine it with T0
+ T1 = four(K10, V10, K11, V11, K12, V12, T10, T11, T12, T13),
+ NewT1 = three(K11, V11, K12, V12, T11, T12, T13),
+ Node = two(K0, V0, T0, T10),
+ Tout = four(K10, V10, K1, V1, K2, V2, Node, NewT1, T2, T3),
+ RH = no
+ ;
+ % steal T1's leftmost subtree and combine it with T0
+ T1 = three(K10, V10, K11, V11, T10, T11, T12),
+ NewT1 = two(K11, V11, T11, T12),
+ Node = two(K0, V0, T0, T10),
+ Tout = four(K10, V10, K1, V1, K2, V2, Node, NewT1, T2, T3),
+ RH = no
+ ;
+ % move T0 one level down to become the leftmost subtree of T1
+ T1 = two(K10, V10, T10, T11),
+ NewT1 = three(K0, V0, K10, V10, T0, T10, T11),
+ Tout = three(K1, V1, K2, V2, NewT1, T2, T3),
+ RH = no
+ ;
+ T1 = empty,
+ error("unbalanced 234 tree")
+ % Tout = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ % The heights of T1, T2 and T3 are unchanged
+ % RH = no
+ ).
+
+:- pred fix_4node_t1(K, V, K, V, K, V,
+ tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_4node_t1(in, in, in, in, in, in, in, in, in, in, out, out) is det.
+
+fix_4node_t1(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3, Tout, RH) :-
+ (
+ % steal T2's leftmost subtree and combine it with T1
+ T2 = four(K20, V20, K21, V21, K22, V22, T20, T21, T22, T23),
+ NewT2 = three(K21, V21, K22, V22, T21, T22, T23),
+ Node = two(K1, V1, T1, T20),
+ Tout = four(K0, V0, K20, V20, K2, V2, T0, Node, NewT2, T3),
+ RH = no
+ ;
+ % steal T2's leftmost subtree and combine it with T1
+ T2 = three(K20, V20, K21, V21, T20, T21, T22),
+ NewT2 = two(K21, V21, T21, T22),
+ Node = two(K1, V1, T1, T20),
+ Tout = four(K0, V0, K20, V20, K2, V2, T0, Node, NewT2, T3),
+ RH = no
+ ;
+ % move T1 one level down to become the leftmost subtree of T2
+ T2 = two(K20, V20, T20, T21),
+ NewT2 = three(K1, V1, K20, V20, T1, T20, T21),
+ Tout = three(K0, V0, K2, V2, T0, NewT2, T3),
+ RH = no
+ ;
+ T2 = empty,
+ error("unbalanced 234 tree")
+ % Tout = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ % The heights of T0, T2 and T3 are unchanged
+ % RH = no
+ ).
+
+:- pred fix_4node_t2(K, V, K, V, K, V,
+ tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_4node_t2(in, in, in, in, in, in, in, in, in, in, out, out) is det.
+
+fix_4node_t2(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3, Tout, RH) :-
+ (
+ % steal T3's leftmost subtree and combine it with T2
+ T3 = four(K30, V30, K31, V31, K32, V32, T30, T31, T32, T33),
+ NewT3 = three(K31, V31, K32, V32, T31, T32, T33),
+ Node = two(K2, V2, T2, T30),
+ Tout = four(K0, V0, K1, V1, K30, V30, T0, T1, Node, NewT3),
+ RH = no
+ ;
+ % steal T3's leftmost subtree and combine it with T2
+ T3 = three(K30, V30, K31, V31, T30, T31, T32),
+ NewT3 = two(K31, V31, T31, T32),
+ Node = two(K2, V2, T2, T30),
+ Tout = four(K0, V0, K1, V1, K30, V30, T0, T1, Node, NewT3),
+ RH = no
+ ;
+ % move T2 one level down to become the leftmost subtree of T3
+ T3 = two(K30, V30, T30, T31),
+ NewT3 = three(K2, V2, K30, V30, T2, T30, T31),
+ Tout = three(K0, V0, K1, V1, T0, T1, NewT3),
+ RH = no
+ ;
+ T3 = empty,
+ error("unbalanced 234 tree")
+ % Tout = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ % The heights of T0, T1 and T3 are unchanged
+ % RH = no
+ ).
+
+:- pred fix_4node_t3(K, V, K, V, K, V,
+ tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V), tree234_cc(K, V),
+ tree234_cc(K, V), bool).
+:- mode fix_4node_t3(in, in, in, in, in, in, in, in, in, in, out, out) is det.
+
+fix_4node_t3(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3, Tout, RH) :-
+ (
+ % steal T2's rightmost subtree and combine it with T3
+ T2 = four(K20, V20, K21, V21, K22, V22, T20, T21, T22, T23),
+ NewT2 = three(K20, V20, K21, V21, T20, T21, T22),
+ Node = two(K2, V2, T23, T3),
+ Tout = four(K0, V0, K1, V1, K22, V22, T0, T1, NewT2, Node),
+ RH = no
+ ;
+ % steal T2's rightmost subtree and combine it with T3
+ T2 = three(K20, V20, K21, V21, T20, T21, T22),
+ NewT2 = two(K20, V20, T20, T21),
+ Node = two(K2, V2, T22, T3),
+ Tout = four(K0, V0, K1, V1, K21, V21, T0, T1, NewT2, Node),
+ RH = no
+ ;
+ % move T3 one level down to become the rightmost subtree of T2
+ T2 = two(K20, V20, T20, T21),
+ NewT2 = three(K20, V20, K2, V2, T20, T21, T3),
+ Tout = three(K0, V0, K1, V1, T0, T1, NewT2),
+ RH = no
+ ;
+ T2 = empty,
+ error("unbalanced 234 tree")
+ % Tout = four(K0, V0, K1, V1, K2, V2, T0, T1, T2, T3),
+ % The heights of T0, T1 and T2 are unchanged
+ % RH = no
+ ).
+
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.35
diff -u -r1.35 Mmakefile
--- tests/debugger/declarative/Mmakefile 30 Apr 2002 07:08:01 -0000 1.35
+++ tests/debugger/declarative/Mmakefile 1 May 2002 18:39:03 -0000
@@ -30,8 +30,11 @@
filter \
func_call \
gcf \
+ higher_order \
+ ho2 \
if_then_else \
input_term_dep \
+ ite_2 \
lpe_example \
neg_conj \
negation \
@@ -48,8 +51,6 @@
untraced_subgoal
NONWORKING_DECLARATIVE_PROGS= \
- higher_order \
- ite_2 \
solutions
MCFLAGS += --trace decl
@@ -147,6 +148,9 @@
higher_order.out: higher_order higher_order.inp
$(MDB) ./higher_order < higher_order.inp > higher_order.out 2>&1
+
+ho2.out: ho2 ho2.inp
+ $(MDB) ./ho2 < ho2.inp > ho2.out 2>&1
if_then_else.out: if_then_else if_then_else.inp
$(MDB) ./if_then_else < if_then_else.inp > if_then_else.out 2>&1
Index: tests/debugger/declarative/higher_order.exp
===================================================================
RCS file: tests/debugger/declarative/higher_order.exp
diff -N tests/debugger/declarative/higher_order.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/higher_order.exp 1 May 2002 18:39:03 -0000
@@ -0,0 +1,21 @@
+ 1: 1 1 CALL pred higher_order:main/2-0 (det) higher_order.m:8
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break p
+ 0: + stop interface pred higher_order:p/2-0 (det)
+mdb> continue
+ 2: 2 2 CALL pred higher_order:p/2-0 (det) higher_order.m:15 (higher_order.m:9)
+mdb> finish
+ 7: 2 2 EXIT pred higher_order:p/2-0 (det) higher_order.m:15 (higher_order.m:9)
+mdb> dd
+p(3, 81)
+Valid? no
+q('IntroducedFrom__pred__p__16__1', 3, 81)
+Valid? yes
+Found incorrect contour:
+p(3, 81)
+Is this a bug? yes
+ 7: 2 2 EXIT pred higher_order:p/2-0 (det) higher_order.m:15 (higher_order.m:9)
+mdb> continue
+81
Index: tests/debugger/declarative/higher_order.inp
===================================================================
RCS file: tests/debugger/declarative/higher_order.inp
diff -N tests/debugger/declarative/higher_order.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/higher_order.inp 1 May 2002 18:39:03 -0000
@@ -0,0 +1,10 @@
+echo on
+register --quiet
+break p
+continue
+finish
+dd
+no
+yes
+yes
+continue
Index: tests/debugger/declarative/ho2.exp
===================================================================
RCS file: tests/debugger/declarative/ho2.exp
diff -N tests/debugger/declarative/ho2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/ho2.exp 1 May 2002 18:39:03 -0000
@@ -0,0 +1,45 @@
+ 1: 1 1 CALL pred ho2:main/2-0 (det) ho2.m:8
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break p
+ 0: + stop interface pred ho2:p/3-0 (det)
+mdb> continue
+ 2: 2 2 CALL pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:9)
+mdb> finish
+ 7: 2 2 EXIT pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:9)
+mdb> dd
+p(0, 3, 27)
+Valid? no
+q('IntroducedFrom__pred__p__22__1'(3), 3, 27)
+Valid? yes
+Found incorrect contour:
+p(0, 3, 27)
+Is this a bug? yes
+ 7: 2 2 EXIT pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:9)
+mdb> continue
+ 8: 5 2 CALL pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:10)
+mdb> finish
+ 13: 5 2 EXIT pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:10)
+mdb> dd
+p(1, 3, 27)
+Valid? no
+Found incorrect contour:
+p(1, 3, 27)
+Is this a bug? yes
+ 13: 5 2 EXIT pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:10)
+mdb> continue
+ 14: 8 2 CALL pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:11)
+mdb> finish
+ 19: 8 2 EXIT pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:11)
+mdb> dd
+p(2, 4, 64)
+Valid? no
+q('IntroducedFrom__pred__p__22__1'(4), 4, 64)
+Valid? yes
+Found incorrect contour:
+p(2, 4, 64)
+Is this a bug? yes
+ 19: 8 2 EXIT pred ho2:p/3-0 (det) ho2.m:21 (ho2.m:11)
+mdb> continue
+27, 27, 64
Index: tests/debugger/declarative/ho2.inp
===================================================================
RCS file: tests/debugger/declarative/ho2.inp
diff -N tests/debugger/declarative/ho2.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/ho2.inp 1 May 2002 18:39:03 -0000
@@ -0,0 +1,21 @@
+echo on
+register --quiet
+break p
+continue
+finish
+dd
+no
+yes
+yes
+continue
+finish
+dd
+no
+yes
+continue
+finish
+dd
+no
+yes
+yes
+continue
Index: tests/debugger/declarative/ho2.m
===================================================================
RCS file: tests/debugger/declarative/ho2.m
diff -N tests/debugger/declarative/ho2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/ho2.m 1 May 2002 18:39:04 -0000
@@ -0,0 +1,29 @@
+:- module ho2.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is det.
+:- implementation.
+:- import_module int.
+
+main -->
+ { p(0, 3, Y0) },
+ { p(1, 3, Y1) },
+ { p(2, 4, Y2) },
+ io__write_int(Y0),
+ io__write_string(", "),
+ io__write_int(Y1),
+ io__write_string(", "),
+ io__write_int(Y2),
+ io__nl.
+
+:- pred p(int::in, int::in, int::out) is det.
+
+p(_, X, Y) :-
+ C = (pred(A::in, B::out) is det :- B = A * X),
+ q(C, X, Y).
+
+:- pred q(pred(int, int)::in(pred(in, out) is det), int::in, int::out) is det.
+
+q(C, X, Y) :-
+ C(X * X, Y).
+
Index: tests/debugger/declarative/ite_2.exp
===================================================================
RCS file: tests/debugger/declarative/ite_2.exp
diff -N tests/debugger/declarative/ite_2.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/ite_2.exp 1 May 2002 18:39:04 -0000
@@ -0,0 +1,51 @@
+ 1: 1 1 CALL pred ite_2:main/2-0 (cc_multi) ite_2.m:8
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break ite
+Ambiguous procedure specification. The matches are:
+0: pred ite_2:ite/3-1 (multi)
+1: pred ite_2:ite/3-0 (det)
+
+Which do you want to put a breakpoint on (0-1 or *)? *
+ 0: + stop interface pred ite_2:ite/3-1 (multi)
+ 1: + stop interface pred ite_2:ite/3-0 (det)
+mdb> continue
+ 2: 2 2 CALL pred ite_2:ite/3-0 (det) ite_2.m:27 (ite_2.m:9)
+mdb> finish
+ 9: 2 2 EXIT pred ite_2:ite/3-0 (det) ite_2.m:27 (ite_2.m:9)
+mdb> dd
+ite(a, 1, 1)
+Valid? no
+a(1, 1)
+Valid? yes
+c(1, 1)
+Valid? yes
+Found incorrect contour:
+ite(a, 1, 1)
+Is this a bug? yes
+ 9: 2 2 EXIT pred ite_2:ite/3-0 (det) ite_2.m:27 (ite_2.m:9)
+mdb> continue
+ 10: 5 2 CALL pred ite_2:ite/3-1 (multi) ite_2.m:27 (ite_2.m:10)
+mdb> finish
+ 23: 5 2 EXIT pred ite_2:ite/3-1 (multi) ite_2.m:27 (ite_2.m:10)
+mdb> dd
+ite(b, 1, 1)
+Valid? no
+b(1, 0)
+Valid? yes
+b(1, 1)
+Valid? yes
+Call b(1, _)
+Solutions:
+ b(1, 0)
+ b(1, 1)
+Complete? yes
+Found incorrect contour:
+ite(b, 1, 1)
+Is this a bug? yes
+ 23: 5 2 EXIT pred ite_2:ite/3-1 (multi) ite_2.m:27 (ite_2.m:10)
+mdb> continue
+ite(a, 1, 1).
+ite(b, 1, 1).
+
Index: tests/debugger/declarative/ite_2.inp
===================================================================
RCS file: tests/debugger/declarative/ite_2.inp
diff -N tests/debugger/declarative/ite_2.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/ite_2.inp 1 May 2002 18:39:04 -0000
@@ -0,0 +1,20 @@
+echo on
+register --quiet
+break ite
+*
+continue
+finish
+dd
+no
+yes
+yes
+yes
+continue
+finish
+dd
+no
+yes
+yes
+yes
+yes
+continue
--------------------------------------------------------------------------
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