Prologの新しいシンタックスの提案 4

Prologの不満を聞くと、関数のネストができなくて嫌だ。という話もよく聞きます。
そこで、ここでは関数呼び出しができるようにして関数論理型言語にしてみます。

K正規形に変換するようなイメージで変換すればよいはずです。

where を使うと Haskell ライクになるので where を使って前提となる式を右側に書くことにしましょう:

% eval6.npl

eval(_Γ,_x)       = v   where member(x = _v, Γ).
eval(_Γ,_i)       = i   where integer(i).
eval(_Γ,_a+_b)    = v   where _v is eval(Γ, a) + eval(Γ, b).
eval(_Γ,_a*_b)    = v   where _v is eval(Γ, a) * eval(Γ, b).
eval(_Γ,_x=_a;_b) = v   where eval([x = eval(Γ, a)|Γ], b,_v).
t(_Γ,_x)          = t   where atom(x),member(x:t_, Γ).
t(_Γ,_i)          = Int where integer(i).
t(_Γ,_a+_b)       = Int where Int=t(Γ,a),Int=t(Γ,b).
t(_Γ,_a*_b)       = Int where Int=t(Γ,a),Int=t(Γ,b).
t(_Γ,x_=_a;_b)    = t   where _t=t([x:t(Γ,a)|Γ],b).
add(_a,_b)        = c   where _c is a+b.
run(_e)           = r:t where _t=t([], e), _r=eval([], e).

> _r = run(x = 1 * 2 + 3 * 4; x), writeln(r).
> _a = 1, _a is a+1, _a is a+1, writeln(a).
> _a:Int = x:_t, writeln(a:t).
> add(1,2,_C),writeln(C).
> writeln(add(1,add(2,3))).
> halt.

実行すると:

$ swipl npl4.pl eval6.npl
14:Int
3
x:Int
3
6

実装

% npl4.pl
:- dynamic(func/1).
:- op(1200,fx,[>]).
:- op(1200,xfx,[where]).
read_file_terms(F,R) :-
    open(F,read,FP),read_terms(FP,R,[]),close(FP).
read_terms(FP, Terms, Tail) :-
    read_term(FP, C1, [variable_names(Vs)]),read_terms_conv(C1,Vs),
    read_terms(C1, FP, Terms, Tail).
read_terms(end_of_file, _, Tail, Tail) :- !.
read_terms(C, FP, [C|T], Tail) :-
    read_term(FP, C2, [variable_names(Vs)]),read_terms_conv(C2,Vs),
    read_terms(C2, FP, T, Tail).
read_terms_conv((> _),Vs) :- maplist(call,Vs).
read_terms_conv((_ where _),Vs) :- maplist(call,Vs).
read_terms_conv(_,_).
% 述語１つを変換

conv_terms(_,[],[],I,I) :- !.
conv_terms(E,[C|Cs],[C2|Cs2],I,I2) :- conv_goal(E,C,C2,I,I1),conv_terms(E,Cs,Cs2,I1,I2).

conv_goal(_,V,V,I,I) :- var(V),!.
conv_goal(_,V,V3,I,I) :- atom(V),(concat('_',V2,V);concat(V2,'_',V)),memberchk(V2=V3,I),!.
conv_goal(_,V,V3,I,[V2=V3|I]) :- atom(V),(concat('_',V2,V);concat(V2,'_',V)).
conv_goal(E,V,V2,I,I) :- atom(V),memberchk(V=V2,E),!.
conv_goal(_,V,V,I,I) :- atomic(V),!.
conv_goal(E,V,V3,I,[V4|I2]) :- functor(V,N,A),func(N/A),V=..[C|Cs], conv_terms(E,Cs,Cs2,I,I2),
                                      append(Cs2,[V3],Cs4),V4=..[C|Cs4].
conv_goal(E,V,V2,I,I2) :- V=..[C|Cs], conv_terms(E,Cs,Cs2,I,I2), V2=..[C|Cs2].

simpl(I1,I2) :- simpl([],I1,I2).
simpl(E,[],E).
simpl(E,[X=_|I1],I2) :- memberchk(X=_,E),simpl(E,I1,I2).
simpl(E,[V|I1],I2) :- simpl([V|E],I1,I2).

merge(S1,[],S1).
merge(S1,[X=V|S2],S3) :- member(X=V,S1),merge(S1,S2,S3).
merge(S1,[X=V|S2],S3) :- merge([X=V|S1],S2,S3).

kconv([],A,A).
kconv([K|B],A,A2) :- kconv(B,(K,A),A2).
conv_goal(I,A,K,R1) :- conv_goal(I,A,A1,[],I1),partition([_=_]>>!,I1,R1,R2),!,kconv(R2,A1,K).
conv_goals((A,B),(A1,B1)) --> conv_goals(A,A1),conv_goals(B,B1).
conv_goals((A;B),(A1;B1),I,I3) :-
    conv_goal(I,A,A1,I1),conv_goal(I,B,B1,I2),
    simpl(I1,S1),simpl(I2,S2),merge(S1,S2,S3),append(S3,I,I3).
conv_goals(A,A1,I,I2) :- conv_goal(I,A,A1,I1),append(I1,I,I2).

% 文を変換
conv_stmt((H=R where V),H3:-V2) :- !,functor(H,N,A),assertz(func(N/A)),H=..H1,append(H1,[R],H11),H12=..H11,
  conv_goals((H12,V),(H2,V2),[],I),!,conv_goals(H2,H3,I,_).
conv_stmt((> V),(:- V2)) :- !,conv_goals(V,V2,[],_).
conv_stmt((H where V),(H3 :- V2)) :- !,conv_goals((H,V),(H2,V2),[],I),!,
  conv_goals(H2,H3,I,_).
conv_stmt(V,V).
% 文のリストを変換
conv_stmts(Vs,Vs2) :- maplist(conv_stmt,Vs,Vs2).

assert1(:- V) :- call(V); writeln(error:V).
assert1(V) :- assertz(V).
consult1(F) :- read_file_terms(F,R),conv_stmts(R,R2),maplist(assert1,R2).
:- current_prolog_flag(argv, Argv),maplist(consult1,Argv).