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