hprolog.pl

   1 :- module(hprolog,
   2           [ prolog_flag/3,              % +Flag, -Old, +New
   3             append_lists/2,             % +ListOfLists, -List
   4             nth/3,                      % ?Index, ?List, ?Element
   5             substitute/4,               % +OldVal, +OldList, +NewVal, -NewList
   6             memberchk_eq/2,             % +Val, +List
   7             intersect_eq/3,             % +List1, +List2, -Intersection
   8             list_difference_eq/3,       % +List, -Subtract, -Rest
   9             take/3,                     % +N, +List, -FirstElements
  10             max_go_list/2,              % +List, -Max
  11             or_list/2,                  % +ListOfInts, -BitwiseOr
  12             sublist/2,
  13             min_list/2,
  14             chr_delete/3,
  15             strip_attributes/2,
  16             restore_attributes/2
  17           ]).
  18 :- use_module(library(lists)).
  19
  20 %       prolog_flag(+Flag, -Old, +New)
  21 %
  22 %       Combine ISO prolog flag reading and writing
  23
  24 prolog_flag(Flag, Old, New) :-
  25         current_prolog_flag(Flag, Old),
  26         (   Old == New
  27         ->  true
  28         ;   set_prolog_flag(Flag, New)
  29         ).
  30
  31
  32                  /*******************************
  33                  *      MORE LIST OPERATIONS    *
  34                  *******************************/
  35
  36 %       append_lists(+ListOfLists, -List)
  37 %
  38 %       Convert a one-level nested list into a flat one.  E.g.
  39 %       append_lists([[a,b], [c]], X) --> X = [a,b,c].  See also
  40 %       flatten/3.
  41
  42 append_lists([],[]).
  43 append_lists([X|Xs],L) :-
  44         append(X,T,L),
  45         append_lists(Xs,T).
  46
  47
  48 %       nth(?Index, ?List, ?Element)
  49 %
  50 %       Same as nth1/3
  51
  52 nth(Index, List, Element) :-
  53         nth1(Index, List, Element).
  54
  55
  56 %       substitute(+OldVal, +OldList, +NewVal, -NewList)
  57 %
  58 %       Substitute OldVal by NewVal in OldList and unify the result
  59 %       with NewList.  JW: Shouldn't this be called substitute_eq/4?
  60
  61 substitute(_, [], _, []) :- ! .
  62 substitute(X, [U|Us], Y, [V|Vs]) :-
  63         (   X == U
  64         ->  V = Y,
  65             substitute(X, Us, Y, Vs)
  66         ;   V = U,
  67             substitute(X, Us, Y, Vs)
  68         ).
  69
  70 %       memberchk_eq(+Val, +List)
  71 %
  72 %       Deterministic check of membership using == rather than
  73 %       unification.
  74
  75 memberchk_eq(X, [Y|Ys]) :-
  76    (   X == Y
  77    ->  true
  78    ;   memberchk_eq(X, Ys)
  79    ).
  80
  81
  82 %       list_difference_eq(+List, -Subtract, -Rest)
  83 %
  84 %       Delete all elements of Subtract from List and unify the result
  85 %       with Rest.  Element comparision is done using ==/2.
  86
  87 list_difference_eq([],_,[]).
  88 list_difference_eq([X|Xs],Ys,L) :-
  89         (   memberchk_eq(X,Ys)
  90         ->  list_difference_eq(Xs,Ys,L)
  91         ;   L = [X|T],
  92             list_difference_eq(Xs,Ys,T)
  93         ).
  94
  95 %       intersect_eq(+List1, +List2, -Intersection)
  96 %
  97 %       Determine the intersection of two lists without unifying values.
  98
  99 intersect_eq([], _, []).
 100 intersect_eq([X|Xs], Ys, L) :-
 101         (   memberchk_eq(X, Ys)
 102         ->  L = [X|T],
 103             intersect_eq(Xs, Ys, T)
 104         ;   intersect_eq(Xs, Ys, L)
 105         ).
 106
 107
 108 %       take(+N, +List, -FirstElements)
 109 %
 110 %       Take the first  N  elements  from   List  and  unify  this  with
 111 %       FirstElements. The definition is based   on the GNU-Prolog lists
 112 %       library. Implementation by Jan Wielemaker.
 113
 114 take(0, _, []) :- !.
 115 take(N, [H|TA], [H|TB]) :-
 116         N > 0,
 117         N2 is N - 1,
 118         take(N2, TA, TB).
 119
 120
 121 %       max_go_list(+List, -Max)
 122 %
 123 %       Return the maximum of List in the standard order of terms.
 124
 125 max_go_list([H|T], Max) :-
 126         max_go_list(T, H, Max).
 127
 128 max_go_list([], Max, Max).
 129 max_go_list([H|T], X, Max) :-
 130         (   H @=< X
 131         ->  max_go_list(T, X, Max)
 132         ;   max_go_list(T, H, Max)
 133         ).
 134
 135 %       or_list(+ListOfInts, -BitwiseOr)
 136 %
 137 %       Do a bitwise disjuction over all integer members of ListOfInts.
 138
 139 or_list(L, Or) :-
 140         or_list(L, 0, Or).
 141
 142 or_list([], Or, Or).
 143 or_list([H|T], Or0, Or) :-
 144         Or1 is H \/ Or0,
 145         or_list(T, Or1, Or).
 146
 147
 148 sublist(L, L).
 149 sublist(Sub, [H|T]) :-
 150         '$sublist1'(T, H, Sub).
 151
 152 '$sublist1'(Sub, _, Sub).
 153 '$sublist1'([H|T], _, Sub) :-
 154         '$sublist1'(T, H, Sub).
 155 '$sublist1'([H|T], X, [X|Sub]) :-
 156         '$sublist1'(T, H, Sub).
 157
 158 min_list([H|T], Min) :-
 159         '$min_list1'(T, H, Min).
 160
 161 '$min_list1'([], Min, Min).
 162 '$min_list1'([H|T], X, Min) :-
 163         (   H>=X ->
 164             '$min_list1'(T, X, Min)
 165         ;   '$min_list1'(T, H, Min)
 166         ).
 167
 168 chr_delete([], _, []).
 169 chr_delete([H|T], X, L) :-
 170         (   H==X ->
 171             chr_delete(T, X, L)
 172         ;   L=[H|RT],
 173             chr_delete(T, X, RT)
 174         ).
 175
 176 strip_attributes([],[]).
 177 strip_attributes([V|R],[V2|R2]) :-
 178         (   attvar(V) ->
 179             get_attrs(V,VAttrs),
 180             remove_attrs(V,VAttrs,V2)
 181         ;   V2 = []
 182         ),
 183         strip_attributes(R,R2).
 184
 185 remove_attrs(_V,[],[]).
 186 remove_attrs(V,att(X,Y,OtherAttrs),[(X,Y)|R]) :-
 187         del_attr(V,X),
 188         remove_attrs(V,OtherAttrs,R).
 189
 190 restore_attributes([],[]).
 191 restore_attributes([_V|R],[[]|R2]) :-
 192         restore_attributes(R,R2).
 193 restore_attributes([V|R],[[(X,Y)|RVAttr]|R2]) :-
 194         put_attr(V,X,Y),
 195         restore_attributes([V|R],[RVAttr|R2]).