hprolog.pl

   1 :- module(hprolog,
   2           [ substitute_eq/4,            % +OldVal, +OldList, +NewVal, -NewList
   3             memberchk_eq/2,             % +Val, +List
   4             intersect_eq/3,             % +List1, +List2, -Intersection
   5             list_difference_eq/3,       % +List, -Subtract, -Rest
   6             take/3,                     % +N, +List, -FirstElements
   7             drop/3,                     % +N, +List, -LastElements
   8             split_at/4,                 % +N, +List, -FirstElements, -LastElements
   9             max_go_list/2,              % +List, -Max
  10             or_list/2,                  % +ListOfInts, -BitwiseOr
  11             sublist/2,                  % ?Sublist, +List
  12             bounded_sublist/3,          % ?Sublist, +List, +Bound
  13             chr_delete/3,
  14             init_store/2,
  15             get_store/2,
  16             update_store/2,
  17             make_get_store_goal/3,
  18             make_update_store_goal/3,
  19             make_init_store_goal/3,
  20
  21             empty_ds/1,
  22             ds_to_list/2,
  23             get_ds/3,
  24             put_ds/4
  25 %           lookup_ht1/4
  26           ]).
  27 :- use_module(library(lists)).
  28 :- use_module(library(assoc)).
  29
  30 empty_ds(DS) :- empty_assoc(DS).
  31 ds_to_list(DS,LIST) :- assoc_to_list(DS,LIST).
  32 get_ds(A,B,C) :- get_assoc(A,B,C).
  33 put_ds(A,B,C,D) :- put_assoc(A,B,C,D).
  34
  35
  36 init_store(Name,Value) :- nb_setval(Name,Value).
  37
  38 get_store(Name,Value) :- nb_getval(Name,Value).
  39
  40 update_store(Name,Value) :- b_setval(Name,Value).
  41
  42 make_init_store_goal(Name,Value,Goal) :- Goal = nb_setval(Name,Value).
  43
  44 make_get_store_goal(Name,Value,Goal) :- Goal = nb_getval(Name,Value).
  45
  46 make_update_store_goal(Name,Value,Goal) :- Goal = b_setval(Name,Value).
  47
  48
  49                  /*******************************
  50                  *      MORE LIST OPERATIONS    *
  51                  *******************************/
  52
  53 %       substitute_eq(+OldVal, +OldList, +NewVal, -NewList)
  54 %
  55 %       Substitute OldVal by NewVal in OldList and unify the result
  56 %       with NewList.
  57
  58 substitute_eq(_, [], _, []) :- ! .
  59 substitute_eq(X, [U|Us], Y, [V|Vs]) :-
  60         (   X == U
  61         ->  V = Y,
  62             substitute_eq(X, Us, Y, Vs)
  63         ;   V = U,
  64             substitute_eq(X, Us, Y, Vs)
  65         ).
  66
  67 %       memberchk_eq(+Val, +List)
  68 %
  69 %       Deterministic check of membership using == rather than
  70 %       unification.
  71
  72 memberchk_eq(X, [Y|Ys]) :-
  73    (   X == Y
  74    ->  true
  75    ;   memberchk_eq(X, Ys)
  76    ).
  77
  78 % :- load_foreign_library(chr_support).
  79
  80 %       list_difference_eq(+List, -Subtract, -Rest)
  81 %
  82 %       Delete all elements of Subtract from List and unify the result
  83 %       with Rest.  Element comparision is done using ==/2.
  84
  85 list_difference_eq([],_,[]).
  86 list_difference_eq([X|Xs],Ys,L) :-
  87         (   memberchk_eq(X,Ys)
  88         ->  list_difference_eq(Xs,Ys,L)
  89         ;   L = [X|T],
  90             list_difference_eq(Xs,Ys,T)
  91         ).
  92
  93 %       intersect_eq(+List1, +List2, -Intersection)
  94 %
  95 %       Determine the intersection of two lists without unifying values.
  96
  97 intersect_eq([], _, []).
  98 intersect_eq([X|Xs], Ys, L) :-
  99         (   memberchk_eq(X, Ys)
 100         ->  L = [X|T],
 101             intersect_eq(Xs, Ys, T)
 102         ;   intersect_eq(Xs, Ys, L)
 103         ).
 104
 105
 106 %       take(+N, +List, -FirstElements)
 107 %
 108 %       Take the first  N  elements  from   List  and  unify  this  with
 109 %       FirstElements. The definition is based   on the GNU-Prolog lists
 110 %       library. Implementation by Jan Wielemaker.
 111
 112 take(0, _, []) :- !.
 113 take(N, [H|TA], [H|TB]) :-
 114         N > 0,
 115         N2 is N - 1,
 116         take(N2, TA, TB).
 117
 118 %       Drop the first  N  elements  from   List  and  unify  the remainder  with
 119 %       LastElements.
 120
 121 drop(0,LastElements,LastElements) :- !.
 122 drop(N,[_|Tail],LastElements) :-
 123         N > 0,
 124         N1 is N  - 1,
 125         drop(N1,Tail,LastElements).
 126
 127 split_at(0,L,[],L) :- !.
 128 split_at(N,[H|T],[H|L1],L2) :-
 129         M is N -1,
 130         split_at(M,T,L1,L2).
 131
 132 %       max_go_list(+List, -Max)
 133 %
 134 %       Return the maximum of List in the standard order of terms.
 135
 136 max_go_list([H|T], Max) :-
 137         max_go_list(T, H, Max).
 138
 139 max_go_list([], Max, Max).
 140 max_go_list([H|T], X, Max) :-
 141         (   H @=< X
 142         ->  max_go_list(T, X, Max)
 143         ;   max_go_list(T, H, Max)
 144         ).
 145
 146 %       or_list(+ListOfInts, -BitwiseOr)
 147 %
 148 %       Do a bitwise disjuction over all integer members of ListOfInts.
 149
 150 or_list(L, Or) :-
 151         or_list(L, 0, Or).
 152
 153 or_list([], Or, Or).
 154 or_list([H|T], Or0, Or) :-
 155         Or1 is H \/ Or0,
 156         or_list(T, Or1, Or).
 157
 158
 159 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 160 sublist(L, L).
 161 sublist(Sub, [H|T]) :-
 162         '$sublist1'(T, H, Sub).
 163
 164 '$sublist1'(Sub, _, Sub).
 165 '$sublist1'([H|T], _, Sub) :-
 166         '$sublist1'(T, H, Sub).
 167 '$sublist1'([H|T], X, [X|Sub]) :-
 168         '$sublist1'(T, H, Sub).
 169
 170 bounded_sublist(Sublist,_,_) :-
 171         Sublist = [].
 172 bounded_sublist(Sublist,[H|List],Bound) :-
 173         Bound > 0,
 174         (
 175                 Sublist = [H|Rest],
 176                 NBound is Bound - 1,
 177                 bounded_sublist(Rest,List,NBound)
 178         ;
 179                 bounded_sublist(Sublist,List,Bound)
 180         ).
 181
 182
 183 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 184
 185 chr_delete([], _, []).
 186 chr_delete([H|T], X, L) :-
 187         (   H==X ->
 188             chr_delete(T, X, L)
 189         ;   L=[H|RT],
 190             chr_delete(T, X, RT)
 191         ).
 192