an implementation of the meld language.
This commit is contained in:
parent
8ca680705d
commit
216c1b85f3
70
C/dbase.c
70
C/dbase.c
|
@ -4394,6 +4394,73 @@ p_erase(void)
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* increase_reference_counter(+Ref) */
|
||||||
|
static Int
|
||||||
|
p_increase_reference_counter(void)
|
||||||
|
{
|
||||||
|
Term t1 = Deref(ARG1);
|
||||||
|
LogUpdClause *cl;
|
||||||
|
|
||||||
|
if (IsVarTerm(t1)) {
|
||||||
|
Yap_Error(INSTANTIATION_ERROR, t1, "increase_reference_counter/1");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
if (!IsDBRefTerm(t1)) {
|
||||||
|
Yap_Error(TYPE_ERROR_DBREF, t1, "increase_reference_counter");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
cl = (LogUpdClause *)DBRefOfTerm(t1);
|
||||||
|
PELOCK(67,cl->ClPred);
|
||||||
|
cl->ClRefCount++;
|
||||||
|
UNLOCK(cl->ClPred);
|
||||||
|
return TRUE;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* increase_reference_counter(+Ref) */
|
||||||
|
static Int
|
||||||
|
p_decrease_reference_counter(void)
|
||||||
|
{
|
||||||
|
Term t1 = Deref(ARG1);
|
||||||
|
LogUpdClause *cl;
|
||||||
|
|
||||||
|
if (IsVarTerm(t1)) {
|
||||||
|
Yap_Error(INSTANTIATION_ERROR, t1, "increase_reference_counter/1");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
if (!IsDBRefTerm(t1)) {
|
||||||
|
Yap_Error(TYPE_ERROR_DBREF, t1, "increase_reference_counter");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
cl = (LogUpdClause *)DBRefOfTerm(t1);
|
||||||
|
PELOCK(67,cl->ClPred);
|
||||||
|
if (cl->ClRefCount) {
|
||||||
|
cl->ClRefCount--;
|
||||||
|
UNLOCK(cl->ClPred);
|
||||||
|
return TRUE;
|
||||||
|
}
|
||||||
|
UNLOCK(cl->ClPred);
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* erase(+Ref) */
|
||||||
|
static Int
|
||||||
|
p_current_reference_counter(void)
|
||||||
|
{
|
||||||
|
Term t1 = Deref(ARG1);
|
||||||
|
LogUpdClause *cl;
|
||||||
|
|
||||||
|
if (IsVarTerm(t1)) {
|
||||||
|
Yap_Error(INSTANTIATION_ERROR, t1, "increase_reference_counter/1");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
if (!IsDBRefTerm(t1)) {
|
||||||
|
Yap_Error(TYPE_ERROR_DBREF, t1, "increase_reference_counter");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
cl = (LogUpdClause *)DBRefOfTerm(t1);
|
||||||
|
return Yap_unify(ARG2, MkIntegerTerm(cl->ClRefCount));
|
||||||
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_erase_clause(void)
|
p_erase_clause(void)
|
||||||
{
|
{
|
||||||
|
@ -5443,6 +5510,9 @@ Yap_InitDBPreds(void)
|
||||||
Yap_InitCPred("$recordzp", 4, p_drcdzp, SyncPredFlag|HiddenPredFlag);
|
Yap_InitCPred("$recordzp", 4, p_drcdzp, SyncPredFlag|HiddenPredFlag);
|
||||||
Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$erase_clause", 2, p_erase_clause, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
Yap_InitCPred("$erase_clause", 2, p_erase_clause, SafePredFlag|SyncPredFlag|HiddenPredFlag);
|
||||||
|
Yap_InitCPred("increase_reference_count", 1, p_increase_reference_counter, SafePredFlag|SyncPredFlag);
|
||||||
|
Yap_InitCPred("decrease_reference_count", 1, p_decrease_reference_counter, SafePredFlag|SyncPredFlag);
|
||||||
|
Yap_InitCPred("current_reference_count", 2, p_current_reference_counter, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("instance", 2, p_instance, SyncPredFlag);
|
Yap_InitCPred("instance", 2, p_instance, SyncPredFlag);
|
||||||
Yap_InitCPred("$instance_module", 2, p_instance_module, SyncPredFlag|HiddenPredFlag);
|
Yap_InitCPred("$instance_module", 2, p_instance_module, SyncPredFlag|HiddenPredFlag);
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
root(a).
|
||||||
|
|
||||||
|
neighbor(a,b).
|
||||||
|
neighbor(b,a).
|
||||||
|
neighbor(a,c).
|
||||||
|
neighbor(c,a).
|
||||||
|
|
||||||
|
temperature(a, 10).
|
||||||
|
temperature(b, 12).
|
||||||
|
temperature(c, 15).
|
|
@ -0,0 +1,10 @@
|
||||||
|
root(a).
|
||||||
|
|
||||||
|
neighbor(a,b).
|
||||||
|
neighbor(b,a).
|
||||||
|
neighbor(a,c).
|
||||||
|
neighbor(c,a).
|
||||||
|
|
||||||
|
temperature(a, 20).
|
||||||
|
temperature(b, 12).
|
||||||
|
temperature(c, 15).
|
|
@ -0,0 +1,15 @@
|
||||||
|
root(a).
|
||||||
|
|
||||||
|
neighbor(a,b).
|
||||||
|
neighbor(b,a).
|
||||||
|
neighbor(a,c).
|
||||||
|
neighbor(c,a).
|
||||||
|
neighbor(d,b).
|
||||||
|
neighbor(b,d).
|
||||||
|
neighbor(d,c).
|
||||||
|
neighbor(c,d).
|
||||||
|
|
||||||
|
temperature(a, 10).
|
||||||
|
temperature(b, 12).
|
||||||
|
temperature(c, 15).
|
||||||
|
temperature(d, 20).
|
|
@ -0,0 +1,6 @@
|
||||||
|
root(a).
|
||||||
|
|
||||||
|
neighbor(a,b).
|
||||||
|
neighbor(b,a).
|
||||||
|
|
||||||
|
temperature(a, 10).
|
|
@ -0,0 +1,34 @@
|
||||||
|
|
||||||
|
%:- ensure_loaded(l
|
||||||
|
|
||||||
|
type logical_neighbor parent(module, first module).
|
||||||
|
type maxTemp(module, max float).
|
||||||
|
|
||||||
|
parent(A, A) :- root(A).
|
||||||
|
parent(A, B) :-
|
||||||
|
neighbor(A, B),
|
||||||
|
parent(B, _).
|
||||||
|
|
||||||
|
maxTemp(A, T) :-
|
||||||
|
temperature(A, T).
|
||||||
|
maxTemp(B, T) :-
|
||||||
|
parent(A, B),
|
||||||
|
maxTemp(A, T).
|
||||||
|
|
||||||
|
type globalMax(module, max float).
|
||||||
|
|
||||||
|
globalMax(A, T) :-
|
||||||
|
maxTemp(A, T),
|
||||||
|
root(A).
|
||||||
|
globalMax(B, T) :-
|
||||||
|
neighbor(A, B),
|
||||||
|
globalMax(A, T).
|
||||||
|
|
||||||
|
type localMax(module).
|
||||||
|
localMax(A) :-
|
||||||
|
temperature(A,T),
|
||||||
|
forall
|
||||||
|
neighbor(A, B)
|
||||||
|
then
|
||||||
|
( temperature(B, TT), T > TT ).
|
||||||
|
|
|
@ -0,0 +1,22 @@
|
||||||
|
:- module(meld_core,
|
||||||
|
[simulate/1,
|
||||||
|
op(1200, fy, (type)),
|
||||||
|
op(1150, fy, (logical_neighbor)),
|
||||||
|
op( 500, fy, (first)),
|
||||||
|
op( 500, fy, (max)),
|
||||||
|
op( 950, fy, (forall)),
|
||||||
|
op( 900, xfy, (then))
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- style_check(all).
|
||||||
|
|
||||||
|
:- reexport(meldi).
|
||||||
|
|
||||||
|
:- reexport(meldc).
|
||||||
|
|
||||||
|
simulate(G) :-
|
||||||
|
input_graph(G),
|
||||||
|
live.
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,213 @@
|
||||||
|
:- style_check(all).
|
||||||
|
|
||||||
|
:- yap_flag(unknown,error).
|
||||||
|
|
||||||
|
:- module(meld_compiler,
|
||||||
|
[
|
||||||
|
mcompile/1,
|
||||||
|
input_graph/1,
|
||||||
|
run/1
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- use_module(meldi,
|
||||||
|
[
|
||||||
|
push/1,
|
||||||
|
first/2,
|
||||||
|
min/3,
|
||||||
|
max/3
|
||||||
|
]).
|
||||||
|
|
||||||
|
:- use_module(meld).
|
||||||
|
|
||||||
|
:- use_module(library(terms), [
|
||||||
|
variable_in_term/2
|
||||||
|
]).
|
||||||
|
|
||||||
|
mcompile(Program) :-
|
||||||
|
open(Program, read, P),
|
||||||
|
init_mcompile(Program),
|
||||||
|
repeat,
|
||||||
|
read_term(P, Term, [variable_names(Vars), module(meld_compiler)]),
|
||||||
|
(
|
||||||
|
Term == end_of_file
|
||||||
|
->
|
||||||
|
!,
|
||||||
|
close(P)
|
||||||
|
;
|
||||||
|
mcompile(Term, Program, Vars),
|
||||||
|
fail
|
||||||
|
).
|
||||||
|
|
||||||
|
init_mcompile(Program) :-
|
||||||
|
retractall(type(_, _, Program, _)).
|
||||||
|
|
||||||
|
mcompile(type(T), Program, Vars) :-
|
||||||
|
ground_term(T, Vars),
|
||||||
|
type_declaration(T, Program), !.
|
||||||
|
mcompile((Head :- Body), _, _Vars) :-
|
||||||
|
rule(Head, Body).
|
||||||
|
|
||||||
|
type_declaration(logical_neighbor(T), Program) :- !,
|
||||||
|
type_declaration(T, Program).
|
||||||
|
type_declaration(T, _) :-
|
||||||
|
functor(T, N, A),
|
||||||
|
dynamic(meld_program:N/A),
|
||||||
|
fail.
|
||||||
|
type_declaration(T, Program) :-
|
||||||
|
T =.. [P|Args],
|
||||||
|
check_aggregate(Args, 1, NewArgs, Aggregation, Arg),
|
||||||
|
!,
|
||||||
|
NT =.. [P|NewArgs],
|
||||||
|
assert_type(NT, Program, aggregation(Aggregation, Arg)).
|
||||||
|
type_declaration(T, Program) :-
|
||||||
|
assert_type(T, Program, horn).
|
||||||
|
|
||||||
|
assert_type(NT, Program, Agg) :-
|
||||||
|
functor(NT, Na, Ar),
|
||||||
|
functor(Spec, Na, Ar),
|
||||||
|
assert(type(Spec, NT, Program, Agg)).
|
||||||
|
|
||||||
|
check_aggregate([first(Type)|Args], I, [Type|Args], first, I) :- !.
|
||||||
|
check_aggregate([max(Type)|Args], I, [Type|Args], max, I) :- !.
|
||||||
|
check_aggregate([min(Type)|Args], I, [Type|Args], min, I) :- !.
|
||||||
|
check_aggregate([Type|Args], I, [Type|NewArgs], Agg, Arg) :-
|
||||||
|
atom(Type),
|
||||||
|
I1 is I+1,
|
||||||
|
check_aggregate(Args, I1, NewArgs, Agg, Arg).
|
||||||
|
|
||||||
|
ground_term(_, []).
|
||||||
|
|
||||||
|
rule(Head, Body) :-
|
||||||
|
bodytolist(Body, L, []),
|
||||||
|
compile_goals(L, [], Head).
|
||||||
|
|
||||||
|
compile_goals([], _, _).
|
||||||
|
compile_goals([Goal|Goals], Gs, Head) :-
|
||||||
|
compile_goal(Goal, Goals, Gs, Head),
|
||||||
|
compile_goals(Goals, [Goal|Gs], Head).
|
||||||
|
|
||||||
|
compile_goal((forall G then Do), Goals, Gs, Head) :- !,
|
||||||
|
% make sure quantified variables are not seen outside
|
||||||
|
quantified_vars(G,Gs+Goals,NG),
|
||||||
|
%
|
||||||
|
% just collect the body into a number of goals
|
||||||
|
%
|
||||||
|
collect_body(Gs, [(forall G then Do)|Goals], BLF, BL1),
|
||||||
|
% make a backup copy for deletion
|
||||||
|
copy_term(h(Head,BLF,BL1,NG), h(Head,DelBLF,DelBL1,DelNG)),
|
||||||
|
% add the operation, usually push
|
||||||
|
extra_head(Head, BL1, []),
|
||||||
|
% add the delete operation
|
||||||
|
extra_delete(Head, DelBL1, []),
|
||||||
|
% create the body as a conjunction
|
||||||
|
listtobody(BLF, Body),
|
||||||
|
listtobody(DelBLF, DelBody),
|
||||||
|
% done
|
||||||
|
assert(meld_program:(run(NG) :- Body)),
|
||||||
|
assert(meld_program:(run(delete(DelNG)) :- DelBody)).
|
||||||
|
compile_goal(Goal, Goals, Gs, Head) :-
|
||||||
|
collect_body(Gs, Goals, BLF, BL1),
|
||||||
|
copy_term(h(Head,BLF,BL1,Goal), h(Head,DelBLF,DelBL1,DelGoal)),
|
||||||
|
extra_head(Head, BL1, []),
|
||||||
|
extra_delete(Head, DelBL1, []),
|
||||||
|
listtobody(BLF, Body),
|
||||||
|
listtobody(DelBLF, DelBody),
|
||||||
|
assert(meld_program:(run(Goal) :- Body)),
|
||||||
|
assert(meld_program:(run(deleted(DelGoal)) :- DelBody)).
|
||||||
|
|
||||||
|
% quantified variables should not leave the scope of the forall.
|
||||||
|
quantified_vars(G,Extern,NG) :-
|
||||||
|
term_variables(G, TVs),
|
||||||
|
copy_term(G+TVs,NG+NTVs),
|
||||||
|
bind_external(TVs, NTVs, Extern).
|
||||||
|
|
||||||
|
bind_external([], [], _).
|
||||||
|
bind_external(V.TVs, NV.NTVs, Extern) :-
|
||||||
|
variable_in_term(Extern, V), !,
|
||||||
|
V = NV,
|
||||||
|
bind_external(TVs, NTVs, Extern).
|
||||||
|
bind_external(_.TVs, _.NTVs, Extern) :-
|
||||||
|
bind_external(TVs, NTVs, Extern).
|
||||||
|
|
||||||
|
% a very simple version
|
||||||
|
%
|
||||||
|
collect_body([], []) --> [].
|
||||||
|
collect_body([G|Gs], MGs) -->
|
||||||
|
process_goal(G),
|
||||||
|
collect_body(Gs, MGs).
|
||||||
|
collect_body([], [G|Gs]) -->
|
||||||
|
process_goal(G),
|
||||||
|
collect_body([], Gs).
|
||||||
|
|
||||||
|
process_goal((forall Goal then Conj)) --> !,
|
||||||
|
[(Goal, \+ Conj -> fail ; true)].
|
||||||
|
process_goal( G ) -->
|
||||||
|
[G].
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
extra_head(Head) -->
|
||||||
|
{ type(Head, _, _, horn) },
|
||||||
|
[push(Head)].
|
||||||
|
extra_head(Head) -->
|
||||||
|
{ type(Head, _, _, aggregation(first, Arg)), freshen(Head, Arg, VHead) },
|
||||||
|
[ meld_interpreter:first(VHead, Head)].
|
||||||
|
extra_head(Head) -->
|
||||||
|
{ type(Head, _, _, aggregation(max, Arg)), freshen(Head, Arg, VHead) },
|
||||||
|
[ meld_interpreter:max(VHead, Arg, Head)].
|
||||||
|
extra_head(Head) -->
|
||||||
|
{ type(Head, _, _, aggregation(min, Arg)), freshen(Head, Arg, VHead) },
|
||||||
|
[ meld_interpreter:min(VHead, Arg, Head)].
|
||||||
|
|
||||||
|
extra_delete(Head) -->
|
||||||
|
{ type(Head, _, _, horn) },
|
||||||
|
[meld_interpreter:deleted(Head)].
|
||||||
|
extra_delete(Head) -->
|
||||||
|
{ type(Head, _, _, aggregation(first, Arg)), freshen(Head, Arg, VHead) },
|
||||||
|
[ meld_interpreter:delete_from_first(VHead, Head)].
|
||||||
|
extra_delete(Head) -->
|
||||||
|
{ type(Head, _, _, aggregation(max, Arg)), freshen(Head, Arg, VHead) },
|
||||||
|
[ meld_interpreter:delete_from_max(VHead, Arg, Head)].
|
||||||
|
extra_delete(Head) -->
|
||||||
|
{ type(Head, _, _, aggregation(min, Arg)), freshen(Head, Arg, VHead) },
|
||||||
|
[ meld_interpreter:delete_from_min(VHead, Arg, Head)].
|
||||||
|
|
||||||
|
freshen(Head, Arg, VHead) :-
|
||||||
|
Head =.. [N|Args],
|
||||||
|
freshen_arg(Arg, Args, VArgs),
|
||||||
|
VHead =.. [N|VArgs].
|
||||||
|
|
||||||
|
freshen_arg(1, [_|Args], [_|Args]) :- !.
|
||||||
|
freshen_arg(N, A.Args, A.VArgs) :-
|
||||||
|
N1 is N-1,
|
||||||
|
freshen_arg(N1, Args, VArgs).
|
||||||
|
|
||||||
|
input_graph(Program) :-
|
||||||
|
open(Program, read, P),
|
||||||
|
repeat,
|
||||||
|
read_term(P, Term, [variable_names(_Vars), module(meld_compiler)]),
|
||||||
|
(
|
||||||
|
Term == end_of_file
|
||||||
|
->
|
||||||
|
!,
|
||||||
|
close(P)
|
||||||
|
;
|
||||||
|
add_graph_fact(Term),
|
||||||
|
fail
|
||||||
|
).
|
||||||
|
|
||||||
|
add_graph_fact(Term) :-
|
||||||
|
push(Term).
|
||||||
|
|
||||||
|
bodytolist((G1,G2)) -->
|
||||||
|
!,
|
||||||
|
bodytolist(G1),
|
||||||
|
bodytolist(G2).
|
||||||
|
bodytolist(G) -->
|
||||||
|
[G].
|
||||||
|
|
||||||
|
listtobody([G], G) :- !.
|
||||||
|
listtobody([G|GL], (G,Gs)) :-
|
||||||
|
listtobody(GL, Gs).
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,231 @@
|
||||||
|
|
||||||
|
:- module(meld_interpreter,
|
||||||
|
[
|
||||||
|
live/0,
|
||||||
|
delete/1,
|
||||||
|
push/1,
|
||||||
|
first/2,
|
||||||
|
min/3,
|
||||||
|
max/3
|
||||||
|
]).
|
||||||
|
|
||||||
|
|
||||||
|
:- use_module(meldp,
|
||||||
|
[
|
||||||
|
run/1
|
||||||
|
]).
|
||||||
|
|
||||||
|
|
||||||
|
:- use_module(library(nb),
|
||||||
|
[
|
||||||
|
nb_queue/1,
|
||||||
|
nb_queue_enqueue/2,
|
||||||
|
nb_queue_dequeue/2
|
||||||
|
]).
|
||||||
|
|
||||||
|
|
||||||
|
:- initialization
|
||||||
|
init_meld_queue.
|
||||||
|
|
||||||
|
live :-
|
||||||
|
repeat,
|
||||||
|
( pop(Goal) ->
|
||||||
|
format('-~w~n',[Goal]),
|
||||||
|
run(Goal),
|
||||||
|
fail
|
||||||
|
;
|
||||||
|
!,
|
||||||
|
done
|
||||||
|
).
|
||||||
|
|
||||||
|
done :-
|
||||||
|
current_predicate(meld_program:P),
|
||||||
|
P \= run/1,
|
||||||
|
% P \= neighbor/2,
|
||||||
|
% P \= root/1,
|
||||||
|
listing(meld_program:P),
|
||||||
|
fail.
|
||||||
|
done.
|
||||||
|
|
||||||
|
|
||||||
|
delete(Fact) :-
|
||||||
|
nb_getval(meld_queue, Queue),
|
||||||
|
retract(meld_program:Fact),
|
||||||
|
nb_queue_enqueue(Queue, deleted(Fact)),
|
||||||
|
live.
|
||||||
|
|
||||||
|
pop(Goal) :-
|
||||||
|
nb_getval(meld_queue, Queue),
|
||||||
|
nb_queue_dequeue(Queue, Goal).
|
||||||
|
|
||||||
|
push(Goal) :-
|
||||||
|
clause(meld_program:Goal,_,Ref),
|
||||||
|
!,
|
||||||
|
writeln(Goal+ref),
|
||||||
|
increase_reference_count(Ref),
|
||||||
|
fail.
|
||||||
|
push(Goal) :-
|
||||||
|
% format('+~w~n',[Goal]),
|
||||||
|
writeln(Goal+0),
|
||||||
|
nb_getval(meld_queue, Queue), !,
|
||||||
|
assert(meld_program:Goal),
|
||||||
|
nb_queue_enqueue(Queue, Goal).
|
||||||
|
|
||||||
|
|
||||||
|
% 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, !,
|
||||||
|
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, !,
|
||||||
|
cache(Goal).
|
||||||
|
min(Skel,_,Goal) :-
|
||||||
|
clean(Skel),
|
||||||
|
cache(Goal),
|
||||||
|
push(Goal).
|
||||||
|
|
||||||
|
clean(Skel) :-
|
||||||
|
% format('D~w~n',[Skel]),
|
||||||
|
retractall(meld_program:Skel).
|
||||||
|
|
||||||
|
cache(Goal) :-
|
||||||
|
writeln(cache(Goal)),fail.
|
||||||
|
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),
|
||||||
|
!,
|
||||||
|
fail.
|
||||||
|
deleted(Goal) :-
|
||||||
|
% format('-~w~n',[Goal]),
|
||||||
|
nb_getval(meld_queue, Queue), !,
|
||||||
|
retract(meld_program:Goal),
|
||||||
|
nb_queue_enqueue(Queue, deleted(Goal)).
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
%
|
||||||
|
% first, cleanup cache
|
||||||
|
%
|
||||||
|
delete_from_first(_,Goal) :-
|
||||||
|
clause(meld_cache:Goal,_,Ref),
|
||||||
|
(
|
||||||
|
decrease_reference_count(Ref)
|
||||||
|
->
|
||||||
|
fail
|
||||||
|
;
|
||||||
|
erase(Ref),
|
||||||
|
fail
|
||||||
|
).
|
||||||
|
delete_from_first(_,Goal) :-
|
||||||
|
clause(meld_program:Goal,_,Ref),
|
||||||
|
decrease_reference_count(Ref),
|
||||||
|
!,
|
||||||
|
fail.
|
||||||
|
delete_from_first(VGoal,Goal) :-
|
||||||
|
retract(meld_program:Goal),
|
||||||
|
push(deleted(Goal)),
|
||||||
|
once(meld_cache:VGoal),
|
||||||
|
push(VGoal).
|
||||||
|
|
||||||
|
|
||||||
|
delete_from_max(VGoal,Arg,Goal) :-
|
||||||
|
clause(meld_cache:Goal,_,Ref),
|
||||||
|
(
|
||||||
|
decrease_reference_count(Ref)
|
||||||
|
->
|
||||||
|
clause(meld_program:Goal,_,CRef),
|
||||||
|
decrease_reference_count(CRef),
|
||||||
|
fail
|
||||||
|
;
|
||||||
|
erase(Ref),
|
||||||
|
new_max(VGoal, Arg, Goal)
|
||||||
|
).
|
||||||
|
|
||||||
|
new_max(VGoal,Arg,Goal) :-
|
||||||
|
% format('-~w~n',[Goal]),
|
||||||
|
retract(meld_program:Goal),
|
||||||
|
push(deleted(Goal)),
|
||||||
|
writeln(delete_from_max(VGoal,Arg,Goal)),
|
||||||
|
maxval(Arg, meld_cache:VGoal, VGoal),
|
||||||
|
push(VGoal).
|
||||||
|
|
||||||
|
delete_from_min(VGoal,Arg,Goal) :-
|
||||||
|
clause(meld_cache:Goal,_,Ref),
|
||||||
|
(
|
||||||
|
decrease_reference_count(Ref)
|
||||||
|
->
|
||||||
|
clause(meld_program:Goal,_,CRef),
|
||||||
|
decrease_reference_count(CRef),
|
||||||
|
fail
|
||||||
|
;
|
||||||
|
erase(Ref),
|
||||||
|
new_min(VGoal, Arg, Goal)
|
||||||
|
).
|
||||||
|
|
||||||
|
new_min(VGoal,Arg,Goal) :-
|
||||||
|
% format('-~w~n',[Goal]),
|
||||||
|
retract(meld_program:Goal),
|
||||||
|
push(deleted(Goal)),
|
||||||
|
writeln(delete_from_min(VGoal,Arg,Goal)),
|
||||||
|
minval(Arg, meld_cache:VGoal, VGoal),
|
||||||
|
push(VGoal).
|
||||||
|
|
||||||
|
minval(_,_,_) :-
|
||||||
|
nb_setval(min, +inf),
|
||||||
|
nb_setval(min_arg, '$none'),
|
||||||
|
fail.
|
||||||
|
minval(V,G,GMax) :-
|
||||||
|
call(G),
|
||||||
|
nb_getval(min, V0),
|
||||||
|
V < V0,
|
||||||
|
nb_setval(min, V),
|
||||||
|
nb_setval(min_arg, V.GMax),
|
||||||
|
fail.
|
||||||
|
minval(V,_,GMax) :-
|
||||||
|
nb_getval(min_arg, V.GMax).
|
||||||
|
|
||||||
|
|
||||||
|
maxval(_,_,_) :-
|
||||||
|
nb_setval(max, -inf),
|
||||||
|
nb_setval(max_arg, '$none'),
|
||||||
|
fail.
|
||||||
|
maxval(V,G,GMax) :-
|
||||||
|
call(G),
|
||||||
|
nb_getval(max, V0),
|
||||||
|
V > V0,
|
||||||
|
nb_setval(max, V),
|
||||||
|
nb_setval(max_arg, V.GMax),
|
||||||
|
fail.
|
||||||
|
maxval(V,_,GMax) :-
|
||||||
|
nb_getval(max_arg, V.GMax).
|
||||||
|
|
|
@ -0,0 +1,23 @@
|
||||||
|
:- module(meld_program,
|
||||||
|
[
|
||||||
|
run/1
|
||||||
|
]).
|
||||||
|
|
||||||
|
|
||||||
|
:- use_module(meldi,
|
||||||
|
[
|
||||||
|
push/1,
|
||||||
|
first/2,
|
||||||
|
min/3,
|
||||||
|
max/3
|
||||||
|
]).
|
||||||
|
|
||||||
|
|
||||||
|
% built-ins.
|
||||||
|
:- dynamic root/1, neighbor/2, temperature/2.
|
||||||
|
|
||||||
|
trace(A,B) :- !,
|
||||||
|
writeln((A:-B)),
|
||||||
|
trace.
|
||||||
|
|
||||||
|
|
Reference in New Issue