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