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