% Aquarius Prolog compiler % Copyright (C) 1989-91 P. Van Roy and Regents of the University of California % All rights reserved. % Creation date Fri Sep 20 10:16:37 PDT 1991 % See /n/ps-dec3/local1/vanroy/Aquarius1.0.msg/AquaOld/Ralph.Article/FixPoint % :-mips. :-option(float). :-option(analyze). :-notoption(comment). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Entry point for extended DCG expansion: :- entry((term_expansion(_,_) :- true)). % Entry points for correct dataflow analysis: :- entry((op_table(_,_,_) :- true)). :- entry((range(_,_,_) :- true)). :- entry((test_arg(_,_) :- true)). :- entry((a_head(_,_) :- true)). :- entry((valid_testset(_,_,_,_,_,_,_,_,_,_) :- true)). :- entry((entry_data(_) :- true)). % Operator declarations: :- op(1200, xfx, ['-->>']). % Same as ':-'. :- op( 850, xfx, [':']). % Slightly tighter than ',' and '\+'. :- op( 700, xfx, ['\=']). :- op( 500, yfx, [and,or,xor]). :- op(1150, fx, [(init_directive)]). % Same op declaration as 'dynamic'. % The dynamic predicates: (needed for Quintus only) :- dynamic(compile_cputime/3). % See stats in 'utility'. :- dynamic(gensym_integer/1). % See gensym in 'utility'. :- dynamic(include_stack/1). :- dynamic(compile_option/1). :- dynamic(mode_option/5). :- dynamic(modal_entry/2). :- dynamic(save_clause/2). % For piped compiler. :- dynamic(macro/6). :- dynamic(select_option/2). % For evaluation of determinism selection. :- dynamic(dyn_pred/1). % Set of declared dynamic predicates. :- dynamic(init_clause/1). % Set of clauses to be executed during init. :- dynamic((init_directive)/1). % Directive that is allowed during init. :- dynamic(global_copy/1). % Top level loop: main :- adefault, pipe. 'C'(A,B,C) :- A=[B|C]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% term_expansion((A-->>B),(C:-D)) :- functor(A,E,F), '_has_hidden'(A,G), '_new_goal'(A,G,H,C), '_create_acc_pass'(G,H,C,I,J), '_flat_conj'(B,K), '_expand_body'(K,L,E/F,G,I,J), '_flat_conj'(L,D), !. library_directory('/hprg/q2.0/library'). library_directory('/hprg/q2.0/tools'). library_directory('/hprg/q2.0/IPC'). copyright(1,'Aquarius Prolog compiler'). copyright(2,'Copyright (C) 1989-91 P. Van Roy and Regents of the University of California'). copyright(3,'All rights reserved.'). compiler_version('Fri Sep 20 10:16:37 PDT 1991'). '_has_hidden'(A,B) :- functor(A,C,D), pred_info(C,D,B). '_has_hidden'(A,[]) :- functor(A,B,C), \+pred_info(B,C,D). '_new_goal'(A,B,C,D) :- functor(A,E,C), '_number_args'(B,C,F), functor(D,E,F), '_match'(1,C,A,D). '_create_acc_pass'([],A,B,[],[]). '_create_acc_pass'([A|B],C,D,[acc(A,E,F)|G],H) :- '_is_acc'(A), !, I is C+1, arg(I,D,E), J is C+2, arg(J,D,F), '_create_acc_pass'(B,J,D,G,H). '_create_acc_pass'([A|B],C,D,E,[pass(A,F)|G]) :- '_is_pass'(A), !, H is C+1, arg(H,D,F), '_create_acc_pass'(B,H,D,E,G). '_create_acc_pass'([A|B],C,D,E,F) :- \+'_is_acc'(A), \+'_is_pass'(A), write('*** Error: '), write(A), write(' is not a hidden parameter.'), nl. '_flat_conj'(A,B) :- '_flat_conj'(A,B,true). '_expand_body'(true,true,A,B,C,D) :- '_finish_acc'(C). '_expand_body'((A ',' B),(C ',' D),E,F,G,H) :- '_expand_goal'(A,C,E,F,G,I,H), '_expand_body'(B,D,E,F,I,H). '_finish_acc'([]). '_finish_acc'([acc(A,B,B)|C]) :- '_finish_acc'(C). '_expand_goal'({A},A,B,C,D,D,E) :- !. '_expand_goal'(insert(A,B),C=A,D,E,F,G,H) :- '_replace_acc'(dcg,C,I,B,I,F,G), !. '_expand_goal'(insert(A,B):C,D=A,E,F,G,H,I) :- '_replace_acc'(C,D,J,B,J,G,H), !. '_expand_goal'(A:B,C,D,E,F,G,H) :- \+'_list'(A), '_has_hidden'(A,[]), !, '_make_list'(B,I), '_new_goal'(A,I,J,C), '_use_acc_pass'(I,J,C,F,G,H). '_expand_goal'(A:B,C,D,E,F,G,H) :- \+'_list'(A), '_has_hidden'(A,I), I\==[], !, '_make_list'(B,J), '_new_goal'(A,I,K,C), '_replace_defaults'(I,L,J), '_use_acc_pass'(L,K,C,F,G,H). '_expand_goal'(A:B,C,D,E,F,G,H) :- '_list'(A), !, '_joiner'(A,B,D,C,F,G). '_expand_goal'(A,B,C,D,E,F,G) :- '_list'(A), !, '_joiner'(A,dcg,C,B,E,F). '_expand_goal'(A/B,true,C,D,E,E,F) :- var(A), nonvar(B), '_member'(acc(B,A,G),E), !. '_expand_goal'(A/B,true,C,D,E,E,F) :- var(A), nonvar(B), '_member'(pass(B,A),F), !. '_expand_goal'(A/B,true,C,D,E,E,F) :- var(B), nonvar(A), '_member'(acc(A,G,B),E), !. '_expand_goal'(A/B/C,true,D,E,F,F,G) :- var(A), var(C), nonvar(B), '_member'(acc(B,A,C),F), !. '_expand_goal'(A/B,true,C,D,E,E,F) :- write('*** Warning: in '), write(C), write(' the term '), write(A/B), write(' uses a non-existent hidden parameter.'), nl. '_expand_goal'(A,B,C,D,E,F,G) :- '_has_hidden'(A,H), !, '_new_goal'(A,H,I,B), '_use_acc_pass'(H,I,B,E,F,G). '_replace_acc'(A,B,C,D,E,F,G) :- '_member'(acc(A,B,C),F), !, '_replace'(acc(A,H,I),acc(A,D,E),F,G). '_list'(A) :- nonvar(A), A=[B|C], !. '_list'(A) :- A==[], !. '_make_list'(A,[A]) :- \+'_list'(A), !. '_make_list'(A,A) :- '_list'(A), !. '_use_acc_pass'([],A,B,C,C,D). '_use_acc_pass'([A|B],C,D,E,F,G) :- '_replace_acc'(A,H,I,J,I,E,K), !, L is C+1, arg(L,D,H), M is C+2, arg(M,D,J), '_use_acc_pass'(B,M,D,K,F,G). '_use_acc_pass'([A|B],C,D,E,F,G) :- '_acc_info'(A,H,I), !, J is C+1, arg(J,D,H), K is C+2, arg(K,D,I), '_use_acc_pass'(B,K,D,E,F,G). '_use_acc_pass'([A|B],C,D,E,F,G) :- '_is_pass'(A), '_member'(pass(A,H),G), !, I is C+1, arg(I,D,H), '_use_acc_pass'(B,I,D,E,F,G). '_use_acc_pass'([A|B],C,D,E,F,G) :- '_pass_info'(A,H), !, I is C+1, arg(I,D,H), '_use_acc_pass'(B,I,D,E,F,G). '_use_acc_pass'([A|B],C,D,E,E,F) :- write('*** Error: the hidden parameter '), write(A), write(' does not exist.'), nl. '_replace_defaults'([],[],A). '_replace_defaults'([A|B],[C|D],E) :- '_replace_default'(A,C,E), '_replace_defaults'(B,D,E). '_joiner'([],A,B,true,C,C). '_joiner'([A|B],C,D,(E ',' F),G,H) :- '_replace_acc'(C,I,J,K,J,G,L), '_acc_info'(C,A,I,K,E,M,N), !, '_joiner'(B,C,D,F,L,H). '_joiner'([A|B],C,D,E,F,G) :- write('*** Warning: in '), write(D), write(' the accumulator '), write(C), write(' does not exist.'), nl, '_joiner'(B,C,D,E,F,G). '_member'(A,[A|B]). '_member'(A,[B|C]) :- '_member'(A,C). '_is_acc'(A) :- atomic(A), !, '_acc_info'(A,B,C,D,E,F,G). '_is_acc'(A) :- functor(A,B,2), !, '_acc_info'(B,C,D,E,F,G,H). '_is_pass'(A) :- atomic(A), !, '_pass_info'(A,B). '_is_pass'(A) :- functor(A,B,1), !, '_pass_info'(B,C). '_acc_info'(A,B,C) :- functor(A,D,2), '_is_acc'(D), !, arg(1,A,B), arg(2,A,C). '_acc_info'(A,B,C) :- '_acc_info'(A,D,E,F,G,B,C). '_pass_info'(A,B) :- functor(A,C,1), '_is_pass'(C), !, arg(1,A,B). '_pass_info'(A,B) :- pass_info(A,B). '_pass_info'(A,B) :- pass_info(A). '_replace'(A,B,[],[]). '_replace'(A,B,[A|C],[B|D]) :- !, '_replace'(A,B,C,D). '_replace'(A,B,[C|D],[C|E]) :- \+C=A, !, '_replace'(A,B,D,E). '_number_args'([],A,A). '_number_args'([A|B],C,D) :- '_is_acc'(A), !, E is C+2, '_number_args'(B,E,D). '_number_args'([A|B],C,D) :- '_is_pass'(A), !, E is C+1, '_number_args'(B,E,D). '_match'(A,B,C,D) :- A>B, !. '_match'(A,B,C,D) :- A= C=[E|G], read_clauses(A,B,G,D) ; C=D, B=E ), !. split(A,B,C) :- ( A= (B:-C) -> true ; A=B, C=true ). warning(A) :- make_msg(A,B), w, msg_list(B,w). add_mode_option((mode true)) :- !. add_mode_option((mode (A:-B))) :- check_non_builtin(A), !, my_retractall(mode_option(A,C,D,E,F)), make_req_bef(B,G,H), keep_uninit(A,G,I), asserta(mode_option(A,I,H,true,n)). add_mode_option((mode A)). add_mode_option(analyze_mode(A,B,C,D)) :- check_non_builtin(A), !, survive(A,E), my_retractall(mode_option(A,F,G,H,I)), keep_uninit(A,B,J), keep_uninit(A,C,K), translate(J,L), flat_conj(L,M), logical_simplify(M,N), translate(K,O), flat_conj(O,P), logical_simplify(P,Q), translate(D,R), flat_conj(R,S), logical_simplify(S,T), asserta(mode_option(A,N,Q,T,E)). add_mode_option(analyze_mode(A,B,C,D)). add_mode_option(dummy_mode(A,B,C)) :- check_non_builtin(A), !, survive(A,D), after(A,E), my_retractall(mode_option(A,F,G,H,I)), keep_uninit(A,B,J), split_deref(J,K,L), keep_uninit(A,C,M), translate(L,N), flat_conj(N,O), logical_simplify(O,P), translate((K ',' M),Q), flat_conj(Q,R), logical_simplify(R,S), asserta(mode_option(A,P,S,E,D)). add_mode_option(dummy_mode(A,B,C)). add_mode_option(mode(A,B,C,D,E)) :- check_non_builtin(A), !, my_retractall(mode_option(A,F,G,H,I)), check_req_bef(B,C,J,K,A), keep_uninit(A,J,L), translate(L,M), logical_simplify(M,N), keep_uninit(A,K,O), translate(O,P), logical_simplify(P,Q), translate(D,R), logical_simplify(R,S), asserta(mode_option(A,N,Q,S,E)). add_mode_option(mode(A,B,C,D,E)). add_entry_option(entry(A,B,C,D,E)) :- add_mode_option(mode(A,B,C,D,E)), nox(entry(A,F)), translate((B ',' C),G), flat_conj(G,H), logical_simplify(H,I), asserta(compile_option(entry(A,I))). add_entry_option(entry((A:-B))) :- add_mode_option((mode (A:-B))), nox(entry(A,C)), translate(B,D), flat_conj(D,E), logical_simplify(E,F), asserta(compile_option(entry(A,F))). add_entry_option(entry(A/B)) :- atom(A), nonnegative(B), functor(C,A,B), add_mode_option((mode (C:-true))), nox(entry(C,D)), asserta(compile_option(entry(C,true))). add_modal_entry(modal_entry(A,B)) :- check_modal_entry(A,B), !, my_retractall(modal_entry(A,C)), asserta(modal_entry(A,B)). add_modal_entry(modal_entry(A,B)). add_macro_def(macro((A:-B))) :- check_macro_def(A), !, my_retractall(macro(A,C,D,E,F,G)), conjlist(B,H,[]), remove_double_indirect(A,I,J,H), varset(J,K), difflist(J,L,M), macro_varlist(J,N,O), asserta(macro(I,L,M,N,O,K)). add_macro_def(macro(A)). handle_dir(vlsi_bam,[]) :- vlsi_bam. handle_dir(mips,[]) :- mips_options. handle_dir(sparc,[]) :- sparc_options. handle_dir(mc68020,[]) :- mc68020_options. handle_dir(version,[]) :- print_version. handle_dir(help,[]) :- print_help. handle_dir(helpoptions,[]) :- print_helpoptions. handle_dir(options,[]) :- po. handle_dir(option,A) :- cox_list(A). handle_dir(notoption,A) :- nox_list(A). handle_dir(include,[A]) :- atom(A), seeing(B), push_incl_stack(B), see(A). handle_dir(op,[A,B,C]) :- op(A,B,C). handle_dir(prolog_flag,[A,B,C]) :- ( A=character_escapes -> copy([B,C],[D,E]), prolog_flag(A,D,E) ; true ). handle_dir((dynamic),[A]) :- check_spec_list(A), dynamic_list(A). handle_dir((init_directive),[A]) :- check_spec_list(A), init_dir_list(A). handle_dir(o,A) :- cox_list(A). handle_dir(no,A) :- nox_list(A). handle_dir(ex,[A]) :- ground(A), ex(A). vlsi_bam :- compile_option(system(cprolog)), !, cdefault. vlsi_bam :- compile_option(system(quintus)), !, qdefault. vlsi_bam :- compile_option(system(aquarius)), !, adefault. mips_options :- comment(['Compiling for the MIPS processor']), vlsi_bam, cox_list([mips,arithmetic_error_check,align(1)]), nox_list([split_integer]). sparc_options :- comment(['Compiling for the SPARC processor']), vlsi_bam, cox_list([sparc,arithmetic_error_check,align(2)]), nox_list([split_integer]). mc68020_options :- comment(['Compiling for the MC68020 processor']), vlsi_bam, cox_list([mc68020,arithmetic_error_check,align(1)]), nox_list([split_integer]). print_help :- nl, wn('% List of useful directives:'), wn('% option(OptList) Enable the listed options.'), wn('% notoption(OptList) Disable the listed options.'), wn('% options Print the current options.'), wn('% helpoptions Give information about the possible options.'), wn('% op(A,B,C) Operator declaration.'), wn('% prolog_flag(F,Old,New) Modify execution parameters of the system.'), wn('% dynamic(Name/Arity) Declare a dynamic predicate.'), wn('% mode((Head:-Formula)) Mode information for a predicate.'), wn('% entry((Head:-Formula)) As above and also used for flow analysis.'), wn('% mode(H,R,B,A,S) More detailed mode declaration.'), wn('% entry(H,R,B,A,S) More detailed entry declaration.'), wn('% macro((Head:-BAMCode)) Define a predicate as BAM assembly code.'), wn('% include(F) Insert the contents of file F.'), wn('% version Print the creation date of this version.'), wn('% Directives normally only used by the system:'), wn('% mips Set options for the MIPS.'), wn('% sparc Set options for the SPARC.'), wn('% mc68020 Set options for the MC68020.'), wn('% vlsi_bam Set options for the VLSI-BAM.'), wn('% modal_entry(H,Tree) Discrimination tree for efficient builtins.'), nl. print_helpoptions :- nl, wn('% List of useful options (default in parentheses):'), wn('% float (off) Enable use of floating point.'), wn('% analyze (off) Perform flow analysis on the input program.'), wn('% factor (on) Perform factoring transformation.'), wn('% compile (on) Compile the input program.'), wn('% arithmetic_error_check (on)'), wn('% Perform type checking on arithmetic operations.'), wn('% same_number_solutions (on)'), wn('% Keep the same number of solutions as standard Prolog.'), wn('% same_order_solutions (on)'), wn('% Keep the same order of solutions as standard Prolog.'), nl. po :- pox(A), write('% Options = '), write(A), nl, pmodes, !. cox_list([]) :- !. cox_list([A|B]) :- !, cox_list(A), cox_list(B). cox_list(A) :- \+list(A), !, cox(A). nox_list([]) :- !. nox_list([A|B]) :- !, nox_list(A), nox_list(B). nox_list(A) :- \+list(A), !, nox(A). push_incl_stack(A) :- include_stack(B), my_retractall(include_stack(C)), D=[A|B], asserta(include_stack(D)), ( length(D,E), compile_option(include_limit(F)), E>F -> warning(['The inclusion stack ',D,nl,'has exceeded the limit of ',F,' nested includes.']) ; true ). copy(A,B) :- copyB(A,B). check_spec_list((A ',' B)) :- check_spec_list(A), check_spec_list(B). check_spec_list(A/B) :- atom(A), integer(B), B>=0. dynamic_list((A ',' B)) :- dynamic_list(A), dynamic_list(B). dynamic_list(A/B) :- functor(C,A,B), assert(dyn_pred(C)). init_dir_list((A ',' B)) :- init_dir_list(A), init_dir_list(B). init_dir_list(A/B) :- functor(C,A,B), assert((init_directive C)). % PVR -- already a built-in. % ground(A) :- % nonvar(A), % functor(A,B,C), % ground(C,A). ex(A) :- ex(A,B,C), !, comp(B,C). after_collect(options,[]). after_collect(option,A) :- \+do_it_now(A). after_collect(o,A) :- \+do_it_now(A). after_collect(notoption,A) :- \+do_it_now(A). after_collect(no,A) :- \+do_it_now(A). do_it_now(A) :- now_list(B), member(C,B), member(C,A). do_it_now([A]) :- now_list(B), member(C,B), member(C,A). now_list([arithmetic_error_check,stats(A),analyze,analyze_uninit_reg,compile,comment,uni,float,factor,test,test_unify,test_arith,test_typecheck,firstarg]). member(A,[A|B]). member(A,[B|C]) :- member(A,C). comment(A) :- true. % compile_option(comment), % !, % make_msg(A,B), % cm, % msg_list(B,cm). % comment(A) :- % \+compile_option(comment), % !. print_copyright :- copyright(A,B), w('% '), wn(B), fail. print_copyright. print_date :- compiler_version(A), !, w('% Creation date '), wn(A). print_date. my_retractall(A) :- copy(A,B), retract(B), !, my_retractall(A). my_retractall(A). cf(A,B) :- cf(A,B,[]). cf(A,B,C) :- tell(A), comp(B,C), !, told. cf(A,B,C) :- told. comp(A,B) :- make_list(B,C), comp(A,C,D), write_source(A,C), write_code(D). comp(A) :- comp(A,[]). make_list(A,[A]) :- \+list(A), !. make_list(A,A) :- list(A), !. comp(A,B,C) :- clr_mode, add_mode_options(B), internal_comp(A,C). write_source(A,B) :- \+compile_option(source), !. write_source(A,B) :- compile_option(source), inst_vars(B,C), xwrite_modes(C), inst_vars(A,D), xwrite_source(D). write_code([]) :- !. write_code(A) :- \+compile_option(write), !. write_code(A) :- compile_option(write), \+compile_option(flat), !, write_code(A,4). write_code(A) :- compile_option(write), compile_option(flat), !, write_output(A). clr_mode :- my_retractall(mode_option(A,B,C,D,E)). add_mode_options([]) :- !. add_mode_options([(A:-B)|C]) :- !, add_mode_option((mode (A:-B))), add_mode_options(C). add_mode_options([true|A]) :- !, add_mode_options(A). add_mode_options([A|B]) :- add_mode_option(A), add_mode_options(B). internal_comp(A,B) :- internal_comp(nowrite,A,B). ex(pa,[p(a)],(p(A):-uninit(A))). ex(1,[(a(A):-A<1 ',' b(A,A))],true). ex(2,[(a(A):-A@<[B]',' b(A))],true). ex(up,[(p([A|B],C,[A|D],E):-C>=A ',' p(B,C,D,E)),(p([A|B],C,D,[A|E]):-C K=[], write_code(J), F=G ; F=J, G=K ). q_inst_writeq(A) :- compile_option(system(quintus)), !, copy(A,B), numbervars(B,0,C), writeq(B). q_inst_writeq(A) :- compile_option(system(aquarius)), !, copy(A,B), numbervars(B,0,C), writeq(B). q_inst_writeq(A) :- inst_writeq(A). compile_stree(A,B,C,D,E) :- compile_option(compile), builtin_recompile_error(A), !, calc_select_depth(A), % stats(c,1), trim_stree(A,F), % stats(c,2), select_stree(F,G,H), G=stree(I,(J:-K),L,M,N,O), % stats(c,3), segment_disj(J,K,P,L,Q,H), % stats(c,4), selection_disj(J,P,L,R), % stats(c,5), proc_header(D,I,S,T), proc_code(J,R,L,N,C,T,U), % stats(c,6), clause_code_list(Q,N,U,V), end_label(C,V,[]), % stats(c,7), peephole(I,S,E,B), % stats(c,8), !. compile_stree(A,B,C,D,[]). lbl_sets(A,B) :- lbl_sets(A,B,C). map_external_lbls(A,B,C,D) :- map_external_lbls(A,B,E,C,D). compile_stree(A,B,C,D,E,F) :- compile_stree(A,B,C,D,G), difflist(G,E,F). difflist([],A,A). difflist([A|B],C,D) :- 'C'(C,A,E), difflist(B,E,D). builtin_recompile_error(stree(A/B,C,D,E,F,G)) :- compile_option(protect_builtins), functor(H,A,B), builtin(H), !, warning(['The predicate ',A/B,' is a builtin. It is not compiled.']), fail. builtin_recompile_error(A). calc_select_depth(stree(A,B,C,D,E,F)) :- var(F), !, select_limit(F). calc_select_depth(stree(A,B,C,D,E,F)) :- nonvar(F). trim_stree(stree(A,B,C,D,E,F),stree(A,B,G,D,E,F)) :- trim_mode(C,G). select_stree(A,B,C) :- A=stree(D/E,(F:-G),(F:-H),I,J,K), K>0, E>0, length_disj(G,L), L>1, segment_all_disj(G,F,H,M,C,N), not_nonvar(N,H,O,P), select_limit(Q), ( P% compile_option(debug) -> write_code(B), nl ; true ), write_debug('After peephole optimization:'). builtin(A) :- info(A,B,C,y,D), !. trim_mode((A:-B),(A:-C)) :- keep_uninit(A,B,C). length_disj(A,B) :- length_disj(A,0,B). segment_all_disj(A,B,C,D,E,F) :- varset(B,G), unbound_set(C,H), segment_all_disj(A,B,G,H,D,I,[],E), sort(I,J), intersectv(J,G,F). not_nonvar(A,B,C,D) :- not_nonvar(A,B,C,0,D). inv(A,[B|C]) :- compare(D,A,B), inv_2(D,A,C). range_option(A,B,C) :- fail, % compile_option(firstarg), !, B=1. range_option(A,B,C) :- range(A,B,C). memberv(A,[B|C]) :- ( A==B -> true ; memberv(A,C) ). subsume(true,A,B) :- !, simplify(A,B). subsume(A,B,C) :- sub(A,B,D,prolog,E), simplify(D,C). standard_disj(A,B) :- disj(A,B,fail). new_head(A,B,C,D) :- functor(B,E,F), B=..[E|G], append(G,C,H), gensym(A,E/F,I), D=..[I|H]. after(A,B) :- info(A,C,D,E,F,G,H,I), !, logical_simplify(I,B). after(A,B) :- \+info(A), test(A), !, logical_simplify(A,B). after(A,true) :- \+info(A), \+test(A), !. combine_formula(A,B,C) :- unionv_conj(A,B,C). add_mode_option(A,B,C,D,E) :- mode_option(A,F,G,H,I), !, split_deref(F,J,K), split_deref(C,L,M), flat_conj((M ',' K),N), flat_conj((L ',' J ',' D ',' G),O), make_after(E,H,P), add_mode_option(mode(B,N,O,P,I)). add_mode_option(A,B,C,D,E) :- split_deref(C,F,G), flat_conj((F ',' D),H), add_mode_option(mode(B,G,H,true,n)). not_nonvar([],A,[],B,B). not_nonvar([A|B],C,D,E,F) :- implies(C,nonvar(A)), !, G is E+1, not_nonvar(B,C,D,G,F). not_nonvar([A|B],C,[A|D],E,F) :- not_nonvar(B,C,D,E,F). implies(A,B) :- logical_simplify(not(B),C), mutex(A,C,left), !. range(A,A,B). range(A,B,C) :- AB),(C->D)) :- !, translate(A,C), translate(B,D). translate(not(A),not(B)) :- !, translate(A,B). translate(\+A,\+B) :- !, translate(A,B). translate(false,fail) :- !. translate(otherwise,true) :- !. translate(A,'$ call_dynamic'(A)) :- dyn_pred(A), !. translate(A,A). flat_conj(A,B) :- flat_conj(A,B,true). logical_simplify(A,B) :- simp_upv(A,B,logical), !. nonnegative(A) :- integer(A), A>=0. clr_entry :- my_retractall(compile_option(entry(A,B))). check_non_builtin(A) :- nonvar(A), functor(A,B,C), check_nb(A,['Attempt to give modes for builtin ',B/C,' is ignored.']). make_req_bef(A,B,C) :- translate(A,D), flat_conj(D,E), split_uninit_deref(E,F,G), logical_simplify(F,B), logical_simplify(G,C). keep_uninit(A,B,C) :- varbag(A,D), keep_uninit(D,B,E,true), squeeze_conj(E,C). survive(A,y) :- survive(A), !. survive(A,n) :- \+survive(A), !. split_deref((A ',' B),(C ',' D),(E ',' F)) :- !, split_deref(A,C,E), split_deref(B,D,F). split_deref(deref(A),deref(A),true) :- !. split_deref(rderef(A),rderef(A),true) :- !. split_deref(A,true,A). check_req_bef(A,B,C,D,E) :- split_uninit_deref(A,C,F), squeeze_conj(F,G), warning_req(G,E), squeeze_conj((G ',' B),D). split_uninit_deref((A ',' B),(C ',' D),(E ',' F)) :- !, split_uninit_deref(A,C,E), split_uninit_deref(B,D,F). split_uninit_deref(deref(A),deref(A),true) :- !. split_uninit_deref(A,A,true) :- an_uninit_mode(A), !. split_uninit_deref(A,true,A). squeeze_conj((A ',' B),C) :- \+all_true(B), !, squeeze_conj(B,D), flat_conj(A,C,D). squeeze_conj((A ',' B),C) :- \+all_true(A), !, squeeze_conj(A,D), flat_conj(B,C,D). squeeze_conj(A,true) :- all_true(A), !. squeeze_conj(A,A). warning_req(true,A) :- !. warning_req(A,B) :- functor(B,C,D), warning(['Illegal Require modes converted to Before in ',C/D,'.',nl,'Require modes can only be uninit(X), uninit_reg(X) or deref(X).']). make_after(yes,A,A). make_after(no,A,true). check_nb(A,B) :- builtin(A), !, warning(B), fail. check_nb(A,B). o(A) :- nonvar(A), cox(A,B), po, !. cox(A,true) :- atomic(A), compile_option(A), !. cox(A,B) :- functor(A,C,D), functor(E,C,D), nox(E,B), !, ox(A,F). cox(A,B) :- ox(A). no(A) :- nonvar(A), nox(A,B), po, !. nox(A,true) :- copy(A,B), compile_option(B), !, pragma_no_write_once(A), my_retractall(compile_option(A)). nox(A,false) :- \+compile_option(A). co(A) :- nonvar(A), cox(A,true), po, !. pox(A) :- setof(B,compile_option(B),A). pmodes :- mode_option(A,B,C,D,E), w('% '), inst_writeq(mode(A,B,C,D,E)), nl, fail. pmodes :- modal_entry(A,B), w('% '), inst_writeq(modal_entry(A,B)), nl, fail. pmodes. inst_writeq(A) :- copy(A,B), varset(B,C), inst_vars_names_list(0,C,D), inst_writeq(B,C,D). ox(A) :- ox(A,B). ox(A,true) :- compile_option(A), !. ox(A,false) :- \+compile_option(A), pragma_write_once(A), asserta(compile_option(A)). list(A) :- ( nil(A) ; cons(A) ). cox(A) :- cox(A,true). cdefault :- qdefault, cox(system(cprolog)). qdefault :- my_retractall(compile_option(A)), my_retractall(mode_option(B,C,D,E,F)), my_retractall(modal_entry(G,H)), default_option(I), asserta(compile_option(I)), fail. qdefault. adefault :- qdefault, cox(system(aquarius)). interactive_default(cprolog) :- cdefault, nox(flat), po. interactive_default(quintus) :- qdefault, nox(flat), po. interactive_default(aquarius) :- adefault, nox(flat), po. check_macro_def(A) :- nonvar(A), functor(A,B,C), check_nb(A,['Attempt to give macro definition for builtin ',B/C,' is ignored.']). conjlist((A ',' B),C,D) :- !, conjlist(A,C,E), conjlist(B,E,D). conjlist(A,B,C) :- 'C'(B,A,C). remove_double_indirect(A,B,C,D) :- functor(A,E,F), functor(B,E,F), require(A,G), uninit_set_type(reg,G,H), match_heads(1,F,A,B,H,C,D). varset(A,B) :- varbag(A,C), sort(C,B). macro_varlist([move(A,B)|C],D,E) :- var(A), var(B), !, 'C'(D,pref,F), 'C'(F,A,G), 'C'(G,B,H), macro_varlist(C,H,E). macro_varlist([label(A)|B],C,D) :- !, macro_varlist(B,C,D). macro_varlist([A|B],C,D) :- branch(A,E), !, varbag(A,F), diffbag(F,E,G), difflist(G,C,H), macro_varlist(B,H,D). macro_varlist([A|B],C,D) :- varbag(A,C,E), macro_varlist(B,E,D). macro_varlist([],A,A). require(A,B) :- info(A,C,D,E,F,G,H,I), !, logical_simplify(H,B). require(A,true) :- \+info(A), !. uninit_set_type(A,B,C) :- uninit_bag_type(A,B,D), sort(D,C). match_heads(A,B,C,D,E,F,F) :- A>B, !. match_heads(A,B,C,D,E,F,G) :- A= true ; D=[] ), ( first_name(A,E) -> genatom([36,32,105,110,105,116,95],E,F) ; F='$ init' ), list_to_conj(D,G), cls_to_ptrees([(F:-G)],B). append(A,B,C) :- difflist(A,C,B). first_name([ptree(A,B,C,D)|E],A) :- !. first_name([A|B],C) :- first_name(B,C). genatom(A,B/C,D) :- atomic(B), atomic(C), !, name(B,E), name(C,F), append(A,E,[47],F,G), name(D,G). list_to_conj([],true). list_to_conj([A|B],C) :- flat_conj(A,C,D), list_to_conj(B,D). list_ex :- list_ex(A), nl, fail. list_ex. list_ex(A) :- ex(A,B,C), w('% Example '), w(A), wn(:), inst_writeqs(B), ( \+C=true -> wn('% Modes:'), inst_writeqs(C) ; true ). inst_writeqs(A) :- cons(A), !, inst_writeq_list(A). inst_writeqs(A) :- \+cons(A), !, inst_writeq(A), wn('.'). gensym_integer(1). max_int(32767). min_int(-32768). directive((:-A)). stree(stree(A,B,C,D,E,F)). find_arg(A,B,C) :- functor(B,D,E), find_arg(1,E,A,B,C). find_arg(A,B,C,D,E) :- A= append(E,[46],B,G) ; append(D,[46],B,G) ), name(C,G). append([],A,B,C) :- append(A,B,C). append([A|B],C,D,[A|E]) :- append(B,C,D,E). newfilename(A,B,C) :- name(A,D), append(D,B,E), name(C,E). grounds_in_form(A,B) :- ground_set(A,C), vars_in_unify(C,A,B). ground_set(A,B) :- ground_bag(A,C,[]), sort(C,D), filter_vars(D,B). vars_in_unify(A,B,C) :- make_graph((D=A ',' B),E,[]), warshall(E,F), member_w(D-C,F). make_graph((A ',' B),C,D) :- !, make_graph(A,C,E), make_graph(B,E,D). make_graph(A,B,C) :- graph_node(A,B,C). warshall(A,B) :- warshall(A,A,B). member_w(A-B,[C-B|D]) :- A==C, !. member_w(A-B,[C|D]) :- member_w(A-B,D). warshall([],A,A) :- !. warshall([A-B|C],D,E) :- member_w(A-F,D), warshall(D,A,F,G), warshall(C,G,E). warshall([],A,B,[]) :- !. warshall([A-B|C],D,E,[A-F|G]) :- inv(D,B), !, unionv(B,E,F), warshall(C,D,E,G). warshall([A-B|C],D,E,[A-B|F]) :- warshall(C,D,E,F). unionv([],A,A). unionv([A|B],C,D) :- unionv_2(C,A,B,D). graph_node(A=B,C,D) :- !, varset(B,E), 'C'(C,A-E,D). graph_node(A==B,C,D) :- !, varset(B,E), 'C'(C,A-E,D). graph_node(A,B,B). intersectv([],A,[]). intersectv([A|B],C,D) :- intersectv_2(C,A,B,D). intersectv_2([],A,B,[]). intersectv_2([A|B],C,D,E) :- compare(F,C,A), intersectv_3(F,C,D,A,B,E). intersectv_3(<,A,B,C,D,E) :- intersectv_2(B,C,D,E). intersectv_3(=,A,B,C,D,[A|E]) :- intersectv(B,D,E). intersectv_3(>,A,B,C,D,E) :- intersectv_2(D,A,B,E). intersectv_list([],[]). intersectv_list([A|B],C) :- intersectv_list(B,A,C). intersectv_list([],A,A). intersectv_list([A|B],C,D) :- intersectv(A,C,E), intersectv_list(B,E,D). disjointv([],A). disjointv([A|B],C) :- disjointv_2(C,A,B). disjointv_2([],A,B). disjointv_2([A|B],C,D) :- compare(E,C,A), disjointv_3(E,C,D,A,B). disjointv_3(<,A,B,C,D) :- disjointv_2(B,C,D). disjointv_3(>,A,B,C,D) :- disjointv_2(D,A,B). diffv([],A,[]). diffv([A|B],C,D) :- diffv_2(C,A,B,D). diffv_2([],A,B,[A|B]). diffv_2([A|B],C,D,E) :- compare(F,C,A), diffv_3(F,C,D,A,B,E). diffv_3(<,A,B,C,D,[A|E]) :- diffv(B,[C|D],E). diffv_3(=,A,B,C,D,E) :- diffv(B,D,E). diffv_3(>,A,B,C,D,E) :- diffv_2(D,A,B,E). unionv_2([],A,B,[A|B]). unionv_2([A|B],C,D,E) :- compare(F,C,A), unionv_3(F,C,D,A,B,E). unionv_3(<,A,B,C,D,[A|E]) :- unionv_2(B,C,D,E). unionv_3(=,A,B,C,D,[A|E]) :- unionv(B,D,E). unionv_3(>,A,B,C,D,[C|E]) :- unionv_2(D,A,B,E). includev(A,B,C) :- includev_2(B,A,C). includev_2([],A,[A]). includev_2([A|B],C,D) :- compare(E,C,A), includev_3(E,C,A,B,D). includev_3(<,A,B,C,[A,B|C]). includev_3(=,A,B,C,[B|C]). includev_3(>,A,B,C,[B|D]) :- includev_2(C,A,D). excludev(A,B,C) :- excludev_2(B,A,C,B). excludev_2([],A,[],B). excludev_2([A|B],C,D,E) :- compare(F,C,A), excludev_3(F,C,A,B,D,E). excludev_3(<,A,B,C,D,D). excludev_3(=,A,B,C,C,D). excludev_3(>,A,B,C,[B|D],E) :- excludev_2(C,A,D,C). subsetv([],A). subsetv([A|B],[C|D]) :- compare(E,A,C), subsetv_2(E,A,B,D). subsetv_2(=,A,B,C) :- subsetv(B,C). subsetv_2(>,A,B,C) :- subsetv([A|B],C). small_subsetv([],A). small_subsetv([A|B],C) :- inv(A,C), small_subsetv(B,C). inv_2(=,A,B). inv_2(>,A,B) :- inv(A,B). uniqvar([],[]). uniqvar([A|B],C) :- uniqvar(A,B,C,[]). uniqvar(A,[],B,C) :- !, 'C'(B,A,C). uniqvar(A,[B|C],D,E) :- one_uniqvar(A,B,D,F), uniqvar(B,C,F,E). one_uniqvar(A,B,C,C) :- A==B, !. one_uniqvar(A,B,C,D) :- A\==B, 'C'(C,A,D), !. filter_vars(A,B) :- filter_vars(A,B,[]). filter_vars([],A,A). filter_vars([A|B],C,D) :- var(A), !, 'C'(C,A,E), filter_vars(B,E,D). filter_vars([A|B],C,D) :- nonvar(A), !, filter_vars(B,C,D). filter_vars([],[],[],[]). filter_vars([A|B],[C|D],[A|E],[C|F]) :- var(A), !, filter_vars(B,D,E,F). filter_vars([A|B],[C|D],E,F) :- nonvar(A), !, filter_vars(B,D,E,F). varbag(A,B,C,D,D) :- B>C, !. varbag(A,B,C,D,E) :- B= B, in(A,C). include(A,[B|C],[A,B|C]) :- A@B, !, include(A,C,D). include(A,[],[A]). subset([A|B],[C|D]) :- A=C, !, subset(B,D). subset([A|B],[C|D]) :- A@>C, !, subset([A|B],D). subset([],A). not_disjoint([A|B],[A|C]) :- !. not_disjoint([A|B],[C|D]) :- A@>C, !, not_disjoint([A|B],D). not_disjoint([A|B],[C|D]) :- A@ ,A,B,C,D) :- get(D,A,B). fget_2(<,A,B,C,D,E) :- fget(D,A,B). fget_2(=,A,B,C,D,E) :- B=C. fget_2(>,A,B,C,D,E) :- fget(E,A,B). set(node(A,B,C,D),E,F,node(A,F,C,D)) :- E=A, !. set(node(A,B,C,D),E,F,node(A,B,G,D)) :- E@A, !, set(D,E,F,G). set(leaf,A,B,node(A,B,leaf,leaf)). fset(leaf,A,B,node(A,B,leaf,leaf)). fset(node(A,B,C,D),E,F,node(A,G,H,I)) :- compare(J,E,A), fset_2(J,E,F,B,C,D,G,H,I). fset_2(<,A,B,C,D,E,C,F,E) :- fset(D,A,B,F). fset_2(=,A,B,C,D,E,B,D,E). fset_2(>,A,B,C,D,E,C,D,F) :- fset(E,A,B,F). create_array(A,B) :- ( key_list(A) -> C=A ; list_to_key(A,C) ), random_permute(C,D), list_to_tree(D,B). key_list([]). key_list([A-B|C]). random_permute(A,B) :- ran_keys(A,23141,C), keysort(C,D), key_to_list(D,B). list_to_tree([],A) :- seal(A). list_to_tree([A-B|C],D) :- get(D,A,B), list_to_tree(C,D). non_empty_array(node(A,B,C,D)). gensym(A) :- gensym([36,105,110,116,101,114,110,97,108,95,115,121,109,95],A). gensym(A,B) :- gennum(C), name(C,D), append(A,D,E), name(F,E), !, B=F. gennum(A) :- gensym_integer(A), abolish(gensym_integer,1), B is A+1, asserta(gensym_integer(B)). gensym(A,B/C,D) :- atomic(B), atomic(C), !, name(B,E), name(C,F), append(A,E,[47],F,[95],G), gensym(G,D). gensym(A,B,C) :- atomic(B), !, name(B,D), append(A,D,E), gensym(E,C). gensym(A,B,C) :- warning(['Erroneous second argument to gensym/3: ',B]), gensym(A,C). append([],A,B,C,D,E) :- append(A,B,C,D,E). append([A|B],C,D,E,F,[A|G]) :- append(B,C,D,E,F,G). append([],A,B,C,D) :- append(A,B,C,D). append([A|B],C,D,E,[A|F]) :- append(B,C,D,E,F). inst_vars(A,B) :- copy(A,B), inst_vars(B). inst_vars(A) :- varset(A,B), inst_vars_list(0,B). inst_vars_list(A,[]) :- !. inst_vars_list(A,[B|C]) :- !, var_name(A,B), D is A+1, inst_vars_list(D,C). cons(A) :- nonvar(A), A=[B|C]. inst_writeq_list([]). inst_writeq_list([A|B]) :- inst_writeq(A), wn('.'), inst_writeq_list(B). inst_vars_names_list(A,[],[]) :- !. inst_vars_names_list(A,[B|C],[D|E]) :- !, var_name(A,D), F is A+1, inst_vars_names_list(F,C,E). inst_writeq(A,B,C) :- var(A), !, memberv2(A,B,D,C), write(D). inst_writeq(A,B,C) :- atomic(A), !, writeq(A). inst_writeq(A,B,C) :- cons(A), !, write('['), inst_writeq_listterm(A,B,C). inst_writeq(A,B,C) :- binary_op(A,D,E,F), paren_op(E), !, list_op(A,E,G,[]), length(G,H), ( H>1 -> write('(') ; true ), inst_writeq_oplist(G,E,B,C), ( H>1 -> write(')') ; true ). inst_writeq(A,B,C) :- binary_op(A,D,E,F), !, inst_writeq(D,B,C), write(' '), write(E), write(' '), inst_writeq(F,B,C). inst_writeq(A,B,C) :- structure(A), !, functor(A,D,E), writeq(D), write('('), inst_writeq(1,E,A,B,C), write(')'). memberv2(A,[B|C],D,[D|E]) :- A==B, !. memberv2(A,[B|C],D,[E|F]) :- memberv2(A,C,D,F). inst_writeq_listterm(A,B,C) :- \+list(A), !, write('|'), inst_writeq(A,B,C), write(']'). inst_writeq_listterm([],A,B) :- !, write(']'). inst_writeq_listterm([A|B],C,D) :- cons(B), !, inst_writeq(A,C,D), write(','), inst_writeq_listterm(B,C,D). inst_writeq_listterm([A|B],C,D) :- \+cons(B), !, inst_writeq(A,C,D), inst_writeq_listterm(B,C,D). binary_op((A-->B),A,-->,B). binary_op((A ',' B),A,',',B). binary_op((A;B),A,;,B). binary_op(A^B,A,^,B). binary_op(A=B,A,=,B). binary_op(A\=B,A,\=,B). binary_op((A:-B),A,(:-),B). binary_op((A->B),A,->,B). binary_op(A=..B,A,=..,B). binary_op(A@B,A,@>,B). binary_op(A@>=B,A,@>=,B). binary_op(AB,A,>,B). binary_op(A>=B,A,>=,B). binary_op(A=:=B,A,=:=,B). binary_op(A=\=B,A,=\=,B). binary_op(A\==B,A,\==,B). binary_op(A==B,A,==,B). binary_op(A+B,A,+,B). binary_op(A-B,A,-,B). binary_op(A/B,A,/,B). binary_op(A*B,A,*,B). binary_op(A//B,A,//,B). binary_op(A/\B,A,/\,B). binary_op(A\/B,A,\/,B). binary_op(A mod B,A,' mod ',B). binary_op(A is B,A,' is ',B). paren_op(','). paren_op(;). paren_op((:-)). list_op(A,B,C,D) :- nonvar(A), binary_op(A,E,B,F), !, list_op(E,B,C,G), list_op(F,B,G,D). list_op(A,B,C,D) :- 'C'(C,A,D). inst_writeq_oplist([],A,B,C). inst_writeq_oplist([A|B],C,D,E) :- cons(B), !, inst_writeq(A,D,E), write(C), inst_writeq_oplist(B,C,D,E). inst_writeq_oplist([A|B],C,D,E) :- nil(B), !, inst_writeq(A,D,E). structure(A) :- nonvar(A), \+atomic(A), \+A=[B|C]. inst_writeq(A,B,C,D,E) :- A>B, !. inst_writeq(A,B,C,D,E) :- A=:=B, !, arg(A,C,F), inst_writeq(F,D,E). inst_writeq(A,B,C,D,E) :- A=26, !, C is A mod 26+[65], D is A//26, name(D,E), name(B,[C|E]). copyB(A,B) :- bagof(A,true,[B]). copy1(A,B) :- assert(global_copy(A)), global_copy(C), abolish(global_copy,1), !, C=B. copy2(A,B) :- varset(A,C), make_sym(C,D), copy2(A,B,D), !. make_sym([],[]). make_sym([A|B],[p(A,C)|D]) :- make_sym(B,D). copy2(A,B,C) :- var(A), !, retrieve_sym(A,C,B). copy2(A,B,C) :- nonvar(A), !, functor(A,D,E), functor(B,D,E), copy2(A,B,C,1,E). copy3(A,B) :- varbag(A,C), make_sym(C,D), copy2(A,B,D), !. retrieve_sym(A,[p(B,C)|D],C) :- A==B, !. retrieve_sym(A,[B|C],D) :- retrieve_sym(A,C,D). copy2(A,B,C,D,E) :- D>E, !. copy2(A,B,C,D,E) :- D= B, !. map_terms_seq(A,B,C,D,E,F) :- A=B, !. map_terms_seq(A,B,C,D,E,F,G,H) :- A=B, !. range_list(A,B,[B]) :- A=B, !. range_list(A,B,[A|C]) :- AB, !, D is A-1, downrange_list(D,B,C). ran_keys([],A,[]). ran_keys([A|B],C,[C-A|D]) :- random_step(C,E), ran_keys(B,E,D). key_to_list([],[]). key_to_list([A-B|C],[B|D]) :- key_to_list(C,D). random_step(A,B) :- B is(A*1237+2116)mod 44449. member_conj(A,(B ',' C)) :- member_conj(A,B), !. member_conj(A,(B ',' C)) :- member_conj(A,C), !. member_conj(A,A). memberv_conj(A,(B ',' C)) :- memberv_conj(A,B), !. memberv_conj(A,(B ',' C)) :- memberv_conj(A,C), !. memberv_conj(A,B) :- \+B= (C ',' D), A==B, !. reverse_conj(A,B) :- reverse_conj(A,true,B). reverse_conj((A ',' B),C,D) :- reverse_conj(B,(A ',' C),D). reverse_conj(true,A,A). append_conj(true,A,A). append_conj((A ',' B),C,(A ',' D)) :- append_conj(B,C,D). append_conj(true,A,B,C) :- append_conj(A,B,C). append_conj((A ',' B),C,D,(A ',' E)) :- append_conj(B,C,D,E). append_conj(true,A,B,C,D) :- append_conj(A,B,C,D). append_conj((A ',' B),C,D,E,(A ',' F)) :- append_conj(B,C,D,E,F). last_conj((A ',' B),A) :- all_true(B), !. last_conj((A ',' B),C) :- last_conj(B,C). all_true(true). all_true((A ',' B)) :- all_true(A), all_true(B). intersectv_conj(A,B,C) :- intersectv_conj(A,B,C,true). intersectv_conj((A ',' B),C,D,E) :- !, intersectv_conj(A,C,D,F), intersectv_conj(B,C,F,E). intersectv_conj(A,B,C,D) :- \+A= (E ',' F), memberv_conj(A,B), !, co(A,C,D). intersectv_conj(A,B,C,C) :- \+A= (D ',' E), !. co(A,(A ',' B),B). unionv_conj(A,B,fail) :- memberv_conj(fail,A), !. unionv_conj(A,B,fail) :- memberv_conj(fail,B), !. unionv_conj(A,B,C) :- unionv_conj(A,B,C,B). unionv_conj((A ',' B),C,D,E) :- !, unionv_conj(A,C,D,F), unionv_conj(B,C,F,E). unionv_conj(true,A,B,B) :- !. unionv_conj(A,B,C,C) :- succeeds(A), !. unionv_conj(A,B,C,D) :- \+succeeds(A), \+A= (E ',' F), \+A=true, !, conj_if_nomember(A,B,C,D). succeeds(true). succeeds((A ',' B)) :- succeeds(A), succeeds(B). succeeds((A;B)) :- succeeds(A). succeeds((A;B)) :- succeeds(B). succeeds(functor(A,B,C)) :- nonvar(A), nonvar(B), nonvar(C), \+errs(functor(A,B,C)), functor(A,B,C). succeeds('$name_arity'(A,B,C)) :- nonvar(A), nonvar(B), nonvar(C), \+errs(functor(A,B,C)), functor(A,B,C). succeeds(nonvar(A)) :- nonvar(A). succeeds(ground(A)) :- ground(A). succeeds(atom(A)) :- atom(A). succeeds(nil(A)) :- nil(A). succeeds(integer(A)) :- integer(A). succeeds(negative(A)) :- negative(A). succeeds(nonnegative(A)) :- nonnegative(A). succeeds(float(A)) :- float(A). succeeds(number(A)) :- number(A). succeeds(atomic(A)) :- atomic(A). succeeds(list(A)) :- list(A). succeeds(cons(A)) :- cons(A). succeeds(structure(A)) :- structure(A). succeeds(compound(A)) :- compound(A). succeeds(simple(A)) :- nonvar(A), simple(A). succeeds(A) :- encode_relop(A,B,C,D), test_relop(B,C,D), \+errs(A). conj_if_nomember(A,B,C,C) :- memberv_conj(A,B), !. conj_if_nomember(A,B,C,D) :- \+memberv_conj(A,B), !, co(A,C,D). flat_conj(true,A,A) :- !. flat_conj((A ',' B),C,D) :- !, flat_conj(A,C,E), flat_conj(B,E,D). flat_conj(A,B,C) :- co(A,B,C). replace_start_conj(true,A,A). replace_start_conj((A ',' B),(C ',' D),(A ',' E)) :- replace_start_conj(B,D,E). split_disj((A;B),A,B) :- !. split_disj(A,A,fail). ground(0,A) :- !. ground(A,B) :- A>0, !, arg(A,B,C), ground(C), D is A-1, ground(D,B). compound(A) :- nonvar(A), \+atomic(A). simple(A) :- var(A), !. simple(A) :- atomic(A), !. denumerable(A) :- atom(A), !. denumerable(A) :- integer(A), !. negative(A) :- integer(A), A<0. positive(A) :- integer(A), A>0. nonpositive(A) :- integer(A), A=<0. full_list([]). full_list([A|B]) :- full_list(B). conj_p(A) :- nonvar(A), ( A= (B ',' C) ; A=true ), !. disj_p(A) :- nonvar(A), ( A= (B;C) ; A=fail ), !. strong_disj_p(A) :- nonvar(A), A= (B;C). conj_p((A ',' B),A,B). disj_p((A;B),A,B). di(A,(A;B),B). unify_p(A=B). call_p(A) :- \+unify_p(A). split_unify(A=B,A,B). split_unify(A=B,B,A). split_unify(A,B,A,B). split_unify(A,B,B,A). split_unify_v(A=B,A,B) :- var(A). split_unify_v(A=B,B,A) :- var(B). split_unify_v(A,B,A,B) :- var(A). split_unify_v(A,B,B,A) :- var(B). split_unify_v_nv(A=B,A,B) :- var(A), nonvar(B). split_unify_v_nv(A=B,B,A) :- var(B), nonvar(A). split_unify_v_nv(A,B,A,B) :- var(A), nonvar(B). split_unify_v_nv(A,B,B,A) :- var(B), nonvar(A). downrange(A,B,B). downrange(A,B,C) :- A =B, !. max(A,B,B) :- B@>A. maximum(A,B,C) :- max(A,B,C). min(A,B,A) :- A@==B, !. maxlist([A|B],C) :- maxlist(B,A,C), !. maxlist([],A,A). maxlist([A|B],C,D) :- max(A,C,E), maxlist(B,E,D). minlist([A|B],C) :- minlist(B,A,C), !. minlist([],A,A). minlist([A|B],C,D) :- min(A,C,E), minlist(B,E,D). shorter_than([],A) :- A>0. shorter_than([A|B],C) :- C>0, D is C-1, shorter_than(B,D). longer_than([A|B],C) :- C=<0. longer_than([A|B],C) :- C>0, D is C-1, longer_than(B,D). length_disj(fail,A,A) :- !. length_disj((A;B),C,D) :- !, length_disj(A,C,E), length_disj(B,E,D). length_disj(A,B,C) :- \+disj_p(A), !, add(1,B,C). length_conj(A,B) :- length_conj(A,0,B). length_conj(true,A,A) :- !. length_conj((A ',' B),C,D) :- !, length_conj(A,C,E), length_conj(B,E,D). length_conj(A,B,B) :- cut_p(A), !. length_conj(A,B,C) :- \+conj_p(A), !, add(1,B,C). cut_p('$cut_deep'(A)). cut_p('$cut_shallow'(A)). length_test_user(A,B,C) :- length_test(A,D,0,B), length_conj(D,C). length_test(true,true,A,A) :- !. length_test((A ',' B),C,D,E) :- test(A), !, add(1,D,F), length_test(B,C,F,E). length_test(A,true,B,C) :- test(A), !, add(1,B,C). length_test(A,A,B,B). test(A) :- encode_relop(A,B,C,D), !. test(A) :- encode_test(A,B,C,D), !. test(A) :- encode_name_arity(A,B,C,D,E), !. or(true,true,true). or(true,false,true). or(false,true,true). or(false,false,false). or(A,B,C,D) :- or(A,B,E), or(E,C,D). and(true,true,true). and(true,false,false). and(false,true,false). and(false,false,false). and(A,B,C,D) :- and(A,B,E), and(E,C,D). write_code([],A). write_code([A|B],C) :- write_code(A,B,C). write_output([]). write_output([A|B]) :- nl_if_procedure(A), tab_if_nonlbl(A), wq(A), wn('.'), write_output(B). write_code(switch(unify,A,B,C,D,E),F,G) :- !, H is G+4, tab(G), w('switch('), w(B), wn(') {'), tab(G), tag(var,I), w(I), wn(:), write_code(C,H), tab(G), w(A), wn(:), write_code(D,H), tab(G), w('else: '), wn(E), tab(G), wn('}'), write_code(F,G). write_code(label(A),B,C) :- D is C-4, tab(D), wq(A), wn(:), write_code(B,C). write_code(procedure(A),B,C) :- D is C-4, tab(D), nl, wqn(procedure(A)), nl, write_code(B,C). write_code(A,B,C) :- \+A=label(D), \+A=procedure(E), \+A=switch(unify,F,G,H,I,J), tab(C), wqn(A), write_code(B,C). tag(A,B) :- tag_type_test(B,A,C,D). tag(A,B) :- tag_type_test(B,C,D,A). wq(A) :- writeq(A). wqn(A) :- writeq(A), nl. nl_if_procedure(procedure(A)) :- !, nl. nl_if_procedure(A). tab_if_nonlbl(label(A)) :- !. tab_if_nonlbl(procedure(A)) :- !. tab_if_nonlbl(A) :- \+A=label(B), \+A=procedure(C), !, put(9). xwrite_modes([]) :- !. xwrite_modes(A) :- cons(A), !, nl, write('% Modes:'), nl, xwrite_clauses(A), nl, write('% Source:'). xwrite_modes(A) :- \+cons(A), !, xwrite_modes([A]). xwrite_source([]) :- !. xwrite_source(A) :- cons(A), nl, xwrite_clauses(A). xwrite_clauses([]). xwrite_clauses([A|B]) :- write('% '), write(A), write('.'), nl, xwrite_clauses(B). make_msg(A,B) :- inst_vars(A,C), make_list(C,B). cm :- w('% *** '). msg_list([],A) :- !, nl. msg_list([A|B],C) :- msg_one(A,C), msg_list(B,C). aesthetic(A) :- make_msg(A,B), ae, msg_list(B,ae). ae :- w('% *** Aesthetic: '). w :- w('% *** Warning: '). e :- w('% *** Error: '). comment(A,B) :- true. % compile_option(comment), % !, % make_msg(A,B,C), % cm, % msg_list(C,cm). % comment(A,B) :- % \+compile_option(comment), % !. make_msg(A,B,C) :- inst_vars(s(A,B),s(D,E)), make_list(E,C). aesthetic(A,B) :- make_msg(A,B,C), ae, msg_list(C,ae). warning(A,B) :- make_msg(A,B,C), w, msg_list(C,w). error(A,B) :- make_msg(A,B,C), e, msg_list(C,e). msg_one(tab,A) :- !, put(9). msg_one(nl,cm) :- !, nl, cms. msg_one(nl,ae) :- !, nl, aes. msg_one(nl,w) :- !, nl, ws. msg_one(nl,e) :- !, nl, es. msg_one(A,B) :- !, w(A). cms :- w('% *** '). aes :- w('% *** '). ws :- w('% *** '). es :- w('% *** '). f :- wn(' ***'). wd(A,B,B) :- wd(A). wd(A) :- fail, % compile_option(debug), !, w(A). wd(A) :- true. % \+compile_option(debug). write_debug(A,B,B) :- write_debug(A). write_debug(A) :- wd(A), nl_debug. nl_debug :- ( fail -> % compile_option(debug) -> nl ; true ). write_list([]). write_list([A|B]) :- w(A), nl, write_list(B). not_used(A) :- w(A), wn('- not used!'). not_used(A,B,B) :- not_used(A). get_cputime(A) :- the_system(cprolog), !, A=0. get_cputime(A) :- the_system(quintus), !, A=0. get_cputime(A) :- the_system(aquarius), !, A=0. get_cputime(A) :- A=0. write_num(none) :- !. write_num(A) :- w(-), w(A). ttyflush_quintus :- the_system(quintus), !, ttyflush. ttyflush_quintus. stats(A,B,C,C) :- stats(A,B). survive(A) :- info(A,y,B,C,D), !. survive(not(A)) :- info(A,y,B,C,D), !. survive_form(A==B,C) :- !, implies(C,(simple(A);simple(B))). survive_form(A\==B,C) :- !, implies(C,(simple(A);simple(B))). survive_form(A,B) :- survive(A). anyregs(A,y) :- anyregs(A), !. anyregs(A,n) :- \+anyregs(A), !. anyregs(A) :- info(A,B,y,C,D), !. builtin(A,y) :- builtin(A), !. builtin(A,n) :- \+builtin(A), !. expanded(A,y) :- expanded(A), !. expanded(A,n) :- \+expanded(A), !. expanded(A) :- info(A,B,C,D,y), !. fixregs(A) :- \+anyregs(A). fixregs(A) :- \+builtin(A). info(A,B,C,D,E) :- info(A,B,C,D,E,F,G,H). compmodes(A,B) :- info(A,C,D,E,F,G,H,B), !. info(A,B,n,n,n,C,D,E) :- mode_option(A,D,F,E,B), !, A=..[G|C]. info('$cut_load'(A),y,y,y,y,[A],uninit_reg(A),true). info('$cut_deep'(A),y,y,y,y,[],true,true). info('$cut_shallow'(A),y,y,y,y,[],true,true). info('$if2f'(A,B),y,y,y,y,[B],C,D) :- ar_mf(A,B,C,D). info('$if2i'(A,B),y,y,y,y,[B],C,D) :- ar_mf(A,B,C,D). info('$add'(A,B,C),y,y,y,y,[C],D,E) :- ar_mf(A,B,C,D,E). info('$sub'(A,B,C),y,y,y,y,[C],D,E) :- ar_mf(A,B,C,D,E). info('$mul'(A,B,C),y,y,y,y,[C],D,E) :- ar_mf(A,B,C,D,E). info('$fdiv'(A,B,C),y,y,y,y,[C],D,E) :- ar_mf(A,B,C,D,E). info('$idiv'(A,B,C),y,y,y,y,[C],D,E) :- ar_mf(A,B,C,D,E). info('$mod'(A,B,C),y,y,y,y,[C],D,E) :- ar_mf(A,B,C,D,E). info('$and'(A,B,C),y,y,y,y,[C],D,E) :- ar_m(A,B,C,D,E). info('$or'(A,B,C),y,y,y,y,[C],D,E) :- ar_m(A,B,C,D,E). info('$xor'(A,B,C),y,y,y,y,[C],D,E) :- ar_m(A,B,C,D,E). info('$sll'(A,B,C),y,y,y,y,[C],D,E) :- ar_m(A,B,C,D,E). info('$sra'(A,B,C),y,y,y,y,[C],D,E) :- ar_m(A,B,C,D,E). info('$not'(A,B),y,y,y,y,[B],C,D) :- ar_m(A,B,C,D). info(A@B,n,n,y,n,[],C,A@>B) :- d_m([A,B],C). info(A@==B,n,n,y,n,[],C,A@>=B) :- d_m([A,B],C). info(A==B,n,n,y,y,[],C,A==B) :- d_m([A,B],C). info(A\==B,n,n,y,y,[],C,A\==B) :- d_m([A,B],C). info(AB,y,y,y,y,[],C,(D ',' A>B)) :- rel_mf(A,B,C,D). info(A==B,y,y,y,y,[],C,(D ',' A>=B)) :- rel_mf(A,B,C,D). info(A=\=B,y,y,y,y,[],C,(D ',' A=\=B)) :- rel_mf(A,B,C,D). info(A=:=B,y,y,y,y,[],C,(D ',' A=:=B)) :- rel_mf(A,B,C,D). info(A=B,y,y,y,y,[A,B],C,A==B) :- d_m([A,B],C). info('$unify'(A,B),y,y,y,n,[A,B],C,A==B) :- d_m([A,B],C). info(A\=B,n,n,y,y,[],C,A\=B) :- d_m([A,B],C). info('$test'(A,B),y,y,y,y,[],C,('$test'(A,B)',' C)) :- d_m([A],C). info('$equal'(A,B),y,y,y,y,[],C,(A==B ',' D)) :- rd_m([A,B],C,D). info(var(A),y,y,y,y,[],B,(var(A)',' C)) :- rd_m([A],B,C). info(nonvar(A),y,y,y,y,[],B,(nonvar(A)',' B)) :- d_m([A],B). info(atom(A),y,y,y,y,[],B,(atom(A)',' C)) :- rd_m([A],B,C). info('$atom_nonnil'(A),y,y,y,y,[],B,('$atom_nonnil'(A)',' C)) :- rd_m([A],B,C). info(atomic(A),y,y,y,y,[],B,(atomic(A)',' C)) :- rd_m([A],B,C). info(denumerable(A),y,y,y,y,[],B,(denumerable(A)',' C)) :- rd_m([A],B,C). info(nil(A),y,y,y,y,[],B,(nil(A)',' C)) :- rd_m([A],B,C). info(cons(A),y,y,y,y,[],B,(cons(A)',' B)) :- d_m([A],B). info(list(A),y,y,y,y,[],B,(list(A)',' B)) :- d_m([A],B). info(structure(A),y,y,y,y,[],B,(structure(A)',' B)) :- d_m([A],B). info(compound(A),y,y,y,y,[],B,(compound(A)',' B)) :- d_m([A],B). info(simple(A),y,y,y,y,[],B,(simple(A)',' C)) :- rd_m([A],B,C). info(ground(A),n,n,y,y,[],B,(ground(A)',' B)) :- d_m([A],B). info(number(A),y,y,y,y,[],B,(number(A)',' C)) :- rd_m([A],B,C). info(float(A),y,y,y,y,[],B,(float(A)',' C)) :- rd_m([A],B,C). info(integer(A),y,y,y,y,[],B,(integer(A)',' C)) :- rd_m([A],B,C). info(negative(A),y,y,y,y,[],B,(negative(A)',' C)) :- rd_m([A],B,C). info(nonnegative(A),y,y,y,y,[],B,(nonnegative(A)',' C)) :- rd_m([A],B,C). info(functor(A,B,C),n,n,y,y,[A,B,C],D,('$name_arity'(A,B,C)',' atomic(B)',' integer(C))) :- d_m([A,B,C],D). info('$name_arity'(A,B,C),y,y,y,y,[],D,('$name_arity'(A,B,C)',' D)) :- d_m([A],D). info(arg(A,B,C),n,n,y,y,[A,B,C],D,(integer(A)',' nonvar(B))) :- d_m([A,B,C],D). info(A is B,n,n,y,y,[A],(deref(A)',' deref(B)),integer(A)). info(A=..B,n,n,y,n,[A,B],(deref(A)',' deref(B)),(nonvar(A)',' cons(B))). info(!,y,y,y,y,[],true,true). info(true,y,y,y,y,[],true,true). info(otherwise,y,y,y,y,[],true,true). info(fail,y,y,y,y,[],true,fail). info(false,y,y,y,y,[],true,fail). info(copy_term(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),true). info(call(A),n,n,y,n,[A],deref(A),nonvar(A)). info(length(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(list(A)',' integer(B))). info(compare(A,B,C),n,n,y,n,[A],(deref(A)',' deref(B)',' deref(C)),atom(A)). info(expand_term(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),true). info(sort(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),(list(A)',' list(B))). info(keysort(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),(list(A)',' list(B))). info(msort(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),(list(A)',' list(B))). info(name(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(atomic(A)',' list(B))). info(atom_chars(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(atom(A)',' list(B))). info(number_chars(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(number(A)',' list(B))). info(numbervars(A,B,C),n,n,y,n,[A,C],(deref(A)',' deref(B)',' deref(C)),(integer(B)',' integer(C))). info(repeat,n,n,y,n,[],true,true). info(is_list(A),n,n,y,n,[],deref(A),(var(A);list(A))). info(is_proper_list(A),n,n,y,n,[],deref(A),list(A)). info(is_partial_list(A),n,n,y,n,[],deref(A),(var(A);cons(A))). info(abolish(A),n,n,y,n,[],deref(A),ground(A)). info(abolish(A,B),n,n,y,n,[],(deref(A)',' deref(B)),(atomic(A)',' integer(B))). info(assert(A),n,n,y,n,[],deref(A),nonvar(A)). info(assert(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),(nonvar(A)',' ground(B))). info(asserta(A),n,n,y,n,[],deref(A),nonvar(A)). info(asserta(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),(nonvar(A)',' ground(B))). info(assertz(A),n,n,y,n,[],deref(A),nonvar(A)). info(assertz(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),(nonvar(A)',' ground(B))). info(retract(A),n,n,y,n,[A],deref(A),nonvar(A)). info(retractall(A),n,n,y,n,[],deref(A),nonvar(A)). info(A^B,n,n,y,n,[A,B],(deref(A)',' deref(B)),true). info(bagof(A,B,C),n,n,y,n,[C],(deref(A)',' deref(B)',' deref(C)),(nonvar(B)',' cons(C))). info(setof(A,B,C),n,n,y,n,[C],(deref(A)',' deref(B)',' deref(C)),(nonvar(B)',' cons(C))). info(findall(A,B,C),n,n,y,n,[C],(deref(A)',' deref(B)',' deref(C)),(nonvar(B)',' cons(C))). info(clause(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(nonvar(A)',' nonvar(B))). info(clause(A,B,C),n,n,y,n,[A,B,C],(deref(A)',' deref(B)',' deref(C)),(nonvar(A)',' nonvar(B)',' ground(C))). info(abort,n,n,y,n,[],true,true). info(break,n,n,y,n,[],true,true). info(halt,n,n,y,n,[],true,true). info(trace,n,n,y,n,[],true,true). info(error_data(A,B,C,D),n,n,y,n,[A,B,C,D],(deref(A)',' deref(B)',' deref(C)',' deref(D)),true). info(file_error_condition(A),n,n,y,n,[A],deref(A),true). info(type_failure_condition(A),n,n,y,n,[A],deref(A),true). info(unknown_predicate_condition(A),n,n,y,n,[A],deref(A),true). info(unknown(A,B),n,n,y,n,[A],(deref(A)',' deref(B)),(atom(A)',' atom(B))). info(nodebug,n,n,y,n,[],true,true). info(debug,n,n,y,n,[],true,true). info(leash(A),n,n,y,n,[],deref(A),true). info(debugging,n,n,y,n,[],true,true). info(nofileerrors,n,n,y,n,[],true,true). info(fileerrors,n,n,y,n,[],true,true). info(nospy A,n,n,y,n,[],deref(A),nonvar(A)). info(spy A,n,n,y,n,[],deref(A),nonvar(A)). info(op(A,B,C),n,n,y,n,[],(deref(A)',' deref(B)',' deref(C)),true). info(prompt(A,B),n,n,y,n,[A],(deref(A)',' deref(B)),(atom(A)',' atom(B))). info(listing,n,n,y,n,[],true,true). info(listing(A),n,n,y,n,[],deref(A),ground(A)). info(current_atom(A),n,n,y,n,[A],deref(A),atom(A)). info(current_functor(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(atomic(A)',' nonvar(B))). info(current_predicate(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(atomic(A)',' nonvar(B))). info(current_op(A,B,C),n,n,y,n,[A,B,C],(deref(A)',' deref(B)',' deref(C)),(integer(A)',' atom(B)',' atom(C))). info(current_key(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(atomic(A)',' nonvar(B))). info(predicate_property(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),true). info(prolog_flag(A,B,C),n,n,y,n,[B],(deref(A)',' deref(B)',' deref(C)),(atom(A)',' ground(B)',' ground(C))). info(prolog_flag(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(atom(A)',' ground(B))). info([A|B],n,n,y,y,[],(deref(A)',' deref(B)),(ground(A)',' ground(B))). info(consult(A),n,n,y,n,[],deref(A),ground(A)). info(ensure_loaded(A),n,n,y,n,[],deref(A),ground(A)). info(close(A),n,n,y,n,[],deref(A),ground(A)). info(exists(A),n,n,y,n,[],deref(A),ground(A)). info(reconsult(A),n,n,y,n,[],deref(A),ground(A)). info(rename(A,B),n,n,y,n,[],(deref(A)',' deref(B)),(ground(A)',' ground(B))). info(save(A),n,n,y,n,[],deref(A),ground(A)). info(see(A),n,n,y,n,[],deref(A),ground(A)). info(seeing(A),n,n,y,n,[A],deref(A),ground(A)). info(seen,n,n,y,n,[],true,true). info(tell(A),n,n,y,n,[],deref(A),ground(A)). info(telling(A),n,n,y,n,[A],deref(A),ground(A)). info(told,n,n,y,n,[],true,true). info(get(A),n,n,y,n,[A],deref(A),integer(A)). info(get0(A),n,n,y,n,[A],deref(A),integer(A)). info(skip(A),n,n,y,n,[],deref(A),integer(A)). info(read(A),n,n,y,n,[A],deref(A),true). info(nl,n,n,y,n,[],true,true). info(tab(A),n,n,y,n,[],deref(A),integer(A)). info(put(A),n,n,y,n,[],deref(A),integer(A)). info(print(A),n,n,y,n,[],deref(A),true). info(write(A),n,n,y,n,[],deref(A),true). info(writeq(A),n,n,y,n,[],deref(A),true). info(write_canonical(A),n,n,y,n,[],deref(A),true). info(display(A),n,n,y,n,[],deref(A),true). info(format(A,B),n,n,y,n,[],(deref(A)',' deref(B)),ground(A)). info(portray_clause(A),n,n,y,n,[],deref(A),true). info(recorda(A,B,C),n,n,y,n,[B,C],(deref(A)',' deref(B)',' deref(C)),ground(C)). info(recordz(A,B,C),n,n,y,n,[B,C],(deref(A)',' deref(B)',' deref(C)),ground(C)). info(recorded(A,B,C),n,n,y,n,[A,B,C],(deref(A)',' deref(B)',' deref(C)),ground(C)). info(erase(A),n,n,y,n,[],deref(A),ground(A)). info(current_key(A,B),n,n,y,n,[A,B],(deref(A)',' deref(B)),(atomic(A)',' nonvar(B))). info(instance(A,B),n,n,y,n,[B],(deref(A)',' deref(B)),ground(A)). bindset(A,B) :- bindbag(A,C), sort(C,B). bindbag(A,B) :- info(A,C,D,E,F,G,H,I), !, varbag(G,B). bindbag(A,B) :- varbag(A,B), !. binds(A) :- bindbag(A,B), cons(B). info(A) :- info(A,B,C,D,E). before(A,B) :- mode_option(A,C,D,E,F), !, logical_simplify(D,B). before(A,true) :- \+mode_option(A,B,C,D,E), !. ar_mf(A,B,C,D) :- C= (deref(A)',' uninit_reg(B)), D= (number(A)',' number(B)',' rderef(A)',' rderef(B)). ar_mf(A,B,C,D,E) :- D= (deref(A)',' deref(B)',' uninit_reg(C)), E= (number(A)',' number(B)',' number(C)',' rderef(A)',' rderef(B)',' rderef(C)). ar_m(A,B,C,D,E) :- D= (deref(A)',' deref(B)',' uninit_reg(C)), E= (integer(A)',' integer(B)',' integer(C)',' rderef(A)',' rderef(B)',' rderef(C)). ar_m(A,B,C,D) :- C= (deref(A)',' uninit_reg(B)), D= (integer(A)',' integer(B)',' rderef(A)',' rderef(B)). d_m([A],deref(A)). d_m([A|B],(deref(A)',' C)) :- d_m(B,C). rel_mf(A,B,C,D) :- C= (deref(A)',' deref(B)), D= (number(A)',' number(B)',' rderef(A)',' rderef(B)). rd_m([A],deref(A),rderef(A)). rd_m([A|B],(deref(A)',' C),(rderef(A)',' D)) :- rd_m(B,C,D). ar_ff(A,B,C,D,E) :- D= (deref(A)',' deref(B)',' uninit_reg(C)), E= (float(A)',' float(B)',' float(C)',' rderef(A)',' rderef(B)',' rderef(C)). rel_m(A,B,C,D) :- C= (deref(A)',' deref(B)), D= (integer(A)',' integer(B)',' rderef(A)',' rderef(B)). control((A ',' B)). control((A;B)). control((A->B)). control(\+A). control(not(A)). branch(A) :- branch(A,B,C). branch(fail,A,A). branch(return,A,A). branch(jump(A),B,C) :- 'C'(B,A,C). branch(jump(A,B,C,D),E,F) :- 'C'(E,D,F). branch(jump_nt(A,B,C,D),E,F) :- 'C'(E,D,F). branch(call(A),B,C) :- 'C'(B,A,C). branch(test(A,B,C,D),E,F) :- 'C'(E,D,F). branch(equal(A,B,C),D,E) :- 'C'(D,C,E). branch(unify(A,B,C,D,E),F,G) :- 'C'(F,E,G). branch(unify_atomic(A,B,C),D,E) :- 'C'(D,C,E). branch(choice(A,B,C),D,E) :- 'C'(D,C,E). branch(hash(A,B,C,D),E,F) :- 'C'(E,D,F). branch(pair(A,B),C,D) :- 'C'(C,B,D). branch(switch(A,B,C,D,E),F,G) :- 'C'(F,C,H), 'C'(H,D,I), 'C'(I,E,G). branch(switch(unify,A,B,C,D,E),F,G) :- 'C'(F,E,G). map_branch(jump(A),A,jump(B),B). map_branch(jump(A,B,C,D),D,jump(A,B,C,E),E). map_branch(jump_nt(A,B,C,D),D,jump_nt(A,B,C,E),E). map_branch(call(A),A,call(B),B). map_branch(test(A,B,C,D),D,test(A,B,C,E),E). map_branch(equal(A,B,C),C,equal(A,B,D),D). map_branch(unify(A,B,C,D,E),E,unify(A,B,C,D,F),F). map_branch(unify_atomic(A,B,C),C,unify_atomic(A,B,D),D). map_branch(choice(A,B,C),C,choice(A,B,D),D). map_branch(hash(A,B,C,D),D,hash(A,B,C,E),E). map_branch(pair(A,B),B,pair(A,C),C). map_branch(switch(A,B,C,D,E),C,switch(A,B,F,D,E),F). map_branch(switch(A,B,C,D,E),D,switch(A,B,C,F,E),F). map_branch(switch(A,B,C,D,E),E,switch(A,B,C,D,F),F). pure_branch(A) :- pure_branch(A,B,C). pure_branch(jump(A),B,C) :- 'C'(B,A,C). pure_branch(jump(A,B,C,D),E,F) :- 'C'(E,D,F). pure_branch(jump_nt(A,B,C,D),E,F) :- 'C'(E,D,F). pure_branch(test(A,B,C,D),E,F) :- 'C'(E,D,F). pure_branch(equal(A,B,C),D,E) :- 'C'(D,C,E). pure_branch(unify(A,B,C,D,E),F,G) :- 'C'(F,E,G). pure_branch(switch(A,B,C,D,E),F,G) :- 'C'(F,C,H), 'C'(H,D,I), 'C'(I,E,G). pure_branch(switch(unify,A,B,C,D,E),F,G) :- 'C'(F,E,G). pure_branch(unify_atomic(A,B,C),D,E) :- 'C'(D,C,E). pure_branch(A,B) :- pure_branch(A,B,[]). distant_branch(fail). distant_branch(return). distant_branch(jump(A)). distant_branch(switch(A,B,C,D,E)). local_instr(A) :- local_instr(A,B,C). local_instr(pragma(A),B,B). local_instr(deref(A),B,C) :- 'C'(B,A,C). local_instr(deref(A,B),C,D) :- 'C'(C,A,D). local_instr(trail(A),B,C) :- 'C'(B,A,C). local_instr(move(A,B),C,D) :- 'C'(C,A,D). local_instr(push(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(adda(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(pad(A),B,C) :- 'C'(B,r(h),C). local_instr(allocate(A),B,B). local_instr(deallocate(A),B,B). local_instr(f2i(A,B),C,D) :- 'C'(C,A,D). local_instr(i2f(A,B),C,D) :- 'C'(C,A,D). local_instr(fadd(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(fsub(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(fmul(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(fdiv(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(add(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(sub(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(mul(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(div(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(and(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(or(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(xor(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(sll(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(sra(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(not(A,B),C,D) :- 'C'(C,A,D). local_instr(ord(A,B),C,D) :- 'C'(C,A,D). local_instr(val(A,B,C),D,E) :- 'C'(D,B,E). local_instr(add_nt(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(sub_nt(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(and_nt(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(or_nt(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(xor_nt(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(sll_nt(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(sra_nt(A,B,C),D,E) :- 'C'(D,A,F), 'C'(F,B,E). local_instr(not_nt(A,B),C,D) :- 'C'(C,A,D). local_instr(trail_bda(A),B,C) :- 'C'(B,A,C). tag_type_test(tflt,float,A,float(A)) :- true. % float. tag_type_test(tint,integer,A,integer(A)). tag_type_test(tpos,nonnegative,A,nonnegative(A)) :- fail. % split_integer. tag_type_test(tneg,negative,A,negative(A)) :- fail. % split_integer. tag_type_test(tatm,atom,A,atom(A)). tag_type_test(tstr,structure,A,structure(A)). tag_type_test(tlst,cons,A,cons(A)). tag_type_test(tvar,var,A,var(A)). term_tag(A,tflt) :- float(A), true. % float. term_tag(A,tint) :- integer(A), true. % \+split_integer. term_tag(A,tpos) :- nonnegative(A), fail. % split_integer. term_tag(A,tneg) :- negative(A), fail. % split_integer. term_tag(A,tatm) :- atom(A). term_tag(A,tstr) :- structure(A). term_tag(A,tlst) :- cons(A). pointer_tag(tstr). pointer_tag(tlst). pointer_tag(tvar). tag_always(integer,tint). tag_always(nonnegative,tpos). tag_always(negative,tneg). tag_always(float,tflt). tag_always(integer(A),tint). tag_always(nonnegative(A),tpos). tag_always(negative(A),tneg). tag_always(float(A),tflt). tag(A,B,B) :- tag(A). tag(A) :- tag_type_test(A,B,C,D), !. tag(A,B,C,C) :- tag_type_test(B,A,D,E). tag(A,B,C,C) :- tag_type_test(B,D,E,A). test_tag(A,B) :- tag_type_test(B,C,D,A). test_tag(A,B,C) :- tag_type_test(C,D,B,A). term_tag(A,B,C,C) :- term_tag(A,B). atomic_type(A) :- tag_type_test(B,A,C,D), \+pointer_tag(B), !. atomic_type(number). atomic_type(atomic). denumerable_type(A) :- tag_type_test(B,A,C,D), \+pointer_tag(B), B\==float, !. tag_type(A) :- tag_type_test(B,A,C,D). type(A) :- type_test(A,B,C). type_test(A,B,C) :- tag_type_test(D,A,B,C), !. type_test(denumerable,A,denumerable(A)). type_test(number,A,number(A)). type_test(float,A,float(A)). type_test(atomic,A,atomic(A)). type_test(simple,A,simple(A)). type_test(compound,A,compound(A)). term_type(A,B) :- term_tag(A,C), tag_type_test(C,B,D,E). term_test(A,B,C,D,D) :- term_test(A,B,C). term_test(A,B,C) :- term_tag(A,D), tag_type_test(D,E,B,C). arith_test(A) :- arith_test(A,B). arith_test(A,B) :- arith_test(A,C,D,B). arith_test(A=:=B,A,B,eq). arith_test(A=\=B,A,B,ne). arith_test(A=B,A,B,ges). arith_test(A>B,A,B,gts). arith_test(A,B,C) :- arith_test(A,B,C,D). special_cond(eq). special_cond(lts). special_cond(gts). special_cond(feq). special_cond(flts). special_cond(fgts). cond(A) :- cond(A,B). cond(lts,ges). cond(les,gts). cond(gts,les). cond(ges,lts). cond(eq,ne). cond(ne,eq). cond(flts,fges). cond(fles,fgts). cond(fgts,fles). cond(fges,flts). cond(feq,fne). cond(fne,feq). cond_to_float(lts,flts). cond_to_float(les,fles). cond_to_float(gts,fgts). cond_to_float(ges,fges). cond_to_float(eq,feq). cond_to_float(ne,fne). mutex(A,B,C) :- mutex(A,B,C,logical). implies(A,B,C) :- logical_simplify(not(B),D), mutex(A,D,C), !. prolog_implies(A,B) :- simplify(not(B),C), prolog_mutex(A,C,left), !. simplify(A,B) :- simp_upv(A,B,prolog), !. prolog_mutex(A,B,C) :- mutex(A,B,C,prolog). prolog_implies(A,B,C) :- simplify(not(B),D), prolog_mutex(A,D,C), !. mutex(A,B,C,D) :- mutex2(A,B,C,D), !. mutex2(fail,A,B,C). mutex2(A,fail,B,C). mutex2('$test'(A,0),B,C,D). mutex2(A,'$test'(B,0),C,D). mutex2((A->B;C),D,E,F) :- mutex2((A ',' B),D,E,F), mutex2((\+A ',' C),D,E,F). mutex2(A,(B->C;D),E,F) :- mutex2(A,(B ',' C),E,F), mutex2(A,(\+B ',' D),E,F). mutex2((A->B),C,D,E) :- mutex2(A,C,D,E). mutex2((A->B),C,D,E) :- mutex2(B,C,D,E). mutex2(A,(B->C),D,E) :- mutex2(A,B,D,E). mutex2(A,(B->C),D,E) :- mutex2(A,C,D,E). mutex2((A ',' B),C,D,E) :- mutex2(A,C,D,E). mutex2((A ',' B),C,D,E) :- mutex2(B,C,D,E). mutex2(A,(B ',' C),D,E) :- mutex2(A,B,D,E). mutex2(A,(B ',' C),D,E) :- mutex2(A,C,D,E). mutex2((A;B),C,D,E) :- mutex2(A,C,D,E), mutex2(B,C,D,E). mutex2(A,(B;C),D,E) :- mutex2(A,B,D,E), mutex2(A,C,D,E). mutex2(A,B,C,logical) :- logical_simplify(A,D), logical_simplify(B,E), ( D==not(E) ; E==not(D) ). mutex2(A,B,C,prolog) :- simplify(A,D), simplify(B,E), ( D==not(E) ; E==not(D) ). mutex2(not((A;B)),C,D,E) :- mutex2(not(A),C,D,E). mutex2(not((A;B)),C,D,E) :- mutex2(not(B),C,D,E). mutex2(A,not((B;C)),D,E) :- mutex2(A,not(B),D,E). mutex2(A,not((B;C)),D,E) :- mutex2(A,not(C),D,E). mutex2(not((A ',' B)),C,D,E) :- mutex2(not(A),C,D,E), mutex2(not(B),C,D,E). mutex2(A,not((B ',' C)),D,E) :- mutex2(A,not(B),D,E), mutex2(A,not(C),D,E). mutex2(\+ (A;B),C,D,E) :- mutex2(\+A,C,D,E). mutex2(\+ (A;B),C,D,E) :- mutex2(\+B,C,D,E). mutex2(A,\+ (B;C),D,E) :- mutex2(A,\+B,D,E). mutex2(A,\+ (B;C),D,E) :- mutex2(A,\+C,D,E). mutex2(\+ (A ',' B),C,D,E) :- mutex2(\+A,C,D,E), mutex2(\+B,C,D,E). mutex2(A,\+ (B ',' C),D,E) :- mutex2(A,\+B,D,E), mutex2(A,\+C,D,E). mutex2(A,not(B),C,D) :- u_match(A,B). mutex2(A,not(B),C,D) :- u_match(B,A). mutex2(A,not(B),C,D) :- u_implies(A,B). mutex2(not(A),B,C,D) :- u_match(A,B). mutex2(not(A),B,C,D) :- u_match(B,A). mutex2(not(A),B,C,D) :- u_implies(B,A). mutex2(A,B,C,D) :- encode_relop(A,E,F,G), encode_relop(B,H,I,J), check_relops(E,F,G,H,I,J). mutex2(A,B,C,D) :- encode_test(A,E,F,G,H), encode_test(B,I,J,K,L), G==K, \+can_overlap(C,E,F,I,J,H,L). mutex2(A,B,C,D) :- encode_name_arity(A,E,F,G,H), encode_name_arity(B,I,J,K,L), E==I, check_name_arity(H,L,F,G,J,K). u_match(trail(A),trail_if_var(B)) :- A==B. u_match(uninit(A),uninit(mem,B)) :- A==B. u_match(uninit(A),uninit(mem,B,C)) :- A==B. u_match(uninit(mem,A),uninit(mem,B,C)) :- A==B. u_match(uninit(reg,A),uninit_reg(B)) :- A==B. u_implies(var(A),unbound(B)) :- A==B. u_implies(rderef(A),deref(B)) :- A==B. u_implies(uninit(either,A),B) :- an_uninit_mode(B,C,D), A==D. u_implies(A,B) :- an_uninit_mode(A,C,D), u_implies_goal(B,E), D==E. encode_relop(A,B,C,D) :- encode_relop(A,B,C,D,E). check_relops(A,B,C,D,E,F) :- A==F, flip(E,G), get_relop(B,G,H), test_relop(C,H,D). check_relops(A,B,C,D,E,F) :- A==D, get_relop(B,E,G), test_relop(C,G,F). check_relops(A,B,C,D,E,F) :- C==F, flip(B,G), flip(E,H), get_relop(G,H,I), test_relop(A,I,D). check_relops(A,B,C,D,E,F) :- C==D, flip(B,G), get_relop(G,E,H), test_relop(A,H,F). encode_test('$test'(A,B),B,C,A,n) :- C is\(B)/\511. encode_test('$name_arity'(A,B,C),128,511,A,n) :- atom(B), B\==[], C==0. encode_test('$name_arity'(A,B,C),64,447,A,n) :- B==[], C==0. encode_test('$name_arity'(A,B,C),32,511,A,n) :- nonnegative(B), C==0. encode_test('$name_arity'(A,B,C),16,511,A,n) :- negative(B), C==0. encode_test('$name_arity'(A,B,C),8,511,A,n) :- number(B), \+integer(B), C==0, B>=0. encode_test('$name_arity'(A,B,C),4,511,A,n) :- number(B), \+integer(B), C==0, B<0. encode_test('$name_arity'(A,B,C),2,509,A,n) :- atom(B), integer(C), B='.', C=:=2. encode_test('$name_arity'(A,B,C),1,511,A,n) :- atom(B), integer(C), C>0, ( B\=='.' ; C=\=2 ). encode_test(functor(A,B,C),128,511,A,y) :- atom(B), B\==[], C==0. encode_test(functor(A,B,C),64,447,A,y) :- B==[], C==0. encode_test(functor(A,B,C),32,511,A,y) :- nonnegative(B), C==0. encode_test(functor(A,B,C),16,511,A,y) :- negative(B), C==0. encode_test(functor(A,B,C),8,511,A,y) :- number(B), \+integer(B), C==0, B>=0. encode_test(functor(A,B,C),4,511,A,y) :- number(B), \+integer(B), C==0, B<0. encode_test(functor(A,B,C),2,509,A,y) :- atom(B), integer(C), B='.', C=:=2. encode_test(functor(A,B,C),1,511,A,y) :- atom(B), integer(C), C>0, ( B\=='.' ; C=\=2 ). encode_test(functor(A,B,C),32,511,C,y) :- atomic(A). encode_test(functor(A,B,C),32,511,C,y) :- compound(A). encode_test(functor(A,B,C),128,511,B,y) :- atom(A), A\==[]. encode_test(functor(A,B,C),64,447,B,y) :- A==[]. encode_test(functor(A,B,C),32,511,B,y) :- nonnegative(A). encode_test(functor(A,B,C),16,511,B,y) :- negative(A). encode_test(functor(A,B,C),192,511,B,y) :- compound(A). encode_test(functor(A,B,C),252,511,B,y). encode_test(functor(A,B,C),32,511,C,y). encode_test(A=..B,255,511,A,y). encode_test(A=..B,2,511,B,y). encode_test(var(A),256,255,A,n). encode_test(nonvar(A),255,256,A,n). encode_test(ground(A),255,259,A,n). encode_test(atom(A),192,319,A,n). encode_test('$atom_nonnil'(A),128,383,A,n). encode_test(nil(A),64,447,A,n). encode_test(integer(A),48,463,A,n). encode_test(negative(A),16,495,A,n). encode_test(nonnegative(A),32,479,A,n). encode_test(number(A),60,451,A,n). encode_test(denumerable(A),240,271,A,n). encode_test(float(A),12,499,A,n). encode_test(atomic(A),252,259,A,n). encode_test(list(A),66,445,A,n). encode_test(cons(A),2,509,A,n). encode_test(structure(A),1,510,A,n). encode_test(compound(A),3,508,A,n). encode_test(simple(A),508,3,A,n). encode_test(A is B,60,255,A,y). encode_test(A,B,C,D,n) :- sign_flags(A,B,C,D). encode_test(A,48,48,B,n) :- fail, % \+float, \+sign_flags(A,C,D,E), arith_test(A,B,F). encode_test(A,60,60,B,n) :- true, % float, \+sign_flags(A,C,D,E), arith_test(A,B,F). encode_test(A,48,48,B,n) :- fail, % \+float, \+sign_flags(A,C,D,E), arith_test(A,F,B). encode_test(A,60,60,B,n) :- true, % float, \+sign_flags(A,C,D,E), arith_test(A,F,B). encode_test(A=B,C,D,A,y) :- type_flags(B,E,D), C is 0\/E. encode_test(A=B,C,D,B,y) :- type_flags(A,E,D), C is 0\/E. encode_test(A\=B,C,D,A,n) :- type_flags(B,E,C), D is 256\/E. encode_test(A\=B,C,D,B,n) :- type_flags(A,E,C), D is 256\/E. encode_test(A==B,C,D,A,n) :- type_flags(B,C,E), D is 256\/E. encode_test(A==B,C,D,B,n) :- type_flags(A,C,E), D is 256\/E. encode_test(A\==B,C,D,A,n) :- type_flags(B,D,E), C is 256\/E. encode_test(A\==B,C,D,B,n) :- type_flags(A,D,E), C is 256\/E. encode_test(not(A),B,C,D,E) :- nonvar(A), encode_test(A,C,B,D,E). encode_test(\+A,B,C,D,n) :- nonvar(A), encode_test(A,C,B,D,E). can_overlap(A,B,C,D,E,F,G) :- 0=\=B/\D. can_overlap(left,A,B,C,D,E,y) :- 0=\=256/\A. can_overlap(right,A,B,C,D,y,E) :- 0=\=256/\C. can_overlap(before,A,B,C,D,E,y) :- 0=\=256/\A. can_overlap(before,A,B,C,D,y,E) :- 0=\=256/\C. encode_name_arity('$test'(A,B),C,D,E,true) :- bitmap_name_arity(B,C,D,E). encode_name_arity(A=..B,B,'.',2,true). encode_name_arity(A=B,A,C,D,true) :- nonvar(B), functor(B,C,D). encode_name_arity(A=B,B,C,D,true) :- nonvar(A), functor(A,C,D). encode_name_arity(A==B,A,C,D,true) :- nonvar(B), functor(B,C,D). encode_name_arity(A==B,B,C,D,true) :- nonvar(A), functor(A,C,D). encode_name_arity(A=:=B,A,C,D,true) :- number(B), functor(B,C,D). encode_name_arity(A=:=B,B,C,D,true) :- number(A), functor(A,C,D). encode_name_arity(A=\=B,A,not(C),not(D),false) :- number(B), functor(B,C,D). encode_name_arity(A=\=B,B,not(C),not(D),false) :- number(A), functor(A,C,D). encode_name_arity(A\==B,A,not(C),not(D),false) :- atomic(B), functor(B,C,D). encode_name_arity(A\==B,B,not(C),not(D),false) :- atomic(A), functor(A,C,D). encode_name_arity(functor(A,B,C),A,B,C,true). encode_name_arity(functor(A,B,C),B,B,0,true) :- var(A). encode_name_arity(functor(A,B,C),B,D,0,true) :- nonvar(A), functor(A,D,E). encode_name_arity(functor(A,B,C),C,C,0,true) :- var(A). encode_name_arity(functor(A,B,C),C,D,0,true) :- nonvar(A), functor(A,E,D). encode_name_arity('$name_arity'(A,B,C),A,B,C,true). encode_name_arity(atom(A),A,A,0,true). encode_name_arity('$atom_nonnil'(A),A,A,0,true). encode_name_arity(nil(A),A,[],0,true). encode_name_arity(integer(A),A,A,0,true). encode_name_arity(negative(A),A,A,0,true). encode_name_arity(nonnegative(A),A,A,0,true). encode_name_arity(float(A),A,A,0,true). encode_name_arity(number(A),A,A,0,true). encode_name_arity(atomic(A),A,A,0,true). encode_name_arity(cons(A),A,'.',2,true). encode_name_arity(not(A),B,C,D,E) :- nonvar(A), \+invalid_negation(A), encode_name_arity(A,B,F,G,H), negate(F,C), negate(G,D), negate_boolean(H,E). check_name_arity(true,true,A,B,C,D) :- ( check_different(A,C) ; check_different(B,D) ), !. check_name_arity(true,false,A,B,C,D) :- check_different(A,C), check_different(B,D). check_name_arity(false,true,A,B,C,D) :- check_different(A,C), check_different(B,D). an_uninit_mode(uninit(A),mem,A). an_uninit_mode(uninit_reg(A),reg,A). an_uninit_mode(uninit(A,B),A,B) :- mem_reg(A). an_uninit_mode(uninit(A,B,C),A,B) :- mem_reg(A). u_implies_goal(unbound(A),A). u_implies_goal(uninit(any,A),A). u_implies_goal(deref(A),A). u_implies_goal(rderef(A),A). u_implies_goal(trail(A),A). u_implies_goal(trail_if_var(A),A). encode_test(A,B,C,D) :- encode_test(A,B,C,D,E). test_nobind(A) :- test(A), \+bind_test(A). bind_test(A=B). bind_test(A is B). bind_test(functor(A,B,C)). bind_test(A=..B). test_varset(A,B) :- test_varbag(A,C), sort(C,B). test_varbag(A,B) :- test_varbag(A,B,[]). test_varbag(A,B,C) :- encode_relop(A,D,E,F,G), filter_vars([D,F],B,C), !. test_varbag(A,B,C) :- encode_test(A,D,E,F,G), filter_vars([F],B,C), !. test_varbag(A,B,C) :- encode_name_arity(A,D,E,F,G), filter_vars([D],B,C), !. encode_relop('$name_arity'(A,B,C),A,2,B,unify) :- atomic(B), C==0. encode_relop(functor(A,B,C),A,2,B,unify) :- number(B), C==0. encode_relop(functor(A,B,C),A,2,B,unify) :- atom(B), C==0. encode_relop(functor(A,B,C),A,2,B,unify) :- var(B), C==0. encode_relop(functor(A,B,C),C,2,D,unify) :- nonvar(A), functor(A,E,D). encode_relop(functor(A,B,C),B,2,D,unify) :- nonvar(A), functor(A,D,E). encode_relop(A>B,A,1,B,arith). encode_relop(A@>B,A,1,B,stand). encode_relop(A=:=B,A,2,B,arith). encode_relop(A==B,A,2,B,stand). encode_relop(A=B,A,2,B,unify). encode_relop(A is B,A,2,B,arith). encode_relop(A>=B,A,3,B,arith). encode_relop(A@>=B,A,3,B,stand). encode_relop(A>2. get_relop(1,1,0). get_relop(1,2,3). get_relop(1,3,0). get_relop(1,4,3). get_relop(1,5,0). get_relop(1,6,3). get_relop(2,1,6). get_relop(2,2,5). get_relop(2,3,4). get_relop(2,4,3). get_relop(2,5,2). get_relop(2,6,1). get_relop(3,1,0). get_relop(3,2,1). get_relop(3,3,0). get_relop(3,4,3). get_relop(3,5,0). get_relop(3,6,1). get_relop(4,1,6). get_relop(4,2,6). get_relop(4,3,6). get_relop(4,4,0). get_relop(4,5,0). get_relop(4,6,0). get_relop(5,1,0). get_relop(5,2,2). get_relop(5,3,0). get_relop(5,4,0). get_relop(5,5,0). get_relop(5,6,0). get_relop(6,1,6). get_relop(6,2,4). get_relop(6,3,4). get_relop(6,4,0). get_relop(6,5,0). get_relop(6,6,0). test_relop(A,B,C) :- strong_compare(A,D,C), 0 is\(B)/\7/\D. bagof_get_relop(A,B,C) :- bagof(D,op_table(A,B,D),E), !, and_list(E,7,C). bagof_get_relop(A,B,0). and_list([],A,A). and_list([A|B],C,D) :- E is A/\C, and_list(B,E,D). op_table(A,B,0) :- lt(A), lt(B). op_table(A,B,6) :- lt(A), eq(B). op_table(A,B,6) :- lt(A), gt(B). op_table(A,B,3) :- eq(A), lt(B). op_table(A,B,5) :- eq(A), eq(B). op_table(A,B,6) :- eq(A), gt(B). op_table(A,B,3) :- gt(A), lt(B). op_table(A,B,3) :- gt(A), eq(B). op_table(A,B,0) :- gt(A), gt(B). lt(A) :- 4 is 4/\A. eq(A) :- 2 is 2/\A. gt(A) :- 1 is 1/\A. strong_compare(A,2,B) :- A==B, !. strong_compare(A,7,B) :- A\==B, var(A), !. strong_compare(A,7,B) :- A\==B, var(B), !. strong_compare(A,B,C) :- A\==C, nonvar(A), nonvar(C), !, functor(A,D,E), functor(C,F,G), weak_compare(E/D,H,G/F), ( H=2 -> strong_compare_args(1,E,A,B,C) ; B=H ). weak_compare(A,4,B) :- A@ B. strong_compare_args(A,B,C,2,D) :- A>B, !. strong_compare_args(A,B,C,D,E) :- A= D=H ; H=2 -> I is A+1, strong_compare_args(I,B,C,D,E) ; D=H ). get_type_test(A,B,'$test'(B,C)) :- get_type(A,B,511,C). get_type((A ',' B),C,D,E) :- !, get_type(A,C,D,F), get_type(B,C,F,E). get_type(A,B,C,D) :- encode_test(A,E,F,G,H), B==G, !, and_bits(E,C,D). get_type(A,B,C,C). get_tag(A,B,C) :- get_type(A,B,511,D), bitmap_type(D,E), tag(E,C). bitmap_type(256,var). bitmap_type(2,cons). bitmap_type(1,structure). bitmap_type(192,atom). bitmap_type(64,atom). bitmap_type(128,atom). bitmap_type(16,negative) :- fail. % split_integer. bitmap_type(32,nonnegative) :- fail. % split_integer. bitmap_type(48,integer) :- true. % \+split_integer. bitmap_type(16,integer) :- true. % \+split_integer. bitmap_type(32,integer) :- true. % \+split_integer. bitmap_type(12,float) :- true. % float. and_bits(A,B,C) :- C is A/\B. conj_test(A,B,'$test'(C,D)) :- encode_test(A,E,F,C,G), encode_test(B,H,I,J,K), C==J, !, D is E/\H. disj_test(A,B,'$test'(C,D)) :- encode_test(A,E,F,C,G), encode_test(B,H,I,J,K), C==J, !, D is E\/H. not_test(A,'$test'(B,C)) :- encode_test(A,D,C,B,E), !. bitmap_test(A,'$test'(B,C)) :- encode_test(A,C,D,B,E), !. merge_test(A,'$test'(B,C)) :- exact_bitmap(A,B,C), !. merge_test((A ',' B),C) :- merge_test(A,D), merge_test(B,E), !, conj_test(D,E,C). merge_test((A;B),C) :- merge_test(A,D), merge_test(B,E), !, disj_test(D,E,C). merge_test(\+A,B) :- merge_test(A,C), !, not_test(C,B). exact_bitmap(nonvar(A),A,255). exact_bitmap(atom(A),A,192). exact_bitmap(var(A),A,256). exact_bitmap(cons(A),A,2). exact_bitmap(structure(A),A,1). exact_bitmap(nil(A),A,64). exact_bitmap(A==B,A,64) :- B==[]. exact_bitmap(A==B,B,64) :- A==[]. exact_bitmap(negative(A),A,16). exact_bitmap(nonnegative(A),A,32). exact_bitmap(denumerable(A),A,240). exact_bitmap(float(A),A,12). exact_bitmap(simple(A),A,508). exact_bitmap(compound(A),A,3). exact_bitmap(list(A),A,66). exact_bitmap(atomic(A),A,252). exact_bitmap(number(A),A,60). exact_bitmap(integer(A),A,48). exact_bitmap('$atom_nonnil'(A),A,128). bitmap_simplify('$test'(A,0),fail). bitmap_simplify('$test'(A,511),true). bitmap_combine('$test'(A,B),C,D) :- bitmap_combine(C,A,B,D). bitmap_combine('$test'(A,B),C,D,'$test'(A,E)) :- C==A, !, E is B/\D. bitmap_combine((A ',' B),C,D,(E ',' B)) :- bitmap_combine(A,C,D,E), !. bitmap_combine((A ',' B),C,D,(A ',' E)) :- bitmap_combine(B,C,D,E), !. bitmap_name_arity(2,A,'.',2) :- !. bitmap_name_arity(64,A,[],0) :- !. bitmap_name_arity(A,B,B,0) :- A=\=0, A/\259=:=0. i2f_formula((A ',' B),C,(D ',' E)) :- !, i2f_formula(A,C,D), i2f_formula(B,C,E). i2f_formula((A;B),C,(D;E)) :- !, i2f_formula(A,C,D), i2f_formula(B,C,E). i2f_formula(not(A),B,not(C)) :- !, f2i_formula(A,B,C). i2f_formula('$test'(A,B),C,'$test'(A,D)) :- C==A, !, ( B/\48=\=0 -> E is B/\463, D is E\/12 ; D=B ). i2f_formula(integer(A),B,float(A)) :- B==A, !. i2f_formula(nonnegative(A),B,float(A)) :- B==A, !. i2f_formula(negative(A),B,float(A)) :- B==A, !. i2f_formula(denumerable(A),B,atomic(A)) :- B==A, !. i2f_formula(A=B,C,A=D) :- C==A, integer(B), !, D is float(B). i2f_formula(A=B,C,B=D) :- C==B, integer(A), !, D is float(A). i2f_formula(A==B,C,A==D) :- C==A, integer(B), !, D is float(B). i2f_formula(A==B,C,B==D) :- C==B, integer(A), !, D is float(A). i2f_formula(A=:=B,C,A==D) :- C==A, integer(B), !, D is float(B). i2f_formula(A=:=B,C,B==D) :- C==B, integer(A), !, D is float(A). i2f_formula(A,B,A). f2i_formula((A ',' B),C,(D ',' E)) :- !, f2i_formula(A,C,D), f2i_formula(B,C,E). f2i_formula((A;B),C,(D;E)) :- !, f2i_formula(A,C,D), f2i_formula(B,C,E). f2i_formula(not(A),B,not(C)) :- !, i2f_formula(A,B,C). f2i_formula('$test'(A,B),C,'$test'(A,D)) :- C==A, !, ( B/\12=\=0 -> E is B/\499, D is E\/48 ; D=B ). f2i_formula(float(A),B,integer(A)) :- B==A, !. f2i_formula(atomic(A),B,denumerable(A)) :- B==A, !. f2i_formula(A=B,C,A=D) :- C==A, !, D is integer(B). f2i_formula(A=B,C,B=D) :- C==B, !, D is integer(A). f2i_formula(A==B,C,A==D) :- C==A, !, D is integer(B). f2i_formula(A==B,C,B==D) :- C==B, !, D is integer(A). f2i_formula(A=:=B,C,A==D) :- C==A, !, D is integer(B). f2i_formula(A=:=B,C,B==D) :- C==B, !, D is integer(A). f2i_formula(A,B,A). test_to_disj('$test'(A,B),A,C) :- !, bitmap_to_disj(A,B,C). test_to_disj(A,B,C) :- exact_bitmap(A,B,D), bitmap_to_disj(B,D,C). bitmap_to_disj(A,B,C) :- bitmap_to_disj(B,B,A,C,fail). bitmap_to_disj(0,A,B,C,C) :- !. bitmap_to_disj(A,B,C,D,E) :- A=\=0, exact_bitmap(F,C,G), \+complex_bitmap(F), 0=:=G/\ \(B), H is A/\ \(G), H=\=A, !, di(F,D,I), bitmap_to_disj(H,B,C,I,E). bitmap_to_disj(A,B,C,D,D) :- error(['Could not convert bitmap ''',A,''' to a disjunction.',nl,'Replacing by fail.']). complex_bitmap(simple(A)). complex_bitmap(compound(A)). complex_bitmap(list(A)). complex_bitmap(atomic(A)). complex_bitmap(number(A)). complex_bitmap(denumerable(A)). complex_bitmap(integer(A)) :- fail. % split_integer. complex_bitmap(negative(A)) :- true. % \+split_integer. complex_bitmap(nonnegative(A)) :- true. % \+split_integer. exact_bitmap(A) :- exact_bitmap(A,B,C). exact_bitmap(A,B) :- exact_bitmap(A,C,B). ground_bag((A;B),C,D) :- !, ground_set(A,E), ground_set(B,F), intersectv(E,F,G), difflist(G,C,D). ground_bag((A ',' B),C,D) :- !, ground_bag(A,C,E), ground_bag(B,E,D). ground_bag(A,B,C) :- encode_relop(A,D,E,F,arith), !, 'C'(B,D,G), 'C'(G,F,C). ground_bag(A,B,C) :- encode_test(A,D,E,F,G), 0=:=D/\259, !, 'C'(B,F,C). ground_bag(ground(A),B,C) :- !, 'C'(B,A,C). ground_bag(A,B,B). nonvar_set(A,B) :- nonvar_bag(A,C,[]), sort(C,D), filter_vars(D,B). nonvar_bag((A;B),C,D) :- !, nonvar_set(A,E), nonvar_set(B,F), intersectv(E,F,G), difflist(G,C,D). nonvar_bag((A ',' B),C,D) :- !, nonvar_bag(A,C,E), nonvar_bag(B,E,D). nonvar_bag(A,B,C) :- encode_test(A,D,E,F,G), 0=:=D/\256, !, 'C'(B,F,C). nonvar_bag(A,B,B). deref_set(A,B) :- deref_bag(A,C,[]), sort(C,D), filter_vars(D,B). deref_bag((A;B),C,D) :- !, deref_set(A,E), deref_set(B,F), intersectv(E,F,G), difflist(G,C,D). deref_bag((A ',' B),C,D) :- !, deref_bag(A,C,E), deref_bag(B,E,D). deref_bag(rderef(A),B,C) :- !, 'C'(B,A,C). deref_bag(deref(A),B,C) :- !, 'C'(B,A,C). deref_bag(A,B,B). rderef_set(A,B) :- rderef_bag(A,C,[]), sort(C,D), filter_vars(D,E), simple_set(A,F), deref_set(A,G), intersectv(F,G,H), unionv(H,E,B). rderef_bag((A;B),C,D) :- !, rderef_set(A,E), rderef_set(B,F), intersectv(E,F,G), difflist(G,C,D). rderef_bag((A ',' B),C,D) :- !, rderef_bag(A,C,E), rderef_bag(B,E,D). rderef_bag(rderef(A),B,C) :- !, 'C'(B,A,C). rderef_bag(A,B,B). simple_set(A,B) :- simple_bag(A,C,[]), sort(C,D), filter_vars(D,B). atomic_set(A,B) :- atomic_bag(A,C,[]), sort(C,D), filter_vars(D,B). atomic_bag((A;B),C,D) :- !, atomic_set(A,E), atomic_set(B,F), intersectv(E,F,G), difflist(G,C,D). atomic_bag((A ',' B),C,D) :- !, atomic_bag(A,C,E), atomic_bag(B,E,D). atomic_bag(A,B,C) :- encode_relop(A,D,E,F,arith), !, 'C'(B,D,G), 'C'(G,F,C). atomic_bag(A,B,C) :- encode_test(A,D,E,F,G), 0=:=D/\259, !, 'C'(B,F,C). atomic_bag(A,B,B). simple_bag((A;B),C,D) :- !, simple_set(A,E), simple_set(B,F), intersectv(E,F,G), difflist(G,C,D). simple_bag((A ',' B),C,D) :- !, simple_bag(A,C,E), simple_bag(B,E,D). simple_bag(A,B,C) :- encode_relop(A,D,E,F,arith), !, 'C'(B,D,G), 'C'(G,F,C). simple_bag(A,B,C) :- encode_test(A,D,E,F,G), 0=:=D/\3, !, 'C'(B,F,C). simple_bag(A,B,B). subsuming_test(A,B,C,true) :- encode_test(A,D,E,F,n), type_test(C,F,B), encode_test(B,G,H,F,n), 0=:= \(G)/\D. subsuming_test(A,not(B),C,false) :- encode_test(A,D,E,F,n), type_test(C,F,B), encode_test(B,G,H,F,n), 0=:= \(H)/\D. sign_flags(A>B,C,D,A) :- number(B), B>=0, sign_bits(C,D). sign_flags(A>=B,C,D,A) :- number(B), B>=0, sign_bits(C,D). sign_flags(A=0, sign_bits(C,D). sign_flags(A==0, sign_bits(C,D). sign_flags(A>B,C,D,B) :- number(A), A=<0, sign_bits(D,C). sign_flags(A>=B,C,D,B) :- number(A), A<0, sign_bits(D,C). sign_flags(A=0, sign_bits(C,D). sign_flags(A=:=B,C,D,A) :- number(B), B>=0, sign_bits(C,D). sign_flags(A=:=B,C,D,B) :- number(A), A<0, sign_bits(D,C). sign_flags(A=:=B,C,D,A) :- number(B), B<0, sign_bits(D,C). type_flags(A,128,255) :- atom(A), A\==[]. type_flags(A,64,191) :- nil(A). type_flags(A,32,255) :- nonnegative(A). type_flags(A,16,255) :- negative(A). type_flags(A,8,255) :- float(A), A>=0. type_flags(A,4,255) :- float(A), A<0. type_flags(A,2,255) :- cons(A). type_flags(A,1,255) :- structure(A). sign_bits(A,B) :- ( true -> % float -> A=40, B=20 ; A=32, B=16 ). left_overlap(A,B,C,D) :- 0=\=A/\ (C\/ \(C\/D)). right_overlap(A,B,C,D) :- 0=\=C/\ (A\/ \(A\/B)). invalid_negation(A=..B). invalid_negation(A=B). invalid_negation(A\=B). invalid_negation(A==B) :- \+one_atomic(A,B). invalid_negation(A\==B) :- \+one_atomic(A,B). negate(A,B) :- nonvar(A), A=not(B), !. negate(A,not(A)) :- var(A), !. negate(A,not(A)) :- \+A=not(B), !. negate_boolean(true,false). negate_boolean(false,true). one_atomic(A,B) :- atomic(A). one_atomic(A,B) :- atomic(B). check_different(A,B) :- atomic(A), atomic(B), A\==B. check_different(A,B) :- nonvar(A), A=not(C), atomic(C), C==B. check_different(A,B) :- nonvar(B), B=not(C), atomic(C), A==C. ctest(A,B,C,C) :- ctest(A,B). ctest(A,B) :- prolog_implies(B,A). ctest(A,B,B) :- ctest(A,B). nonvartest(A,B) :- ctest(nonvar(A),B). vartest(A,B) :- ctest(var(A),B). rtest_in(A,B,C,D,E,F) :- rtest_in(A,B,C,G,D,E,F). rtest_in(A,B,C,C,D,E,F) :- core_rtest(A,B,D,C,G,no_update,E,F). core_rtest(A,B,C,D,E,F,G,H) :- \+prolog_implies(D,A), expand_test(A,I,B,D,C,G,H), var(I), !, update_choice(F,A,D,E). core_rtest(A,B,C,D,D,E,F,F). rtests_in(A,B,C,C,D,E,F) :- \+A= (G ',' H), !, rtest_in(A,B,C,D,E,F). rtests_in((A ',' B),C,D,D,E,F,G) :- !, rtest_in(A,C,D,E,F,H), rtests_in(B,C,D,I,E,H,G). rtest(A,B,C,D,E,F,G) :- core_rtest(A,B,E,C,D,update,F,G). rtest_in_deref(A,B,[pref,A,B|C],C,D,D,E,F) :- write_once, var(A), \+prolog_implies(D,deref(A)), !, 'C'(E,deref(A,B),F). rtest_in_deref(A,A,[A|B],B,C,C,D,E) :- \+write_once, !, 'C'(D,deref(A),E). rtest_in_deref(A,A,B,B,C,C,D,D). rtest_deref(A,B,[pref,A,B|C],C,D,E,F,G) :- write_once, var(A), \+prolog_implies(D,deref(A)), !, 'C'(F,deref(A,B),G), update_formula(deref(B),D,E). rtest_deref(A,A,[A|B],B,C,D,E,F) :- \+write_once, !, 'C'(E,deref(A),F), update_formula(deref(A),C,D). rtest_deref(A,A,B,B,C,C,D,D). update_formula(A,B,C) :- xupdate_formula(A,prolog,B,yes,D,C). rtests(A,B,C,D,E,F,G) :- \+A= (H ',' I), !, rtest(A,B,C,D,E,F,G). rtests((A ',' B),C,D,E,F,G,H) :- !, rtest(A,C,D,I,F,G,J), rtests(B,C,I,E,F,J,H). rtest_1(true,A,B,B,C,C) :- !. rtest_1(A,B,C,D,E,F) :- arg(1,A,G), rtest(A,G,C,D,B,E,F). rtests_1(A,B,C,D,E,F) :- \+A= (G ',' H), !, rtest_1(A,B,C,D,E,F). rtests_1((A ',' B),C,D,E,F,G) :- !, rtest_1(A,C,D,H,F,I), rtests_1(B,C,H,E,I,G). expand_test(deref(A),A,B,C,D,E,F) :- !, 'C'(E,deref(B,B),F). expand_test(trail(A),A,B,C,D,E,F) :- !, 'C'(E,trail(B),F). expand_test(trail_if_var(A),A,B,C,D,E,F) :- !, tag(var,G), 'C'(E,test(ne,G,B,H),I), 'C'(I,trail(B),J), 'C'(J,label(H),F). expand_test(nil(A),A,B,C,D,E,F) :- !, 'C'(E,equal(B,G^[],D),F), tag(atom,G). expand_test(A==B,A,C,D,E,F,G) :- atomic(B), !, atomic_word(B,H), 'C'(F,equal(C,H,E),G). expand_test(A==B,B,C,D,E,F,G) :- atomic(A), !, atomic_word(A,H), 'C'(F,equal(C,H,E),G). expand_test(negative(A),A,B,C,D,E,F) :- true, % \+split_integer, !, expand_test(integer(A),A,B,G,D,E,H), arith_test(I>=J,K), 'C'(H,jump(K,B,0,D),F). expand_test(nonnegative(A),A,B,C,D,E,F) :- true, % \+split_integer, !, expand_test(integer(A),A,B,G,D,E,H), arith_test(I 0, ( B\=='.' ; C\==2 ), ctest(nonvar(A),E,G,I), !, tag(atom,J,I,K), test_one_tag(structure(A),D,E,F,K,L), tag(structure,M), 'C'(L,pragma(tag(D,M)),N), O=1, % align(O), 'C'(N,pragma(align(D,O)),P), 'C'(P,equal([D],J^ (B/C),F),H). expand_test(functor(A,B,C),A,D,E,F,G,H) :- atom(B), integer(C), C==0, ctest(nonvar(A),E,G,I), !, tag(atom,J,I,K), 'C'(K,equal(D,J^B,F),H). expand_test(functor(A,B,C),A,D,E,F,G,H) :- number(B), integer(C), C==0, ctest(nonvar(A),E,G,I), !, 'C'(I,equal(D,B,F),H). expand_test('$name_arity'(A,B,C),A,D,E,F,G,H) :- atom(B), integer(C), B=='.', C==2, !, 'C'(G,test(ne,I,D,F),H), tag(cons,I). expand_test('$name_arity'(A,B,C),A,D,E,F,G,H) :- atom(B), integer(C), C>0, ( B\=='.' ; C\==2 ), !, tag(atom,I,G,J), test_one_tag(structure(A),D,E,F,J,K), tag(structure,L), 'C'(K,pragma(tag(D,L)),M), N=1, % align(N), 'C'(M,pragma(align(D,N)),O), 'C'(O,equal([D],I^ (B/C),F),H). expand_test('$name_arity'(A,B,C),A,D,E,F,G,H) :- atom(B), integer(C), C==0, !, tag(atom,I,G,J), 'C'(J,equal(D,I^B,F),H). expand_test('$name_arity'(A,B,C),A,D,E,F,G,H) :- number(B), integer(C), C==0, !, 'C'(G,equal(D,B,F),H). expand_test(A,B,C,D,E,F,G) :- test_to_disj(A,B,H), expand_test_disj(H,C,D,E,F,G). update_choice(no_update,A,B,B) :- !. update_choice(update,A,B,C) :- update_formula(A,B,C). rtest_m(A,B,C,D,E,F) :- rtest_m_nf(A,B,C,E,F), update_formula(A,C,D). rtest_m_nf(A,'$varlist'([]),fail,B,C) :- !, 'C'(B,fail,C). rtest_m_nf(A,B,C,D,E) :- expand(A,A,B,C,F,D,E). rtests_m(A,B,C,D,E,F) :- rtests_m_nf(A,B,C,E,F), update_formula(A,C,D). rtests_m_nf((A ',' B),(C ',' D),E,F,G) :- !, rtest_m_nf(A,C,E,F,H), rtests_m_nf(B,D,E,H,G). rtests_m_nf(A,B,C,D,E) :- rtest_m_nf(A,B,C,D,E). expand(true,true,true,A,A,B,B) :- !, true. expand(A,'$equal'(B,C),'$equal'(B,C),D,D,E,F) :- !, E=[equal(B,C,fail)|F], true. expand(A,B,'$varlist'([C]),D,D,E,F) :- arg(1,B,C), expand_test(A,C,D,E,F), !, true. expand(repeat,repeat,'$varlist'([]),A,A,B,C) :- !, B=[choice(1/2,[],D)|E], E=[label(D)|C], true. expand(A,fail,fail,B,B,C,D) :- !, C=[fail|D], true. expand(A==B,C==D,'$varlist'([C,D]),E,E,F,G) :- implies(E,(simple(A);simple(B))), !, F=[equal(C,D,fail)|G], true. expand(A\==B,C\==D,'$varlist'([C,D]),E,E,F,G) :- implies(E,(simple(A);simple(B))), !, F=[equal(C,D,H)|I], I=[fail|J], J=[label(H)|G], true. expand(A,'$cut_load'(B),'$varlist'([B]),C,C,D,E) :- !, D=[move(r(b),B)|E], true. expand(A,'$cut_deep'(B),'$varlist'([B]),C,C,D,E) :- !, D=[cut(B)|E], true. expand(A,'$cut_shallow'(B),'$varlist'([B]),C,C,D,E) :- !, D=[cut(B)|E], true. expand('$and'(A,B,C),'$and'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_integer(and,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$or'(A,B,C),'$or'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_integer(or,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$xor'(A,B,C),'$xor'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_integer(xor,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$sll'(A,B,C),'$sll'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_integer(sll,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$sra'(A,B,C),'$sra'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_integer(sra,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$not'(A,B),'$not'(C,D),'$varlist'(E),F,G,H,I) :- !, expand_integer(not,A,B,C,D,E,[],F,G,H,I), true. expand('$idiv'(A,B,C),'$idiv'(D,E,F),'$varlist'(G),H,I,J,K) :- expand_integer(div,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$mod'(A,B,C),'$mod'(D,E,F),'$varlist'(G),H,I,J,K) :- expand_integer(mod,A,B,C,D,E,F,G,[],H,I,J,K), true. expand(A,B,'$varlist'(C),D,E,F,G) :- arith_test(A,H,I,J), !, arith_test(B,K,L,M), expand_cmp(J,H,I,K,L,false,fail,C,[],D,E,F,G), true. expand('$add'(A,B,C),'$add'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_arith(add,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$sub'(A,B,C),'$sub'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_arith(sub,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$mul'(A,B,C),'$mul'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_arith(mul,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$fdiv'(A,B,C),'$fdiv'(D,E,F),'$varlist'(G),H,I,J,K) :- !, expand_force(div,float,A,B,C,D,E,F,G,[],H,I,J,K), true. expand('$if2f'(A,B),'$if2f'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- true, % float, implies(E,integer(A)), !, G=[i2f(C,D)|H], update_formula(float(B),E,F), true. expand('$if2f'(A,B),'$if2f'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- true, % float, implies(E,float(A)), !, G=[move(C,D)|H], update_formula(float(B),E,F), true. expand('$if2f'(A,B),'$if2f'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- true, % float, !, tag(integer,I), G=[test(ne,I,C,J)|K], K=[i2f(C,D)|L], L=[jump(M)|N], N=[label(J)|O], arith_error(not([float(A),C]),yes,i2f(C,D),E,P,O,Q), Q=[move(C,D)|R], R=[label(M)|H], update_formula(float(B),P,F), true. expand('$if2f'(A,B),'$if2f'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- fail, % \+float, !, warning(['Illegal use of function float(X): float option is disabled.']), arith_error(true,no,i2f(C,D),E,I,G,H), update_formula(fail,I,F), true. expand('$if2i'(A,B),'$if2i'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- true, % float, implies(E,float(A)), !, G=[f2i(C,D)|H], update_formula(integer(B),E,F), true. expand('$if2i'(A,B),'$if2i'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- true, % float, implies(E,integer(A)), !, G=[move(C,D)|H], update_formula(integer(B),E,F), true. expand('$if2i'(A,B),'$if2i'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- true, % float, !, tag(float,I), G=[test(ne,I,C,J)|K], K=[f2i(C,D)|L], L=[jump(M)|N], N=[label(J)|O], arith_error(not([integer(A),C]),yes,f2i(C,D),E,P,O,Q), Q=[move(C,D)|R], R=[label(M)|H], update_formula(integer(B),P,F), true. expand('$if2i'(A,B),'$if2i'(C,D),'$varlist'([pref,C,D]),E,F,G,H) :- fail, % \+float, !, arith_error(not([integer(A),C]),no,f2i(C,D),E,F,G,I), I=[move(C,D)|H], true. expand_test(A,B,C,D,E) :- expand_test(A,B,C,fail,D,E). expand_test(A,B,C,D,E,E) :- prolog_implies(C,A), !. expand_test(A,B,C,D,E,F) :- prolog_implies(C,not(A)), !, 'C'(E,jump(D),F). expand_test(A,B,C,D,E,F) :- expand_test(A,G,B,C,D,E,F). atomic_word(A,A) :- number(A), !. atomic_word(A,B^A) :- atom(A), !, term_tag(atom,B). test_one_tag(A,B,C,D,E,F) :- test_one_tag(ne,A,B,C,D,E,F). expand_test_disj(A,B,C,D,E,F) :- expand_test_disj(A,B,C,G,D,E,F). expand_test_disj(fail,A,B,C,D,E,F) :- 'C'(E,jump(D),G), 'C'(G,label(C),F). expand_test_disj((A;B),C,D,E,F,G,H) :- expand_test(A,C,D,I,G,J), 'C'(J,jump(E),K), 'C'(K,label(I),L), expand_test_disj(B,C,D,E,F,L,H). test_one_tag(A,B,C,D,E,F,G) :- tag(B,H,F,I), \+ctest(B,D), !, 'C'(I,test(A,H,C,E),G). test_one_tag(A,B,C,D,E,F,F). expand_integer(A,B,C,D,E,F,G,H,I,J,K,L,M) :- arith_instr(A,E,F,G,integer,N), H=[E|O], O=[F|P], P=[G|I], ( true -> % float -> Q=yes ; Q=no ), arith_error(not([integer(B),E])or not([integer(C),F]),Q,N,J,R,L,S), S=[N|M], update_formula(integer(B),R,T), update_formula(integer(C),T,U), update_formula(integer(D),U,K), true. expand_integer(A,B,C,D,E,F,G,H,I,J,K) :- arith_instr(A,D,L,E,integer,M), F=[D|N], N=[E|G], ( true -> % float -> O=yes ; O=no ), arith_error(not([integer(B),D]),O,M,H,P,J,Q), Q=[M|K], update_formula(integer(B),P,R), update_formula(integer(C),R,I), true. expand_cmp(A,B,C,D,E,F,G,H,I,J,K,L,M) :- fail, % \+float, !, arith_cmp(A,D,E,F,G,N), arith_error(not([integer(B),D])or not([integer(C),E]),no,N,J,O,L,P), P=[N|M], H=[D|Q], Q=[E|I], update_formula(integer(B),O,R), update_formula(integer(C),R,K), true. expand_cmp(A,B,C,D,E,F,G,H,I,J,J,K,L) :- true, % float, implies(J,(integer(B)',' integer(C))), !, arith_cmp(A,D,E,F,G,M), K=[M|L], H=[D|N], N=[E|I], true. expand_cmp(A,B,C,D,E,F,G,H,I,J,K,L,M) :- true, % float, implies(J,(float(B);float(C))), !, cond_to_float(A,N), arith_cmp(N,O,P,F,G,Q), convert2float(B,D,O,Q,H,R,J,S,L,T), convert2float(C,E,P,Q,R,U,S,V,T,W), arith_error(not([float(B),O])or not([float(C),P]),yes,Q,V,X,W,Y), Y=[Q|M], U=[O|Z], Z=[P|I], make_float_types([B,C],A1), update_formula(A1,X,K), true. expand_cmp(A,B,C,D,E,F,G,H,I,J,K,L,M) :- true, % float, !, tag(integer,N), cond_to_float(A,O), arith_cmp(A,D,E,F,G,P), arith_cmp(O,Q,R,F,G,S), L=[test(ne,N,D,T)|U], U=[test(ne,N,E,V)|W], W=[P|X], X=[jump(Y)|Z], Z=[label(V)|A1], convert2float(B,D,Q,S,H,B1,J,C1,A1,D1), D1=[jump(E1)|F1], F1=[label(T)|G1], convert2float(C,E,R,S,B1,H1,C1,I1,G1,J1), J1=[label(E1)|K1], arith_error(not([float(B),Q])or not([float(C),R]),yes,S,I1,K,K1,L1), L1=[S|M1], H1=[Q|N1], N1=[R|I], M1=[label(Y)|M], true. expand_arith(A,B,C,D,E,F,G,H,I,J,K,L,M) :- fail, % \+float, !, arith_instr(A,E,F,G,integer,N), arith_error(not([integer(B),E])or not([integer(C),F]),no,N,J,O,L,P), P=[N|M], H=[E|Q], Q=[F|R], R=[G|I], update_formula(integer(B),O,S), update_formula(integer(C),S,T), update_formula(integer(D),T,K), true. expand_arith(A,B,C,D,E,F,G,H,I,J,K,L,M) :- true, % float, implies(J,(integer(B)',' integer(C))), !, arith_instr(A,E,F,G,integer,N), L=[N|M], H=[E|O], O=[F|P], P=[G|I], update_formula(integer(D),J,K), true. expand_arith(A,B,C,D,E,F,G,H,I,J,K,L,M) :- true, % float, implies(J,(float(B);float(C))), !, arith_instr(A,N,O,G,float,P), convert2float(B,E,N,P,H,Q,J,R,L,S), convert2float(C,F,O,P,Q,T,R,U,S,V), arith_error(not([float(B),N])or not([float(C),O]),yes,P,U,W,V,X), X=[P|M], T=[N|Y], Y=[O|Z], Z=[G|I], make_float_types([B,C,D],A1), update_formula(A1,W,K), true. expand_arith(A,B,C,D,E,F,G,H,I,J,K,L,M) :- true, % float, !, tag(integer,N), arith_instr(A,E,F,G,integer,O), arith_instr(A,P,Q,G,float,R), L=[test(ne,N,E,S)|T], T=[test(ne,N,F,U)|V], V=[O|W], W=[jump(X)|Y], Y=[label(U)|Z], convert2float(B,E,P,R,H,A1,J,B1,Z,C1), C1=[jump(D1)|E1], E1=[label(S)|F1], convert2float(C,F,Q,R,A1,G1,B1,H1,F1,I1), I1=[label(D1)|J1], arith_error(not([float(B),P])or not([float(C),Q]),yes,R,H1,K,J1,K1), K1=[R|L1], G1=[P|M1], M1=[Q|N1], N1=[G|I], L1=[label(X)|M], true. expand_force(div,float,A,B,C,D,E,F,G,H,I,J,K,L) :- true, % float, !, arith_instr(div,M,N,F,float,O), convert2float(A,D,M,O,G,P,I,Q,K,R), convert2float(B,E,N,O,P,S,Q,T,R,U), arith_error(not([float(A),M])or not([float(B),N]),yes,O,T,V,U,W), W=[O|L], S=[M|X], X=[N|Y], Y=[F|H], make_float_types([A,B,C],Z), update_formula(Z,V,J), true. expand_force(div,float,A,B,C,D,E,F,G,H,I,J,K,L) :- fail, % \+float, !, warning(['Illegal use of X/Y: float option is disabled.']), arith_instr(div,D,E,F,float,M), arith_error(true,no,M,I,N,K,L), G=[D|O], O=[E|P], P=[F|H], update_formula(fail,N,J), true. arith_error(A,B,C,D,D,E,E) :- fail, % \+arith_error_check, !, true. arith_error(A,B,nop,C,C,D,D) :- !, true. arith_error(true,A,B,C,C,D,E) :- !, error_routine(B,F,G), D=[error_jump(F,G)|E], true. arith_error(not(A)or not(B),C,D,E,F,G,H) :- single_check(A,C,I,J,D,E,K,G,L), single_check(B,C,I,J,D,K,F,L,M), J==yes, !, M=[jump(N)|O], O=[label(I)|P], error_routine(D,Q,R), P=[error_jump(Q,R)|S], S=[label(N)|H], true. arith_error(not(A),B,C,D,E,F,G) :- single_check(A,B,H,I,C,D,E,F,J), I==yes, !, J=[jump(K)|L], L=[label(H)|M], error_routine(C,N,O), M=[error_jump(N,O)|P], P=[label(K)|G], true. arith_error(A,B,C,D,D,E,E). expand_cmp_det(A,B,C,D,E,F,G,H,I,J,K) :- expand_cmp(A,B,C,D,E,F,G,L,M,H,I,J,K), true. arith_cmp(A,B,C,D,E,F) :- arith_comparison(A,B,C,D,E,[F],[]). convert2float(A,B,B,C,D,D,E,E,F,F) :- implies(E,float(A)), !, true. convert2float(A,B,C,D,E,E,F,F,G,G) :- integer(B), !, C is float(B), true. convert2float(A,B,B,C,D,D,E,E,F,G) :- implies(E,integer(A)), !, F=[i2f(B,B)|G], true. convert2float(A,B,B,C,D,D,E,E,F,G) :- tag(integer,H), F=[test(ne,H,B,I)|J], J=[i2f(B,B)|K], K=[label(I)|G], true. make_float_types([],true). make_float_types([A|B],C) :- nonvar(A), !, make_float_types(B,C). make_float_types([A|B],(float(A)',' C)) :- var(A), !, make_float_types(B,C). arith_comparison(A,B,C,true,D,E,F) :- !, 'C'(E,jump(A,B,C,D),F). arith_comparison(A,B,C,false,D,E,F) :- !, cond(A,G), 'C'(E,jump(G,B,C,D),F). arith_instr(and,A,B,C,integer,and(A,B,C)). arith_instr(or,A,B,C,integer,or(A,B,C)). arith_instr(xor,A,B,C,integer,xor(A,B,C)). arith_instr(sll,A,B,C,integer,sll(A,B,C)). arith_instr(sra,A,B,C,integer,sra(A,B,C)). arith_instr(not,A,B,C,integer,not(A,C)). arith_instr(add,A,B,C,integer,add(A,B,C)). arith_instr(sub,A,B,C,integer,sub(A,B,C)). arith_instr(mul,A,B,C,integer,mul(A,B,C)). arith_instr(div,A,B,C,integer,div(A,B,C)). arith_instr(mod,A,B,C,integer,mod(A,B,C)). arith_instr(add,A,B,C,float,fadd(A,B,C)). arith_instr(sub,A,B,C,float,fsub(A,B,C)). arith_instr(mul,A,B,C,float,fmul(A,B,C)). arith_instr(div,A,B,C,float,fdiv(A,B,C)). smart_jump(A,B,C,D,D,E,E) :- implies(D,A), !, true. smart_jump(A,B,C,D,D,E,F) :- implies(D,not(A)), !, E=[jump(C)|F], true. smart_jump(A,B,C,D,D,E,F) :- tag_always(A,G), E=[test(ne,G,B,C)|F], true. make_integer_types([],true). make_integer_types([A|B],C) :- nonvar(A), !, make_integer_types(B,C). make_integer_types([A|B],(integer(A)',' C)) :- var(A), !, make_integer_types(B,C). arith_comparison(A,B,C,D,E) :- arith_comparison(A,B,C,false,fail,D,E). arith_comparison(A,B,C,D,E,F) :- arith_comparison(A,B,C,true,D,E,F). error_routine(jump(eq,A,B,C),'$ eq_error'/2,[A,B]). error_routine(jump(ne,A,B,C),'$ ne_error'/2,[A,B]). error_routine(jump(lts,A,B,C),'$ lt_error'/2,[A,B]). error_routine(jump(ges,A,B,C),'$ ge_error'/2,[A,B]). error_routine(jump(gts,A,B,C),'$ gt_error'/2,[A,B]). error_routine(jump(les,A,B,C),'$ le_error'/2,[A,B]). error_routine(jump(feq,A,B,C),'$ feq_error'/2,[A,B]). error_routine(jump(fne,A,B,C),'$ fne_error'/2,[A,B]). error_routine(jump(flts,A,B,C),'$ flt_error'/2,[A,B]). error_routine(jump(fges,A,B,C),'$ fge_error'/2,[A,B]). error_routine(jump(fgts,A,B,C),'$ fgt_error'/2,[A,B]). error_routine(jump(fles,A,B,C),'$ fle_error'/2,[A,B]). error_routine(add(A,B,C),'$ add_error'/2,[A,B]). error_routine(sub(A,B,C),'$ sub_error'/2,[A,B]). error_routine(mul(A,B,C),'$ mul_error'/2,[A,B]). error_routine(div(A,B,C),'$ div_error'/2,[A,B]). error_routine(mod(A,B,C),'$ mod_error'/2,[A,B]). error_routine(fadd(A,B,C),'$ fadd_error'/2,[A,B]). error_routine(fsub(A,B,C),'$ fsub_error'/2,[A,B]). error_routine(fmul(A,B,C),'$ fmul_error'/2,[A,B]). error_routine(fdiv(A,B,C),'$ fdiv_error'/2,[A,B]). error_routine(f2i(A,B),'$ int_error'/1,[A]). error_routine(i2f(A,B),'$ flt_error'/1,[A]). error_routine(not(A,B),'$ not_error'/1,[A]). error_routine(and(A,B,C),'$ and_error'/2,[A,B]). error_routine(or(A,B,C),'$ or_error'/2,[A,B]). error_routine(xor(A,B,C),'$ xor_error'/2,[A,B]). error_routine(sll(A,B,C),'$ sll_error'/2,[A,B]). error_routine(sra(A,B,C),'$ sra_error'/2,[A,B]). single_check([integer(A),B],C,D,E,div(F,G,H),I,J,K,L) :- B==G, !, divmod_check(integer(A),B,D,E,I,J,K,L), true. single_check([integer(A),B],C,D,E,mod(F,G,H),I,J,K,L) :- B==G, !, divmod_check(integer(A),B,D,E,I,J,K,L), true. single_check([float(A),B],C,D,E,fdiv(F,G,H),I,J,K,L) :- B==G, !, divmod_check(float(A),B,D,E,I,J,K,L), true. single_check([A,B],C,D,E,F,G,G,H,H) :- arg(1,A,I), do_nothing_check(C,G,I), !, true. single_check([A,B],C,D,yes,E,F,F,G,H) :- jump_if(ne,A,B,D,G,H), true. divmod_check(A,B,C,D,E,F,G,H) :- divmod_typecheck(A,B,C,D,E,I,G,J), get_typed_zero(A,K), divmod_zerocheck(A,B,C,D,K,I,F,J,H), true. do_nothing_check(yes,A,B) :- implies(A,number(B)), !. do_nothing_check(no,A,B) :- implies(A,integer(B)), !. jump_if(A,float(B),C,D,E,F) :- tag(float,G), 'C'(E,test(A,G,C,D),F). jump_if(A,integer(B),C,D,E,F) :- true, % \+split_integer, !, tag(integer,G), 'C'(E,test(A,G,C,D),F). jump_if(eq,integer(A),B,C,D,E) :- fail, % split_integer, !, tag(negative,F), tag(nonnegative,G), 'C'(D,test(eq,F,B,C),H), 'C'(H,test(eq,G,B,C),E). jump_if(ne,integer(A),B,C,D,E) :- fail, % split_integer, !, tag(negative,F), tag(nonnegative,G), 'C'(D,test(eq,G,B,H),I), 'C'(I,test(ne,F,B,C),J), 'C'(J,label(H),E). divmod_typecheck(A,B,C,D,E,E,F,F) :- implies(E,A), !, true. divmod_typecheck(A,B,C,yes,D,D,E,F) :- jump_if(ne,A,B,C,E,F), true. get_typed_zero(float(A),0.0). get_typed_zero(integer(A),0). divmod_zerocheck(A,B,C,D,E,F,F,G,G) :- arg(1,A,H), implies(F,H\==E), !, true. divmod_zerocheck(A,B,C,yes,D,E,E,F,G) :- F=[jump(eq,B,D,C)|G], true. sub(A,'$case'(B,C,D),'$case'(B,C,E),F,G) :- !, sub(A,D,E,F,G). sub(A,'$test'(B,C,D,E,F),'$test'(B,C,D,E,fail),prolog,G) :- mutex(A,D,left,prolog), !, stopflag(A,D,G). sub(A,'$test'(B,C,D,E,F),'$test'(B,C,D,E,fail),logical,G) :- mutex(A,D,after,logical), !, stopflag(A,D,G). sub(A,'$test'(B,C,D,E,F),'$test'(B,C,D,E,G),H,I) :- !, sub(A,F,G,H,I). sub(A,'$else'(B,C,D),'$else'(B,C,E),F,G) :- !, sub(A,D,E,F,G). sub(A,(B;C),(D;E),F,G) :- !, sub(A,B,D,F,H), sub(A,C,E,F,I), or(H,I,G). sub(A,(B ',' C),(D ',' E),F,G) :- !, sub(A,B,D,F,H), end_sub(H,A,C,E,F,G). sub(A,(B->C),(D->E),F,G) :- !, sub(A,B,D,F,H), end_sub(H,A,C,E,F,G). sub(A,\+B,\+C,D,false) :- !, sub(A,B,C,D,E). sub(A,not(B),not(C),D,E) :- !, sub(A,B,C,D,E). sub(A,B,C,D,E) :- sub_goal(A,B,C,D,E). logical_subsume(true,A,B) :- !, logical_simplify(A,B). logical_subsume(A,B,C) :- sub(A,B,D,logical,E), logical_simplify(D,C). subsume_list(A,[],[]). subsume_list(A,[B|C],[(D:-E)|F]) :- split(B,D,G), subsume(A,G,E), subsume_list(A,C,F). subdisj(A,B,C) :- sub(A,B,D,prolog,E), simplify(D,F), ( disj_p(F) -> C=F ; C= (F;fail) ). stopflag(A,B,C) :- binding_affected(A), \+test_nobind(B), !, C=true. stopflag(A,B,false). binding_affected((A ',' B)) :- binding_affected(A), !. binding_affected((A ',' B)) :- binding_affected(B), !. binding_affected((A;B)) :- binding_affected(A), !. binding_affected((A;B)) :- binding_affected(B), !. binding_affected(var(A)) :- !. binding_affected(deref(A)) :- !. binding_affected(rderef(A)) :- !. binding_affected(A) :- an_uninit_mode(A). an_uninit_mode(A) :- an_uninit_mode(A,B,C). end_sub(true,A,B,B,C,true). end_sub(false,A,B,C,D,E) :- sub(A,B,C,D,E). sub_goal(A,B,fail,prolog,C) :- mutex(A,B,left,prolog), !, stopflag(A,B,C). sub_goal(A,B,fail,logical,C) :- mutex(A,B,after,logical), !, stopflag(A,B,C). sub_goal(A,B,true,prolog,C) :- subsume_work(A,B,left), bindbag(B,A,[]), !, stopflag(A,B,C). sub_goal(A,B,true,logical,C) :- logical_subsume_work(A,B,after), !, stopflag(A,B,C). sub_goal(A,B,B,C,D) :- stopflag(A,B,D). subsume_work(A,B,C) :- memberv_conj(B,A), !. subsume_work(A,B,C) :- prolog_implies(A,B,C). bindbag(A,B,C) :- bindset(A,B,C). logical_subsume_work(A,B,C) :- memberv_conj(B,A), !. logical_subsume_work(A,B,C) :- implies(A,B,C). else(A,B,C) :- simplify(not(A),D), subsume(D,B,C). simp_upv(A,B,C) :- nonvar(A), !, simp_up(A,B,C). simp_upv(A,call(A),B) :- var(A), !. simpdisj(A,B) :- simplify(A,C), ( disj_p(C) -> B=C ; B= (C;fail) ). simp_up('$case'(A,B,C),D,E) :- !, simp_upv(C,F,E), simp_one('$case'(A,B,F),D,E). simp_up('$test'(A,B,C,D,E),F,G) :- !, simp_upv(E,H,G), simp_one('$test'(A,B,C,D,H),F,G). simp_up('$else'(A,B,C),D,E) :- !, simp_upv(C,F,E), simp_one('$else'(A,B,F),D,E). simp_up((A ',' B),C,D) :- !, simp_upv(A,E,D), simp_upv(B,F,D), simp_one((E ',' F),C,D). simp_up((A;B),C,D) :- !, simp_upv(A,E,D), simp_upv(B,F,D), simp_one((E;F),C,D). simp_up((A->B),C,D) :- !, simp_upv(A,E,D), simp_upv(B,F,D), simp_one((E->F),C,D). simp_up(\+A,B,C) :- !, simp_upv(A,D,C), simp_one(\+D,B,C). simp_up(not(A),B,C) :- !, simp_upv(A,D,C), simp_one(not(D),B,C). simp_up(A,B,C) :- simp_one(A,B,C). simp_one(not(not(A)),A,B). simp_one(not(A=B),A\=B,logical). simp_one(\+A=B,A\=B,logical). simp_one(not(A),B,C) :- opposite(A,B). simp_one(\+A,B,C) :- opposite(A,B). simp_one((A;B),A,prolog) :- A==B, diff_sol, no_side_effects(A). simp_one((A;B),A,logical) :- A==B. simp_one((A ',' B),A,prolog) :- A==B, deterministic(A), no_side_effects(A). simp_one((A ',' B),A,prolog) :- A==B, diff_sol, no_side_effects(A). simp_one((A ',' B),A,logical) :- A==B. simp_one((true ',' A),A,B). simp_one((A ',' true),A,B). simp_one((true;A),true,prolog) :- diff_sol, no_side_effects(A), no_bind(A). simp_one((true;A),true,logical). simp_one((A;true),true,prolog) :- diff_sol, no_side_effects(A), no_bind(A). simp_one((A;true),true,logical). simp_one((A ',' fail),fail,prolog) :- no_side_effects(A). simp_one((A ',' fail),fail,logical). simp_one((fail ',' A),fail,B). simp_one((fail;A),A,B). simp_one((A;fail),A,B). simp_one(('$cut_shallow'(A)',' B;C),('$cut_shallow'(A)',' B),prolog). simp_one(('$cut_deep'(A)',' B;C),('$cut_deep'(A)',' B),prolog). simp_one(('$cut_shallow'(A);B),'$cut_shallow'(A),prolog). simp_one(('$cut_deep'(A);B),'$cut_deep'(A),prolog). simp_one('$cut_shallow'(A),true,logical). simp_one('$cut_deep'(A),true,logical). simp_one((true->A;B),A,C). simp_one((fail->A;B),B,C). simp_one((A->true;B),A,prolog) :- deterministic(A), succeeds(A). simp_one((A->true;B),A,logical) :- succeeds(A). simp_one((A->fail;B),fail,prolog) :- no_side_effects(A), succeeds(A). simp_one((A->fail;B),fail,logical) :- succeeds(A). simp_one((A->B;C),C,prolog) :- no_side_effects(A), fails(A). simp_one((A->B;C),C,logical) :- fails(A). simp_one(not((A;B)),(not(A)',' not(B)),C). simp_one(A,fail,prolog) :- fails(A), no_side_effects(A). simp_one(A,fail,logical) :- fails(A). simp_one(A,true,prolog) :- diff_sol, succeeds(A), no_side_effects(A), no_bind(A). simp_one(A,true,logical) :- succeeds(A). simp_one(A,true,prolog) :- deterministic(A), succeeds(A), no_bind(A). simp_one(A,true,logical) :- succeeds(A). simp_one(deref(A),true,B) :- nonvar(A). simp_one('$case'(A,B,true),true,C). simp_one('$case'(A,B,fail),fail,C). simp_one('$test'(A,B,C,D,fail),fail,E). simp_one(A==B,'$name_arity'(A,B,0),prolog) :- var(A), atomic(B). simp_one(A==B,'$name_arity'(B,A,0),prolog) :- var(B), atomic(A). simp_one(functor(A,B,C),A=B,prolog) :- atomic(B), integer(C), C=:=0. simp_one(functor(A,B,C),A=D,prolog) :- atom(B), integer(C), C>=0, E=5, % compile_option(functor_limit(E)), C= =B). opp(A>B,A==B). opp(A@>B,A@= F=G ; F= (float(A)',' G) ). xupdate_formula(A,B,C,D,E,F) :- ( B=logical -> ( mutex(A,C,after) -> F=fail ; bitmap_combine(A,C,F) -> true ; F= (A ',' C) ) ; B=prolog -> ( var(D) -> extended_bindset(A,C,E,G) ; nonvar(D) -> extended_bindset(A,C,G) ), ( G=[] -> ( mutex(A,C,left,prolog) -> F=fail ; bitmap_combine(A,C,F) -> true ; F= (A ',' C) ) ; cons(G) -> split_formula(D,E,G,C,H,I), remove_vars(H,J), ( mutex(A,J,left,prolog) -> F=fail ; combine_formula((A ',' J),I,F) ) ; G=all -> remove_vars(C,J), ( mutex(A,J,left,prolog) -> F=fail ; F= (A ',' J) ) ) ). logical_update_formula(A,B,C) :- xupdate_formula(A,logical,B,yes,D,C). update_formula(A,B,C,D) :- xupdate_formula(A,prolog,C,E,B,D). remove_formula(A,B,C) :- an_uninit_mode(A,D,E), !, remove_uninit(D,[E],B,C). remove_formula(A,B,C) :- pred_exists(A,B), !, remove_form(A,B,D), flat_conj(D,C). remove_formula(A,B,B). extended_bindset(A=B,C,D,E) :- uninit_set(C,F), e_bindset(A,B,F,D,E), !. extended_bindset(A,B,C,D) :- bindset(A,E), grounds_in_form(B,F), diffv(E,F,D), disjointv(D,C), !. extended_bindset(A,B,C,all). extended_bindset(A=B,C,D) :- uninit_set(C,E), e_bindset(A,B,E,D), !. extended_bindset(A,B,C) :- bindset(A,D), grounds_in_form(B,E), diffv(D,E,C), C=[], !. extended_bindset(A,B,all). split_formula(A,B,C,D,E,F) :- vars_in_unify(C,D,G), % stats(x,data(A,C)), ( var(A) -> uninit_set(D,H), diffv(B,H,I), aliasing_flag(I,G,A) ; true ), notnonvar_ground_formula(D,J,K), % stats(x,data(notnv(J),notgnd(K))), split_form_vars(A,J,K,G,D,L,M), % stats(x,data(f1(L),sf1(M))), logical_simplify(L,N), % stats(x,data(f2(N))), flat_conj(N,O), % stats(x,data(f3(O))), squeeze_conj(O,E), % stats(x,6), flat_conj(M,F), % stats(x,7), !. remove_vars(A,B) :- remove_all_vars(A,C), notnonvar_ground_formula(A,D,E), remove_all_derefs(C,F,D,E), squeeze_conj(F,B), !. step_formula(A,B,C,D) :- extended_bindset(A,C,B,E), ( E=[] -> D=C ; cons(E) -> split_formula(F,B,E,C,G,H), remove_vars(G,I), combine_formula(I,H,D) ; E=all -> remove_vars(C,D) ). remove_all_vars((A ',' B),(C ',' D)) :- !, remove_all_vars(A,C), remove_all_vars(B,D). remove_all_vars(var(A),true) :- var(A), !. remove_all_vars(A,A). notnonvar_ground_formula(A,B,C) :- varset(A,D), nonvar_set(A,E), ground_set(A,F), diffv(D,E,B), diffv(D,F,C). remove_all_derefs((A ',' B),(C ',' D),E,F) :- !, remove_all_derefs(A,C,E,F), remove_all_derefs(B,D,E,F). remove_all_derefs(deref(A),true,B,C) :- var(A), inv(A,B), !. remove_all_derefs(rderef(A),B,C,D) :- var(A), inv(A,D), !, ( inv(A,C) -> B=true ; B=deref(A) ). remove_all_derefs(A,A,B,C). remove_uninit(A,(B ',' C),D,E) :- !, remove_uninit(A,B,D,F), remove_uninit(A,C,F,E). remove_uninit(A,B,C,C) :- an_uninit_mode(B,D,E), var(E), memberv(E,A), !. remove_uninit(A,B,C,D) :- co(B,C,D). remove_uninit(A,B,C,D) :- remove_uninit(A,B,C,E,true), flat_conj(E,D). pred_exists(A,(B ',' C)) :- pred_exists(A,B), !. pred_exists(A,(B ',' C)) :- pred_exists(A,C), !. pred_exists(A,B) :- A==B, !. remove_form(A,(B ',' C),(D ',' E)) :- !, remove_form(A,B,D), remove_form(A,C,E). remove_form(A,B,true) :- A==B, !. remove_form(A,B,B) :- !. split_from_formula(A,(B ',' C),(D ',' E),(F ',' G)) :- !, split_from_formula(A,B,D,F), split_from_formula(A,C,E,G). split_from_formula(A,B,true,B) :- varbag(B,C), memberv(A,C), !. split_from_formula(A,B,B,true) :- !. intersect_formula(A,B,C) :- intersect_formula(A,B,C,true). intersect_formula((A ',' B),C,D,E) :- !, intersect_formula(A,C,D,F), intersect_formula(B,C,F,E). intersect_formula(A,B,C,D) :- memberv_conj(A,B), !, co(A,C,D). intersect_formula(A,B,C,C). intersect_formula_list([A],A) :- !. intersect_formula_list([A|B],C) :- cons(B), !, intersect_formula_list(B,D), intersect_formula(A,D,C). union_formula(A,B,C) :- unionv_conj(A,B,C). split_deref((A ',' B),(C ',' D)) :- !, split_deref(A,C), split_deref(B,D). split_deref(deref(A),deref(A)) :- !. split_deref(rderef(A),rderef(A)) :- !. split_deref(A,true). split_formula(A,B,C,D,E) :- split_formula(F,A,B,C,D,E). uninit_set(A,B) :- uninit_bag(A,C), sort(C,B). aliasing_flag(A,B,C) :- disjointv(A,B), !, C=no. aliasing_flag(A,B,yes). split_form_vars(A,B,C,D,(E ',' F),(G ',' H),(I ',' J)) :- !, split_form_vars(A,B,C,D,E,G,I), split_form_vars(A,B,C,D,F,H,J). split_form_vars(A,B,C,D,E,F,G) :- split_one(A,B,C,D,E,F,G). split_one(A,B,C,D,true,true,true) :- !. split_one(A,B,C,D,fail,fail,true) :- !. split_one(yes,A,B,C,var(D),var(D),true) :- !. split_one(yes,A,B,C,deref(D),deref(D),true) :- inv(D,A), !. split_one(yes,A,B,C,deref(D),deref(D),deref(D)) :- !. split_one(yes,A,B,C,rderef(D),rderef(D),true) :- inv(D,B), !. split_one(yes,A,B,C,rderef(D),rderef(D),rderef(D)) :- !. split_one(A,B,C,D,E,true,E) :- varset(E,F), disjointv(F,D), !. split_one(A,B,C,D,E,E,true). notnonvar_formula(A,B) :- varset(A,C), nonvar_set(A,D), diffv(C,D,B). mem_reg(mem). mem_reg(reg). split_uninit((A ',' B),(C ',' D),(E ',' F)) :- !, split_uninit(A,C,E), split_uninit(B,D,F). split_uninit(A,A,true) :- an_uninit_mode(A), !. split_uninit(A,true,A). split_unbound((A ',' B),(C ',' D),(E ',' F)) :- !, split_unbound(A,C,E), split_unbound(B,D,F). split_unbound(var(A),var(A),true) :- !. split_unbound(A,A,true) :- an_uninit_mode(A), !. split_unbound(A,true,A). uninit_bag(A,B) :- uninit_bag(A,B,[]). uninit_bag((A ',' B),C,D) :- !, uninit_bag(A,C,E), uninit_bag(B,E,D). uninit_bag(A,B,C) :- an_uninit_mode(A,D,E), !, 'C'(B,E,C). uninit_bag(A,B,B). uninit_bag_type(A,B,C) :- uninit_bag_type(A,B,C,[]). uninit_bag_type(A,(B ',' C),D,E) :- !, uninit_bag_type(A,B,D,F), uninit_bag_type(A,C,F,E). uninit_bag_type(A,B,C,D) :- an_uninit_mode(B,A,E), !, 'C'(C,E,D). uninit_bag_type(A,B,C,C). unbound_set(A,B) :- unbound_bag(A,C), sort(C,B). unbound_bag(A,B) :- unbound_bag(A,B,[]). unbound_bag((A ',' B),C,D) :- !, unbound_bag(A,C,E), unbound_bag(B,E,D). unbound_bag(var(A),B,C) :- !, 'C'(B,A,C). unbound_bag(A,B,C) :- an_uninit_mode(A,D,E), !, 'C'(B,E,C). unbound_bag(A,B,B). remove_uninit(A,B,C) :- remove_uninit(A,B,D,true), flat_conj(D,C). remove_uninit(A,B,(C ',' D),E,F) :- !, remove_uninit(A,B,C,E,G), remove_uninit(A,B,D,G,F). remove_uninit(A,B,C,D,D) :- an_uninit_mode(C,A,E), memberv(E,B), !. remove_uninit(A,B,C,D,E) :- co(C,D,E). keep_uninit(A,(B ',' C),D,E) :- !, keep_uninit(A,B,D,F), keep_uninit(A,C,F,E). keep_uninit(A,B,C,C) :- an_uninit_mode(B,D,E), var(E), \+memberv(E,A), !. keep_uninit(A,B,C,D) :- co(B,C,D). remove_all_uninit(A,B) :- uninit_set(A,C), remove_uninit(C,A,B). e_bindset(A,B,C,D,E) :- is_new(A,C,D), is_new(B,C,D), !, E=[]. e_bindset(A,B,C,D,E) :- is_new(A,C,D), !, E=[A]. e_bindset(A,B,C,D,E) :- is_new(B,C,D), !, E=[B]. e_bindset(A,B,C,D) :- inv(A,C), inv(B,C), !, D=[]. e_bindset(A,B,C,D) :- inv(A,C), !, D=[A]. e_bindset(A,B,C,D) :- inv(B,C), !, D=[B]. is_new(A,B,C) :- var(A), \+inv(A,C), !. is_new(A,B,C) :- inv(A,B), !. bindset(A=B,C,D) :- uninit_set(C,E), ( inv(A,E), !, D=[A] ; inv(B,E), !, D=[B] ). bindset(A,B,C) :- bindset(A,D), nonvar_set(B,E), diffv(D,E,C). bindset(A=B,C,D,E) :- var(A), \+inv(A,D), !, E=[A]. bindset(A=B,C,D,E) :- var(B), \+inv(B,D), !, E=[B]. bindset(A,B,C,D) :- bindset(A,B,D). keylist_cls(A,B) :- extract_directives(A,C,D,E), first_namearity(C,F), keylist_cls(C,B,D,E,F). merge_cls([],[]). merge_cls(A,B) :- extract_merge(A,C,D,B,E,E,F), merge_cls(D,F). extract_directives([],[],A,A). extract_directives([A|B],C,D,E) :- directive(A), !, 'C'(D,A,F), extract_directives(B,C,F,E). extract_directives([A|B],[A|B],C,C). first_namearity([A|B],C/D) :- !, split(A,E,F), functor(E,C,D). first_namearity(A,B). keylist_cls([],A,B,C,D) :- ( B==C -> A=[] ; A=[key(3,E,end)-pair(B,C,F,F)] ). keylist_cls([A|B],[C-pair(D,E,[A|F],F)|G],D,E,H) :- split(A,I,J), functor(I,K,L), hash_name(K,L,M), ( K/L=H -> N=1 ; N=2 ), C=key(N,M,K/L), extract_directives(B,O,P,Q), keylist_cls(O,G,P,Q,H). hash_name(A,B,0). diff_sum([],A,A). diff_sum([A],B,C) :- add(A,B,C). diff_sum([A,B|C],D,E) :- add(A,D,F), sub(B,F,G), diff_sum(C,G,E). extract_merge([],A,[],B,B,C,C) :- !, true. extract_merge([key(A,B,C)-pair(D,E,F,G)|H],C,I,J,K,L,M) :- !, J=D, L=F, extract_merge(H,C,I,E,K,G,M), true. extract_merge([A-B|C],D,[A-B|C],E,E,F,F) :- !, true. expand_clauses([],[]). expand_clauses([A|B],[C|D]) :- expand_term(A,C), expand_clauses(B,D). translate_clauses([],[]). translate_clauses([A|B],[A|C]) :- directive(A), !, translate_clauses(B,C). translate_clauses([A|B],[(C:-D)|E]) :- split(A,C,F), translate(F,G), simplify(G,D), translate_clauses(B,E). cls_to_ptrees_loop(A,B) :- ( next_name(A,C,D,B,E), cls_to_proc(C,F,D,G) -> E=[ptree(D,G,H,[])|I], cls_to_ptrees_loop(F,I) ; B=A ). add_modes([]). add_modes([A|B]) :- directive(A), !, add_modes(B). add_modes([ptree(A/B,C,(D:-E),F)|G]) :- functor(D,A,B), ( require(D,H), before(D,I), combine_formula(H,I,E) ; E=true ), !, add_modes(G). next_name([A|B],C,D,E,F) :- directive(A), !, 'C'(E,A,G), next_name(B,C,D,G,F). next_name([A|B],[A|B],C/D,E,E) :- split(A,F,G), functor(F,C,D). cls_to_proc([],[],A,[]). cls_to_proc([A|B],C,D,E) :- split(A,F,G), functor(F,H,I), D=H/I, !, E=[A|J], cls_to_proc(B,C,D,J). cls_to_proc([A|B],[A|B],C,[]). top_expr(A,B,C,D) :- arith_eval(A,E), xtop_expr(E,B,C,D). expr(A,B,C,D) :- arith_eval(A,E), xexpr(E,B,C,D). translate_unify(A,B,C) :- nonvar(A), nonvar(B), functor(A,D,E), functor(B,D,E), !, translate_unify(A,B,1,E,C). translate_unify(A,B,fail) :- nonvar(A), nonvar(B), !. translate_unify(A,B,A=B) :- var(A), !. translate_unify(A,B,B=A) :- var(B), !. translate_unify(A,B,C,D,true) :- C>D, !. translate_unify(A,B,C,D,(E ',' F)) :- C= >B,[A,B],[C,D],E,F,G) :- !, co('$sra'(C,D,E),F,G). xexpr_list([],[],A,A). xexpr_list([A|B],[C|D],E,F) :- xexpr(A,C,E,G), xexpr_list(B,D,G,F). eval_args(A,B,C,D) :- A>B, !. eval_args(A,B,C,D) :- A=>B,C) :- integer(A), integer(B), C is A>>B. xor(A,B,C) :- C is A/\ \(B)\/ (B/\ \(A)). transform_cut_ptree(A,B) :- A=ptree(C,D,E,F), !, transform_cut_cls(D,G,H,I,J), K=ptree(C,G,E,L), transform_cut_ptrees(F,L), transform_2(J,H,K,B). transform_cut_ptree(A,A) :- directive(A), !. transform_cut_cls([],[],A,false,false). transform_cut_cls([A|B],[(C:-D)|E],F,G,H) :- split(A,C,I), standard_conj(I,J), transform_cut_conj(J,D,true,F,K,L,true,M), transform_cut_cls(B,E,F,N,O), or(K,N,G), or(L,O,H). transform_2(false,A,B,B) :- !. transform_2(true,A,B,C) :- B=ptree(D/E,F,(G:-H),I), gensym([36,99,117,116,95],D/E,J), K is E+1, dup_head(G,J,K,L,M), C=ptree(D/E,[(G:-'$cut_load'(L)',' M)],(G:-H),[N]), dup_head(G,J,K,A,O), replace_heads(F,P,J,K,A), N=ptree(J/K,P,(O:-H),I), add_mode_option(G,O,true,true,yes). dup_head(A,B,C,D,E) :- functor(A,F,G), functor(E,B,C), match_all(1,G,A,E), arg(C,E,D). replace_heads([],[],A,B,C). replace_heads([A|B],[(C:-D)|E],F,G,H) :- split(A,I,D), dup_head(I,F,G,H,C), replace_heads(B,E,F,G,H). match_all(A,B,C,D) :- A>B, !. match_all(A,B,C,D) :- A=B;C)) :- !. contains_if((A;B)) :- contains_if(B). transform_cut_disj(fail,fail,A,B,false,false,C). transform_cut_disj((A->B;C),(D;E),F,G,H,I,J) :- transform_cut_conj(A,D,K,F,L,M,J,N), insert_cut(N,G,K,O), transform_cut_conj(B,O,true,F,P,Q,N,R), transform_cut_disj(C,E,F,G,S,T,J), or(L,P,S,H), or(M,Q,T,I). transform_cut_disj((A;B),(C;D),E,F,G,H,I) :- transform_cut_conj(A,C,true,E,J,K,I,L), transform_cut_disj(B,D,E,F,M,N,I), or(J,M,G), or(K,N,H). insert_cut(true,A,('$cut_shallow'(A)',' B),B). insert_cut(false,A,('$cut_deep'(A)',' B),B). factor_dlist(ptree(A,B,C,D),ptree(A,B,C,E)) :- factor_ptrees(D,E). get_factor_args(ptree(A,B,(C:-D),E),F) :- a_head(B,G), functor(G,H,I), bagof(J,(range(1,J,I)',' test_arg(J,B)),F), !. get_factor_args(A,[]). factor_args_ptree([],A,A). factor_args_ptree([A|B],ptree(C,D,E,F),ptree(C,G,E,H)) :- factor_arg_cls(C,A,D,G,E,I,[]), factor_args_ptrees(B,I,H,F). factor_arg_cls(A,B,C,D,E,F,G) :- check_arity(C,B), get_arg(C,B,H), solution_order(H,I), collect_info(A,I,J,K), cons(J), check_heuristic(K), !, transform(C,1,B,J,D,L), keysort(L,M), collect_ptrees(M,B,E,F,G). factor_arg_cls(A,B,C,C,D,E,E). factor_args_ptrees(A,[],B,B). factor_args_ptrees(A,[B|C],[D|E],F) :- factor_args_ptree(A,B,D), factor_args_ptrees(A,C,E,F). check_arity([A|B],C) :- split(A,D,E), functor(D,F,G), C= H=[(S:-U)|X] ; H=X ), Y is C+1, transform(B,Y,D,G,X,J). transform([A|B],C,D,[E-F|G],[A|H],I) :- C E, !, J is C+1, transform(B,J,D,G,H,I). collect_ptrees([],A,B,C,C). collect_ptrees([A-B|C],D,E,F,G) :- B=info2(H,I,J), E= (K:-L), require(K,M), before(K,N), make_dformula((K:-M),A,H,D,I,(O:-P)), make_dformula((K:-N),A,H,D,I,(O:-Q)), flat_conj((P ',' Q),R), 'C'(F,ptree(A,[J|S],(O:-R),[]),T), add_mode_option(dummy_mode(O,P,Q)), collect_proc(C,A,U,S), collect_ptrees(U,D,E,T,G). adjacent_nontrivial([A-B,C-D|E]) :- msg(A,C,F), compound(F). adjacent_nontrivial([A|B]) :- adjacent_nontrivial(B). msg(A,B,C) :- nonvar(A), nonvar(B), !, ( functor(A,D,E), functor(B,D,E) -> A=..[D|F], B=..[D|G], msg_args(F,G,H), C=..[D|H] ; true ). msg(A,B,A) :- A==B, !. msg(A,B,C) :- \+A==B, !. a_head(A,B) :- member(C,A), split(C,B,D). test_arg(A,B) :- bagof(C-nop,D^ (a_head(B,D)',' arg(A,D,C)',' compound(C)),E), keysort(E,F), similar_args(F), !. similar_args([A-nop,B-nop|C]) :- similar(A,B), !. similar_args([A|B]) :- similar_args(B). similar(A,B) :- functor(A,C,D), functor(B,C,D). get_arg([],A,[],B). get_arg([A|B],C,[D-E|F],E) :- head_arg(C,A,D), G is E+1, get_arg(B,C,F,G). head_arg(A,B,C) :- ( B= (D:-E) -> arg(A,D,C) ; arg(A,B,C) ). collect_msg([],[]). collect_msg([A-B|C],D) :- collect_msg(C,A,[B],D). remove_single([],[]). remove_single([A|B],C) :- A=D-[E], !, remove_single(B,C). remove_single([A|B],[A|C]) :- \+A=D-[E], !, remove_single(B,C). list_clauses([],A,B,B). list_clauses([A-B|C],D,E,F) :- gensym([36,102,97,99,95],D,G), varset(A,H), length(H,I), expand_clauses(B,A,G,I,first,E,J), list_clauses(C,D,J,F). collect_msg([],A,B,[A-B]) :- compound(A), !. collect_msg([],A,B,[]) :- \+compound(A), !. collect_msg(A,B,C,D) :- \+compound(B), !, collect_msg(A,D). collect_msg([A-B|C],D,E,F) :- compound(D), msg(A,D,G), ( nonvar(G) -> collect_msg(C,G,[B|E],F) ; F=[D-E|H], collect_msg(C,A,[B],H) ). expand_clauses([],A,B,C,D,E,E). expand_clauses([A|B],C,D,E,F,G,H) :- copy(C,I), 'C'(G,A-info(I,D,E,F),J), expand_clauses(B,C,D,E,notfirst,J,H). calc_darity(A,B,C) :- functor(A,D,E), F is E+B-1, maximum(F,E,C). match_most(A,B,C,D,E) :- A>C, !. match_most(A,B,C,D,E) :- A=\=B, A= B, !. match_rest(A,B,C,D,E,F,G) :- A= K is B+1, arg(A,F,L), J=[L|M], end_fill_args(M,F,K), arg(A,E,N), I=[N|O], end_fill_args(O,E,K) ; true ). match_offset(A,B,C,D,E) :- A>B, !. match_offset(A,B,C,D,E) :- A=B, !. corr_args(A,B,C,D,E,F,G,H) :- A=B, !. msg_args(A,B,C,D,E) :- A= N=[O|P], arg(F,H,O), Q is K+1, end_fill_args(P,H,Q) ; true ), ( type_propagate(B,M,R) -> mode_propagate(N,R,I,B) ; I=B ). collect_proc([],A,[],[]). collect_proc([A|B],C,[A|B],[]) :- A=D-info2(E,F,G), H=info2(I,J,G), C\==D, !. collect_proc([A|B],C,D,[E|F]) :- A=C-info2(G,H,E), collect_proc(B,C,D,F). type_propagate(A,B,uninit) :- implies(A,uninit(B)), !. type_propagate(A,B,var) :- implies(A,var(B)), !. type_propagate(A,B,ground) :- implies(A,ground(B)), !. type_propagate(A,B,rderef) :- implies(A,rderef(B)), !. mode_propagate([],A,B,B) :- !. mode_propagate([A|B],C,D,E) :- one_propagate(C,A,D,F), mode_propagate(B,C,F,E). one_propagate(uninit,A,B,C) :- co(uninit(A),B,C), !. one_propagate(var,A,B,C) :- co(var(A),B,C), !. one_propagate(ground,A,B,C) :- co(ground(A),B,C), !. one_propagate(rderef,A,B,C) :- co(rderef(A),B,C), !. msg_args([],[],[]). msg_args([A|B],[C|D],[E|F]) :- msg(A,C,E), msg_args(B,D,F). ptree_to_stree(ptree(A,B,C,D),stree(A,(E:-F),(E:-G),H,I,J)) :- !, standard_cls(B,C,E,H,F), copy(C,(E:-G)), ptrees_to_strees(D,I). ptree_to_stree(A,A) :- directive(A), !. standard_cls([],A,B,[],fail). standard_cls([A|B],C,D,[E|F],(G;H)) :- expand_term(A,I), copy(I,J), standard_form(J,C,E,D,G), standard_cls(B,C,D,F,H). standard_form(A,B,C,D,E) :- split(A,C,F), simplify(F,G), unr_head(C,B,D,E,H), standard_conj(G,H). standard_form(A,B,C) :- split(A,B,D), simplify(D,E), standard_conj(E,C). unr_head(A,(B:-true),C,D,E) :- !, functor(A,F,G), downrange_list(G,1,H), match_unr(H,[],[],A,C,D,E). unr_head(A,(B:-C),D,E,F) :- functor(A,G,H), split_nonvars(1,C,B,A,H,I,[],J,[],K,[]), reverse(J,L), reverse(K,M), append(I,L,M,N), match_unr(N,K,I,A,D,E,F). conj((A ',' B),C,D) :- !, conj(A,C,E), conj(B,E,D). conj(true,A,A) :- !. conj(A,B,C) :- \+conj_p(A), inside_conj(A,B,C). disj((A;B),C,D) :- !, disj(A,C,E), disj(B,E,D). disj(fail,A,A) :- !. disj(A,B,C) :- \+disj_p(A), inside_disj(A,B,C). inside_conj(\+A,B,C) :- !, simplify(\+A,D), negation_as_failure_conj(D,B,C). inside_conj((A->B),C,D) :- !, conj(A,E,true), conj(B,F,true), co((E->F;fail),C,D). inside_conj(A,B,C) :- disj_p(A), !, disj(A,D,fail), co(D,B,C). inside_conj(A,B,C) :- \+disj_p(A), \+anyregs(A), !, co(A,B,C). inside_conj(A,B,C) :- \+disj_p(A), anyregs(A), !, unr_goal(A,B,C). inside_disj(\+A,B,C) :- !, simplify(\+A,D), negation_as_failure_disj(D,B,C). inside_disj((A->B),C,D) :- !, conj(A,E,true), conj(B,F,true), di((E->F),C,D). inside_disj(A,B,C) :- conj_p(A), !, conj(A,D,true), di(D,B,C). inside_disj(A,B,C) :- \+conj_p(A), !, co(A,D,true), di(D,B,C). negation_as_failure_disj(\+A,B,C) :- !, conj(A,D,true), di(((D->fail ',' true;true;fail)',' true),B,C). negation_as_failure_disj(A,B,C) :- disj(A,B,C). negation_as_failure_conj(\+A,B,C) :- !, conj(A,D,true), co((D->fail ',' true;true;fail),B,C). negation_as_failure_conj(A,B,C) :- conj(A,B,C). unr_goal(A,B,C) :- unr_goal(A,D,B,E), co(D,E,C). match_unr(A,B,C,D,E,F,G) :- functor(D,H,I), functor(E,H,I), match_unr(A,B,C,D,E,J,true,K,true,L,G), reverse_conj(J,M), reverse_conj(K,N), append_conj(M,N,L,F). split_nonvars(A,B,C,D,E,F,F,G,G,H,H) :- A>E, !, true. split_nonvars(A,B,C,D,E,F,G,H,I,J,K) :- A= true ; disj_exists(B) ). gather_single([],A) :- seal(A). gather_single([stree(A,(B:-C;fail),D,E,[],F)|G],H) :- length_test_user(C,I,J), K is I+J, K=<2, \+builtin(B), !, get(H,A,L), enter_def(L,info((B:-C),I,J),A), gather_single(G,H). gather_single([A|B],C) :- gather_single(B,C). inline_replace_strees([],[],A). inline_replace_strees([stree(A,(B:-C),D,E,F,G)|H],[stree(A,(B:-I),D,E,J,G)|K],L) :- inline_replace_disj(C,I,L), inline_replace_strees(F,J,L), inline_replace_strees(H,K,L). enter_def(A,B,C) :- var(A), !, B=A. enter_def(A,B,C) :- nonvar(A), !, warning(['The predicate ',C,' has multiple definitions.',nl,'Only the first definition will be used.']). inline_replace_disj(fail,fail,A). inline_replace_disj((A;B),(C;D),E) :- inline_replace_conj(A,F,E), flat_conj(F,C), inline_replace_disj(B,D,E). inline_replace_conj(true,true,A). inline_replace_conj((A ',' B),(A ',' C),D) :- test(A), !, inline_replace_conj(B,C,D). inline_replace_conj((A ',' B),(C ',' D),E) :- functor(A,F,G), fget(E,F/G,info(H,I,J)), !, copy(H,(A:-C)), ( J=:=0 -> inline_replace_conj(B,D,E) ; B=D ). inline_replace_conj((A ',' B),(A ',' B),C). complexity(A,A) :- fail, % compile_option(complexity), !, init_mult_strees(A,B), mult_strees(A,B,C,D,E,0,F), seal(E), comment(['Total complexity of program is ',F]), print_mult_strees(E,C). complexity(A,A). init_mult_strees(A,B) :- init_mult_strees(A,C,B), seal(B). mult_strees([],A,A,B,B,C,C). mult_strees([A|B],C,D,E,F,G,H) :- mult_stree(A,C,I,E,J,G,K), mult_strees(B,I,D,J,F,K,H), true. print_mult_strees(node(A,[B|C],D,E),node(A,F,G,H)) :- !, I is B+C, comment(['uc= ',B,' gc= ',C,' tc= ',I,' times_called= ',F,' pred= ',A]), print_mult_strees(D,G), print_mult_strees(E,H). print_mult_strees(leaf,leaf) :- !. print_mult_strees(A,B) :- !, error(['Mismatch in complexity measurement.']). mult_stree(stree(A,(B:-C),D,E,F,G),H,I,J,K,L,M) :- !, mult_disj(C,H,N,A,0,O,0,P), table_command(get(A,[P|Q]),J,R), S is L+P, T is S+O, mult_strees(F,N,I,R,K,T,M), Q is O+ (M-T), true. mult_stree(A,B,B,C,C,D,D) :- directive(A), !, true. mult_disj(fail,A,A,B,C,C,D,D). mult_disj((A;B),C,D,E,F,G,H,I) :- mult_conj_head(A,C,J,E,F,K,H,L), mult_disj(B,J,D,E,K,G,L,I), true. table_command(get(A,B),C,C) :- get(C,A,B). table_command(fget(A,B),C,C) :- fget(C,A,B). table_command(set(A,B),C,D) :- fset(C,A,B,D). table_command(add(A,B),C,D) :- get(C,A,E), includev(B,E,F), fset(C,A,F,D), !. mult_conj_head(true,A,A,B,C,C,D,D) :- !, true. mult_conj_head((A ',' B),C,D,E,F,G,H,I) :- test(A), !, J is H+1, mult_conj_head(B,C,D,E,F,G,J,I), true. mult_conj_head(A,B,C,D,E,F,G,G) :- mult_conj_body(A,B,C,D,E,F), true. mult_conj_body(true,A,A,B,C,C). mult_conj_body((A ',' B),C,D,E,F,G) :- mult_goal(A,C,H,E), I is F+1, mult_conj_body(B,H,D,E,I,G), true. mult_goal(A,B,C,D) :- functor(A,E,F), G=E/F, D\==G, table_command(fget(G,H),B,I), J is H+1, table_command(set(G,J),I,C), !, true. mult_goal(A,B,B,C). init_mult_strees([],A,A). init_mult_strees([A|B],C,D) :- init_mult_stree(A,C,E), init_mult_strees(B,E,D), true. init_mult_stree(stree(A,(B:-C),D,E,F,G),H,I) :- !, table_command(get(A,0),H,J), init_mult_strees(F,J,I), true. init_mult_stree(A,B,B) :- directive(A), !, true. set_command(sub(A),B,C) :- excludev(A,B,C). set_command(add(A),B,C) :- includev(A,B,C). set_command(sub_set(A),B,C) :- diffv(B,A,C). set_command(add_set(A),B,C) :- unionv(A,B,C). create_mode_strees(A,B,C,D,E) :- create_mode_strees(A,B,C,D,E,top). create_mode_strees([],[],A,B,C,D) :- !. create_mode_strees([A|B],[C|D],E,F,G,H) :- create_mode_stree(A,C,E,F,G,H), create_mode_strees(B,D,E,F,G,H). create_mode_stree(stree(A,B,(C:-D),E,F,G),stree(A,B,(C:-H),E,I,G),J,K,L,M) :- !, lattice_modes_table(A,J,C,N), lattice_modes_table(A,K,C,O), new_formula(C,N,O,B,L,P,Q,R), add_mode_option(analyze_mode(C,P,Q,R)), flat_conj((P ',' Q),H), write_mode(M,C), create_mode_strees(F,I,J,K,L,nontop). create_mode_stree(A,A,B,C,D,E) :- directive(A). lattice_modes_table(A/B,C,D,E) :- functor(D,A,B), get(C,A/B,F), lattice_modes_call(1,B,F,D,mem,E,true). new_formula(A,B,C,D,E,F,G,H) :- require(A,I), before(A,J), split_unbound(I,K,L), combine_formula(K,J,M), update_mode(B,M,A,N), squeeze_conj(N,O), convert_uninit(D,E,O,P), split_uninit(P,Q,G), logical_subsume(B,L,R), combine_formula(Q,R,F), after(A,S), update_mode(C,S,A,T), squeeze_conj(T,H). write_mode(top,A) :- fail, % \+compile_option(compile), !, require(A,B), before(A,C), after(A,D), survive(A,E), w(':- '), inst_writeq(mode(A,B,C,D,E)), wn('.'). write_mode(A,B) :- fail, % \+compile_option(compile), !, require(B,C), before(B,D), after(B,E), survive(B,F), w('% '), inst_writeq(mode(B,C,D,E,F)), nl. write_mode(A,B) :- true, % compile_option(compile), !, require(B,C), before(B,D), after(B,E), survive(B,F), w('% '), inst_writeq(mode(B,C,D,E,F)), nl. update_mode(A,fail,B,fail) :- !. update_mode(fail,A,B,fail) :- !. update_mode(A,true,B,A) :- !. update_mode(true,A,B,A) :- !. update_mode((A ',' B),C,D,E) :- !, update_one(A,C,D,F), update_mode(B,F,D,E). convert_uninit((A:-B),C,D,E) :- compile_option(analyze_uninit_reg), !, functor(A,F,G), get(C,F/G,H), convert_form(D,E,H). convert_uninit(A,B,C,C). update_one(fail,A,B,fail) :- !. update_one(ground(A),B,C,D) :- implies(B,unbound(A)), !, incorrect_mode(A,C,ground(A),B,D). update_one(nonvar(A),B,C,D) :- implies(B,unbound(A)), !, incorrect_mode(A,C,nonvar(A),B,D). update_one(uninit(A),B,C,D) :- implies(B,nonvar(A)), !, incorrect_mode(A,C,uninit(A),B,D). update_one(uninit_reg(A),B,C,D) :- implies(B,nonvar(A)), !, incorrect_mode(A,C,uninit_reg(A),B,D). update_one(ground(A),B,C,B) :- pred_exists(ground(A),B), !. update_one(nonvar(A),B,C,B) :- pred_exists(nonvar(A),B), !. update_one(uninit(A),B,C,B) :- pred_exists(uninit(A),B), !. update_one(uninit_reg(A),B,C,B) :- pred_exists(uninit_reg(A),B), !. update_one(rderef(A),B,C,B) :- pred_exists(rderef(A),B), !. update_one(uninit(A),B,C,D) :- pred_exists(var(A),B), !, D= (uninit(A)',' E), split_from_formula(A,B,E,F), squeeze_conj(F,G), warning(C,['Mode ',G,' of ',C,' replaced by ',uninit(A)]). update_one(uninit_reg(A),B,C,D) :- pred_exists(var(A),B), !, D= (uninit_reg(A)',' E), split_from_formula(A,B,E,F), squeeze_conj(F,G), warning(C,['Mode ',G,' of ',C,' replaced by ',uninit_reg(A)]). update_one(ground(A),B,C,(ground(A)',' B)) :- !. update_one(nonvar(A),B,C,(nonvar(A)',' B)) :- !. update_one(uninit(A),B,C,(uninit(A)',' B)) :- !. update_one(uninit_reg(A),B,C,(uninit_reg(A)',' B)) :- !. update_one(rderef(A),B,C,(rderef(A)',' B)) :- !. incorrect_mode(A,B,C,D,(C ',' E)) :- split_from_formula(A,D,E,F), squeeze_conj(F,G), warning(B,['Mode ',G,' of ',B,' is incorrect.',nl,'Compilation continued with corrected mode ',C]). convert_form((A ',' B),(C ',' D),E) :- !, convert_form(A,C,E), convert_form(B,D,E). convert_form(uninit(A),uninit_reg(A),B) :- inv(A,B), !. convert_form(uninit_mem(A),uninit_reg(A),B) :- inv(A,B), !. convert_form(A,A,B). convert_uninit_strees(A,B,C,D,E) :- compile_option(analyze_uninit_reg), !, % stats(a,1), init_convert(A,B,F,G,H), % stats(a,2), convert_closure(F,C,I,D,J,G,K,H,E). convert_uninit_strees(A,B,C,D,E) :- seal(E). init_convert(A,B,C,D,E) :- init_convert_strees(A,B,F,C,[],G,D,H,E), seal(D), seal(E). convert_closure([],A,A,B,B,C,C,D,D). convert_closure(A,B,C,D,E,F,G,H,I) :- cons(A), !, % stats(a,3), conv_preds(A,B,J,F,K,H,L,[],M), % stats(a,4), length(M,N), comment(['Uninit(reg) conversion pass--changed ',N,' predicates.']), new_preds(M,D,O,[],P), convert_closure(P,J,C,O,E,K,G,L,I), true. conv_preds([],A,A,B,B,C,C,D,D). conv_preds([A|B],C,D,E,F,G,H,I,J) :- table_command(fget(A,K),G,L), table_command(fget(A,(M:-N)),C,O), % stats(a,data4(A)), calc_convert_set(N,M,A,O,P,E,Q,L,R,I,S,K,T), % stats(a,5), update_ureg(A,K,T,R,U,S,V), % stats(a,6), conv_preds(B,P,D,Q,F,U,H,V,J), true. new_preds([],A,A,B,B) :- !, true. new_preds([entry(A)|B],C,D,E,F) :- !, set_command(add(A),E,G), new_preds(B,C,D,G,F), true. new_preds([exit(A)|B],C,D,E,F) :- table_command(fget(A,G),C,H), !, set_command(add_set(G),E,I), new_preds(B,H,D,I,F), true. new_preds([A|B],C,D,E,F) :- new_preds(B,C,D,E,F), true. calc_convert_set(fail,A,B,C,C,D,D,E,E,F,F,G,G) :- !, true. calc_convert_set((A;B),C,D,E,F,G,H,I,J,K,L,M,N) :- cons(M), split_conj_begin_end(A,O,P), last_conj(P,Q), !, varset(O,R), set_command(sub_set(R),M,S), term_dupset(P,T), set_command(sub_set(T),S,U), % stats(a,data7(D)), last_goal_ureg(Q,C,D,E,V,G,W,I,X,K,Y,U,Z), % stats(a,8), update_fast_goal(Q,C,D,V,A1,W,B1,X,C1,Y,D1), % stats(a,9), calc_convert_set(B,C,D,A1,F,B1,H,C1,J,D1,L,Z,N), true. calc_convert_set((A;B),C,D,E,E,F,F,G,G,H,H,I,I). update_ureg(A,B,C,D,E,F,G) :- B\==C, !, table_command(set(A,C),D,E), set_command(add(exit(A)),F,G), true. update_ureg(A,B,C,D,D,E,E). split_conj_begin_end(true,true,true). split_conj_begin_end((A ',' B),true,(A ',' B)) :- all_survive(B), !. split_conj_begin_end((A ',' B),(A ',' C),D) :- split_conj_begin_end(B,C,D). term_dupset(A,B) :- term_dupset_varbag(A,B,C). last_goal_ureg(A,B,C,D,D,E,E,F,F,G,G,H,H) :- survive(A), !, true. last_goal_ureg(A,B,C/D,E,F,G,G,H,I,J,J,K,L) :- cons(K), functor(A,M,N), table_command(fget(M/N,O),H,I), table_command(fget(M/N,(P:-Q)),E,F), !, % stats(a,data10(M/N,P,A,O)), map_args(P,O,A,R), % stats(a,11), % stats(a,data12(R)), intersectv(R,K,S), % stats(a,13), min_integer(N,D,T), % stats(a,data14(N,D,T)), match_corresponding_args(1,T,B,A,S,L), % stats(a,15), true. last_goal_ureg(A,B,C,D,D,E,E,F,F,G,G,H,[]) :- H=I, true. update_fast_goal(A,B,C/D,E,F,G,H,I,J,K,L) :- \+survive(A), functor(A,M,N), table_command(fget(M/N,O),G,H), table_command(fget(M/N,P),I,Q), table_command(fget(M/N,(R:-S)),E,F), !, map_args(R,P,A,T), min_integer(N,D,U), match_corresponding_args(1,U,B,A,T,V), map_args(A,V,R,W), update_ureg(M/N,P,W,Q,J,K,L), true. update_fast_goal(A,B,C,D,D,E,E,F,F,G,G). map_args(A,B,C,D) :- functor(A,E,F), map_args(1,F,A,B,C,G,[]), sort(G,D). match_corresponding_args(A,B,C,D,E,[]) :- A>B, !. match_corresponding_args(A,B,C,D,E,F) :- A= true ; F=[] ), filter_defs(F,C,G,B), entry_zero(A,H,G), sort(H,D). filter_defs([],[],[],A). filter_defs([A|B],[A|C],[D/E|F],G) :- A=entry(H,I,J,K,L,M), functor(H,D,E), get(G,D/E,N), !, filter_defs(B,C,F,G). filter_defs([A|B],C,D,E) :- filter_defs(B,C,D,E). entry_zero([],A,A). entry_zero([stree(A/0,B,C,D,E,F)|G],H,I) :- !, 'C'(H,A/0,J), entry_zero(G,J,K), entry_zero(E,K,I). entry_zero([stree(A/B,C,D,E,F,G)|H],I,J) :- B>0, !, entry_zero(H,I,K), entry_zero(F,K,J). entry_zero([A|B],C,D) :- entry_zero(B,C,D). entry_data(entry(A,B,C,D,E,F)) :- compile_option(entry(A,G)), varset(A,B), ground_set(G,C), nonvar_set(G,D), uninit_set(G,E), rderef_set(G,F). entry_init([],A,A). entry_init([A|B],C,D) :- entry_init_one(A,C,E), entry_init(B,E,D), true. entry_init_one(entry(A,B,C,D,E,F),G,H) :- update_entry(A,I,J,G,H,[],K,C,L,D,M,E,N,F,O,B,P), true. update_entry(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) :- calc_entry(A,R,H,I,J,K,L,M,N,O,P,Q), functor(A,S,T), table_command(fget(S/T,U),D,V), lub_call(U,R,B), update_entry(S/T,U,B,C,V,E,F,G), true. analyze(A,B) :- % stats(an,1), init_tables(A,C,D,E,F), entry_data(A,E,G,H), cons(H), !, entry_init(G,C,I), % stats(an,2), analyze_closure(H,I,J,D,K,E,L,M,N,F,O), % stats(an,3), seal(N), spec_strees(A,P,N), % stats(an,4), convert_uninit_strees(P,J,E,F,Q), % stats(an,5), wn('% Modes generated:'), create_mode_strees(P,R,J,K,Q), % stats(an,6), re_unr_strees(R,B). % stats(an,7). analyze(A,A) :- warning(['There are no usable entry points, so no flow analysis was done.']). analyze_closure([],A,A,B,B,C,C,D,D,E,E) :- !, true. analyze_closure(A,B,C,D,E,F,G,H,I,J,K) :- cons(A), !, trav_preds(A,B,L,D,M,F,N,H,O,[],P), % stats(an,'2_5'), length(P,Q), comment(['Analysis pass--changed ',Q,' entry and exit modes.']), new_preds(P,J,R,[],S), analyze_closure(S,L,C,M,E,N,G,O,I,R,K), true. spec_strees([],[],A). spec_strees([A|B],[C|D],E) :- spec_stree(A,C,E), spec_strees(B,D,E). trav_preds([],A,A,B,B,C,C,D,D,E,E) :- !, true. trav_preds([A|B],C,D,E,F,G,H,I,J,K,L) :- table_command(fget(A,M),C,N), no_bottom(A,M), table_command(fget(A,O),G,P), !, copy(O,(Q:-R)), % stats(trav_pred,A), trav_pred(R,Q,M,A,N,S,E,T,P,U,I,V,K,W,[],X,[],Y,[],Z,[],A1,[],B1), trav_preds(B,S,D,T,F,U,H,V,J,W,L), true. trav_preds([A|B],C,D,E,F,G,H,I,J,K,L) :- trav_preds(B,C,D,E,F,G,H,I,J,K,L), true. no_bottom(A/B,C) :- bottom(D), no_bottom(B,C,D). trav_pred(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X) :- new_sets(B,C,O,Y,Q,Z,S,A1,U,B1,W,C1), trav_disj(A,B,D,1,[],D1,E1,F1,E,F,G,G1,I,J,K,L,M,H1,Y,I1,Z,J1,A1,T,B1,K1,C1,L1), set_command(add_set(D1),I1,M1), set_command(add_set(E1),J1,N1), intersectv(B1,Y,O1), unionv(O1,F1,P1), K1=Q1, update_exit(B,G1,H,H1,N,M1,P,N1,R,F1,V,L1,X), true. bottom(unknown). no_bottom(0,A,B) :- !. no_bottom(A,B,C) :- A>0, arg(A,B,D), D\==C, E is A-1, no_bottom(E,B,C). new_sets(A,B,C,D,E,F,G,H,I,J,K,L) :- C=M, E=N, G=O, I=P, K=Q, get_argvars(ground,A,B,D), get_args(nonvar,A,B,F), get_argvars(uninit,A,B,H), get_argvars(rderef,A,B,J), varset(A,L), true. trav_disj(fail,A,B,C,D,E,E,E,F,F,G,G,H,H,I,I,J,J,K,K,L,L,M,M,N,N,O,O) :- !, varset(A,E), true. trav_disj((A;B),C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,A1,B1,C1) :- member(caller(D,E),F), !, D1 is E+1, trav_disj(B,C,D,D1,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,A1,B1,C1), true. trav_disj((A;B),C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,A1,B1,C1) :- save_sets(D1,T,E1,V,F1,X,G1,Z,H1,B1,I1), term_dupset(A,J1), % stats(trav_conj,d(D,E)), trav_conj(A,D,E,1,[caller(D,E)|F],J,K1,L,L1,N,M1,P,N1,R,O1,E1,P1,F1,Q1,G1,R1,H1,S1,I1,T1,U1,[],J1), back_propagate(U1,P1,V1,Q1,W1,S1,X1), restore_sets(D1,V1,Y1,W1,Z1,R1,A2,X1,B2,T1,C2), D2 is E+1, trav_disj(B,C,D,D2,F,E2,F2,G2,K1,K,L1,M,M1,O,N1,Q,O1,S,Y1,U,Z1,W,A2,Y,B2,A1,C2,C1), intersectv(V1,E2,G), intersectv(W1,F2,H), intersectv(X1,G2,I), true. update_exit(A,B,C,D,E,F,G,H,I,J,K,L,L) :- functor(A,M,N), table_command(fget(M/N,O),B,P), !, calc_exit(A,Q,F,G,H,I,J,K), lub_call(O,Q,R), update_exit(M/N,O,R,P,C,D,E), true. update_exit(A,B,B,C,C,D,D,E,E,F,F,G,G). save_sets(state(A,B,C,D,E),A,A,B,B,C,C,D,D,E,E). trav_conj(true,A,B,C,D,E,E,F,F,G,G,H,H,I,I,J,J,K,K,L,L,M,N,O,O,P,P,Q) :- !, set_command(add_set(L),M,N), true. trav_conj((A ',' B),C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,A1,B1,C1) :- varset(A,D1), % stats(trav_goal,d(C,D,E)), trav_goal(A,C,D,E,F,D1,G,E1,I,F1,K,G1,M,H1,O,I1,Q,J1,S,K1,U,L1,W,M1,Y,N1,A1,O1,C1), P1 is E+1, trav_conj(B,C,D,P1,F,E1,H,F1,J,G1,L,H1,N,I1,P,J1,R,K1,T,L1,V,M1,X,N1,Z,O1,B1,C1), true. back_propagate(A,B,C,D,E,F,G) :- back_prop_d_cl(A,F,G), back_prop_g_cl(A,B,C), set_command(add_set(C),D,H), back_prop_n_cl(A,H,E), true. restore_sets(state(A,B,C,D,E),F,A,G,B,H,C,I,D,J,E) :- F=K, G=L, H=M, I=N, J=O, true. back_prop_d_cl(A,B,C) :- back_prop_d(A,D,B,E,0,F), back_prop_d_cl(F,D,E,C), true. back_prop_g_cl(A,B,C) :- back_prop_g(A,D,B,E,0,F), back_prop_g_cl(F,D,E,C), true. back_prop_n_cl(A,B,C) :- back_prop_n(A,D,B,E,0,F), back_prop_n_cl(F,D,E,C), true. back_prop_d([],[],A,A,B,B) :- !, true. back_prop_d([unify(yes,A,B,C)|D],E,F,G,H,I) :- subsetv(C,F), !, set_command(add(A),F,J), K is H+1, back_prop_d(D,E,J,G,K,I), true. back_prop_d([unify(no,A,B,C)|D],E,F,G,H,I) :- !, back_prop_d(D,E,F,G,H,I), true. back_prop_d([A|B],[A|C],D,E,F,G) :- back_prop_d(B,C,D,E,F,G), true. back_prop_d_cl(0,A,B,B) :- !, true. back_prop_d_cl(A,B,C,D) :- A>0, !, back_prop_d_cl(B,C,D), true. back_prop_g([],[],A,A,B,B) :- !, true. back_prop_g([unify(A,B,C,D)|E],F,G,H,I,J) :- nonvar(C), subsetv(D,G), !, set_command(add(B),G,K), L is I+1, back_prop_g(E,F,K,H,L,J), true. back_prop_g([unify(A,B,C,D)|E],F,G,H,I,J) :- inv(B,G), !, set_command(add_set(D),G,K), L is I+1, back_prop_g(E,F,K,H,L,J), true. back_prop_g([A|B],[A|C],D,E,F,G) :- back_prop_g(B,C,D,E,F,G), true. back_prop_g_cl(0,A,B,B) :- !, true. back_prop_g_cl(A,B,C,D) :- A>0, !, back_prop_g_cl(B,C,D), true. back_prop_n([],[],A,A,B,B) :- !, true. back_prop_n([unify(A,B,C,D)|E],F,G,H,I,J) :- var(B), var(C), inv(C,G), !, set_command(add(B),G,K), L is I+1, back_prop_n(E,F,K,H,L,J), true. back_prop_n([A|B],[A|C],D,E,F,G) :- back_prop_n(B,C,D,E,F,G), true. back_prop_n_cl(0,A,B,B) :- !, true. back_prop_n_cl(A,B,C,D) :- A>0, !, back_prop_n_cl(B,C,D), true. trav_goal(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,A1,A1,B1) :- call_p(A), !, trav_call(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,C1,W,X,Y,D1), set_command(sub_set(F),C1,V), unionv(F,D1,Z), true. trav_goal(A=B,C,D,E,F,G,H,H,I,I,J,J,K,K,L,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y) :- make_uni(A,B,Z,Q,A1,U,B1,W,C1,Y), make_uni(B,A,D1,A1,E1,B1,F1,C1,X,Y), term_dupset(A=B,G1), trav_goal_d(A,B,G,G1,M,H1,O,I1,E1,J1,S,K1,F1,L1), trav_goal_u(A,B,G,H1,N,J1,M1,K1,T,L1,N1,Y), set_command(add_set(N),I1,O1), trav_goal_n(A,B,O1,P), set_command(sub_set(G1),M1,R), unionv(G,N1,V), true. trav_call(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z) :- functor(A,A1,B1), table_command(fget(A1/B1,C1),K,D1), !, update_entry(A,E1,F1,G,G1,O,H1,Q,I1,S,J1,U,K1,W,L1,Y,M1), trav_def(A,A1/B1,C1,E,E1,F1,F,G1,H,I,J,D1,L,M,N,H1,P,I1,R,J1,T,K1,V,L1,X,M1,Z), true. trav_call(A,B,C,D,E,F,G,G,H,I,J,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X) :- spec_goal(B,C,D,A,Y,O,Z,Q,A1,S,T,U,B1,W,C1,K,L), after(Y,D1), bindset(Y,E1), diffv(E1,Z,F1), set_command(sub_set(F1),B1,G1), rderef_set(D1,H1), set_command(add_set(H1),G1,I1), ground_set(D1,J1), set_command(add_set(J1),Z,K1), nonvar_set(D1,L1), set_command(add_set(L1),A1,M1), update_exit(Y,H,I,M,N,K1,P,M1,R,I1,V,C1,X), true. make_uni(A,B,C,D,E,F,G,H,I,J) :- var(A), !, dref_prop_flag(A,K,D,E,F,G,H,L,J), varset(B,C), L=[unify(K,A,B,C)|I], true. make_uni(A,B,C,D,D,E,E,F,F,G). trav_goal_d(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- split_unify_v(A,B,O,P), varset(P,Q), trav_drf1(O,P,Q,C,E,F,G,H,I,J,K,L,M,N), !, true. trav_goal_d(A,B,C,D,E,F,G,G,H,I,J,K,L,M) :- split_unify_v(A,B,N,O), varset(O,P), trav_drf2(N,O,P,C,D,E,F,H,I,J,K,L,M), !, true. trav_goal_d(A,B,C,D,E,E,F,F,G,G,H,I,J,J) :- !, intersectv(E,H,I), true. trav_goal_u(A,B,C,D,E,F,G,H,I,J,K,L) :- split_unify_v(A,B,M,N), varset(N,O), trav_unif(M,N,O,C,D,E,F,G,H,I,J,K,L), !, true. trav_goal_u(A,B,C,D,D,E,F,G,G,H,H,I) :- set_command(sub_set(C),E,F), true. trav_goal_n(A,B,C,D) :- split_unify_v(A,B,E,F), trav_non(E,F,C,D), !, true. trav_goal_n(A,B,C,C). dref_prop_flag(A,no,B,B,C,C,D,D,E) :- inv(A,E), !, true. dref_prop_flag(A,yes,B,B,C,C,D,D,E) :- \+inv(A,C), !, true. dref_prop_flag(A,yes,B,B,C,C,D,D,E) :- inv(A,B), !, true. dref_prop_flag(A,no,B,B,C,C,D,D,E). trav_non(A,B,C,D) :- nonvar(B), !, set_command(add(A),C,D), true. trav_non(A,B,C,D) :- var(B), inv(B,C), !, set_command(add(A),C,D), true. trav_drf1(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- \+inv(A,M), !, new_dref(A,B,C,E,F,G,H,I,O,K,P,M,Q), add_dref(C,O,J,P,L,Q,N), true. trav_drf1(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- inv(A,I), !, new_dref(A,B,C,E,F,G,H,I,O,K,P,M,Q), add_dref(C,O,J,P,L,Q,N), true. trav_drf2(A,B,C,D,E,F,F,G,H,I,J,K,L) :- inv(A,I), inv(A,F), !, add_dref(C,G,H,I,J,K,L), true. trav_drf2(A,B,C,D,E,F,F,G,H,I,J,K,L) :- E=[], inv(A,I), intersectv(K,C,M), subsetv(M,G), !, add_dref(C,G,H,I,N,K,L), set_command(sub(A),N,J), true. new_dref(A,B,C,D,D,E,E,F,F,G,H,I,I) :- var(B), intersectv(C,I,J), unionv(G,F,K), subsetv(J,K), !, set_command(add(A),G,H), true. new_dref(A,B,C,D,D,E,E,F,F,G,H,I,I) :- nonvar(B), intersectv(C,I,J), unionv(E,D,K), intersectv(G,K,L), subsetv(J,L), !, set_command(add(A),G,H), true. new_dref(A,B,C,D,D,E,E,F,F,G,G,H,H). add_dref(A,B,B,C,D,E,E) :- diffv(E,B,F), diffv(A,F,G), set_command(add_set(G),C,D), true. trav_unif(A,B,C,D,E,F,G,H,I,I,J,J,K) :- subsetv(C,E), !, set_command(add(A),E,F), set_command(sub(A),G,H), true. trav_unif(A,B,C,D,E,E,F,G,H,H,I,I,J) :- inv(A,F), \+inv(A,J), !, diffv(D,I,K), set_command(add_set(K),F,L), set_command(sub(A),L,M), intersectv(D,I,N), set_command(sub_set(N),M,G), true. trav_unif(A,B,C,D,E,E,F,G,H,H,I,I,J) :- \+inv(A,I), \+inv(A,J), !, diffv(D,I,K), set_command(add_set(K),F,L), set_command(sub(A),L,M), intersectv(D,I,N), set_command(sub_set(N),M,G), true. trav_unif(A,B,C,D,E,F,G,H,I,I,J,J,K) :- inv(A,E), !, set_command(add_set(D),E,F), set_command(sub_set(D),G,H), true. trav_def(A,B/C,D,E,F,no,G,H,H,I,J,K,K,L,L,M,M,N,O,P,Q,R,S,T,U,V,W) :- !, table_command(fget(B/C,X),I,J), get_argvars(rderef,A,X,Y), get_argvars(ground,A,X,Z), get_args(nonvar,A,X,A1), new_drf_gnd(Y,Z,A1,G,N,O,P,Q,R,S,T,U,V,W), true. trav_def(A,B/C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,A1,B1) :- copy(D,(C1:-D1)), save_sets(E1,S,F1,U,G1,W,H1,Y,I1,A1,J1), new_sets(C1,F,F1,K1,G1,L1,H1,M1,I1,N1,J1,O1), % stats(trav_disj,B/C), trav_disj(D1,C1,B/C,1,E,P1,Q1,R1,I,J,K,S1,M,N,O,P,Q,T1,K1,U1,L1,V1,M1,W1,N1,X1,O1,Y1), restore_sets(E1,U1,Z1,V1,A2,W1,B2,X1,C2,Y1,D2), map_argvars(C1,R1,A,E2), map_argvars(C1,P1,A,F2), map_args(C1,Q1,A,G2), new_drf_gnd(E2,F2,G2,H,Z1,H2,A2,I2,B2,X,C2,J2,D2,K2), update_exit(A,S1,L,T1,R,H2,T,I2,V,J2,Z,K2,B1), true. spec_goal(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) :- modal_entry(D,R), !, S=index(A,B,C), table_command(get(S,T),P,U), functor(D,V,W), calc_entry(D,X,F,Y,H,Z,J,A1,L,B1,N,C1), spec_goal2(D,V/W,S,T,X,E,Y,G,Z,I,A1,K,B1,M,C1,O,U,Q), true. spec_goal(A,B,C,D,D,E,E,F,F,G,G,H,H,I,I,J,J). get_args(A,B,C,D) :- functor(B,E,F), get_args(1,F,A,B,C,G,[]), sort(G,D). new_drf_gnd(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- new_drf_set(A,D,E,O,I,J,K,L,M,N), set_command(add_set(B),O,F), set_command(add_set(C),G,H), true. map_argvars(A,B,C,D) :- functor(A,E,F), map_argvars(1,F,A,B,C,G,[]), sort(G,D). new_drf_set([],A,B,B,C,C,D,E,F,F) :- !, intersectv(B,D,E), true. new_drf_set(A,B,C,C,D,D,E,F,G,G) :- cons(A), !, E=H, unionv(D,H,I), diffv(B,G,J), unionv(J,I,K), intersectv(A,K,L), intersectv(C,H,M), unionv(L,M,F), true. calc_entry(A,B,C,C,D,D,E,E,F,F,G,G) :- term_dupset(A,H), functor(A,I,J), functor(B,I,J), calc_entry_2(1,J,C,D,H,E,F,G,A,B), true. spec_goal2(A,B,C,D,E,F,G,G,H,H,I,I,J,J,K,K,L,L) :- var(D), !, lattice_modes_entry(B,E,A,M), efficient_entry(A,F,M), D=value(A,E,F), true. spec_goal2(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) :- nonvar(D), !, copy(D,value(A,S,T)), spec_update(A,B,C,S,T,E,F,G,H,I,J,K,L,M,N,O,P,Q,R), true. lattice_modes_entry(A/B,C,D,E) :- lattice_modes_call(1,B,C,D,either,E,true). efficient_entry(A,B,C) :- modal_entry(A,D), tree_trav_entry(D,C,B), !. efficient_entry(A,A,B). spec_update(A,B,C,D,E,F,G,H,H,I,I,J,J,K,K,L,L,M,N) :- D\==F, !, lattice_modes_entry(B,F,A,O), efficient_entry(A,G,O), table_command(set(C,value(A,F,G)),M,N), true. spec_update(A,B,C,D,E,D,E,F,F,G,G,H,H,I,I,J,J,K,K). spec_stree(stree(A,(B:-C),D,E,F,G),stree(A,(B:-H),D,E,I,G),J) :- !, spec_disj(C,H,A,1,J), spec_strees(F,I,J). spec_stree(A,A,B) :- directive(A). spec_disj(fail,fail,A,B,C). spec_disj((A;B),(C;D),E,F,G) :- spec_conj(A,C,E,F,1,G), H is F+1, spec_disj(B,D,E,H,G). spec_conj(true,true,A,B,C,D). spec_conj((A ',' B),(C ',' D),E,F,G,H) :- spec_goal(A,C,E,F,G,H), I is G+1, spec_conj(B,D,E,F,I,H). spec_goal(A,B,C,D,E,F) :- get(F,index(C,D,E),G), !, copy(G,value(A,H,B)). spec_goal(A,A,B,C,D,E). map_argvars(A,B,C,D,E,F,G) :- A=B, !. map_args(A,B,C,D,E,F,G) :- A=B, !. get_argvars(A,B,C,D,E,F,G) :- A=B, !. greater_eq(ground,gnddrf) :- !. greater_eq(rderef,gnddrf) :- !. greater_eq(rderef,nondrf) :- !. greater_eq(nonvar,gnddrf) :- !. greater_eq(nonvar,nondrf) :- !. greater_eq(nonvar,ground) :- !. greater_eq(A,A) :- !. greater_eq(A,unknown) :- !. greater_eq(any,A) :- !. get_args(A,B,C,D,E,F,G) :- A=B, !. lub_call(A,B,C) :- functor(A,D,E), functor(B,D,E), functor(C,D,E), lub_call(1,E,A,B,C). update_entry(A,B,C,yes,D,E,F,G) :- B\==C, !, table_command(set(A,C),D,E), set_command(add(entry(A)),F,G), true. update_entry(A,B,C,no,D,D,E,E). calc_exit(A,B,C,C,D,D,E,E) :- functor(A,F,G), functor(B,F,G), calc_exit_2(1,G,C,D,E,A,B), true. update_exit(A,B,C,D,E,F,G) :- B\==C, !, table_command(set(A,C),D,E), set_command(add(exit(A)),F,G), true. update_exit(A,B,C,D,D,E,E). calc_exit_2(A,B,C,D,E,F,G) :- A>B, !. calc_exit_2(A,B,C,D,E,F,G) :- A=B, !. calc_entry_2(A,B,C,D,E,F,G,H,I,J) :- A=B, !. lub_call(A,B,C,D,E) :- A=B, !. bottom_call(A,B,C) :- A=B, !. lattice_modes_call(A,B,C,D,E,F,G) :- A= flat_conj((M ',' L),C), J=R, E=S, F=T, G=U ; flat_conj(L,V), varset(M,W), varset(V,X), C= (M ',' '$body'((Y:-V),X,Z)), J=[body((Y:-V),Z)|R], E=[Y|S], F=[W|T], G=[X|U] ), create_bodies(B,D,S,T,U,H,I,R,K). create_heads([],A,B,[],[]). create_heads([A|B],C,D,[E|F],[G|H]) :- intersectv(E,G,I), diffv(I,D,J), unionv(E,D,K), intersectv(K,G,L), new_head(L,[36,98,95],C,J,A), create_heads(B,C,D,F,H). new_head(A,B,C,D,E) :- cons(A), !, new_head(B,C,D,E). new_head(A,B,C,D,E) :- nil(A), !, functor(C,F,G), gensym(B,F/G,E). segment_test(A,B,C,D,E) :- F=true, B=G, H=I, J=K, segment_1(A,K,C,F,G,H,I,J,[],L,D,M,E,N). st(A,B,C) :- varset(B,D), segment_test(A,E,F,D,C), wn(F), wn(E). segment_1(true,true,A,A,B,B,C,C,D,D,E,E,F,F) :- !, true. segment_1(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- next_goal(A,O,P), split_unify(O,Q,R), var(Q), atomic(R), implies(M,nonvar(Q)), !, C= ('$name_arity'(Q,R,0)',' S), update_formula('$name_arity'(Q,R,0),M,T), segment_1(P,B,S,D,E,F,G,H,I,J,K,L,T,N), true. segment_1(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- next_goal(A,O,P), test(O), \+standard_order(O), varset(O,Q), intersectv(Q,I,[]), subsetv(Q,K), bindset(O,M,[]), !, add_name_arity(O,C,R,M,S), R= (O ',' T), update_formula(O,S,U), segment_1(P,B,T,D,E,F,G,H,I,J,K,L,U,N), true. segment_1(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- next_goal(A,O,P), split_unify(O,Q,R), var(Q), compound(R), implies(M,nonvar(Q)), varset(R,S), intersectv(S,K,[]), !, functor(R,T,U), C= ('$name_arity'(Q,T,U)',' V), V= (O ',' W), M=X, update_formula(O,K,X,Y), unionv([Q],K,Z), unionv(S,Z,A1), segment_1(P,B,W,D,E,F,G,H,I,J,A1,L,Y,N), true. segment_1(A,A,B,C,D,D,E,E,F,F,G,G,H,I) :- next_goal(A,J,K), split_unify(J,L,M), var(L), compound(M), implies(H,nonvar(L)), !, functor(M,N,O), B= ('$name_arity'(L,N,O)',' C), update_formula('$name_arity'(L,N,O),H,I), true. segment_1(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- next_goal(A,O,P), split_unify(O,Q,R), var(Q), implies(M,var(Q)), !, E= (O ',' S), includev(Q,I,T), segment_1(P,B,C,D,S,F,G,H,T,J,K,L,M,N), true. segment_1(A,B,C,D,E,F,G,H,I,J,K,L,M,N) :- next_goal(A,O,P), split_unify(O,Q,R), var(Q), implies(M,uninit(any,Q)), !, G= (O ',' S), includev(Q,I,T), segment_1(P,B,C,D,E,F,S,H,T,J,K,L,M,N), true. segment_1(A,A,B,B,C,C,D,D,E,E,F,F,G,G) :- !, true. next_goal((A ',' B),A,B) :- !. next_goal(A,A,true). add_name_arity(A,B,C,D,E) :- split_unify(A,F,G), var(F), nonvar(G), implies(D,nonvar(F)), !, functor(G,H,I), B= ('$name_arity'(F,H,I)',' C), update_formula('$name_arity'(F,H,I),D,E), true. add_name_arity(A,B,B,C,C). segment_all_disj(fail,A,B,C,fail,D,D,[]). segment_all_disj((A;B),C,D,E,(F;G),H,I,J) :- segment_all_conj(A,K,L,E,H,M), varset(K,N), ( length_test_user(L,O,P), Q=1, R=2, % compile_option(user_test_size(Q,R)), P= F= (K ',' L), J=S ; varset(L,T), intersectv(N,T,U), diffv(U,D,V), new_head([36,115,95],C,V,W), F= (K ',' '$body'((W:-L),T,X)), J=[body((W:-L),X)|S] ), segment_all_disj(B,C,D,E,G,M,I,S). segment_all_conj(true,true,true,A,B,B) :- !. segment_all_conj((A ',' B),(A ',' C),D,E,F,G) :- A= (H=I), filter_vars([H,I],J), sort(J,K), disjointv(K,E), !, insert(K,F,L), segment_all_conj(B,C,D,E,L,G). segment_all_conj((A ',' B),(A ',' C),D,E,F,G) :- test(A), !, segment_all_conj(B,C,D,E,F,G). segment_all_conj((A ',' B),true,(A ',' B),C,D,D) :- \+test(A), !. selection_3(A,B,C,D,E,F) :- length_disj(A,G), G>1, % stats(s,1), find_testset(A,B,C,D,E,H,I), % stats(s,2), pick_testset(I,H,J), !, % stats(s,3), thin_testset(J,K), % stats(s,4), code_testset(K,B,C,D,E,A,F), % stats(s,5), ( fail -> % compile_option(debug) -> write('Selection code:'), nl, write(F), nl ; true ), !. selection_3(A,B,C,D,E,A). selection(A,B,C,D,E,F) :- simplify(A,G), selection_3(G,B,C,D,E,F), !. find_testset(A,B,C,D,E,F,G) :- unbound_set(E,H), pred_gather(A,B,C,D,H,E,1,F,[]), keysort(F,I), part_testset(I,G). pick_testset(A,B,C) :- first_test(B,D-E), comment(['First test is ',D-E]), rel_flag(D,F), pick_eq(none-[],0,A,C,G,F), G>0, !. thin_testset(A-B,A-C) :- show_tests(B,D), keysort(D,E), make_thin(E,C), !. code_testset(A-B,C,D,E,F,G,'$case'(H,I,J)) :- A=key(H,I), get_clause_nums(B,K,[]), sort(K,L), extract_else_disj(L,1,G,M,N), full_testset(H,I,B,O), ( H=var -> P=G ; P=M ), code_testset(O,C,[A|D],E,F,[],N,M,P,J). pred_gather((A;B),C,D,E,F,G,H,I,J) :- !, flat_conj(A,K), clause_gather(K,C,A,D,E,F,G,H,1,L,I,M), N is H+1, pred_gather(B,C,D,E,F,G,N,M,J). pred_gather(A,B,C,D,E,F,G,H,I) :- flat_conj(A,J), clause_gather(J,B,A,C,D,E,F,G,1,K,H,I). part_testset(A,[B-[C|D]|E]) :- A=[B-C|F], !, one_testset(B,C,F,D,G), part_testset(G,E). part_testset([],[]). clause_gather(true,A,B,C,D,E,F,G,H,H,I,I). clause_gather((A ',' B),C,D,E,F,G,H,I,J,K,L,L) :- cut_p(A), !, J=K. clause_gather((A ',' B),C,D,E,F,G,H,I,J,K,L,M) :- one_clause_gather(A,C,D,E,F,G,H,I,J,N,L,O), !, clause_gather(B,C,D,E,F,G,H,I,N,K,O,M). clause_gather((A ',' B),C,D,E,F,G,H,I,J,K,L,M) :- N is J+1, clause_gather(B,C,D,E,F,G,H,I,N,K,L,M). one_clause_gather(A,B,C,D,E,F,G,H,I,J,K,L) :- J is I+1, bagof(key(M,N)-val(A,O,H,I,P,Q),valid_testset(A,B,G,M,N,P,O,D,E,F),R), !, make_correct(A,C,R), difflist(R,K,L). make_correct(A,B,[C-val(A,D,E,F,G,B)|H]) :- !, make_correct(A,B,H). make_correct(A,B,[]). valid_testset(A,B,C,D,E,F,G,H,I,J) :- internal_testset(A,C,D,E,F,K), logical_simplify(K,G), relational_check(A,C,D), \+memberv(key(D,E),H), \+implies(C,G), survive_form(G,C), varset(A,L), subsetv(L,I), varset(E,M), disjointv(M,J), valid_option(A,B,L). internal_testset(A,B,C,D,E,F) :- bindbag(A,B,[]), testset(A,F,B,C,D,E). internal_testset(A=B,C,equal,v(A,B),true,'$equal'(A,B)) :- implies(C,(atomic(A)',' atomic(B))), !. internal_testset(A,B,C,D,E,F) :- \+unify_p(A), bindbag(A,B,[]), testset(A,F,B,C,D,E). relational_check(A,B,C) :- \+relational_test(A,D,E), !. relational_check(A,B,C) :- relational_test(A,D,E), relational_testset(C), !. relational_check(A,B,C) :- relational_test(A,D,E), \+relational_testset(C), logical_simplify((integer(D)',' integer(E)),F), implies(B,F), !. valid_option(A,B,C) :- goal_type(B,A,D), test_option(D), !. goal_type(A,B,unify) :- split_unify_v_nv(B,C,D), !. goal_type(A,var(B),unify) :- select_option(A,C), !. goal_type(A,nonvar(B),unify) :- select_option(A,C), !. goal_type(A,'$name_arity'(B,C,D),unify) :- !. goal_type(A,B,arith) :- encode_relop(B,C,D,E,arith), !. goal_type(A,B,typecheck). test_option(unify) :- fail, % compile_option(test), fail, % compile_option(test_unify), !. test_option(arith) :- fail, % compile_option(test), fail, % compile_option(test_arith), !. test_option(typecheck) :- fail, % compile_option(test), fail, % compile_option(test_typecheck), !. test_option(A) :- true. % \+compile_option(test). firstarg_option(A,B,C) :- fail, % compile_option(firstarg), \+unify_p(B), !, arg(1,A,D), memberv(D,C). firstarg_option(A,B,C) :- fail, % compile_option(firstarg), unify_p(B), !, split_unify(B,D,E), arg(1,A,F), D==F. firstarg_option(A,B,C). testset(A,B,C,D,E,F) :- testset(A,B,C,D,E,F,G). relational_testset(comparison(A,arith)). one_testset(A,B,[C-D|E],F,G) :- A==C, B==D, !, one_testset(A,D,E,F,G). one_testset(A,B,[C-D|E],[D|F],G) :- A==C, B\==D, !, one_testset(A,D,E,F,G). one_testset(A,B,[C-D|E],[],[C-D|E]) :- A\==C, !. one_testset(A,B,[],[],[]). first_test(A,B) :- A=[C|D], C=E-val(F,G,H,I,J,K), first_test(D,H,I,C,B). rel_flag(key(A,B),yes) :- relational_testset(A), !. rel_flag(key(A,B),no) :- \+relational_testset(A), !. pick_eq(A,B,[C-D|E],F,G,H) :- !, ( rel_flag(C,I), I=H, goodness_testset(C,D,J), J>B -> pick_eq(C-D,J,E,F,G,H) ; pick_eq(A,B,E,F,G,H) ). pick_eq(A,B,[],A,B,C). goodness_testset(key(A,B),C,D) :- number_of_direcs(C,E), goodness_key(A,F), ( A=hash(G), H=5, % compile_option(hash_size(H)), ED=0 ; D is 1000*E+F ), !, comment(['Goodness of ',A,' is ',D]). first_test([],A,B,C,C). first_test([A|B],C,D,E,F) :- A=G-val(H,I,J,K,L,M), ( J R=X ; unionv(T,J,Z), logical_subsume(B,K,A1), logical_simplify((B ',' A1),B1), selection(X,H,I,Z,B1,R) ), code_testset(G,H,I,J,K,V,M,N,Y,S), !. code_testset([],A,B,C,D,E,F,G,H,'$else'(I,E,J)) :- restore_block(E,E,I,true), selection(H,A,B,C,D,J). needset(A,B,C) :- varset(A,D), intersectv(B,D,C). restore_block([A|B],[C|D],E,F) :- A@ C, restore_block([A|B],D,E,F). restore_block(A,[],B,B). restore_block([],A,B,B). save_block([A|B],C,D) :- co(save(A),C,E), save_block(B,E,D). save_block([],A,A). merge_disj_list(A,none,B,C,B) :- !. merge_disj_list([A|B],C,(D;E),F,(D;G)) :- A 0 -> comment(['Number of duplicate blocks = ',F]), map_blocks(A,E,B) ; A=B ). peep_dead(A,B) :- gather_closure(A,C), peep_dead(A,C,B). peep_jump_closure(A,B,C) :- peep_jump(A,B,D), peep_jump_end_closure(A,B,D,C). peep_inst(A,B,C) :- make_block_array(B,D), peep_inst(B,D,A,C,[]). peep_labl(A,B) :- branch_dest_set(A,C), list_to_key(C,D), create_array(D,E), remove_label_inst(A,E,B). synonym(A,B) :- synonym(A,B,[]), !. wc(A,A) :- write_code(A). inst_labl_list([],A). inst_labl_list([l(A,B)|C],A) :- gennum(B), inst_labl_list(C,A). insert_error_jump([],A,A). insert_error_jump([error_jump(A,B)|C],D,E) :- !, error_jump_moves(B,F,G,D,H), G=[], local_allocate(F), 'C'(H,jump(A),I), insert_error_jump(C,I,E). insert_error_jump([A|B],C,D) :- 'C'(C,A,E), insert_error_jump(B,E,D). error_jump_moves(A,B,C,D,E) :- error_jump_1(A,F,B,G,D,H), low_reg(I), error_jump_2(F,I,G,C,H,E). local_allocate(A) :- local_allocate(A,B,C). error_jump_1([],[],A,A,B,B). error_jump_1([A|B],[C|D],[pref,A,C|E],F,G,H) :- 'C'(G,move(A,C),I), error_jump_1(B,D,E,F,I,H). error_jump_2([],A,B,B,C,C). error_jump_2([A|B],C,[pref,A,r(C)|D],E,F,G) :- 'C'(F,move(A,r(C)),H), I is C+1, error_jump_2(B,I,D,E,H,G). make_large_blocks([],[]). make_large_blocks([label(A)|B],[A-C|D]) :- first_block(B,C), \+has_label(C), \+small_block(C), !, make_large_blocks(B,D). make_large_blocks([A|B],C) :- make_large_blocks(B,C). make_unique_array([],A,B,B) :- seal(A). make_unique_array([A-B|C],D,E,F) :- get(D,B,G), !, ( var(G) -> G=A, H=E ; H is E+1 ), make_unique_array(C,D,H,F). make_unique_array([A|B],C,D,E) :- make_unique_array(B,C,D,E). map_blocks([],A,[]). map_blocks([label(A)|B],C,D) :- first_block(B,E,F), fget(C,E,G), A\==G, !, D=[label(A),jump(G)|H], map_blocks(F,C,H). map_blocks([A|B],C,D) :- branch(A), \+distant_branch(A), \+B=[label(E)|F], first_block(B,G,H), fget(C,G,I), !, comment(['Able to remove a block after ',A]), D=[A,jump(I)|J], map_blocks(H,C,J). map_blocks([A|B],C,[A|D]) :- map_blocks(B,C,D). first_block([A],[A],[]) :- !. first_block([A|B],[A|C],D) :- \+end_block(A), !, first_block(B,C,D). first_block([A|B],[A],B) :- end_block(A), !. first_block(A,B) :- first_block(A,B,C). has_label([label(A)|B]). has_label([A|B]) :- has_label(B). small_block([jump(A)]). small_block([return]). small_block([fail]). peep_jump(A,B,C) :- make_block_array(B,D), non_empty_array(D), !, ( fail -> % compile_option(rearr_debug) -> write_code(B) ; true ), get_uniq_labels(B,E), rearr_jump(B,A,E,D,F), peep_dead(F,G), peep_choice(G,A,E,D,C). peep_jump(A,B,B). peep_jump_end_closure(A,B,C,D) :- B=C, !, D=B. peep_jump_end_closure(A,B,C,D) :- peep_jump_closure(A,C,D). make_block_array(A,B) :- make_blocks(A,C), create_array(C,B). get_uniq_labels(A,B) :- get_label_bag(A,C,[]), filter_uniq(C,D), length(D,E), comment(['Number of unique labels = ',E]), create_array(D,B). rearr_jump([],A,B,C,[]). rearr_jump([jump(A)|B],C,D,E,F) :- \+B=[label(A)|G], fget(E,A,H), \+no_opt_block(H), first_block(H,I), ( fget(D,A,J), \+last(I,jump(A)) ; short_block(I), \+last(I,jump(K)) ), !, insert_block(I,C,F,L), rearr_jump(B,C,D,E,L). rearr_jump([call(A)|B],C,D,E,F) :- \+B=[return,label(A)|G], fget(E,A,H), first_block(H,I), ( fget(D,A,J) ; short_block(I) ), \+has_recursion(I,A), returns_or_fails(I,K), !, insert_block(K,C,F,L), rearr_jump(B,C,D,E,L). rearr_jump([A|B],C,D,E,F) :- branch(A,[G]), fget(E,G,H), merge_branch(A,H,I,F,J), !, inst_labl_list(I,C), rearr_jump(B,C,D,E,J). rearr_jump([A|B],C,D,E,F) :- map_branch(A,G,H,I), fget(E,G,J), ( J=[jump(I)|K] ; J=[fail|L], I=fail ), !, F=[H|M], rearr_jump(B,C,D,E,M). rearr_jump([A|B],C,D,E,[A|F]) :- rearr_jump(B,C,D,E,F). peep_choice(A,B,C,D,E) :- rearr_choice(A,C,D,F,G), ( F\==[] -> repl_choice(G,F,E,0,H), comment(['Number of choice-fail replacements = ',H]) ; G=E ). get_label_bag([],A,A) :- !. get_label_bag([A|B],C,D) :- branch(A,C,E), !, get_label_bag(B,E,D). get_label_bag([A|B],C,D) :- get_label_bag(B,C,D). get_label_set(A,B) :- get_label_bag(A,C,[]), sort(C,B). rearr_choice([],A,B,[],[]). rearr_choice([choice(1/A,B,C),fail|D],E,F,G,[jump(C)|H]) :- fget(E,C,I), fget(F,C,J), J=[choice(K/L,M,N)|O], 1 G=[rep(C,P,P)|Q] ; G=[rep(C,[choice(1/L,M,N)|P],P)|Q] ), rearr_choice(D,E,F,Q,H). rearr_choice([A|B],C,D,E,[A|F]) :- rearr_choice(B,C,D,E,F). repl_choice([],A,[],B,B). repl_choice([label(A),B|C],D,[label(A)|E],F,G) :- member(rep(A,E,H),D), !, I is F+1, repl_choice(C,D,H,I,G). repl_choice([A|B],C,[A|D],E,F) :- repl_choice(B,C,D,E,F). no_opt_block([pragma(push(cons))|A]). no_opt_block([pragma(push(structure(A)))|B]). no_opt_block([unify_atomic(A,B,fail)|C]). short_block(A) :- B=6, % compile_option(short_block(B)), shorter_than(A,B). insert_block(A,B,C,D) :- get_labels(A,E,[]), assoc_labels(E,F), inst_labl_list(F,B), replace_labels(A,E,F,C,D). has_recursion([call(A)|B],A) :- !. has_recursion([A|B],C) :- has_recursion(B,C). returns_or_fails(A,B) :- returns_or_fails(A,B,[]). merge_branch(test(A,B,C,D),[test(A,B,C,E)|F],[],G,H) :- 'C'(G,test(A,B,C,E),H). merge_branch(test(ne,A,B,C),[switch(D,B,fail,E,F)|G],[H],I,J) :- 'C'(I,switch(D,B,H,E,F),K), 'C'(K,label(H),J), tag(var,A). merge_branch(choice(A/B,C,D),[jump(E)|F],[],G,H) :- 'C'(G,choice(A/B,C,E),H). merge_branch(jump(A),[test(B,C,D,E),label(F)|G],[],H,I) :- true, % ( mips % ; sparc % ; mc68020 % ), 'C'(H,test(B,C,D,E),J), 'C'(J,jump(F),I). merge_branch(jump(A),[switch(B,C,D,E,F)|G],[],H,I) :- true, % ( mips % ; sparc % ; mc68020 % ), 'C'(H,switch(B,C,D,E,F),I). merge_branch(jump(A),[deref(B,C),test(D,E,C,F),label(G)|H],[],I,J) :- true, % ( mips % ; sparc % ; mc68020 % ), 'C'(I,deref(B,C),K), 'C'(K,test(D,E,C,F),L), 'C'(L,jump(G),J). merge_branch(jump(A),[deref(B,C),switch(D,C,E,F,G)|H],[],I,J) :- true, % ( mips % ; sparc % ; mc68020 % ), 'C'(I,deref(B,C),K), 'C'(K,switch(D,C,E,F,G),J). merge_branch(jump(A),[jump(B,C,D,E),label(F)|G],[],H,I) :- true, % ( mips % ; sparc % ; mc68020 % ), 'C'(H,jump(B,C,D,E),J), 'C'(J,jump(F),I). make_blocks([],[]). make_blocks([label(A)|B],[A-B|C]) :- !, make_blocks(B,C). make_blocks([procedure(A)|B],[A-B|C]) :- !, make_blocks(B,C). make_blocks([A|B],C) :- make_blocks(B,C). basic_block(A,A) :- A=[label(B)|C]. basic_block([A|B],C) :- basic_block(B,C). end_block(A) :- distant_branch(A). get_labels([],A,A) :- !. get_labels([label(A)|B],C,D) :- !, 'C'(C,A,E), get_labels(B,E,D). get_labels([A|B],C,D) :- get_labels(B,C,D). assoc_labels([],[]) :- !. assoc_labels([A|B],[C|D]) :- assoc_labels(B,D). replace_labels([],A,B,C,C) :- !. replace_labels([A|B],C,D,E,F) :- replace_labels_one(A,C,D,E,G), replace_labels(B,C,D,G,F). replace_labels_one(label(A),B,C,[label(D)|E],E) :- memberv2(A,B,D,C), !. replace_labels_one(A,B,C,[D|E],E) :- map_branches(A,F,D,G), !, map_terms(B,C,F,G). replace_labels_one(A,B,C,[A|D],D). returns_or_fails([fail],A,B) :- !, 'C'(A,fail,B). returns_or_fails([return],A,A) :- !. returns_or_fails([call(A)|B],C,D) :- !, 'C'(C,call(A),E), returns_or_fails(B,E,D). returns_or_fails([A|B],C,D) :- \+branch(A), !, 'C'(C,A,E), returns_or_fails(B,E,D). returns_or_fails([A|B],C,D) :- pure_branch(A,E), all_fails(E), !, 'C'(C,A,F), returns_or_fails(B,F,D). all_fails([]). all_fails([A|B]) :- nonvar(A), A=fail, all_fails(B). gather_closure(A,B) :- gather_closure(A,[],B). peep_dead([],A,[]). peep_dead([A|B],C,[A|D]) :- distant_branch(A), !, to_next_label(B,C,E), peep_dead(E,C,D). peep_dead([A|B],C,[A|D]) :- peep_dead(B,C,D). to_next_label([],A,[]). to_next_label([A|B],C,D) :- ( A=label(E), member(E,C) -> D=[A|B] ; to_next_label(B,C,D) ). gather_closure(A,B,C) :- gather_labels(A,B,D), sort(D,E), gather_end_closure(A,B,E,C). gather_labels([],A,A). gather_labels([A|B],C,D) :- branch(A,E,C), !, next_code(A,B,F,E), gather_labels(F,E,D). gather_labels([label(A)|B],C,D) :- member(A,C), !, gather_labels(B,C,D). gather_labels([A|B],C,D) :- gather_labels(B,C,D). gather_end_closure(A,B,C,D) :- B=C, !, D=C. gather_end_closure(A,B,C,D) :- gather_closure(A,C,D). next_code(A,B,C,D) :- distant_branch(A), !, to_next_label(B,D,C). next_code(A,B,B,C). branch_dest_set(A,B) :- branch_dest_bag(A,C), sort(C,B). remove_label_inst([],A,[]). remove_label_inst([A|B],C,D) :- ( A=label(E), \+fget(C,E,F) -> D=G ; D=[A|G] ), remove_label_inst(B,C,G). branch_dest_bag([],[]). branch_dest_bag([A|B],C) :- ( branch(A,C,D) -> branch_dest_bag(B,D) ; branch_dest_bag(B,C) ). peep_inst([],A,B,C,C). peep_inst([choice(1/A,B,C)|D],E,F,G,H) :- success_to_cut(D,E), !, peep_inst(D,E,F,G,H). peep_inst([choice(A/B,C,D)|E],F,G,H,I) :- 1=0. lbl(l(A/B,C)) :- atom(A), integer(B), B>=0, integer(C). contains_label([label(A)|B],A) :- !. contains_label([label(A)|B],C) :- contains_label(B,C). contains_label([pragma(A)|B],C) :- contains_label(B,C). cpeep3(call(A),label(B),return,C,D) :- 'C'(C,jump(A),E), 'C'(E,label(B),F), 'C'(F,return,D). peep3r(test(A,B,C,D),E,test(A,B,C,F),G,H) :- no_mod(E,C), \+E=label(I), 'C'(G,test(A,B,C,D),J), 'C'(J,E,H). peep3r(A,label(B),A,C,D) :- distant_branch(A), 'C'(C,label(B),E), 'C'(E,A,D). peep3r(jump(A,B,C,D),jump(E),label(D),F,G) :- cond(A,H), lbl(E), 'C'(F,jump(H,B,C,E),I), 'C'(I,label(D),G). peep3r(jump_nt(A,B,C,D),jump(E),label(D),F,G) :- cond(A,H), lbl(E), 'C'(F,jump_nt(H,B,C,E),I), 'C'(I,label(D),G). peep3r(jump(A,B,C,D),fail,label(D),E,F) :- cond(A,G), 'C'(E,jump(G,B,C,fail),H), 'C'(H,label(D),F). peep3r(jump_nt(A,B,C,D),fail,label(D),E,F) :- cond(A,G), 'C'(E,jump_nt(G,B,C,fail),H), 'C'(H,label(D),F). peep3r(test(A,B,C,D),fail,label(D),E,F) :- eq_ne(A,G), 'C'(E,test(G,B,C,fail),H), 'C'(H,label(D),F). peep3r(test(A,B,C,D),jump(E),label(D),F,G) :- eq_ne(A,H), lbl(E), 'C'(F,test(H,B,C,E),I), 'C'(I,label(D),G). peep3r(move(A^B,C),adda(B,D,B),move(C,[C]),E,F) :- 'C'(E,move(A^B,C),G), 'C'(G,push(C,B,D),F), tag(A), integer(D), reg(C), reg(B), C\==B. peep3r(move(A,B),move(B,C),move(D,B),E,F) :- reg(B), \+is_in(B,C), \+is_in(B,D), 'C'(E,move(A,C),G), 'C'(G,move(D,B),F). peep3r(pragma(tag(A,B)),pragma(align(A,C)),move(D,r(void)),E,E) :- is_in(A,D). peep3r(pragma(tag(A,B)),pragma(align(A,C)),deref(D,r(void)),E,E) :- is_in(A,D). peep3(A,label(B),fail,C,D) :- local_instr(A), \+A=cut(E), \+A=fail, 'C'(C,fail,F), 'C'(F,label(B),G), 'C'(G,fail,D). peep3(pragma(tag(A,B)),move(C,D),move(C,E),F,G) :- reg(E), ind(D,A), a_var(A), \+reg(C), \+is_in(E,D), 'C'(F,move(C,E),H), 'C'(H,pragma(tag(A,B)),I), 'C'(I,move(E,D),G). peep3(move(A,B),pragma(tag(A,C)),move(B,[B]),D,E) :- perm(A), reg(B), 'C'(D,move(A,B),F), 'C'(F,pragma(tag(B,C)),G), 'C'(G,move(B,[B]),E). peep3(move(A^r(h),B),push(B,r(h),C),deref(B,D),E,F) :- reg(B), a_var(D), tag(A), 'C'(E,move(A^r(h),B),G), 'C'(G,push(B,r(h),C),H), 'C'(H,move(B,D),F). peep2r(add(A,B,C),test(ne,D,C,E),F,G) :- 'C'(F,add(A,B,C),G), tag(integer,D). peep2r(sub(A,B,C),test(ne,D,C,E),F,G) :- 'C'(F,sub(A,B,C),G), tag(integer,D). peep2r(div(A,B,C),test(ne,D,C,E),F,G) :- 'C'(F,div(A,B,C),G), tag(integer,D). peep2r(mul(A,B,C),test(ne,D,C,E),F,G) :- 'C'(F,mul(A,B,C),G), tag(integer,D). peep2r(pragma(A),pragma(A),B,C) :- 'C'(B,pragma(A),C). peep2r(pragma(tag(A,B)),deref(C,D),E,F) :- \+ind(C), \+ind(D), 'C'(E,deref(C,D),F). peep2r(allocate(A),deallocate(A),B,B). peep2r(jump_nt(A,B,C,D),label(D),E,F) :- 'C'(E,label(D),F). peep2r(A,B,C,D) :- distant_branch(A), \+B=label(E), 'C'(C,A,D). peep2r(label(A),label(A),B,C) :- 'C'(B,label(A),C). peep2r(move(A,B),move(B,A),C,D) :- \+is_in(B,A), 'C'(C,move(A,B),D). peep2r(move(A,B),move(C,B),D,E) :- \+is_in(B,C), 'C'(D,move(C,B),E). peep2r(move(A,B),move(A,B),C,D) :- \+is_in(B,A), 'C'(C,move(A,B),D). peep2r(return,return,A,B) :- 'C'(A,return,B). peep2r(move(A,B),jump(C/D),E,F) :- reg(B,G), low_reg(H), G>=D+H, functor(I,C,D), \+survive(I), 'C'(E,jump(C/D),F). peep2r(move(A,B),call(C/D),E,F) :- reg(B,G), low_reg(H), G>=D+H, functor(I,C,D), \+survive(I), 'C'(E,call(C/D),F). peep2r(A,fail,B,C) :- local_instr(A), \+A=cut(D), 'C'(B,fail,C). peep2r(A,fail,B,C) :- pure_branch(A,D), all_fails(D), 'C'(B,fail,C). peep2r(pragma(A),fail,B,C) :- 'C'(B,fail,C). peep2r(fail,fail,A,B) :- 'C'(A,fail,B). peep2r(fail,A,B,C) :- \+A=label(D), 'C'(B,fail,C). peep2r(pair(A,B),C,D,E) :- \+C=pair(F,G), \+C=label(H), 'C'(D,pair(A,B),E). peep2r(choice(1/A,B,C),cut(D),E,F) :- 'C'(E,cut(D),F). peep2r(choice(A/B,C,D),fail,E,F) :- 'C'(E,jump(D),F), A>1, A >B, 'C'(D,move(F,C),E). get_tag(A,B) :- integer(A), A>0, tag_always(nonnegative,B). get_tag(A,B) :- integer(A), A=<0, tag_always(negative,B). get_tag(A,B) :- float(A), tag_always(float,B). get_tag(A^B,A) :- tag(atom,A). eq_ne(eq,ne). eq_ne(ne,eq). tmatch(eq,A,A). tmatch(eq,A,B) :- tag(integer,A), tag_always(nonnegative,B). tmatch(eq,A,B) :- tag(integer,A), tag_always(negative,B). tmatch(eq,A,B) :- tag(integer,B), tag_always(nonnegative,A). tmatch(eq,A,B) :- tag(integer,B), tag_always(negative,A). tmatch(ne,A,B) :- \+tmatch(eq,A,B). s_oper(A,B) :- ( s_o(A,B) -> true ; A=B ). ind([A]). is_in(A,A). is_in(A,A+B). is_in(A,A-B). is_in(A,[A]). is_in(A,[A+B]). is_in(A,[A-B]). is_in(A,B^A) :- pointer_tag(B). is_in(A,B^ (A+C)) :- pointer_tag(B). is_in(A,B^ (A-C)) :- pointer_tag(B). reg(r(A),A) :- integer(A). reg(r(A)) :- atomic(A). perm(p(A)) :- integer(A). inc_reg(move(A,B),C,D,move(E,F)) :- add_ea(A,C,D,E), add_ea(B,C,D,F). inc_reg(pragma(A),B,C,pragma(A)). cond_ftest(A,f) :- cond_to_float(B,A). cond_ftest(A,i) :- cond_to_float(A,B). tag_ftest(A,f) :- tag(float,A). tag_ftest(A,i) :- tag(integer,A). tag_ftest(A,i) :- tag(negative,A). tag_ftest(A,i) :- tag(nonnegative,A). ftest(eq,f,i,A,nop). ftest(eq,i,f,A,nop). ftest(ne,f,f,A,nop). ftest(ne,i,i,A,nop). ftest(eq,f,f,A,jump(A)). ftest(eq,i,i,A,jump(A)). ftest(ne,i,f,A,jump(A)). ftest(ne,f,i,A,jump(A)). arith_ftest(add(A,B,C),i,A,B,C). arith_ftest(sub(A,B,C),i,A,B,C). arith_ftest(mul(A,B,C),i,A,B,C). arith_ftest(div(A,B,C),i,A,B,C). arith_ftest(mod(A,B,C),i,A,B,C). arith_ftest(and(A,B,C),i,A,B,C). arith_ftest(or(A,B,C),i,A,B,C). arith_ftest(xor(A,B,C),i,A,B,C). arith_ftest(not(A,B),i,A,B,dummy). arith_ftest(sll(A,B,C),i,A,B,C). arith_ftest(sra(A,B,C),i,A,B,C). arith_ftest(fadd(A,B,C),f,A,B,C). arith_ftest(fsub(A,B,C),f,A,B,C). arith_ftest(fdiv(A,B,C),f,A,B,C). arith_ftest(fmul(A,B,C),f,A,B,C). no_mod(move(A,B),C) :- C\==B. no_mod(f2i(A,B),C) :- C\==B. no_mod(i2f(A,B),C) :- C\==B. no_mod(add(A,B,C),D) :- D\==C. no_mod(sub(A,B,C),D) :- D\==C. no_mod(mul(A,B,C),D) :- D\==C. no_mod(div(A,B,C),D) :- D\==C. no_mod(mod(A,B,C),D) :- D\==C. no_mod(and(A,B,C),D) :- D\==C. no_mod(or(A,B,C),D) :- D\==C. no_mod(xor(A,B,C),D) :- D\==C. no_mod(sll(A,B,C),D) :- D\==C. no_mod(sra(A,B,C),D) :- D\==C. no_mod(not(A,B),C) :- C\==B. no_mod(fadd(A,B,C),D) :- D\==C. no_mod(fsub(A,B,C),D) :- D\==C. no_mod(fdiv(A,B,C),D) :- D\==C. no_mod(fmul(A,B,C),D) :- D\==C. no_mod(jump(A,B,C,D),E). no_mod(test(A,B,C,D),E). no_mod(switch(A,B,C,D,E),F). no_mod(nop,A). ind([A],A). a_var(A) :- reg(A). a_var(A) :- perm(A). tf_ft(true,false). tf_ft(false,true). add_ea(A^B,C,D,A^E) :- pointer_tag(A), add_reg(B,C,D,E). add_ea([A],B,C,[D]) :- add_reg(A,B,C,D). add_ea(A,B,C,D) :- add_reg(A,B,C,D). add_ea(A,B,C,A). add_reg(A+B,A,C,D) :- reg(A), integer(B), E is B-C, make_reg(A,E,D). add_reg(A-B,A,C,D) :- reg(A), integer(B), E is-B-C, make_reg(A,E,D). add_reg(A,A,B,C) :- reg(A), D is-B, make_reg(A,D,C). make_reg(A,B,A+B) :- B>0, !. make_reg(A,B,A) :- B=:=0, !. make_reg(A,B,A-C) :- B<0, !, C is-B. peep_flat([],A,A). peep_flat([A|B],C,D) :- peep_flat(A,B,C,D). peep_flat(switch(unify,A,B,C,D,E),F,G,H) :- !, 'C'(G,switch(A,B,I,J,E),K), 'C'(K,label(I),L), peep_flat(C,L,M), 'C'(M,jump(N),O), 'C'(O,label(J),P), peep_flat(D,P,Q), 'C'(Q,jump(N),R), 'C'(R,label(N),S), peep_flat(F,S,H). peep_flat(A,B,C,D) :- \+A=switch(unify,E,F,G,H,I), 'C'(C,A,J), peep_flat(B,J,D). an_atom(A) :- integer(A). an_atom(A^B) :- atom(B), tag(atom,A). an_atom(A^ (B/C)) :- atom(B), positive(C), tag(atom,A). complex(A^B). complex([A]). s_o(A+0,A) :- !. s_o(A-0,A) :- !. s_o([A+0],[A]) :- !. s_o([A-0],[A]) :- !. s_o(A+B,A-C) :- neg_abs(B,C), !. s_o(A-B,A+C) :- neg_abs(B,C), !. s_o([A+B],[A-C]) :- neg_abs(B,C), !. s_o([A-B],[A+C]) :- neg_abs(B,C), !. s_o(A^ (r(h)+0),A^r(h)) :- !. s_o(A^ (r(h)-0),A^r(h)) :- !. s_o(A^ (r(h)+B),A^ (r(h)-C)) :- neg_abs(B,C), !. s_o(A^ (r(h)-B),A^ (r(h)+C)) :- neg_abs(B,C), !. neg_abs(A,B) :- integer(A), A<0, B is-A. synonym([],[],A). synonym([A|B],C,D) :- synonym(A,B,C,D). synonym(A,B,C,D) :- equal_maker(A,E,F), !, make_set(E,F,G), equal_synonym(A,E,F,G,D,H,C,I), synonym(B,I,H). synonym(label(A),B,[label(A)|C],D) :- !, synonym(B,C,[]). synonym(A,B,C,D) :- synonym_step(A,D,E,C,F), synonym(B,F,E). equal_maker(move(A,B),A,B). equal_maker(equal(A,B,C),A,B). equal_maker(unify(A,B,C,D,E),A,B). make_set(A,B,C) :- A@=B, !, C=[B,A]. equal_synonym(A,B,C,D,E,F,[G|H],H) :- not_independent(A), !, map_equal_maker(A,I,G,J), cheapest_list(I,E,J), remove_if_move(A,E,C,F). equal_synonym(A,B,C,D,E,F,[G|H],H) :- \+is_syn(D,E), !, map_equal_maker(A,I,G,J), cheapest_list(I,E,J), remove_if_move(A,E,C,K), add_set(K,D,F). equal_synonym(A,B,C,D,E,E,F,F). synonym_step(A,B,C,D,E) :- synonym_step1(A,B,D,E), synonym_step2(A,B,C). synonym_step1(A,B,[C|D],D) :- map_instruction(A,E,C,F), !, cheapest_list(E,B,F). synonym_step1(A,B,[A|C],C). synonym_step2(A,B,C) :- destr_instruction(A,D), !, remove_all(B,D,C). synonym_step2(A,B,B). map_instruction(pragma(tag(A,B)),[A],pragma(tag(C,B)),[C]). map_instruction(pragma(align(A,B)),[A],pragma(align(C,B)),[C]). map_instruction(cut(A),[A],cut(B),[B]). map_instruction(trail(A),[A],trail(B),[B]). map_instruction(trail_if_var(A),[A],trail_if_var(B),[B]). map_instruction(unify_atomic(A,B,C),[A],unify_atomic(D,B,C),[D]). map_instruction(test(A,B,C,D),[C],test(A,B,E,D),[E]). map_instruction(jump(A,B,C,D),[B,C],jump(A,E,F,D),[E,F]). map_instruction(hash(A,B,C,D),[B],hash(A,E,C,D),[E]). map_instruction(switch(A,B,C,D,E),[B],switch(A,F,C,D,E),[F]). map_instruction(add(A,B,C),[A,B],add(D,E,C),[D,E]). map_instruction(sub(A,B,C),[A,B],sub(D,E,C),[D,E]). map_instruction(mul(A,B,C),[A,B],mul(D,E,C),[D,E]). map_instruction(div(A,B,C),[A,B],div(D,E,C),[D,E]). map_instruction(and(A,B,C),[A,B],and(D,E,C),[D,E]). map_instruction(or(A,B,C),[A,B],or(D,E,C),[D,E]). map_instruction(xor(A,B,C),[A,B],xor(D,E,C),[D,E]). map_instruction(not(A,B),[A],not(C,B),[C]). map_instruction(sll(A,B,C),[A,B],sll(D,E,C),[D,E]). map_instruction(sra(A,B,C),[A,B],sra(D,E,C),[D,E]). map_instruction(push(A,B,C),[A,B],push(D,E,C),[D,E]). map_instruction(jump_nt(A,B,C,D),[B,C],jump_nt(A,E,F,D),[E,F]). map_instruction(add_nt(A,B,C),[A,B],add_nt(D,E,C),[D,E]). map_instruction(sub_nt(A,B,C),[A,B],sub_nt(D,E,C),[D,E]). map_instruction(and_nt(A,B,C),[A,B],and_nt(D,E,C),[D,E]). map_instruction(or_nt(A,B,C),[A,B],or_nt(D,E,C),[D,E]). map_instruction(xor_nt(A,B,C),[A,B],xor_nt(D,E,C),[D,E]). map_instruction(not_nt(A,B),[A],not_nt(C,B),[C]). map_instruction(sll_nt(A,B,C),[A,B],sll_nt(D,E,C),[D,E]). map_instruction(sra_nt(A,B,C),[A,B],sra_nt(D,E,C),[D,E]). map_instruction(trail_bda(A,B),[A],trail_bda(C,B),[C]). map_instruction(queue_sda(A,B,C),[A,B],queue_sda(D,E,C),[D,E]). cheapest_list([],A,[]). cheapest_list([A|B],C,[D|E]) :- cheapest(A,C,D), cheapest_list(B,C,E). destr_instruction(simple_call(A/B),C) :- functor(D,A,B), require(D,E), uninit_set_type(reg,E,F), head_regs(D,F,C), cons(C). destr_instruction(cut(A),[r(b)]) :- \+A=r(b). destr_instruction(deref(A),[A]). destr_instruction(deref(A,B),[B]). destr_instruction(add(A,B,C),[C]). destr_instruction(adda(A,B,C),[C]). destr_instruction(sub(A,B,C),[C]). destr_instruction(mul(A,B,C),[C]). destr_instruction(div(A,B,C),[C]). destr_instruction(and(A,B,C),[C]). destr_instruction(or(A,B,C),[C]). destr_instruction(xor(A,B,C),[C]). destr_instruction(not(A,B),[B]). destr_instruction(sll(A,B,C),[C]). destr_instruction(sra(A,B,C),[C]). destr_instruction(push(A,B,C),[B]) :- C=\=0. destr_instruction(pad(A),[r(h)]) :- A=\=0. destr_instruction(choice(1/A,B,C),[r(b)]). destr_instruction(choice(A/B,C,D),E) :- 1 D=G ; D=[E|G] ), remove_all(B,C,G). not_independent(move(A,B)) :- ind(A), is_in(B,A). map_equal_maker(move(A,[B]),[A,B],move(C,[D]),[C,D]) :- !. map_equal_maker(move(A,B),[A],move(C,B),[C]) :- \+B=[D], !. map_equal_maker(equal(A,B,C),[A,B],equal(D,E,C),[D,E]) :- !. map_equal_maker(unify(A,B,C,D,E),[A,B],unify(F,G,C,D,E),[F,G]) :- !. remove_if_move(move(A,B),C,D,E) :- !, remove_all(C,[D],E). remove_if_move(A,B,C,B) :- \+A=move(D,E). is_syn(A,[B|C]) :- subset(A,B), !. is_syn(A,[B|C]) :- is_syn(A,C). add_set(A,[],A) :- !. add_set(A,[B],A) :- !. add_set([A|B],C,[D|B]) :- not_disjoint(C,A), !, union(C,A,D). add_set([A|B],C,[A|D]) :- add_set(B,C,D). add_set([],A,[A]). head_regs(A,B,C) :- head_regs(A,B,C,[]). regset_to_regs([],[]). regset_to_regs([A|B],[r(A)|C]) :- integer(A), !, regset_to_regs(B,C). regset_to_regs([no|A],B) :- regset_to_regs(A,B). intersect_syn([A|B],C,[D|E]) :- member(F,C), intersect(A,F,D), \+D=[], !, diff(C,[F],G), intersect_syn(B,C,E). intersect_syn([A|B],C,D) :- intersect_syn(B,C,D). intersect_syn([],A,[]). remove_one([],A,[]). remove_one([A|B],C,D) :- uses_el(A,C), !, remove_one(B,C,D). remove_one([A|B],C,[A|D]) :- remove_one(B,C,D). uses_el([A],B) :- uses_el(A,B). uses_el(A+B,C) :- uses_el(A,C). uses_el(A^B,C) :- pointer_tag(A), uses_el(B,C). uses_el(p(A),B) :- member(p(C),B), var(C), !. uses_el(r(A),B) :- member(r(C),B), var(C), !. uses_el([A],B) :- !, member([C],B). uses_el(A,B) :- memberv(A,B). less_p(A,B) :- cost_syn(A,C), cost_syn(B,D), C@ 0, !. choice_block(A,B,C,D,E,F,G,(H;I),J,K,L,M,N) :- !, O is K+1, 'C'(M,label(J),P), functor(A,Q,R), cp_instr(C,D,E,H,A,O,L,I,S,P,T), % stats(d,O), code(A,B,F,G,H,T,U), choice_block(A,B,C,D,E,F,G,I,S,O,L,U,N). choice_block(A,B,C,D,E,F,G,H,I,J,K,L,M) :- \+disj_p(H), !, choice_block(A,B,C,D,E,F,G,(H;fail),I,J,K,L,M). cp_instr(A,B,C,D,E,1,F,fail,G,H,H) :- !. cp_instr(A,B,C,D,E,F,G,H,I,J,K) :- F=:=1, !, 'C'(J,choice(F/G,A,I),K). cp_instr(A,B,C,D,E,F,G,H,I,J,K) :- F>1, !, varset_conj(D,L), unionv(B,L,M), diffv(M,C,N), varset_numset(E,N,O), format_numset(A,O,P), 'C'(J,choice(F/G,P,I),K). varset_conj(A,B) :- varbag_conj(A,C,[]), sort(C,B). format_numset([A|B],[A|C],[A|D]) :- !, format_numset(B,C,D). format_numset([A|B],[C|D],[no|E]) :- A B, !. varset_numset(A,B,C,D,E,F) :- A=B, !, E=r(arity_error). head_reg(A,B,C,D,E) :- A=0, arg(A,B,G), inv(G,D), !, 'C'(E,r(H),I), J is A-1, H is A+C-1, head_regs(J,B,C,D,I,F). head_regs(A,B,C,D,E,F) :- A>0, !, G is A-1, head_regs(G,B,C,D,E,F). testset(A) :- testset(A,B,C,D,E). testset(A,B,C,D,E) :- testset(A,B,true,C,D,E). testset(A,'$name_arity'(B,C,0),D,equal(atomic,C),v(B),true,false) :- test_type_name_arity(A,B,E,C,0), atomic_type(E). testset(A,not('$name_arity'(B,C,0)),D,equal(atomic,C),v(B),false,true) :- logical_simplify(not(A),E), test_type_name_arity(E,B,F,C,0), atomic_type(F). testset(A,'$name_arity'(B,C,D),E,equal(structure,C/D),v(B),true,false) :- test_type_name_arity(A,B,structure,C,D). testset(A,not('$name_arity'(B,C,D)),E,equal(structure,C/D),v(B),false,true) :- logical_simplify(not(A),F), test_type_name_arity(F,B,structure,C,D). testset(A,'$name_arity'(B,C,D),E,hash(F),v(B),G,not(G)) :- test_type_name_arity(A,B,H,C,D), H\==cons, ( H==float, true -> % float -> F=float ; H==float, fail -> % \+float -> F=denumerable ; denumerable_type(H) -> F=denumerable ; F=structure ), ( D>0 -> G=C/D ; G=C ). testset(A,A,B,comparison(C,D),v(E,F),G,H) :- D=arith, encode_relop(A,E,I,F,D), E@= 0, \+ (A='.' ',' B=:=2). name_arity_type(A,B,cons) :- A=='.', integer(B), B=:=2. negation(\+A,A) :- !. negation(not(A),A) :- !. out_negation(not(A),A) :- !. out_negation(A,not(A)) :- !. entry_comment(A,B,C) :- fail, % compile_option(entry_comment), !, length(C,D), comment(A,['(',B,') is called with ',C]). entry_comment(A,B,C) :- true, % \+compile_option(entry_comment), !. split_uninit_list([],[],[],[],[]). split_uninit_list([entry(A,B)|C],[D|E],[F|G],[H|I],[J|K]) :- split_uninit(B,H,J), uninit_set_type(mem,H,D), uninit_set_type(reg,H,F), split_uninit_list(C,E,G,I,K). insert_uninit([],A,B,[],C,D,D). insert_uninit([A|B],C,D,[entry(E,F)|G],H,I,J) :- diffv(A,D,K), 'C'(I,label(E),L), init_code_block(K,C,L,M), 'C'(M,jump(H),N), insert_uninit(B,C,D,G,H,N,J). uninit_origins(A,B) :- origin_fragments(A,C,[]), keysort(C,D), origin_merge(D,B). make_uninit_mem_formula([],A,B,B). make_uninit_mem_formula([A|B],C,D,E) :- member_origin(A-F,C), !, co(uninit(mem,A,F),D,G), make_uninit_mem_formula(B,C,G,E). make_uninit_mem_formula([A|B],C,D,E) :- co(uninit(A),D,F), make_uninit_mem_formula(B,C,F,E). make_uninit_reg_formula([],A,A). make_uninit_reg_formula([A|B],C,D) :- co(uninit(reg,A),C,E), make_uninit_reg_formula(B,E,D). init_code_block([],A,B,B). init_code_block([A|B],C,D,E) :- find_arg(F,C,A), !, low_reg(G), H is G+F-1, pragma_tag(H,var,D,I), 'C'(I,move(H,[H]),J), init_code_block(B,C,J,E). init_code_block([A|B],C,D,E) :- error(C,['Variable ',A,' is not initialized.']), init_code_block(B,C,D,E). member_origin(A-B,[C-D|E]) :- A==C, !, B=D. member_origin(A-B,[C|D]) :- member_origin(A-B,D). origin_fragments([],A,A). origin_fragments([A|B],C,D) :- origin_formula(A,C,E), origin_fragments(B,E,D). origin_merge([],[]). origin_merge([A-B|C],D) :- origin_merge(C,A,E,D,[]). origin_formula((A ',' B),C,D) :- !, origin_formula(A,C,E), origin_formula(B,E,D). origin_formula(uninit(mem,A,B),C,D) :- !, 'C'(C,A-B,D). origin_formula(A,B,B). origin_merge([],A,B,C,D) :- 'C'(C,A-B,D). origin_merge([A-B|C],D,E,F,G) :- D==A, !, append(B,E,H), origin_merge(C,D,H,F,G). origin_merge([A-B|C],D,E,F,G) :- D\==A, !, 'C'(F,D-E,H), origin_merge(C,A,B,H,G). clause_code(A,B,C,D,E,F,G) :- standard_form(A,H,I), logical_simplify(D,J), clause_code_3((H:-I),B,C,J,E,F,G). clause_code_3(A,B,C,fail,fail,D,E) :- !, 'C'(D,fail,E). clause_code_3(A,B,C,D,E,F,G) :- \+D=fail, 'C'(F,H,I), copy([A|D],[J|K]), clause(J,B,L,K,M,I,N), copy([J|M],[A|E]), 'C'(N,O,P), return_jump(C,P,G), clause_allocate(L,Q,R), environment(Q,R,H,O), !. clause((A:-B),C,(A:-D),E,F,G,H) :- uninit_set_type(reg,E,I), head_moves_pre(A,I,J,K,G,L), find_gperms((A:-B),M), uninit_allowset(B,C,N), varbag((A:-B),O), filter_uniq(O,P), body(B,no,Q,M,N,C,P,[],R,[],S,[],T,[],U,J,V,E,F,L,W), head_moves_post_c(A,I,X,T,U,W,H), flat_conj(('$varlist'(K)',' Q ',' '$varlist'(X)),D). return_jump(return,A,B) :- 'C'(A,return,B). return_jump(jump(A),B,C) :- 'C'(B,jump(A),C). clause_allocate(A,B,C) :- % stats(reg,1), varlist(A,D), local_allocate(D,B,C). clause_allocate(A,B,C) :- error(['Register allocation could not be done for the clause:',nl,A,nl,'because of a bug in the register allocation routine.']). environment(no,A,nop,nop). environment(yes,A,allocate(A),deallocate(A)). head_moves_pre(A,B,C,D,E,F) :- A=..[G|H], low_reg(I), head_moves_pre_2(H,I,B,D,E,F), sort(H,J), diffv(J,B,C). find_gperms(A,B) :- split(A,C,D), varset(C,E), gpermvars(D,E,F,[],G,[],B). uninit_allowset(A,B,C) :- uninit_allowbag(A,B,D,E,[],[],F), sort(E,C). body(A,B,fail,C,D,E,F,G,G,H,H,I,I,J,J,K,K,L,L,M,N) :- L=fail, !, M=[fail|N], true. body(true,no,'$varlist'(A),B,C,D,E,F,F,G,G,H,H,I,I,J,K,L,M,N,O) :- !, init_uninit([],A,[],J,K,L,M,N,O), true. body((A ',' B),no,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U) :- !, efficient_entry(A,V,G,R,W,P,X), flat_conj(V,Y), union_conj_eff(Y,B,Z,A1), body(Z,A1,C,D,E,F,G,H,I,J,K,L,M,N,O,X,Q,W,S,T,U), true. body((A ',' B),(yes ',' C),(D ',' E ',' F ',' G ',' H),I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z) :- % stats(goal,A), W=A1, split_formula(B1,U,A,A1,C1,D1), % stats(x,8), last_goal_adjust(B,C1,D1,E1,F1), % stats(x,9), perm_c(A,D,I,M,G1,O,H1,Q,I1,S,J1,U,K1,E1,L1,Y,M1), % stats(x,10), map_terms(G1,H1,A,N1), % stats(x,11), map_terms(G1,H1,L1,O1), % stats(x,12), uninit_bag_type(mem,O1,P1), % stats(x,13), goal_c(N1,E,Q1,R1,S1,J,K,T1,P1,I1,U1,J1,V1,K1,W1,O1,X1,M1,Y1), sort(T1,Z1), make_indirect(Z1,A2), append(Z1,U1,B2), append(A2,V1,C2), x_call_moves_post_c2(Q1,F,B2,D2,C2,E2,Y1,F2), args_post_c2(R1,G,D2,G2,E2,H2,W1,I2,X1,J2,F2,K2), update_formula(S1,J2,L2), map_terms(H1,G1,L2,M2), M2=N2, combine_formula(N2,F1,O2), body(B,C,H,I,J,K,L,G1,N,H1,P,G2,R,H2,T,I2,V,O2,X,K2,Z), true. head_moves_post_c(A,B,C,D,E,F,G) :- cons(D), !, head_moves_post(A,B,H,I,[]), map_instr_list(I,D,E,F,G), map_varlist_list(H,C,D). head_moves_post_c(A,B,C,D,E,F,G) :- head_moves_post(A,B,C,F,G). uninit_allowbag((A ',' B),C,D,E,F,G,H) :- !, uninit_allowbag(A,C,I,E,J,G,K), uninit_allowbag(B,I,D,J,F,K,H), true. uninit_allowbag((A;B),C,D,E,F,G,H) :- !, uninit_allowbag(A,C,I,E,J,G,K), uninit_allowbag(B,I,D,J,F,K,H), true. uninit_allowbag('$body'((A:-B),C,D),E,F,G,H,I,J) :- !, uninit_allowbag(B,E,F,G,H,I,J), true. uninit_allowbag(A,B,B,C,D,E,F) :- functor(A,G,H), member(stree(G/H,(I:-J),(K:-L),M,N,O),B), !, copy((K:-L),(A:-P)), uninit_bag(P,C,Q), copy((I:-J),(A:-R)), B=S, uninit_allowbag(R,N,T,Q,D,E,F), T=U, true. uninit_allowbag(A,B,B,C,D,E,E) :- require(A,F), uninit_bag(F,C,D), true. init_uninit(A,B,C,D,E,F,G,H,I) :- varbag(A,J), init_uninit(J,F,B,C,D,E,H,I,K,[]), remove_uninit(K,F,G), true. efficient_entry(A,B,C,D,D,E,E) :- modal_entry(A,F), add_uninit_void(A,E,C,D,G), tree_trav_entry(F,G,B), !, comment(['Replaced ',A,' by ',B]), comment(A,['The mode formula at this point is ',G]). efficient_entry(A,A,B,C,C,D,D). union_conj_eff((A ',' B),C,(A ',' D),(yes ',' E)) :- union_conj_eff(B,C,D,E). union_conj_eff(true,A,A,no). last_goal_adjust(true,A,B,C,D) :- !, split_uninit(B,E,D), combine_formula(E,A,C). last_goal_adjust(A,B,C,B,C) :- \+A=true, !. perm_c(A,B,C,D,E,F,G,H,H,I,I,J,K,L,M,N,O) :- cons(H), !, perm(A,P,C,D,E,F,G,J,K,L,M,Q,[]), map_instr_list(Q,H,I,N,O), map_varlist(P,B,H), true. perm_c(A,B,C,D,E,F,G,H,H,I,I,J,K,L,M,N,O) :- perm(A,B,C,D,E,F,G,J,K,L,M,N,O), true. goal_c(A,B,C,D,E,F,G,H,I,J,K,L,L,M,N,O,P,Q,R) :- cons(J), !, goal(A,S,C,D,E,F,G,H,I,J,K,M,N,O,P,T,[]), map_instr_list(T,J,L,Q,R), map_varlist(S,B,J), true. goal_c(A,B,C,D,E,F,G,H,I,J,K,L,L,M,N,O,P,Q,R) :- goal(A,B,C,D,E,F,G,H,I,J,K,M,N,O,P,Q,R), true. make_indirect([],[]). make_indirect([A|B],[[A]|C]) :- make_indirect(B,C). x_call_moves_post_c2(data(A,B),C,D,D,E,E,F,G) :- cons(D), !, x_call_moves_post(A,B,H,[],I,[]), map_instr_list(I,D,E,F,G), map_varlist_goal(H,C,D), true. x_call_moves_post_c2(data(A,B),'$varlist'(C),D,D,E,E,F,G) :- !, x_call_moves_post(A,B,C,[],F,G), true. x_call_moves_post_c2(none,'$varlist'([]),A,A,B,B,C,C). args_post_c2(data(A,B,C),D,E,E,F,F,G,H,I,J,K,L) :- cons(E), !, args_post(A,B,C,M,[],G,H,I,J,N,[]), map_instr_list(N,E,F,K,L), map_varlist_goal(M,D,E), true. args_post_c2(data(A,B,C),'$varlist'(D),E,E,F,F,G,H,I,J,K,L) :- !, args_post(A,B,C,D,[],G,H,I,J,K,L), true. args_post_c2(none,'$varlist'([]),A,A,B,B,C,C,D,D,E,E). goal(A,'$varlist'(B),C,none,true,D,E,F,F,G,G,H,I,J,K,L,M) :- call_p(A), unwrap_goal(A,N,yes), !, init_uninit(N,B,O,H,P,J,Q,L,R), functor(N,S,T), gensym([36,101,95],S/T,U), unwrap_form(A,U/T,Q,V), uninit_set_type(reg,V,W), x_call_moves_pre(N,W,O,X,R,Y), fence_if_die(N,X,[]), Y=[call(U/T)|M], x_call_moves_post_c1(N,W,C), unionv(W,P,I), remove_vars(V,Z), remove_all_uninit(Z,K), true. goal(A,B,none,C,D,E,F,G,H,I,I,J,K,L,M,N,O) :- call_p(A), unwrap_goal(A,P,no), !, functor(P,Q,R), P=..[Q|S], B= ('$varlist'(T)',' U ',' '$varlist'(V)',' W), parameter_setup(P,X,Y,T,Z,J,A1,L,B1,N,C1), % stats(x,15), args_pre(X,S,D1,G,H,Z,[],A1,E1,B1,F1,C1,G1), % stats(x,data16(ireq(Y),form(F1))), H1=..[Q|D1], rtests_m(Y,U,F1,I1,G1,J1), % stats(x,17), warn_fail(A,I1,K1), init_uninit(pair(S,D1),V,[],E1,K,K1,L1,J1,M1), % stats(x,18), the_call(P,H1,W,X,D1,F,L1,N1,M1,O), remove_all_uninit(N1,O1), after(P,D), map_vars(S,D1,D,P1), update_formula(P1,O1,M), args_post_c1(X,S,D1,C), true. goal(A=B,'$varlist'(C),none,none,true,D,E,F,F,G,H,I,J,K,L,M,N) :- init_uninit(A=B,C,O,I,P,K,Q,M,R), unify_g(A=B,O,D,P,J,Q,L,R,N,G,H), true. map_varlist(A,B,C) :- bodylist(A,D,[]), map_varlist_goal(D,B,C). head_moves_post(A,B,C,D,E) :- head_moves_post_2(B,A,C,D,E). map_varlist_list(A,B,C) :- map_varlist_list(A,C,B,[]). perm(A,'$varlist'(B),C,D,E,F,G,H,I,J,K,L,M) :- write_once, !, vars_to_rename(A,J,N), intersectv(N,C,O), intersectv(O,H,P), copy(P,Q), sort(Q,R), update_mapping(P,R,S,D,E,F,G), init_extra_vars(P,R,S,B,[],H,I,J,K,L,M), true. perm(A,'$varlist'([]),B,C,C,D,D,E,E,F,F,G,G) :- \+write_once, !, true. x_call_moves_post_c1(A,B,data(A,B)). x_call_moves_post(A,B,C,D,E,F) :- x_call_moves_post_2(B,A,C,D,E,F). map_varlist_goal(A,'$varlist'(B,C),D) :- map_varlist_list(A,D,B,C). args_post_c1(A,B,C,data(A,B,C)). args_post([],[],[],A,A,B,B,C,C,D,D) :- !, true. args_post([flag(A,B)|C],[D|E],[F|G],H,I,J,K,L,M,N,O) :- one_arg_post(A,B,D,F,H,P,J,Q,L,R,N,S), args_post(C,E,G,P,I,Q,K,R,M,S,O), true. bodylist((A ',' B),C,D) :- !, bodylist(A,C,E), bodylist(B,E,D). bodylist(A,B,C) :- goallist(A,B,C). map_varlist_list([],A,B,B). map_varlist_list([A,B,C|D],E,F,G) :- A==pref, ( memberv(B,E) ; memberv(C,E) ), !, 'C'(F,B,H), 'C'(H,C,I), map_varlist_list(D,E,I,G). map_varlist_list([A|B],C,D,E) :- 'C'(D,A,F), map_varlist_list(B,C,F,E). unwrap_goal('$body'((A:-B),C,D),A,yes) :- !. unwrap_goal(A,A,no). unwrap_form('$body'((A:-B),C,D),E,F,F) :- !, end_of_list(D,G), G=[entry(E,F)|H]. unwrap_form(A,B,C,C). x_call_moves_pre(A,B,C,D,E,F) :- varset(A,G), diffv(G,B,H), x_call_moves_pre_2(H,A,C,D,E,F). fence_if_die(A,B,B) :- survive(A), !. fence_if_die(A,B,C) :- \+survive(A), !, 'C'(B,fence,C). parameter_setup(A,B,C,D,E,F,G,H,I,J,K) :- functor(A,L,M), A=..[L|N], uninit_set(H,O), uninit_set_type(mem,H,P), term_dupset_varset(A,Q,R), diffv(R,F,S), unionv(S,O,T), intersectv(Q,T,U), warn_dup_uninit(A,U), init_uninit_set(U,P,D,E,F,G,H,V,J,K), remove_uninit(U,V,I), uninit_set_type(reg,I,W), uninit_set_type(mem,I,X), get_given_flags(W,X,G,N,B), require(A,Y), split_uninit(Y,Z,C), uninit_set_type(reg,Z,A1), uninit_set_type(mem,Z,B1), get_req_flags(A1,B1,N,B), warn_req_uninit(1,A,B,L/M), true. args_pre([],[],[],A,A,B,B,C,C,D,D,E,E) :- !, true. args_pre([flag(A,B)|C],[D|E],[F|G],H,I,J,K,L,M,N,O,P,Q) :- one_arg_pre(A,B,D,F,H,R,J,S,L,T,N,U,P,V), args_pre(C,E,G,R,I,S,K,T,M,U,O,V,Q), true. warn_fail(A,B,B) :- B=fail, !, warning(['Bad require modes--the goal ',A,' can never be reached.']). warn_fail(A,B,B). the_call(A,B,C,D,E,F,G,H,I,J) :- expand(A,B,C,G,H,I,J), !, true. the_call(A,B,'$varlist'(C,D),E,F,G,H,H,I,J) :- macro_expand(B,I,J,C,K,L,M), !, fence_if_die(B,K,D), true. the_call(A,B,'$varlist'(C),D,E,F,G,H,I,J) :- \+anyregs(B), !, low_reg(K), call_moves_pre(K,D,E,C,L,I,M), fence_if_die(B,L,N), functor(B,O,P), % stats(x,19), call_instruction(O/P,B,F,M,Q), call_moves_post(K,D,E,N,[],Q,J), remove_vars(G,H), true. the_call(A,B,B,C,D,E,F,G,H,I) :- anyregs(B), !, H=[call(B)|I], functor(B,J,K), remove_vars(F,G), true. unify_g(A=B,C,D,E,F,G,H,I,J,K,K) :- var(A), compound(B), memberv(A,K), \+implies(G,unbound(A)), !, unify_goal((A=L ',' L=B),C,D,E,F,G,H,I,J), true. unify_g(A=B,C,D,E,F,G,H,I,J,K,K) :- var(B), compound(A), memberv(B,K), \+implies(G,unbound(B)), !, unify_goal((B=L ',' L=A),C,D,E,F,G,H,I,J), true. unify_g(A=B,C,D,E,F,G,H,I,J,K,K) :- unify_goal(A=B,C,D,E,F,G,H,I,J), true. unify_goal(A,B,C,D,E,F,G,H,I) :- unify(A,C,D,E,B,[],F,G,fail,H,I). end_of_list(A,B) :- var(A), !, A=B. end_of_list(A,B) :- nonvar(A), !, A=[C|D], end_of_list(D,B). init_uninit(A,(B ',' C),D,E,F,G,H,I,J,K) :- !, init_uninit(A,B,D,L,F,M,H,N,J,O), init_uninit(A,C,L,E,M,G,N,I,O,K), true. init_uninit(A,B,C,D,E,F,G,H,I,J) :- an_uninit_mode(B,mem,K), \+memberv(K,A), !, pragma_tag(K,var,G,L), I=[K|J], C=[K|D], includev(K,E,F), L=[move(K,[K])|H], true. init_uninit(A,B,C,D,E,F,G,H,I,J) :- an_uninit_mode(B,reg,K), \+memberv(K,A), !, I=[K|J], new_var_nf(K,E,F,C,D,G,H), true. init_uninit(A,B,C,C,D,D,E,E,F,F). new_var_nf(A,B,C,D,E,F,G) :- includev(A,B,C), D=[A|H], H=[A|E], tag(var,I), F=[move(I^r(h),A)|J], J=[pragma(push(variable))|K], K=[push(A,r(h),1)|L], align_calc(1,M,N), align_pad(N,L,G), true. init_uninit_set([],A,B,B,C,C,D,D,E,E) :- !, true. init_uninit_set([A|B],C,D,E,F,G,H,I,J,K) :- inv(A,C), !, pragma_tag(A,var,J,L), D=[A|M], includev(A,F,N), L=[move(A,[A])|O], init_uninit_set(B,C,M,E,N,G,H,I,O,K), true. init_uninit_set([A|B],C,D,E,F,G,H,I,J,K) :- \+inv(A,C), !, new_var_nf(A,F,L,D,M,J,N), init_uninit_set(B,C,M,E,L,G,H,I,N,K), true. macro_expand(A,B,C,D,E,F,G) :- macro(A,B,C,D,E,H), sort(H,I), unionv(I,F,G). call_moves_pre(A,[],[],B,B,C,C) :- !. call_moves_pre(A,[flag(B,reg)|C],[D|E],F,G,H,I) :- !, J is A+1, call_moves_pre(J,C,E,F,G,H,I). call_moves_pre(A,[B|C],[D|E],[pref,D,r(A)|F],G,H,I) :- 'C'(H,move(D,r(A)),J), K is A+1, call_moves_pre(K,C,E,F,G,J,I). call_instruction(A,B,C,D,E) :- F=stree(A,G,H,I,J,K), member(F,C), !, compile_stree(F,nopeep,jump(L),noheader,D,E), true. call_instruction(A,B,C,D,E) :- survive(B), !, D=[simple_call(A)|E], true. call_instruction(A,B,C,D,E) :- \+survive(B), !, D=[call(A)|E], true. call_moves_post(A,[],[],B,B,C,C) :- !. call_moves_post(A,[flag(B,reg)|C],[D|E],[pref,r(A),D|F],G,H,I) :- !, 'C'(H,move(r(A),D),J), K is A+1, call_moves_post(K,C,E,F,G,J,I). call_moves_post(A,[B|C],[D|E],F,G,H,I) :- J is A+1, call_moves_post(J,C,E,F,G,H,I). warn_dup_uninit(A,[]) :- !. warn_dup_uninit(A,[B]) :- !, comment(A,['Argument ',B,' of ',A,' is duplicated.']). warn_dup_uninit(A,B) :- cons(B), !, comment(A,['Arguments ',B,' of ',A,' are duplicated.']). get_given_flags(A,B,C,[],[]) :- !. get_given_flags(A,B,C,[D|E],[flag(F,G)|H]) :- get_given_one(A,B,C,D,F), get_given_flags(A,B,C,E,H). get_req_flags(A,B,[],[]) :- !. get_req_flags(A,B,[C|D],[flag(E,F)|G]) :- get_req_one(A,B,C,F), get_req_flags(A,B,D,G). warn_req_uninit(A,B,[],C) :- !. warn_req_uninit(A,B,[flag(ini,mem)|C],D) :- !, arg(A,B,E), warning(B,['Argument ',E,' of ',B,' is given an init but requires an uninit.']), F is A+1, warn_req_uninit(F,B,C,D). warn_req_uninit(A,B,[C|D],E) :- F is A+1, warn_req_uninit(F,B,D,E). get_given_one(A,B,C,D,ini) :- nonvar(D), !. get_given_one(A,B,C,D,mem) :- var(D), inv(D,B), !. get_given_one(A,B,C,D,ini) :- var(D), inv(D,C), !. get_given_one(A,B,C,D,reg(sf)) :- var(D), \+inv(D,C), !. get_given_one(A,B,C,D,reg(uni)) :- var(D), inv(D,A), !. get_req_one(A,B,C,mem) :- inv(C,B), !. get_req_one(A,B,C,reg) :- inv(C,A), !. get_req_one(A,B,C,ini). one_arg_pre(reg(A),reg,B,B,C,C,D,D,E,E,F,F,G,G) :- !, true. one_arg_pre(mem,reg,A,B,C,D,E,E,F,F,G,G,H,H) :- !, C=[A|D], true. one_arg_pre(ini,reg,A,B,C,C,D,D,E,E,F,F,G,G) :- !, true. one_arg_pre(reg(uni),mem,A,B,C,D,E,F,G,H,I,I,J,K) :- !, includev(B,G,H), C=[B|D], E=[B|L], L=[B|F], tag(var,M), N=1, % align(N), O is N-1, J=[move(M^r(h),B)|P], P=[adda(r(h),1,r(h))|Q], Q=[pad(O)|K], true. one_arg_pre(reg(sf),mem,A,B,C,D,E,F,G,H,I,I,J,K) :- !, includev(A,G,L), includev(B,L,H), C=[A|M], M=[B|D], E=[A|N], N=[pref|O], O=[A|P], P=[B|Q], Q=[B|F], tag(var,R), S=1, % align(S), T is S-1, J=[move(R^r(h),A)|U], U=[move(R^r(h),B)|V], V=[adda(r(h),1,r(h))|W], W=[pad(T)|K], true. one_arg_pre(mem,mem,A,A,B,C,D,D,E,E,F,F,G,G) :- !, B=[A|C], true. one_arg_pre(ini,mem,A,B,C,D,E,F,G,H,I,J,K,L) :- !, includev(B,G,H), C=[B|D], E=[B|M], M=[B|F], tag(var,N), O=1, % align(O), P is O-1, K=[move(N^r(h),B)|Q], Q=[adda(r(h),1,r(h))|R], R=[pad(P)|L], combine_formula(uninit(B),I,J), true. one_arg_pre(reg(uni),ini,A,B,C,D,E,F,G,H,I,J,K,L) :- !, C=[B|D], new_var(B,G,H,E,F,I,J,K,L), true. one_arg_pre(reg(sf),ini,A,B,C,D,E,F,G,H,I,J,K,L) :- !, C=[A|M], M=[B|D], new_var(A,B,G,H,E,F,I,J,K,L), true. one_arg_pre(mem,ini,A,B,C,D,E,F,G,H,I,J,K,L) :- !, includev(B,G,H), C=[A|M], M=[B|D], E=[A|N], N=[pref|O], O=[A|P], P=[B|F], pragma_tag(A,var,K,Q), Q=[move(A,[A])|R], R=[move(A,B)|L], combine_formula((deref(A)',' var(A)',' A==B),I,J), true. one_arg_pre(ini,ini,A,B,C,D,E,F,G,H,I,J,K,L) :- !, varset(A,M), diffv(M,G,N), difflist(N,C,D), create_arg(A,B,G,H,E,F,I,J,K,L), true. one_arg_post(reg(A),reg,B,B,C,C,D,E,F,F,G,G) :- !, includev(B,D,E), true. one_arg_post(mem,reg,A,B,C,D,E,F,G,G,H,I) :- !, includev(B,E,F), C=[B|J], J=[A|D], H=[move(B,A)|I], true. one_arg_post(ini,reg,A,B,C,D,E,F,G,H,I,J) :- !, includev(B,E,K), unify(B=A,K,F,C,D,G,H,I,J), true. one_arg_post(reg(uni),mem,A,B,C,D,E,F,G,G,H,I) :- !, includev(A,E,F), C=[B|J], J=[A|D], H=[move(B,A)|I], true. one_arg_post(reg(sf),mem,A,B,C,C,D,D,E,E,F,F) :- !, true. one_arg_post(mem,mem,A,B,C,C,D,D,E,E,F,F) :- !, true. one_arg_post(ini,mem,A,B,C,D,E,F,G,H,I,J) :- !, unify(B=A,E,F,C,D,G,H,I,J), true. one_arg_post(reg(uni),ini,A,B,C,D,E,F,G,G,H,I) :- !, includev(A,E,F), C=[B|J], J=[A|D], H=[move(B,A)|I], true. one_arg_post(reg(sf),ini,A,B,C,C,D,D,E,E,F,F) :- !, true. one_arg_post(mem,ini,A,B,C,C,D,D,E,E,F,F) :- !, true. one_arg_post(ini,ini,A,B,C,C,D,D,E,E,F,F) :- !, true. new_var(A,B,C,D,E,F,G,H,I) :- combine_formula((deref(A)',' var(A)),F,G), new_var_nf(A,B,C,D,E,H,I), true. new_var(A,B,C,D,E,F,G,H,I,J) :- A\==B, !, combine_formula((deref(A)',' var(A)',' deref(B)',' var(B)),G,H), new_var_nf(A,B,C,D,E,F,I,J), true. new_var(A,B,C,D,E,F,G,H,I,J) :- A==B, !, new_var(A,C,D,E,F,G,H,I,J), true. create_arg(A,A,B,B,C,C,D,D,E,E) :- var(A), inv(A,B), !, true. create_arg(A,B,C,D,E,F,G,G,H,I) :- var(A), \+inv(A,C), !, new_var_nf(A,B,C,D,E,F,H,I), true. create_arg(A,B,C,C,D,D,E,E,F,F) :- atomic(A), !, make_word(A,B), true. create_arg(A,B,C,D,E,F,G,H,I,J) :- compound(A), !, term_formula(B,A,G,K), combine_formula(deref(B),K,H), E=[B|L], includev(B,C,M), make_word(A,N), I=[move(N,B)|O], M=P, uninit_set(H,Q), intersectv(P,Q,R), diffv(P,R,S), uninit_set_type(mem,H,T), writemode(A,T,S,U,L,F,O,J), U=V, unionv(V,R,D), true. unify(A=B,C,D,E,F,G,H,I,J) :- varset(A=B,K), unify(A=B,K,C,D,E,F,G,H,fail,I,J). call_moves(A,[],B,B) :- !. call_moves(A,[B|C],D,E) :- !, 'C'(D,move(B,r(A)),F), G is A+1, call_moves(G,C,F,E). head_moves_pre_2([],A,B,[],C,C) :- !. head_moves_pre_2([A|B],C,D,E,F,G) :- inv(A,D), !, H is C+1, head_moves_pre_2(B,H,D,E,F,G). head_moves_pre_2([A|B],C,D,[pref,r(C),A|E],F,G) :- 'C'(F,move(r(C),A),H), I is C+1, head_moves_pre_2(B,I,D,E,H,G). head_moves_post_2([],A,[],B,B). head_moves_post_2([A|B],C,[pref,A,D|E],F,G) :- head_reg(C,A,D), 'C'(F,move(A,D),H), head_moves_post_2(B,C,E,H,G). x_call_moves_pre_2([],A,B,B,C,C). x_call_moves_pre_2([A|B],C,[pref,A,D|E],F,G,H) :- head_reg(C,A,D), 'C'(G,move(A,D),I), x_call_moves_pre_2(B,C,E,F,I,H). x_call_moves_post_2([],A,B,B,C,C). x_call_moves_post_2([A|B],C,[pref,D,A|E],F,G,H) :- head_reg(C,A,D), 'C'(G,move(D,A),I), x_call_moves_post_2(B,C,E,F,I,H). vars_to_rename(A,B,C) :- survive(A), !, vars_to_be_dereffed(A,B,D), bindset(A,B,E), unionv(D,E,C). vars_to_rename(A,B,C) :- \+survive(A), !, vars_to_be_dereffed(A,B,C). update_mapping(A,B,C,D,E,F,G) :- map_terms(D,F,A,C), map_terms(C,B,F,H), diffv(A,D,I), map_terms(A,B,I,J), append(J,H,G), append(I,D,E). init_extra_vars([],[],[],A,A,B,B,C,C,D,D) :- !, true. init_extra_vars([A|B],[C|D],[E|F],G,H,I,J,K,L,M,N) :- init_extra_var(A,C,E,G,O,I,P,K,Q,M,R), init_extra_vars(B,D,F,O,H,P,J,Q,L,R,N), true. vars_to_be_dereffed(A,B,C) :- require(A,D), split_deref(D,E), varset(E,F), not_deref(F,B,C). not_deref([],A,[]) :- !. not_deref([A|B],C,[A|D]) :- \+implies(C,deref(A)), !, not_deref(B,C,D). not_deref([A|B],C,D) :- not_deref(B,C,D). init_extra_var(A,B,C,D,E,F,G,H,H,I,J) :- implies(H,deref(A)), !, includev(B,F,G), D=[pref|K], K=[C|L], L=[B|E], I=[move(C,B)|J], true. init_extra_var(A,B,C,D,E,F,G,H,I,J,K) :- includev(B,F,G), D=[pref|L], L=[C|M], M=[B|E], J=[deref(C,B)|K], update_formula(deref(A),H,I), true. gpermvars(true,A,A,B,B,C,C) :- !, true. gpermvars((A ',' B),C,D,E,F,G,H) :- gpermstep(A,C,I,E,J,G,K), gpermsurv(A,I,L,J,M), gpermvars(B,L,D,M,F,K,H), true. gpermstep(A,B,C,D,D,E,F) :- varset(A,G), intersectv(G,D,H), unionv(E,H,F), unionv(B,G,C), true. gpermsurv(A,B,B,C,C) :- survive(A), !, true. gpermsurv(A,B,B,C,D) :- \+survive(A), !, unionv(C,B,D), true. add_uninit_void(A,B,C,D,E) :- var_args(A,F), term_dupset(A,G), diffv(F,G,H), diffv(H,B,I), uninit_set(D,J), diffv(I,J,K), make_uninit(K,L,true), intersectv(I,C,M), make_voids(M,N,L), union_formula(N,D,O), squeeze_conj(O,E). tree_trav_entry(entry(A),B,A). tree_trav_entry(mode(A,B,C),D,E) :- ( implies(D,A) -> tree_trav_entry(B,D,E) ; tree_trav_entry(C,D,E) ). make_uninit([],A,A). make_uninit([A|B],C,D) :- co(uninit(either,A),C,E), make_uninit(B,E,D). make_voids([],A,A). make_voids([A|B],C,D) :- co(void(A),C,E), make_voids(B,E,D). clause_allocate(A) :- clause_allocate(A,B,C). varlist(A,B) :- varlist(A,B,[]). local_allocate(A,B,C) :- % stats(reg,2), usage(A,D), % stats(reg,3), alloc_voids(D), % stats(reg,4), find_perms(A,E), % stats(reg,5), split_temps(D,E,F), alloc_temps(F,A), % stats(reg,6), split_perms(D,G), alloc_perms(G,A), % stats(reg,7), num_perms(G,C), env_needed(A,C,B), % stats(reg,8), !. usage(A,B) :- varset(A,C), init_usage(C,B), first_usage(A,1,B), length(A,D), reverse(A,E), last_usage(E,D,B). alloc_voids([]). alloc_voids([A|B]) :- get_usage(A,C,D,E), ( D=E -> C=r(void) ; true ), alloc_voids(B). find_perms(A,B) :- permvars(A,[],C,[],D,[],B). split_temps([],A,[]) :- !. split_temps([A|B],C,[A|D]) :- get_usage(A,E,F,G), \+inv(E,C), !, split_temps(B,C,D). split_temps([A|B],C,D) :- split_temps(B,C,D). alloc_temps(A,B) :- pref_closure(A,B), rest_temps(A,B,A). split_perms([],[]). split_perms([A|B],[A|C]) :- get_usage(A,D,E,F), var(D), !, split_perms(B,C). split_perms([A|B],C) :- split_perms(B,C). alloc_perms(A,B) :- write_once, !, naive_alloc_perms(B). alloc_perms(A,B) :- \+write_once, !, soph_alloc_perms(A). num_perms(A,B) :- low_perm(C), D is C-1, num_perms(A,D,E), B is E-D. env_needed(A,B,yes) :- B>0, !. env_needed(A,B,yes) :- env_needed(A), !. env_needed(A,B,no). varlist((A:-B),C,D) :- bodylist(B,C,D), !. goallist('$varlist'(A),B,C) :- !, difflist(A,B,C). goallist('$varlist'(A,B),C,D) :- !, insert(A,B,C,D). goallist(A,B,C) :- anyregs(A), !, varbag(A,B,D), fence_if_die(A,D,C). goallist(A,B,C) :- \+anyregs(A), !, A=..[D|E], low_reg(F), goallist(F,E,B,G), fence_if_die(A,G,C). goallist(A,[],B,B). goallist(A,[B|C],D,E) :- var(B), !, 'C'(D,pref,F), 'C'(F,B,G), 'C'(G,r(A),H), I is A+1, goallist(I,C,H,E). goallist(A,[B|C],D,E) :- nonvar(B), !, 'C'(D,r(A),F), G is A+1, goallist(G,C,F,E). env_needed([A|B]) :- A==fence, \+trivial_moves(B). env_needed([A|B]) :- env_needed(B). trivial_moves([]). trivial_moves([pref,A,A|B]) :- trivial_moves(B). get_usage(var(A,B,C),C,B,A). init_usage([],[]) :- !. init_usage([A|B],[var(C,D,A)|E]) :- init_usage(B,E). first_usage([],A,B) :- !. first_usage([A|B],C,D) :- var(A), !, E is C+1, find_usage(A,D,F,G), fix_it(C,F), first_usage(B,E,D). first_usage([A|B],C,D) :- nonvar(A), !, E is C+1, first_usage(B,E,D). last_usage([],A,B) :- !. last_usage([A|B],C,D) :- var(A), !, E is C-1, find_usage(A,D,F,G), fix_it(C,G), last_usage(B,E,D). last_usage([A|B],C,D) :- nonvar(A), !, E is C-1, last_usage(B,E,D). find_usage(A,[var(B,C,D)|E],F,G) :- ( A==D -> F=C, G=B ; find_usage(A,E,F,G) ). fix_it(A,B) :- ( var(B) -> A=B ; true ). permvars([],A,A,B,B,C,C) :- !, true. permvars([A|B],C,D,E,F,G,H) :- var(A), !, includev(A,C,I), permstep(A,E,J,G,K), permvars(B,I,D,J,F,K,H), true. permvars([A|B],C,D,E,F,G,H) :- A==fence, !, unionv(E,C,I), permvars(B,C,D,I,F,G,H), true. permvars([A|B],C,D,E,F,G,H) :- nonvar(A), A\==fence, !, permvars(B,C,D,E,F,G,H), true. permstep(A,B,B,C,D) :- inv(A,B), !, includev(A,C,D), true. permstep(A,B,B,C,C) :- !, true. naive_alloc_perms(A) :- reverse(A,B), low_perm(C), naive_alloc_perms(B,C,D). soph_alloc_perms(A) :- sort(A,B), reverse(B,C), soph_alloc_perms(C,C). naive_alloc_perms([],A,A) :- !. naive_alloc_perms([A|B],C,D) :- alloc_if_var(A,C,E), naive_alloc_perms(B,E,D). alloc_if_var(A,B,C) :- ( var(A) -> C is B+1, A=p(B) ; C=B ). soph_alloc_perms([],A) :- !. soph_alloc_perms([A|B],C) :- get_usage(A,D,E,F), low_perm(G), max_int(H), range(G,I,H), J=p(I), \+usage_overlap(E,F,C,J), D=J, soph_alloc_perms(B,C). usage_overlap(A,B,[C|D],E) :- get_usage(C,F,G,H), nonvar(F), overlap(A,B,G,H), F=E, !. usage_overlap(A,B,[C|D],E) :- usage_overlap(A,B,D,E). num_perms([],A,A). num_perms([A|B],C,D) :- get_usage(A,p(E),F,G), max(C,E,H), num_perms(B,H,D). pref_closure(A,B) :- pref_temps(A,B,A,0,C), pref_closure(A,B,C). rest_temps([],A,B) :- !. rest_temps([A|B],C,D) :- get_usage(A,E,F,G), ( var(E), rest_allocate(E,C,D,F,G) -> pref_closure(D,C) ; true ), rest_temps(B,C,D). pref_temps([],A,B,C,C) :- !. pref_temps([A|B],C,D,E,F) :- get_usage(A,G,H,I), ( var(G), pref_allocate(G,C,D,H,I) -> J is E+1 ; J=E ), pref_temps(B,C,D,J,F). pref_closure(A,B,C) :- C>0, !, pref_closure(A,B). pref_closure(A,B,C) :- C=0, !. pref_allocate(A,B,C,D,E) :- D=:=E, prefer(A,B,F), A=F. pref_allocate(A,B,C,D,E) :- D=\=E, prefer(A,B,F), \+already_used(A,F,D,E,B,C), A=F. prefer(A,[B,C,D|E],D) :- pref(B), A==C, temp_register(D). prefer(A,[B,C,D|E],C) :- pref(B), A==D, temp_register(C). prefer(A,[B|C],D) :- prefer(A,C,D). already_used(A,B,C,D,E,F) :- usage_overlap(C,D,F,B), !. already_used(A,B,C,D,E,F) :- reg_overlap(A,B,1,C,D,E), !. rest_allocate(A,B,C,D,E) :- low_reg(F), high_reg(G), range(F,H,G), I=r(H), \+already_used(A,I,D,E,B,C), A=I. reg_overlap(A,B,C,D,E,[F|G]) :- C= D, !, true. unify_nonvar(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) :- C= =H, !, D= (I=B ',' J), J= (I=C ',' E), F=[C|G], comment(['Found structure ',B,' at depth ',A]), true. unify_depth_2(A,B,C,D,E,F,G) :- functor(B,H,I), functor(C,H,I), J is A+1, unify_depth_2(1,I,J,B,C,D,E,F,G), true. unify_depth_2(A,B,C,D,E,F,F,G,G) :- A>B, !, true. unify_depth_2(A,B,C,D,E,F,G,H,I) :- A=
Please send all comments to Peter Van Roy.