hprolog.pl

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