Package of CHR with dynamic rule priorities? (original) (raw)
I eventually found the source code of CHRrp system (see The CHR-rp System).
The good news is that it still compiles fine (with some minor changes) in the current SWI-Prolog. The bad news is it doesn’t seem to support dynamic priority?
For example,
%% dijkstra.chr
:- chr_constraint source(+), e(+,+,+), dist(+,+).
source(V) ==> dist(V,0) pragma priority(1).
dist(V,D1) \ dist(V,D2) <=> D1 < D2 | true pragma priority(1).
dist(V,D), e(V,C,U) ==> DC is D + C, dist(U,DC) pragma priority(D+2).
?- consult(["c.pl "]).
true.
?- main(dijkstra).
database:constraint(dist/2,[+,+],[any,any]),
database:constraint(e/3,[+,+,+],[any,any,any]),
database:constraint(source/1,[+],[any]),
database:constraint_index(dist/2,[1],1,2),
database:constraint_index(e/3,[1],2,2),
database:constraint_index(dist/2,[],0,1),
database:constraint_index(e/3,[],2,1),
database:constraint_index(source/1,[],1,1),
database:join_order(3,k(2),[k(1)]),
database:join_order(3,k(1),[k(2)]),
database:join_order(2,k(1),[r(1)]),
database:join_order(2,r(1),[k(1)]),
database:join_order(1,k(1),[]),
database:max_occurrence(e/3,2,1),
database:max_occurrence(dist/2,2,1),
database:max_occurrence(dist/2,1,2),
database:max_occurrence(source/1,1,1),
database:nb_constraint_indexes(e/3,2),
database:nb_constraint_indexes(dist/2,2),
database:nb_constraint_indexes(source/1,1),
database:nb_rules(3),
database:no_check_activation_call(3),
database:no_check_activation_call(2),
database:no_check_activation_call(1),
database:occurrence(e/3,3,k(2),2,1),
database:occurrence(dist/2,3,k(1),2,1),
database:occurrence(dist/2,2,k(1),1,2),
database:occurrence(dist/2,2,r(1),1,1),
database:occurrence(source/1,1,k(1),1,1),
database:rule(3,no,$VAR(_A)+2,[dist($VAR(_B),$VAR(_A)),e($VAR(_B),$VAR(_C),$VAR(_D))],[],[],[$VAR(_E)is$VAR(_A)+ <span class="katex"><span class="katex-mathml"><math xmlns="http://www.w3.org/1998/Math/MathML"><semantics><mrow><mi>V</mi><mi>A</mi><mi>R</mi><msub><mo stretchy="false">(</mo><mi>C</mi></msub><mo stretchy="false">)</mo><mo separator="true">,</mo><mi>d</mi><mi>i</mi><mi>s</mi><mi>t</mi><mo stretchy="false">(</mo></mrow><annotation encoding="application/x-tex">VAR(_C),dist(</annotation></semantics></math></span><span class="katex-html" aria-hidden="true"><span class="base"><span class="strut" style="height:1em;vertical-align:-0.25em;"></span><span class="mord mathnormal" style="margin-right:0.22222em;">V</span><span class="mord mathnormal">A</span><span class="mord mathnormal" style="margin-right:0.00773em;">R</span><span class="mopen"><span class="mopen">(</span><span class="msupsub"><span class="vlist-t vlist-t2"><span class="vlist-r"><span class="vlist" style="height:0.3283em;"><span style="top:-2.55em;margin-left:0em;margin-right:0.05em;"><span class="pstrut" style="height:2.7em;"></span><span class="sizing reset-size6 size3 mtight"><span class="mord mathnormal mtight" style="margin-right:0.07153em;">C</span></span></span></span><span class="vlist-s"></span></span><span class="vlist-r"><span class="vlist" style="height:0.15em;"><span></span></span></span></span></span></span><span class="mclose">)</span><span class="mpunct">,</span><span class="mspace" style="margin-right:0.1667em;"></span><span class="mord mathnormal">d</span><span class="mord mathnormal">i</span><span class="mord mathnormal">s</span><span class="mord mathnormal">t</span><span class="mopen">(</span></span></span></span>VAR(_D),$VAR(_E))]),
database:rule(2,no,1,[dist($VAR(_F),$VAR(_G))],[dist($VAR(_F),$VAR(_H))],[$VAR(_G)< $VAR(_H)],[true]),
database:rule(1,no,1,[source($VAR(_I))],[],[],[dist($VAR(_I),0)]),
schedule_depth(3,k(2),1),
schedule_depth(3,k(1),0),
suspension:fix_suspension_layout,
suspension:uses_history(source/1),
suspension:uses_history(dist/2),
suspension:uses_history(e/3) . <---- There is a choice point, but I don't know what it means. I press `.` .
?- consult("dijkstra.pl").
true.
?- source(1), e(1,3,2),e(2,8,4),e(1,5,3),e(3,2,4),e(2,1,3), check_activation, show_store.
dist(1,0)
e(1,3,2)
e(2,8,4)
e(1,5,3)
e(3,2,4)
e(2,1,3)
source(1)
true.
It only produced one dist(1,0) constraint. Maybe I missed something?
Using the same approach, the leq.chr can work normally.
%% leq.chr
:- chr_constraint leq/2.
leq(X,X) <=> true pragma priority(1).
leq(X,Y), leq(Y,X) <=> X = Y pragma priority(1).
leq(X,Y) \ leq(X,Y) <=> true pragma priority(1).
leq(X,Y), leq(Y,Z) ==> leq(X,Z) pragma priority(2).
?- leq(1,2),leq(2,3),leq(3,4), check_activation, show_store.
leq(1,4)
leq(2,4)
leq(3,4)
leq(1,3)
leq(2,3)
leq(1,2)
true.