1/*  Part of CHR (Constraint Handling Rules)
    2
    3    Author:        Tom Schrijvers
    4    E-mail:        Tom.Schrijvers@cs.kuleuven.be
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2005-2011, K.U. Leuven
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(chr_compiler_utility,
   36	[ time/2
   37	, replicate/3
   38	, pair_all_with/3
   39	, conj2list/2
   40	, list2conj/2
   41	, disj2list/2
   42	, list2disj/2
   43	, variable_replacement/3
   44	, variable_replacement/4
   45	, identical_rules/2
   46	, identical_guarded_rules/2
   47	, copy_with_variable_replacement/3
   48	, my_term_copy/3
   49	, my_term_copy/4
   50	, atom_concat_list/2
   51	, init/2
   52	, member2/3
   53	, select2/6
   54	, set_elems/2
   55	, instrument_goal/4
   56	, sort_by_key/3
   57	, arg1/3
   58	, wrap_in_functor/3
   59	, tree_set_empty/1
   60	, tree_set_memberchk/2
   61	, tree_set_add/3
   62	, tree_set_merge/3
   63	, fold1/3
   64	, fold/4
   65	, maplist_dcg//3
   66	, maplist_dcg//4
   67	]).   68
   69:- use_module(pairlist).   70:- use_module(library(lists), [permutation/2]).   71:- use_module(library(assoc)).   72
   73:- meta_predicate
   74	fold1(3,+,-),
   75	fold(+,3,+,-).

   82%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   83% time(Phase,Goal) :-
   84%	statistics(runtime,[T1|_]),
   85%	call(Goal),
   86%	statistics(runtime,[T2|_]),
   87%	T is T2 - T1,
   88%	format('    ~w ~46t ~D~80| ms\n',[Phase,T]),
   89%	deterministic(Det),
   90%	( Det == true ->
   91%		true
   92%	;
   93%		format('\t\tNOT DETERMINISTIC!\n',[])
   94%	).
   95time(_,Goal) :- call(Goal).
   96
   97%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   98replicate(N,E,L) :-
   99	( N =< 0 ->
  100		L = []
  101	;
  102		L = [E|T],
  103		M is N - 1,
  104		replicate(M,E,T)
  105	).
  106
  107%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  108pair_all_with([],_,[]).
  109pair_all_with([X|Xs],Y,[X-Y|Rest]) :-
  110	pair_all_with(Xs,Y,Rest).
  111
  112%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  113conj2list(Conj,L) :-

  114  conj2list(Conj,L,[])

  114.
  115
  116conj2list(Var,L,T) :-
  117	var(Var), !,
  118	L = [Var|T].
  119conj2list(true,L,L) :- !.
  120conj2list(Conj,L,T) :-
  121  Conj = (G1,G2), !,
  122  conj2list(G1,L,T1),
  123  conj2list(G2,T1,T).
  124conj2list(G,[G | T],T).
  125
  126disj2list(Conj,L) :-

  127  disj2list(Conj,L,[])

  127.
  128disj2list(Conj,L,T) :-
  129  Conj = (fail;G2), !,
  130  disj2list(G2,L,T).
  131disj2list(Conj,L,T) :-
  132  Conj = (G1;G2), !,
  133  disj2list(G1,L,T1),
  134  disj2list(G2,T1,T).
  135disj2list(G,[G | T],T).
  136
  137list2conj([],true).
  138list2conj([G],X) :- !, X = G.
  139list2conj([G|Gs],C) :-
  140	( G == true ->

  141		list2conj(Gs,C)
  142	;
  143		C = (G,R),
  144		list2conj(Gs,R)
  145	)

  145.
  146
  147list2disj([],fail).
  148list2disj([G],X) :- !, X = G.
  149list2disj([G|Gs],C) :-
  150	( G == fail ->

  151		list2disj(Gs,C)
  152	;
  153		C = (G;R),
  154		list2disj(Gs,R)
  155	)

  155.
  156
  157%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  158% check wether two rules are identical
  159
  160identical_guarded_rules(rule(H11,H21,G1,_),rule(H12,H22,G2,_)) :-
  161   G1 == G2,
  162   permutation(H11,P1),
  163   P1 == H12,
  164   permutation(H21,P2),
  165   P2 == H22.
  166
  167identical_rules(rule(H11,H21,G1,B1),rule(H12,H22,G2,B2)) :-
  168   G1 == G2,
  169   identical_bodies(B1,B2),
  170   permutation(H11,P1),
  171   P1 == H12,
  172   permutation(H21,P2),
  173   P2 == H22.
  174
  175identical_bodies(B1,B2) :-
  176   ( B1 = (X1 = Y1),
  177     B2 = (X2 = Y2) ->
  178     ( X1 == X2,
  179       Y1 == Y2
  180     ; X1 == Y2,
  181       X2 == Y1
  182     ),
  183     !
  184   ; B1 == B2
  185   ).
  186
  187% replace variables in list
  188
  189copy_with_variable_replacement(X,Y,L) :-
  190   ( var(X) ->
  191     ( lookup_eq(L,X,Y) ->
  192       true
  193     ; X = Y
  194     )
  195   ; functor(X,F,A),
  196     functor(Y,F,A),
  197     X =.. [_|XArgs],
  198     Y =.. [_|YArgs],
  199     copy_with_variable_replacement_l(XArgs,YArgs,L)
  200   ).
  201
  202copy_with_variable_replacement_l([],[],_).
  203copy_with_variable_replacement_l([X|Xs],[Y|Ys],L) :-
  204   copy_with_variable_replacement(X,Y,L),
  205   copy_with_variable_replacement_l(Xs,Ys,L).
  206
  207% build variable replacement list
  208
  209variable_replacement(X,Y,L) :-
  210   variable_replacement(X,Y,[],L).
  211
  212variable_replacement(X,Y,L1,L2) :-
  213   ( var(X) ->
  214     var(Y),
  215     ( lookup_eq(L1,X,Z) ->
  216       Z == Y,
  217       L2 = L1
  218     ; ( X == Y -> L2=L1 ; L2 = [X-Y,Y-X|L1])
  219     )
  220   ; X =.. [F|XArgs],
  221     nonvar(Y),
  222     Y =.. [F|YArgs],
  223     variable_replacement_l(XArgs,YArgs,L1,L2)
  224   ).
  225
  226variable_replacement_l([],[],L,L).
  227variable_replacement_l([X|Xs],[Y|Ys],L1,L3) :-
  228   variable_replacement(X,Y,L1,L2),
  229   variable_replacement_l(Xs,Ys,L2,L3).
  230
  231%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  232my_term_copy(X,Dict,Y) :-
  233   my_term_copy(X,Dict,_,Y).
  234
  235my_term_copy(X,Dict1,Dict2,Y) :-
  236   (   var(X) ->
  237       (   lookup_eq(Dict1,X,Y) ->
  238           Dict2 = Dict1
  239       ;   Dict2 = [X-Y|Dict1]
  240       )
  241   ;   functor(X,XF,XA),
  242       functor(Y,XF,XA),
  243       X =.. [_|XArgs],
  244       Y =.. [_|YArgs],
  245       my_term_copy_list(XArgs,Dict1,Dict2,YArgs)
  246   ).
  247
  248my_term_copy_list([],Dict,Dict,[]).
  249my_term_copy_list([X|Xs],Dict1,Dict3,[Y|Ys]) :-
  250   my_term_copy(X,Dict1,Dict2,Y),
  251   my_term_copy_list(Xs,Dict2,Dict3,Ys).
  252
  253%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  254atom_concat_list([X],X) :- ! .
  255atom_concat_list([X|Xs],A) :-
  256	atom_concat_list(Xs,B),
  257	atomic_concat(X,B,A).
  258
  259set_elems([],_).
  260set_elems([X|Xs],X) :-
  261	set_elems(Xs,X).
  262
  263init([],[]).
  264init([_],[]) :- !.
  265init([X|Xs],[X|R]) :-
  266	init(Xs,R).
  267
  268member2([X|_],[Y|_],X-Y).
  269member2([_|Xs],[_|Ys],P) :-
  270	member2(Xs,Ys,P).
  271
  272select2(X, Y, [X|Xs], [Y|Ys], Xs, Ys).
  273select2(X, Y, [X1|Xs], [Y1|Ys], [X1|NXs], [Y1|NYs]) :-
  274	select2(X, Y, Xs, Ys, NXs, NYs).
  275
  276instrument_goal(Goal,Pre,Post,(Pre,Goal,Post)).
  277
  278sort_by_key(List,Keys,SortedList) :-
  279	pairup(Keys,List,Pairs),
  280	sort(Pairs,SortedPairs),
  281	once(pairup(_,SortedList,SortedPairs)).
  282
  283%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  284arg1(Term,Index,Arg) :- arg(Index,Term,Arg).
  285
  286wrap_in_functor(Functor,X,Term) :-
  287	Term =.. [Functor,X].
  288
  289%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  290
  291tree_set_empty(TreeSet) :- empty_assoc(TreeSet).
  292tree_set_memberchk(Element,TreeSet) :- get_assoc(Element,TreeSet,_).
  293tree_set_add(TreeSet,Element,NTreeSet) :- put_assoc(Element,TreeSet,x,NTreeSet).
  294tree_set_merge(TreeSet1,TreeSet2,TreeSet3) :-
  295	assoc_to_list(TreeSet1,List),
  296	fold(List,tree_set_add_pair,TreeSet2,TreeSet3).
  297tree_set_add_pair(Key-Value,TreeSet,NTreeSet) :-
  298	put_assoc(Key,TreeSet,Value,NTreeSet).
  299
  300%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  301fold1(P,[Head|Tail],Result) :-
  302	fold(Tail,P,Head,Result).
  303
  304fold([],_,Acc,Acc).
  305fold([X|Xs],P,Acc,Res) :-
  306	call(P,X,Acc,NAcc),
  307	fold(Xs,P,NAcc,Res).
  308
  309maplist_dcg(P,L1,L2,L) -->
  310	maplist_dcg_(L1,L2,L,P).
  311
  312maplist_dcg_([],[],[],_) --> [].
  313maplist_dcg_([X|Xs],[Y|Ys],[Z|Zs],P) -->
  314	call(P,X,Y,Z),
  315	maplist_dcg_(Xs,Ys,Zs,P).
  316
  317maplist_dcg(P,L1,L2) -->
  318	maplist_dcg_(L1,L2,P).
  319
  320maplist_dcg_([],[],_) --> [].
  321maplist_dcg_([X|Xs],[Y|Ys],P) -->
  322	call(P,X,Y),
  323	maplist_dcg_(Xs,Ys,P).
  324%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  325:- dynamic
  326	user:goal_expansion/2.  327:- multifile
  328	user:goal_expansion/2.  329
  330user:goal_expansion(arg1(Term,Index,Arg), arg(Index,Term,Arg)).
  331user:goal_expansion(wrap_in_functor(Functor,In,Out), Goal) :-
  332	( atom(Functor), var(Out) ->
  333		Out =.. [Functor,In],
  334		Goal = true
  335	;
  336		Goal = (Out =.. [Functor,In])
  337	)