3value_member(Val,Val).
    4
    5safe_for_dict(P,D):- is_list(P),maplist(safe_for_dict,P,D).
    6safe_for_dict(N=V,NN=V):- compound(N),term_to_atom(N,NN),!.
    7safe_for_dict(N-V,NN-V):- compound(N),term_to_atom(N,NN),!.
    8safe_for_dict(D,D).
    9
   10portray_hashtable(T):- is_hashtable(T),!,hashtable_pairs(T,P), safe_for_dict(P,D), dict_create(Dict,'HT',D),writeq(Dict).
   11% portray_hashtable(T):- is_hashtable(T),!,hashtable_pairs(T,P),write('HT{'),writeq(P),write('}').
   12
   13
   14user:portray(T):- notrace(((catch(portray_hashtable(T),_,fail)))),!.
   15
   16is_hashtable(UDT):- notrace(is_rbtree(UDT)).
   17
   18hashtable_new(UDT):- notrace(rb_new(UDT)).
   19
   20hashtable_lookup(Key, Val, UDT):- notrace(ground(Key) ; \+ compound(Key)),!, notrace(rb_lookup(Key, Val, UDT)).
   21hashtable_lookup(Key, Val, UDT):- notrace(rb_keys(UDT, Keys)),member(Key,Keys),notrace(rb_lookup(Key, Val, UDT)).
   22
   23hashtable_get(UDT, Key, Val):- notrace((hashtable_get_raw(UDT, Key, ValS),value_member(Val,ValS))).
   24hashtable_get_raw(UDT, Key, Val):- notrace((hashtable_lookup(Key, Val, UDT))).
   25
   26hashtable_insert(UDT,Key,Value,NewUDT):- notrace(rb_insert(UDT,Key,Value,NewUDT)).
   27
   28nb_hashtable_insert(UDT,Key,Value):- notrace(nb_rb_insert(UDT,Key,Value)).
   29
   30hashtable_remove(UDT,Key):- notrace((ignore((rb_delete(UDT,Key,NewUDT),nb_copy_rb(NewUDT,UDT))))).
   31
   32hashtable_clear(UDT):- notrace((rb_empty(NewUDT),nb_copy_rb(NewUDT,UDT))).
   33
   34hashtable_set(UDT,Key,Value):- notrace((
   35  (var(UDT)->hashtable_new(UDT);must(is_hashtable(UDT))),
   36 ((nb_hashtable_get_node(Key,UDT,Node) 
   37 -> nb_hashtable_set_node_value(Node, Value)
   38 ; (rb_insert(UDT,Key,Value,NewUDT),nb_copy_rb(NewUDT,UDT)))))).
   39
   40nb_copy_rb(NewUDT,UDT):- 
   41 notrace((
   42  arg(1,NewUDT,Arg1),duplicate_term(Arg1,Arg1D),nb_setarg(1,UDT,Arg1D),
   43  arg(2,NewUDT,Arg2),duplicate_term(Arg2,Arg2D),nb_setarg(2,UDT,Arg2D))).
   44 
   45
   46nb_hashtable_set_node_value(Node, Value):- notrace((nb_rb_set_node_value(Node, Value))).
   47
   48nb_hashtable_get_node(Key, UDT, Node):- notrace((nb_rb_get_node(Key, UDT, Node))).
   49
   50
   51
   52hashtable_set_props(Graph, Props):- is_list(Props), !, 
   53  maplist(hashtable_set_props(Graph), Props).
   54hashtable_set_props(Graph, HT):-
   55  is_hashtable(HT),hashtable_pairs(HT,Pairs),!,
   56  hashtable_set_props(Graph, Pairs).
   57hashtable_set_props(Graph, [P|Props]):- !, 
   58  hashtable_set_props(Graph, Props),
   59  hashtable_set_props(Graph, P).
   60hashtable_set_props(Graph, Props):-
   61  props_kv(Props,Key,Value), 
   62  hashtable_set(Graph, Key, Value).
   63
   64hashtable_get_props(Graph, Props):- var(Props),!, hashtable_pairs(Graph,Props).
   65hashtable_get_props(Graph, Props):- is_list(Props), !, 
   66  maplist(hashtable_get_props(Graph), Props).
   67hashtable_get_props(Graph, Key=Value):- !,hashtable_get(Graph, Key, Value).
   68hashtable_get_props(Graph, Props):-
   69  props_kv(Props,Key,Value), 
   70  hashtable_get(Graph, Key, Value).
   71
   72
   73hashtable_pairs(A,B):-notrace(hashtable_pairs_now(A,B)).
   74
   75hashtable_pairs_now(Var,VarO):- var(Var),!,Var=VarO.
   76hashtable_pairs_now(Atomic,Atom):- \+ compound(Atomic),!,Atom=Atomic.
   77hashtable_pairs_now(UDT,PairsO):- is_hashtable(UDT),!,rb_visit(UDT,Pairs),maplist(hashtable_pairs_now,Pairs,PairsO).
   78hashtable_pairs_now(Pairs,PairsO):- is_list(Pairs),!,maplist(hashtable_pairs_now,Pairs,PairsO).
   79hashtable_pairs_now(Props, Key=ValueO):- % compound(Props),
   80  props_kv(Props,Key,Value),
   81  hashtable_pairs_now(Value,ValueO),!.
   82hashtable_pairs_now(VV,VV).
   83
   84props_kv(Props,Key,Value):- Props=..[_, Key, Value].
   85
   86into_pairs(Graph, Props):- 
   87  notrace(\+ compound(Graph)->Props=Graph 
   88    ; (into_pairs_now(Graph, Pairs),flatten([Pairs],Props))).
   89into_pairs_now(Graph, Props):- is_list(Graph), !, 
   90  maplist(into_pairs_now,Graph,Props).
   91into_pairs_now(Graph, Props):- \+ compound(Graph),!,Props=Graph.
   92into_pairs_now(Graph, Props):- is_hashtable(Graph),!,
   93  % hashtable_pairs
   94  =(Graph,Props).
   95into_pairs_now(Props, Key=Value):- compound(Props),
   96  props_kv(Props,Key,Value)