home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / sbprolog.zoo / prolog / cmplib / src / $factor1.P < prev    next >
Encoding:
Text File  |  1990-04-17  |  6.5 KB  |  194 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /*-----------------------------------------------------------------
  9. SB-Prolog is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY.  No author or distributor
  11. accepts responsibility to anyone for the consequences of using it
  12. or for whether it serves any particular purpose or works at all,
  13. unless he says so in writing.  Refer to the SB-Prolog General Public
  14. License for full details.
  15.  
  16. Everyone is granted permission to copy, modify and redistribute
  17. SB-Prolog, but only under the conditions described in the
  18. SB-Prolog General Public License.   A copy of this license is
  19. supposed to have been given to you along with SB-Prolog so you
  20. can know your rights and responsibilities.  It should be in a
  21. file named COPYING.  Among other things, the copyright notice
  22. and this notice must be preserved on all copies. 
  23. ------------------------------------------------------------------ */
  24. /* $factor1.P */
  25.  
  26. /*  the predicates in this file handle factoring of clauses to decrease
  27.     the amount of nondeterminism.  The process is as follows: first, the
  28.     clauses of a predicate are checked to see if adjacent clauses contain
  29.     complementary inline literals that might be factorable.  If this is the
  30.     case, then the heads of the clauses are checked to see if they subsume
  31.     each other, in which case the two clauses can be merged.  If the heads
  32.     are not similar, then an attempt is made to factor the heads by moving
  33.     "dont-know" arguments from the head into the body so that variables in
  34.     tests appearing in the body are "covered" by what's left in the head.
  35.     This, of course, needs mode information.  If this still doesn't work,
  36.     the attempt at factoring fails and nothing is done.            */
  37.  
  38. $factor(pred(P,N,_,_,Clauses),Mode,pred(P,N,_,_,FClauses)) :-
  39.     $check_compl(Clauses) ->
  40.         $factor0(Clauses,Mode,FClauses) ;
  41.         Clauses = FClauses.
  42.  
  43. /* check_comp does a quick scan of the clauses to see if there's any
  44.    potential for factoring of inline clauses to produce if-then-elses, by
  45.    checking whether adjacent clauses contain literals that appear to be
  46.    complementary.                            */
  47.  
  48. $check_compl([Cl1,Cl2|Rest]) :-
  49.     $check_compl1(Cl1,Cl2) -> true ; $check_compl([Cl2|Rest]).
  50.  
  51. $check_compl1(rule(H1,B1,_,_),rule(H2,B2,_,_)) :- $check_compl2(B1,B2).
  52.  
  53. $check_compl2(','(L11,B1), ','(L21,B2)) :- $compl_lits(L11,L21), !.
  54. $check_compl2(','(not(_),B1), ','(not(_),B2)) :- $check_compl2(B1,B2), !.
  55. $check_compl2(B1, ','(not(_),B2)) :- $check_compl2(B1,B2).
  56. $check_compl2(','(not(_),B1), B2) :- $check_compl2(B1,B2).
  57.  
  58. $compl_lits(L1,not(L2)) :- functor(L1,F,N), functor(L2,F,N).
  59. $compl_lits(L1,L2) :-
  60.     functor(L1,F1,N),
  61.     functor(L2,F2,N),
  62.     ( ($factor_arith_test(F1,N), $complementary(F1,N,F2)) ;
  63.       $implied_mutex(F1,N,F2)
  64.     ).
  65.  
  66. /* $factor0 runs down the list of clauses "backwards", trying to combine
  67.    clauses wherever possible.                        */
  68.  
  69. $factor0([Cl],_,[Cl]).
  70. $factor0([Cl1|ClRest],Mode,FClauses) :-
  71.     $factor0(ClRest,Mode,FClRest),
  72.     $factor1(Cl1,FClRest,Mode,FClauses).
  73.  
  74. $factor1(Cl1,[Cl2|CRest],Mode,Clauses) :-
  75.     ($check_compl1(Cl1,Cl2) -> $factor2(Cl1,Cl2,Mode,Cl)) ->
  76.         Clauses = [Cl|CRest] ;
  77.         Clauses = [Cl1,Cl2|CRest].
  78.  
  79. $factor2(rule(H1,B1,_,_), rule(H2,B2,_,_), Mode, rule(H3,B3,_,_)) :-
  80.     $factor3(H1,B1,H2,B2,H3,B3,Mode).
  81.  
  82. $factor3(H1,B1,H2,B2,H3,B3,_) :- 
  83.     subsumes(H1,H2), subsumes(H2,H1),
  84.     !,
  85.     H1 = H2, H3 = H2,
  86.     $factor4(B1,B2,B3).
  87. $factor3(H1,B1,H2,B2,H3,B3,Mode) :-
  88.     H1 =.. [P|Args1], H2 =.. [P|Args2],
  89.     $factor_pullout(Args1,Mode,NArgs1,Eqs1,CV1),
  90.     $factor_pullout(Args2,Mode,NArgs2,Eqs2,CV2),
  91.     subsumes(NArgs1,NArgs2),
  92.     subsumes(NArgs2,NArgs1),
  93.     !,
  94.     H3 =.. [P|NArgs1], NArgs1 = NArgs2,
  95.     $factor_hb(Eqs1,CV1,B1,B1a),
  96.     $factor_hb(Eqs2,CV2,B2,B2a),
  97.     $factor4(B1a,B2a,B3).
  98.  
  99. $factor_pullout([],_,[],[],CV) :- $closetail(CV), !.
  100. $factor_pullout([A|ARest],[M|MRest],NHArgs,Eqs,CV) :-
  101.     ((M =< 0, nonvar(A)) ->
  102.         (NHArgs = [NA|NARest], Eqs = [(NA = A)|EqRest]) ;
  103.         (NHArgs = [A|NARest],
  104.          Eqs = EqRest,
  105.          (M =:= 2 -> $factor_addvars(A,CV) ; true)
  106.         )
  107.     ),    
  108.     $factor_pullout(ARest,MRest,NARest,EqRest,CV).
  109.  
  110. $factor_hb(Eqs,CV,Bin,Bout) :-
  111.     $factor_coveredtests(CV,Bin,[],CTests,BRest),
  112.     $app_comma(Eqs,BRest,B0),
  113.     $app_comma(CTests,B0,Bout).
  114.  
  115. /* $factor_coveredtests takes a list of variables that are guaranteed to
  116.    be ground in the input, and splits the leading tests in the body into
  117.    those whose variables are covered by this, and the rest.  If any
  118.    argument is being moved out of the head into the body, it can be safely
  119.    moved past any of the tests which are in the first group, i.e. whose
  120.    variables are covered by the ground arguments in the head.        */
  121.  
  122. $factor_coveredtests(CV,','(Test,Body),Tin,Tout,BRest) :-
  123.     functor(Test,F,N),
  124.     $factor_arith_test(F,N),
  125.     !,
  126.     $factor_testcov(Test,CV),
  127.     $factor_coveredtests(CV,Body,[Test|Tin],Tout,BRest).
  128. $factor_coveredtests(_,Body,T,T,Body).
  129.  
  130. $factor_testcov(T,V) :-
  131.     $factor_addvars(T,VList),
  132.     $closetail(VList),
  133.     !,
  134.     $factor_testcov1(VList,V).
  135.  
  136. $factor_testcov1([],_).
  137. $factor_testcov1([V|VRest],VList) :-
  138.     $absmember(V,VList),
  139.     $factor_testcov1(VRest,VList).
  140.  
  141. $factor4(','(L1,B1), ','(L2,B2), ','(L1,B3)) :-
  142.     L1 == L2,
  143.     !,
  144.     $factor4(B1,B2,B3).
  145. $factor4(','(L1,B1), ','(L2,B2), ((L1,B1) ; (not(L1),L2,B2)) ) :-
  146.     L1 =.. [F1|Args1], L2 =.. [F2|Args2],
  147.     functor(L1,F1,N), functor(L2,F2,N),
  148.     $implied_mutex(F1,N,F2),
  149.     Args1 == Args2.
  150. $factor4(B1,B2,';'(B1a,B2)) :-
  151.     functor(B1,'->',2) -> B1a = (B1 ; fail) ; B1a = B1.
  152.  
  153. $implied_mutex('=:=',2,'>').
  154. $implied_mutex('=:=',2,'<').
  155. $implied_mutex('>',2,'<').
  156. $implied_mutex('<',2,'>').
  157. $implied_mutex('>',2,'=:=').
  158. $implied_mutex('<',2,'=:=').
  159.  
  160. /*     $factor_chmode $checks that the mode given has at least one 0,
  161.     so that it is worth trying to pull head arguments in.        */
  162.  
  163. $factor_chmode([M|MRest]) :-
  164.     M =:= 0 -> true ; $factor_chmode(MRest).
  165.  
  166. $factor_arith_test('>',2).
  167. $factor_arith_test('>=',2).
  168. $factor_arith_test('=:=',2).
  169. $factor_arith_test('=\=',2).
  170. $factor_arith_test('=<',2).
  171. $factor_arith_test('<',2).
  172.  
  173. $factor_addvars(A,VList) :-
  174.     var(A) ->
  175.         $factor_addvars1(A,VList) ;
  176.         (A =.. [_|Args],
  177.          $factor_addvarslist(Args,VList)
  178.         ).
  179.  
  180. $factor_addvarslist([],_).
  181. $factor_addvarslist([A|ARest],VList) :-
  182.     $factor_addvars(A,VList),
  183.     $factor_addvarslist(ARest,VList).
  184.  
  185. $factor_addvars1(A,VList) :-
  186.     var(VList) ->
  187.         VList = [A|_] ;
  188.         (VList = [H|L], (H == A ; $factor_addvars1(A,L))).
  189.  
  190.  
  191. $app_comma([],L,L).
  192. $app_comma([H|L1],L2,','(H,L3)) :- $app_comma(L1,L2,L3).
  193.  
  194.