Untitled

#!/usr/bin/env swipl -q -t start -f 

%% chmod +x pharmacon.prolog && ./pharmacon.prolog 

%% hello world program in stack form

helloworld([
    pushz,inc,inc,dup,dup,mul,mul,dup,dup,inc,mul,
    prc,pushz,inc,inc,inc,dup,dup,mul,mul,add,inc,
    inc,prc,add,dec,prc,prc,inc,inc,inc,prc,pushz,
    inc,inc,dup,dup,mul,dup,inc,mul,inc,mul,inc,inc,
    prc,pushz,inc,inc,inc,dup,inc,mul,swap,sub,prc,
    swap,dup,pushz,inc,inc,dup,dup,mul,mul,add,prc,
    swap,pushz,inc,inc,inc,add,dup,dec,dec,dec,prc,
    pop,prc,swap,pop,pushz,inc,inc,dup,inc,mul,swap,
    sub,prc,pushz,inc,inc,dup,dup,mul,mul,swap,sub,
    prc,pop,inc,prc,pop,pushz,inc,inc,dup,dup,dup,
    inc,add,mul,add,inc,prc,dec,dec,dec,prc,pop
]).


%% peano arithmetic
z(z).
inc(S,s(S)).
dec(s(S),S).

add(z,S,S).
add(s(S),A,O) :- add(S,s(A),O).

sub(S,z,S).
sub(s(S),s(A),O) :- sub(S,A,O).

mul(_,z,z).
mul(z,_,z).
mul(S,s(z),S).
mul(s(z),S,S) :- \+ S = s(z).
mul(A,B,O) :- dec(A,A1), mul(A1,B,O1), add(B,O1,O).

num(0,z).
num(N,s(S)) :- \+ var(N), N> 0, N1 is N -1, num(N1,S).
num(N,s(S)) :- \+ var(S), num(N1,S), N is N1 + 1.

%% basic linked list/cons cells/

nil(nil).
pair(A,B,pair(A,B)).
head(pair(A,_),A).
tail(pair(_,B),B).

pairs([],nil).
pairs([H|T],pair(H,T1)) :- pairs(T,T1).

%% stack machine

run(P,O) :- pairs(P,Pa), nil(S), eval(Pa,S,Oa), stackback(Oa,O),!.

eval(I,S,S) :- nil(I).
eval(I,S,O) :- head(I,H), exec(H,S,O1),!, tail(I,T), eval(T,O1,O).

exec(pushz,S,O) :- z(Z),pair(Z,S,O).
exec(pop,S,O) :- tail(S,O).
exec(inc,S,O) :- pair(A,B,S), inc(A,A1), pair(A1,B,O).
exec(dup,S,O) :- head(S,A), pair(A,S,O).
exec(prc,S,S) :- head(S,A), num(N,A), writef('%n',[N]).
exec(prn,S,S) :- head(S,A), num(N,A), writef('%w',[N]).
exec(dec,S,O) :- pair(A,B,S), dec(A,A1), pair(A1,B,O).
exec(add,S,O) :- pair(A,At,S), pair(B,T,At), add(A,B,AB), pair(AB,T,O).
exec(swap,S,O) :- pair(A,At,S), pair(B,T,At), pair(A,T,Bt), pair(B,Bt,O).
exec(sub,S,O) :- pair(A,At,S), pair(B,T,At), sub(A,B,AB), pair(AB,T,O).
exec(mul,S,O) :- pair(A,At,S), pair(B,T,At), mul(A,B,AB), pair(AB,T,O).
exec(A,_,_) :- writef("Unknown %w\n",[A]), !, fail.

stackback(nil,[]).
stackback(pair(H,T),[H1|T1]) :- num(H1,H),stackback(T,T1).

start :- helloworld(H), run(H,[]).