hprolog.pl

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