%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Copyright (C) 1989 Peter Van Roy and Regents of the University of California % Dataflow analysis version 4 % This module does a flow analysis, deriving 'uninit', 'ground', 'nonvar', and % 'rderef' modes by doing an abstract interpretation of the source code. % It traverses the call tree and keeps track of entry and exit modes. % It iterates and propagates modes until the least fixed point is reached. % The module is a transformation pass in the Aquarius compiler. % The entry mode lattice is (for each argument of all predicates): % any % / \ % nonvar rderef % / \ / \ % ground non+drf uninit % \ / / % gnd+drf / % \ / % unknown % The exit mode lattice is identical (there is no 'uninit' element for non-unify % goals). The rderef lattice element corresponds to the mode rderef(X) which % means that all subterms of X are dereferenced. It propagates just like % ground(X). It is useful to reduce the large amount of dereferencing which is % going on (usually between 10% and 20% of the execution time with analyzer 2!). % These simple lattices are easily implemented for four reasons: (1) neither % uninits nor grounds are affected by aliasing, and (2) uninit, grounds, and % rderefs all propagate indefinitely into explicit unifications with compound % terms, (3) nonvars and grounds, once true, do not become false again, and % (4) there is no explicit representation for aliasing--modes are calculated % only for unaliased variables (e.g. uninit and rderef) and for cases where % aliasing has no effect (e.g. ground and nonvar). % Notes: % 1. A set of entry points must exist to do the analysis. % 2. In each pass, this algorithm traverses the call tree starting from those % predicates whose entry modes have changed or which contain a goal whose % exit modes have changed. The algorithm differs from O'Keefe's in the % data structures used. % 3. Only modes "generated" within the strees given are propagated. Except for % the entry modes, all modes "already existing" are ignored. This allows % the compiler to correct programmer's errors. % 4. Predicates of arity zero are always used as entry points in the analysis. % 5. To get better results for exit modes, this algorithm back-propagates % the results at the end of the clause to the beginning, through the % unifications in the clause. For example, part1(A,B) :- A=[X|L], B=[X|L1], % part2(L,L1). Let A be ground at entry. If L1 returns ground from part2 % then B should return ground from part1 as well. % For later: % 1. Back propagate univ, i.e. in A=..[X|Y], if X & Y are ground then A is too. % Can use existing unify(_,_,_) data structure. Generalize? % 2. The mode rlist(X) (recursive list) propagates similarly to ground(X) also. % It should be added to the exit mode analyzer too. % 3. This version does not use cuts to get better modes. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Accumulator declarations: pass_info(pred). pass_info(dup). acc_info(gnd, T, In, Out, set_command(T,In,Out), [], _). acc_info(nonvar, T, In, Out, set_command(T,In,Out), [], _). acc_info(uninit, T, In, Out, set_command(T,In,Out), [], _). acc_info(rderef, T, In, Out, set_command(T,In,Out), [], _). acc_info(sf, S, In, Out, unionv(S,In,Out), [], _). acc_info(uni, U, Out, In, Out=[U|In], _, []). acc_info(set, T, In, Out, set_command(T,In,Out), [], _). acc_info(count, I, In, Out, (Out is In+I)). acc_info(change, I, In, Out, set_command(I, In, Out)). acc_info(occurs, T, In, Out, table_command(T,In,Out)). acc_info(entry, T, In, Out, table_command(T,In,Out)). acc_info(exit, T, In, Out, table_command(T,In,Out)). acc_info(defs, T, In, Out, table_command(T,In,Out)). acc_info(spec, T, In, Out, table_command(T,In,Out)). acc_info(uregs, T, In, Out, table_command(T,In,Out)). acc_info(fast, T, In, Out, table_command(T,In,Out)). acc_info(preds, P, Out, In, Out=[P|In]). % Predicate declarations: % *** Initialization: pred_info( init_strees, 1, [entry,exit,defs,occurs]). pred_info( init_disj, 1, [entry,exit,defs,occurs,pred]). pred_info( init_conj, 1, [entry,exit,defs,occurs,pred]). pred_info( init_goal, 1, [entry,exit,defs,occurs,pred]). pred_info( entry_init, 1, [entry]). pred_info( entry_init_one, 1, [entry]). % *** Top level analysis: pred_info(analyze_closure, 1, [entry,exit,defs,spec,occurs]). pred_info( trav_preds, 1, [entry,exit,defs,spec,change]). % *** Traversal of call tree: pred_info( trav_pred, 4, [entry,exit,defs,spec,change,gnd,nonvar,uninit,rderef,sf]). pred_info( trav_disj, 8, [entry,exit,defs,spec,change,gnd,nonvar,uninit,rderef,sf]). pred_info( trav_conj, 5, [entry,exit,defs,spec,change,gnd,nonvar,uninit,rderef,sf,uni,dup]). pred_info( trav_goal, 6, [entry,exit,defs,spec,change,gnd,nonvar,uninit,rderef,sf,uni,dup]). pred_info( trav_call, 6, [entry,exit,defs,spec,change,gnd,nonvar,uninit,rderef,sf]). pred_info( trav_def, 7, [entry,exit,defs,spec,change,gnd,nonvar,uninit,rderef,sf]). % *** Update of entry & exit mode tables: pred_info( update_entry, 3, [entry, change,gnd,nonvar,uninit,rderef,sf]). pred_info( update_entry, 4, [entry, change]). pred_info( update_exit, 1, [exit, change,gnd,nonvar,rderef,sf]). pred_info( update_exit, 3, [exit, change]). % *** Utilities: pred_info( trav_goal_n, 2, [nonvar]). pred_info( trav_non, 2, [nonvar]). pred_info( trav_goal_u, 3, [gnd, uninit,rderef,sf,dup]). pred_info( trav_unif, 4, [gnd, uninit,rderef,sf,dup]). pred_info( trav_goal_d, 4, [gnd,nonvar,uninit,rderef,sf]). pred_info( trav_drf1, 4, [gnd,nonvar,uninit,rderef,sf]). pred_info( trav_drf2, 5, [gnd, uninit,rderef,sf]). pred_info( new_dref, 3, [gnd,nonvar,uninit,rderef,sf]). pred_info( add_dref, 1, [ uninit,rderef,sf]). pred_info( new_drf_gnd, 4, [gnd,nonvar,uninit,rderef,sf]). pred_info( new_drf_set, 2, [gnd, uninit,rderef,sf]). pred_info( calc_exit, 2, [gnd,nonvar, rderef]). pred_info( calc_entry, 2, [gnd,nonvar,uninit,rderef,sf]). pred_info( back_propagate, 1, [gnd,nonvar, rderef]). pred_info( back_prop_g_cl, 1, [gnd]). pred_info( back_prop_g_cl, 2, [gnd]). pred_info( back_prop_g, 2, [gnd,count]). pred_info( back_prop_d_cl, 1, [rderef]). pred_info( back_prop_d_cl, 2, [rderef]). pred_info( back_prop_d, 2, [rderef,count]). pred_info( back_prop_n_cl, 1, [nonvar]). pred_info( back_prop_n_cl, 2, [nonvar]). pred_info( back_prop_n, 2, [nonvar,count]). pred_info( make_uni, 3, [uninit,sf,uni,dup]). pred_info( dref_prop_flag, 2, [uninit,sf,uni,dup]). pred_info( new_preds, 1, [occurs,change]). pred_info( new_sets, 2, [gnd,nonvar,uninit,rderef,sf]). pred_info( save_sets, 1, [gnd,nonvar,uninit,rderef,sf]). pred_info( restore_sets, 1, [gnd,nonvar,uninit,rderef,sf]). pred_info( spec_goal, 5, [gnd,nonvar,uninit,rderef,sf,spec]). pred_info( spec_goal2, 6, [gnd,nonvar,uninit,rderef,sf,spec]). pred_info( spec_update, 7, [gnd,nonvar,uninit,rderef,sf,spec]). % *** Used in conversion of uninit to uninit_reg: pred_info( convert_closure, 1, [defs,occurs,fast,uregs]). pred_info( conv_preds, 1, [defs, fast,uregs,change]). pred_info( calc_convert_set, 3, [defs, fast,uregs,change,set]). pred_info( last_goal_ureg, 3, [defs, fast,uregs,change,set]). pred_info( update_fast_goal, 3, [defs, fast,uregs,change]). pred_info( update_ureg, 3, [uregs,change]). pred_info(init_convert_strees, 1, [entry,preds,fast,uregs]). pred_info( enter_fast, 2, [fast]). % Implement the accumulator commands: set_command(sub(X), In, Out) :- excludev(X, In, Out). % diffv(In, [X], Out). set_command(add(X), In, Out) :- includev(X, In, Out). set_command(sub_set(X), In, Out) :- diffv(In, X, Out). set_command(add_set(X), In, Out) :- unionv(X, In, Out). table_command(get(I,Val), In, In) :- get(In, I, Val). table_command(fget(I,Val),In, In) :- fget(In, I, Val). table_command(set(I,Val), In, Out) :- fset(In, I, Val, Out). table_command(add(I,X), In, Out) :- get(In, I, S1), includev(X, S1, S), fset(In, I, S, Out), !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % *** Add the derived modes to the strees and to the stored modes: % This adds information to pre-existing modes of the strees. create_mode_strees(Ss, ASs, Entry, Exit, UReg) :- create_mode_strees(Ss, ASs, Entry, Exit, UReg, top). create_mode_strees([], [], _, _, _, _) :- !. create_mode_strees([S|Ss], [AS|ASs], Entry, Exit, UReg, F) :- create_mode_stree(S, AS, Entry, Exit, UReg, F), create_mode_strees(Ss, ASs, Entry, Exit, UReg, F). create_mode_stree(stree(NaAr,HD,(H:-OldF),OH,DList,SD), stree(NaAr,HD,(H:-NewF),OH,ADList,SD), Entry,Exit,UReg,F):- !, lattice_modes_table(NaAr, Entry, H, Flow), lattice_modes_table(NaAr, Exit, H, ExFlow), new_formula(H, Flow, ExFlow, HD, UReg, NewReq, NewBef, NewAft), add_mode_option(analyze_mode(H,NewReq,NewBef,NewAft)), flat_conj((NewReq,NewBef), NewF), write_mode(F, H), create_mode_strees(DList, ADList, Entry, Exit, UReg, nontop). create_mode_stree(D, D, _, _, _, _) :- directive(D). % Calculate new Req+Bef+Aft modes according to the following schema: % OldReq OldBef OldAft % | | | % |\(split) | | % | \ | | % | \-unbound-\ | | % | \|(combine) | % | | | % | subsume | update | update % | Flow | Flow | ExFlow % | | | % | /|(split) | % | /-uninit--/ | | % | / | | % |/(combine) | | % | | | % NewReq NewBef NewAft new_formula(H, Flow, ExFlow, HD, UReg, NewReq, NewBef, NewAft) :- require(H, OldReq), before(H, OldBef), split_unbound(OldReq, OldU, OldReq2), combine_formula(OldU, OldBef, OldBef2), update_mode(Flow, OldBef2, H, OldBef3), squeeze_conj(OldBef3, OldBef4), convert_uninit(HD, UReg, OldBef4, OldBef5), split_uninit(OldBef5, NewU, NewBef), logical_subsume(Flow, OldReq2, OldReq3), combine_formula(NewU, OldReq3, NewReq), after(H, OldAft), update_mode(ExFlow, OldAft, H, OldAft2), squeeze_conj(OldAft2, NewAft). % Add the derived formula to an existing formula: update_mode( _, fail, _, fail) :- !. update_mode(fail, _, _, fail) :- !. update_mode(NewF, true, _, NewF) :- !. update_mode(true, OldF, _, OldF) :- !. update_mode((Goal,Conj), OldF, Head, NewF) :- !, update_one(Goal, OldF, Head, MidF), update_mode(Conj, MidF, Head, NewF). update_one(fail, _, _, fail) :- !. update_one(ground(X), OldF, Head, NewF) :- implies(OldF, unbound(X)), !, incorrect_mode(X, Head, ground(X), OldF, NewF). update_one(nonvar(X), OldF, Head, NewF) :- implies(OldF, unbound(X)), !, incorrect_mode(X, Head, nonvar(X), OldF, NewF). update_one(uninit(X), OldF, Head, NewF) :- implies(OldF, nonvar(X)), !, incorrect_mode(X, Head, uninit(X), OldF, NewF). update_one(uninit_reg(X), OldF, Head, NewF) :- implies(OldF, nonvar(X)), !, incorrect_mode(X, Head, uninit_reg(X), OldF, NewF). update_one(ground(X), OldF, _, OldF) :- pred_exists(ground(X), OldF), !. update_one(nonvar(X), OldF, _, OldF) :- pred_exists(nonvar(X), OldF), !. update_one(uninit(X), OldF, _, OldF) :- pred_exists(uninit(X), OldF), !. update_one(uninit_reg(X), OldF, _, OldF) :- pred_exists(uninit_reg(X), OldF), !. update_one(rderef(X), OldF, _, OldF) :- pred_exists(rderef(X), OldF), !. update_one(uninit(X), OldF, Head, NewF) :- pred_exists(var(X), OldF), !, NewF = (uninit(X),MidF), split_from_formula(X, OldF, MidF, BadF), squeeze_conj(BadF, SquF), warning(Head, ['Mode ',SquF,' of ',Head,' replaced by ',uninit(X)]). update_one(uninit_reg(X), OldF, Head, NewF) :- pred_exists(var(X), OldF), !, NewF = (uninit_reg(X),MidF), split_from_formula(X, OldF, MidF, BadF), squeeze_conj(BadF, SquF), warning(Head, ['Mode ',SquF,' of ',Head,' replaced by ',uninit_reg(X)]). update_one(ground(X), OldF, _, (ground(X),OldF)) :- !. update_one(nonvar(X), OldF, _, (nonvar(X),OldF)) :- !. update_one(uninit(X), OldF, _, (uninit(X),OldF)) :- !. update_one(uninit_reg(X), OldF, _, (uninit_reg(X),OldF)) :- !. update_one(rderef(X), OldF, _, (rderef(X),OldF)) :- !. incorrect_mode(X, Head, GoodF, OldF, (GoodF,MidF)) :- split_from_formula(X, OldF, MidF, BadF), squeeze_conj(BadF, SquF), warning(Head, ['Mode ',SquF,' of ',Head,' is incorrect.',nl, 'Compilation continued with corrected mode ',GoodF]). % Write the mode: % If it is a top-level mode and no compile, then output it in % Prolog-readable form. Otherwise, output it as a comment. write_mode(top, Head) :- \+compile_option(compile), !, require(Head, R), before(Head, B), after(Head, A), survive(Head, S), w(':- '),inst_writeq(mode(Head,R,B,A,S)),wn('.'). write_mode(_, Head) :- \+compile_option(compile), !, require(Head, R), before(Head, B), after(Head, A), survive(Head, S), w('% '),inst_writeq(mode(Head,R,B,A,S)),nl. write_mode(_, Head) :- compile_option(compile), !, require(Head, R), before(Head, B), after(Head, A), survive(Head, S), w('% '),inst_writeq(mode(Head,R,B,A,S)),nl. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % *** Convert uninit(X) modes into uninit_reg(X) modes: % This is done only for uninitialized variables which occur up to once in the % last non-survive goal or the survive goals beyond it, and do not occur before % that in the body of each clause. % The last non-survive goal, if it exists, must have an uninit_reg mode in the % same argument position as those uninit. vars, otherwise no tail recursion % optimization can be done. A closure calculation is done to guarantee this & % not to lose optimization opportunities. % (An easy approximation is to allow the conversion only for recursive calls, % but this loses the optimization for predicates with cuts and factoring.) % There are two entry points to this transformation: % convert_uninit: uses the pre-calculated URegTable to convert one predicate. % convert_uninit_strees: closure calculation which gives URegTable. % *** Convert the allowed arguments of a single predicate to uninit_reg. % Relies on the information gathered by convert_uninit_strees. convert_uninit((Head:-Disj), URegTable, InF, OutF) :- compile_option(analyze_uninit_reg), !, functor(Head, Na, Ar), get(URegTable, Na/Ar, ConvSet), convert_form(InF, OutF, ConvSet). convert_uninit(_, _, InF, InF). convert_form((A,B), (CA,CB), ConvSet) :- !, convert_form(A, CA, ConvSet), convert_form(B, CB, ConvSet). convert_form(uninit(X), uninit_reg(X), ConvSet) :- inv(X, ConvSet), !. convert_form(uninit_mem(X), uninit_reg(X), ConvSet) :- inv(X, ConvSet), !. convert_form(T, T, _). % *** Calculate for each predicate the set of arguments that may be uninit_reg. % The results are returned in OutUReg. convert_uninit_strees(Strees, Entry, Defs, Occurs, OutUReg) :- compile_option(analyze_uninit_reg), !, stats(a,1), init_convert(Strees, Entry, Preds, Fast, InUReg), stats(a,2), convert_closure(Preds, Defs, _, Occurs, _, Fast, _, InUReg, OutUReg). convert_uninit_strees(Strees, _, _, _, OutUReg) :- seal(OutUReg). convert_closure([]) -->> []. convert_closure(PropPreds) -->> {cons(PropPreds)}, !, {stats(a,3)}, conv_preds(PropPreds):change([],ChgSet), {stats(a,4)}, {length(ChgSet, N)}, {comment(['Uninit(reg) conversion pass--changed ',N,' predicates.'])}, new_preds(ChgSet):change([],NewPreds), convert_closure(NewPreds). conv_preds([]) -->> []. conv_preds([NaAr|Preds]) -->> [fget(NaAr,UReg)]:uregs, [fget(NaAr,(Head:-Disj))]:defs, {stats(a,data4(NaAr))}, calc_convert_set(Disj, Head, NaAr):set(UReg, NewUReg), {stats(a,5)}, update_ureg(NaAr, UReg, NewUReg), {stats(a,6)}, conv_preds(Preds). % Find the set of uninit(mem) variables that satisfy the condition to be % converted to uninit(reg) variables: calc_convert_set(fail, _, _) -->> !. calc_convert_set((Conj;Disj), Head, NaAr) -->> S/set, {cons(S)}, {split_conj_begin_end(Conj, Begin, End)}, {last_conj(End, Goal)}, !, {varset(Begin, BVars)}, [sub_set(BVars)]:set, {term_dupset(End, EDups)}, % For later: can relax this Dups condition slightly: [sub_set(EDups)]:set, {stats(a,data7(NaAr))}, last_goal_ureg(Goal, Head, NaAr), {stats(a,8)}, % Removing this goal slows chat_parser by 1%: update_fast_goal(Goal, Head, NaAr), {stats(a,9)}, calc_convert_set(Disj, Head, NaAr). calc_convert_set((_;_), _, _) -->> []. % Last_goal_ureg is used in the calculation of Head's set of uninit. regs. % If the last goal in the clause is a non-survive goal, then the head's % uninitialized register arguments must be uninitialized register arguments % of the last goal and in the same argument position. This guarantees no % extraneous move instructions destroying the possibility for TRO in the % clause. % If the last goal in the clause is a survive goal, then there are no extra % conditions on the uninitialized register arguments since no TRO is possible % anyway. % If the last goal is not defined in the program being analyzed, then no % uninitialized register arguments are possible. last_goal_ureg(Goal, _, _) -->> {survive(Goal)}, !. last_goal_ureg(Goal, Head, _/Ar) -->> S/set, {cons(S)}, {functor(Goal, N, A)}, [fget(N/A,UR)]:uregs, [fget(N/A,(G:-_))]:defs, !, % Rename UR's variables to those of Goal: {stats(a,data10(N/A,G,Goal,UR))}, {map_args(G, UR, Goal, URSet)}, {stats(a,11)}, {stats(a,data12(URSet))}, intersectv(URSet):set, {stats(a,13)}, {min_integer(A, Ar, Min)}, {stats(a,data14(A,Ar,Min))}, match_corresponding_args(1, Min, Head, Goal):set, {stats(a,15)}. last_goal_ureg(_, _, _) -->> insert(_,[]):set. % Additional optimization in the calculation of Goal's set of uninit. regs. % (This predicate can be removed without affecting correctness.) % If the last goal is "fast" (i.e. it calls only builtins & survive goals) then % update uregs for its definition too, by removing those ureg arguments whose % position doesn't match the head. This avoids having to do move instructions % AFTER the last goal returns. Doing such moves is bad, in particular: % 1. It removes the last call optimization (LCO) for that goal. % 2. It may increase the number of environments created. % If the last goal is not fast then it is not effective to keep LCO, % since execution time of the last goal can become very large, so the few % cycles gained by LCO aren't an advantage. % Note that uninit(mem) variables are better than uninit(reg)'s if an argument % is moved. This is because they can be passed INTO a predicate, % whereas uninit(reg) variables must always be passed OUT OF a predicate. % The string/1 predicate in chat_parser is an example of this, because it is % factored. It creates an environment when $fac_string/6 uses uninit(reg) args. update_fast_goal(Goal, Head, _/Ar) -->> {\+survive(Goal)}, {functor(Goal, N, A)}, [fget(N/A,_)]:fast, [fget(N/A,UR)]:uregs, [fget(N/A,(G:-_))]:defs, !, {map_args(G, UR, Goal, URSet)}, {min_integer(A, Ar, Min)}, {match_corresponding_args(1, Min, Head, Goal, URSet, NewURSet)}, {map_args(Goal, NewURSet, G, NUR)}, update_ureg(N/A, UR, NUR). update_fast_goal(_, _, _) -->> []. % Return the arguments of Set which are in the same position in Head and Goal. match_corresponding_args(N, M, _, _, _, []) :- N>M, !. match_corresponding_args(N, M, Head, Goal, Set, Out) :- N=> {UReg\==NewUReg}, !, [set(NaAr,NewUReg)]:uregs, [add(exit(NaAr))]:change. update_ureg(_, _, _) -->> []. % Create the initial values of Preds and URegTable: init_convert(Strees, Entry, Preds, Fast, URegTable) :- init_convert_strees(Strees, Entry, _, Preds, [], _, Fast, _, URegTable), seal(Fast), seal(URegTable). init_convert_strees([]) -->> []. init_convert_strees([S|Ss]) -->> {S=stree(NaAr,(Head:-Disj),_,_,DList,_)}, !, [NaAr]:preds, enter_fast(NaAr, Disj), [fget(NaAr,Entry)]:entry, {get_argvars(uninit, Head, Entry, UReg)}, [get(NaAr,X)]:uregs, {enter_ureg(X, UReg)}, init_convert_strees(DList), init_convert_strees(Ss). init_convert_strees([D|Ss]) -->> {directive(D)}, !, init_convert_strees(Ss). enter_fast(NaAr, Disj) -->> {fast_routine(Disj)}, !, [get(NaAr,dummy)]:fast. enter_fast(_, _) -->> []. enter_ureg(X, UReg) :- var(X), !, X=UReg. enter_ureg(X, _) :- nonvar(X). % Succeeds for the definition of a "fast" routine, i.e. the routine calls only % builtins and survive goals so that its execution time is almost independent % of its arguments. fast_routine((A;B)) :- !, fast_routine(A), fast_routine(B). fast_routine((A,B)) :- !, fast_routine(A), fast_routine(B). fast_routine(Goal) :- survive(Goal), !. fast_routine(Goal) :- builtin(Goal), !. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Initialize entry and exit mode tables, a table of predicate definitions, % and a table of predicates in which each predicate occurs. % (Could create only one table as initial value for both entry & exit modes) init_tables(Strees, Entry, Exit, Defs, Occurs) :- init_strees(Strees, _, Entry, _, Exit, _, Defs, _, Occurs), seal(Entry), seal(Exit), seal(Defs), seal(Occurs), !. init_strees([]) -->> []. init_strees([S|Ss]) -->> {S=stree(NaAr,(Head:-Disj),_,_,DList,_)}, !, {bottom_call(NaAr, B)}, [get(NaAr,B)]:entry, [get(NaAr,B)]:exit, [get(NaAr,Def)]:defs, {enter_def(Def, (Head:-Disj), NaAr)}, init_disj(Disj):pred(NaAr), init_strees(DList), init_strees(Ss). init_strees([D|Ss]) -->> {directive(D)}, !, init_strees(Ss). init_disj(fail) -->> []. init_disj((Conj;Disj)) -->> init_conj(Conj), init_disj(Disj). init_conj(true) -->> []. init_conj((Goal,Conj)) -->> init_goal(Goal), init_conj(Conj). init_goal(Goal) -->> {call_p(Goal)}, !, {functor(Goal, Na, Ar)}, {bottom_call(Na/Ar, B)}, [get(Na/Ar,B)]:entry, [get(Na/Ar,B)]:exit, Pred/pred, [add(Na/Ar,Pred)]:occurs. init_goal(Goal) -->> {unify_p(Goal)}, !. % Enter definition in table & give warning for multiple definitions: enter_def(Def, NewDef, _) :- var(Def), !, NewDef=Def. enter_def(Def, _, NaAr) :- nonvar(Def), !, warning(['The predicate ',NaAr,' has multiple definitions.',nl, 'Only the first definition will be used.']). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % *** Create and traverse entry point data structures: % Through the entry points' modes the analysis is kept consistent with % external calls. entry_data(Strees, Defs, EntData, SortPreds) :- (bagof(E, entry_data(E), Bag) -> true ; Bag=[]), filter_defs(Bag, EntData, EntDecl, Defs), entry_zero(Strees, EntPreds, EntDecl), sort(EntPreds, SortPreds). % Remove duplicates. % Get all definitions of arity zero. They are always entry points. entry_zero([]) --> []. entry_zero([stree(Na/0,_,_,_,DL,_)|Ss]) --> !, [Na/0], entry_zero(Ss), entry_zero(DL). entry_zero([stree(_/N,_,_,_,DL,_)|Ss]) --> {N>0}, !, entry_zero(Ss), entry_zero(DL). entry_zero([_|Ss]) --> entry_zero(Ss). % Calculate the variable sets corresponding to the entry point's formula: entry_data(entry(Head,Vars,Gnd,Non,Uni,Drf)) :- compile_option(entry(Head,Formula)), varset(Head, Vars), ground_set(Formula, Gnd), nonvar_set(Formula, Non), uninit_set(Formula, Uni), rderef_set(Formula, Drf). % Keep only entries which are definitions: filter_defs([], [], [], _). filter_defs([E|In], [E|Out], [Na/Ar|Preds], Defs) :- E=entry(Head,_,_,_,_,_), functor(Head, Na, Ar), get(Defs, Na/Ar, _), !, filter_defs(In, Out, Preds, Defs). filter_defs([_|In], Out, Preds, Defs) :- filter_defs(In, Out, Preds, Defs). % Do one analysis pass over all entry points: % Initialize tables for all entry points: entry_init([]) -->> []. entry_init([E|EntData]) -->> entry_init_one(E), entry_init(EntData). entry_init_one(entry(Head,V,G,N,U,D)) -->> update_entry(Head, _, _) :[gnd(G,_),nonvar(N,_),uninit(U,_),rderef(D,_),sf(V,_),change([],_)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % *** Top level of analysis: analyze_strees(Strees, AStrees) :- compile_option(analyze), !, comment(['Starting dataflow analysis']), analyze(Strees, AStrees). analyze_strees(Strees, Strees). % During traversal of call tree update the entry & exit mode tables and % keep track of the predicates whose entry and exit modes are changed. % Repeat traversal step with the predicates that need propagating (i.e. those % whose entry mode is changed & those which contain a goal whose exit mode % is changed) until there are no more changes. analyze(Strees, CStrees) :- stats(an,1), init_tables(Strees, Ent, Ex, Defs, Occurs), entry_data(Strees, Defs, EntData, EntPreds), cons(EntPreds), !, entry_init(EntData, Ent, MidEnt), stats(an,2), analyze_closure(EntPreds, MidEnt, OutEnt, Ex, OutEx, Defs, _, _, Spec, Occurs,_), stats(an,3), % Replace goals by their most specialized equivalents: seal(Spec), spec_strees(Strees, AStrees, Spec), stats(an,4), % Calculate which modes can be converted to uninit_reg: convert_uninit_strees(AStrees, OutEnt, Defs, Occurs, OutUReg), stats(an,5), % Update the modes: wn('% Modes generated:'), create_mode_strees(AStrees, BStrees, OutEnt, OutEx, OutUReg), stats(an,6), % Re-unravel the heads with the new modes (gives better selection): re_unr_strees(BStrees, CStrees), stats(an,7). analyze(Strees, Strees) :- warning(['There are no usable entry points, so no flow analysis was done.']). % ChgSet is the set of all predicates whose entry or exit modes have changed. analyze_closure([]) -->> !. analyze_closure(EntPreds) -->> cons(EntPreds), !, trav_preds(EntPreds):change([],ChgSet), {stats(an,'2_5')}, {length(ChgSet, N)}, {comment(['Analysis pass--changed ',N,' entry and exit modes.'])}, new_preds(ChgSet):change([],NewPreds), analyze_closure(NewPreds). % Calculate from ChgSet the set of predicates that need further traversal: % (This predicate also used in convert_uninit_strees) new_preds([]) -->> !. new_preds([entry(NaAr)|ChgSet]) -->> !, [add(NaAr)]:change, new_preds(ChgSet). new_preds([exit(NaAr)|ChgSet]) -->> [fget(NaAr,Occurs)]:occurs, !, [add_set(Occurs)]:change, new_preds(ChgSet). new_preds([_|ChgSet]) -->> new_preds(ChgSet). % Top level call: Traverse predicates & update exit mode for each predicate: % Only traverse a predicate if all arguments of its Entry are not bottom % (in the contrary case, it is unreachable). trav_preds([]) -->> !. trav_preds([NaAr|Preds]) -->> [fget(NaAr,Entry)]:entry, {no_bottom(NaAr,Entry)}, [fget(NaAr,Def)]:defs, !, {copy(Def,(Head:-Disj))}, {stats(trav_pred,NaAr)}, trav_pred(Disj, Head, Entry, NaAr), trav_preds(Preds). % The predicate is not defined here (it is probably a builtin): trav_preds([_|Preds]) -->> trav_preds(Preds). % Succeeds if Entry has no bottom arguments. no_bottom(_/Ar, Entry) :- bottom(B), no_bottom(Ar, Entry, B). no_bottom(0, _, _) :- !. no_bottom(I, Entry, B) :- I>0, arg(I, Entry, A), A\==B, I1 is I-1, no_bottom(I1, Entry, B). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Traversal of the call tree: % Traverse a single predicate & its subtree of the call tree: trav_pred(Disj, Head, Entry, NaAr) -->> new_sets(Head, Entry), OldDrf/rderef, OldGnd/gnd, trav_disj(Disj, Head, NaAr, 1, [], OutGnd, OutNon, OutDrf), [add_set(OutGnd)]:gnd, [add_set(OutNon)]:nonvar, {intersectv(OldDrf, OldGnd, D1)}, {unionv(D1, OutDrf, D)}, insert(_,OutDrf):rderef, update_exit(Head). % Give each choice the same gnd, rderef, sf, and uninit values. % Return the set of arguments ground at the output. trav_disj(fail, Head, _, _, _, All, All, All) -->> !, {varset(Head, All)}. % Don't redo an active clause: (unless current entry worse than stored?) trav_disj((Conj;Disj), Head, NaAr, Num, CallList, OutGnd, OutNon, OutDrf) -->> {member(caller(NaAr,Num), CallList)}, !, {Num1 is Num+1}, trav_disj(Disj, Head, NaAr, Num1, CallList, OutGnd, OutNon, OutDrf). trav_disj((Conj;Disj), Head, NaAr, Num, CallList, OutGnd, OutNon, OutDrf) -->> save_sets(X), {term_dupset(Conj, Dups)}, {stats(trav_conj,d(NaAr,Num))}, trav_conj(Conj, NaAr, Num, 1, [caller(NaAr,Num)|CallList]) :[uni(Unis,[]),dup(Dups)], back_propagate(Unis), NewGnd/gnd, NewNon/nonvar, NewDrf/rderef, restore_sets(X), {Num1 is Num+1}, trav_disj(Disj, Head, NaAr, Num1, CallList, NewGnd2, NewNon2, NewDrf2), {intersectv(NewGnd, NewGnd2, OutGnd)}, {intersectv(NewNon, NewNon2, OutNon)}, {intersectv(NewDrf, NewDrf2, OutDrf)}. % Back propagate gnd, rderef, and nonvar sets at end of clause to the head: % Do closure on the clause's unifications at the end of the clause % to find any additional arguments that exit as gnd or rderef terms. % This routine is not needed for correctness, but it improves results. back_propagate(Unis) -->> back_prop_d_cl(Unis), back_prop_g_cl(Unis), Gnd/gnd, [add_set(Gnd)]:nonvar, back_prop_n_cl(Unis). % Closure on rderef back propagation: back_prop_d_cl(InUnis) -->> back_prop_d(InUnis, MidUnis):count(0,N), back_prop_d_cl(N, MidUnis). back_prop_d_cl(0, _) -->> !. back_prop_d_cl(N, Unis) -->> {N>0}, !, back_prop_d_cl(Unis). back_prop_d([], []) -->> !. back_prop_d([unify(yes, X, Y, YVars)|InUnis], OutUnis) -->> Drf/rderef, {subsetv(YVars, Drf)}, !, [add(X)]:rderef, [1]:count, back_prop_d(InUnis, OutUnis). back_prop_d([unify(no, _, _, _)|InUnis], OutUnis) -->> !, back_prop_d(InUnis, OutUnis). back_prop_d([U|InUnis], [U|OutUnis]) -->> back_prop_d(InUnis, OutUnis). % Closure on gnd back propagation: back_prop_g_cl(InUnis) -->> back_prop_g(InUnis, MidUnis):count(0,N), back_prop_g_cl(N, MidUnis). back_prop_g_cl(0, _) -->> !. back_prop_g_cl(N, Unis) -->> {N>0}, !, back_prop_g_cl(Unis). back_prop_g([], []) -->> !. back_prop_g([unify(_, X, Y, YVars)|InUnis], OutUnis) -->> {nonvar(Y)}, Gnd/gnd, {subsetv(YVars, Gnd)}, !, [add(X)]:gnd, [1]:count, back_prop_g(InUnis, OutUnis). back_prop_g([unify(_, X, Y, YVars)|InUnis], OutUnis) -->> Gnd/gnd, {inv(X, Gnd)}, !, [add_set(YVars)]:gnd, [1]:count, back_prop_g(InUnis, OutUnis). back_prop_g([U|InUnis], [U|OutUnis]) -->> back_prop_g(InUnis, OutUnis). % Closure on nonvar back propagation: back_prop_n_cl(InUnis) -->> back_prop_n(InUnis, MidUnis):count(0,N), back_prop_n_cl(N, MidUnis). back_prop_n_cl(0, _) -->> !. back_prop_n_cl(N, Unis) -->> {N>0}, !, back_prop_n_cl(Unis). back_prop_n([], []) -->> !. back_prop_n([unify(_, X, Y, _)|InUnis], OutUnis) -->> {var(X), var(Y)}, Non/nonvar, {inv(Y, Non)}, !, [add(X)]:nonvar, [1]:count, back_prop_n(InUnis, OutUnis). back_prop_n([U|InUnis], [U|OutUnis]) -->> back_prop_n(InUnis, OutUnis). trav_conj(true, _, _, _, _) -->> !, % Any uninits remaining are initialized & thus become dereffed: Uni/uninit, [add_set(Uni)]:rderef. trav_conj((Goal,Conj), NaAr, I, J, CallList) -->> {varset(Goal, Vars)}, {stats(trav_goal,d(NaAr,I,J))}, trav_goal(Goal, NaAr, I, J, CallList, Vars), {J1 is J+1}, trav_conj(Conj, NaAr, I, J1, CallList). trav_goal(Goal, NaAr, I, J, CallList, Vars) -->> {call_p(Goal)}, !, trav_call(Goal, NaAr, I, J, CallList, Vars), [sub_set(Vars)]:uninit, [Vars]:sf. % Handling unify goals is done in three sections: % trav_goal_n and trav_non (which updates the nonvar set), % trav_goal_d and trav_drf1 & trav_drf2 (which updates the rderef set), and % trav_goal_u and trav_unif (which updates the uninit and gnd sets). % Each of these sections tries to get the best possible result. This % is implemented using backtracking to switch the unify arguments. trav_goal(A=B, _, _, _, _, Vars) -->> make_uni(A, B, _), make_uni(B, A, _), {term_dupset(A=B, Dups)}, trav_goal_d(A, B, Vars, Dups), trav_goal_u(A, B, Vars), Gnd/gnd, [add_set(Gnd)]:nonvar, trav_goal_n(A, B), % How do duplicate variables affect the Deref set? Not at all. % How do circular terms affect the Deref set? [sub_set(Dups)]:uninit, % Uni/uninit, [add_set(Uni)]:rderef, [Vars]:sf. % Collect the unify goals in unify/3 data structures: make_uni(X, Y, YVs) -->> {var(X)}, !, dref_prop_flag(X, Flag), {varset(Y, YVs)}, [unify(Flag, X, Y, YVs)]:uni. make_uni(X, Y, _) -->> []. % If (X is notin sf or X is uninit) and (X occurs only once in the body) % then we can propagate rderef exit modes to X in back_propagate: dref_prop_flag(X, no) -->> ConjDups/dup, {inv(X, ConjDups)}, !. dref_prop_flag(X, yes) -->> SF/sf, {\+inv(X,SF)}, !. dref_prop_flag(X, yes) -->> Uni/uninit, {inv(X,Uni)}, !. dref_prop_flag(_, no) -->> []. % 1. Backtracking between split_unify_v and trav_non: trav_goal_n(A, B) -->> {split_unify_v(A, B, X, T)}, trav_non(X, T), !. % Default case: trav_goal_n(_, _) -->> []. % Update the nonvar set: % This handles only the cases that are not taken care of in the gnd set. trav_non(X, T) -->> {nonvar(T)}, !, [add(X)]:nonvar. trav_non(X, T) -->> {var(T)}, Non/nonvar, {inv(T,Non)}, !, [add(X)]:nonvar. % 2. Backtracking between split_unify_v and trav_drf1 & trav_drf2: trav_goal_d(A, B, Vars, Dups) -->> {split_unify_v(A, B, X, T)}, {varset(T, TVars)}, trav_drf1(X, T, TVars, Vars), !. trav_goal_d(A, B, Vars, Dups) -->> {split_unify_v(A, B, X, T)}, {varset(T, TVars)}, trav_drf2(X, T, TVars, Vars, Dups), !. % Default case: trav_goal_d(A, B, Vars, Dups) -->> !, Gnd/gnd, intersectv(Gnd):rderef. % Traverse a unify goal to get new Deref set: % Try to find a successful clause in trav_drf1 before trav_drf2, because % trav_drf1 gives a more powerful result. % Relies on the fact that bindings always go from new variables to old. trav_drf1(X, T, TVars, Vars) -->> SF/sf, {\+inv(X, SF)}, !, new_dref(X, T, TVars), add_dref(TVars). trav_drf1(X, T, TVars, Vars) -->> Uni/uninit, {inv(X, Uni)}, !, new_dref(X, T, TVars), add_dref(TVars). trav_drf2(X, T, TVars, _, _) -->> Drf/rderef, {inv(X, Drf)}, Gnd/gnd, {inv(X, Gnd)}, !, add_dref(TVars). trav_drf2(X, T, TVars, _, Dups) -->> {Dups=[]}, Drf/rderef, {inv(X, Drf)}, SF/sf, {intersectv(SF, TVars, Old)}, Uni/uninit, {subsetv(Old, Uni)}, !, add_dref(TVars), [sub(X)]:rderef. % If X is new (uninit or notin sf) then add it to rderef % if one of two conditions is satisfied: % If (1) var(T) & it is rderef (i.e. (TVars n SF) c (Drf u Uni)), % or (2) nonvar(T) & ((TVars n SF) c (Drf n (Nonvar u Gnd))). % (1) No new memory locations are allocated since T is var: new_dref(X, T, TVars) -->> {var(T)}, SF/sf, {intersectv(TVars, SF, TSF)}, Drf/rderef, Uni/uninit, {unionv(Drf, Uni, DU)}, {subsetv(TSF, DU)}, !, [add(X)]:rderef. % (2) Since T is nonvar, its unification allocates memory. Putting % deref'ed objects in there adds an extra link unless the deref'ed object % is nonvariable (in which case no extra link is added!): new_dref(X, T, TVars) -->> {nonvar(T)}, SF/sf, {intersectv(TVars, SF, TSF)}, Non/nonvar, Gnd/gnd, {unionv(Non, Gnd, NG)}, Drf/rderef, {intersectv(Drf, NG, DNG)}, {subsetv(TSF, DNG)}, !, [add(X)]:rderef. new_dref(_, _, _) -->> []. % If (1) X is new (uninit or notin sf), or (2) X is ground and rderef, % or (3) X is rderef and (SF n TVars) c Uni and there are no duplicate % variables in {X} u TVars (because duplicate vars can create extra links), % then can add TVars-(SF-Uni) to rderef: add_dref(TVars) -->> SF/sf, Uni/uninit, {diffv(SF, Uni, ND)}, {diffv(TVars, ND, D)}, [add_set(D)]:rderef. % 3. Backtracking between split_unify_v and trav_unif: trav_goal_u(A, B, Vars) -->> {split_unify_v(A, B, X, T)}, {varset(T, TVars)}, trav_unif(X, T, TVars, Vars), !. % Default case: trav_goal_u(A, B, Vars) -->> [sub_set(Vars)]:uninit. % Traverse a unify goal to get new Gnd and Uni sets: % The manipulations done with the arguments of unify goals are the heart % of the analysis. The order of clauses in this predicate is important! % This predicate fails if no conditions are satisfied. % Important: if X=Term creates uninits, then X must not be used later in % the clause. This is checked here by making sure that X occurs only once. trav_unif(X, T, TVars, Vars) -->> Gnd/gnd, {subsetv(TVars, Gnd)}, !, [add(X)]:gnd, [sub(X)]:uninit. trav_unif(X, T, TVars, Vars) -->> Uni/uninit, {inv(X, Uni)}, ConjDups/dup, {\+inv(X, ConjDups)}, !, SF/sf, {diffv(Vars, SF, V1)}, [add_set(V1)]:uninit, [sub(X)]:uninit, {intersectv(Vars, SF, V3)}, [sub_set(V3)]:uninit. % Added Aug. 24, 1990: trav_unif(X, T, TVars, Vars) -->> SF/sf, {\+inv(X,SF)}, ConjDups/dup, {\+inv(X, ConjDups)}, !, {diffv(Vars, SF, V1)}, [add_set(V1)]:uninit, [sub(X)]:uninit, {intersectv(Vars, SF, V3)}, [sub_set(V3)]:uninit. trav_unif(X, T, TVars, Vars) -->> Gnd/gnd, {inv(X, Gnd)}, !, [add_set(Vars)]:gnd, [sub_set(Vars)]:uninit. % Traverse a non-unify goal: % 1. Goal has a definition: trav_call(Goal, _, _, _, CallList, Vars) -->> {functor(Goal, N, A)}, [fget(N/A,Def)]:defs, !, update_entry(Goal, NewEntry, Flag), trav_def(Goal, N/A, Def, CallList, NewEntry, Flag, Vars). % 2. Goal has no definition: % Find the most efficient entry point for Goal with the modal_entry tree. % Then update Gnd with the after modes of this entry. % After modes exist for builtins and if mode declarations were given, % even if no more efficient entry was found. % Note: update_entry in trav_goal is irrelevant for this clause. trav_call(Goal, NaAr, I, J, _, _) -->> spec_goal(NaAr, I, J, Goal, EGoal), {after(EGoal, After)}, % Update rderef set to be in accord with the builtin's exit mode: {bindset(EGoal, BS)}, G/gnd, {diffv(BS, G, ND)}, [sub_set(ND)]:rderef, {rderef_set(After, Drf)}, [add_set(Drf)]:rderef, % Update gnd set to be in accord with the builtin's exit mode: {ground_set(After, Gnd)}, [add_set(Gnd)]:gnd, % Update nonvar set to be in accord with the builtin's exit mode: {nonvar_set(After, Non)}, [add_set(Non)]:nonvar, update_exit(EGoal). % Traverse a goal that has a definition: % 1. Stored entry mode of Goal is equal or worse. % In this case, just update exit mode with no traversal. % This step needed to avoid having to traverse the whole call tree, which % has a worst-case size exponential in the program size. trav_def(Goal, N/A, _, CallList, Entry, no, Vars) -->> % {\+member(caller(N/A,_), CallList)}, !, [fget(N/A,Exit)]:exit, {get_argvars(rderef, Goal, Exit, ExitDrf)}, {get_argvars(ground, Goal, Exit, ExitGnd)}, {get_args(nonvar, Goal, Exit, ExitNon)}, new_drf_gnd(ExitDrf, ExitGnd, ExitNon, Vars). % 2. Stored entry mode of Goal is better or Goal is in the call list % & a definition exists: traverse to get new exit mode. trav_def(Goal, N/A, Def, CallList, Entry, Flag, Vars) -->> {copy(Def,(Head:-Disj))}, % 1. Set up correct state for the call: save_sets(X), new_sets(Head, Entry), % 2. Do the call: {stats(trav_disj,N/A)}, trav_disj(Disj, Head, N/A, 1, CallList, OutGndH, OutNonH, OutDrfH), % 3. Restore state of caller: restore_sets(X), % 4. Calculate new exit mode: {map_argvars(Head, OutDrfH, Goal, OutDrfG)}, {map_argvars(Head, OutGndH, Goal, OutGndG)}, {map_args(Head, OutNonH, Goal, OutNonG)}, new_drf_gnd(OutDrfG, OutGndG, OutNonG, Vars), update_exit(Goal). % Calculate new rderef & gnd sets from the exit sets of a predicate: % New rderef set = (Drf n Gnd) u (ExitDrf n (Uni u Drf u (Vars-SF))) % New gnd set = (Gnd u ExitGnd) % New nonvar set = (Non u ExitNon) new_drf_gnd(ExitDrf, ExitGnd, ExitNon, Vars) -->> new_drf_set(ExitDrf, Vars), [add_set(ExitGnd)]:gnd, [add_set(ExitNon)]:nonvar. new_drf_set([], _) -->> !, Gnd/gnd, intersectv(Gnd):rderef. new_drf_set(ExitDrf, Vars) -->> cons(ExitDrf), !, insert(Drf,NewDrf):rderef, Gnd/gnd, Uni/uninit, SF/sf, {unionv(Uni, Drf, D1)}, {diffv(Vars, SF, NV)}, {unionv(NV, D1, D2)}, {intersectv(ExitDrf, D2, D3)}, {intersectv(Gnd, Drf, D4)}, {unionv(D3, D4, NewDrf)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % *** Support for specialized entries: % The call to a goal is replaced by the most specific entry possible, % depending on its input mode. This is useful to speed up builtins, % although it can be used for any predicate that is in the modal_entry tree % (for example, this can be used to speed up any library). % It is implemented with the accumulator 'spec', which holds the most % specialized entry for each call that has a modal_entry. The index of spec % is index(NaAr,ClauseNum,GoalNum), which uniquely identifies each goal in % the program. % For later: better interaction between required/needed uninit mem/reg? % During analysis, replace Goal by the more specialized EGoal, % if that is possible: spec_goal(NaAr, ClNum, GNum, Goal, EGoal) -->> {modal_entry(Goal, _)}, !, {Index = index(NaAr,ClNum,GNum)}, [get(Index,Val)]:spec, functor(Goal, N, A), calc_entry(Goal, Entry), spec_goal2(Goal, N/A, Index, Val, Entry, EGoal). spec_goal(_, _, _, Goal, Goal) -->> []. % Get the previous specialization: spec_goal2(Goal, NA, Index, Val, Entry, EGoal) -->> {var(Val)}, !, {lattice_modes_entry(NA, Entry, Goal, F)}, {efficient_entry(Goal, EGoal, F)}, Val = value(Goal,Entry,EGoal). spec_goal2(Goal, NA, Index, Val, Entry, EGoal) -->> {nonvar(Val)}, !, {copy(Val, value(Goal,LEntry,LGoal))}, spec_update(Goal, NA, Index, LEntry, LGoal, Entry, EGoal). % Update the specialization & its entry lattice: spec_update(Goal, NA, Index, LEntry, LGoal, Entry, EGoal) -->> {LEntry\==Entry}, !, {lattice_modes_entry(NA, Entry, Goal, F)}, {efficient_entry(Goal, EGoal, F)}, [set(Index,value(Goal,Entry,EGoal))]:spec. spec_update(Goal, NA, Index, LEntry, LGoal, LEntry, LGoal) -->> []. % After analysis, convert all calls to their specialized equivalent: % (The traversal code is a bit tedious, it would be nice to have a preprocessor % here to do the traversing!) spec_strees([], [], _). spec_strees([S|Strees], [SS|SStrees], Spec) :- spec_stree(S, SS, Spec), spec_strees(Strees, SStrees, Spec). spec_stree(stree(NaAr,(Head:-Disj), M,OH, DL,SD), stree(NaAr,(Head:-SDisj),M,OH,SDL,SD), Spec) :- !, spec_disj(Disj, SDisj, NaAr, 1, Spec), spec_strees(DL, SDL, Spec). spec_stree(D, D, _) :- directive(D). spec_disj(fail, fail, _, _, _). spec_disj((Conj;Disj), (SConj;SDisj), NaAr, I, Spec) :- spec_conj(Conj, SConj, NaAr, I, 1, Spec), I1 is I+1, spec_disj(Disj, SDisj, NaAr, I1, Spec). spec_conj(true, true, _, _, _, _). spec_conj((Goal,Conj), (SGoal,SConj), NaAr, I, J, Spec) :- spec_goal(Goal, SGoal, NaAr, I, J, Spec), J1 is J+1, spec_conj(Conj, SConj, NaAr, I, J1, Spec). spec_goal(Goal, SGoal, NaAr, I, J, Spec) :- get(Spec, index(NaAr,I,J), Val), !, copy(Val, value(Goal,_,SGoal)). spec_goal(Goal, Goal, _, _, _, _). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % High-level utilities to calculate, propagate, and update modes: save_sets(state(G,N,U,D,S)) -->> G/gnd, N/nonvar, U/uninit, D/rderef, S/sf. restore_sets(state(G,N,U,D,S)) -->> insert(_,G):gnd, insert(_,N):nonvar, insert(_,U):uninit, insert(_,D):rderef, insert(_,S):sf. new_sets(Head, Entry) -->> insert(_,G):gnd, insert(_,N):nonvar, insert(_,U):uninit, insert(_,D):rderef, insert(_,S):sf, {get_argvars(ground, Head, Entry, G)}, {get_args(nonvar, Head, Entry, N)}, {get_argvars(uninit, Head, Entry, U)}, {get_argvars(rderef, Head, Entry, D)}, {varset(Head, S)}. % Map a set of variables between two goals: % Maps from each argument of G1 to all variables in G2's corresponding argument. map_argvars(G1, Set1, G2, Set2) :- functor(G1, Na, Ar), map_argvars(1, Ar, G1, Set1, G2, Bag2, []), sort(Bag2, Set2). map_argvars(I, Ar, G1, Set1, G2) --> {I= {I= {I>Ar}, !. % Map a set of variables between two goals: % Maps from G1's argument to G2's argument only if the latter is a variable. map_args(G1, Set1, G2, Set2) :- functor(G1, Na, Ar), map_args(1, Ar, G1, Set1, G2, Bag2, []), sort(Bag2, Set2). map_args(I, Ar, G1, Set1, G2) --> {I= {I= {I>Ar}, !. % Get the set of head arguments corresponding to the lattice value Type: % Maps from each arg. of Mode to all variables in Head's corresponding arg. get_argvars(Type, Head, Mode, TypeSet) :- functor(Head, Na, Ar), get_argvars(1, Ar, Type, Head, Mode, Bag, []), sort(Bag, TypeSet). get_argvars(I, Ar, T, Head, Mode) --> {I= {I= {I>Ar}, !. % Get the set of head arguments corresponding to the lattice value Type: % Maps from Mode's argument to Head's argument only if the latter is a variable. get_args(Type, Head, Mode, TypeSet) :- functor(Head, Na, Ar), get_args(1, Ar, Type, Head, Mode, Bag, []), sort(Bag, TypeSet). get_args(I, Ar, T, Head, Mode) --> {I= {I= {I>Ar}, !. % Update the entry mode & return the most general entry mode. % (Does NOT modify gnd or uninit sets) update_entry(Goal, NewEntry, Flag) -->> calc_entry(Goal, Entry), {functor(Goal, Na, Ar)}, [fget(Na/Ar,OldEntry)]:entry, {lub_call(OldEntry, Entry, NewEntry)}, update_entry(Na/Ar, OldEntry, NewEntry, Flag). update_entry(NaAr, OldEntry, NewEntry, yes) -->> {OldEntry\==NewEntry}, !, [set(NaAr,NewEntry)]:entry, [add(entry(NaAr))]:change. update_entry(_, _, _, no) -->> []. % Update the exit mode & return the most general exit mode. update_exit(Goal) -->> {functor(Goal, Na, Ar)}, [fget(Na/Ar,OldExit)]:exit, !, calc_exit(Goal, Exit), {lub_call(OldExit, Exit, NewExit)}, update_exit(Na/Ar, OldExit, NewExit). update_exit(_) -->> []. update_exit(NaAr, OldExit, NewExit) -->> {OldExit\==NewExit}, !, [set(NaAr,NewExit)]:exit, [add(exit(NaAr))]:change. update_exit(_, _, _) -->> []. % Calculate the exit mode corresponding to the current values of the sets: calc_exit(Goal, Exit) -->> {functor(Goal, Na, Ar)}, {functor(Exit, Na, Ar)}, Gnd/gnd, Non/nonvar, Drf/rderef, {calc_exit_2(1, Ar, Gnd, Non, Drf, Goal, Exit)}. calc_exit_2(I, Ar, _, _, _, _, _) :- I>Ar, !. calc_exit_2(I, Ar, Gnd, Non, Drf, Goal, Exit) :- I=> {term_dupset(Goal, Dups)}, Gnd/gnd, Non/nonvar, Uni/uninit, Drf/rderef, SF/sf, {functor(Goal, Na, Ar)}, {functor(Entry, Na, Ar)}, {calc_entry_2(1, Ar, Gnd, Non, Dups, Uni, Drf, SF, Goal, Entry)}. % Calculate the entry mode, given more information: % (Could recode this predicate to be much faster and use less memory by not % doing so much redundant work.) calc_entry_2(I, Ar, _, _, _, _, _, _, _, _) :- I>Ar, !. calc_entry_2(I, Ar, Gnd, Non, Dups, Uni, Drf, SF, Goal, Entry) :- I=Ar, !. lub_call(I, Ar, Call1, Call2, Lub) :- I=Ar, !. bottom_call(I, Ar, Bottom) :- I= {I>Ar}, !. lattice_modes_call(I, Ar, Value, Head, UT) --> {I= !, co(uninit(X)). lattice_modes_arg( uninit, T, X) --> !, co(uninit(T,X)). lattice_modes_arg( ground, _, X) --> !, co(ground(X)). lattice_modes_arg( rderef, _, X) --> !, co(rderef(X)). lattice_modes_arg( gnddrf, _, X) --> !, co(ground(X)), co(rderef(X)). lattice_modes_arg( nonvar, _, X) --> !, co(nonvar(X)). lattice_modes_arg( nondrf, _, X) --> !, co(nonvar(X)), co(rderef(X)). lattice_modes_arg(unknown, _, _) --> !, co(fail). lattice_modes_arg( any, _, _) --> []. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % General utilities: % Return a flag to show set membership: membership_flag(X, Set, yes) :- inv(X, Set), !. membership_flag(X, _, no). % Return a flag to show if an argument's variables are in the set: subset_flag(Vars, Set, yes) :- subsetv(Vars, Set), !. subset_flag(_, _, no). % Return a flat to show if an argument's variables are disjoint from the set: disjoint_flag(Vars, Set, yes) :- disjointv(Vars, Set), !. disjoint_flag(X, _, no). % Return a flag to show if an argument is a variable: var_flag(X, yes) :- var(X), !. var_flag(X, no) :- nonvar(X), !. % Calculate the set of head arguments that are variables: var_args(Goal, Set) :- Goal=..[_|RawBag], filter_vars(RawBag, Bag), sort(Bag, Set). % Calculate the set of variables in Goal that occur more than once: % Also calculate the set or bag of variables in Goal. % (Also used in clause_code.pl) term_dupset(Goal, DupSet) :- term_dupset_varbag(Goal, DupSet, _). term_dupset_varset(Goal, DupSet, VarSet) :- term_dupset_varbag(Goal, DupSet, VarBag), sort(VarBag, VarSet). term_dupset_varbag(Goal, DupSet, VarBag) :- varbag(Goal, VarBag), filter_dups(VarBag, DupSet). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%