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 %%
  14 %% To be done:
  15 %%      inline clauses
  16
  17 :- module(clean_code,
  18         [
  19                 clean_clauses/2
  20         ]).
  21
  22 :- use_module(hprolog).
  23
  24 clean_clauses(Clauses,NClauses) :-
  25         clean_clauses1(Clauses,Clauses1),
  26         merge_clauses(Clauses1,NClauses).
  27
  28
  29 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  30 % CLEAN CLAUSES
  31 %
  32 %       - move neck unification into the head of the clause
  33 %       - drop true body
  34 %       - specialize control flow goal wrt true and fail
  35 %
  36 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  37
  38 clean_clauses1([],[]).
  39 clean_clauses1([C|Cs],[NC|NCs]) :-
  40         clean_clause(C,NC),
  41         clean_clauses1(Cs,NCs).
  42
  43 clean_clause(Clause,NClause) :-
  44         ( Clause = (Head :- Body) ->
  45                 clean_goal(Body,Body1),
  46                 move_unification_into_head(Head,Body1,NHead,NBody),
  47                 ( NBody == true ->
  48                         NClause = NHead
  49                 ;
  50                         NClause = (NHead :- NBody)
  51                 )
  52         ; Clause = '$source_location'(File,Line) : ActualClause ->
  53                 NClause = '$source_location'(File,Line) :  NActualClause,
  54                 clean_clause(ActualClause,NActualClause)
  55         ;
  56                 NClause = Clause
  57         ).
  58
  59 clean_goal(Goal,NGoal) :-
  60         var(Goal), !,
  61         NGoal = Goal.
  62 clean_goal((G1,G2),NGoal) :-
  63         !,
  64         clean_goal(G1,NG1),
  65         clean_goal(G2,NG2),
  66         ( NG1 == true ->
  67                 NGoal = NG2
  68         ; NG2 == true ->
  69                 NGoal = NG1
  70         ;
  71                 NGoal = (NG1,NG2)
  72         ).
  73 clean_goal((If -> Then ; Else),NGoal) :-
  74         !,
  75         clean_goal(If,NIf),
  76         ( NIf == true ->
  77                 clean_goal(Then,NThen),
  78                 NGoal = NThen
  79         ; NIf == fail ->
  80                 clean_goal(Else,NElse),
  81                 NGoal = NElse
  82         ;
  83                 clean_goal(Then,NThen),
  84                 clean_goal(Else,NElse),
  85                 NGoal = (NIf -> NThen; NElse)
  86         ).
  87 clean_goal((G1 ; G2),NGoal) :-
  88         !,
  89         clean_goal(G1,NG1),
  90         clean_goal(G2,NG2),
  91         ( NG1 == fail ->
  92                 NGoal = NG2
  93         ; NG2 == fail ->
  94                 NGoal = NG1
  95         ;
  96                 NGoal = (NG1 ; NG2)
  97         ).
  98 clean_goal(once(G),NGoal) :-
  99         !,
 100         clean_goal(G,NG),
 101         ( NG == true ->
 102                 NGoal = true
 103         ; NG == fail ->
 104                 NGoal = fail
 105         ;
 106                 NGoal = once(NG)
 107         ).
 108 clean_goal((G1 -> G2),NGoal) :-
 109         !,
 110         clean_goal(G1,NG1),
 111         ( NG1 == true ->
 112                 clean_goal(G2,NGoal)
 113         ; NG1 == fail ->
 114                 NGoal = fail
 115         ;
 116                 clean_goal(G2,NG2),
 117                 NGoal = (NG1 -> NG2)
 118         ).
 119 clean_goal(Goal,Goal).
 120 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 121 move_unification_into_head(Head,Body,NHead,NBody) :-
 122         conj2list(Body,BodyList),
 123         move_unification_into_head_(BodyList,Head,NHead,NBody).
 124
 125 move_unification_into_head_([],Head,Head,true).
 126 move_unification_into_head_([G|Gs],Head,NHead,NBody) :-
 127         ( nonvar(G), G = (X = Y) ->
 128                 term_variables(Gs,GsVars),
 129                 ( var(X), ( \+ memberchk_eq(X,GsVars) ; atomic(Y)) ->
 130                         X = Y,
 131                         move_unification_into_head_(Gs,Head,NHead,NBody)
 132                 ; var(Y), (\+ memberchk_eq(Y,GsVars) ; atomic(X)) ->
 133                         X = Y,
 134                         move_unification_into_head_(Gs,Head,NHead,NBody)
 135                 ;
 136                         Head = NHead,
 137                         list2conj([G|Gs],NBody)
 138                 )
 139         ;
 140                 Head = NHead,
 141                 list2conj([G|Gs],NBody)
 142         ).
 143
 144
 145 conj2list(Conj,L) :-                            %% transform conjunctions to list
 146   conj2list(Conj,L,[]).
 147
 148 conj2list(G,L,T) :-
 149         var(G), !,
 150         L = [G|T].
 151 conj2list(true,L,L) :- !.
 152 conj2list(Conj,L,T) :-
 153   Conj = (G1,G2), !,
 154   conj2list(G1,L,T1),
 155   conj2list(G2,T1,T).
 156 conj2list(G,[G | T],T).
 157
 158 list2conj([],true).
 159 list2conj([G],X) :- !, X = G.
 160 list2conj([G|Gs],C) :-
 161         ( G == true ->                          %% remove some redundant trues
 162                 list2conj(Gs,C)
 163         ;
 164                 C = (G,R),
 165                 list2conj(Gs,R)
 166         ).
 167
 168 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 169 % MERGE CLAUSES
 170 %
 171 %       Find common prefixes of successive clauses and share them.
 172 %
 173 %       Note: we assume that the prefix does not generate a side effect.
 174 %
 175 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 176
 177 merge_clauses([],[]).
 178 merge_clauses([C],[C]).
 179 merge_clauses([X,Y|Clauses],NClauses) :-
 180         ( merge_two_clauses(X,Y,Clause) ->
 181                 merge_clauses([Clause|Clauses],NClauses)
 182         ;
 183                 NClauses = [X|RClauses],
 184                 merge_clauses([Y|Clauses],RClauses)
 185         ).
 186
 187 merge_two_clauses('$source_location'(F1,L1) : C1,
 188                   '$source_location'(_F2,_L2) : C2,
 189                   Result) :- !,
 190         merge_two_clauses(C1,C2,C),
 191         Result = '$source_location'(F1,L1) : C.
 192 merge_two_clauses(H1 :- B1, H2 :- B2, H :- B) :-
 193         H1 =@= H2,
 194         H1 = H,
 195         conj2list(B1,List1),
 196         conj2list(B2,List2),
 197         merge_lists(List1,List2,H1,H2,Unifier,List,NList1,NList2),
 198         List \= [],
 199         H1 = H2,
 200         call(Unifier),
 201         list2conj(List,Prefix),
 202         list2conj(NList1,NB1),
 203         ( NList2 == (!) ->
 204                 B = Prefix
 205         ;
 206                 list2conj(NList2,NB2),
 207                 B = (Prefix,(NB1 ; NB2))
 208         ).
 209
 210 merge_lists([],[],_,_,true,[],[],[]).
 211 merge_lists([],L2,_,_,true,[],[],L2).
 212 merge_lists([!|Xs],_,_,_,true,[!|Xs],[],!) :- !.
 213 merge_lists([X|Xs],[],_,_,true,[],[X|Xs],[]).
 214 merge_lists([X|Xs],[Y|Ys],H1,H2,Unifier,Common,N1,N2) :-
 215         ( H1-X =@= H2-Y ->
 216                 Unifier = (X = Y, RUnifier),
 217                 Common = [X|NCommon],
 218                 merge_lists(Xs,Ys,H1/X,H2/Y,RUnifier,NCommon,N1,N2)
 219         ;
 220                 Unifier = true,
 221                 Common = [],
 222                 N1 = [X|Xs],
 223                 N2 = [Y|Ys]
 224         ).