say yes .. nprolog

前回からの積み残しで、say yes 問題（オイラーが勝手にこう呼んでいるだけだけど）を何とかしたい。

p(A,B,C) :- A < B, A^2 + B^2 == C^2.

?- p(3,4,5).
no

ピタゴラスの三角形が成り立っているかの問い。say yes を希望するも、つれない返事。

prologの資料を呼んだよ。根本解決は

?- 3^2 + 4^2 =:= 5^2.
yes

数値用の比較を使えって事。こんな記号の羅列は誰の発案だ？

お約束のgdb観光。

(gdb) bt
#0  b_numeq (arglist=7000017, rest=174) at builtin.c:1655
#1  0x1503e32e in prove (goal=7000018, bindings=0, rest=174, n=1) at main.c:407
#2  0x1503d424 in prove_all (goals=7000003, bindings=0, n=1) at main.c:370
#3  0x1503cc64 in query (x=902) at main.c:299
#4  0x1503c8c2 in main (argc=1, argv=0xcf7eb424) at main.c:234

builtin.cに、関数が登録されてた。

void initbuiltin(void){
    definfix(">",b_greater,700,XFX);
    definfix("<",b_smaller,700,XFX);
    definfix("=<",b_eqsmaller,700,XFX);
    definfix(">=",b_eqgreater,700,XFX);
    definfix("=:=",b_numeq,700,XFX);
    definfix("=\\=",b_notnumeq,700,XFX);
    definfix("=/=",b_notnumeq,700,XFX);
    definfix("@<",b_atsmaller,700,XFX);
     :

prolog側の関数とC語側の関数の対応表。700,XFXとかは、参照した資料に説明が有った記憶があったけど、意味忘れた。C語のビルトイン関数は、b_ を付ける事にしてるようだ。

  int b_numeq(int arglist, int rest){
      int n,arg1,arg2;

B =>  n = length(arglist);
      if(n == 2){
          arg1 = eval(car(arglist));
          arg2 = eval(cadr(arglist));
          if(!numberp(arg1))
              error(NOT_NUM,"=:= ",arg1);
          if(!numberp(arg2))
              error(NOT_NUM,"=:= ",arg2);

          if(numeqp(arg1,arg2))
              return(YES);
          else
              return(NO);
      }
      return(NO);
  }

非常に素直な関数になっている。ここに来た時は、α簡約が済んでいると見受けた。

ちなみに ＝＝ での比較は b_equalp にあって

if(anoymousp(arg1) && anoymousp(arg2))
    return(NO);
else if(equalp(arg1,arg2))

数値を除くものを何でも比較しちゃう。何でもってのは、null、structure、listの比較になる。今回の場合なら、リストが長さが違うから、等しく無いよって事だろうね。

emacsと連携する為、nplをgprologと名称変更して使ってた。けど、オレオレ詐欺みたいで気分が悪い。大体gprologとnplの作者さんに失礼である。

prolog.elをざっと見した結果、prologでもplでもよさそうって推測出来たんで、慎ましくplを名乗る事にした。emacsの設定ファイルに書いておいた、(setq prolog-system 'gnu)を削除したよ。これでも、ちゃんとplを見つけてくれて、ちゃんと使えた。肩の荷が下りたよ。

nplは足が速くて、Ver 1.4 で、traceやspyが導入されたけど、OpenBSDでは、面倒なので1.2のまま使ってる。いや、機能が増えると目移りするんで、基本を押さえるのさ。新しいmakefileを見ると、地味にmake installが出来るようになってた。

DEST = /usr/local/bin

install: $(NPL)
        install -s  $(NPL) $(DEST)

install時に、余計な物（debug情報等）を削除しつつ実行するんだな。これは、オイラーみたいなgdb好きには、困った挙動だ。

それとmain.c中に

fp = fopen("library/compiler.pl","r");
if(fp != NULL){
    fclose(fp);
    b_consult(list1(makeconst("library/compiler.pl")),NIL);
    predicates = NIL;
}

こういう、コンパイラーを呼んでるけど、ちと困りそう。Verが上がって性能が出るようになったら、本格的に対処されるのかな？

マニュアルによると、 compile_file('xxx.pl') すると、C語に変換してgccでそれをオブジェクトファイルにコンパイルするとな。xxx.oが出来るんだな。後はそれをconsult('xxx.o')すれば使えるとな。

それで、ダイナミックロードのライブラリィーが必要になるのね(only need linux)。

grep  -nH -e gcc library/*
library/compiler.pl:58:    jump_invoke_gcc(X).
library/compiler.pl:61:    jump_invoke_gcc(X).
library/compiler.pl:99:gcc -O3 -w -shared -fPIC -o <filenam>.c <filename>.o <option>
library/compiler.pl:101:jump_invoke_gcc(X) :-
library/compiler.pl:108:    atom_concat('gcc -O3 -w -shared -fPIC -o ',Files,Sys),

gccを呼び出して、コンパイルするまで、prolog語で書かれている。後はそれの読み込みだな。

grep  -nH -e dlopen *.c
link.c:28:    hmod = dlopen(str, RTLD_LAZY);

この近辺を見ると、必須の手続きを呼び出している（のかな？）。引数無しから、４引数までに対応だな。

マニュアルによると、edit関数で、prologの中からeditorを呼び出せるようだ。 で、使うeditorは、nanoって言う、リナなら必ず入っているやつみたい。 オイラーは、リナをインストールすると、直ぐにEDITOR=emacs って口だから、環境変数で手軽に切り替えられるといいね。

特に、スーパーユーザーになって、何かしようとしてnanoがやって来るとげんなりだ。本当は軽いviあたりがスーパーユーザー向けなんだろうけど、リナのviはもどきでvimなんで、これも困った口だ（オイラーの個人的な意見だから、石投げないでね）。

編集関数は、builtin.c に有った。ズバリの関数名 b_nano でね。 何か所か、nanoって文字列が出て来るけど、本質部分は、

char str0[STRSIZE] = "nano ";

だけだ。他にある"nano"は、"editor"ぐらいで、ごまかしてしまっても良いはず。後でOpenBSDでやってみよう。何たってOpenBSDにはnano君は居ないはずだから。

debian:nprolog$ cat z.pl
p(A,B,C) :- A < B, A^2 + B^2 =:= C^2.

Bugが取れた、超ミニをコンパイルしてみる。勿論、library/が見える所でやらないといけない（だろう）、上の考察によればね。gitから落としたその中です。

debian:nprolog$ ./npl
N-Prolog Ver 1.4
?- compile_file('z.pl').
pass1
pass2
Existence error

compile_file が赤字になって、危険と知らせてきた。構わず実行すると、見事にエラー。

debian:nprolog$ cat z.c
#include "jump.h"
jump_pred_data(p,type1)debian:nprolog$

C語ファイル作成途中のようだなあ。それにjump.h も無いようだし。

compiler.plをチラ見。いきなりC語（の雛型）が出てきたのでびっくり。めげずに見て行くと

compile_file(X) :-
    jump_pass1(X),
    jump_pass2(X),
    jump_invoke_gcc(X).

2passでC語を作成、それをgccにかけている。pass1は無事に通過して、pass2で引っかかっているのだな。pass1はtail recursive optimize、pass2がC語作成とコメントが入ってた。

マニュアルにある例を試しにやってみる。

?- compile_file('queens.pl').
pass1
pass2
compiling test16
compiling test
compiling test1
compiling queen
compiling queen_2
compiling qdelete
compiling tail nodiag
invoke GCC
queens.c:1:10: fatal error: jump.h: No such file or directory
 #include "jump.h"
          ^~~~~~~~
compilation terminated.
yes

今度はベタなC語ファイルが出来た。indent queens.c して整形する。

#include "jump.h"
int b_test16 (int arglist, int rest);
int
b_test16 (int arglist, int rest)
{
  int varX, n, body, save1, save2;
  save2 = Jget_sp ();
  n = Jlength (arglist);
  if (n == 0)
    {
      varX = Jmakevariant ();
      save1 = Jget_wp ();
       :

ふむ、私設のjump.hを要求してるんだな。testsの下にひっそりと置いてあった。これをqueens.cと同列の場所（今の場合だと/tmpの実験場）に引っ張り出してみる。 そしたら、ちゃんとコンパイル出来て、オブジェクトファイルが作成された。

debian:tmp$ npl
N-Prolog Ver 1.4
?- ['queens.o'].
yes
?- test.
[1,3,6,8,2,4,9,7,5]
[1,3,7,2,8,5,9,4,6]
  :

とか、

debian:tmp$ npl -c queens.o
N-Prolog Ver 1.4
?- test.
[1,3,6,8,2,4,9,7,5]
[1,3,7,2,8,5,9,4,6]
  :

アプリのように、-c　でロードしたら、いきなり走り出すようには、出来ないのかな。ロードモジュールに、そんな危険な事をさせるって、いかがなものかと、OpenBSD小僧は密かに、思ったり、思わなかったり。。。

いや、Linuxなら、イケイケ・ドンドン、勇ましくが信条だから、そういうのも許す（かな）。

それはそうと、サンプルがちゃんとコンパイル出来て、オイラーの書いたピタゴラスの三角形チェックがエラーになるのは、数値比較がまだ実装されていないのではなかろうか。 急ぐ事は無いので、コンパイラーの骨格をしっかり固めてください。

そして最後は、コンパイラー自身をコンパイルするって言う、究極の試験に合格する事を祈ります。

ごちゃごちゃ書いたのを、OpenBSDで試してみる。

DEST = /home/sakae/bin

install: $(NPL)
        mv $(NPL) $(DEST)/pl

-rwxr-xr-x  1 sakae  wheel  10924 Nov  8 15:56 queens.o*  ;; by cc
-rwxr-xr-x  1 sakae  wheel  15276 Nov  8 16:00 queens.o*  ;; by gcc

?- compile_file('compiler.pl').
pass1
pass2
Existence error

vbox$ cat compiler.c
#include "jump.h"
jump_pred_data(compile_file,type1)vbox$

jump_eval_form(X + Y) :-
        write('Jplus('),
    jump_eval_form(X),
    write(','),
    jump_eval_form(Y),
    write(')').

#define Jcons(x,y)   (f2[0])(x,y)
#define Jplus(x,y)   (f2[1])(x,y)
#define Jminus(x,y)  (f2[2])(x,y)
  :

//argument-2 type
init_f2(0,(tpred)cons);
init_f2(1,(tpred)f_plus);
init_f2(2,(tpred)f_minus);
 :