1/*  Part of SWI-Prolog
    2
    3    Author:        Vitor Santos Costa
    4    E-mail:        vscosta@gmail.com
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2007-2021, Vitor Santos Costa
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(rbtrees,
   36          [ rb_new/1,                   % -Tree
   37            rb_empty/1,                 % ?Tree
   38            rb_lookup/3,                % +Key, -Value, +Tree
   39            rb_update/4,                % +Tree, +Key,          ?NewVal, -NewTree
   40            rb_update/5,                % +Tree, +Key, -OldVal, ?NewVal, -NewTree
   41            rb_apply/4,                 % +Tree, +Key, :G, -NewTree
   42            rb_insert/4,                % +Tree, +Key, ?Value, -NewTree
   43            rb_insert_new/4,            % +Tree, +Key, ?Value, -NewTree
   44            rb_delete/3,                % +Tree, +Key,       -NewTree
   45            rb_delete/4,                % +Tree, +Key, -Val, -NewTree
   46            rb_visit/2,                 % +Tree, -Pairs
   47            rb_visit_range/4,           % +Tree, +Min, +Max, -Pairs
   48            rb_keys/2,                  % +Tree, +Keys
   49            rb_map/2,                   % +Tree, :Goal
   50            rb_map/3,                   % +Tree, :Goal, -MappedTree
   51            rb_partial_map/4,           % +Tree, +Keys, :Goal, -MappedTree
   52            rb_fold/4,                  % :Goal, +Tree, +State0, -State
   53            rb_clone/3,                 % +TreeIn, -TreeOut, -Pairs
   54            rb_min/3,                   % +Tree, -Key, -Value
   55            rb_max/3,                   % +Tree, -Key, -Value
   56            rb_del_min/4,               % +Tree, -Key, -Val, -TreeDel
   57            rb_del_max/4,               % +Tree, -Key, -Val, -TreeDel
   58            rb_next/4,                  % +Tree, +Key, -Next, -Value
   59            rb_previous/4,              % +Tree, +Key, -Next, -Value
   60            list_to_rbtree/2,           % +Pairs, -Tree
   61            ord_list_to_rbtree/2,       % +Pairs, -Tree
   62            is_rbtree/1,                % @Tree
   63            rb_size/2,                  % +Tree, -Size
   64            rb_in/3                     % ?Key, ?Value, +Tree
   65          ]).   66:- autoload(library(error), [domain_error/2]).   67
   68/** <module> Red black trees
   69
   70Red-Black trees are balanced search binary trees. They are named because
   71nodes can be classified as either red or   black. The code we include is
   72based on "Introduction  to  Algorithms",   second  edition,  by  Cormen,
   73Leiserson, Rivest and Stein. The library   includes  routines to insert,
   74lookup and delete elements in the tree.
   75
   76A Red black tree is represented as a term t(Nil, Tree), where Nil is the
   77Nil-node, a node shared for each nil-node in  the tree. Any node has the
   78form colour(Left, Key, Value, Right), where _colour_  is one of `red` or
   79`black`.
   80
   81__Warning: instantiation of keys__
   82
   83Red-Black trees depend on  the  Prolog   _standard  order  of  terms_ to
   84organize the keys as a (balanced)  binary   tree.  This implies that any
   85term may be used as a key. The   tree may produce wrong results, such as
   86not being able to find a key, if  the ordering of keys changes after the
   87key has been inserted into the tree.   The user is responsible to ensure
   88that variables used as keys or appearing in  a term used as key that may
   89affect ordering are not  unified,  with   the  exception  of unification
   90against new fresh variables. For this   reason,  _ground_ terms are safe
   91keys. When using non-ground terms, either make sure the variables appear
   92in places that do not affect the   standard order relative to other keys
   93in the tree or make sure to not unify against these variables as long as
   94the tree is being used.
   95
   96@see            library(pairs), library(assoc)
   97@author Vitor Santos Costa, Jan Wielemaker, Samer Abdallah,
   98        Peter Ludemann.
   99@see "Introduction to Algorithms", Second Edition Cormen, Leiserson,
  100     Rivest, and Stein, MIT Press
  101*/
  102
  103% rbtrees.pl is derived from YAP's rbtrees.yap, with some minor editing.
  104% One difference is that the SWI-Prolog version  assumes that a key only
  105% appears once in the tree - the   YAP  code is somewhat inconsistent in
  106% that  (and  even  allows  rb_lookup/3  to    backtrack,  plus  it  has
  107% rb_lookupall/3, which isn't in the SWI-Prolog code).
  108
  109% The code has also been modified to   use SWI-Prolog's '=>' operator to
  110% throw an existence_error(matching_rule, _)  exception   if  Tree isn't
  111% instantiated (if ':-' is used, an  uninstanted   Tree  gets  set to an
  112% empty tree, which probably isn't the desired result).
  113
  114:- meta_predicate
  115    rb_map(+,2,-),
  116    rb_map(?,1),
  117    rb_partial_map(+,+,2,-),
  118    rb_apply(+,+,2,-),
  119    rb_fold(3,+,+,-).  120
  121/*
  122:- use_module(library(type_check)).
  123
  124:- type rbtree(K,V) ---> t(tree(K,V),tree(K,V)).
  125:- type tree(K,V)   ---> black(tree(K,V),K,V,tree(K,V))
  126                       ; red(tree(K,V),K,V,tree(K,V))
  127                       ; ''.
  128:- type cmp ---> (=) ; (<) ; (>).
  129
  130
  131:- pred rb_new(rbtree(_K,_V)).
  132:- pred rb_empty(rbtree(_K,_V)).
  133:- pred rb_lookup(K,V,rbtree(K,V)).
  134:- pred lookup(K,V, tree(K,V)).
  135:- pred lookup(cmp, K, V, tree(K,V)).
  136:- pred rb_min(rbtree(K,V),K,V).
  137:- pred min(tree(K,V),K,V).
  138:- pred rb_max(rbtree(K,V),K,V).
  139:- pred max(tree(K,V),K,V).
  140:- pred rb_next(rbtree(K,V),K,pair(K,V),V).
  141:- pred next(tree(K,V),K,pair(K,V),V,tree(K,V)).
  142*/
  143
  144%!  rb_new(-Tree) is det.
  145%
  146%   Create a new Red-Black tree Tree.
  147%
  148%   @deprecated     Use rb_empty/1.
  149
  150:- det(rb_new/1).  151rb_new(t(Nil,Nil)) :-
  152    Nil = black('',_,_,'').
  153
  154%!  rb_empty(?Tree) is semidet.
  155%
  156%   Succeeds if Tree is an empty Red-Black tree.
  157
  158rb_empty(t(Nil,Nil)) :-
  159    Nil = black('',_,_,'').
  160
  161%!  rb_lookup(+Key, -Value, +Tree) is semidet.
  162%
  163%   True when Value is associated with Key   in the Red-Black tree Tree.
  164%   The given Key may include variables, in   which  case the RB tree is
  165%   searched for a key with equivalent   variables  (using (==)/2). Time
  166%   complexity is O(log N) in the number of elements in the tree.
  167%
  168%   @see rb_in/3 for backtracking over keys.
  169
  170rb_lookup(Key, Val, t(_,Tree)) =>
  171    lookup(Key, Val, Tree).
  172
  173lookup(_Key, _Val, black('',_,_,'')) => fail.
  174lookup(Key, Val, Tree) =>
  175    arg(2,Tree,KA),
  176    compare(Cmp,KA,Key),
  177    lookup(Cmp,Key,Val,Tree).
  178
  179lookup(>, K, V, Tree) :-
  180    arg(1,Tree,NTree),
  181    lookup(K, V, NTree).
  182lookup(<, K, V, Tree) :-
  183    arg(4,Tree,NTree),
  184    lookup(K, V, NTree).
  185lookup(=, _, V, Tree) :-
  186    arg(3,Tree,V).
  187
  188%!  rb_min(+Tree, -Key, -Value) is semidet.
  189%
  190%   Key is the minimum key in Tree, and is associated with Val.
  191
  192rb_min(t(_,Tree), Key, Val) =>
  193    min(Tree, Key, Val).
  194
  195min(red(black('',_,_,_),Key0,Val0,_), Key, Val) => Key0=Key, Val0=Val.
  196min(black(black('',_,_,_),Key0,Val0,_), Key, Val) => Key0=Key, Val0=Val.
  197min(red(Right,_,_,_), Key, Val) =>
  198    min(Right,Key,Val).
  199min(black(Right,_,_,_), Key, Val) =>
  200    min(Right,Key,Val).
  201min('', _Key, _Val) => fail.
  202
  203%!  rb_max(+Tree, -Key, -Value) is semidet.
  204%
  205%   Key is the maximal key in Tree, and is associated with Val.
  206
  207rb_max(t(_,Tree), Key, Val) =>
  208    max(Tree, Key, Val).
  209
  210max(red(_,Key0,Val0,black('',_,_,_)), Key, Val) => Key0=Key, Val0=Val.
  211max(black(_,Key0,Val0,black('',_,_,_)), Key, Val) =>Key0=Key, Val0=Val.
  212max(red(_,_,_,Left), Key, Val) =>
  213    max(Left,Key,Val).
  214max(black(_,_,_,Left), Key, Val) =>
  215    max(Left,Key,Val).
  216max('', _Key, _Val) => fail.
  217
  218%!  rb_next(+Tree, +Key, -Next, -Value) is semidet.
  219%
  220%   Next is the next element after Key   in Tree, and is associated with
  221%   Val. Fails if Key isn't in Tree or if Key is the maximum key.
  222
  223rb_next(t(_,Tree), Key, Next, Val) =>
  224    next(Tree, Key, Next, Val, []).
  225
  226next(black('',_,_,''), _, _, _, _) => fail.
  227next(Tree, Key, Next, Val, Candidate) =>
  228    arg(2,Tree,KA),
  229    arg(3,Tree,VA),
  230    compare(Cmp,KA,Key),
  231    next(Cmp, Key, KA, VA, Next, Val, Tree, Candidate).
  232
  233next(>, K, KA, VA, NK, V, Tree, _) :-
  234    arg(1,Tree,NTree),
  235    next(NTree,K,NK,V,KA-VA).
  236next(<, K, _, _, NK, V, Tree, Candidate) :-
  237    arg(4,Tree,NTree),
  238    next(NTree,K,NK,V,Candidate).
  239next(=, _, _, _, NK, Val, Tree, Candidate) :-
  240    arg(4,Tree,NTree),
  241    (   min(NTree, NK, Val)
  242    ->  true
  243    ;   Candidate = (NK-Val)
  244    ).
  245
  246%!  rb_previous(+Tree, +Key, -Previous, -Value) is semidet.
  247%
  248%   Previous  is  the  previous  element  after  Key  in  Tree,  and  is
  249%   associated with Val. Fails if Key isn't  in   Tree  or if Key is the
  250%   minimum key.
  251
  252rb_previous(t(_,Tree), Key, Previous, Val) =>
  253    previous(Tree, Key, Previous, Val, []).
  254
  255previous(black('',_,_,''), _, _, _, _) => fail.
  256previous(Tree, Key, Previous, Val, Candidate) =>
  257    arg(2,Tree,KA),
  258    arg(3,Tree,VA),
  259    compare(Cmp,KA,Key),
  260    previous(Cmp, Key, KA, VA, Previous, Val, Tree, Candidate).
  261
  262previous(>, K, _, _, NK, V, Tree, Candidate) :-
  263    arg(1,Tree,NTree),
  264    previous(NTree,K,NK,V,Candidate).
  265previous(<, K, KA, VA, NK, V, Tree, _) :-
  266    arg(4,Tree,NTree),
  267    previous(NTree,K,NK,V,KA-VA).
  268previous(=, _, _, _, K, Val, Tree, Candidate) :-
  269    arg(1,Tree,NTree),
  270    (   max(NTree, K, Val)
  271    ->  true
  272    ;   Candidate = (K-Val)
  273    ).
  274
  275%!  rb_update(+Tree, +Key, ?NewVal, -NewTree) is semidet.
  276%
  277%   Tree NewTree is tree Tree, but with   value  for Key associated with
  278%   NewVal. Fails if Key is not in   Tree (using (==)/2). This predicate
  279%   may fail or give  unexpected  results   if  Key  is not sufficiently
  280%   instantiated.
  281%
  282%   @see rb_in/3 for backtracking over keys.
  283
  284rb_update(t(Nil,OldTree), Key, OldVal, Val, NewTree2) =>
  285    NewTree2 = t(Nil,NewTree),
  286    update(OldTree, Key, OldVal, Val, NewTree).
  287
  288%!  rb_update(+Tree, +Key, -OldVal, ?NewVal, -NewTree) is semidet.
  289%
  290% Same as =|rb_update(Tree, Key, NewVal, NewTree)|= but also unifies
  291% OldVal with the value associated with Key in Tree.
  292
  293rb_update(t(Nil,OldTree), Key, Val, NewTree2) =>
  294    NewTree2 = t(Nil,NewTree),
  295    update(OldTree, Key, _, Val, NewTree).
  296
  297update(black(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
  298    Left \= [],
  299    compare(Cmp,Key0,Key),
  300    (   Cmp == (=)
  301    ->  OldVal = Val0,
  302        NewTree = black(Left,Key0,Val,Right)
  303    ;   Cmp == (>)
  304    ->  NewTree = black(NewLeft,Key0,Val0,Right),
  305        update(Left, Key, OldVal, Val, NewLeft)
  306    ;   NewTree = black(Left,Key0,Val0,NewRight),
  307        update(Right, Key, OldVal, Val, NewRight)
  308    ).
  309update(red(Left,Key0,Val0,Right), Key, OldVal, Val, NewTree) :-
  310    compare(Cmp,Key0,Key),
  311    (   Cmp == (=)
  312    ->  OldVal = Val0,
  313        NewTree = red(Left,Key0,Val,Right)
  314    ;   Cmp == (>)
  315    ->  NewTree = red(NewLeft,Key0,Val0,Right),
  316        update(Left, Key, OldVal, Val, NewLeft)
  317    ;   NewTree = red(Left,Key0,Val0,NewRight),
  318        update(Right, Key, OldVal, Val, NewRight)
  319    ).
  320
  321%!  rb_apply(+Tree, +Key, :G, -NewTree) is semidet.
  322%
  323%   If the value associated  with  key  Key   is  Val0  in  Tree, and if
  324%   call(G,Val0,ValF) holds, then NewTree differs from Tree only in that
  325%   Key is associated with value  ValF  in   tree  NewTree.  Fails if it
  326%   cannot find Key in Tree, or if call(G,Val0,ValF) is not satisfiable.
  327
  328rb_apply(t(Nil,OldTree), Key, Goal, NewTree2) =>
  329    NewTree2 = t(Nil,NewTree),
  330    apply(OldTree, Key, Goal, NewTree).
  331
  332:- meta_predicate apply(+,?,2,-).  333%apply(black('',_,_,''), _, _, _) :- !, fail.
  334apply(black(Left,Key0,Val0,Right), Key, Goal,
  335      black(NewLeft,Key0,Val,NewRight)) :-
  336    Left \= [],
  337    compare(Cmp,Key0,Key),
  338    (   Cmp == (=)
  339    ->  NewLeft = Left,
  340        NewRight = Right,
  341        call(Goal,Val0,Val)
  342    ;   Cmp == (>)
  343    ->  NewRight = Right,
  344        Val = Val0,
  345        apply(Left, Key, Goal, NewLeft)
  346    ;   NewLeft = Left,
  347        Val = Val0,
  348        apply(Right, Key, Goal, NewRight)
  349    ).
  350apply(red(Left,Key0,Val0,Right), Key, Goal,
  351      red(NewLeft,Key0,Val,NewRight)) :-
  352    compare(Cmp,Key0,Key),
  353    (   Cmp == (=)
  354    ->  NewLeft = Left,
  355        NewRight = Right,
  356        call(Goal,Val0,Val)
  357    ;   Cmp == (>)
  358    ->  NewRight = Right,
  359        Val = Val0,
  360        apply(Left, Key, Goal, NewLeft)
  361    ;   NewLeft = Left,
  362        Val = Val0,
  363        apply(Right, Key, Goal, NewRight)
  364    ).
  365
  366%!  rb_in(?Key, ?Value, +Tree) is nondet.
  367%
  368%   True when Key-Value is a key-value pair in red-black tree Tree. Same
  369%   as below, but does not materialize the pairs.
  370%
  371%        rb_visit(Tree, Pairs), member(Key-Value, Pairs)
  372%
  373%   Leaves a choicepoint  even  if  Key   is  instantiated;  to  avoid a
  374%   choicepoint, use rb_lookup/3.
  375
  376rb_in(Key, Val, t(_,T)) =>
  377    enum(Key, Val, T).
  378
  379enum(Key, Val, black(L,K,V,R)) =>
  380    L \= '',
  381    enum_cases(Key, Val, L, K, V, R).
  382enum(Key, Val, red(L,K,V,R)) =>
  383    enum_cases(Key, Val, L, K, V, R).
  384enum(_Key, _Val, _Tree) => fail.
  385
  386enum_cases(Key, Val, L, _, _, _) :-
  387    enum(Key, Val, L).
  388enum_cases(Key, Val, _, Key, Val, _).
  389enum_cases(Key, Val, _, _, _, R) :-
  390    enum(Key, Val, R).
  391
  392
  393
  394                 /*******************************
  395                 *       TREE INSERTION         *
  396                 *******************************/
  397
  398% We don't use parent nodes, so we may have to fix the root.
  399
  400%!  rb_insert(+Tree, +Key, ?Value, -NewTree) is det.
  401%
  402%   Add an element with key Key and Value   to  the tree Tree creating a
  403%   new red-black tree NewTree. If Key is  a key in Tree, the associated
  404%   value is replaced by Value.  See   also  rb_insert_new/4. Does _not_
  405%   validate that Key is sufficiently instantiated   to  ensure the tree
  406%   remains valid if a key is further instantiated.
  407
  408:- det(rb_insert/4).  409rb_insert(t(Nil,Tree0),Key,Val,NewTree) =>
  410    NewTree = t(Nil,Tree),
  411    insert(Tree0,Key,Val,Nil,Tree).
  412
  413
  414insert(Tree0,Key,Val,Nil,Tree) :-
  415    insert2(Tree0,Key,Val,Nil,TreeI,_),
  416    fix_root(TreeI,Tree).
  417
  418%
  419% Cormen et al present the algorithm as
  420% (1) standard tree insertion;
  421% (2) from the viewpoint of the newly inserted node:
  422%     partially fix the tree;
  423%     move upwards
  424% until reaching the root.
  425%
  426% We do it a little bit different:
  427%
  428% (1) standard tree insertion;
  429% (2) move upwards:
  430%      when reaching a black node;
  431%        if the tree below may be broken, fix it.
  432% We take advantage of Prolog unification
  433% to do several operations in a single go.
  434%
  435
  436
  437
  438%
  439% actual insertion
  440%
  441insert2(black('',_,_,''), K, V, Nil, T, Status) =>
  442    T = red(Nil,K,V,Nil),
  443    Status = not_done.
  444insert2(red(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  445    (   K @< K0
  446    ->  NT = red(NL,K0,V0,R),
  447        insert2(L, K, V, Nil, NL, Flag)
  448    ;   K == K0
  449    ->  NT = red(L,K0,V,R),
  450        Flag = done
  451    ;   NT = red(L,K0,V0,NR),
  452        insert2(R, K, V, Nil, NR, Flag)
  453    ).
  454insert2(black(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  455    (   K @< K0
  456    ->  insert2(L, K, V, Nil, IL, Flag0),
  457        fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
  458    ;   K == K0
  459    ->  NT = black(L,K0,V,R),
  460        Flag = done
  461    ;   insert2(R, K, V, Nil, IR, Flag0),
  462        fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
  463    ).
  464
  465% We don't use parent nodes, so we may have to fix the root.
  466
  467%!  rb_insert_new(+Tree, +Key, ?Value, -NewTree) is semidet.
  468%
  469%   Add a new element with key Key and Value to the tree Tree creating a
  470%   new red-black tree NewTree. Fails if  Key   is  a  key in Tree. Does
  471%   _not_ validate that Key is sufficiently   instantiated to ensure the
  472%   tree remains valid if a key is further instantiated.
  473
  474rb_insert_new(t(Nil,Tree0),Key,Val,NewTree) =>
  475    NewTree = t(Nil,Tree),
  476    insert_new(Tree0,Key,Val,Nil,Tree).
  477
  478insert_new(Tree0,Key,Val,Nil,Tree) :-
  479    insert_new_2(Tree0,Key,Val,Nil,TreeI,_),
  480    fix_root(TreeI,Tree).
  481
  482%
  483% actual insertion, copied from insert2
  484%
  485insert_new_2(black('',_,_,''), K, V, Nil, T, Status) =>
  486    T = red(Nil,K,V,Nil),
  487    Status = not_done.
  488insert_new_2(red(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  489    (   K @< K0
  490    ->  NT = red(NL,K0,V0,R),
  491        insert_new_2(L, K, V, Nil, NL, Flag)
  492    ;   K == K0
  493    ->  fail
  494    ;   NT = red(L,K0,V0,NR),
  495        insert_new_2(R, K, V, Nil, NR, Flag)
  496    ).
  497insert_new_2(black(L,K0,V0,R), K, V, Nil, NT, Flag) =>
  498    (   K @< K0
  499    ->  insert_new_2(L, K, V, Nil, IL, Flag0),
  500        fix_left(Flag0, black(IL,K0,V0,R), NT, Flag)
  501    ;   K == K0
  502    ->  fail
  503    ;   insert_new_2(R, K, V, Nil, IR, Flag0),
  504        fix_right(Flag0, black(L,K0,V0,IR), NT, Flag)
  505    ).
  506
  507%
  508% make sure the root is always black.
  509%
  510:- det(fix_root/2).  511fix_root(black(L,K,V,R), Root) => Root = black(L,K,V,R).
  512fix_root(red(L,K,V,R), Root) => Root = black(L,K,V,R).
  513
  514%
  515% How to fix if we have inserted on the left
  516%
  517:- det(fix_left/4).  518fix_left(done,T0,T,Done) => T = T0, Done = done.
  519fix_left(not_done,Tmp,Final,Done) =>
  520    fix_left(Tmp,Final,Done).
  521
  522:- det(fix_left/3).  523%
  524% case 1 of RB: just need to change colors.
  525%
  526fix_left(black(red(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,red(De,KD,VD,Ep)),
  527        red(black(Al,AK,AV,red(Be,BK,BV,Ga)),KC,VC,black(De,KD,VD,Ep)),
  528        not_done) :- !.
  529fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,red(De,KD,VD,Ep)),
  530        red(black(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,black(De,KD,VD,Ep)),
  531        not_done) :- !.
  532%
  533% case 2 of RB: got a knee so need to do rotations
  534%
  535fix_left(black(red(Al,KA,VA,red(Be,KB,VB,Ga)),KC,VC,De),
  536        black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
  537        done) :- !.
  538%
  539% case 3 of RB: got a line
  540%
  541fix_left(black(red(red(Al,KA,VA,Be),KB,VB,Ga),KC,VC,De),
  542        black(red(Al,KA,VA,Be),KB,VB,red(Ga,KC,VC,De)),
  543        done) :- !.
  544%
  545% case 4 of RB: nothing to do
  546%
  547fix_left(T,T,done).
  548
  549%
  550% How to fix if we have inserted on the right
  551%
  552:- det(fix_right/4).  553fix_right(done,T0,T,Done) => T0 = T, Done = done.
  554fix_right(not_done,Tmp,Final,Done) =>
  555    fix_right(Tmp,Final,Done).
  556
  557:- det(fix_right/3).  558%
  559% case 1 of RB: just need to change colors.
  560%
  561fix_right(black(red(Ep,KD,VD,De),KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
  562          red(black(Ep,KD,VD,De),KC,VC,black(red(Ga,KB,VB,Be),KA,VA,Al)),
  563          not_done) :- !.
  564fix_right(black(red(Ep,KD,VD,De),KC,VC,red(Ga,Ka,Va,red(Be,KB,VB,Al))),
  565          red(black(Ep,KD,VD,De),KC,VC,black(Ga,Ka,Va,red(Be,KB,VB,Al))),
  566          not_done) :- !.
  567%
  568% case 2 of RB: got a knee so need to do rotations
  569%
  570fix_right(black(De,KC,VC,red(red(Ga,KB,VB,Be),KA,VA,Al)),
  571          black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
  572          done) :- !.
  573%
  574% case 3 of RB: got a line
  575%
  576fix_right(black(De,KC,VC,red(Ga,KB,VB,red(Be,KA,VA,Al))),
  577          black(red(De,KC,VC,Ga),KB,VB,red(Be,KA,VA,Al)),
  578          done) :- !.
  579%
  580% case 4 of RB: nothing to do.
  581%
  582fix_right(T,T,done).
  583
  584
  585%!  rb_delete(+Tree, +Key, -NewTree).
  586%
  587%   Delete element with key Key from the  tree Tree, returning the value
  588%   Val associated with the key and a new  tree NewTree. Fails if Key is
  589%   not in Tree  (using  (==)/2).
  590%
  591%   @see rb_in/3 for backtracking over keys.
  592
  593rb_delete(t(Nil,T), K, NewTree) =>
  594    NewTree = t(Nil,NT),
  595    delete(T, K, _, NT, _).
  596
  597%!  rb_delete(+Tree, +Key, -Val, -NewTree).
  598%
  599%   Same as rb_delete(Tree, Key, NewTree), but also unifies Val with the
  600%   value associated with Key in Tree.
  601
  602rb_delete(t(Nil,T), K, V, NewTree) =>
  603    NewTree = t(Nil,NT),
  604    delete(T, K, V0, NT, _),
  605    V = V0.
  606
  607%
  608% I am afraid our representation is not as nice for delete
  609%
  610delete(red(L,K0,V0,R), K, V, NT, Flag) =>
  611    delete_red(L,K0,V0,R, K, V, NT, Flag).
  612delete(black(L,K0,V0,R), K, V, NT, Flag) =>
  613    delete_black(L,K0,V0,R, K, V, NT, Flag).
  614delete('', _K, _V, _NT, _Flag) =>
  615    fail.
  616
  617delete_red(L,K0,V0,R, K, V, NT, Flag), K @< K0 =>
  618    delete(L, K, V, NL, Flag0),
  619    fixup_left(Flag0,red(NL,K0,V0,R),NT, Flag).
  620delete_red(L,K0,V0,R, K, V, NT, Flag), K @> K0 =>
  621    delete(R, K, V, NR, Flag0),
  622    fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
  623delete_red(L,_,V0,R, _, V, Out, Flag) => % K == K0,
  624    V0 = V,
  625    delete_red_node(L,R,Out,Flag).
  626
  627delete_black(L,K0,V0,R, K, V, NT, Flag), K @< K0 =>
  628    delete(L, K, V, NL, Flag0),
  629    fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
  630delete_black(L,K0,V0,R, K, V, NT, Flag), K @> K0 =>
  631    delete(R, K, V, NR, Flag0),
  632    fixup_right(Flag0,black(L,K0,V0,NR),NT, Flag).
  633delete_black(L,_,V0,R, _, V, Out, Flag) => % K == K0,
  634    V0 = V,
  635    delete_black_node(L,R,Out,Flag).
  636
  637%!  rb_del_min(+Tree, -Key, -Val, -NewTree)
  638%
  639%   Delete the least element from the tree  Tree, returning the key Key,
  640%   the value Val associated with the key  and a new tree NewTree. Fails
  641%   if Tree is empty.
  642
  643rb_del_min(t(Nil,T), K, Val, NewTree) =>
  644    NewTree = t(Nil,NT),
  645    del_min(T, K, Val, Nil, NT, _).
  646
  647del_min(red(black('',_,_,_),K,V,R), K, V, Nil, Out, Flag) :-
  648    !,
  649    delete_red_node(Nil,R,Out,Flag).
  650del_min(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  651    del_min(L, K, V, Nil, NL, Flag0),
  652    fixup_left(Flag0,red(NL,K0,V0,R), NT, Flag).
  653del_min(black(black('',_,_,_),K,V,R), K, V, Nil, Out, Flag) :-
  654    !,
  655    delete_black_node(Nil,R,Out,Flag).
  656del_min(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  657    del_min(L, K, V, Nil, NL, Flag0),
  658    fixup_left(Flag0,black(NL,K0,V0,R),NT, Flag).
  659
  660
  661%!  rb_del_max(+Tree, -Key, -Val, -NewTree)
  662%
  663%   Delete the largest element from  the   tree  Tree, returning the key
  664%   Key, the value Val associated with the   key and a new tree NewTree.
  665%   Fails if Tree is empty.
  666
  667rb_del_max(t(Nil,T), K, Val, NewTree) =>
  668    NewTree = t(Nil,NT),
  669    del_max(T, K, Val, Nil, NT, _).
  670
  671del_max(red(L,K,V,black('',_,_,_)), K, V, Nil, Out, Flag) :-
  672    !,
  673    delete_red_node(L,Nil,Out,Flag).
  674del_max(red(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  675    del_max(R, K, V, Nil, NR, Flag0),
  676    fixup_right(Flag0,red(L,K0,V0,NR),NT, Flag).
  677del_max(black(L,K,V,black('',_,_,_)), K, V, Nil, Out, Flag) :-
  678    !,
  679    delete_black_node(L,Nil,Out,Flag).
  680del_max(black(L,K0,V0,R), K, V, Nil, NT, Flag) :-
  681    del_max(R, K, V, Nil, NR, Flag0),
  682    fixup_right(Flag0,black(L,K0,V0,NR), NT, Flag).
  683
  684delete_red_node(L1,L2,L1,done) :- L1 == L2, !.
  685delete_red_node(black('',_,_,''),R,R,done) :-  !.
  686delete_red_node(L,black('',_,_,''),L,done) :-  !.
  687delete_red_node(L,R,Out,Done) :-
  688    delete_next(R,NK,NV,NR,Done0),
  689    fixup_right(Done0,red(L,NK,NV,NR),Out,Done).
  690
  691delete_black_node(L1,L2,L1,not_done) :-         L1 == L2, !.
  692delete_black_node(black('',_,_,''),red(L,K,V,R),black(L,K,V,R),done) :- !.
  693delete_black_node(black('',_,_,''),R,R,not_done) :- !.
  694delete_black_node(red(L,K,V,R),black('',_,_,''),black(L,K,V,R),done) :- !.
  695delete_black_node(L,black('',_,_,''),L,not_done) :- !.
  696delete_black_node(L,R,Out,Done) :-
  697    delete_next(R,NK,NV,NR,Done0),
  698    fixup_right(Done0,black(L,NK,NV,NR),Out,Done).
  699
  700delete_next(red(black('',_,_,''),K,V,R),K,V,R,done) :-  !.
  701delete_next(black(black('',_,_,''),K,V,red(L1,K1,V1,R1)),
  702        K,V,black(L1,K1,V1,R1),done) :- !.
  703delete_next(black(black('',_,_,''),K,V,R),K,V,R,not_done) :- !.
  704delete_next(red(L,K,V,R),K0,V0,Out,Done) :-
  705    delete_next(L,K0,V0,NL,Done0),
  706    fixup_left(Done0,red(NL,K,V,R),Out,Done).
  707delete_next(black(L,K,V,R),K0,V0,Out,Done) :-
  708    delete_next(L,K0,V0,NL,Done0),
  709    fixup_left(Done0,black(NL,K,V,R),Out,Done).
  710
  711fixup_left(done,T,T,done).
  712fixup_left(not_done,T,NT,Done) :-
  713    fixup2(T,NT,Done).
  714
  715%
  716% case 1: x moves down, so we have to try to fix it again.
  717% case 1 -> 2,3,4 -> done
  718%
  719fixup2(black(black(Al,KA,VA,Be),KB,VB,
  720             red(black(Ga,KC,VC,De),KD,VD,
  721                 black(Ep,KE,VE,Fi))),
  722        black(T1,KD,VD,black(Ep,KE,VE,Fi)),done) :-
  723    !,
  724    fixup2(red(black(Al,KA,VA,Be),KB,VB,black(Ga,KC,VC,De)),
  725            T1,
  726            _).
  727%
  728% case 2: x moves up, change one to red
  729%
  730fixup2(red(black(Al,KA,VA,Be),KB,VB,
  731           black(black(Ga,KC,VC,De),KD,VD,
  732                 black(Ep,KE,VE,Fi))),
  733        black(black(Al,KA,VA,Be),KB,VB,
  734              red(black(Ga,KC,VC,De),KD,VD,
  735                  black(Ep,KE,VE,Fi))),done) :- !.
  736fixup2(black(black(Al,KA,VA,Be),KB,VB,
  737             black(black(Ga,KC,VC,De),KD,VD,
  738                   black(Ep,KE,VE,Fi))),
  739        black(black(Al,KA,VA,Be),KB,VB,
  740              red(black(Ga,KC,VC,De),KD,VD,
  741                  black(Ep,KE,VE,Fi))),not_done) :- !.
  742%
  743% case 3: x stays put, shift left and do a 4
  744%
  745fixup2(red(black(Al,KA,VA,Be),KB,VB,
  746           black(red(Ga,KC,VC,De),KD,VD,
  747                 black(Ep,KE,VE,Fi))),
  748        red(black(black(Al,KA,VA,Be),KB,VB,Ga),KC,VC,
  749            black(De,KD,VD,black(Ep,KE,VE,Fi))),
  750        done) :- !.
  751fixup2(black(black(Al,KA,VA,Be),KB,VB,
  752             black(red(Ga,KC,VC,De),KD,VD,
  753                   black(Ep,KE,VE,Fi))),
  754        black(black(black(Al,KA,VA,Be),KB,VB,Ga),KC,VC,
  755              black(De,KD,VD,black(Ep,KE,VE,Fi))),
  756        done) :- !.
  757%
  758% case 4: rotate left, get rid of red
  759%
  760fixup2(red(black(Al,KA,VA,Be),KB,VB,
  761           black(C,KD,VD,red(Ep,KE,VE,Fi))),
  762        red(black(black(Al,KA,VA,Be),KB,VB,C),KD,VD,
  763            black(Ep,KE,VE,Fi)),
  764        done).
  765fixup2(black(black(Al,KA,VA,Be),KB,VB,
  766             black(C,KD,VD,red(Ep,KE,VE,Fi))),
  767       black(black(black(Al,KA,VA,Be),KB,VB,C),KD,VD,
  768             black(Ep,KE,VE,Fi)),
  769       done).
  770
  771fixup_right(done,T,T,done).
  772fixup_right(not_done,T,NT,Done) :-
  773    fixup3(T,NT,Done).
  774
  775% case 1: x moves down, so we have to try to fix it again.
  776% case 1 -> 2,3,4 -> done
  777%
  778fixup3(black(red(black(Fi,KE,VE,Ep),KD,VD,
  779                 black(De,KC,VC,Ga)),KB,VB,
  780             black(Be,KA,VA,Al)),
  781        black(black(Fi,KE,VE,Ep),KD,VD,T1),done) :-
  782    !,
  783    fixup3(red(black(De,KC,VC,Ga),KB,VB,
  784               black(Be,KA,VA,Al)),T1,_).
  785
  786%
  787% case 2: x moves up, change one to red
  788%
  789fixup3(red(black(black(Fi,KE,VE,Ep),KD,VD,
  790                 black(De,KC,VC,Ga)),KB,VB,
  791           black(Be,KA,VA,Al)),
  792       black(red(black(Fi,KE,VE,Ep),KD,VD,
  793                 black(De,KC,VC,Ga)),KB,VB,
  794             black(Be,KA,VA,Al)),
  795       done) :- !.
  796fixup3(black(black(black(Fi,KE,VE,Ep),KD,VD,
  797                   black(De,KC,VC,Ga)),KB,VB,
  798             black(Be,KA,VA,Al)),
  799       black(red(black(Fi,KE,VE,Ep),KD,VD,
  800                 black(De,KC,VC,Ga)),KB,VB,
  801             black(Be,KA,VA,Al)),
  802       not_done):- !.
  803%
  804% case 3: x stays put, shift left and do a 4
  805%
  806fixup3(red(black(black(Fi,KE,VE,Ep),KD,VD,
  807                 red(De,KC,VC,Ga)),KB,VB,
  808           black(Be,KA,VA,Al)),
  809       red(black(black(Fi,KE,VE,Ep),KD,VD,De),KC,VC,
  810           black(Ga,KB,VB,black(Be,KA,VA,Al))),
  811       done) :- !.
  812fixup3(black(black(black(Fi,KE,VE,Ep),KD,VD,
  813                   red(De,KC,VC,Ga)),KB,VB,
  814             black(Be,KA,VA,Al)),
  815       black(black(black(Fi,KE,VE,Ep),KD,VD,De),KC,VC,
  816             black(Ga,KB,VB,black(Be,KA,VA,Al))),
  817       done) :- !.
  818%
  819% case 4: rotate right, get rid of red
  820%
  821fixup3(red(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
  822       red(black(Fi,KE,VE,Ep),KD,VD,black(C,KB,VB,black(Be,KA,VA,Al))),
  823       done).
  824fixup3(black(black(red(Fi,KE,VE,Ep),KD,VD,C),KB,VB,black(Be,KA,VA,Al)),
  825       black(black(Fi,KE,VE,Ep),KD,VD,black(C,KB,VB,black(Be,KA,VA,Al))),
  826       done).
  827
  828%!  rb_visit(+Tree, -Pairs) is det.
  829%
  830%   Pairs is an infix visit of tree Tree, where each element of Pairs is
  831%   of the form Key-Value.
  832
  833:- det(rb_visit/2).  834rb_visit(t(_,T),Lf) =>
  835    visit(T,[],Lf).
  836
  837visit(black('',_,_,_),L0,L) => L0 = L.
  838visit(red(L,K,V,R),L0,Lf) =>
  839    visit(L,[K-V|L1],Lf),
  840    visit(R,L0,L1).
  841visit(black(L,K,V,R),L0,Lf) =>
  842    visit(L,[K-V|L1],Lf),
  843    visit(R,L0,L1).
  844
  845%!  rb_visit_range(+Tree, +Min, +Max, -Pairs) is det.
  846%
  847%   Retrieves a range of pairs with keys between `Min` and `Max` (inclusive)
  848%   from a Tree using standard term comparison.
  849
  850:- det(rb_visit_range/4).  851rb_visit_range(t(_,T), Min, Max, Pairs) =>
  852   visit_range(T, Min, Max, [], Pairs).
  853
  854visit_range(black('',_,_,_), _Min, _Max, L0, Lf) => 
  855   L0 = Lf.
  856visit_range(red(L,K,V,R), Min, Max, L0, Lf) =>
  857   (   K @< Min
  858   ->  visit_range(R, Min, Max, L0, Lf)
  859   ;   K @> Max
  860   ->  visit_range(L, Min, Max, L0, Lf)
  861   ;   visit_range(L, Min, Max, [K-V|L1], Lf),
  862       visit_range(R, Min, Max, L0, L1)
  863   ).
  864visit_range(black(L,K,V,R), Min, Max, L0, Lf) =>
  865   (   K @< Min
  866   ->  visit_range(R, Min, Max, L0, Lf)
  867   ;   K @> Max
  868   ->  visit_range(L, Min, Max, L0, Lf)
  869   ;   visit_range(L, Min, Max, [K-V|L1], Lf),
  870       visit_range(R, Min, Max, L0, L1)
  871   ).
  872
  873:- meta_predicate map(?,2,?,?).  % this is required.
  874
  875%!  rb_map(+Tree, :G, -NewTree) is semidet.
  876%
  877%   For all nodes Key in the tree Tree, if the value associated with key
  878%   Key is Val0 in tree Tree, and   if call(G,Val0,ValF) holds, then the
  879%   value  associated  with  Key  in   NewTree    is   ValF.   Fails  if
  880%   call(G,Val0,ValF)  is  not  satisfiable  for  all   Val0.  If  G  is
  881%   non-deterministic, rb_map/3 will backtrack over  all possible values
  882%   from call(G,Val0,ValF). You should not depend   on the order of tree
  883%   traversal (currently: key order).
  884
  885rb_map(t(Nil,Tree),Goal,NewTree2) =>
  886    NewTree2 = t(Nil,NewTree),
  887    map(Tree,Goal,NewTree,Nil).
  888
  889
  890map(black('',_,_,''),_,Nil0,Nil) => Nil0 = Nil.
  891map(red(L,K,V,R),Goal,NewTree,Nil) =>
  892    NewTree = red(NL,K,NV,NR),
  893    call(Goal,V,NV),
  894    map(L,Goal,NL,Nil),
  895    map(R,Goal,NR,Nil).
  896map(black(L,K,V,R),Goal,NewTree,Nil) =>
  897    NewTree = black(NL,K,NV,NR),
  898    call(Goal,V,NV),
  899    map(L,Goal,NL,Nil),
  900    map(R,Goal,NR,Nil).
  901
  902:- meta_predicate map(?,1).  % this is required.
  903
  904%!  rb_map(+T, :Goal) is semidet.
  905%
  906%   True if call(Goal, Value) is true for all nodes in T.
  907
  908rb_map(t(_,Tree),Goal) =>
  909    map(Tree,Goal).
  910
  911
  912map(black('',_,_,''),_) => true.
  913map(red(L,_,V,R),Goal) =>
  914    call(Goal,V),
  915    map(L,Goal),
  916    map(R,Goal).
  917map(black(L,_,V,R),Goal) =>
  918    call(Goal,V),
  919    map(L,Goal),
  920    map(R,Goal).
  921
  922%!  rb_fold(:Goal, +Tree, +State0, -State).
  923%
  924%   Fold the given predicate  over  all   the  key-value  pairs in Tree,
  925%   starting with initial state State0  and   returning  the final state
  926%   State. Pred is called as
  927%
  928%       call(Pred, Key-Value, State1, State2)
  929%
  930%   Determinism depends on Goal.
  931
  932rb_fold(Pred, t(_,T), S1, S2) =>
  933    fold(T, Pred, S1, S2).
  934
  935fold(black(L,K,V,R), Pred) -->
  936    (   {L == ''}
  937    ->  []
  938    ;   fold_parts(Pred, L, K-V, R)
  939    ).
  940fold(red(L,K,V,R), Pred) -->
  941    fold_parts(Pred, L, K-V, R).
  942
  943fold_parts(Pred, L, KV, R) -->
  944    fold(L, Pred),
  945    call(Pred, KV),
  946    fold(R, Pred).
  947
  948%!  rb_clone(+TreeIn, -TreeOut, -Pairs) is det.
  949%
  950%   `Clone' the red-back tree TreeIn into a   new  tree TreeOut with the
  951%   same keys as the original but with all values set to unbound values.
  952%   Pairs is a list containing all new nodes as pairs K-V.
  953
  954:- det(rb_clone/3).  955rb_clone(t(Nil,T),TreeOut,Ns) =>
  956    TreeOut = t(Nil,NT),
  957    clone(T,Nil,NT,Ns,[]).
  958
  959clone(black('',_,_,''),Nil0,Nil,Ns0,Ns) => Nil0=Nil, Ns0=Ns.
  960clone(red(L,K,_,R),Nil,TreeOut,NsF,Ns0) =>
  961    TreeOut = red(NL,K,NV,NR),
  962    clone(L,Nil,NL,NsF,[K-NV|Ns1]),
  963    clone(R,Nil,NR,Ns1,Ns0).
  964clone(black(L,K,_,R),Nil,TreeOut,NsF,Ns0) =>
  965    TreeOut = black(NL,K,NV,NR),
  966    clone(L,Nil,NL,NsF,[K-NV|Ns1]),
  967    clone(R,Nil,NR,Ns1,Ns0).
  968
  969%!  rb_partial_map(+Tree, +Keys, :G, -NewTree)
  970%
  971%   For all nodes Key in Keys, if the   value associated with key Key is
  972%   Val0 in tree Tree, and if   call(G,Val0,ValF)  holds, then the value
  973%   associated with Key in NewTree is ValF,   otherwise  it is the value
  974%   associated with the key in Tree. Fails if   Key  isn't in Tree or if
  975%   call(G,Val0,ValF) is not satisfiable for all   Val0 in Keys. Assumes
  976%   keys are sorted and not repeated (fails if this is not true).
  977
  978rb_partial_map(t(Nil,T0), Map, Goal, NewTree) =>
  979    NewTree = t(Nil,TF),
  980    partial_map(T0, Map, [], Nil, Goal, TF).
  981
  982partial_map(T,[],[],_,_,T) :- !.
  983partial_map(black('',_,_,_),Map,Map,Nil,_,Nil) :- !.
  984partial_map(red(L,K,V,R),Map,MapF,Nil,Goal,red(NL,K,NV,NR)) :-
  985    partial_map(L,Map,MapI,Nil,Goal,NL),
  986    (   MapI == []
  987    ->  NR = R, NV = V, MapF = []
  988    ;   MapI = [K1|MapR],
  989        (   K == K1
  990        ->  (   call(Goal,V,NV)
  991            ->  true
  992            ;   NV = V
  993            ),
  994            MapN = MapR
  995        ;   NV = V,
  996            MapN = MapI
  997        ),
  998        partial_map(R,MapN,MapF,Nil,Goal,NR)
  999    ).
 1000partial_map(black(L,K,V,R),Map,MapF,Nil,Goal,black(NL,K,NV,NR)) :-
 1001    partial_map(L,Map,MapI,Nil,Goal,NL),
 1002    (   MapI == []
 1003    ->  NR = R, NV = V, MapF = []
 1004    ;   MapI = [K1|MapR],
 1005        (   K == K1
 1006        ->  (   call(Goal,V,NV)
 1007            ->  true
 1008            ;   NV = V
 1009            ),
 1010            MapN = MapR
 1011        ;   NV = V,
 1012            MapN = MapI
 1013        ),
 1014        partial_map(R,MapN,MapF,Nil,Goal,NR)
 1015    ).
 1016
 1017
 1018%!  rb_keys(+Tree, -Keys) is det.
 1019%
 1020%   Keys is unified with an ordered list   of  all keys in the Red-Black
 1021%   tree Tree.
 1022
 1023:- det(rb_keys/2). 1024rb_keys(t(_,T),Lf) =>
 1025    keys(T,[],Lf).
 1026
 1027keys(black('',_,_,''),L0,L) => L0 = L.
 1028keys(red(L,K,_,R),L0,Lf) =>
 1029    keys(L,[K|L1],Lf),
 1030    keys(R,L0,L1).
 1031keys(black(L,K,_,R),L0,Lf) =>
 1032    keys(L,[K|L1],Lf),
 1033    keys(R,L0,L1).
 1034
 1035
 1036%!  list_to_rbtree(+List, -Tree) is det.
 1037%
 1038%   Tree is the red-black tree  corresponding   to  the mapping in List,
 1039%   which should be a list of Key-Value   pairs. List should not contain
 1040%   more than one entry for each distinct key, but this is not validated
 1041%   by list_to_rbtree/2.
 1042
 1043:- det(list_to_rbtree/2). 1044list_to_rbtree(List, T) :-
 1045    sort(List,Sorted),
 1046    ord_list_to_rbtree(Sorted, T).
 1047
 1048%!  ord_list_to_rbtree(+List, -Tree) is det.
 1049%
 1050%   Tree is the red-black tree  corresponding   to  the  mapping in list
 1051%   List, which should be a list  of   Key-Value  pairs. List should not
 1052%   contain more than one entry for each   distinct key, but this is not
 1053%   validated by ord_list_to_rbtree/2. List is assumed
 1054%   to be sorted according to the standard order of terms.
 1055
 1056:- det(ord_list_to_rbtree/2). 1057ord_list_to_rbtree([], Tree) =>
 1058    Tree = t(Nil,Nil),
 1059    Nil = black('', _, _, '').
 1060ord_list_to_rbtree([K-V], Tree) =>
 1061    Tree = t(Nil,black(Nil,K,V,Nil)),
 1062    Nil = black('', _, _, '').
 1063ord_list_to_rbtree(List, Tree2) =>
 1064    Tree2 = t(Nil,Tree),
 1065    Nil = black('', _, _, ''),
 1066    Ar =.. [seq|List],
 1067    functor(Ar,_,L),
 1068    Height is truncate(log(L)/log(2)),
 1069    construct_rbtree(1, L, Ar, Height, Nil, Tree).
 1070
 1071construct_rbtree(L, M, _, _, Nil, Nil) :- M < L, !.
 1072construct_rbtree(L, L, Ar, Depth, Nil, Node) :-
 1073    !,
 1074    arg(L, Ar, K-Val),
 1075    build_node(Depth, Nil, K, Val, Nil, Node).
 1076construct_rbtree(I0, Max, Ar, Depth, Nil, Node) :-
 1077    I is (I0+Max)//2,
 1078    arg(I, Ar, K-Val),
 1079    build_node(Depth, Left, K, Val, Right, Node),
 1080    I1 is I-1,
 1081    NewDepth is Depth-1,
 1082    construct_rbtree(I0, I1, Ar, NewDepth, Nil, Left),
 1083    I2 is I+1,
 1084    construct_rbtree(I2, Max, Ar, NewDepth, Nil, Right).
 1085
 1086build_node( 0, Left, K, Val, Right, red(Left, K, Val, Right)) :- !.
 1087build_node( _, Left, K, Val, Right, black(Left, K, Val, Right)).
 1088
 1089
 1090%!  rb_size(+Tree, -Size) is det.
 1091%
 1092%   Size is the number of elements in Tree.
 1093
 1094:- det(rb_size/2). 1095rb_size(t(_,T),Size) =>
 1096    size(T,0,Size).
 1097
 1098size(black('',_,_,_),Sz,Sz) :- !.
 1099size(red(L,_,_,R),Sz0,Szf) :-
 1100    Sz1 is Sz0+1,
 1101    size(L,Sz1,Sz2),
 1102    size(R,Sz2,Szf).
 1103size(black(L,_,_,R),Sz0,Szf) :-
 1104    Sz1 is Sz0+1,
 1105    size(L,Sz1,Sz2),
 1106    size(R,Sz2,Szf).
 1107
 1108%!  is_rbtree(@Term) is semidet.
 1109%
 1110%   True if Term is a valid Red-Black   tree. Processes the entire tree,
 1111%   checking the coloring of the nodes, the  balance and the ordering of
 1112%   keys.    Does _not_ validate that keys are sufficiently instantiated
 1113%   to ensure the tree remains valid if a key is further instantiated.
 1114
 1115is_rbtree(X), var(X) =>
 1116    fail.
 1117is_rbtree(t(Nil,Nil)) => true.
 1118is_rbtree(t(_,T)) =>
 1119    Err = error(_,_),
 1120    catch(check_rbtree(T), Err, is_rbtree_error(Err)).
 1121is_rbtree(_) =>
 1122    fail.
 1123
 1124is_rbtree_error(Err), Err = error(resource_error(_),_) => throw(Err).
 1125is_rbtree_error(_) => fail.
 1126
 1127% This code checks if a tree is ordered and a rbtree
 1128
 1129check_rbtree(black(L,K,_,R)) =>
 1130    find_path_blacks(L, 0, Bls),
 1131    check_rbtree(L,-inf,K,Bls),
 1132    check_rbtree(R,K,+inf,Bls).
 1133check_rbtree(Node), Node = red(_,_,_,_) =>
 1134    domain_error(rb_black, Node).
 1135
 1136
 1137find_path_blacks(black('',_,_,''), Bls0, Bls) => Bls = Bls0.
 1138find_path_blacks(black(L,_,_,_), Bls0, Bls) =>
 1139    Bls1 is Bls0+1,
 1140    find_path_blacks(L, Bls1, Bls).
 1141find_path_blacks(red(L,_,_,_), Bls0, Bls) =>
 1142    find_path_blacks(L, Bls0, Bls).
 1143
 1144check_rbtree(black('',_,_,''),Min,Max,Bls0) =>
 1145    check_height(Bls0,Min,Max).
 1146check_rbtree(red(L,K,_,R),Min,Max,Bls) =>
 1147    check_val(K,Min,Max),
 1148    check_red_child(L),
 1149    check_red_child(R),
 1150    check_rbtree(L,Min,K,Bls),
 1151    check_rbtree(R,K,Max,Bls).
 1152check_rbtree(black(L,K,_,R),Min,Max,Bls0) =>
 1153    check_val(K,Min,Max),
 1154    Bls is Bls0-1,
 1155    check_rbtree(L,Min,K,Bls),
 1156    check_rbtree(R,K,Max,Bls).
 1157
 1158check_height(0,_,_) => true.
 1159check_height(Bls0,Min,Max) =>
 1160    throw(error(rbtree(balance(Bls0, Min, Max)), _)).
 1161
 1162check_val(K, Min, Max), (K @> Min ; Min == -inf), (K @< Max ; Max == +inf) =>
 1163    true.
 1164check_val(K, Min, Max) =>
 1165    throw(error(rbtree(order(K, Min, Max)), _)).
 1166
 1167check_red_child(black(_,_,_,_)) => true.
 1168check_red_child(Node), Node = red(_,_,_,_) =>
 1169    domain_error(rb_black, Node).
 1170
 1171
 1172		 /*******************************
 1173		 *            MESSAGES		*
 1174		 *******************************/
 1175
 1176:- multifile
 1177    prolog:error_message//1. 1178
 1179prolog:error_message(rbtree(balance(Bls0, Min, Max))) -->
 1180    [ 'Unbalance ~d between ~w and ~w'-[Bls0,Min,Max] ].
 1181prolog:error_message(rbtree(order(K, Min, Max))) -->
 1182    [ 'not ordered: ~w not between ~w and ~w'-[K,Min,Max] ]