251 lines
6.2 KiB
Prolog
251 lines
6.2 KiB
Prolog
|
|
:- set_prolog_flag(dollar_as_lower_case,on).
|
|
|
|
:- use_module(library(lists)).
|
|
:- use_module(library(hacks),[
|
|
current_choicepoint/1,
|
|
cut_by/1]).
|
|
:- use_module(library(terms)).
|
|
:- use_module(library(system)).
|
|
|
|
:- ensure_loaded(bprolog/arrays).
|
|
:- ensure_loaded(bprolog/hashtable).
|
|
|
|
%:- ensure_loaded(bprolog/actionrules).
|
|
:- ensure_loaded(bprolog/foreach).
|
|
%:- ensure_loaded(bprolog/compile_foreach).
|
|
|
|
:- op(700, xfx, [?=]).
|
|
:- op(200, fx, (@)).
|
|
|
|
X ?= Y :- unifiable(X,Y,_).
|
|
|
|
global_set(F,N,Value) :-
|
|
atomic_concat([F,'/',N],Key),
|
|
nb_setval(Key, Value).
|
|
|
|
global_set(F,Value) :-
|
|
atom_concat([F,'/0'],Key),
|
|
nb_setval(Key, Value).
|
|
|
|
global_get(F,Arity,Value) :-
|
|
atomic_concat([F,'/',Arity],Key),
|
|
nb_getval(Key, Value).
|
|
|
|
global_get(F,Value) :-
|
|
atom_concat([F,'/0'],Key),
|
|
nb_getval(Key, Value).
|
|
|
|
global_del(F,Arity) :-
|
|
atomic_concat([F,'/',Arity],Key),
|
|
catch(nb_delete(Key),_,true).
|
|
|
|
global_del(F) :-
|
|
atom_concat([F,'/0'],Key),
|
|
catch(nb_delete(Key),_,true).
|
|
|
|
getclauses1(File, Prog, _Opts) :-
|
|
findall(Clause, '$bpe_get_clause_from_file'(File, Clause), Prog0),
|
|
'$bpe_get_preds'(Prog0, Prog).
|
|
|
|
'$bpe_open_file'(File, Dir, S) :-
|
|
absolute_file_name(File, Abs, [expand(true),access(read)]),
|
|
file_directory_name(Abs, Dir),
|
|
open(Abs, read, S).
|
|
|
|
'$bpe_get_clause_from_file'(File, Clause) :-
|
|
'$bpe_open_file'(File, Dir, S),
|
|
working_directory(Old, Dir),
|
|
repeat,
|
|
read(S, Clause0),
|
|
( Clause0 = end_of_file ->
|
|
!,
|
|
working_directory(Dir, Old),
|
|
fail
|
|
;
|
|
%ugh, but we have to process include directives on the spot...
|
|
Clause0 = (:- include(Include))
|
|
->
|
|
'$bpe_get_clause_from_file'(Include, Clause)
|
|
;
|
|
Clause = Clause0
|
|
).
|
|
|
|
'$bpe_get_preds'(Decl.Prog0, pred(F,N,Modes,Delay,Tabled,Cls).NProg) :-
|
|
'$get_pred'(Decl, F, N, Modes,Delay, Tabled, Cls, Cls0), !,
|
|
'$bpe_process_pred'(Prog0, F,N,Modes,Delay,Tabled, Cls0, ProgF, []),
|
|
'$bpe_get_preds'(ProgF, NProg).
|
|
'$bpe_get_preds'(_Decl.Prog0, NProg) :-
|
|
'$bpe_get_preds'(Prog0, NProg).
|
|
'$bpe_get_preds'([], []).
|
|
|
|
'$bpe_process_pred'([], _F, N, Mode, _Delay, _Tabled, []) -->
|
|
{ '$init_mode'(N, Mode) }.
|
|
'$bpe_process_pred'([Call|Prog0], F,N, Modes, Delay, Tabled, Cls0) -->
|
|
{ '$get_pred'(Call, F, N, Modes, Delay, Tabled, Cls0, ClsI) }, !,
|
|
'$bpe_process_pred'(Prog0, F, N, Modes, Delay, Tabled, ClsI).
|
|
'$bpe_process_pred'([Call|Prog0], F, N, Modes, Delay, Tabled, Cls0) -->
|
|
[ Call ],
|
|
'$bpe_process_pred'(Prog0, F,N,Modes,Delay,Tabled, Cls0).
|
|
|
|
'$init_mode'(_N, Mode) :- nonvar(Mode), !.
|
|
'$init_mode'(0, []) :- !.
|
|
'$init_mode'(I, [d|Mode]) :- !,
|
|
I0 is I-1,
|
|
'$init_mode'(I0, Mode).
|
|
|
|
'$get_pred'((P :- Q), F, N, _Modes, _Delay, _Tabled) -->
|
|
{ functor(P, F, N), ! },
|
|
[(P:-Q)].
|
|
'$get_pred'((:- mode Q), F, N, Modes, _Delay, _Tabled) -->
|
|
{ functor(Q, F, N), !, Q =.. [_|Modes0],
|
|
'$bpe_cvt_modes'(Modes0, Modes, [])
|
|
},
|
|
[].
|
|
%'$get_pred'((:- table _), F, N, Modes, Delay, Tabled) -->
|
|
% { functor(Q, F, N), !, Q =.. [_|Modes] },
|
|
% [].
|
|
'$get_pred'((:- Q), '$damon_load', 0, _Modes, _Delay, _Tabled) -->
|
|
[ ('$damon_load' :- '$query'( Q ) )].
|
|
'$get_pred'((P), F, N, _Modes, _Delay, _Tabled) -->
|
|
{ functor(P, F, N), ! },
|
|
[(P)].
|
|
|
|
|
|
'$bpe_cvt_modes'([Mode|Modes0]) --> [NewMode],
|
|
{ '$bpe_cvt_mode'(Mode, NewMode) },
|
|
'$bpe_cvt_modes'(Modes0).
|
|
'$bpe_cvt_modes'([]) --> [].
|
|
|
|
'$bpe_cvt_mode'(Mode, Mode).
|
|
|
|
list_to_and([], true).
|
|
list_to_and([G], G).
|
|
list_to_and([G1,G2|Gs], (G1, NGs)) :-
|
|
list_to_and([G2|Gs], NGs).
|
|
|
|
preprocess_cl(Cl, Cl, _, _, _, _).
|
|
|
|
phase_1_process(Prog, Prog).
|
|
|
|
compileProgToFile(_, _File, []).
|
|
compileProgToFile(_, File, [Pred|Prog2]) :-
|
|
consult_pred(Pred),
|
|
compileProgToFile(_, File, Prog2).
|
|
|
|
consult_preds([], L) :- !,
|
|
consult_preds(L).
|
|
consult_preds(L0, L) :-
|
|
writeln(consult_preds(L0,L)).
|
|
|
|
consult_preds([]).
|
|
consult_preds([P|L]) :-
|
|
consult_pred(P),
|
|
consult_preds(L).
|
|
|
|
consult_pred(pred(F,N,_Mode,_Delay,Tabled,Clauses)) :-
|
|
(nonvar(Tabled) -> table(F/N) ; true),
|
|
functor(S,F,N),
|
|
assert(b_IS_CONSULTED_c(S)),
|
|
abolish(F/N),
|
|
'$assert_clauses'(Clauses).
|
|
|
|
add_pred(Name, Arity, _Mode, _Delay, Tabled, Clauses) :-
|
|
'$assert_clauses'(Clauses).
|
|
|
|
'$assert_clauses'([]).
|
|
'$assert_clauses'([Cl|Clauses]) :-
|
|
assert_static(Cl),
|
|
'$assert_clauses'(Clauses).
|
|
|
|
'$myload'(_F) :-
|
|
'$damon_load'.
|
|
|
|
'$query'(G) :- call(G).
|
|
|
|
initialize_table :- abolish_all_tables.
|
|
|
|
:- dynamic b_IS_DEBUG_MODE/0.
|
|
|
|
'_$savecp'(B) :- current_choicepoint(B).
|
|
'_$cutto'(B) :- cut_by(B).
|
|
|
|
X <= Y :- subsumes_chk(Y,X).
|
|
|
|
cputime(X) :- statistics(cputime,[X,_]).
|
|
|
|
vars_set(Term, Vars) :-
|
|
term_variables(Term, Vars).
|
|
|
|
sort(=<, L, R) :-
|
|
length(L, N),
|
|
'$bp_sort'(@=<, N, L, _, R1), !,
|
|
R = R1.
|
|
sort(>=, L, R) :-
|
|
length(L, N),
|
|
'$bp_sort'(@>=, N, L, _, R1), !,
|
|
R = R1.
|
|
sort(<, L, R) :-
|
|
length(L, N),
|
|
'$bp_sort2'(@<, N, L, _, R1), !,
|
|
R = R1.
|
|
sort(>, L, R) :-
|
|
length(L, N),
|
|
'$bp_sort2'(@>, N, L, _, R1), !,
|
|
R = R1.
|
|
|
|
'$bp_sort'(P, 2, [X1, X2|L], L, R) :- !,
|
|
(
|
|
call(P, X1, X2) ->
|
|
R = [X1,X2]
|
|
;
|
|
R = [X2,X1]
|
|
).
|
|
'$bp_sort'(_, 1, [X|L], L, [X]) :- !.
|
|
'$bp_sort'(_, 0, L, L, []) :- !.
|
|
'$bp_sort'(P, N, L1, L3, R) :-
|
|
N1 is N // 2,
|
|
plus(N1, N2, N),
|
|
'$bp_sort'(P, N1, L1, L2, R1),
|
|
'$bp_sort'(P, N2, L2, L3, R2),
|
|
'$bp_predmerge'(P, R1, R2, R).
|
|
|
|
'$bp_predmerge'(_, [], R, R) :- !.
|
|
'$bp_predmerge'(_, R, [], R) :- !.
|
|
'$bp_predmerge'(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
|
call(P, H1, H2), !,
|
|
'$bp_predmerge'(P, T1, [H2|T2], Result).
|
|
'$bp_predmerge'(P, [H1|T1], [H2|T2], [H2|Result]) :-
|
|
'$bp_predmerge'(P, [H1|T1], T2, Result).
|
|
|
|
'$bp_sort2'(P, 2, [X1, X2|L], L, R) :- !,
|
|
(
|
|
call(P, X1, X2) ->
|
|
R = [X1,X2]
|
|
;
|
|
X1 == X2
|
|
->
|
|
R = [X1]
|
|
;
|
|
R = [X2,X1]
|
|
).
|
|
'$bp_sort2'(_, 1, [X|L], L, [X]) :- !.
|
|
'$bp_sort2'(_, 0, L, L, []) :- !.
|
|
'$bp_sort2'(P, N, L1, L3, R) :-
|
|
N1 is N // 2,
|
|
plus(N1, N2, N),
|
|
'$bp_sort'(P, N1, L1, L2, R1),
|
|
'$bp_sort'(P, N2, L2, L3, R2),
|
|
'$bp_predmerge'(P, R1, R2, R).
|
|
|
|
'$bp_predmerge2'(_, [], R, R) :- !.
|
|
'$bp_predmerge2'(_, R, [], R) :- !.
|
|
'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
|
call(P, H1, H2), !,
|
|
'$bp_predmerge'(P, T1, [H2|T2], Result).
|
|
'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
|
H1 == H2, !,
|
|
'$bp_predmerge'(P, T1, T2, Result).
|
|
'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H2|Result]) :-
|
|
'$bp_predmerge'(P, [H1|T1], T2, Result).
|