1/*
    2 _________________________________________________________________________
    3|	Copyright (C) 1982						  |
    4|									  |
    5|	David Warren,							  |
    6|		SRI International, 333 Ravenswood Ave., Menlo Park,	  |
    7|		California 94025, USA;					  |
    8|									  |
    9|	Fernando Pereira,						  |
   10|		Dept. of Architecture, University of Edinburgh,		  |
   11|		20 Chambers St., Edinburgh EH1 1JZ, Scotland		  |
   12|									  |
   13|	This program may be used, copied, altered or included in other	  |
   14|	programs only for academic purposes and provided that the	  |
   15|	authorship of the initial program is aknowledged.		  |
   16|	Use for commercial purposes without the previous written 	  |
   17|	agreement of the authors is forbidden.				  |
   18|_________________________________________________________________________|
   19
   20*/
   21
   22% QPLAN - supplies the control information (ie. sequencing and cuts) needed
   23%         for efficient execution of a query.
   24
   25
   26qplan((P:-Q),(P1:-Q1)) :- qplan(P,Q,P1,Q1), !.
   27qplan(P,P).
   28
   29qplan(X0,P0,X,P) :-
   30   numbervars80(X0,0,I), variables(X0,0,Vg),
   31   numbervars80(P0,I,N),
   32   mark(P0,L,0,Vl),
   33   schedule(L,Vg,P1),
   34   quantificate(Vl,0,P1,P2),
   35   functor(VA,$,N),
   36   variablise(X0,VA,X),
   37   variablise(P2,VA,P).
   38
   39mark(X^P,L,Q0,Q) :- !, variables(X,Q0,Q1), mark(P,L,Q1,Q).
   40mark((P1,P2),L,Q0,Q) :- !,
   41   mark(P1,L1,Q0,Q1),
   42   mark(P2,L2,Q1,Q),
   43   recombine(L1,L2,L).
   44mark(\+P,L,Q,Q) :- !, mark(P,L0,0,Vl), negate80(L0,Vl,L).
   45mark(SQ,[m(V,C,SQ1)],Q0,Q0) :- subquery(SQ,SQ1,X,P,N,Q), !,
   46   mark(P,L,0,Vl),
   47   L=[Q],   % Too bad about the general case!
   48   marked(Q,Vq,C0,_),
   49   variables(X,Vl,Vlx),
   50   setminus(Vq,Vlx,V0),
   51   setofcost(V0,C0,C),
   52   variables(N,V0,V).
   53mark(P,[m(V,C,P)],Q,Q) :-
   54   variables(P,0,V),
   55   cost(P,V,C).
   56
   57subquery(setof(X,P,S),setof(X,Q,S),X,P,S,Q).
   58subquery(numberof(X,P,N),numberof(X,Q,N),X,P,N,Q).
   59
   60negate80([],_,[]).
   61negate80([P|L],Vl,[m(Vg,C,\+P)|L1]) :-
   62   freevars(P,V),
   63   setminus(V,Vl,Vg),
   64   negationcost(Vg,C),
   65   negate80(L,Vl,L1).
   66
   67negationcost(0,0) :- !.
   68negationcost(_V,1000).
   69
   70setofcost(0,_,0) :- !.
   71setofcost(_,C,C).
   72
   73variables('$VAR'(N),V0,V) :- !, setplusitem(V0,N,V).
   74variables(T,V,V) :- atomic(T), !.
   75variables(T,V0,V) :- functor(T,_,N), variables(N,T,V0,V).
   76
   77variables(0,_,V,V) :- !.
   78variables(N,T,V0,V) :- N1 is N-1,
   79   arg(N,T,X),
   80   variables(X,V0,V1),
   81   variables(N1,T,V1,V).
   82
   83quantificate(W-V,N,P0,P) :- !, N1 is N+18,
   84   quantificate(V,N,P1,P),
   85   quantificate(W,N1,P0,P1).
   86quantificate(0,_,P,P) :- !.
   87quantificate(V,N,P0,'$VAR'(Nr)^P) :-
   88   Vr is V /\ -(V),     % rightmost bit
   89   log2(Vr,I),
   90   Nr is N+I,
   91   N1 is Nr+1,
   92   V1 is V >> (I+1),
   93   quantificate(V1,N1,P0,P).
   94
   95log2(1,0) :- !.
   96log2(2,1) :- !.
   97log2(4,2) :- !.
   98log2(8,3) :- !.
   99log2(N,I) :- N1 is N>>4, N1=\=0, log2(N1,I1), I is I1+4.
  100
  101schedule([P],Vg,Q) :- !, schedule1(P,Vg,Q).
  102schedule([P1|P2],Vg,(Q1,Q2)) :- !, schedule1(P1,Vg,Q1), schedule(P2,Vg,Q2).
  103
  104schedule1(m(V,C,P),Vg,Q) :-
  105   maybe_cut(V,Vg,Q0,Q),
  106   plan(P,V,C,Vg,Q0).
  107
  108maybe_cut(V,Vg,P,{P}) :- disjoint(V,Vg), !.
  109maybe_cut(_V,_Vg,P,P).
  110
  111plan(\+P,Vg,_,_,\+Q) :- !, Vg = 0,
  112   marked(P,V,C,P1),
  113   plan(P1,V,C,Vg,Q1),
  114   quantificate(V,0,Q1,Q).
  115plan(SQ,Vg,_,_,SQ1) :- subquery(SQ,SQ1,X,P,_,Q), !,
  116   marked(P,V,C,P1),
  117   variables(X,Vg,Vgx),
  118   setminus(V,Vgx,Vl),
  119   quantificate(Vl,0,Q1,Q),
  120   plan(P1,V,C,Vgx,Q1).
  121plan(P,V,C,Vg,(Q,R)) :- is_conjunction(P), !,
  122   best_goal(P,V,C,P0,V0,PP),
  123   plan(P0,V0,C,Vg,Q),
  124   instantiate(PP,V0,L),
  125   add_keys(L,L1),
  126   keysort(L1,L2),
  127   strip_keys(L2,L3),
  128   schedule(L3,Vg,R).
  129plan(P,_,_,_,P).
  130
  131is_conjunction((_,_)).
  132
  133marked(m(V,C,P),V,C,P).
  134
  135freevars(m(V,_,_),V).
  136
  137best_goal((P1,P2),V,C,P0,V0,m(V,C,Q)) :- !,
  138   ( marked(P1,Va,C,Pa), Q=(Pb,P2) ; marked(P2,Va,C,Pa), Q=(P1,Pb) ), !,
  139   best_goal(Pa,Va,C,P0,V0,Pb).
  140best_goal(P,V,_C,P,V,true).
  141
  142instantiate(true,_,[]) :- !.
  143instantiate(P,Vi,[P]) :- freevars(P,V), disjoint(V,Vi), !.
  144instantiate(m(V,_,P),Vi,L) :- instantiate0(P,V,Vi,L).
  145
  146instantiate0((P1,P2),_,Vi,L) :-
  147   instantiate(P1,Vi,L1),
  148   instantiate(P2,Vi,L2),
  149   recombine(L1,L2,L).
  150instantiate0(\+P,V,Vi,L) :- !,
  151   instantiate(P,Vi,L0),
  152   freevars(P,Vf), setminus(Vf,V,Vl),
  153   negate80(L0,Vl,L).
  154instantiate0(SQ,Vg,Vi,[m(V,C,SQ1)]) :- subquery(SQ,SQ1,X,P,_,Q), !,
  155   instantiate(P,Vi,L),
  156   L=[Q],   % Too bad about the general case!
  157   marked(Q,Vg,C0,_),
  158   setminus(Vg,Vi,V),
  159   variables(X,0,Vx),
  160   setminus(V,Vx,V0),
  161   setofcost(V0,C0,C).
  162instantiate0(P,V,Vi,[m(V1,C,P)]) :-
  163   setminus(V,Vi,V1),
  164   cost(P,V1,C).
  165
  166recombine(L,[],L) :- !.
  167recombine([],L,L).
  168recombine([P1|L1],[P2|L2],L) :-
  169   marked(P1,V1,C1,_), nonempty(V1),
  170   incorporate(P1,V1,C1,P2,L2,L3), !,
  171   recombine(L1,L3,L).
  172recombine([P|L1],L2,[P|L]) :- recombine(L1,L2,L).
  173
  174incorporate(P0,V0,C0,P1,L1,L) :-
  175   marked(P1,V1,C1,_),
  176   intersect(V0,V1), !,
  177   setplus(V0,V1,V),
  178   minimum(C0,C1,C),
  179   incorporate0(m(V,C,(P0,P1)),V,C,L1,L).
  180incorporate(P0,V0,C0,P1,[P2|L1],[P1|L]) :- incorporate(P0,V0,C0,P2,L1,L).
  181
  182incorporate0(P0,V0,C0,[P1|L1],L) :- incorporate(P0,V0,C0,P1,L1,L), !.
  183incorporate0(P,_,_,L,[P|L]).
  184
  185minimum(N1,N2,N1) :- N1 =< N2, !.
  186minimum(_N1,N2,N2).
  187
  188add_keys([],[]).
  189add_keys([P|L],[C-P|L1]) :- marked(P,_,C,_), add_keys(L,L1).
  190
  191strip_keys([],[]).
  192strip_keys([X|L],[P|L1]) :- strip_key(X,P), strip_keys(L,L1).
  193
  194strip_key(_C-P,P).
  195
  196variablise('$VAR'(N),VV,V) :- !, N1 is N+1, arg(N1,VV,V).
  197variablise(T,_,T) :- atomic(T), !.
  198variablise(T,VV,T1) :-
  199   functor(T,F,N),
  200   functor(T1,F,N),
  201   variablise(N,T,VV,T1).
  202
  203variablise(0,_,_,_) :- !.
  204variablise(N,T,VV,T1) :- N1 is N-1,
  205   arg(N,T,X),
  206   arg(N,T1,X1),
  207   variablise(X,VV,X1),
  208   variablise(N1,T,VV,T1).
  209
  210cost(+P,0,N) :- !, cost(P,0,N).
  211cost(+_P,_V,1000) :- !.
  212cost(P,V,N) :- functor(P,F,I), cost(I,F,P,V,N).
  213
  214cost(1,F,P,V,N) :-
  215   arg(1,P,X1), instantiated(X1,V,I1),
  216   nd(F,N0,N1),
  217   N is N0-I1*N1.
  218cost(2,F,P,V,N) :-
  219   arg(1,P,X1), instantiated(X1,V,I1),
  220   arg(2,P,X2), instantiated(X2,V,I2),
  221   nd(F,N0,N1,N2),
  222   N is N0-I1*N1-I2*N2.
  223cost(3,F,P,V,N) :-
  224   arg(1,P,X1), instantiated(X1,V,I1),
  225   arg(2,P,X2), instantiated(X2,V,I2),
  226   arg(3,P,X3), instantiated(X3,V,I3),
  227   nd(F,N0,N1,N2,N3),
  228   N is N0-I1*N1-I2*N2-I3*N3.
  229
  230instantiated([X|_],V,N) :- !, instantiated(X,V,N).
  231instantiated('$VAR'(N),V,0) :- setcontains(V,N), !.
  232instantiated(_,_,1).
  233
  234/*-------------------------Put in reserve--------------------
  235
  236sort_parts([],[]) :- !.
  237sort_parts([X],[X]) :- !.
  238sort_parts(L,R) :-
  239   divide(L,L1,L2),
  240   sort_parts(L1,R1),
  241   sort_parts(L2,R2),
  242   merge(R1,R2,R).
  243
  244divide([X1|L0],[X1|L1],[X2|L2]) :- list(L0,X2,L), !, divide(L,L1,L2).
  245divide(L,L,[]).
  246
  247list([X|L],X,L).
  248
  249merge([],R,R) :- !.
  250merge([X|R1],R2,[X|R]) :- precedes(X,R2), !, merge(R1,R2,R).
  251merge(R1,[X|R2],[X|R]) :- !, merge(R1,R2,R).
  252merge(R,[],R).
  253
  254precedes(G1,[G2|_]) :- goal_info(G1,_,N1), goal_info(G2,_,N2), N1 =< N2.
  255
  256-------------------------------------------------------------*/
  257
  258nonempty(0) :- !, fail.
  259nonempty(_).
  260
  261setplus(W1-V1,W2-V2,W-V) :- !, V is V1 \/ V2, setplus(W1,W2,W).
  262setplus(W-V1,V2,W-V) :- !, V is V1 \/ V2.
  263setplus(V1,W-V2,W-V) :- !, V is V1 \/ V2.
  264setplus(V1,V2,V) :- V is V1 \/ V2.
  265
  266setminus(W1-V1,W2-V2,S) :- !, V is V1 /\ \(V2),
  267   setminus(W1,W2,W), mkset(W,V,S).
  268setminus(W-V1,V2,W-V) :- !, V is V1 /\ \(V2).
  269setminus(V1,_W-V2,V) :- !, V is V1 /\ \(V2).
  270setminus(V1,V2,V) :- V is V1 /\ \(V2).
  271
  272mkset(0,V,V) :- !.
  273mkset(W,V,W-V).
  274
  275setplusitem(W-V,N,W-V1) :- N < 18, !, V1 is V \/ 1<<N.
  276setplusitem(W-V,N,W1-V) :- !, N1 is N-18, setplusitem(W,N1,W1).
  277setplusitem(V,N,V1) :- N < 18, !, V1 is V \/ 1<<N.
  278setplusitem(V,N,W-V) :- N1 is N-18, setplusitem(0,N1,W).
  279
  280setcontains(_W-V,N) :- N < 18, !, V /\ 1<<N =\= 0.
  281setcontains(W-_V,N) :- !, N1 is N-18, setcontains(W,N1).
  282setcontains(V,N) :- N < 18, V /\ 1<<N =\= 0.
  283
  284intersect(W1-V1,W2-V2) :- !, ( V1 /\ V2 =\= 0 ; intersect(W1,W2) ), !.
  285intersect(_W-V1,V2) :- !, V1 /\ V2 =\= 0.
  286intersect(V1,_W-V2) :- !, V1 /\ V2 =\= 0.
  287intersect(V1,V2) :- V1 /\ V2 =\= 0.
  288
  289disjoint(W1-V1,W2-V2) :- !, V1 /\ V2 =:= 0, disjoint(W1,W2).
  290disjoint(_W-V1,V2) :- !, V1 /\ V2 =:= 0.
  291disjoint(V1,_W-V2) :- !, V1 /\ V2 =:= 0.
  292disjoint(V1,V2) :- V1 /\ V2 =:= 0