A Couple of Meta-interpreters in Prolog

Motivation

natnum(0). natnum(s(X)) :- natnum(X).

?- Goal = natnum(X), Goal. Goal = natnum(0), X = 0 ; Goal = natnum(s(0)), X = s(0) ; ...

Vanilla MIs

Accessing Prolog code

natnum(0) :- true.

?- clause(natnum(Z), Body). Z = 0, Body = true ; Z = s(_A), Body = natnum(_A).

complicated_clause(A) :- goal1(A), goal2(A), goal3(A). ?- clause(complicated_clause(Z), Body). Body = (goal1(Z), goal2(Z), goal3(Z)).

body(true). body((A,B)) :- body(A), body(B). body(G) :- % ambiguous, also matches "true" and "(_,_)" goal(G). goal(_ = _). goal(call(_)). % ... etc.

mi1(true). mi1((A,B)) :- mi1(A), mi1(B). mi1(Goal) :- Goal \= true, Goal \= (_,_), clause(Goal, Body), mi1(Body).

?- mi1(natnum(X)). X = 0 ; X = s(0) ; X = s(s(0)) ; ...

Using a clean representation

body(true). body((A,B)) :- body(A), body(B). body(g(G)) :- goal(G).

natnum_clean(0). natnum_clean(s(X)) :- g(natnum_clean(X)).

?- natnum_clean(X).

mi2(true). mi2((A,B)) :- mi2(A), mi2(B). mi2(g(G)) :- clause(G, Body), mi2(Body).

?- integer_natnum(10^5, T), time(mi1(natnum(T))). % 400,005 inferences, 0.80 CPU in 0.83 seconds (96% CPU, 500006 Lips) ?- integer_natnum(10^5, T), time(mi2(g(natnum_clean(T)))). % 200,003 inferences, 0.71 CPU in 0.79 seconds (90% CPU, 281694 Lips)

mi_clause(G, Body) :- clause(G, B), defaulty_better(B, Body). defaulty_better(true, true). defaulty_better((A,B), (BA,BB)) :- defaulty_better(A, BA), defaulty_better(B, BB). defaulty_better(G, g(G)) :- G \= true, G \= (_,_).

mi_clause(natnum(0), true). mi_clause(natnum(s(X)), g(natnum(X)).

Variants and modifications

mi3(true). mi3((A,B)) :- mi3(B), % first B, then A mi3(A). mi3(g(G)) :- mi_clause(G, Body), mi3(Body).

mi3(false) :- false.

declarative_false :- declarative_false, false.

mi2_safe(g(G)) :- ( safe_goal(G) -> mi_clause(G, Body), mi2_safe(Body) ; throw(cannot_execute(G)) ).

natnum_list(0, []). natnum_list(s(X), [natnum_list(X)]).

mi_clause(G, Ls) :- clause(G, Body), phrase(body_list(Body), Ls). body_list(true) --> []. body_list((A,B)) --> body_list(A), body_list(B). body_list(G) --> { G \= true }, { G \= (_,_) }, [G].

mi_list1([]). mi_list1([G|Gs]) :- mi_clause(G, Body), mi_list1(Body), mi_list1(Gs).

mi_list2([]). mi_list2([G0|Gs0]) :- mi_clause(G0, Body), append(Body, Gs0, Gs), mi_list2(Gs).

always_infinite :- always_infinite. ?- mi_list1([always_infinite]). ERROR: Out of local stack ?- mi_list2([always_infinite]). % loops, constant stack space

mi_ldclause(natnum(0), Rest, Rest). mi_ldclause(natnum(s(X)), [natnum(X)|Rest], Rest). mi_list3([]). mi_list3([G0|Gs0]) :- mi_ldclause(G0, Remaining, Gs0), mi_list3(Remaining).

?- mi_list3([natnum(X)]). X = 0 ; X = s(0) ; X = s(s(0)) ; ...

A meta-circular MI

mi_circ(true). mi_circ((A,B)) :- mi_circ(A), mi_circ(B). mi_circ(clause(A,B)) :- clause(A,B). mi_circ(A \= B) :- A \= B. mi_circ(G) :- G \= true, G \= (_,_), G \= (_\=_), G \= clause(_,_), clause(G, Body), mi_circ(Body).

?- mi_circ(mi_circ(natnum(X))). X = 0 ; X = s(0) ; X = s(s(0)) ; ...

Reasoning about programs

provable/2

provable(true, _). provable((A,B), Defs) :- provable(A, Defs), provable(B, Defs). provable(g(Goal), Defs) :- ( predicate_property(Goal, built_in) -> call(Goal) ; member(Def, Defs), copy_term(Def, Goal-Body), provable(Body, Defs) ).

copy_term/2

redundant(Functor/Arity, Reds) :- functor(Term, Functor, Arity), findall(Term-Body, mi_clause(Term, Body), Defs), setof(Red, Defs^redundant_(Defs, Red), Reds). redundant_(Defs, Fact) :- select(Fact-true, Defs, Rest), once(provable(g(Fact), Rest)).

as([]). as([a]). % redundant as([a,a]). % redundant as([A|As]) :- A = a, % test built-in (=)/2 true, % test built-in true/0 as(As).

?- redundant(as/1, Rs). Rs = [as([a]), as([a, a])].

?- ack_fixpoint(As). As = [ack(odd, odd, odd), ack(odd, even, odd), ack(odd, one, odd), ack(even, odd, odd), ack(odd, zero, odd), ack(even, even, odd), ack(even, one, odd), ack(one, odd, odd), ack(even, zero, odd), ack(one, even, even), ack(one, one, odd), ack(one, zero, even), ack(zero, even, odd), ack(zero, odd, even), ack(zero, zero, one), ack(zero, one, even)].

?- dif(X, one), dif(X, zero), dif(Z, odd), ack_fixpoint(As), member(ack(X,Y,Z), As). false.

Ackermann(i, j)

Reifying backtracking

[G0]

[G0]-G0

G0

mi_backtrack(G0) :- mi_backtrack_([[G0]-G0], G0).

resstep_([A|As0], As) :- findall(Gs-G, (A = [G0|Rest]-G,mi_ldclause(G0,Gs,Rest)), As, As0).

A = [G0|Rest]-G

mi_backtrack_([[]-G|_], G). mi_backtrack_(Alts0, G) :- resstep_(Alts0, Alts1), mi_backtrack_(Alts1, G).

Extending Prolog

Showing proofs

:- op(750, xfy, =>). mi_tree(true, true). mi_tree((A,B), (TA,TB)) :- mi_tree(A, TA), mi_tree(B, TB). mi_tree(g(G), TBody => G) :- mi_clause(G, Body), mi_tree(Body, TBody).

?- mi_tree(g(natnum(X)), T). T = true=>natnum(0), X = 0 ; T = (true=>natnum(0))=>natnum(s(0)), X = s(0) ; T = ((true=>natnum(0))=>natnum(s(0)))=>natnum(s(s(0))), X = s(s(0)) ; ...

Changing the search strategy

mi_limit(Goal, Max) :- mi_limit(Goal, Max, _). mi_limit(true, N, N). mi_limit((A,B), N0, N) :- mi_limit(A, N0, N1), mi_limit(B, N1, N). mi_limit(g(G), N0, N) :- N0 #> 0, N1 #= N0 - 1, mi_clause(G, Body), mi_limit(Body, N1, N).

?- mi_limit(g(natnum(X)), 3). X = 0 ; X = s(0) ; X = s(s(0)) ; false.

mi_id(Goal) :- length(_, N), mi_limit(Goal, N).

edge(a, b). edge(b, a). edge(b, c). path(A, A, []). path(A, C, [e(A,B)|Es]) :- edge(A, B), path(B, C, Es).

?- path(a, c, Es). ERROR: Out of local stack ?- mi_id(g(path(a, c, Es))). Es = [e(a,b),e(b,c)] ; ...

Sound unification

occ(X, f(X)).

?- occ(A, A).

mi_occ(true). mi_occ((A,B)) :- mi_occ(A), mi_occ(B). mi_occ(g(G)) :- functor(G, F, Arity), functor(H, F, Arity), mi_clause(H, Body), unify_with_occurs_check(G, H), mi_occ(Body).

?- mi_occ(g(occ(A,A))). false.

unify(G,H)

Parsing with left-recursive grammars

dcgnumber(0). dcgnumber(1). expr(N) --> [N], { dcgnumber(N) }. expr(A+B) --> expr(A), [(+)], expr(B).

?- phrase(expr(E), Ss). E = 0, Ss = [0] ; E = 1, Ss = [1] ; E = 0+0, Ss = [0,+,0] ; ...

?- phrase(expr(E), [1,+,1]). E = 1+1 ; ERROR: Out of local stack

dcg_clause(expr(N), [t(N),{dcgnumber(N)}]). dcg_clause(expr(A+B), [l,nt(expr(A)),t(+),nt(expr(B))]).

l

l

t/1

nt/1

{}/1

mi_dcg(NT, String) :- length(String, L), length(Rest0, L), mi_dcg_([nt(NT)], Rest0, _, String, []).

mi_dcg(t(T), Rest, Rest, [T|Ts], Ts). mi_dcg({Goal}, Rest, Rest, Ts, Ts) :- call(Goal). mi_dcg(nt(NT), Rest0, Rest, Ts0, Ts) :- dcg_clause(NT, Body), mi_dcg_(Body, Rest0, Rest, Ts0, Ts). mi_dcg(l, [_|Rest], Rest, Ts, Ts). mi_dcg_([], Rest, Rest, Ts, Ts). mi_dcg_([G|Gs], Rest0, Rest, Ts0, Ts) :- mi_dcg(G, Rest0, Rest1, Ts0, Ts1), mi_dcg_(Gs, Rest1, Rest, Ts1, Ts).

?- mi_dcg(expr(E), [1,+,1,+,1]). E = 1+(1+1) ; E = 1+1+1 ; false.

Further extensions

pe_expr(Expr, String) :- length(String, L), length(Rest0, L), pe_expr(Expr, Rest0, _, String, []). pe_expr(N, Rest, Rest, Ts0, Ts) :- Ts0 = [N|Ts], dcgnumber(N). pe_expr(A+B, [_|Rest0], Rest, Ts0, Ts) :- pe_expr(A, Rest0, Rest1, Ts0, Ts1), Ts1 = [+|Ts2], pe_expr(B, Rest1, Rest, Ts2, Ts).

?- sum_of_ones(10^3, Ss), time(mi_dcg(expr(Sum), Ss)). % 525,516 inferences, 0.68 CPU in 0.68 seconds (100% CPU, 772818 Lips) ?- sum_of_ones(10^3, Ss), time(pe_expr(Sum, Ss)). % 6,008 inferences, 0.01 CPU in 0.01 seconds (186% CPU, 600800 Lips)