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         [ time/2
  33         , replicate/3
  34         , pair_all_with/3
  35         , conj2list/2
  36         , list2conj/2
  37         , disj2list/2
  38         , list2disj/2
  39         , variable_replacement/3
  40         , variable_replacement/4
  41         , identical_rules/2
  42         , identical_guarded_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         , sort_by_key/3
  54         , arg1/3
  55         , wrap_in_functor/3
  56         , tree_set_empty/1
  57         , tree_set_memberchk/2
  58         , tree_set_add/3
  59         ]).
  60
  61 :- use_module(pairlist).
  62 :- use_module(library(lists), [permutation/2]).
  63 :- use_module(library(assoc)).
  64
  65 %% SICStus begin
  66 %% use_module(library(terms),[term_variables/2]).
  67 %% SICStus end
  68
  69
  70 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  71 % time(Phase,Goal) :-
  72 %       statistics(runtime,[T1|_]),
  73 %       call(Goal),
  74 %       statistics(runtime,[T2|_]),
  75 %       T is T2 - T1,
  76 %       format('    ~w ~46t ~D~80| ms\n',[Phase,T]),
  77 %       deterministic(Det),
  78 %       ( Det == true ->
  79 %               true
  80 %       ;
  81 %               format('\t\tNOT DETERMINISTIC!\n',[])
  82 %       ).
  83 time(_,Goal) :- call(Goal).
  84
  85 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  86 replicate(N,E,L) :-
  87         ( N =< 0 ->
  88                 L = []
  89         ;
  90                 L = [E|T],
  91                 M is N - 1,
  92                 replicate(M,E,T)
  93         ).
  94
  95 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  96 pair_all_with([],_,[]).
  97 pair_all_with([X|Xs],Y,[X-Y|Rest]) :-
  98         pair_all_with(Xs,Y,Rest).
  99
 100 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 101 conj2list(Conj,L) :-                            %% transform conjunctions to list
 102   conj2list(Conj,L,[]).
 103
 104 conj2list(Var,L,T) :-
 105         var(Var), !,
 106         L = [Var|T].
 107 conj2list(true,L,L) :- !.
 108 conj2list(Conj,L,T) :-
 109   Conj = (G1,G2), !,
 110   conj2list(G1,L,T1),
 111   conj2list(G2,T1,T).
 112 conj2list(G,[G | T],T).
 113
 114 disj2list(Conj,L) :-                            %% transform disjunctions to list
 115   disj2list(Conj,L,[]).
 116 disj2list(Conj,L,T) :-
 117   Conj = (fail;G2), !,
 118   disj2list(G2,L,T).
 119 disj2list(Conj,L,T) :-
 120   Conj = (G1;G2), !,
 121   disj2list(G1,L,T1),
 122   disj2list(G2,T1,T).
 123 disj2list(G,[G | T],T).
 124
 125 list2conj([],true).
 126 list2conj([G],X) :- !, X = G.
 127 list2conj([G|Gs],C) :-
 128         ( G == true ->                          %% remove some redundant trues
 129                 list2conj(Gs,C)
 130         ;
 131                 C = (G,R),
 132                 list2conj(Gs,R)
 133         ).
 134
 135 list2disj([],fail).
 136 list2disj([G],X) :- !, X = G.
 137 list2disj([G|Gs],C) :-
 138         ( G == fail ->                          %% remove some redundant fails
 139                 list2disj(Gs,C)
 140         ;
 141                 C = (G;R),
 142                 list2disj(Gs,R)
 143         ).
 144
 145 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 146 % check wether two rules are identical
 147
 148 identical_guarded_rules(rule(H11,H21,G1,_),rule(H12,H22,G2,_)) :-
 149    G1 == G2,
 150    permutation(H11,P1),
 151    P1 == H12,
 152    permutation(H21,P2),
 153    P2 == H22.
 154
 155 identical_rules(rule(H11,H21,G1,B1),rule(H12,H22,G2,B2)) :-
 156    G1 == G2,
 157    identical_bodies(B1,B2),
 158    permutation(H11,P1),
 159    P1 == H12,
 160    permutation(H21,P2),
 161    P2 == H22.
 162
 163 identical_bodies(B1,B2) :-
 164    ( B1 = (X1 = Y1),
 165      B2 = (X2 = Y2) ->
 166      ( X1 == X2,
 167        Y1 == Y2
 168      ; X1 == Y2,
 169        X2 == Y1
 170      ),
 171      !
 172    ; B1 == B2
 173    ).
 174
 175 % replace variables in list
 176
 177 copy_with_variable_replacement(X,Y,L) :-
 178    ( var(X) ->
 179      ( lookup_eq(L,X,Y) ->
 180        true
 181      ; X = Y
 182      )
 183    ; functor(X,F,A),
 184      functor(Y,F,A),
 185      X =.. [_|XArgs],
 186      Y =.. [_|YArgs],
 187      copy_with_variable_replacement_l(XArgs,YArgs,L)
 188    ).
 189
 190 copy_with_variable_replacement_l([],[],_).
 191 copy_with_variable_replacement_l([X|Xs],[Y|Ys],L) :-
 192    copy_with_variable_replacement(X,Y,L),
 193    copy_with_variable_replacement_l(Xs,Ys,L).
 194
 195 % build variable replacement list
 196
 197 variable_replacement(X,Y,L) :-
 198    variable_replacement(X,Y,[],L).
 199
 200 variable_replacement(X,Y,L1,L2) :-
 201    ( var(X) ->
 202      var(Y),
 203      ( lookup_eq(L1,X,Z) ->
 204        Z == Y,
 205        L2 = L1
 206      ; ( X == Y -> L2=L1 ; L2 = [X-Y,Y-X|L1])
 207      )
 208    ; X =.. [F|XArgs],
 209      nonvar(Y),
 210      Y =.. [F|YArgs],
 211      variable_replacement_l(XArgs,YArgs,L1,L2)
 212    ).
 213
 214 variable_replacement_l([],[],L,L).
 215 variable_replacement_l([X|Xs],[Y|Ys],L1,L3) :-
 216    variable_replacement(X,Y,L1,L2),
 217    variable_replacement_l(Xs,Ys,L2,L3).
 218
 219 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 220 my_term_copy(X,Dict,Y) :-
 221    my_term_copy(X,Dict,_,Y).
 222
 223 my_term_copy(X,Dict1,Dict2,Y) :-
 224    (   var(X) ->
 225        (   lookup_eq(Dict1,X,Y) ->
 226            Dict2 = Dict1
 227        ;   Dict2 = [X-Y|Dict1]
 228        )
 229    ;   functor(X,XF,XA),
 230        functor(Y,XF,XA),
 231        X =.. [_|XArgs],
 232        Y =.. [_|YArgs],
 233        my_term_copy_list(XArgs,Dict1,Dict2,YArgs)
 234    ).
 235
 236 my_term_copy_list([],Dict,Dict,[]).
 237 my_term_copy_list([X|Xs],Dict1,Dict3,[Y|Ys]) :-
 238    my_term_copy(X,Dict1,Dict2,Y),
 239    my_term_copy_list(Xs,Dict2,Dict3,Ys).
 240
 241 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 242 atom_concat_list([X],X) :- ! .
 243 atom_concat_list([X|Xs],A) :-
 244         atom_concat_list(Xs,B),
 245         atomic_concat(X,B,A).
 246
 247 atomic_concat(A,B,C) :-
 248         make_atom(A,AA),
 249         make_atom(B,BB),
 250         atom_concat(AA,BB,C).
 251
 252 make_atom(A,AA) :-
 253         (
 254           atom(A) ->
 255           AA = A
 256         ;
 257           number(A) ->
 258           number_codes(A,AL),
 259           atom_codes(AA,AL)
 260         ).
 261
 262
 263
 264 set_elems([],_).
 265 set_elems([X|Xs],X) :-
 266         set_elems(Xs,X).
 267
 268 init([],[]).
 269 init([_],[]) :- !.
 270 init([X|Xs],[X|R]) :-
 271         init(Xs,R).
 272
 273 member2([X|_],[Y|_],X-Y).
 274 member2([_|Xs],[_|Ys],P) :-
 275         member2(Xs,Ys,P).
 276
 277 select2(X, Y, [X|Xs], [Y|Ys], Xs, Ys).
 278 select2(X, Y, [X1|Xs], [Y1|Ys], [X1|NXs], [Y1|NYs]) :-
 279         select2(X, Y, Xs, Ys, NXs, NYs).
 280
 281 instrument_goal(Goal,Pre,Post,(Pre,Goal,Post)).
 282
 283 sort_by_key(List,Keys,SortedList) :-
 284         pairup(Keys,List,Pairs),
 285         sort(Pairs,SortedPairs),
 286         once(pairup(_,SortedList,SortedPairs)).
 287
 288 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 289 arg1(Term,Index,Arg) :- arg(Index,Term,Arg).
 290
 291 wrap_in_functor(Functor,X,Term) :-
 292         Term =.. [Functor,X].
 293
 294 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 295
 296 tree_set_empty(TreeSet) :- empty_assoc(TreeSet).
 297 tree_set_memberchk(Element,TreeSet) :- get_assoc(Element,TreeSet,_).
 298 tree_set_add(TreeSet,Element,NTreeSet) :- put_assoc(Element,TreeSet,x,NTreeSet).
 299
 300 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 301 :- dynamic
 302         user:goal_expansion/2.
 303 :- multifile
 304         user:goal_expansion/2.
 305
 306 user:goal_expansion(arg1(Term,Index,Arg), arg(Index,Term,Arg)).
 307 user:goal_expansion(wrap_in_functor(Functor,In,Out), Goal) :-
 308         ( atom(Functor), var(Out) ->
 309                 Out =.. [Functor,In],
 310                 Goal = true
 311         ;
 312                 Goal = (Out =.. [Functor,In])
 313         ).
 314