clean_code.pl

   1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   2 % Author:       Tom Schrijvers
   3 % Email:        Tom.Schrijvers@cs.kuleuven.be
   4 % Copyright:    K.U.Leuven 2004
   5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   6 %%   ____          _         ____ _                  _
   7 %%  / ___|___   __| | ___   / ___| | ___  __ _ _ __ (_)_ __   __ _
   8 %% | |   / _ \ / _` |/ _ \ | |   | |/ _ \/ _` | '_ \| | '_ \ / _` |
   9 %% | |__| (_) | (_| |  __/ | |___| |  __/ (_| | | | | | | | | (_| |
  10 %%  \____\___/ \__,_|\___|  \____|_|\___|\__,_|_| |_|_|_| |_|\__, |
  11 %%                                                           |___/
  12 %%
  13 %% removes redundant 'true's and other trivial but potentially non-free constructs
  14
  15 % TODO
  16 %       Remove last clause with Body = fail
  17
  18 :- module(clean_code,
  19         [
  20                 clean_clauses/2
  21         ]).
  22
  23 :- use_module(hprolog).
  24
  25 clean_clauses(Clauses,NClauses) :-
  26         clean_clauses1(Clauses,Clauses1),
  27         merge_clauses(Clauses1,NClauses).
  28
  29
  30 clean_clauses1([],[]).
  31 clean_clauses1([C|Cs],[NC|NCs]) :-
  32         clean_clause(C,NC),
  33         clean_clauses1(Cs,NCs).
  34
  35 clean_clause(Clause,NClause) :-
  36         ( Clause = (Head :- Body) ->
  37                 clean_goal(Body,Body1),
  38                 move_unification_into_head(Head,Body1,NHead,NBody),
  39                 ( NBody == true ->
  40                         NClause = NHead
  41                 ;
  42                         NClause = (NHead :- NBody)
  43                 )
  44         ; Clause = '$source_location'(File,Line) : ActualClause ->
  45                 NClause = '$source_location'(File,Line) :  NActualClause,
  46                 clean_clause(ActualClause,NActualClause)
  47         ;
  48                 NClause = Clause
  49         ).
  50
  51 clean_goal(Goal,NGoal) :-
  52         var(Goal), !,
  53         NGoal = Goal.
  54 clean_goal((G1,G2),NGoal) :-
  55         !,
  56         clean_goal(G1,NG1),
  57         clean_goal(G2,NG2),
  58         ( NG1 == true ->
  59                 NGoal = NG2
  60         ; NG2 == true ->
  61                 NGoal = NG1
  62         ;
  63                 NGoal = (NG1,NG2)
  64         ).
  65 clean_goal((If -> Then ; Else),NGoal) :-
  66         !,
  67         clean_goal(If,NIf),
  68         ( NIf == true ->
  69                 clean_goal(Then,NThen),
  70                 NGoal = NThen
  71         ; NIf == fail ->
  72                 clean_goal(Else,NElse),
  73                 NGoal = NElse
  74         ;
  75                 clean_goal(Then,NThen),
  76                 clean_goal(Else,NElse),
  77                 NGoal = (NIf -> NThen; NElse)
  78         ).
  79 clean_goal((G1 ; G2),NGoal) :-
  80         !,
  81         clean_goal(G1,NG1),
  82         clean_goal(G2,NG2),
  83         ( NG1 == fail ->
  84                 NGoal = NG2
  85         ; NG2 == fail ->
  86                 NGoal = NG1
  87         ;
  88                 NGoal = (NG1 ; NG2)
  89         ).
  90 clean_goal(once(G),NGoal) :-
  91         !,
  92         clean_goal(G,NG),
  93         ( NG == true ->
  94                 NGoal = true
  95         ; NG == fail ->
  96                 NGoal = fail
  97         ;
  98                 NGoal = once(NG)
  99         ).
 100 clean_goal((G1 -> G2),NGoal) :-
 101         !,
 102         clean_goal(G1,NG1),
 103         ( NG1 == true ->
 104                 clean_goal(G2,NGoal)
 105         ; NG1 == fail ->
 106                 NGoal = fail
 107         ;
 108                 clean_goal(G2,NG2),
 109                 NGoal = (NG1 -> NG2)
 110         ).
 111 clean_goal(Goal,Goal).
 112 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 113 move_unification_into_head(Head,Body,NHead,NBody) :-
 114         conj2list(Body,BodyList),
 115         move_unification_into_head_(BodyList,Head,NHead,NBody).
 116
 117 move_unification_into_head_([],Head,Head,true).
 118 move_unification_into_head_([G|Gs],Head,NHead,NBody) :-
 119         ( nonvar(G), G = (X = Y) ->
 120                 term_variables(Gs,GsVars),
 121                 ( var(X), ( \+ memberchk_eq(X,GsVars) ; atomic(Y)) ->
 122                         X = Y,
 123                         move_unification_into_head_(Gs,Head,NHead,NBody)
 124                 ; var(Y), (\+ memberchk_eq(Y,GsVars) ; atomic(X)) ->
 125                         X = Y,
 126                         move_unification_into_head_(Gs,Head,NHead,NBody)
 127                 ;
 128                         Head = NHead,
 129                         list2conj([G|Gs],NBody)
 130                 )
 131         ;
 132                 Head = NHead,
 133                 list2conj([G|Gs],NBody)
 134         ).
 135
 136 % move_unification_into_head(Head,Body,NHead,NBody) :-
 137 %       ( Body = (X = Y, More) ; Body = (X = Y), More = true), !,
 138 %       ( var(X), term_variables(More,MoreVars), \+ memberchk_eq(X,MoreVars) ->
 139 %               X = Y,
 140 %               move_unification_into_head(Head,More,NHead,NBody)
 141 %       ; var(Y) ->
 142 %               move_unification_into_head(Head,(Y = X,More),NHead,NBody)
 143 %       ;
 144 %               NHead = Head,
 145 %               NBody = Body
 146 %       ).
 147 %
 148 % move_unification_into_head(Head,Body,Head,Body).
 149
 150
 151 conj2list(Conj,L) :-                            %% transform conjunctions to list
 152   conj2list(Conj,L,[]).
 153
 154 conj2list(G,L,T) :-
 155         var(G), !,
 156         L = [G|T].
 157 conj2list(true,L,L) :- !.
 158 conj2list(Conj,L,T) :-
 159   Conj = (G1,G2), !,
 160   conj2list(G1,L,T1),
 161   conj2list(G2,T1,T).
 162 conj2list(G,[G | T],T).
 163
 164 list2conj([],true).
 165 list2conj([G],X) :- !, X = G.
 166 list2conj([G|Gs],C) :-
 167         ( G == true ->                          %% remove some redundant trues
 168                 list2conj(Gs,C)
 169         ;
 170                 C = (G,R),
 171                 list2conj(Gs,R)
 172         ).
 173
 174
 175 merge_clauses([],[]).
 176 merge_clauses([C],[C]).
 177 merge_clauses([X,Y|Clauses],NClauses) :-
 178         ( merge_two_clauses(X,Y,Clause) ->
 179                 merge_clauses([Clause|Clauses],NClauses)
 180         ;
 181                 NClauses = [X|RClauses],
 182                 merge_clauses([Y|Clauses],RClauses)
 183         ).
 184
 185
 186 merge_two_clauses(H1 :- B1, H2 :- B2, H :- B) :-
 187         H1 =@= H2,
 188         H1 = H,
 189         conj2list(B1,List1),
 190         conj2list(B2,List2),
 191         merge_lists(List1,List2,H1,H2,Unifier,List,NList1,NList2),
 192         List \= [],
 193         H1 = H2,
 194         call(Unifier),
 195         list2conj(List,Prefix),
 196         list2conj(NList1,NB1),
 197         ( NList2 == (!) ->
 198                 B = Prefix
 199         ;
 200                 list2conj(NList2,NB2),
 201                 B = (Prefix,(NB1 ; NB2))
 202         ).
 203
 204 merge_lists([],[],_,_,true,[],[],[]).
 205 merge_lists([],L2,_,_,true,[],[],L2).
 206 merge_lists([!|Xs],_,_,_,true,[!|Xs],[],!) :- !.
 207 merge_lists([X|Xs],[],_,_,true,[],[X|Xs],[]).
 208 merge_lists([X|Xs],[Y|Ys],H1,H2,Unifier,Common,N1,N2) :-
 209         ( H1-X =@= H2-Y ->
 210                 Unifier = (X = Y, RUnifier),
 211                 Common = [X|NCommon],
 212                 merge_lists(Xs,Ys,H1/X,H2/Y,RUnifier,NCommon,N1,N2)
 213         ;
 214                 Unifier = true,
 215                 Common = [],
 216                 N1 = [X|Xs],
 217                 N2 = [Y|Ys]
 218         ).