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