chr_compiler_utility.pl

   1 /*  $Id$
   2
   3     Part of CHR (Constraint Handling Rules)
   4
   5     Author:        Tom Schrijvers
   6     E-mail:        Tom.Schrijvers@cs.kuleuven.be
   7     WWW:           http://www.swi-prolog.org
   8     Copyright (C): 2005-2006, K.U. Leuven
   9
  10     This program is free software; you can redistribute it and/or
  11     modify it under the terms of the GNU General Public License
  12     as published by the Free Software Foundation; either version 2
  13     of the License, or (at your option) any later version.
  14
  15     This program is distributed in the hope that it will be useful,
  16     but WITHOUT ANY WARRANTY; without even the implied warranty of
  17     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18     GNU General Public License for more details.
  19
  20     You should have received a copy of the GNU Lesser General Public
  21     License along with this library; if not, write to the Free Software
  22     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  23
  24     As a special exception, if you link this library with other files,
  25     compiled with a Free Software compiler, to produce an executable, this
  26     library does not by itself cause the resulting executable to be covered
  27     by the GNU General Public License. This exception does not however
  28     invalidate any other reasons why the executable file might be covered by
  29     the GNU General Public License.
  30 */
  31 :- module(chr_compiler_utility,
  32         [ is_variant/2
  33         , time/2
  34         , replicate/3
  35         , pair_all_with/3
  36         , conj2list/2
  37         , list2conj/2
  38         , disj2list/2
  39         , list2disj/2
  40         , variable_replacement/3
  41         , variable_replacement/4
  42         , identical_rules/2
  43         , identical_guarded_rules/2
  44         , copy_with_variable_replacement/3
  45         , my_term_copy/3
  46         , my_term_copy/4
  47         , atom_concat_list/2
  48         , atomic_concat/3
  49         , init/2
  50         , member2/3
  51         , select2/6
  52         , set_elems/2
  53         , instrument_goal/4
  54         , sort_by_key/3
  55         ]).
  56
  57 :- use_module(pairlist).
  58 :- use_module(library(lists), [permutation/2]).
  59
  60 %% SICStus begin
  61 %% use_module(library(terms),[term_variables/2]).
  62 %% SICStus end
  63
  64
  65 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  66 is_variant(A,B) :-
  67         copy_term_nat(A,AC),
  68         copy_term_nat(B,BC),
  69         term_variables(AC,AVars),
  70         term_variables(BC,BVars),
  71         AC = BC,
  72         is_variant1(AVars),
  73         is_variant2(BVars).
  74
  75 is_variant1([]).
  76 is_variant1([X|Xs]) :-
  77         var(X),
  78         X = '$test',
  79         is_variant1(Xs).
  80
  81 is_variant2([]).
  82 is_variant2([X|Xs]) :-
  83         X == '$test',
  84         is_variant2(Xs).
  85
  86 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  87 % time(Phase,Goal) :-
  88 %       statistics(runtime,[T1|_]),
  89 %       call(Goal),
  90 %       statistics(runtime,[T2|_]),
  91 %       T is T2 - T1,
  92 %       format('    ~w ~46t ~D~80| ms\n',[Phase,T]),
  93 %       deterministic(Det),
  94 %       ( Det == true ->
  95 %               true
  96 %       ;
  97 %               format('\t\tNOT DETERMINISTIC!\n',[])
  98 %       ).
  99 time(_,Goal) :- call(Goal).
 100
 101 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 102 replicate(N,E,L) :-
 103         ( N =< 0 ->
 104                 L = []
 105         ;
 106                 L = [E|T],
 107                 M is N - 1,
 108                 replicate(M,E,T)
 109         ).
 110
 111 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 112 pair_all_with([],_,[]).
 113 pair_all_with([X|Xs],Y,[X-Y|Rest]) :-
 114         pair_all_with(Xs,Y,Rest).
 115
 116 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 117 conj2list(Conj,L) :-                            %% transform conjunctions to list
 118   conj2list(Conj,L,[]).
 119
 120 conj2list(Var,L,T) :-
 121         var(Var), !,
 122         L = [Var|T].
 123 conj2list(true,L,L) :- !.
 124 conj2list(Conj,L,T) :-
 125   Conj = (G1,G2), !,
 126   conj2list(G1,L,T1),
 127   conj2list(G2,T1,T).
 128 conj2list(G,[G | T],T).
 129
 130 disj2list(Conj,L) :-                            %% transform disjunctions to list
 131   disj2list(Conj,L,[]).
 132 disj2list(Conj,L,T) :-
 133   Conj = (fail;G2), !,
 134   disj2list(G2,L,T).
 135 disj2list(Conj,L,T) :-
 136   Conj = (G1;G2), !,
 137   disj2list(G1,L,T1),
 138   disj2list(G2,T1,T).
 139 disj2list(G,[G | T],T).
 140
 141 list2conj([],true).
 142 list2conj([G],X) :- !, X = G.
 143 list2conj([G|Gs],C) :-
 144         ( G == true ->                          %% remove some redundant trues
 145                 list2conj(Gs,C)
 146         ;
 147                 C = (G,R),
 148                 list2conj(Gs,R)
 149         ).
 150
 151 list2disj([],fail).
 152 list2disj([G],X) :- !, X = G.
 153 list2disj([G|Gs],C) :-
 154         ( G == fail ->                          %% remove some redundant fails
 155                 list2disj(Gs,C)
 156         ;
 157                 C = (G;R),
 158                 list2disj(Gs,R)
 159         ).
 160
 161 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 162 % check wether two rules are identical
 163
 164 identical_guarded_rules(rule(H11,H21,G1,_),rule(H12,H22,G2,_)) :-
 165    G1 == G2,
 166    permutation(H11,P1),
 167    P1 == H12,
 168    permutation(H21,P2),
 169    P2 == H22.
 170
 171 identical_rules(rule(H11,H21,G1,B1),rule(H12,H22,G2,B2)) :-
 172    G1 == G2,
 173    identical_bodies(B1,B2),
 174    permutation(H11,P1),
 175    P1 == H12,
 176    permutation(H21,P2),
 177    P2 == H22.
 178
 179 identical_bodies(B1,B2) :-
 180    ( B1 = (X1 = Y1),
 181      B2 = (X2 = Y2) ->
 182      ( X1 == X2,
 183        Y1 == Y2
 184      ; X1 == Y2,
 185        X2 == Y1
 186      ),
 187      !
 188    ; B1 == B2
 189    ).
 190
 191 % replace variables in list
 192
 193 copy_with_variable_replacement(X,Y,L) :-
 194    ( var(X) ->
 195      ( lookup_eq(L,X,Y) ->
 196        true
 197      ; X = Y
 198      )
 199    ; functor(X,F,A),
 200      functor(Y,F,A),
 201      X =.. [_|XArgs],
 202      Y =.. [_|YArgs],
 203      copy_with_variable_replacement_l(XArgs,YArgs,L)
 204    ).
 205
 206 copy_with_variable_replacement_l([],[],_).
 207 copy_with_variable_replacement_l([X|Xs],[Y|Ys],L) :-
 208    copy_with_variable_replacement(X,Y,L),
 209    copy_with_variable_replacement_l(Xs,Ys,L).
 210
 211 % build variable replacement list
 212
 213 variable_replacement(X,Y,L) :-
 214    variable_replacement(X,Y,[],L).
 215
 216 variable_replacement(X,Y,L1,L2) :-
 217    ( var(X) ->
 218      var(Y),
 219      ( lookup_eq(L1,X,Z) ->
 220        Z == Y,
 221        L2 = L1
 222      ; ( X == Y -> L2=L1 ; L2 = [X-Y,Y-X|L1])
 223      )
 224    ; X =.. [F|XArgs],
 225      nonvar(Y),
 226      Y =.. [F|YArgs],
 227      variable_replacement_l(XArgs,YArgs,L1,L2)
 228    ).
 229
 230 variable_replacement_l([],[],L,L).
 231 variable_replacement_l([X|Xs],[Y|Ys],L1,L3) :-
 232    variable_replacement(X,Y,L1,L2),
 233    variable_replacement_l(Xs,Ys,L2,L3).
 234
 235 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 236 my_term_copy(X,Dict,Y) :-
 237    my_term_copy(X,Dict,_,Y).
 238
 239 my_term_copy(X,Dict1,Dict2,Y) :-
 240    (   var(X) ->
 241        (   lookup_eq(Dict1,X,Y) ->
 242            Dict2 = Dict1
 243        ;   Dict2 = [X-Y|Dict1]
 244        )
 245    ;   functor(X,XF,XA),
 246        functor(Y,XF,XA),
 247        X =.. [_|XArgs],
 248        Y =.. [_|YArgs],
 249        my_term_copy_list(XArgs,Dict1,Dict2,YArgs)
 250    ).
 251
 252 my_term_copy_list([],Dict,Dict,[]).
 253 my_term_copy_list([X|Xs],Dict1,Dict3,[Y|Ys]) :-
 254    my_term_copy(X,Dict1,Dict2,Y),
 255    my_term_copy_list(Xs,Dict2,Dict3,Ys).
 256
 257 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 258 atom_concat_list([X],X) :- ! .
 259 atom_concat_list([X|Xs],A) :-
 260         atom_concat_list(Xs,B),
 261         atomic_concat(X,B,A).
 262
 263 atomic_concat(A,B,C) :-
 264         make_atom(A,AA),
 265         make_atom(B,BB),
 266         atom_concat(AA,BB,C).
 267
 268 make_atom(A,AA) :-
 269         (
 270           atom(A) ->
 271           AA = A
 272         ;
 273           number(A) ->
 274           number_codes(A,AL),
 275           atom_codes(AA,AL)
 276         ).
 277
 278
 279
 280 set_elems([],_).
 281 set_elems([X|Xs],X) :-
 282         set_elems(Xs,X).
 283
 284 init([],[]).
 285 init([_],[]) :- !.
 286 init([X|Xs],[X|R]) :-
 287         init(Xs,R).
 288
 289 member2([X|_],[Y|_],X-Y).
 290 member2([_|Xs],[_|Ys],P) :-
 291         member2(Xs,Ys,P).
 292
 293 select2(X, Y, [X|Xs], [Y|Ys], Xs, Ys).
 294 select2(X, Y, [X1|Xs], [Y1|Ys], [X1|NXs], [Y1|NYs]) :-
 295         select2(X, Y, Xs, Ys, NXs, NYs).
 296
 297 instrument_goal(Goal,Pre,Post,(Pre,Goal,Post)).
 298
 299 sort_by_key(List,Keys,SortedList) :-
 300         pairup(Keys,List,Pairs),
 301         sort(Pairs,SortedPairs),
 302         once(pairup(_,SortedList,SortedPairs)).