This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/meld/meldi.yap

331 lines
5.4 KiB
Plaintext
Raw Normal View History

:- module(meld_interpreter,
[
live/0,
delete/1,
push/1,
first/2,
min/3,
2010-11-03 00:33:26 +00:00
max/3,
sum/3,
2010-11-03 00:33:26 +00:00
minval/3,
maxval/3
]).
:- use_module(meldp,
[
run/1
]).
2014-08-06 16:26:03 +01:00
:- use_module(meld).
:- use_module(library(nb),
[
nb_queue/1,
nb_queue_enqueue/2,
2011-05-11 09:28:40 +01:00
nb_queue_dequeue/2,
nb_queue_replace/3
]).
:- initialization
init_meld_queue.
2010-11-03 16:16:40 +00:00
:- dynamic speculative_delete/3.
live :-
repeat,
( pop(Goal) ->
2011-05-11 09:28:40 +01:00
% format('<- ~w~n',[Goal]),
run(Goal),
fail
;
!,
done
).
2010-11-03 16:16:40 +00:00
done :-
speculative_delete(_, _, _), !,
push_residuals,
live.
done :-
current_predicate(meld_program:P),
P \= run/1,
2011-05-11 09:28:40 +01:00
P \= trace/2,
% P \= neighbor/2,
% P \= root/1,
listing(meld_program:P),
fail.
done.
delete(Fact) :-
2011-05-11 09:28:40 +01:00
once(retract(meld_program:Fact)),
nb_getval(meld_queue, Queue),
2011-05-11 09:28:40 +01:00
(
% nb:nb_queue_show(Queue, L ), writeln(show:Fact:L),
nb_queue_replace(Queue, Fact, [] ),
% format('R ~w~n', [Fact]),
deleted(Fact)
->
true
;
nb_queue_enqueue(Queue, deleted(Fact))
).
pop(Goal) :-
nb_getval(meld_queue, Queue),
nb_queue_dequeue(Queue, Goal).
push(Goal) :-
clause(meld_program:Goal,_,Ref),
!,
increase_reference_count(Ref),
fail.
push(Goal) :-
2011-05-11 09:28:40 +01:00
% format('-> ~w~n',[Goal]),
nb_getval(meld_queue, Queue), !,
assert(meld_program:Goal),
2011-05-11 09:28:40 +01:00
nb_queue_enqueue(Queue, Goal),
% nb:nb_queue_show(Queue, L ), writeln(show:Goal:L),
fail.
% create a queue
init_meld_queue :-
nb_queue(Queue),
nb_setval(meld_queue, Queue).
first(Skel,Goal) :-
meld_program:Skel, !,
cache(Goal).
first(_,Goal) :-
cache(Goal),
push(Goal).
max(Skel,Arg,Goal) :-
meld_program:Skel,
arg(Arg, Skel, A0),
arg(Arg, Goal, AN),
AN =< A0, !,
delete(Skel),
cache(Goal).
max(Skel,_,Goal) :-
clean(Skel),
cache(Goal),
push(Goal).
min(Skel,Arg,Goal) :-
meld_program:Skel,
arg(Arg, Skel, A0),
arg(Arg, Goal, AN),
AN >= A0, !,
delete(Skel),
cache(Goal).
min(Skel,_,Goal) :-
clean(Skel),
cache(Goal),
push(Goal).
sum(Skel,Arg,Goal) :-
copy_term(Skel, NGoal),
2011-05-08 23:49:06 +01:00
meld_program:Skel, !,
arg(Arg, Skel, A0),
arg(Arg, Goal, A),
AN is A0+A,
2011-05-11 09:28:40 +01:00
AN \= A0,
delete(Skel),
arg(Arg, NGoal, AN),
2011-05-11 09:28:40 +01:00
% format('S ~w~n',[NGoal-Skel]),
push(NGoal).
2011-05-08 23:49:06 +01:00
sum(_Skel,_Arg,Goal) :-
2011-05-11 09:28:40 +01:00
% format('S ~w~n',[Goal]),
push(Goal).
clean(Skel) :-
% format('D~w~n',[Skel]),
retractall(meld_program:Skel).
cache(Goal) :-
clause(meld_cache:Goal,_,Ref),
!,
increase_reference_count(Ref).
cache(Goal) :-
assert(meld_cache:Goal).
deleted(Goal) :-
clause(meld_program:Goal,_,Ref),
decrease_reference_count(Ref),
!,
2010-11-03 16:16:40 +00:00
force_delete(Goal, Ref),
2010-11-03 00:33:26 +00:00
complete_delete(Goal).
2010-11-03 16:16:40 +00:00
deleted(Goal) :-
retract(speculative_delete(Goal, Ref, Count)), !,
NCount is Count-1,
(
NCount > 0
->
assert(speculative_delete(Goal, Ref, Count))
;
true
).
deleted(Goal) :-
% format('-~w~n',[Goal]),
2010-11-03 00:33:26 +00:00
complete_delete(Goal).
complete_delete(Goal) :-
nb_getval(meld_queue, Queue), !,
retract(meld_program:Goal),
nb_queue_enqueue(Queue, deleted(Goal)).
2010-11-03 16:16:40 +00:00
force_delete(Goal, Ref) :-
current_reference_count(Ref, Count),
assert(speculative_delete(Goal, Ref, Count)).
push_residuals :-
retract(speculative_delete(Goal, _, _)),
push(Goal),
fail.
push_residuals.
%
% first, cleanup cache
%
delete_from_first(_,Goal) :-
2010-11-03 16:16:40 +00:00
clause(meld_program:Goal,_,Ref), !,
(
2010-11-03 16:16:40 +00:00
decrease_reference_count(Ref)
->
2010-11-03 16:16:40 +00:00
true
;
2010-11-03 16:16:40 +00:00
force_delete(Goal, Ref)
),
erase(Ref),
retract(meld_cache:Goal),
retract(meld_program:Goal),
push(deleted(Goal)),
once(meld_cache:VGoal),
push(VGoal).
2010-11-03 16:16:40 +00:00
delete_from_first(Goal) :-
retract(speculative_delete(Goal, Ref, Count)), !,
NCount is Count-1,
(
NCount > 0
->
assert(speculative_delete(Goal, Ref, Count))
;
true
).
delete_from_first(Goal) :-
retract(meld_cache:Goal),
push(deleted(Goal)).
delete_from_max(VGoal,Arg,Goal) :-
2010-11-03 16:16:40 +00:00
clause(meld_program:Goal,_,Ref), !,
(
2010-11-03 16:16:40 +00:00
decrease_reference_count(Ref)
->
true
;
force_delete(Goal, Ref)
),
erase(Ref),
retract(meld_cache:Goal),
push(deleted(Goal)),
2010-11-03 16:16:40 +00:00
new_max(VGoal, Arg).
delete_from_max(Goal) :-
retract(speculative_delete(Goal, Ref, Count)), !,
NCount is Count-1,
(
NCount > 0
->
assert(speculative_delete(Goal, Ref, Count))
;
true
).
delete_from_max(Goal) :-
retract(meld_cache:Goal),
push(deleted(Goal)).
delete_from_sum(Skel,Arg,Goal) :-
copy_term(Skel, NGoal),
2011-05-11 09:28:40 +01:00
once(meld_program:Skel),
arg(Arg, Skel, A0),
arg(Arg, Goal, A),
AN is A0-A,
2011-05-11 09:28:40 +01:00
AN \= A0,
delete(Skel),
arg(Arg, NGoal, AN),
push(NGoal).
2010-11-03 16:16:40 +00:00
new_max(VGoal,Arg) :-
arg(Arg, VGoal, A),
maxval(A, meld_cache:VGoal, VGoal),
push(VGoal).
delete_from_min(VGoal,Arg,Goal) :-
2010-11-03 16:16:40 +00:00
clause(meld_program:Goal,_,Ref), !,
(
2010-11-03 16:16:40 +00:00
decrease_reference_count(Ref)
->
2010-11-03 16:16:40 +00:00
true
;
force_delete(Goal, Ref)
),
erase(Ref),
retract(meld_cache:Goal),
push(deleted(Goal)),
2010-11-03 16:16:40 +00:00
new_min(VGoal, Arg).
delete_from_min(Goal) :- !,
retract(speculative_delete(Goal, Ref, Count)),
NCount is Count-1,
(
NCount > 0
->
assert(speculative_delete(Goal, Ref, Count))
;
true
).
delete_from_min(Goal) :-
retract(meld_cache:Goal),
push(deleted(Goal)).
new_min(VGoal,Arg) :-
arg(Arg, VGoal, A),
minval(A, meld_cache:VGoal, VGoal),
push(VGoal).
2010-11-03 00:33:26 +00:00
:- meta_predicate minval(+,:,-), maxval(+,:,-).
maxval(V,G,GMax) :-
2010-11-03 09:45:18 +00:00
Memory = f(-inf,[]),
(
call(G),
arg(1, Memory, V0),
V > V0,
nb_setarg(1, Memory, V),
2010-11-03 16:16:40 +00:00
nb_setarg(2, Memory, V.GMax),
fail
2010-11-03 09:45:18 +00:00
;
arg(2, Memory, V.GMax)
).
2010-11-03 09:45:18 +00:00
minval(V,G,GMin) :-
Memory = f(+inf,[]),
(
call(G),
arg(1, Memory, V0),
V < V0,
nb_setarg(1, Memory, V),
2010-11-03 16:16:40 +00:00
nb_setarg(2, Memory, V.GMin),
fail
2010-11-03 09:45:18 +00:00
;
arg(2, Memory, V.GMin)
).