1/*  Part of SWI-Prolog
    2
    3    Author:        R.A.O'Keefe, L.Damas, V.S.Costa, Glenn Burgess,
    4                   Jiri Spitz and Jan Wielemaker
    5    E-mail:        J.Wielemaker@vu.nl
    6    WWW:           http://www.swi-prolog.org
    7    Copyright (c)  2004-2018, various people and institutions
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(assoc,
   37          [ empty_assoc/1,              % -Assoc
   38            is_assoc/1,                 % +Assoc
   39            assoc_to_list/2,            % +Assoc, -Pairs
   40            assoc_to_keys/2,            % +Assoc, -List
   41            assoc_to_values/2,          % +Assoc, -List
   42            gen_assoc/3,                % ?Key, +Assoc, ?Value
   43            get_assoc/3,                % +Key, +Assoc, ?Value
   44            get_assoc/5,                % +Key, +Assoc0, ?Val0, ?Assoc, ?Val
   45            list_to_assoc/2,            % +List, ?Assoc
   46            map_assoc/2,                % :Goal, +Assoc
   47            map_assoc/3,                % :Goal, +Assoc0, ?Assoc
   48            max_assoc/3,                % +Assoc, ?Key, ?Value
   49            min_assoc/3,                % +Assoc, ?Key, ?Value
   50            ord_list_to_assoc/2,        % +List, ?Assoc
   51            put_assoc/4,                % +Key, +Assoc0, +Value, ?Assoc
   52            del_assoc/4,                % +Key, +Assoc0, ?Value, ?Assoc
   53            del_min_assoc/4,            % +Assoc0, ?Key, ?Value, ?Assoc
   54            del_max_assoc/4             % +Assoc0, ?Key, ?Value, ?Assoc
   55          ]).   56:- use_module(library(error)).   57
   58/** <module> Binary associations
   59
   60Assocs are Key-Value associations implemented as  a balanced binary tree
   61(AVL tree).
   62
   63@see            library(pairs), library(rbtrees)
   64@author         R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
   65*/
   66
   67:- meta_predicate
   68    map_assoc(1, ?),
   69    map_assoc(2, ?, ?).   70
   71%!  empty_assoc(?Assoc) is semidet.
   72%
   73%   Is true if Assoc is the empty association list.
   74
   75empty_assoc(t).
   76
   77%!  assoc_to_list(+Assoc, -Pairs) is det.
   78%
   79%   Translate Assoc to a list Pairs of Key-Value pairs.  The keys
   80%   in Pairs are sorted in ascending order.
   81
   82assoc_to_list(Assoc, List) :-
   83    assoc_to_list(Assoc, List, []).
   84
   85assoc_to_list(t(Key,Val,_,L,R), List, Rest) :-
   86    assoc_to_list(L, List, [Key-Val|More]),
   87    assoc_to_list(R, More, Rest).
   88assoc_to_list(t, List, List).
   89
   90
   91%!  assoc_to_keys(+Assoc, -Keys) is det.
   92%
   93%   True if Keys is the list of keys   in Assoc. The keys are sorted
   94%   in ascending order.
   95
   96assoc_to_keys(Assoc, List) :-
   97    assoc_to_keys(Assoc, List, []).
   98
   99assoc_to_keys(t(Key,_,_,L,R), List, Rest) :-
  100    assoc_to_keys(L, List, [Key|More]),
  101    assoc_to_keys(R, More, Rest).
  102assoc_to_keys(t, List, List).
  103
  104
  105%!  assoc_to_values(+Assoc, -Values) is det.
  106%
  107%   True if Values is the  list  of   values  in  Assoc.  Values are
  108%   ordered in ascending  order  of  the   key  to  which  they were
  109%   associated.  Values may contain duplicates.
  110
  111assoc_to_values(Assoc, List) :-
  112    assoc_to_values(Assoc, List, []).
  113
  114assoc_to_values(t(_,Value,_,L,R), List, Rest) :-
  115    assoc_to_values(L, List, [Value|More]),
  116    assoc_to_values(R, More, Rest).
  117assoc_to_values(t, List, List).
  118
  119%!  is_assoc(+Assoc) is semidet.
  120%
  121%   True if Assoc is an association list. This predicate checks
  122%   that the structure is valid, elements are in order, and tree
  123%   is balanced to the extent guaranteed by AVL trees.  I.e.,
  124%   branches of each subtree differ in depth by at most 1.
  125
  126is_assoc(Assoc) :-
  127    is_assoc(Assoc, _Min, _Max, _Depth).
  128
  129is_assoc(t,X,X,0) :- !.
  130is_assoc(t(K,_,-,t,t),K,K,1) :- !, ground(K).
  131is_assoc(t(K,_,>,t,t(RK,_,-,t,t)),K,RK,2) :-
  132    % Ensure right side Key is 'greater' than K
  133    !, ground((K,RK)), K @< RK.
  134
  135is_assoc(t(K,_,<,t(LK,_,-,t,t),t),LK,K,2) :-
  136    % Ensure left side Key is 'less' than K
  137    !, ground((LK,K)), LK @< K.
  138
  139is_assoc(t(K,_,B,L,R),Min,Max,Depth) :-
  140    is_assoc(L,Min,LMax,LDepth),
  141    is_assoc(R,RMin,Max,RDepth),
  142    % Ensure Balance matches depth
  143    compare(Rel,RDepth,LDepth),
  144    balance(Rel,B),
  145    % Ensure ordering
  146    ground((LMax,K,RMin)),
  147    LMax @< K,
  148    K @< RMin,
  149    Depth is max(LDepth, RDepth)+1.
  150
  151% Private lookup table matching comparison operators to Balance operators used in tree
  152balance(=,-).
  153balance(<,<).
  154balance(>,>).
  155
  156
  157%!  gen_assoc(?Key, +Assoc, ?Value) is nondet.
  158%
  159%   True if Key-Value is an association in Assoc. Enumerates keys in
  160%   ascending order on backtracking.
  161%
  162%   @see get_assoc/3.
  163
  164gen_assoc(Key, Assoc, Value) :-
  165    (   ground(Key)
  166    ->  get_assoc(Key, Assoc, Value)
  167    ;   gen_assoc_(Key, Assoc, Value)
  168    ).
  169
  170gen_assoc_(Key, t(_,_,_,L,_), Val) :-
  171    gen_assoc_(Key, L, Val).
  172gen_assoc_(Key, t(Key,Val,_,_,_), Val).
  173gen_assoc_(Key, t(_,_,_,_,R), Val) :-
  174    gen_assoc_(Key, R, Val).
  175
  176
  177%!  get_assoc(+Key, +Assoc, -Value) is semidet.
  178%
  179%   True if Key-Value is an association in Assoc.
  180%
  181%   @error type_error(assoc, Assoc) if Assoc is not an association list.
  182
  183get_assoc(Key, Assoc, Val) :-
  184    must_be(assoc, Assoc),
  185    get_assoc_(Key, Assoc, Val).
  186
  187:- if(current_predicate('$btree_find_node'/5)).  188get_assoc_(Key, Tree, Val) :-
  189    Tree \== t,
  190    '$btree_find_node'(Key, Tree, 0x010405, Node, =),
  191    arg(2, Node, Val).
  192:- else.  193get_assoc_(Key, t(K,V,_,L,R), Val) :-
  194    compare(Rel, Key, K),
  195    get_assoc(Rel, Key, V, L, R, Val).
  196
  197get_assoc(=, _, Val, _, _, Val).
  198get_assoc(<, Key, _, Tree, _, Val) :-
  199    get_assoc(Key, Tree, Val).
  200get_assoc(>, Key, _, _, Tree, Val) :-
  201    get_assoc(Key, Tree, Val).
  202:- endif.  203
  204
  205%!  get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet.
  206%
  207%   True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.
  208
  209get_assoc(Key, t(K,V,B,L,R), Val, t(K,NV,B,NL,NR), NVal) :-
  210    compare(Rel, Key, K),
  211    get_assoc(Rel, Key, V, L, R, Val, NV, NL, NR, NVal).
  212
  213get_assoc(=, _, Val, L, R, Val, NVal, L, R, NVal).
  214get_assoc(<, Key, V, L, R, Val, V, NL, R, NVal) :-
  215    get_assoc(Key, L, Val, NL, NVal).
  216get_assoc(>, Key, V, L, R, Val, V, L, NR, NVal) :-
  217    get_assoc(Key, R, Val, NR, NVal).
  218
  219
  220%!  list_to_assoc(+Pairs, -Assoc) is det.
  221%
  222%   Create an association from a list Pairs of Key-Value pairs. List
  223%   must not contain duplicate keys.
  224%
  225%   @error domain_error(unique_key_pairs, List) if List contains duplicate keys
  226
  227list_to_assoc(List, Assoc) :-
  228    (  List = [] -> Assoc = t
  229    ;  keysort(List, Sorted),
  230           (  ord_pairs(Sorted)
  231           -> length(Sorted, N),
  232              list_to_assoc(N, Sorted, [], _, Assoc)
  233           ;  domain_error(unique_key_pairs, List)
  234           )
  235    ).
  236
  237list_to_assoc(1, [K-V|More], More, 1, t(K,V,-,t,t)) :- !.
  238list_to_assoc(2, [K1-V1,K2-V2|More], More, 2, t(K2,V2,<,t(K1,V1,-,t,t),t)) :- !.
  239list_to_assoc(N, List, More, Depth, t(K,V,Balance,L,R)) :-
  240    N0 is N - 1,
  241    RN is N0 div 2,
  242    Rem is N0 mod 2,
  243    LN is RN + Rem,
  244    list_to_assoc(LN, List, [K-V|Upper], LDepth, L),
  245    list_to_assoc(RN, Upper, More, RDepth, R),
  246    Depth is LDepth + 1,
  247    compare(B, RDepth, LDepth), balance(B, Balance).
  248
  249%!  ord_list_to_assoc(+Pairs, -Assoc) is det.
  250%
  251%   Assoc is created from an ordered list Pairs of Key-Value
  252%   pairs. The pairs must occur in strictly ascending order of
  253%   their keys.
  254%
  255%   @error domain_error(key_ordered_pairs, List) if pairs are not ordered.
  256
  257ord_list_to_assoc(Sorted, Assoc) :-
  258    (  Sorted = [] -> Assoc = t
  259    ;  (  ord_pairs(Sorted)
  260           -> length(Sorted, N),
  261              list_to_assoc(N, Sorted, [], _, Assoc)
  262           ;  domain_error(key_ordered_pairs, Sorted)
  263           )
  264    ).
  265
  266%!  ord_pairs(+Pairs) is semidet
  267%
  268%   True if Pairs is a list of Key-Val pairs strictly ordered by key.
  269
  270ord_pairs([K-_V|Rest]) :-
  271    ord_pairs(Rest, K).
  272ord_pairs([], _K).
  273ord_pairs([K-_V|Rest], K0) :-
  274    K0 @< K,
  275    ord_pairs(Rest, K).
  276
  277%!  map_assoc(:Pred, +Assoc) is semidet.
  278%
  279%   True if Pred(Value) is true for all values in Assoc.
  280
  281map_assoc(Pred, T) :-
  282    map_assoc_(T, Pred).
  283
  284map_assoc_(t, _).
  285map_assoc_(t(_,Val,_,L,R), Pred) :-
  286    map_assoc_(L, Pred),
  287    call(Pred, Val),
  288    map_assoc_(R, Pred).
  289
  290%!  map_assoc(:Pred, +Assoc0, ?Assoc) is semidet.
  291%
  292%   Map corresponding values. True if Assoc is Assoc0 with Pred
  293%   applied to all corresponding pairs of of values.
  294
  295map_assoc(Pred, T0, T) :-
  296    map_assoc_(T0, Pred, T).
  297
  298map_assoc_(t, _, t).
  299map_assoc_(t(Key,Val,B,L0,R0), Pred, t(Key,Ans,B,L1,R1)) :-
  300    map_assoc_(L0, Pred, L1),
  301    call(Pred, Val, Ans),
  302    map_assoc_(R0, Pred, R1).
  303
  304
  305%!  max_assoc(+Assoc, -Key, -Value) is semidet.
  306%
  307%   True if Key-Value is in Assoc and Key is the largest key.
  308
  309max_assoc(t(K,V,_,_,R), Key, Val) :-
  310    max_assoc(R, K, V, Key, Val).
  311
  312max_assoc(t, K, V, K, V).
  313max_assoc(t(K,V,_,_,R), _, _, Key, Val) :-
  314    max_assoc(R, K, V, Key, Val).
  315
  316
  317%!  min_assoc(+Assoc, -Key, -Value) is semidet.
  318%
  319%   True if Key-Value is in assoc and Key is the smallest key.
  320
  321min_assoc(t(K,V,_,L,_), Key, Val) :-
  322    min_assoc(L, K, V, Key, Val).
  323
  324min_assoc(t, K, V, K, V).
  325min_assoc(t(K,V,_,L,_), _, _, Key, Val) :-
  326    min_assoc(L, K, V, Key, Val).
  327
  328
  329%!  put_assoc(+Key, +Assoc0, +Value, -Assoc) is det.
  330%
  331%   Assoc is Assoc0, except that Key is associated with
  332%   Value. This can be used to insert and change associations.
  333
  334put_assoc(Key, A0, Value, A) :-
  335    insert(A0, Key, Value, A, _).
  336
  337insert(t, Key, Val, t(Key,Val,-,t,t), yes).
  338insert(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  339    compare(Rel, K, Key),
  340    insert(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
  341
  342insert(=, t(Key,_,B,L,R), _, V, t(Key,V,B,L,R), no).
  343insert(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  344    insert(L, K, V, NewL, LeftHasChanged),
  345    adjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
  346insert(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  347    insert(R, K, V, NewR, RightHasChanged),
  348    adjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
  349
  350adjust(no, Oldree, _, Oldree, no).
  351adjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, WhatHasChanged) :-
  352    table(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
  353    rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, _, _).
  354
  355%     balance  where     balance  whole tree  to be
  356%     before   inserted  after    increased   rebalanced
  357table(-      , left    , <      , yes       , no    ) :- !.
  358table(-      , right   , >      , yes       , no    ) :- !.
  359table(<      , left    , -      , no        , yes   ) :- !.
  360table(<      , right   , -      , no        , no    ) :- !.
  361table(>      , left    , -      , no        , no    ) :- !.
  362table(>      , right   , -      , no        , yes   ) :- !.
  363
  364%!  del_min_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
  365%
  366%   True if Key-Value  is  in  Assoc0   and  Key  is  the smallest key.
  367%   Assoc is Assoc0 with Key-Value   removed. Warning: This will
  368%   succeed with _no_ bindings for Key or Val if Assoc0 is empty.
  369
  370del_min_assoc(Tree, Key, Val, NewTree) :-
  371    del_min_assoc(Tree, Key, Val, NewTree, _DepthChanged).
  372
  373del_min_assoc(t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
  374del_min_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
  375    del_min_assoc(L, Key, Val, NewL, LeftChanged),
  376    deladjust(LeftChanged, t(K,V,B,NewL,R), left, NewTree, Changed).
  377
  378%!  del_max_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
  379%
  380%   True if Key-Value  is  in  Assoc0   and  Key  is  the greatest key.
  381%   Assoc is Assoc0 with Key-Value   removed. Warning: This will
  382%   succeed with _no_ bindings for Key or Val if Assoc0 is empty.
  383
  384del_max_assoc(Tree, Key, Val, NewTree) :-
  385    del_max_assoc(Tree, Key, Val, NewTree, _DepthChanged).
  386
  387del_max_assoc(t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
  388del_max_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
  389    del_max_assoc(R, Key, Val, NewR, RightChanged),
  390    deladjust(RightChanged, t(K,V,B,L,NewR), right, NewTree, Changed).
  391
  392%!  del_assoc(+Key, +Assoc0, ?Value, -Assoc) is semidet.
  393%
  394%   True if Key-Value is  in  Assoc0.   Assoc  is  Assoc0 with
  395%   Key-Value removed.
  396
  397del_assoc(Key, A0, Value, A) :-
  398    delete(A0, Key, Value, A, _).
  399
  400% delete(+Subtree, +SearchedKey, ?SearchedValue, ?SubtreeOut, ?WhatHasChanged)
  401delete(t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  402    compare(Rel, K, Key),
  403    delete(Rel, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged).
  404
  405% delete(+KeySide, +Subtree, +SearchedKey, ?SearchedValue, ?SubtreeOut, ?WhatHasChanged)
  406% KeySide is an operator {<,=,>} indicating which branch should be searched for the key.
  407% WhatHasChanged {yes,no} indicates whether the NewTree has changed in depth.
  408delete(=, t(Key,Val,_B,t,R), Key, Val, R, yes) :- !.
  409delete(=, t(Key,Val,_B,L,t), Key, Val, L, yes) :- !.
  410delete(=, t(Key,Val,>,L,R), Key, Val, NewTree, WhatHasChanged) :-
  411    % Rh tree is deeper, so rotate from R to L
  412    del_min_assoc(R, K, V, NewR, RightHasChanged),
  413    deladjust(RightHasChanged, t(K,V,>,L,NewR), right, NewTree, WhatHasChanged),
  414    !.
  415delete(=, t(Key,Val,B,L,R), Key, Val, NewTree, WhatHasChanged) :-
  416    % Rh tree is not deeper, so rotate from L to R
  417    del_max_assoc(L, K, V, NewL, LeftHasChanged),
  418    deladjust(LeftHasChanged, t(K,V,B,NewL,R), left, NewTree, WhatHasChanged),
  419    !.
  420
  421delete(<, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  422    delete(L, K, V, NewL, LeftHasChanged),
  423    deladjust(LeftHasChanged, t(Key,Val,B,NewL,R), left, NewTree, WhatHasChanged).
  424delete(>, t(Key,Val,B,L,R), K, V, NewTree, WhatHasChanged) :-
  425    delete(R, K, V, NewR, RightHasChanged),
  426    deladjust(RightHasChanged, t(Key,Val,B,L,NewR), right, NewTree, WhatHasChanged).
  427
  428deladjust(no, OldTree, _, OldTree, no).
  429deladjust(yes, t(Key,Val,B0,L,R), LoR, NewTree, RealChange) :-
  430    deltable(B0, LoR, B1, WhatHasChanged, ToBeRebalanced),
  431    rebalance(ToBeRebalanced, t(Key,Val,B0,L,R), B1, NewTree, WhatHasChanged, RealChange).
  432
  433%     balance  where     balance  whole tree  to be
  434%     before   deleted   after    changed   rebalanced
  435deltable(-      , right   , <      , no        , no    ) :- !.
  436deltable(-      , left    , >      , no        , no    ) :- !.
  437deltable(<      , right   , -      , yes       , yes   ) :- !.
  438deltable(<      , left    , -      , yes       , no    ) :- !.
  439deltable(>      , right   , -      , yes       , no    ) :- !.
  440deltable(>      , left    , -      , yes       , yes   ) :- !.
  441% It depends on the tree pattern in avl_geq whether it really decreases.
  442
  443% Single and double tree rotations - these are common for insert and delete.
  444/* The patterns (>)-(>), (>)-( <), ( <)-( <) and ( <)-(>) on the LHS
  445   always change the tree height and these are the only patterns which can
  446   happen after an insertion. That's the reason why we can use a table only to
  447   decide the needed changes.
  448
  449   The patterns (>)-( -) and ( <)-( -) do not change the tree height. After a
  450   deletion any pattern can occur and so we return yes or no as a flag of a
  451   height change.  */
  452
  453
  454rebalance(no, t(K,V,_,L,R), B, t(K,V,B,L,R), Changed, Changed).
  455rebalance(yes, OldTree, _, NewTree, _, RealChange) :-
  456    avl_geq(OldTree, NewTree, RealChange).
  457
  458avl_geq(t(A,VA,>,Alpha,t(B,VB,>,Beta,Gamma)),
  459        t(B,VB,-,t(A,VA,-,Alpha,Beta),Gamma), yes) :- !.
  460avl_geq(t(A,VA,>,Alpha,t(B,VB,-,Beta,Gamma)),
  461        t(B,VB,<,t(A,VA,>,Alpha,Beta),Gamma), no) :- !.
  462avl_geq(t(B,VB,<,t(A,VA,<,Alpha,Beta),Gamma),
  463        t(A,VA,-,Alpha,t(B,VB,-,Beta,Gamma)), yes) :- !.
  464avl_geq(t(B,VB,<,t(A,VA,-,Alpha,Beta),Gamma),
  465        t(A,VA,>,Alpha,t(B,VB,<,Beta,Gamma)), no) :- !.
  466avl_geq(t(A,VA,>,Alpha,t(B,VB,<,t(X,VX,B1,Beta,Gamma),Delta)),
  467        t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
  468    !,
  469    table2(B1, B2, B3).
  470avl_geq(t(B,VB,<,t(A,VA,>,Alpha,t(X,VX,B1,Beta,Gamma)),Delta),
  471        t(X,VX,-,t(A,VA,B2,Alpha,Beta),t(B,VB,B3,Gamma,Delta)), yes) :-
  472    !,
  473    table2(B1, B2, B3).
  474
  475table2(< ,- ,> ).
  476table2(> ,< ,- ).
  477table2(- ,- ,- ).
  478
  479
  480                 /*******************************
  481                 *            ERRORS            *
  482                 *******************************/
  483
  484:- multifile
  485    error:has_type/2.  486
  487error:has_type(assoc, X) :-
  488    (   X == t
  489    ->  true
  490    ;   compound(X),
  491        functor(X, t, 5)
  492    )