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.ac.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         , copy_with_variable_replacement/3
  44         , my_term_copy/3
  45         , my_term_copy/4
  46         , atom_concat_list/2
  47         , init/2
  48         , member2/3
  49         , select2/6
  50         , set_elems/2
  51         , instrument_goal/4
  52         ]).
  53
  54 :- use_module(pairlist).
  55 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  56 is_variant(A,B) :-
  57         copy_term_nat(A,AC),
  58         copy_term_nat(B,BC),
  59         term_variables(AC,AVars),
  60         term_variables(BC,BVars),
  61         AC = BC,
  62         is_variant1(AVars),
  63         is_variant2(BVars).
  64
  65 is_variant1([]).
  66 is_variant1([X|Xs]) :-
  67         var(X),
  68         X = '$test',
  69         is_variant1(Xs).
  70
  71 is_variant2([]).
  72 is_variant2([X|Xs]) :-
  73         X == '$test',
  74         is_variant2(Xs).
  75
  76 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  77 time(Phase,Goal) :-
  78         statistics(runtime,[T1|_]),
  79         call(Goal),
  80         statistics(runtime,[T2|_]),
  81         T is T2 - T1,
  82         format('    ~w:\t\t~w ms\n',[Phase,T]).
  83
  84 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  85 replicate(N,E,L) :-
  86         ( N =< 0 ->
  87                 L = []
  88         ;
  89                 L = [E|T],
  90                 M is N - 1,
  91                 replicate(M,E,T)
  92         ).
  93
  94 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  95 pair_all_with([],_,[]).
  96 pair_all_with([X|Xs],Y,[X-Y|Rest]) :-
  97         pair_all_with(Xs,Y,Rest).
  98
  99 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 100 conj2list(Conj,L) :-                            %% transform conjunctions to list
 101   conj2list(Conj,L,[]).
 102
 103 conj2list(Conj,L,T) :-
 104   Conj = (true,G2), !,
 105   conj2list(G2,L,T).
 106 conj2list(Conj,L,T) :-
 107   Conj = (G1,G2), !,
 108   conj2list(G1,L,T1),
 109   conj2list(G2,T1,T).
 110 conj2list(G,[G | T],T).
 111
 112 disj2list(Conj,L) :-                            %% transform disjunctions to list
 113   disj2list(Conj,L,[]).
 114 disj2list(Conj,L,T) :-
 115   Conj = (fail;G2), !,
 116   disj2list(G2,L,T).
 117 disj2list(Conj,L,T) :-
 118   Conj = (G1;G2), !,
 119   disj2list(G1,L,T1),
 120   disj2list(G2,T1,T).
 121 disj2list(G,[G | T],T).
 122
 123 list2conj([],true).
 124 list2conj([G],X) :- !, X = G.
 125 list2conj([G|Gs],C) :-
 126         ( G == true ->                          %% remove some redundant trues
 127                 list2conj(Gs,C)
 128         ;
 129                 C = (G,R),
 130                 list2conj(Gs,R)
 131         ).
 132
 133 list2disj([],fail).
 134 list2disj([G],X) :- !, X = G.
 135 list2disj([G|Gs],C) :-
 136         ( G == fail ->                          %% remove some redundant fails
 137                 list2disj(Gs,C)
 138         ;
 139                 C = (G;R),
 140                 list2disj(Gs,R)
 141         ).
 142
 143 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 144 % check wether two rules are identical
 145
 146 identical_rules(rule(H11,H21,G1,B1),rule(H12,H22,G2,B2)) :-
 147    G1 == G2,
 148    identical_bodies(B1,B2),
 149    permutation(H11,P1),
 150    P1 == H12,
 151    permutation(H21,P2),
 152    P2 == H22.
 153
 154 identical_bodies(B1,B2) :-
 155    ( B1 = (X1 = Y1),
 156      B2 = (X2 = Y2) ->
 157      ( X1 == X2,
 158        Y1 == Y2
 159      ; X1 == Y2,
 160        X2 == Y1
 161      ),
 162      !
 163    ; B1 == B2
 164    ).
 165
 166 % replace variables in list
 167
 168 copy_with_variable_replacement(X,Y,L) :-
 169    ( var(X) ->
 170      ( lookup_eq(L,X,Y) ->
 171        true
 172      ; X = Y
 173      )
 174    ; functor(X,F,A),
 175      functor(Y,F,A),
 176      X =.. [_|XArgs],
 177      Y =.. [_|YArgs],
 178      copy_with_variable_replacement_l(XArgs,YArgs,L)
 179    ).
 180
 181 copy_with_variable_replacement_l([],[],_).
 182 copy_with_variable_replacement_l([X|Xs],[Y|Ys],L) :-
 183    copy_with_variable_replacement(X,Y,L),
 184    copy_with_variable_replacement_l(Xs,Ys,L).
 185
 186 %% build variable replacement list
 187
 188 variable_replacement(X,Y,L) :-
 189    variable_replacement(X,Y,[],L).
 190
 191 variable_replacement(X,Y,L1,L2) :-
 192    ( var(X) ->
 193      var(Y),
 194      ( lookup_eq(L1,X,Z) ->
 195        Z == Y,
 196        L2 = L1
 197      ; ( X == Y -> L2=L1 ; L2 = [X-Y,Y-X|L1])
 198      )
 199    ; X =.. [F|XArgs],
 200      nonvar(Y),
 201      Y =.. [F|YArgs],
 202      variable_replacement_l(XArgs,YArgs,L1,L2)
 203    ).
 204
 205 variable_replacement_l([],[],L,L).
 206 variable_replacement_l([X|Xs],[Y|Ys],L1,L3) :-
 207    variable_replacement(X,Y,L1,L2),
 208    variable_replacement_l(Xs,Ys,L2,L3).
 209
 210 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 211 my_term_copy(X,Dict,Y) :-
 212    my_term_copy(X,Dict,_,Y).
 213
 214 my_term_copy(X,Dict1,Dict2,Y) :-
 215    (   var(X) ->
 216        (   lookup_eq(Dict1,X,Y) ->
 217            Dict2 = Dict1
 218        ;   Dict2 = [X-Y|Dict1]
 219        )
 220    ;   functor(X,XF,XA),
 221        functor(Y,XF,XA),
 222        X =.. [_|XArgs],
 223        Y =.. [_|YArgs],
 224        my_term_copy_list(XArgs,Dict1,Dict2,YArgs)
 225    ).
 226
 227 my_term_copy_list([],Dict,Dict,[]).
 228 my_term_copy_list([X|Xs],Dict1,Dict3,[Y|Ys]) :-
 229    my_term_copy(X,Dict1,Dict2,Y),
 230    my_term_copy_list(Xs,Dict2,Dict3,Ys).
 231
 232 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 233 atom_concat_list([X],X) :- ! .
 234 atom_concat_list([X|Xs],A) :-
 235         atom_concat_list(Xs,B),
 236         atom_concat(X,B,A).
 237
 238 set_elems([],_).
 239 set_elems([X|Xs],X) :-
 240         set_elems(Xs,X).
 241
 242 init([],[]).
 243 init([X],[]) :- !.
 244 init([X|Xs],[X|R]) :-
 245         init(Xs,R).
 246
 247 member2([X|_],[Y|_],X-Y).
 248 member2([_|Xs],[_|Ys],P) :-
 249         member2(Xs,Ys,P).
 250
 251 select2(X, Y, [X|Xs], [Y|Ys], Xs, Ys).
 252 select2(X, Y, [X1|Xs], [Y1|Ys], [X1|NXs], [Y1|NYs]) :-
 253         select2(X, Y, Xs, Ys, NXs, NYs).
 254
 255 instrument_goal(Goal,Pre,Post,(Pre,Goal,Post)).