1/*  Copyright 1986-2020 David H. D. Warren and Fernando C. N. Pereira
    2
    3    Permission is hereby granted, free of charge, to any person obtaining a
    4    copy of this software and associated documentation files (the
    5    "Software"), to deal in the Software without restriction, including
    6    without limitation the rights to use, copy, modify, merge, publish,
    7    distribute, sublicense, and/or sell copies of the Software, and to
    8    permit persons to whom the Software is furnished to do so, subject to
    9    the following conditions:
   10
   11    The above copyright notice and this permission notice shall be included
   12    in all copies or substantial portions of the Software.
   13
   14    THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
   15    OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
   16    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
   17    IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
   18    CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
   19    TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
   20    SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
   21*/
   22
   23% QPLAN - supplies the control information (ie. sequencing and cuts) needed
   24%         for efficient execution of a query.
   25
   26:-public qplan/2.   27
   28:-mode
   29   qplan(+,-),
   30   qplan(+,+,-,-),
   31   mark(+,-,+,-),
   32   subquery(+,-,?,?,?,?),
   33   negate(+,+,-),
   34   negationcost(+,-),
   35   setofcost(+,+,-),
   36   variables(+,+,-),
   37   variables(+,+,+,-),
   38   quantificate(+,+,?,-),
   39   log2(+,-),
   40   schedule(+,+,-),
   41   schedule1(+,+,-),
   42   maybe_cut(+,+,?,-),
   43   plan(+,+,+,+,-),
   44   is_conjunction(+),
   45   marked(+,?,?,?),
   46   freevars(+,?),
   47   best_goal(+,+,+,?,?,-),
   48   instantiate(+,+,-),
   49   instantiate0(+,+,-),
   50   recombine(+,+,-),
   51   incorporate(+,+,+,+,+,-),
   52   incorporate0(+,+,+,+,-),
   53   minimum(+,+,-),
   54   add_keys(+,-),
   55   strip_keys(+,-),
   56   strip_key(+,?),
   57   variablise(+,+,-),
   58   variablise(+,+,+,+),
   59   cost(+,+,-),
   60   cost(+,+,+,+,-),
   61   instantiated(+,+,-).   62
   63qplan((P:-Q),(P1:-Q1)) :- qplan(P,Q,P1,Q1), !.
   64qplan(P,P).
   65
   66qplan(X0,P0,X,P) :-
   67   numbervars(X0,0,I), variables(X0,0,Vg),
   68   numbervars(P0,I,N),
   69   mark(P0,L,0,Vl),
   70   schedule(L,Vg,P1),
   71   quantificate(Vl,0,P1,P2),
   72   functor(VA,$,N),
   73   variablise(X0,VA,X),
   74   variablise(P2,VA,P).
   75
   76mark(X^P,L,Q0,Q) :- !, variables(X,Q0,Q1), mark(P,L,Q1,Q).
   77mark((P1,P2),L,Q0,Q) :- !,
   78   mark(P1,L1,Q0,Q1),
   79   mark(P2,L2,Q1,Q),
   80   recombine(L1,L2,L).
   81mark(\+P,L,Q,Q) :- !, mark(P,L0,0,Vl), negate(L0,Vl,L).
   82mark(SQ,[m(V,C,SQ1)],Q0,Q0) :- subquery(SQ,SQ1,X,P,N,Q), !,
   83   mark(P,L,0,Vl),
   84   L=[Q],   % Too bad about the general case!
   85   marked(Q,Vq,C0,_),
   86   variables(X,Vl,Vlx),
   87   setminus(Vq,Vlx,V0),
   88   setofcost(V0,C0,C),
   89   variables(N,V0,V).
   90mark(P,[m(V,C,P)],Q,Q) :-
   91   variables(P,0,V),
   92   cost(P,V,C).
   93
   94subquery(setof(X,P,S),setof(X,Q,S),X,P,S,Q).
   95subquery(numberof(X,P,N),numberof(X,Q,N),X,P,N,Q).
   96
   97negate([],_,[]).
   98negate([P|L],Vl,[m(Vg,C,\+P)|L1]) :-
   99   freevars(P,V),
  100   setminus(V,Vl,Vg),
  101   negationcost(Vg,C),
  102   negate(L,Vl,L1).
  103
  104negationcost(0,0) :- !.
  105negationcost(V,1000).
  106
  107setofcost(0,_,0) :- !.
  108setofcost(_,C,C).
  109
  110variables('$VAR'(N),V0,V) :- !, setplusitem(V0,N,V).
  111variables(T,V,V) :- atomic(T), !.
  112variables(T,V0,V) :- functor(T,_,N), variables(N,T,V0,V).
  113
  114variables(0,_,V,V) :- !.
  115variables(N,T,V0,V) :- N1 is N-1,
  116   arg(N,T,X),
  117   variables(X,V0,V1),
  118   variables(N1,T,V1,V).
  119
  120quantificate(W-V,N,P0,P) :- !, N1 is N+18,
  121   quantificate(V,N,P1,P),
  122   quantificate(W,N1,P0,P1).
  123quantificate(0,_,P,P) :- !.
  124quantificate(V,N,P0,'$VAR'(Nr)^P) :-
  125   Vr is V /\ -(V),     % rightmost bit
  126   log2(Vr,I),
  127   Nr is N+I,
  128   N1 is Nr+1,
  129   V1 is V >> (I+1),
  130   quantificate(V1,N1,P0,P).
  131
  132log2(1,0) :- !.
  133log2(2,1) :- !.
  134log2(4,2) :- !.
  135log2(8,3) :- !.
  136log2(N,I) :- N1 is N>>4, N1=\=0, log2(N1,I1), I is I1+4.
  137
  138schedule([P],Vg,Q) :- !, schedule1(P,Vg,Q).
  139schedule([P1|P2],Vg,(Q1,Q2)) :- !, schedule1(P1,Vg,Q1), schedule(P2,Vg,Q2).
  140
  141schedule1(m(V,C,P),Vg,Q) :-
  142   maybe_cut(V,Vg,Q0,Q),
  143   plan(P,V,C,Vg,Q0).
  144
  145maybe_cut(V,Vg,P,{P}) :- disjoint(V,Vg), !.
  146maybe_cut(V,Vg,P,P).
  147
  148plan(\+P,Vg,_,_,\+Q) :- !, Vg = 0,
  149   marked(P,V,C,P1),
  150   plan(P1,V,C,Vg,Q1),
  151   quantificate(V,0,Q1,Q).
  152plan(SQ,Vg,_,_,SQ1) :- subquery(SQ,SQ1,X,P,_,Q), !,
  153   marked(P,V,C,P1),
  154   variables(X,Vg,Vgx),
  155   setminus(V,Vgx,Vl),
  156   quantificate(Vl,0,Q1,Q),
  157   plan(P1,V,C,Vgx,Q1).
  158plan(P,V,C,Vg,(Q,R)) :- is_conjunction(P), !,
  159   best_goal(P,V,C,P0,V0,PP),
  160   plan(P0,V0,C,Vg,Q),
  161   instantiate(PP,V0,L),
  162   add_keys(L,L1),
  163   keysort(L1,L2),
  164   strip_keys(L2,L3),
  165   schedule(L3,Vg,R).
  166plan(P,_,_,_,P).
  167
  168is_conjunction((_,_)).
  169
  170marked(m(V,C,P),V,C,P).
  171
  172freevars(m(V,_,_),V).
  173
  174best_goal((P1,P2),V,C,P0,V0,m(V,C,Q)) :- !,
  175   ( marked(P1,Va,C,Pa), Q=(Pb,P2) ; marked(P2,Va,C,Pa), Q=(P1,Pb) ), !,
  176   best_goal(Pa,Va,C,P0,V0,Pb).
  177best_goal(P,V,C,P,V,true).
  178
  179instantiate(true,_,[]) :- !.
  180instantiate(P,Vi,[P]) :- freevars(P,V), disjoint(V,Vi), !.
  181instantiate(m(V,_,P),Vi,L) :- instantiate0(P,V,Vi,L).
  182
  183instantiate0((P1,P2),_,Vi,L) :-
  184   instantiate(P1,Vi,L1),
  185   instantiate(P2,Vi,L2),
  186   recombine(L1,L2,L).
  187instantiate0(\+P,V,Vi,L) :- !,
  188   instantiate(P,Vi,L0),
  189   freevars(P,Vf), setminus(Vf,V,Vl),
  190   negate(L0,Vl,L).
  191instantiate0(SQ,Vg,Vi,[m(V,C,SQ1)]) :- subquery(SQ,SQ1,X,P,_,Q), !,
  192   instantiate(P,Vi,L),
  193   L=[Q],   % Too bad about the general case!
  194   marked(Q,Vq,C0,_),
  195   setminus(Vg,Vi,V),
  196   variables(X,0,Vx),
  197   setminus(V,Vx,V0),
  198   setofcost(V0,C0,C).
  199instantiate0(P,V,Vi,[m(V1,C,P)]) :-
  200   setminus(V,Vi,V1),
  201   cost(P,V1,C).
  202
  203recombine(L,[],L) :- !.
  204recombine([],L,L).
  205recombine([P1|L1],[P2|L2],L) :-
  206   marked(P1,V1,C1,_), nonempty(V1),
  207   incorporate(P1,V1,C1,P2,L2,L3), !,
  208   recombine(L1,L3,L).
  209recombine([P|L1],L2,[P|L]) :- recombine(L1,L2,L).
  210
  211incorporate(P0,V0,C0,P1,L1,L) :-
  212   marked(P1,V1,C1,_),
  213   intersect(V0,V1), !,
  214   setplus(V0,V1,V),
  215   minimum(C0,C1,C),
  216   incorporate0(m(V,C,(P0,P1)),V,C,L1,L).
  217incorporate(P0,V0,C0,P1,[P2,L1],[P1|L]) :- incorporate(P0,V0,C0,G2,L1,L).
  218
  219incorporate0(P0,V0,C0,[P1|L1],L) :- incorporate(P0,V0,C0,P1,L1,L), !.
  220incorporate0(P,_,_,L,[P|L]).
  221
  222minimum(N1,N2,N1) :- N1 =< N2, !.
  223minimum(N1,N2,N2).
  224
  225add_keys([],[]).
  226add_keys([P|L],[C-P|L1]) :- marked(P,_,C,_), add_keys(L,L1).
  227
  228strip_keys([],[]).
  229strip_keys([X|L],[P|L1]) :- strip_key(X,P), strip_keys(L,L1).
  230
  231strip_key(C-P,P).
  232
  233variablise('$VAR'(N),VV,V) :- !, N1 is N+1, arg(N1,VV,V).
  234variablise(T,_,T) :- atomic(T), !.
  235variablise(T,VV,T1) :-
  236   functor(T,F,N),
  237   functor(T1,F,N),
  238   variablise(N,T,VV,T1).
  239
  240variablise(0,_,_,_) :- !.
  241variablise(N,T,VV,T1) :- N1 is N-1,
  242   arg(N,T,X),
  243   arg(N,T1,X1),
  244   variablise(X,VV,X1),
  245   variablise(N1,T,VV,T1).
  246
  247cost(+P,0,N) :- !, cost(P,0,N).
  248cost(+P,V,1000) :- !.
  249cost(P,V,N) :- functor(P,F,I), cost(I,F,P,V,N).
  250
  251cost(1,F,P,V,N) :-
  252   arg(1,P,X1), instantiated(X1,V,I1),
  253   nd(F,N0,N1),
  254   N is N0-I1*N1.
  255cost(2,F,P,V,N) :-
  256   arg(1,P,X1), instantiated(X1,V,I1),
  257   arg(2,P,X2), instantiated(X2,V,I2),
  258   nd(F,N0,N1,N2),
  259   N is N0-I1*N1-I2*N2.
  260cost(3,F,P,V,N) :-
  261   arg(1,P,X1), instantiated(X1,V,I1),
  262   arg(2,P,X2), instantiated(X2,V,I2),
  263   arg(3,P,X3), instantiated(X3,V,I3),
  264   nd(F,N0,N1,N2,N3),
  265   N is N0-I1*N1-I2*N2-I3*N3.
  266
  267instantiated([X|_],V,N) :- !, instantiated(X,V,N).
  268instantiated('$VAR'(N),V,0) :- setcontains(V,N), !.
  269instantiated(_,_,1).
  270
  271/*-------------------------Put in reserve--------------------
  272
  273sort_parts([],[]) :- !.
  274sort_parts([X],[X]) :- !.
  275sort_parts(L,R) :-
  276   divide(L,L1,L2),
  277   sort_parts(L1,R1),
  278   sort_parts(L2,R2),
  279   merge(R1,R2,R).
  280
  281divide([X1|L0],[X1|L1],[X2|L2]) :- list(L0,X2,L), !, divide(L,L1,L2).
  282divide(L,L,[]).
  283
  284list([X|L],X,L).
  285
  286merge([],R,R) :- !.
  287merge([X|R1],R2,[X|R]) :- precedes(X,R2), !, merge(R1,R2,R).
  288merge(R1,[X|R2],[X|R]) :- !, merge(R1,R2,R).
  289merge(R,[],R).
  290
  291precedes(G1,[G2|_]) :- goal_info(G1,_,N1), goal_info(G2,_,N2), N1 =< N2.
  292
  293-------------------------------------------------------------*/
  294
  295:-mode
  296   nonempty(+),
  297   setplus(+,+,-),
  298   setminus(+,+,-),
  299   mkset(+,+,-),
  300   setplusitem(+,+,-),
  301   setcontains(+,+),
  302   intersect(+,+),
  303   disjoint(+,+).  304
  305nonempty(0) :- !, fail.
  306nonempty(_).
  307
  308setplus(W1-V1,W2-V2,W-V) :- !, V is V1 \/ V2, setplus(W1,W2,W).
  309setplus(W-V1,V2,W-V) :- !, V is V1 \/ V2.
  310setplus(V1,W-V2,W-V) :- !, V is V1 \/ V2.
  311setplus(V1,V2,V) :- V is V1 \/ V2.
  312
  313setminus(W1-V1,W2-V2,S) :- !, V is V1 /\ \(V2),
  314   setminus(W1,W2,W), mkset(W,V,S).
  315setminus(W-V1,V2,W-V) :- !, V is V1 /\ \(V2).
  316setminus(V1,W-V2,V) :- !, V is V1 /\ \(V2).
  317setminus(V1,V2,V) :- V is V1 /\ \(V2).
  318
  319mkset(0,V,V) :- !.
  320mkset(W,V,W-V).
  321
  322setplusitem(W-V,N,W-V1) :- N < 18, !, V1 is V \/ 1<<N.
  323setplusitem(W-V,N,W1-V) :- !, N1 is N-18, setplusitem(W,N1,W1).
  324setplusitem(V,N,V1) :- N < 18, !, V1 is V \/ 1<<N.
  325setplusitem(V,N,W-V) :- N1 is N-18, setplusitem(0,N1,W).
  326
  327setcontains(W-V,N) :- N < 18, !, V /\ 1<<N =\= 0.
  328setcontains(W-V,N) :- !, N1 is N-18, setcontains(W,N1).
  329setcontains(V,N) :- N < 18, V /\ 1<<N =\= 0.
  330
  331intersect(W1-V1,W2-V2) :- !, ( V1 /\ V2 =\= 0 ; intersect(W1,W2) ), !.
  332intersect(W-V1,V2) :- !, V1 /\ V2 =\= 0.
  333intersect(V1,W-V2) :- !, V1 /\ V2 =\= 0.
  334intersect(V1,V2) :- V1 /\ V2 =\= 0.
  335
  336disjoint(W1-V1,W2-V2) :- !, V1 /\ V2 =:= 0, disjoint(W1,W2).
  337disjoint(W-V1,V2) :- !, V1 /\ V2 =:= 0.
  338disjoint(V1,W-V2) :- !, V1 /\ V2 =:= 0.
  339disjoint(V1,V2) :- V1 /\ V2 =:= 0