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)  2004-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%   ____          _         ____ _                  _
   36%  / ___|___   __| | ___   / ___| | ___  __ _ _ __ (_)_ __   __ _
   37% | |   / _ \ / _` |/ _ \ | |   | |/ _ \/ _` | '_ \| | '_ \ / _` |
   38% | |__| (_) | (_| |  __/ | |___| |  __/ (_| | | | | | | | | (_| |
   39%  \____\___/ \__,_|\___|  \____|_|\___|\__,_|_| |_|_|_| |_|\__, |
   40%                                                           |___/
   41%
   42% To be done:
   43%	inline clauses
   44
   45:- module(clean_code,
   46	[
   47		clean_clauses/2
   48	]).   49
   50:- use_module(library(dialect/hprolog)).   51
   52clean_clauses(Clauses,NClauses) :-
   53	clean_clauses1(Clauses,Clauses1),
   54	merge_clauses(Clauses1,NClauses).
   55
   56
   57%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   58% CLEAN CLAUSES
   59%
   60%	- move neck unification into the head of the clause
   61%	- drop true body
   62%	- specialize control flow goal wrt true and fail
   63%
   64%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   65
   66clean_clauses1([],[]).
   67clean_clauses1([C|Cs],[NC|NCs]) :-
   68	clean_clause(C,NC),
   69	clean_clauses1(Cs,NCs).
   70
   71clean_clause(Clause,NClause) :-
   72	( Clause = (Head :- Body) ->
   73		clean_goal(Body,Body1),
   74		move_unification_into_head(Head,Body1,NHead,NBody),
   75		( NBody == true ->
   76			NClause = NHead
   77		;
   78			NClause = (NHead :- NBody)
   79		)
   80	; Clause = '$source_location'(File,Line) : ActualClause ->
   81		NClause = '$source_location'(File,Line) :  NActualClause,
   82		clean_clause(ActualClause,NActualClause)
   83	;
   84		NClause = Clause
   85	).
   86
   87clean_goal(Goal,NGoal) :-
   88	var(Goal), !,
   89	NGoal = Goal.
   90clean_goal((G1,G2),NGoal) :-
   91	!,
   92	clean_goal(G1,NG1),
   93	clean_goal(G2,NG2),
   94	( NG1 == true ->
   95		NGoal = NG2
   96	; NG2 == true ->
   97		NGoal = NG1
   98	;
   99		NGoal = (NG1,NG2)
  100	).
  101clean_goal((If -> Then ; Else),NGoal) :-
  102	!,
  103	clean_goal(If,NIf),
  104	( NIf == true ->
  105		clean_goal(Then,NThen),
  106		NGoal = NThen
  107	; NIf == fail ->
  108		clean_goal(Else,NElse),
  109		NGoal = NElse
  110	;
  111		clean_goal(Then,NThen),
  112		clean_goal(Else,NElse),
  113		NGoal = (NIf -> NThen; NElse)
  114	).
  115clean_goal((G1 ; G2),NGoal) :-
  116	!,
  117	clean_goal(G1,NG1),
  118	clean_goal(G2,NG2),
  119	( NG1 == fail ->
  120		NGoal = NG2
  121	; NG2 == fail ->
  122		NGoal = NG1
  123	;
  124		NGoal = (NG1 ; NG2)
  125	).
  126clean_goal(once(G),NGoal) :-
  127	!,
  128	clean_goal(G,NG),
  129	( NG == true ->
  130		NGoal = true
  131	; NG == fail ->
  132		NGoal = fail
  133	;
  134		NGoal = once(NG)
  135	).
  136clean_goal((G1 -> G2),NGoal) :-
  137	!,
  138	clean_goal(G1,NG1),
  139	( NG1 == true ->
  140		clean_goal(G2,NGoal)
  141	; NG1 == fail ->
  142		NGoal = fail
  143	;
  144		clean_goal(G2,NG2),
  145		NGoal = (NG1 -> NG2)
  146	).
  147clean_goal(Goal,Goal).
  148%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  149move_unification_into_head(Head,Body,NHead,NBody) :-
  150	conj2list(Body,BodyList),
  151	move_unification_into_head_(BodyList,Head,NHead,NBody).
  152
  153move_unification_into_head_([],Head,Head,true).
  154move_unification_into_head_([G|Gs],Head,NHead,NBody) :-
  155	( nonvar(G), G = (X = Y) ->
  156		term_variables(Gs,GsVars),
  157		( var(X), ( \+ memberchk_eq(X,GsVars) ; atomic(Y)) ->
  158			X = Y,
  159			move_unification_into_head_(Gs,Head,NHead,NBody)
  160		; var(Y), (\+ memberchk_eq(Y,GsVars) ; atomic(X)) ->
  161			X = Y,
  162			move_unification_into_head_(Gs,Head,NHead,NBody)
  163		;
  164			Head = NHead,
  165			list2conj([G|Gs],NBody)
  166		)
  167	;
  168		Head = NHead,
  169		list2conj([G|Gs],NBody)
  170	).
  171
  172
  173conj2list(Conj,L) :-

  174  conj2list(Conj,L,[])

  174.
  175
  176conj2list(G,L,T) :-
  177	var(G), !,
  178	L = [G|T].
  179conj2list(true,L,L) :- !.
  180conj2list(Conj,L,T) :-
  181  Conj = (G1,G2), !,
  182  conj2list(G1,L,T1),
  183  conj2list(G2,T1,T).
  184conj2list(G,[G | T],T).
  185
  186list2conj([],true).
  187list2conj([G],X) :- !, X = G.
  188list2conj([G|Gs],C) :-
  189	( G == true ->

  190		list2conj(Gs,C)
  191	;
  192		C = (G,R),
  193		list2conj(Gs,R)
  194	)

  194.
  195
  196%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  197% MERGE CLAUSES
  198%
  199%	Find common prefixes of successive clauses and share them.
  200%
  201%	Note: we assume that the prefix does not generate a side effect.
  202%
  203%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  204
  205merge_clauses([],[]).
  206merge_clauses([C],[C]).
  207merge_clauses([X,Y|Clauses],NClauses) :-
  208	( merge_two_clauses(X,Y,Clause) ->
  209		merge_clauses([Clause|Clauses],NClauses)
  210	;
  211		NClauses = [X|RClauses],
  212		merge_clauses([Y|Clauses],RClauses)
  213	).
  214
  215merge_two_clauses('$source_location'(F1,L1) : C1,
  216		  '$source_location'(_F2,_L2) : C2,
  217		  Result) :- !,
  218	merge_two_clauses(C1,C2,C),
  219	Result = '$source_location'(F1,L1) : C.
  220merge_two_clauses((H1 :- B1), (H2 :- B2), (H :- B)) :-
  221	H1 =@= H2,
  222	H1 = H,
  223	conj2list(B1,List1),
  224	conj2list(B2,List2),
  225	merge_lists(List1,List2,H1,H2,Unifier,List,NList1,NList2),
  226	List \= [],
  227	H1 = H2,
  228	call(Unifier),
  229	list2conj(List,Prefix),
  230	list2conj(NList1,NB1),
  231	( NList2 == (!) ->
  232		B = Prefix
  233	;
  234		list2conj(NList2,NB2),
  235		B = (Prefix,(NB1 ; NB2))
  236	).
  237
  238merge_lists([],[],_,_,true,[],[],[]).
  239merge_lists([],L2,_,_,true,[],[],L2).
  240merge_lists([!|Xs],_,_,_,true,[!|Xs],[],!) :- !.
  241merge_lists([X|Xs],[],_,_,true,[],[X|Xs],[]).
  242merge_lists([X|Xs],[Y|Ys],H1,H2,Unifier,Common,N1,N2) :-
  243	( H1-X =@= H2-Y ->
  244		Unifier = (X = Y, RUnifier),
  245		Common = [X|NCommon],
  246		merge_lists(Xs,Ys,H1/X,H2/Y,RUnifier,NCommon,N1,N2)
  247	;
  248		Unifier = true,
  249		Common = [],
  250		N1 = [X|Xs],
  251		N2 = [Y|Ys]
  252	)