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([],[]).
  26 clean_clauses([C|Cs],[NC|NCs]) :-
  27         clean_clause(C,NC),
  28         clean_clauses(Cs,NCs).
  29
  30 clean_clause(Clause,NClause) :-
  31         ( Clause = (Head :- Body) ->
  32                 clean_goal(Body,Body1),
  33                 move_unification_into_head(Head,Body1,NHead,NBody),
  34                 ( NBody == true ->
  35                         NClause = NHead
  36                 ;
  37                         NClause = (NHead :- NBody)
  38                 )
  39         ;
  40                 NClause = Clause
  41         ).
  42
  43 clean_goal(Goal,NGoal) :-
  44         var(Goal), !,
  45         NGoal = Goal.
  46 clean_goal((G1,G2),NGoal) :-
  47         !,
  48         clean_goal(G1,NG1),
  49         clean_goal(G2,NG2),
  50         ( NG1 == true ->
  51                 NGoal = NG2
  52         ; NG2 == true ->
  53                 NGoal = NG1
  54         ;
  55                 NGoal = (NG1,NG2)
  56         ).
  57 clean_goal((If -> Then ; Else),NGoal) :-
  58         !,
  59         clean_goal(If,NIf),
  60         ( NIf == true ->
  61                 clean_goal(Then,NThen),
  62                 NGoal = NThen
  63         ; NIf == fail ->
  64                 clean_goal(Else,NElse),
  65                 NGoal = NElse
  66         ;
  67                 clean_goal(Then,NThen),
  68                 clean_goal(Else,NElse),
  69                 NGoal = (NIf -> NThen; NElse)
  70         ).
  71 clean_goal((G1 ; G2),NGoal) :-
  72         !,
  73         clean_goal(G1,NG1),
  74         clean_goal(G2,NG2),
  75         ( NG1 == fail ->
  76                 NGoal = NG2
  77         ; NG2 == fail ->
  78                 NGoal = NG1
  79         ;
  80                 NGoal = (NG1 ; NG2)
  81         ).
  82 clean_goal(once(G),NGoal) :-
  83         !,
  84         clean_goal(G,NG),
  85         ( NG == true ->
  86                 NGoal = true
  87         ; NG == fail ->
  88                 NGoal = fail
  89         ;
  90                 NGoal = once(NG)
  91         ).
  92 clean_goal((G1 -> G2),NGoal) :-
  93         !,
  94         clean_goal(G1,NG1),
  95         ( NG1 == true ->
  96                 clean_goal(G2,NGoal)
  97         ; NG1 == fail ->
  98                 NGoal = fail
  99         ;
 100                 clean_goal(G2,NG2),
 101                 NGoal = (NG1 -> NG2)
 102         ).
 103 clean_goal(Goal,Goal).
 104 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 105 move_unification_into_head(Head,Body,NHead,NBody) :-
 106         conj2list(Body,BodyList),
 107         move_unification_into_head_(BodyList,Head,NHead,NBody).
 108
 109 move_unification_into_head_([],Head,Head,true).
 110 move_unification_into_head_([G|Gs],Head,NHead,NBody) :-
 111         ( nonvar(G), G = (X = Y) ->
 112                 term_variables(Gs,GsVars),
 113                 ( var(X), ( \+ memberchk_eq(X,GsVars) ; atomic(Y)) ->
 114                         X = Y,
 115                         move_unification_into_head_(Gs,Head,NHead,NBody)
 116                 ; var(Y), (\+ memberchk_eq(Y,GsVars) ; atomic(X)) ->
 117                         X = Y,
 118                         move_unification_into_head_(Gs,Head,NHead,NBody)
 119                 ;
 120                         Head = NHead,
 121                         list2conj([G|Gs],NBody)
 122                 )
 123         ;
 124                 Head = NHead,
 125                 list2conj([G|Gs],NBody)
 126         ).
 127
 128 % move_unification_into_head(Head,Body,NHead,NBody) :-
 129 %       ( Body = (X = Y, More) ; Body = (X = Y), More = true), !,
 130 %       ( var(X), term_variables(More,MoreVars), \+ memberchk_eq(X,MoreVars) ->
 131 %               X = Y,
 132 %               move_unification_into_head(Head,More,NHead,NBody)
 133 %       ; var(Y) ->
 134 %               move_unification_into_head(Head,(Y = X,More),NHead,NBody)
 135 %       ;
 136 %               NHead = Head,
 137 %               NBody = Body
 138 %       ).
 139 %
 140 % move_unification_into_head(Head,Body,Head,Body).
 141
 142
 143 conj2list(Conj,L) :-                            %% transform conjunctions to list
 144   conj2list(Conj,L,[]).
 145
 146 conj2list(Conj,L,T) :-
 147   Conj = (true,G2), !,
 148   conj2list(G2,L,T).
 149 conj2list(Conj,L,T) :-
 150   Conj = (G1,G2), !,
 151   conj2list(G1,L,T1),
 152   conj2list(G2,T1,T).
 153 conj2list(G,[G | T],T).
 154
 155 list2conj([],true).
 156 list2conj([G],X) :- !, X = G.
 157 list2conj([G|Gs],C) :-
 158         ( G == true ->                          %% remove some redundant trues
 159                 list2conj(Gs,C)
 160         ;
 161                 C = (G,R),
 162                 list2conj(Gs,R)
 163         ).