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