├── .github └── FUNDING.yml ├── .gitignore ├── README-ja.md ├── README.md ├── bench ├── Bench.md ├── cpbench.pl ├── derive.pl ├── devide10.pl ├── log10.pl ├── nreverse.pl ├── ops8.pl ├── qsort.pl ├── runbench.pl ├── serialize.pl └── times10.pl ├── bignum.c ├── builtin.c ├── cell.c ├── clp.c ├── compat ├── cdefs.h ├── curses_stubs.h ├── eiffel_stubs.h ├── nana_stubs.h └── term_stubs.h ├── compute.c ├── data.c ├── document ├── ATFIRST.md ├── CHECKER.md ├── CLPFD.md ├── COMPILER.md ├── CURL.md ├── DCG.md ├── EDLOG.md ├── HISTORY.md ├── JSON.md ├── LIST.md ├── MANUAL.md ├── MANUALja.md ├── MODULE.md ├── MPW.md ├── OPENGL.md ├── PARA1.md ├── PARA2.md ├── PLOT.md ├── PYHTON.md ├── SETS.md ├── SUPERSET.md ├── TCLTK.md ├── TCPIP.md ├── UNICODE.md ├── WIRINGPI.md ├── book1.png ├── book2.png ├── para1.png ├── para2.png ├── para3.png ├── para4.png ├── screen1.png ├── screen2.png ├── screen3.png ├── screen4.png └── screen5.png ├── edit.c ├── edlog.c ├── edlog.h ├── error.c ├── example ├── animal.pl ├── assoc.pl ├── bagof.pl ├── bignum.pl ├── comp.pl ├── counter.pl ├── cursor.pl ├── cut.pl ├── dcg.pl ├── dif.pl ├── disj.pl ├── dna.pl ├── doctor.pl ├── einstein.pl ├── enigma.pl ├── fact.pl ├── fib.pl ├── fizzbuzz.pl ├── gcd.pl ├── led.pl ├── length.pl ├── lisp.pl ├── list.pl ├── math.pl ├── maze.pl ├── measure.pl ├── monkey.pl ├── one-stroke.pl ├── paip.pl ├── pp.pl ├── production.pl ├── prover.pl ├── quarternion.pl ├── record.pl ├── repeat.pl ├── sazaesan.pl ├── tamura.pl ├── taxi.pl ├── turing.pl ├── utf8.pl └── zebra.pl ├── extension.c ├── function.c ├── gbc.c ├── jump.h ├── library ├── checker.pl ├── clpfd.pl ├── compiler.pl ├── dcg.pl ├── json.pl ├── list.pl ├── mpworld.pl ├── opengl.pl ├── plot.pl ├── python.pl ├── sets.pl └── tcltk.pl ├── license.txt ├── link.c ├── main.c ├── makefile ├── npl.h ├── npl.png ├── parallel.c ├── parser.c ├── superset.c ├── syntax_highlight.c ├── term.h └── tests ├── ac3.pl ├── ack.pl ├── ack1.pl ├── bench.pl ├── bug.pl ├── calc.py ├── chatgpt.pl ├── clpfd.pl ├── clpqueen.pl ├── collatz.pl ├── curl.pl ├── dpqueens.pl ├── exception.pl ├── fact.pl ├── fact1.pl ├── function.pl ├── http.pl ├── iitaka.pl ├── io.pl ├── json.pl ├── mpw.pl ├── mtqueens.pl ├── opengl.pl ├── para1.pl ├── para2.pl ├── plot.pl ├── queens.pl ├── queens.pl~ ├── socket.pl ├── tail.pl ├── tcltk.pl ├── tfact.pl └── verify.pl /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [sasagawa888] # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] 4 | patreon: # Replace with a single Patreon username 5 | open_collective: # Replace with a single Open Collective username 6 | ko_fi: # Replace with a single Ko-fi username 7 | tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel 8 | community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry 9 | liberapay: # Replace with a single Liberapay username 10 | issuehunt: # Replace with a single IssueHunt username 11 | otechie: # Replace with a single Otechie username 12 | lfx_crowdfunding: # Replace with a single LFX Crowdfunding project-name e.g., cloud-foundry 13 | custom: # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | edlog 3 | npl 4 | *.c~ 5 | *.h~ 6 | dp.pl 7 | network.pl 8 | 9 | 10 | -------------------------------------------------------------------------------- /README-ja.md: -------------------------------------------------------------------------------- 1 | # N-Prolog 2 | 3 | N-Prolog(NPL)はARITY/PROLOG(MS-DOS)上位互換のインタプリタ、コンパイラです。 4 | 5 | **N-PrologはISO-Prolog互換ではありません.** ARITY/PROLOG(MS-DOS)上位互換です。 6 | 7 | MANUAL.mdにユーザーズマニュアルがあります。ご参照ください。 8 | ライセンスは修正BSDに基づいています。無償でお使いいただけます。 9 | 10 | ![npl](npl.png) 11 | 12 | 13 | ## OS 14 | 下記のOSでの動作を確認しております。 15 | 16 | - Ubuntu 17 | - Linux MINT 18 | - RaspberryPI Raspbian 19 | - macOS 20 | - OpenBSD 21 | - FreeBSD 22 | 23 | 24 | Windowsでお使いの場合にはWSLをお使いください。 25 | 26 | 27 | ## インストール 28 | homeディレクトリにおいてGithubからクローンを作るか、あるいはzipファイルをダウンロードします。 29 | linuexの端末において"sudo make install"とタイプします。 30 | 31 | 参考 https://www.youtube.com/watch?v=36vUd8ThMF0 32 | 33 | ver4.08からcurlライブラリが必要となりました。 34 | 標準でインストールされていない場合には下記によりインストールしてください。 35 | 36 | ``` 37 | sudo apt update 38 | sudo apt install libcurl4-openssl-dev 39 | ``` 40 | 41 | macOSにおいてはncursesが必要となります。 42 | 43 | brew install ncurses 44 | export PATH=$PATH:/opt/homebrew/Cellar/ncurses/6.5/bin 45 | 46 | ## アンインストール 47 | Linuxの端末において"sudo make uninstall"とタイプします。 48 | 49 | 50 | # 起動 51 | N-Prologを起動するには下記のように端末からタイプします。 52 | 53 | ``` 54 | npl 55 | 56 | -c オプションはファイルを読み込んで起動します。 57 | 58 | 例 59 | npl -c init.pl 60 | 61 | -r オプションは編集可能REPLをOFFにして起動します。 62 | 指定しない場合にはREPLは編集可能となっています。 63 | ``` 64 | 65 | 他のオプション 66 | 67 | ``` 68 | $ npl -h 69 | List of options: 70 | -c filename -- NPL starts after reading the file. 71 | -h -- display help. 72 | -r -- NPL does not use editable REPL. 73 | -s filename -- NPL run file with script mode. 74 | -v -- dislplay version number. 75 | 76 | ``` 77 | 78 | 79 | ## 目標 80 | N-Prologは1980年代のDEC10-Prologを楽しむことを目標にしています。 81 | 82 | 83 | ## 実行例 84 | ```prolog 85 | N-Prolog Ver 4.20 86 | ?- length([1,2,3],X). 87 | X = 3 88 | yes 89 | 90 | 91 | ?- X is 2^1000. 92 | X = 107150860718626732094842504906000181056140481170553360744375038837035105112493612249319837881569585812 93 | 7594672917553146825187145285692314043598457757469857480393456777482423098542107460506237114187795418215304 94 | 6474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069376 95 | yes 96 | 97 | ?- append(X,Y,[1,2,3]). 98 | X = [] 99 | Y = [1,2,3]; 100 | X = [1] 101 | Y = [2,3]; 102 | X = [1,2] 103 | Y = [3]; 104 | X = [1,2,3] 105 | Y = []; 106 | no 107 | ?- 108 | ?- ['tests/queens.pl']. 109 | yes 110 | ?- test. 111 | .... 112 | [9,7,2,4,1,8,5,3,6] 113 | [9,7,3,8,2,5,1,6,4] 114 | [9,7,4,2,8,6,1,3,5] 115 | no 116 | ?- 117 | 118 | 119 | 120 | ?- halt. 121 | - good bye - 122 | 123 | ``` 124 | 125 | # 編集可能なREPL 126 | キーバインディングは下記の通りです。 127 | 128 | - → move right 129 | - ← move left 130 | - ↑ recall history older 131 | - ↓ recall history newer 132 | - return insert end of line 133 | - back-space backspace 134 | - Esc Tab completion 135 | 136 | # ユニコード 137 | unicodeが使用可能です。 138 | 139 | ``` 140 | 141 | 動物(人間). 142 | 人間(ジョー). 143 | 144 | 動物(X) :- 人間(X). 145 | 146 | ?- ['tests/animal.pl']. 147 | yes 148 | ?- 動物(ジョー). 149 | yes 150 | ?- 動物(X). 151 | X = 人間 . 152 | yes 153 | 154 | ``` 155 | 156 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # N-Prolog 2 | N-Prolog(NPL) is an interpreter and compiler to be superset of ARITY/PROLOG(MS-DOS) 3 | 4 | **N-Prolog is NOT ISO-Prolog.** Compatible with ARITY/PROLOG(MS-DOS) see document/NAMUAL.md 5 | 6 | license is modified BSD. 7 | Note: We later became aware that another system with the same name, N-Prolog, already existed. This project is unrelated. 8 | 9 | ![npl](npl.png) 10 | 11 | 12 | ## OS 13 | We have confirmed the operation on the following OS. 14 | 15 | - Ubuntu 16 | - Linux MINT 17 | - RaspberryPI Raspbian 18 | - OpenBSD 19 | - FreeBSD 20 | - MacOS 21 | 22 | Please use WSL when using it on Windows. 23 | 24 | ## Installation 25 | In home directory ,make clone or download zip file from github. 26 | On Linux type "make" on terminal. and type "sudo make install" on terminal. 27 | 28 | see https://www.youtube.com/watch?v=36vUd8ThMF0 29 | 30 | Starting from version 4.08, the CURL library is required. 31 | If it is not installed by default, please install it using the following commands: 32 | 33 | ``` 34 | sudo apt update 35 | sudo apt install libcurl4-openssl-dev 36 | ``` 37 | 38 | On MacOs be sure to install ncurses 39 | 40 | brew install ncurses 41 | export PATH=$PATH:/opt/homebrew/Cellar/ncurses/6.5/bin 42 | 43 | ## Uninstall 44 | On Linux type "sudo make uninstall" on terminal. 45 | 46 | 47 | # invoke 48 | To invoke npl, enter command from terminal 49 | 50 | ``` 51 | npl 52 | 53 | -c option is for start up file. 54 | 55 | e.g. 56 | npl -c init.pl 57 | 58 | -r option is for Not editable REPL mode. 59 | Default, REPL is editable. 60 | ``` 61 | 62 | other option 63 | 64 | ``` 65 | $ npl -h 66 | List of options: 67 | -c filename -- NPL starts after reading the file. 68 | -h -- display help. 69 | -r -- NPL does not use editable REPL. 70 | -s filename -- NPL run file with script mode. 71 | -v -- dislplay version number. 72 | 73 | ``` 74 | 75 | ## Goal 76 | N-Prolog aims to enjoy the experience of DEC10-Prolog from the 1980s. 77 | 78 | ## example 79 | ```prolog 80 | N-Prolog Ver 4.20 81 | ?- length([1,2,3],X). 82 | X = 3 83 | yes 84 | 85 | 86 | ?- X is 2^1000. 87 | X = 107150860718626732094842504906000181056140481170553360744375038837035105112493612249319837881569585812 88 | 7594672917553146825187145285692314043598457757469857480393456777482423098542107460506237114187795418215304 89 | 6474983581941267398767559165543946077062914571196477686542167660429831652624386837205668069376 90 | yes 91 | 92 | ?- append(X,Y,[1,2,3]). 93 | X = [] 94 | Y = [1,2,3]; 95 | X = [1] 96 | Y = [2,3]; 97 | X = [1,2] 98 | Y = [3]; 99 | X = [1,2,3] 100 | Y = []; 101 | no 102 | ?- 103 | ?- ['tests/queens.pl']. 104 | yes 105 | ?- test. 106 | .... 107 | [9,7,2,4,1,8,5,3,6] 108 | [9,7,3,8,2,5,1,6,4] 109 | [9,7,4,2,8,6,1,3,5] 110 | no 111 | ?- 112 | 113 | 114 | 115 | ?- halt. 116 | - good bye - 117 | 118 | ``` 119 | 120 | # Editable REPL 121 | key-bindings are as follows: 122 | 123 | - → move right 124 | - ← move left 125 | - ↑ recall history older 126 | - ↓ recall history newer 127 | - return insert end of line 128 | - back-space backspace 129 | - Esc Tab completion 130 | 131 | # unicode 132 | You can use unicode. 133 | 134 | ``` 135 | 136 | 動物(人間). 137 | 人間(ジョー). 138 | 139 | 動物(X) :- 人間(X). 140 | 141 | ?- ['tests/animal.pl']. 142 | yes 143 | ?- 動物(ジョー). 144 | yes 145 | ?- 動物(X). 146 | X = 人間 . 147 | yes 148 | 149 | ``` 150 | -------------------------------------------------------------------------------- /bench/Bench.md: -------------------------------------------------------------------------------- 1 | # Benchmark 2 | I record it as a reference value for improving the compiler. 3 | 4 | ## Hardware 5 | Intel Icore5 2.9GHz Memroy 8GB 6 | 7 | ## OS 8 | WSL on Windows10 Ubuntu 9 | 10 | ## derive 11 | ?- ['bench/derive.o']. 12 | yes 13 | ?- measure(test). 14 | Elapsed Time=0.029811 (second) 1744395(LIPS) 15 | no 16 | ?- 17 | 18 | # devide10 19 | ?- ['bench/devide10.o']. 20 | yes 21 | ?- measure(test). 22 | Elapsed Time=0.013030 (second) 1688558(LIPS) 23 | no 24 | ?- 25 | 26 | ## nreverse 27 | ?- ['bench/nreverse.o']. 28 | yes 29 | ?- measure(test). 30 | Elapsed Time=0.162602 (second) 3068856(LIPS) 31 | no 32 | ?- 33 | 34 | ## qsort 35 | no 36 | ?- ['bench/qsort.o']. 37 | yes 38 | ?- measure(test). 39 | Elapsed Time=0.199829 (second) 3022593(LIPS) 40 | no 41 | ?- 42 | 43 | ## queens 44 | ?- ['tests/queens.o']. 45 | yes 46 | ?- measure(test16). 47 | Elapsed Time=0.350892 (second) 6835936(LIPS) 48 | no -------------------------------------------------------------------------------- /bench/cpbench.pl: -------------------------------------------------------------------------------- 1 | 2 | main :- 3 | compile_file('bench/derive.pl'), 4 | compile_file('bench/devide10.pl'), 5 | compile_file('bench/log10.pl'), 6 | compile_file('bench/nreverse.pl'), 7 | compile_file('bench/ops8.pl'), 8 | compile_file('bench/qsort.pl'), 9 | compile_file('bench/serialize.pl'), 10 | compile_file('bench/times10.pl'). 11 | 12 | 13 | :- main. 14 | -------------------------------------------------------------------------------- /bench/derive.pl: -------------------------------------------------------------------------------- 1 | % generated: 25 October 1989 2 | % option(s): 3 | % 4 | % (deriv) ops8 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % symbolic derivative of (x+1)*((^(x,2)+2)*(^(x,3)+3)) 10 | 11 | test :- between(1,1000,X),top,fail. 12 | top:-ops8,log10,divide10. 13 | 14 | ops8 :- d((x+1)*((^(x,2)+2)*(^(x,3)+3)),x,_). 15 | log10 :- d(log(log(log(log(log(log(log(log(log(log(x)))))))))),x,_). 16 | divide10 :- d(((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x,x,_). 17 | 18 | d(U+V,X,DU+DV) :- !, 19 | d(U,X,DU), 20 | d(V,X,DV). 21 | d(U-V,X,DU-DV) :- !, 22 | d(U,X,DU), 23 | d(V,X,DV). 24 | d(U*V,X,DU*V+U*DV) :- !, 25 | d(U,X,DU), 26 | d(V,X,DV). 27 | d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, 28 | d(U,X,DU), 29 | d(V,X,DV). 30 | d(^(U,N),X,DU*N*(^(U,N1))) :- !, 31 | integer(N), 32 | N1 is N-1, 33 | d(U,X,DU). 34 | d(-U,X,-DU) :- !, 35 | d(U,X,DU). 36 | d(exp(U),X,exp(U)*DU) :- !, 37 | d(U,X,DU). 38 | d(log(U),X,DU/U) :- !, 39 | d(U,X,DU). 40 | d(X,X,1) :- !. 41 | d(_,_,0). 42 | -------------------------------------------------------------------------------- /bench/devide10.pl: -------------------------------------------------------------------------------- 1 | % generated: 7 March 1990 2 | % option(s): 3 | % 4 | % (deriv) divide10 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % symbolic derivative of ((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x 10 | 11 | test :- between(1,1000,X),top,fail. 12 | top:-divide10. 13 | 14 | 15 | divide10 :- d(((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x,x,_). 16 | 17 | d(U+V,X,DU+DV) :- !, 18 | d(U,X,DU), 19 | d(V,X,DV). 20 | d(U-V,X,DU-DV) :- !, 21 | d(U,X,DU), 22 | d(V,X,DV). 23 | d(U*V,X,DU*V+U*DV) :- !, 24 | d(U,X,DU), 25 | d(V,X,DV). 26 | d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, 27 | d(U,X,DU), 28 | d(V,X,DV). 29 | d(^(U,N),X,DU*N*(^(U,N1))) :- !, 30 | integer(N), 31 | N1 is N-1, 32 | d(U,X,DU). 33 | d(-U,X,-DU) :- !, 34 | d(U,X,DU). 35 | d(exp(U),X,exp(U)*DU) :- !, 36 | d(U,X,DU). 37 | d(log(U),X,DU/U) :- !, 38 | d(U,X,DU). 39 | d(X,X,1) :- !. 40 | d(_,_,0). 41 | -------------------------------------------------------------------------------- /bench/log10.pl: -------------------------------------------------------------------------------- 1 | % generated: 25 October 1989 2 | % option(s): 3 | % 4 | % (deriv) log10 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % symbolic derivative of log(log(log(log(log(log(log(log(log(log(x)))))))))) 10 | 11 | test :- between(1,1000,X),top,fail. 12 | top:-log10. 13 | 14 | log10 :- d(log(log(log(log(log(log(log(log(log(log(x)))))))))),x,_). 15 | 16 | d(U+V,X,DU+DV) :- !, 17 | d(U,X,DU), 18 | d(V,X,DV). 19 | d(U-V,X,DU-DV) :- !, 20 | d(U,X,DU), 21 | d(V,X,DV). 22 | d(U*V,X,DU*V+U*DV) :- !, 23 | d(U,X,DU), 24 | d(V,X,DV). 25 | d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, 26 | d(U,X,DU), 27 | d(V,X,DV). 28 | d(^(U,N),X,DU*N*(^(U,N1))) :- !, 29 | integer(N), 30 | N1 is N-1, 31 | d(U,X,DU). 32 | d(-U,X,-DU) :- !, 33 | d(U,X,DU). 34 | d(exp(U),X,exp(U)*DU) :- !, 35 | d(U,X,DU). 36 | d(log(U),X,DU/U) :- !, 37 | d(U,X,DU). 38 | d(X,X,1) :- !. 39 | d(_,_,0). 40 | -------------------------------------------------------------------------------- /bench/nreverse.pl: -------------------------------------------------------------------------------- 1 | % generated: 25 October 1989 2 | % option(s): 3 | % 4 | % nreverse 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % "naive"-reverse a list of 30 integers 10 | 11 | test :- between(1,1000,X),top,fail. 12 | top:-nreverse. 13 | 14 | nreverse :- nreverse([1,2,3,4,5,6,7,8,9,10,11,12, 15 | 13,14,15,16,17,18,19,20,21, 16 | 22,23,24,25,26,27,28,29,30],_). 17 | 18 | nreverse([X|L0],L) :- nreverse(L0,L1), concatenate(L1,[X],L). 19 | nreverse([],[]). 20 | 21 | concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3). 22 | concatenate([],L,L). 23 | -------------------------------------------------------------------------------- /bench/ops8.pl: -------------------------------------------------------------------------------- 1 | % generated: 25 October 1989 2 | % option(s): 3 | % 4 | % (deriv) ops8 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % symbolic derivative of (x+1)*((^(x,2)+2)*(^(x,3)+3)) 10 | 11 | test :- between(1,1000,X),top,fail. 12 | top:-ops8. 13 | 14 | ops8 :- d((x+1)*((^(x,2)+2)*(^(x,3)+3)),x,_). 15 | 16 | d(U+V,X,DU+DV) :- !, 17 | d(U,X,DU), 18 | d(V,X,DV). 19 | d(U-V,X,DU-DV) :- !, 20 | d(U,X,DU), 21 | d(V,X,DV). 22 | d(U*V,X,DU*V+U*DV) :- !, 23 | d(U,X,DU), 24 | d(V,X,DV). 25 | d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, 26 | d(U,X,DU), 27 | d(V,X,DV). 28 | d(^(U,N),X,DU*N*(^(U,N1))) :- !, 29 | integer(N), 30 | N1 is N-1, 31 | d(U,X,DU). 32 | d(-U,X,-DU) :- !, 33 | d(U,X,DU). 34 | d(exp(U),X,exp(U)*DU) :- !, 35 | d(U,X,DU). 36 | d(log(U),X,DU/U) :- !, 37 | d(U,X,DU). 38 | d(X,X,1) :- !. 39 | d(_,_,0). 40 | -------------------------------------------------------------------------------- /bench/qsort.pl: -------------------------------------------------------------------------------- 1 | % generated: 16 November 1989 2 | % option(s): SOURCE_TRANSFORM_1 3 | % 4 | % qsort 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % quicksort a list of 50 integers 10 | 11 | test :- between(1,1000,X),top,fail. 12 | top:-qsort. 13 | 14 | qsort :- qsort([27,74,17,33,94,18,46,83,65, 2, 15 | 32,53,28,85,99,47,28,82, 6,11, 16 | 55,29,39,81,90,37,10, 0,66,51, 17 | 7,21,85,27,31,63,75, 4,95,99, 18 | 11,28,61,74,18,92,40,53,59, 8],_,[]). 19 | 20 | qsort([X|L],R,R0) :- 21 | partition(L,X,L1,L2), 22 | qsort(L2,R1,R0), 23 | qsort(L1,R,[X|R1]). 24 | qsort([],R,R). 25 | 26 | partition([X|L],Y,[X|L1],L2) :- 27 | X =< Y, !, 28 | partition(L,Y,L1,L2). 29 | partition([X|L],Y,L1,[X|L2]) :- 30 | partition(L,Y,L1,L2). 31 | partition([],_,[],[]). 32 | -------------------------------------------------------------------------------- /bench/runbench.pl: -------------------------------------------------------------------------------- 1 | :- consult('bench/derive.o'). 2 | :- write('derive'),nl,measure(test). 3 | :- consult('bench/devide10.o'). 4 | :- write('devide10'),nl,measure(test). 5 | :- consult('bench/log10.o'). 6 | :- write('log10'),nl,measure(test). 7 | :- consult('bench/nreverse.o'). 8 | :- write('nreverse'),nl,measure(test). 9 | :- consult('bench/ops8.o'). 10 | :- write('ops8'),nl,measure(test). 11 | :- consult('bench/qsort.o'). 12 | :- write('qsort'),nl,measure(test). 13 | :- consult('bench/serialize.o'). 14 | :- write('serialize'),nl,measure(test). 15 | :- consult('bench/times10.o'). 16 | :- write('times10'),nl,measure(test). 17 | -------------------------------------------------------------------------------- /bench/serialize.pl: -------------------------------------------------------------------------------- 1 | % generated: 17 November 1989 2 | % option(s): 3 | % 4 | % serialise 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % itemize (pick a "serial number" for each 10 | % unique integer in) a list of 25 integers 11 | 12 | test :- between(1,1000,X),top,fail. 13 | top:-serialise. 14 | 15 | serialise :- serialise("ABLE WAS I ERE I SAW ELBA",_). 16 | 17 | serialise(L,R) :- 18 | pairlists(L,R,A), 19 | arrange(A,T), 20 | numbered(T,1,_). 21 | 22 | pairlists([X|L],[Y|R],[pair(X,Y)|A]) :- pairlists(L,R,A). 23 | pairlists([],[],[]). 24 | 25 | arrange([X|L],tree(T1,X,T2)) :- 26 | split(L,X,L1,L2), 27 | arrange(L1,T1), 28 | arrange(L2,T2). 29 | arrange([],void). 30 | 31 | split([X|L],X,L1,L2) :- !, split(L,X,L1,L2). 32 | split([X|L],Y,[X|L1],L2) :- before(X,Y), !, split(L,Y,L1,L2). 33 | split([X|L],Y,L1,[X|L2]) :- before(Y,X), !, split(L,Y,L1,L2). 34 | split([],_,[],[]). 35 | 36 | before(pair(X1,_),pair(X2,_)) :- X1 < X2. 37 | 38 | numbered(tree(T1,pair(_,N1),T2),N0,N) :- 39 | numbered(T1,N0,N1), 40 | N2 is N1+1, 41 | numbered(T2,N2,N). 42 | numbered(void,N,N). 43 | -------------------------------------------------------------------------------- /bench/times10.pl: -------------------------------------------------------------------------------- 1 | % generated: 7 March 1990 2 | % option(s): 3 | % 4 | % (deriv) times10 5 | % 6 | % David H. D. Warren 7 | % Copyright: Public domain 8 | % 9 | % symbolic derivative of ((((((((x*x)*x)*x)*x)*x)*x)*x)*x)*x 10 | 11 | test :- between(1,1000,X),top,fail. 12 | top:-times10. 13 | 14 | times10 :- d(((((((((x*x)*x)*x)*x)*x)*x)*x)*x)*x,x,_). 15 | 16 | d(U+V,X,DU+DV) :- !, 17 | d(U,X,DU), 18 | d(V,X,DV). 19 | d(U-V,X,DU-DV) :- !, 20 | d(U,X,DU), 21 | d(V,X,DV). 22 | d(U*V,X,DU*V+U*DV) :- !, 23 | d(U,X,DU), 24 | d(V,X,DV). 25 | d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, 26 | d(U,X,DU), 27 | d(V,X,DV). 28 | d(^(U,N),X,DU*N*(^(U,N1))) :- !, 29 | integer(N), 30 | N1 is N-1, 31 | d(U,X,DU). 32 | d(-U,X,-DU) :- !, 33 | d(U,X,DU). 34 | d(exp(U),X,exp(U)*DU) :- !, 35 | d(U,X,DU). 36 | d(log(U),X,DU/U) :- !, 37 | d(U,X,DU). 38 | d(X,X,1) :- !. 39 | d(_,_,0). 40 | -------------------------------------------------------------------------------- /compat/cdefs.h: -------------------------------------------------------------------------------- 1 | /* Wrapper around BSD sys/cdefs.h annotations */ 2 | 3 | #ifndef COMPAT_CDEFS_H 4 | #define COMPAT_CDEFS_H 5 | 6 | #ifndef __dead 7 | #define __dead \ 8 | __attribute__((__noreturn__)) 9 | #endif 10 | 11 | #ifndef __unused 12 | #define __unused \ 13 | __attribute__((__unused__)) 14 | #endif 15 | 16 | #ifndef __packed 17 | #define __packed \ 18 | __attribute__((__packed__)) 19 | #endif 20 | 21 | #endif 22 | -------------------------------------------------------------------------------- /compat/curses_stubs.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPAT_CURSES_STUBS_H 2 | #define COMPAT_CURSES_STUBS_H 3 | 4 | #define _XOPEN_SOURCE 700 5 | #define _XOPEN_SOURCE_EXTENDED 6 | #ifdef WITHOUT_CURSES 7 | #else 8 | # ifdef __linux__ 9 | # include 10 | # else 11 | # include 12 | # endif 13 | #endif 14 | #undef _XOPEN_SOURCE 15 | #undef _XOPEN_SOURCE_EXTENDED 16 | 17 | #endif 18 | -------------------------------------------------------------------------------- /compat/eiffel_stubs.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPAT_EIFFEL_STUBS_H 2 | #define COMPAT_EIFFEL_STUBS_H 3 | 4 | #ifdef WITH_NANA 5 | #include "eiffel.h" 6 | #else 7 | #define REQUIRE(x) 8 | #define ENSURE(x) 9 | #endif 10 | 11 | #endif 12 | -------------------------------------------------------------------------------- /compat/nana_stubs.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPAT_NANA_STUBS_H 2 | #define COMPAT_NANA_STUBS_H 3 | 4 | #ifdef WITH_NANA 5 | #include "nana.h" 6 | #else 7 | #define IP(x, y) 8 | #define VL(x) 9 | #endif 10 | 11 | #endif 12 | -------------------------------------------------------------------------------- /compat/term_stubs.h: -------------------------------------------------------------------------------- 1 | #ifndef COMPAT_TERM_STUBS_H 2 | #define COMPAT_TERM_STUBS_H 3 | 4 | #ifdef WITHOUT_CURSES 5 | #define COLOR_RED 0 6 | #define COLOR_CYAN 0 7 | #define COLOR_MAGENTA 0 8 | #define COLOR_YELLOW 0 9 | #define COLOR_BLUE 0 10 | #define ERR 0 11 | #define tputs(x, y, z) 12 | #define putp(x) 13 | #define setupterm(x, y, z) (ERR) 14 | static const char *key_up = NULL; 15 | static const char *key_down = NULL; 16 | static const char *key_right = NULL; 17 | static const char *key_left = NULL; 18 | #else 19 | #include 20 | #endif 21 | 22 | #endif 23 | -------------------------------------------------------------------------------- /document/ATFIRST.md: -------------------------------------------------------------------------------- 1 | # AtFirst 2 | This document provides an overview of many documents. Please read it first. 3 | 4 | # Dosuments 5 | ![UserManual](MANUAL.md) 6 | This is the user manual for N-Prolog. 7 | 8 | ![Chacker](CHECKER.md) 9 | This is a description of the Prolog code checker library using static analysis. 10 | 11 | ![CLPFD](CLPFD.md) 12 | This is a description of the CLP(FD) library. 13 | 14 | ![Compiler](COMPILER.md) 15 | This is a description of the N-Prolog compiler. 16 | 17 | ![Curl](CURL.md) 18 | This is a description of the HTTPS functionality with encryption using curl. 19 | 20 | ![DCG](DCG.md) 21 | This is a description of the DCG library. 22 | 23 | ![Edlog](EDLOG.md) 24 | This is a description of Edlog, a CUI editor dedicated to N-Prolog. 25 | 26 | ![History](HISTORY.md) 27 | This is the development history of N-Prolog. 28 | 29 | ![JSON](JSON.md) 30 | This is a description of the JSON library. 31 | 32 | ![List](LIST.md) 33 | This is a description of the List library. 34 | 35 | ![Module](MODULE.md) 36 | This is a description of the module functionality in N-Prolog. 37 | 38 | ![MultipleWorld](MPW.md) 39 | This is a description of Professor Hideyuki Nakashima's multiple world mechanism. 40 | 41 | ![OpenGL](OPENGL.md) 42 | This is a library for interfacing with OpenGL. 43 | 44 | ![Parallel1](PARA1.md) 45 | This is a description of the distributed parallel features in N-Prolog. 46 | 47 | ![Parallel2](PARA2.md) 48 | This is a description of the multi-thread parallel features in N-Prolog. 49 | 50 | ![Plot](PLOT.md) 51 | This is a library for interfacing with Gnuplot. 52 | 53 | ![Python](PYTHON.md) 54 | This is a library for using TensorFlow via Python. 55 | 56 | ![Sets](SETS.md) 57 | This is a description of the Sets library. 58 | 59 | ![SuperSet](SUPERSET.md) 60 | This is a description of ISO-style predicates and other modern extended predicates. 61 | 62 | ![TCL/TK](TCLTK.md) 63 | This is a library for interfacing with Tcl/Tk. 64 | 65 | ![TCP/IP](TCPIP.md) 66 | This is a description of extended predicates for TCP/IP communication. 67 | 68 | ![Unicode](UNICODE.md) 69 | This is a description of how Unicode is handled in N-Prolog. 70 | 71 | ![WiringPI](WIRINGPI.md) 72 | On Raspberry Pi, predicates for WiringPi are installed. This is their description. 73 | -------------------------------------------------------------------------------- /document/CHECKER.md: -------------------------------------------------------------------------------- 1 | # Checker 2 | The checker is a library that performs static analysis of Prolog code to detect ARITY errors ,singleton variable issues and single clause issues. 3 | 4 | # Usage 5 | 6 | ``` 7 | use_module(checker). 8 | 9 | check_file(file_name). -> check arity and singleton 10 | check_file(file_name,full) -> check arity, singleton and single clause 11 | ``` 12 | 13 | # Example 14 | 15 | ``` 16 | foo(X,Y) :- write(1,2,X). 17 | ?- check_file('./tests/bug.pl'). 18 | detect arity write(1,2,varX) in foo(varX,varY) 19 | detect singleton varY in foo(varX,varY) 20 | no 21 | ?- 22 | 23 | fact(0,1). 24 | facT(N,X) :- 25 | N1 is N-1, 26 | fact(N1,X1), 27 | X is N*X1. 28 | ?- check_file('./tests/fact.pl',full). 29 | detect single clause facT(varN,varX):-varN1 is varN-1,(fact(varN1,varX1),varX is varN*varX1) 30 | yes 31 | 32 | ``` 33 | 34 | # Why Checker 35 | With short code like the example above, mistakes are easily detectable. However, when dealing with thousands of lines of Prolog code, it's easy to miss certain errors. In an interpreter, bugs that don’t cause runtime errors might go unnoticed. Many of these bugs stem from typographical mistakes, such as singleton variable issues. Sometimes, a mistake is made in the number of arguments in just one clause, and it's hard to notice. By detecting these errors, the goal is to prevent mistakes in large-scale code. 36 | 37 | I have also included a feature to detect spelling mistakes in the head of clauses. This simply extracts clauses that occur only once. While some of these may be legitimate, there is also the possibility of spelling mistakes. It detects them as potential issues. In large codebases, these mistakes can be surprisingly difficult to find. -------------------------------------------------------------------------------- /document/COMPILER.md: -------------------------------------------------------------------------------- 1 | # Compiler 2 | 3 | # Usage 4 | To use the compiler in N-Prolog, you need to load the module. Compilation is performed using compile_file/1. 5 | 6 | ``` 7 | N-Prolog Ver 3.91 8 | ?- use_module(compiler). 9 | yes 10 | ?- compile_file('./tests/fact.pl'). 11 | phase pass1 12 | phase pass2 13 | compiling fact 14 | invoke GCC 15 | yes 16 | ?- 17 | 18 | ``` 19 | 20 | # Option 21 | 22 | - compile_file(F,c) 23 | If you provide c as the second argument, the converted C code will be retained. You can check what kind of code is being generated. 24 | 25 | - compile_file(F,o) 26 | If you provide o as the second argument, it simply compiles the C source code and generates the object code. This is useful when you need to manually modify the compiled code. 27 | 28 | - compile_file(F,co) 29 | If you provide co as the second argument, it compiles prolog code and generate c source and object code. 30 | 31 | 32 | # C inline 33 | N-Prolog allows embedding C code in the body section. When a string is passed to cinline/1, it is directly embedded into the compiled code as is. 34 | 35 | e.g. 36 | 37 | ``` 38 | ack(M,N,X) :- 39 | cinline($ int a(int m, int n){ 40 | if(m==0) return(n+1); 41 | else if(n==0) return(a(m-1,1)); 42 | else return(a(m-1,a(m,n-1))); 43 | } 44 | int m = Jget_int(Jderef(varM,th)); 45 | int n = Jget_int(Jderef(varN,th)); 46 | int res = a(m,n); 47 | Junify(varX,Jmakeint(res),th); 48 | return(Jexec_all(rest,Jget_sp(th),th)); $). 49 | 50 | ``` 51 | cinline/1 only functions when there is a single instance in the body. Multiple instances of cinline/1 will not work correctly. 52 | 53 | 54 | ## C inline declare 55 | To embed C code such as #include and #define, use cdeclate/1. 56 | e.g. 57 | 58 | ``` 59 | cdeclare($#define a 1$). 60 | cdeclare($#define b 2$). 61 | cdeclare($#include $). 62 | ``` 63 | 64 | ## C inline library option 65 | To add compilation options, use clibrary/1. 66 | e.g. 67 | 68 | ``` 69 | clibrary($-ltcl -ltk$). 70 | ``` 71 | 72 | ## C inline variable 73 | In compiled Prolog, variable names have 'var' prefixed to them at compile time. When retrieving a value, deref is called first, and then the value is converted to a C value using an API corresponding to its type. 74 | 75 | ## C inline API 76 | The publicly available APIs that can be used for embedding in this context are as follows. 77 | 78 | - static inline int Jcheckgbc(void) 79 | - static inline int Jgbc(void) 80 | - static inline int Jfreshcell(void) 81 | - static inline int Jdebug(void) 82 | - static inline int Jcar(x) 83 | - static inline int Jcdr(int x) 84 | - static inline int Jcadr(int x) 85 | - static inline int Jcaddr(int x) 86 | - static inline int Jcaar(int x) 87 | - static inline int Jcadar(int x) 88 | - static inline int Jprint(int x) 89 | - static inline int Jmakeint(int x) 90 | - static inline int Jlength(int x) 91 | - static inline int Jget_int(int x) 92 | - static inline int Jlist1(int x) 93 | - static inline int Jrandom(int th) 94 | - static inline int Jrandi(int x) 95 | - static inline int Jlistp(int x) 96 | - static inline int Jstructurep(int x) 97 | - static inline int Jvariablep(int x) 98 | - static inline int Jget_sp(int x) 99 | - static inline int Jget_wp(int x) 100 | - static inline int Jget_ac(int x) 101 | - static inline int Jinc_proof(int x) 102 | - static inline int Jmakevariant(int x) 103 | - static inline int Jadd_dynamic(int x) 104 | - static inline int Jbigx_to_parmanent(int x) 105 | - static inline int Jcons(int x, int y) 106 | - static inline int Jeqp(int x, int y) 107 | - static inline int Jequalp(int x, int y) 108 | - static inline int Jnumeqp(int x, int y) 109 | - static inline int Jsmallerp(int x, int y) 110 | - static inline int Jeqsmallerp(int x, int y) 111 | - static inline int Jgreaterp(int x, int y) 112 | - static inline int Jeqgreaterp(int x, int y) 113 | - static inline int Jlistcons(int x, int y) 114 | - static inline int Jlist2(int x, int y) 115 | - static inline int Jset_car(int x, int y) 116 | - static inline int Jset_cdr(int x, int y) 117 | - static inline int Jset_aux(int x, int y) 118 | - static inline int Jnot_numeqp(int x, int y) 119 | - static inline int Jset_var(int x, int y) 120 | - static inline int Jnth(int x, int y) 121 | - static inline int Junbind(int x, int th) 122 | - static inline int Jset_wp(int x, int th) 123 | - static inline int Jset_ac(int x, int th) 124 | - static inline int Jderef(int x, int th) 125 | - static inline int Jwlist1(int x, int th) 126 | - static inline int Jsin(int x, int th) 127 | - static inline int Jasin(int x, int th) 128 | - static inline int Jcos(int x, int th) 129 | - static inline int Jacos(int x, int th) 130 | - static inline int Jtan(int x, int th) 131 | - static inline int Jatan(int x, int th) 132 | - static inline int Jexp(int x, int th) 133 | - static inline int Jlog(int x, int th) 134 | - static inline int Jln(int x, int th) 135 | - static inline int Junify_nil(int x, int th) 136 | - static inline int Jlist3(int x, int y, int z) 137 | - static inline int Jerrorcomp(int x, int y, int z) 138 | - static inline int Jwlistcons(int x, int y, int th) 139 | - static inline int Junify(int x, int y, int th) 140 | - static inline int Junify_pair(int x, int y, int th) 141 | - static inline int Junify_var(int x, int y, int th) 142 | - static inline int Junify_int(int x, int y, int th) 143 | - static inline int Junify_long(int x, int y, int th) 144 | - static inline int Junify_big(int x, int y, int th) 145 | - static inline int Junify_str(int x, int y, int th) 146 | - static inline int Junify_atom(int x, int y, int th) 147 | - static inline int Jexec_all(int x, int y, int th) 148 | - static inline int Jwcons(int x, int y, int th) 149 | - static inline int Jwlist2(int x, int y, int th) 150 | - static inline int Jaddtail_body(int x, int y, int th) 151 | - static inline int Jplus(int x, int y, int th) 152 | - static inline int Jminus(int x, int y, int th) 153 | - static inline int Jmult(int x, int y, int th) 154 | - static inline int Jdivide(int x, int y, int th) 155 | - static inline int Jremainder(int x, int y, int th) 156 | - static inline int Jquotient(int x, int y, int th) 157 | - static inline int Jmod(int x, int y, int th) 158 | - static inline int Jexpt(int x, int y, int th) 159 | - static inline int Jsqrt(int x, int y, int th) 160 | - static inline int Jleftshift(int x, int y, int th) 161 | - static inline int Jrightshift(int x, int y, int th) 162 | - static inline int Jlogicaland(int x, int y, int th) 163 | - static inline int Jlogicalor(int x, int y, int th) 164 | - static inline int Jcomplement(int x, int y, int th) 165 | - static inline int Jround(int x, int y, int th) 166 | - static inline int Jdiv(int x, int y, int th) 167 | - static inline int Jcall(int pred, int arglist, int th) 168 | call predicate without continuation. 169 | - static inline int Jmakeconst(char* x) 170 | - static inline int Jmakepred(char* x) 171 | - static inline int Jmakevar(char* x) 172 | - static inline int Jmakestrflt(char* x) 173 | - static inline int Jmakecomp(char* x) 174 | - static inline int Jmakesys(char* x) 175 | - static inline int Jmakeope(char* x) 176 | - static inline int Jmakeuser(char* x) 177 | - static inline int Jmakestrlong(char* x) 178 | - static inline int Jmakebig(char* x) 179 | - static inline int Jmakestr(char* x) 180 | - static inline int Jmakefun(char* x) 181 | - static inline int Jcallsubr(int x, int y, int z, int th) 182 | - static inline int Jwlist3(int x, int y, int z, int th) 183 | - static inline char* Jgetname(int x) 184 | - static inline double Jget_flt(int x) 185 | 186 | # Internal of compiler 187 | Since version 3.92, I have been rewriting the compiler. The previous compiler could optimize only a very limited subset of tail-recursive predicates. I am generalizing this optimization to cover a broader range of cases and improve execution efficiency. 188 | 189 | Specifically, the compiler classifies predicates into the following three categories through static analysis: predicates eligible for tail-recursion optimization, deterministic predicates, and all other predicates. 190 | 191 | The predicate analyze/1 in the compiler is responsible for this classification. The analysis results are stored in pred_data/3 in the form pred_data(PredName, Arity, TailOrDetOrHalt). The code generation predicates refer to this data to generate the corresponding C code. 192 | -------------------------------------------------------------------------------- /document/CURL.md: -------------------------------------------------------------------------------- 1 | # CURL HTTPS 2 | 3 | 4 | # Specification 5 | - create_client_curl(Curl, URL)  6 | Creates a Curl for the specified URL. If successful, unify it in Curl. 7 | 8 | - send_curl(Curl, Post) 9 | Sends the body (as a string) using POST/PUT. 10 | 11 | - recv_curl(Curl, Response)  12 | Receives the response. Stores it as a string in Response. 13 | 14 | - close_curl(Curl)  15 | Releases the CURL*. Frees internal state and memory. 16 | 17 | - set_curl_option(Curl, Option)  18 | Option can be structures like header("..."), method(post), timeout(5), etc. 19 | 20 | - add_curl_header(Curl, Header)  21 | Adds multiple headers if needed. For example, "Authorization: Bearer ...". 22 | 23 | -------------------------------------------------------------------------------- /document/DCG.md: -------------------------------------------------------------------------------- 1 | # DCG 2 | To use DCG call module. 3 | use_module(dcg). 4 | 5 | The following is an example from Professor Hideyuki Nakashima's "Prolog". 6 | 7 | A dog bites a postman. 8 | 9 | This English sentence has a structure. Its structure follows certain grammatical rules. 10 | 11 | 12 | ``` 13 | Sentence-> noun phrase, verb phrase 14 | Noun phrases-> articles, nouns 15 | Article-> a 16 | Noun-> dog 17 | Noun-> postman 18 | Verb phrase-> verb, noun phrase 19 | Verb-> bits 20 | ``` 21 | It's possible to write this directly in Prolog, but there's an easier way. 22 | That is DCG. It is possible to write the above rules almost as they are. 23 | 24 | Write the following code to a file and load it with consult in the same way as the Prolog code. 25 | 26 | 27 | ``` 28 | s --> np,vp. 29 | np --> det,n. 30 | det -->[a]. 31 | n -->[dog]. 32 | n -->[postman]. 33 | vp --> v,np. 34 | v -->[bites]. 35 | ``` 36 | 37 | The grammar category is abbreviated. 38 | 39 | ``` 40 | sentence　s 41 | noun　n 42 | noun　phrase　np 43 | verb　v 44 | determiner　det 45 | verb　phrase 46 | ``` 47 | 48 | Let's run this on the N-Prolog processing system. 49 | You can check if the sentence is correct with the predicate phrase. 50 | 51 | 52 | ``` 53 | | ?- phrase(s,[a,dog,bites,a,postman]). 54 | yes 55 | | 56 | ``` 57 | 58 | In this way, it was confirmed that the sentence given in the list has the given sentence structure. What if you give the wrong sentence? 59 | 60 | 61 | ``` 62 | | ?- phrase(s,[bites,a,dog,a,postman]). 63 | no 64 | | 65 | ``` 66 | 67 | False is returned. It violates the grammar rules. 68 | 69 | Interestingly, you can also generate sentences that meet grammatical rules. 70 | 71 | ``` 72 | | ?- phrase(s,X). 73 | X = [a,dog,bites,a,dog]; 74 | X = [a,dog,bites,a,postman]; 75 | X = [a,postman,bites,a,dog]; 76 | X = [a,postman,bites,a,postman]; 77 | no 78 | | 79 | ``` 80 | 81 | When I typed a semicolon and backtracked, some sentences came out. 82 | The meaning is strange, but it follows the grammatical rules. 83 | 84 | -------------------------------------------------------------------------------- /document/EDLOG.md: -------------------------------------------------------------------------------- 1 | # Edlog 2 | Edlog is a simple editor for N-Prolog. Edlog is subset Edwin. 3 | 4 | ![Edlog](screen1.png) 5 | 6 | ## Invocation 7 | `edit(filename)` in the N-Prolog REPL. 8 | 9 | `edlog` or `edlog filename` on terminal. 10 | 11 | ## Commands 12 | 13 | | Key | Command | 14 | | ------------- | ------------------------| 15 | | CTRL+X CTRL+S | Save file | 16 | | CTRL+X CTRL+C | Quit editor with save | 17 | | CTRL+X CTRL+I | Insert file | 18 | | CTRL+X CTRL+Z | Quit editor without save| 19 | | CTRL+X CTRL+W | Save buffer to file | 20 | | CTRL+X CTRL+L | Save region to file | 21 | 22 | ## Editing 23 | The key bindings are Emacs like. 24 | 25 | | Key | Binding | 26 | | --------- | ------------------------------- | 27 | | Enter | Automatically indent | 28 | | Insert | Switch between insert/overwrite | 29 | | Tab | Insert tab | 30 | | BackSpace | Delete previous char | 31 | | Delete | Delete next char | 32 | | CTRL+F | Move right | 33 | | CTRL+B | Move left | 34 | | CTRL+P | Move up | 35 | | CTRL+N | Move down | 36 | | CTRL+J | End of line | 37 | | CTRL+D | Delete | 38 | | CTRL+H | Backspace | 39 | | CTRL+A | Beginning of line | 40 | | CTRL+E | End of line | 41 | | CTRL+V | Page down | 42 | | ESC V | Page up | 43 | | CTRL+K | Cut selection | 44 | | CTRL+U | Uncut selection | 45 | | CTRL+L | Go to line | 46 | | CTRL+S | Search for word foward | 47 | | CTRL+R | Search for word backward | 48 | | CTRL+T | Replace word | 49 | | ESC TAB | Complete builtin function or syntax | 50 | | ESC < | Goto top page | 51 | | ESC > | Goto end page | 52 | | ESC f | Move right in word units | 53 | | ESC b | Move left in word units | 54 | | ESC CTRL+F| Move right in S-exp units | 55 | | ESC CTRL+B| Move left in S-exp units | 56 | | ESC CTRL+N| Move right in list units | 57 | | ESC CTRL+P| Move left in list units | 58 | | ESC CTRL+U| Move up in list structure | 59 | | ESC CTRL+D| Move down in list structure | 60 | | ESC ^ | Mark (or unmark) row for selection. "ESC ^" marks the current row, then cursor up or down selects rows. "ESC ^" again unmarks.| 61 | | ←　→　↑　↓　| Usual cursor movement | 62 | | Home | Display top page | 63 | | End | Display end page | 64 | | PageUp | Page up | 65 | | PageDown | Page down | 66 | 67 | 68 | ## Note 69 | Edlog supports Unicode. 70 | ![Edlog](screen2.png) 71 | 72 | # Tmux 73 | Using tmux is very convenient. Pressing CTRL+B followed by % will split the screen into two panes. You can start Edlog on the left side and N-Prolog on the right side. When you want to finish, detach by pressing CTRL+B followed by D in the terminal. To reattach, use tmux attach. The previous state will be restored. 74 | 75 | 76 | To easily move between the two split screens, add the following setting to the ~/.tmux.conf file: 77 | `set -g mouse on` 78 | 79 | # Spec 80 | 81 | - main buffer row-size 5000, col-size 256 (defined in edlis.h) 82 | - sub buffer row-size 1000, col-size 256 (defined in edlis.h) 83 | 84 | # Hint to modify 85 | The structure of the buffer is extremely simple. Each line consists of 256 characters and is initially initialized to 0. The line ends with an EOL character. The remaining part is left unused. Although there is a lot of waste, the simple structure makes it easy to understand. 86 | 87 | The color specification for syntax highlighting is described around line 60 in edlis.c. The curses library allows for 16 color settings. By modifying this part, you can change it to your desired colors. 88 | 89 | ``` 90 | const enum Color ed_syntax_color = RED_ON_DFL; 91 | const enum Color ed_builtin_color = CYAN_ON_DFL; 92 | const enum Color ed_extended_color = MAGENTA_ON_DFL; 93 | const enum Color ed_string_color = YELLOW_ON_DFL; 94 | const enum Color ed_comment_color = BLUE_ON_DFL; 95 | 96 | ``` 97 | 98 | Parentheses highlighting is handled by emphasis_lparen() & emphasis_rparen(). If you change the color settings here, you can modify the color used for bracket highlighting. 99 | 100 | ``` 101 | CHECK(addch, ')'); 102 | ESCBORG(); 103 | if (pos.row >= ed_start) { 104 | ESCMOVE(pos.row + TOP_MARGIN - ed_start, 105 | pos.col + LEFT_MARGIN); 106 | ESCBCYAN(); <----- -------------- color 107 | CHECK(addch, '('); 108 | ``` 109 | 110 | When the Enter key is pressed, tabs are automatically calculated, and spaces are inserted. The tab settings are handled by calc_tab(). By changing the constants here, you can adjust them to your preference. 111 | 112 | ``` 113 | 114 | int calc_tabs() 115 | { 116 | int col; 117 | 118 | if (ed_row == 0) 119 | return (0); 120 | 121 | col = 0; 122 | while (ed_data[ed_row - 1][col] == ' ') { 123 | col++; 124 | } 125 | return (col); 126 | 127 | } 128 | 129 | 130 | ``` -------------------------------------------------------------------------------- /document/HISTORY.md: -------------------------------------------------------------------------------- 1 | # The History of N-Prolog 2 | 3 | ## RUN/PROLOG 4 | In the 1980s, Prolog gained attention in Japan due to the Fifth Generation Computer Systems project. 5 | At that time, the Prolog system running on the DEC-10 at the University of Edinburgh was not accessible to the general public. 6 | Around the same period, a low-cost Prolog interpreter was sold by Lifeboat Associates for approximately $200. Considering that other systems at the time were priced above $1,000, this was relatively inexpensive. 7 | Lifeboat sold the interpreter portion of ARITY/PROLOG, a product of ARITY Corporation, in Japan under the name **RUN/PROLOG**. 8 | It is believed to have been the most widely used Prolog system during that time, especially on the PC-9801, the standard personal computer in Japan at the time. 9 | 10 | ## Books 11 | During that period, the most commonly used Prolog systems for personal computers were **RUN/PROLOG** and the Japanese-made **Prolog-KABA**. Prolog-KABA was slightly more expensive, priced at around $700. 12 | Many books on Prolog were also published. 13 | 14 | ![Image](book1.png) 15 | ![Image](book2.png) 16 | 17 | 18 | While there were many introductory books, some advanced books also existed, such as **"The World of Mathematics Created with Prolog"** by Professor Shigeru Iitaka. 19 | 20 | ## N-Prolog 21 | The developer of **N-Prolog** had an affinity for **RUN/PROLOG**. In the 1980s, ISO-Prolog had not yet been established. 22 | Based on the RUN/PROLOG user manual from that era, N-Prolog was designed to be as compatible as possible with RUN/PROLOG. 23 | The system was developed primarily for personal enjoyment, rather than practical use, with a focus on experimenting with code from books published in the 1980s. 24 | 25 | -------------------------------------------------------------------------------- /document/JSON.md: -------------------------------------------------------------------------------- 1 | # JSON 2 | JSON library for using API of ChatGPT. 3 | 4 | # usage 5 | 6 | ``` 7 | use_module(json). 8 | 9 | ?- term_json(foo(1),J). 10 | J = {"predicate":"foo","argument":[1]} . 11 | yes 12 | ?- 13 | ``` 14 | 15 | 16 | # Spec 17 | 18 | term_json(Term,Json). 19 | 20 | if Term is variable, get Prolog term converted from JSON. 21 | if Json is variable, get Json code converter from Prolog term. 22 | 23 | ``` 24 | test(predicate) :- 25 | term_json(foo(1),J), 26 | J = {"predicate":"foo","argument":[1]}. 27 | test(rpredicate) :- 28 | J = {"predicate":"foo","argument":[1]}, 29 | term_json(T,J), 30 | T = foo(1). 31 | 32 | test(clause) :- 33 | term_json((foo(1):-bar(2)),J), 34 | J = {"head":{"predicate":"foo","argument":[1]},"body":{"predicate":"bar","argument":[2]}}. 35 | test(rclause) :- 36 | J = {"head":{"predicate":"foo","argument":[1]},"body":{"predicate":"bar","argument":[2]}}, 37 | term_json(T,J), 38 | T = ((foo(1):-bar(2))). 39 | 40 | 41 | test(true) :- 42 | term_json(T,"true"), 43 | T = '@true'. 44 | test(rtrue) :- 45 | term_json('@true',J), 46 | J = "true". 47 | 48 | test(null) :- 49 | term_json(T,"null"), 50 | T = '@null'. 51 | 52 | test(rnull) :- 53 | term_json('@null',J), 54 | J = "null". 55 | 56 | 57 | test(basic) :- 58 | term_json([id=1,id=2],J), 59 | J = [{"id":1},{"id":2}]. 60 | 61 | test(rbasic) :- 62 | J = [{"id":1},{"id":2}], 63 | term_json(T,J), 64 | T = [id=1,id=2]. 65 | ``` 66 | 67 | # Unicode 68 | Unicode is displayed as is. It will not be converted into escape sequences. The purpose of this library is communication with ChatGPT, and using Unicode directly is not a problem. 69 | 70 | 71 | # Caution 72 | To simplify JSON parsing, the handling of strings has been modified. By default, strings are represented enclosed in $. However, when using the JSON module, strings are represented enclosed in ". To revert to the original behavior, use reset_json. 73 | -------------------------------------------------------------------------------- /document/LIST.md: -------------------------------------------------------------------------------- 1 | # List Library 2 | These are the basic functions for list processing. 3 | 4 | # Usage 5 | 6 | ``` 7 | -? use_module(list). 8 | ``` 9 | 10 | # Predicates 11 | - last/2 12 | 13 | - butlast/2 14 | 15 | - second/2 16 | 17 | - cons/3 18 | 19 | - nth/3 20 | 21 | - nth0/3 22 | 23 | - iota/3 24 | 25 | - take/3 26 | 27 | - drop/3 28 | 29 | - make_list/3 30 | 31 | - reverse/2 32 | 33 | - remove_at/3 34 | 35 | - insert_at/4 36 | 37 | - qsort/2 38 | 39 | - permutation/2 40 | 41 | - flatten/2 42 | -------------------------------------------------------------------------------- /document/MODULE.md: -------------------------------------------------------------------------------- 1 | # Module 2 | N-Prolog has several modularized libraries. 3 | 4 | - Compiler 5 | use_module(compiler). 6 | Until version 3.89, the compiler was loaded at startup. However, as the compiler grew larger, it began to occupy the heap area. Therefore, starting from version 3.9, it has been changed to be called as a module only when needed. 7 | 8 | - Checker 9 | use_module(checker). 10 | The checker is a library that performs static analysis of Prolog code to detect ARITY errors ,singleton variable issues and single clause issues. 11 | see CHECKER.md 12 | 13 | 14 | - DCG 15 | use_module(dcg). 16 | Starting from version 3.9, DCG must be loaded from a module when used. 17 | 18 | - Multiple world system 19 | use_module(mpworld). 20 | Starting from version 3.9, mpworld must be loaded from a module when used. 21 | see https://www.ipsj.or.jp/10jigyo/taikai/67kai/67program/html/event/ts10.pdf 22 | 23 | - List 24 | use_module(list). 25 | It includes basic predicates for list processing. Please refer to the following. 26 | 27 | ``` 28 | last/2,butlast/2,second/2,cons/3,nth/3,nth0/3,iota/3,take/3,drop/3,make_list/3,reverse/2, 29 | remove_at/3,insert_at/4,qsort/2,permutation/2,flatten/2 30 | ``` 31 | 32 | - Sets 33 | use_module(sets). 34 | 35 | ``` 36 | make_set/2,union/3,intersection/3,difference/3,subset/2,equal/2 37 | ``` 38 | 39 | - tcltk 40 | see TCLTK.md 41 | -------------------------------------------------------------------------------- /document/MPW.md: -------------------------------------------------------------------------------- 1 | # Multiple World Mechanism 2 | 3 | # Usage 4 | 5 | ``` 6 | ?- use_module(mpworld). 7 | ``` 8 | 9 | The multiple world mechanism similar to that implemented in Dr. Hideyuki Nakajima's Prolog/KR is extended. Use the with/2 predicate. 10 | There is an example in the mpw.pl file in the tests folder. 11 | See Chapter 7 https://stacks.stanford.edu/file/druid:bv252vf8932/bv252vf8932.pdf 12 | 13 | # Example 14 | 15 | ``` 16 | :- use_module(mpworld). 17 | 18 | % World multiplex mechanism 19 | %example1 20 | :- with(a,assertz(p(a))). 21 | :- with(b,assertz(p(b))). 22 | :- with(c,assertz(p(c1))). 23 | :- with(c,assertz(p(c2))). 24 | 25 | %example2 26 | % with(w1,with(w2,with(w3,fly(canary)))). -> yes 27 | % with(w1,with(w2,with(w3,fly(penguin)))). -> no 28 | :- with(w1,assertz(bird(canary))). 29 | :- with(w1,assertz(bird(penguin))). 30 | :- with(w2,assertz((fly(X) :- bird(X)))). 31 | :- with(w3,deny(fly(penguin))). 32 | 33 | ``` 34 | -------------------------------------------------------------------------------- /document/OPENGL.md: -------------------------------------------------------------------------------- 1 | # OpenGL linbrary 2 | 3 | 4 | # Preparation 5 | The OPenGL library utilizes the C language embedding feature. Therefore, it needs to be compiled first. Please follow the steps below to compile it. 6 | 7 | ``` 8 | ?- use_module(compiler). 9 | yes 10 | ?- compile_file('./library/opengl.pl') 11 | *** 12 | yes 13 | ``` 14 | 15 | # Usage 16 | 17 | ``` 18 | ?- use_module(opengl). 19 | ``` 20 | 21 | # Example 22 | 23 | ``` 24 | main :- 25 | glut_init, 26 | glut_init_display_mode(glut_single), 27 | glut_init_window_size(400,300), 28 | glut_init_window_position(200,300), 29 | glut_create_window('GLUT test'), 30 | glut_init_display_mode(glut_rgba), 31 | gl_clear_color(1.0,1.0,1.0,1.0), 32 | glut_display_func(show), 33 | glut_main_loop. 34 | 35 | 36 | show :- 37 | gl_clear(gl_color_buffer_bit), 38 | gl_color3d(1.0,0.0,0.0), 39 | gl_begin(gl_line_loop), 40 | gl_vertex2d(-0.5,-0.5), 41 | gl_vertex2d(-0.5,0.5), 42 | gl_vertex2d(0.5,0.5), 43 | gl_vertex2d(0.5,-0.5), 44 | gl_end, 45 | glut_solid_teapot(0.5), 46 | gl_flush. 47 | 48 | ``` 49 | 50 | # Specification 51 | 52 | - glut_init: 53 | Initializes GLUT (OpenGL Utility Toolkit) for use with OpenGL applications. 54 | 55 | - glut_init_display_mode(glut_single): 56 | Sets the display mode to single-buffered. 57 | 58 | - glut_init_display_mode(glut_rgba): 59 | Sets the display mode to RGBA color format. 60 | 61 | - glut_init_window_size(Height, Width): 62 | Initializes the window size with the specified height and width. 63 | 64 | - glut_init_window_position(Height, Width): 65 | Initializes the window position with the specified height and width. 66 | 67 | - glut_create_window(X): 68 | Creates a window with the specified name. 69 | 70 | - gl_clear_color(X1, Y1, X2, Y2): 71 | Sets the clear color for the OpenGL window. 72 | 73 | - glut_display_func(X): 74 | Sets the display function callback for rendering. 75 | 76 | - glut_mouse_func(X): 77 | Sets the mouse function callback for mouse events. 78 | 79 | - glut_main_loop: 80 | Starts the GLUT main loop for handling events and rendering. 81 | 82 | - gl_clear(gl_color_buffer_bit): 83 | Clears the color buffer bit. 84 | 85 | - gl_color3d(R, G, B): 86 | Sets the color for drawing with the specified RGB values. 87 | 88 | - gl_begin1(X): 89 | Begins a drawing operation with the specified mode (e.g., GL_LINE_LOOP). 90 | 91 | - gl_begin(gl_line_loop): 92 | Begins drawing a line loop. 93 | 94 | - gl_begin(gl_points): 95 | Begins drawing points. 96 | 97 | - gl_begin(gl_lines): 98 | Begins drawing lines. 99 | 100 | - gl_begin(gl_line_strip): 101 | Begins drawing a line strip. 102 | 103 | - gl_begin(gl_triangles): 104 | Begins drawing triangles. 105 | 106 | - gl_begin(gl_quads): 107 | Begins drawing quads. 108 | 109 | - gl_begin(gl_triangle_strip): 110 | Begins drawing a triangle strip. 111 | 112 | - gl_begin(gl_quad_strip): 113 | Begins drawing a quad strip. 114 | 115 | - gl_begin(gl_triangle_fan): 116 | Begins drawing a triangle fan. 117 | 118 | - gl_begin(gl_polygon): 119 | Begins drawing a polygon. 120 | 121 | - gl_error(P, O): 122 | Handles errors in drawing operations. 123 | 124 | - gl_vertex2d(X, Y): 125 | Specifies a 2D vertex for drawing. 126 | 127 | - gl_vertex3d(X, Y, Z): 128 | Specifies a 3D vertex for drawing. 129 | 130 | - gl_vertex4d(X1, X2, X3, X4): 131 | Specifies a 4D vertex for drawing. 132 | 133 | - glut_solid_cube(X): 134 | Draws a solid cube with the specified size. 135 | 136 | - glut_solid_sphere(X, Y, Z): 137 | Draws a solid sphere with the specified radius and segments. 138 | 139 | - glut_solid_torus(X1, X2, X3, X4): 140 | Draws a solid torus with the specified inner and outer radii. 141 | 142 | - glut_solid_icosahedron: 143 | Draws a solid icosahedron. 144 | 145 | - glut_solid_octahedron: 146 | Draws a solid octahedron. 147 | 148 | - glut_solid_tetrahedron: 149 | Draws a solid tetrahedron. 150 | 151 | - glut_solid_dodecahedron: 152 | Draws a solid dodecahedron. 153 | 154 | - glut_solid_cone(X1, X2, X3, X4): 155 | Draws a solid cone with the specified base radius, height, and slices. 156 | 157 | - glut_solid_teapot(X): 158 | Draws a solid teapot with the specified size. 159 | 160 | - gl_end: 161 | Ends the current drawing operation. 162 | 163 | - gl_flush: 164 | Flushes the OpenGL commands to the graphics hardware. 165 | 166 | - gl_finish: 167 | Waits for all OpenGL commands to finish. 168 | 169 | 170 | ![screen5.png](screen5.png) -------------------------------------------------------------------------------- /document/PARA2.md: -------------------------------------------------------------------------------- 1 | # Multi-thread Parallel 2 | This is a multi-thread parallel extension for N-Prolog. N-Prolog is oriented toward computational experiments and aims to explore the potential of Prolog in medium-scale parallel computation with distributed parallel. 3 | 4 | 5 | # Spec 6 | 7 | mt_create(N): Generate N threads. 8 | 9 | mt-and([p0,p1, ...,pn]): It executes the predicates from P0 to PN in parallel. If all of them return YES, it returns YES. If even one returns NO, it returns NO. 10 | 11 | mt_or([p0,p1, ...,n]): It executes the predicates from P0 to PN in parallel. If any one of them returns YES, it interrupts the other computations and returns YES. 12 | 13 | mt_prove(Nth,Pred): Prove Predicate on the Nth thread for testing. 14 | 15 | mt_close: Close all threads. 16 | 17 | 18 | # Example 19 | 20 | ``` 21 | % multi-thread parallel example 22 | 23 | :- mt_create(2). 24 | 25 | para(X) :- list50(Y),psort(Y,X). 26 | 27 | psort([Pivot|Rest], Sorted) :- 28 | partition(Pivot, Rest, Left, Right), 29 | mt_and([qsort(Left, SortedLeft), qsort(Right, SortedRight)]), 30 | append(SortedLeft, [Pivot|SortedRight], Sorted). 31 | 32 | seq(X) :- list50(Y),qsort(Y,X). 33 | 34 | qsort([], []). 35 | qsort([Pivot|Rest], Sorted) :- 36 | partition(Pivot, Rest, Left, Right), 37 | qsort(Left, SortedLeft), 38 | qsort(Right, SortedRight), 39 | append(SortedLeft, [Pivot|SortedRight], Sorted). 40 | 41 | partition(_, [], [], []). 42 | partition(Pivot, [H|T], [H|Left], Right) :- 43 | H =< Pivot, 44 | partition(Pivot, T, Left, Right). 45 | partition(Pivot, [H|T], Left, [H|Right]) :- 46 | H > Pivot, 47 | partition(Pivot, T, Left, Right). 48 | 49 | % List of 50 elements for another test 50 | list50([27, 74, 17, 33, 94, 18, 46, 83, 65, 2, 32, 53, 28, 85, 99, 47, 28, 82, 6, 11, 51 | 55, 29, 39, 81, 90, 37, 10, 0, 66, 51, 7, 21, 85, 27, 31, 63, 75, 4, 95, 99, 11, 28, 61, 52 | 74, 18, 92, 40, 55, 59, 8]). 53 | 54 | ``` 55 | [MT](para3.png) 56 | 57 | # Thread pooling 58 | source code extension.c line 2139 59 | 60 | mt-create... b_mt_create 61 | mt-amd... f_mt_and 62 | mt-or... f_mt_or 63 | mp-close... f_mt_close 64 | 65 | queue[] = 1,2,3,... worker_count 66 | 67 | worker_count = core_count - 1(main + GC); 68 | 69 | 70 | initital 71 | queue [1,2,3,4] hexa core 72 | queue_pt = 4; 73 | 74 | eval_para(arg) 75 | dequeue [2,3,4] 76 | queue_pt = 3 77 | main thread send signal to worker1 thread. 78 | worker1 eval(arg) -> para_output[1]=result. 79 | worker1 send signal to main thread. 80 | enqueue [2,3,4,1] 81 | queue_pt = 4 82 | 83 | [thread](para4.png) 84 | 85 | # Constraint 86 | Bignums are not thread-safe in multithreading due to memory limitations. -------------------------------------------------------------------------------- /document/PLOT.md: -------------------------------------------------------------------------------- 1 | # Plot library 2 | 3 | 4 | # Preparation 5 | The Plot library utilizes the C language embedding feature. Therefore, it needs to be compiled first. Please follow the steps below to compile it. 6 | 7 | ``` 8 | ?- use_module(compiler). 9 | yes 10 | ?- compile_file('./library/plot.pl'). 11 | *** 12 | yes 13 | ``` 14 | 15 | # Specification 16 | 17 | - open_plot/0 18 | 19 | - send_plot(Msg) 20 | 21 | - close_plot/0 22 | 23 | ![screen3.png](screen3.png) 24 | 25 | -------------------------------------------------------------------------------- /document/PYHTON.md: -------------------------------------------------------------------------------- 1 | # Python Library to use TensorFlow 2 | under construction 3 | 4 | # Install Tensorflow 5 | 6 | ``` 7 | sudo apt install python3-pip 8 | pip install tensorflow-cpu 9 | 10 | ``` 11 | 12 | # Preparation 13 | The Plot library utilizes the C language embedding feature. Therefore, it needs to be compiled first. Please follow the steps below to compile it. 14 | 15 | ``` 16 | ?- use_module(compiler). 17 | yes 18 | ?- compile_file('./library/python.pl'). 19 | *** 20 | yes 21 | ``` 22 | 23 | # Usage 24 | 25 | ``` 26 | ?- use_module(python). 27 | ``` 28 | 29 | # Example 30 | 31 | ``` 32 | # calc.py test for tensorflow 33 | import os 34 | os.environ['TF_CPP_MIN_LOG_LEVEL'] = '2' 35 | import tensorflow as tf 36 | print(tf.add(1, 2).numpy()) 37 | ``` 38 | 39 | ``` 40 | N-Prolog Ver 4.07 41 | ?- use_module(python). 42 | yes 43 | ?- send_python('./tests/calc.py',X). 44 | python3 ./tests/calc.py3 45 | X = $3 46 | $ . 47 | yes 48 | ?- 49 | ``` 50 | 51 | # Specification 52 | 53 | - `send_python(File,Result)' 54 | Provide a file name to Python 3 and receive the execution result as a string. 55 | 56 | # Note 57 | This feature was created for TensorFlow. However, since it's simply instructing Python, I believe it can be applied to other uses as well. 58 | 59 | # Idea note 60 | 61 | ``` 62 | exec.py 63 | ?- send_python('exec.py image.jpg', X). 64 | 65 | import sys 66 | import tensorflow as tf 67 | from tensorflow.keras.preprocessing import image 68 | import numpy as np 69 | 70 | # Get the image file path from command-line arguments 71 | if len(sys.argv) != 2: 72 | print("Usage: python3 exec.py ") 73 | sys.exit(1) 74 | 75 | img_path = sys.argv[1] # Image file path 76 | 77 | # Load the MobileNetV2 model pre-trained on ImageNet 78 | model = tf.keras.applications.MobileNetV2(weights='imagenet') 79 | 80 | # Load and resize the image to the input size of the model (224x224) 81 | img = image.load_img(img_path, target_size=(224, 224)) 82 | 83 | # Convert the image to a NumPy array 84 | img_array = image.img_to_array(img) 85 | 86 | # Add a batch dimension (the model expects input in batches) 87 | img_array = np.expand_dims(img_array, axis=0) 88 | 89 | # Normalize the pixel values to be between 0 and 1 90 | img_array = img_array / 255.0 91 | 92 | # Perform inference (make predictions) 93 | predictions = model.predict(img_array) 94 | 95 | # Decode the predictions (convert them to human-readable labels) 96 | decoded_predictions = tf.keras.applications.mobilenet_v2.decode_predictions(predictions, top=3) 97 | 98 | # Simple conclusion output for Prolog: "cat" or "dog" 99 | for i, (imagenet_id, label, score) in enumerate(decoded_predictions[0]): 100 | if 'cat' in label.lower(): 101 | print("cat") # Output "cat" if the result is related to cat 102 | break 103 | elif 'dog' in label.lower(): 104 | print("dog") # Output "dog" if the result is related to dog 105 | break 106 | 107 | ``` -------------------------------------------------------------------------------- /document/SETS.md: -------------------------------------------------------------------------------- 1 | # Sets 2 | This is a library for simple set operations. 3 | 4 | # Usage 5 | 6 | ``` 7 | ?- use_module(sets). 8 | ``` 9 | 10 | # predicates 11 | 12 | - make_set/2 13 | 14 | - union/3 15 | 16 | - intersection/3 17 | 18 | - difference/3 19 | 20 | - subset/2 21 | 22 | - equal/2 23 | -------------------------------------------------------------------------------- /document/SUPERSET.md: -------------------------------------------------------------------------------- 1 | # Superset 2 | N-Prolog is compatible with ARITY/PROLOG. This is an old language specification from the 1980s. Some predicates have been added to run more modern code, primarily based on ISO-Prolog. However, please note that these may not necessarily conform to the ISO-Prolog specification. 3 | 4 | # Spec 5 | The following extension functions respect ISO-Prolog as much as possible, but they are provided primarily for the purpose of being a backward-compatible extension in N-Prolog. Please refrain from pointing out differences with ISO-Prolog. 6 | 7 | 8 | - \+ (not) 9 | 10 | - atom_concat/3 11 | The first and second arguments are concatenated and unified with the third argument. Now ,the following cases are not supported. e.g. atom_concat(X,b,ab). 12 | 13 | - append/3 14 | 15 | - member/2 16 | 17 | - between/3 18 | 19 | - select/3 20 | 21 | - succ/2 22 | 23 | - maplist/2 24 | 25 | - compound/1 26 | 27 | - ground/1 28 | 29 | - once/1 30 | 31 | - atom_codes/2 32 | 33 | - atom_chars/2 34 | 35 | - char_code/2 36 | 37 | - number_codes/2 38 | 39 | - number_chars/2 40 | 41 | - predicate_property/2 42 | 43 | - bagof/3 44 | 45 | - setof/3 46 | 47 | - findall/3 48 | 49 | - write_canonical/1 /2 50 | 51 | - atom_length/2 52 | 53 | - get_code/1 2 54 | 55 | - get_char/1 2 56 | 57 | - get_byte/1 2 58 | 59 | - put_char/1 2 60 | 61 | - put_code/1 2 62 | 63 | - put_byte/1 2 64 | 65 | - peek_code/1 2 66 | 67 | - peek_char/1 2 68 | 69 | - peek_byte/1 2 70 | 71 | - flush_output/0 1 72 | 73 | - catch/3 74 | 75 | - throw/1 76 | 77 | - unify_with_occurs_check/2 78 | 79 | - current_input/1 80 | 81 | - current_output/1 82 | 83 | - set_input/1 84 | 85 | - set_output/1 86 | 87 | - use_module/1 88 | 89 | - module/1 90 | 91 | - copy_term/2 92 | 93 | - at_end_of_stream/1 94 | 95 | - stream_property/2 96 | 97 | - dynamic/1 98 | In N-Prolog, when foo/1 is given, the entire foo predicate is defined as dynamic. 99 | 100 | # Not ISO-Prolog 101 | N-Prolog is specialized for experimenting with and playing around with small-scale code. Therefore, the following features are not included. 102 | 103 | - sub_atom/5 104 | Reverse computation is too complex. 105 | - open/3 106 | Please use open/3 compatible with Arity/Prolog. 107 | - multifile/1 108 | For now, we are not considering complex libraries. 109 | - initialization/1 110 | - include/1 111 | - ensure_loaded/1 112 | 113 | - set_prolog_flag/2 114 | The set_prolog_flag exists, but it is different from ISO. It is only effective when changing the handling of strings. 115 | 116 | - current_prolog_flag/2 117 | not exist. 118 | 119 | - long atom with '\\' 120 | Excessively long atoms hinder code readability. 121 | 122 | # String 123 | Strings are enclosed in dollar signs, similar to ARITY/PROLOG. However, they can be changed to double quotes using set_prolog_flag. 124 | 125 | ``` 126 | N-Prolog Ver 4.01 127 | ?- X = $hello$. 128 | X = $hello$ . 129 | yes 130 | ?- set_prolog_flag(string,iso). 131 | yes 132 | ?- X = "hello". 133 | X = "hello" . 134 | yes 135 | ?- set_prolog_flag(string,arity). 136 | yes 137 | ?- X = $hello$. 138 | X = $hello$ . 139 | yes 140 | ?- 141 | 142 | ``` 143 | 144 | 145 | # Module 146 | A module is generated by module/2. The first argument is the module name, and the second argument is a list of predicates and their arities to be exported. Each file corresponds to one module. Files are stored in the library folder, and the filename is the module name followed by the .pl extension. To invoke a module, use use_module/1. The argument is an atom representing the module name.Predicates other than those exported have the module name prefixed to them.Predicates within a module are not displayed by listing/0. 147 | 148 | e.g. 149 | 150 | ``` 151 | :- module(asdf,[bar/1]). 152 | 153 | bar(X) :- boo(X). 154 | 155 | boo(X) :- write(X). 156 | 157 | save file to library as asdf.pl 158 | | 159 | v 160 | use_module(asdf) 161 | bar(X) :- 162 | asdf_boo(X). 163 | asdf_boo(X) :- 164 | write(X). 165 | 166 | ``` 167 | 168 | It is also possible to compile the module. In this case, use_module/1 first looks for a file to be executed by the compiler. If not found, it will load the file to be executed by the interpreter. 169 | 170 | 171 | # Function 172 | In ARITY/PROLOG, the ^ symbol is used for exponentiation. However, since ** is used for exponentiation in ISO-Prolog, we allow this as well. 173 | 174 | ``` 175 | N-Prolog Ver 3.80 176 | ?- X is 2**3. 177 | X = 8 . 178 | yes 179 | ?- 180 | ``` 181 | 182 | # My Personal Thoughts on ISO-Prolog 183 | I believe ISO-Prolog has excessively high requirements. It sets overly detailed specifications regarding syntax and imposes high standards on op/3. The appeal of Prolog, in my opinion, lies in the astonishing realization that first-order predicate logic can be applied to programming. I think overly detailed syntax rules hinder the widespread adoption of Prolog. I would like to emphasize that this is my personal opinion. 184 | 185 | 186 | 187 | # Extended 188 | 189 | ## format(Str,Format,List). 190 | If the first argument is a variable, the formatted string will be unified with the variable. The second argument is the format, which is a string. Values can be inserted into the string, and the values to be inserted are provided as a list in the third argument. 191 | 192 | The variables for insertion are as follows: 193 | - ~O All of atomic. 194 | - ~A atom 195 | - ~S string 196 | - ~D integer 197 | - ~F float 198 | 199 | ## format(Stream,format,List). 200 | If the first argument is a stream or alias, the edited string will be output to that stream. The specifications of the second and third arguments remain the same. 201 | 202 | e.g. 203 | 204 | ``` 205 | ?- format(user_output,$asdf$,[]). 206 | asdfyes 207 | ?- format(X,$hello ~S !$,[$world$]). 208 | X = $hello world !$ . 209 | yes 210 | ?- format(X,$hello ~A !$,[world]). 211 | X = $hello world !$ . 212 | yes 213 | ?- 214 | ?- format(X,$number ~D $,[1]). 215 | X = $number 1 $ . 216 | yes 217 | ?- format(X,$number ~F $,[1.1]). 218 | X = $number 1.1 $ . 219 | yes 220 | ?- format(X,$number ~O ~O $,[1.1,atom]). 221 | X = $number 1.1 atom $ . 222 | yes 223 | ``` -------------------------------------------------------------------------------- /document/TCLTK.md: -------------------------------------------------------------------------------- 1 | # TCL/TK library 2 | 3 | 4 | # Preparation 5 | The Tcl/Tk library utilizes the C language embedding feature. Therefore, it needs to be compiled first. Please follow the steps below to compile it. 6 | 7 | ``` 8 | ?- use_module(compiler). 9 | yes 10 | ?- compile_file('./library/tcltk.pl'). 11 | *** 12 | yes 13 | ``` 14 | 15 | # Usage 16 | 17 | ``` 18 | ?- use_module(tcltk). 19 | 20 | ``` 21 | 22 | # Specification 23 | 24 | - `tk_init` 25 | Initializes the Tcl and Tk interpreters. 26 | 27 | - `tk_exit` 28 | Deletes the Tcl interpreter and exits. 29 | 30 | - `tk_clear` 31 | Clears the command buffer (used for GUI commands). 32 | 33 | - `tk_command(Cmd)` 34 | Executes the arbitrary Tcl command string `Cmd`. 35 | 36 | - `tk_mainloop` 37 | Starts the main event loop of Tk. 38 | 39 | - `tk_update` 40 | Immediately updates the Tk GUI. 41 | 42 | 43 | - `tk_canvas(Obj)` 44 | Creates a canvas widget with the name `Obj`. 45 | 46 | - `tk_canvas(Obj, Opt)` 47 | Creates a canvas widget with options. 48 | 49 | - `tk_label(Obj)` 50 | Creates a label widget. 51 | 52 | - `tk_label(Obj, Opt)` 53 | Creates a label widget with options. 54 | 55 | - `tk_button(Obj)` 56 | Creates a button widget. 57 | 58 | - `tk_button(Obj, Opt)` 59 | Creates a button widget with options. 60 | 61 | - `tk_radiobutton(Obj)` 62 | Creates a radio button widget. 63 | 64 | - `tk_radiobutton(Obj, Opt)` 65 | Creates a radio button widget with options. 66 | 67 | - `tk_checkbutton(Obj)` 68 | Creates a check button widget. 69 | 70 | - `tk_checkbutton(Obj, Opt)` 71 | Creates a check button widget with options. 72 | 73 | - `tk_listbox(Obj)` 74 | Creates a listbox widget. 75 | 76 | - `tk_listbox(Obj, Opt)` 77 | Creates a listbox widget with options. 78 | 79 | - `tk_scrollbar(Obj)` 80 | Creates a scrollbar widget. 81 | 82 | - `tk_scrollbar(Obj, Opt)` 83 | Creates a scrollbar widget with options. 84 | 85 | 86 | - `tk_pack(Obj)` 87 | Packs a single widget. 88 | 89 | - `tk_pack(Obj, Opt)` 90 | Packs a widget with options. 91 | 92 | - `tk_pack(ObjList)` 93 | Packs multiple widgets provided as a list of atoms. 94 | 95 | - `tk_create(Obj, Class, Option)` 96 | Creates a canvas item of type `Class` with ID `Obj` and options. 97 | 98 | class line([x1,y1,x2,y2,...]) oval([x1,y1,x2,y2]) arc([x1,y1,x2,y2]) 99 | rectangle([x1,y1,x2,y2]) polygon([x1,y1,x2,y2,...]) 100 | 101 | 102 | 103 | ![screen4.png](screen4.png) -------------------------------------------------------------------------------- /document/TCPIP.md: -------------------------------------------------------------------------------- 1 | # TCP/IP 2 | I have implemented the TCP/IP predicates. see ./tests/socket.pl 3 | 4 | # Specification 5 | - create_server_socket(Soket,port) 6 | Creates and returns a socket as a server based on the port number. Provide the port number to port. It ranges from 0 to 65536. 7 | 8 | - create_client-socket(Soket,port,ip-address) 9 | Provide the port number to port. It ranges from 0 to 65536. ip-address is given as an atom. Example: '127.1.1.1' Returns yes is success. 10 | 11 | - send_socket(Socket,Atom) 12 | Sends an atom to the socket. Returns yes. 13 | 14 | - recv_socket(Socket,Atom) 15 | Receives from the socket and returns yes. 16 | 17 | - close_socket(Socket) 18 | Closes the socket. Returns yes. 19 | 20 | ``` 21 | start_server :- 22 | create_server_socket(ServerSocket, 5000), 23 | write('Server started on port 5000'),nl, 24 | recv_socket(ServerSocket, Message), 25 | write('Server received: '), 26 | write(Message),nl, 27 | send_socket(ServerSocket, Message), 28 | close_socket(ServerSocket). 29 | 30 | start_client :- 31 | create_client_socket(ClientSocket, 5000, '127.1.1.1'), 32 | send_socket(ClientSocket, hello), 33 | write('Client sent: hello'),nl, 34 | recv_socket(ClientSocket, Message), 35 | write('Client recv: '), 36 | write(Message),nl, 37 | close_socket(ClientSocket). 38 | 39 | ``` 40 | 41 | -------------------------------------------------------------------------------- /document/UNICODE.md: -------------------------------------------------------------------------------- 1 | # Unicode 2 | N-Prolog supports UNICODE. 3 | Internally, it uses UTF-8. 4 | 5 | # Example 6 | 7 | ``` 8 | 9 | 鳥類(X) :- 10 | 温血(X), 11 | 脊椎動物(X), 12 | 羽根(X). 13 | 14 | ?- name(動物,X). 15 | X = [21205,29289] . 16 | yes 17 | ?- 18 | 19 | እንፎች(X) :- 20 | ሞቃት(X), 21 | እግርተኞች(X), 22 | ተንቀሳቃሽ(X). 23 | 24 | ``` 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /document/WIRINGPI.md: -------------------------------------------------------------------------------- 1 | # wiringPi 2 | On paspberry PI, N-Prolog includes builtin predicates of WiringPi. 3 | 4 | ``` 5 | N-Prolog <==================================> C 6 | wiringpi_spi_setup(ch speed) <===> wiringPiSPISetup (SPI_CH, SPI_SPEED) 7 | wiringpi_setup_gpio <===> wiringPiSetupGpio() 8 | pin_mode(n, 'output) <====> pinMode(n, OUTPUT) or 'input -> INPUT 'pwm-output -> PWM_OUTPUT 9 | digital_write(n, v) <===> digitalWrite(n, v) 10 | digital_write_byte(v) <===> digitalWriteByte(value) 11 | digital_read(pin,Var) <===> digitalRead(pin,Var) 12 | delay(howlong) <===> void delay(unsigned int howLong) 13 | delay_microseconds(howlong) <===> void delay_microseconds(unsigned int howLong) 14 | pull_up_dn_control(pin, pud) <===> pullUpDnControl(pin,pud) 15 | pwm_set_mode('pwm_mode_ms) <===> pwmSetMode(PWM_MODE_MS); or 'pwm_mode_bal -> PWM_MODE_BAL 16 | pwm_set_clock(n) <===> pwmSetClock(n) 17 | pwm_set_range(n) <===> pwmSetRange(n) 18 | pwm_write(pin, value) <===> pwmWrite(pin , value) 19 | 20 | timer_microseconds/1 21 | usage: timer_microseconds(on). timer on 22 | timer_microseconds(off). timer off 23 | timer_microsecons(X). unify X elapsed time. float number ,unit seconds , valid digits microsecnods 24 | see tests/measure.pl 25 | ``` 26 | 27 | -------------------------------------------------------------------------------- /document/book1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/book1.png -------------------------------------------------------------------------------- /document/book2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/book2.png -------------------------------------------------------------------------------- /document/para1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/para1.png -------------------------------------------------------------------------------- /document/para2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/para2.png -------------------------------------------------------------------------------- /document/para3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/para3.png -------------------------------------------------------------------------------- /document/para4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/para4.png -------------------------------------------------------------------------------- /document/screen1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/screen1.png -------------------------------------------------------------------------------- /document/screen2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/screen2.png -------------------------------------------------------------------------------- /document/screen3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/screen3.png -------------------------------------------------------------------------------- /document/screen4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/screen4.png -------------------------------------------------------------------------------- /document/screen5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/document/screen5.png -------------------------------------------------------------------------------- /edlog.h: -------------------------------------------------------------------------------- 1 | #ifndef EDLIS_H 2 | #define EDLIS_H 3 | 4 | #ifndef _XOPEN_SOURCE 5 | #define _XOPEN_SOURCE 600 6 | #endif /* 7 | */ 8 | 9 | #define FULLSCREEN 10 | #include "term.h" 11 | 12 | static const float VERSION = 4.31; 13 | 14 | #define ROW_SIZE 5000 15 | #define COL_SIZE 256 16 | #define COPY_SIZE 1000 17 | #define TOKEN_MAX 80 18 | #define LEFT_MARGIN 7 19 | #define TOP_MARGIN 2 20 | 21 | // edit 22 | struct position{ 23 | int row; 24 | int col; 25 | }; 26 | 27 | 28 | static const int NIL = 0; 29 | static const char *predicates_data[]; 30 | 31 | bool edit_loop(void); 32 | bool is_special(int row, int col); 33 | bool is_word_char(char x); 34 | bool quit_with_save(void); 35 | int calc_tabs(void); 36 | int findnext(int row, int col); 37 | int find_eol(int row); 38 | int find_eol1(int row); 39 | int find_function_data(const char *str); 40 | int find_predicate_data(const char *str); 41 | int find_predicate_data1(const char *str); 42 | int getch1(void); 43 | char *get_fragment(void); 44 | char *getname(void); 45 | char *getword1(void); 46 | char *getword2(void); 47 | enum HighlightToken check_token(int row, int col); 48 | struct position find_lparen(int bias); 49 | struct position find_rparen(int bias); 50 | struct position find_lbracket(int bias); 51 | struct position find_rbracket(int bias); 52 | struct position find_word(const char *word); 53 | struct position find_word_back(const char *word); 54 | void add_eol(void); 55 | void backspace(void); 56 | void backspace_key(void); 57 | void copy_selection(void); 58 | void cut_line(void); 59 | void del(void); 60 | void delete_char(void); 61 | void delete_row(void); 62 | void delete_selection(void); 63 | void display_header(void); 64 | void display_screen(void); 65 | void display_line(int line); 66 | void down(void); 67 | void edit_screen(void); 68 | void end(void); 69 | void emphasis_lparen(void); 70 | void emphasis_rparen(void); 71 | void emphasis_lbracket(void); 72 | void emphasis_rbracket(void); 73 | void find_candidate(void); 74 | void help(void); 75 | void home(void); 76 | void information(void); 77 | void init_ncurses(void); 78 | void input(char *str); 79 | void insert_col(void); 80 | void insert_row(void); 81 | void left(void); 82 | void load_data(char *name); 83 | void mark_unmark(void); 84 | void pageup(void); 85 | void pagedown(void); 86 | void paste_selection(void); 87 | void redisplay_screen(void); 88 | void replace_fragment(const char *newstr); 89 | void replace_word(const char *str1, const char *str2); 90 | void restore_paren(void); 91 | void restore_bracket(void); 92 | void restore_cursol(void); 93 | void return_key(void); 94 | void remove_headspace(int row); 95 | void right(void); 96 | void save_region(void); 97 | void save_file_as(void); 98 | void set_color(enum Color); 99 | void softtabs(int n); 100 | void save_data(char *name); 101 | void save_copy(char *name); 102 | void signal_handler_c(int signo __unused); 103 | void signal_handler_z(int signo __unused); 104 | void tab_key(void); 105 | void up(void); 106 | void word_next(void); 107 | void word_prev(void); 108 | 109 | 110 | //following are for unicode<=>UTF-8 transform 111 | #define UNI2ADD1 192 //#b11000000 112 | #define UNI3ADD1 224 //#b11100000 113 | #define UNI4ADD1 240 //#b11110000 114 | #define UNIOADDO 128 //#b10000000 115 | #define UNI2MSK1 1984 //#b0000011111000000 116 | #define UNI2MSK2 63 //#b0000000000111111 117 | #define UNI3MSK1 61440 //#b1111000000000000 118 | #define UNI3MSK2 4032 //#b0000111111000000 119 | #define UNI3MSK3 63 //#b0000000000111111 120 | #define UNI4MSK1 1835008 //#b00000000000111000000000000000000 121 | #define UNI4MSK2 258048 //#b00000000000000111111000000000000 122 | #define UNI4MSK3 4032 //#b00000000000000000000111111000000 123 | #define UNI4MSK4 63 //#b00000000000000000000000000111111 124 | #define UTF2MSK1 63 //#b00111111 125 | #define UTF3MSK1 31 //#b00011111 126 | #define UTF4MSK1 15 //#b00001111 127 | #define UTFOMSKO 127 //#b01111111 128 | 129 | #define isUni1(c) ((unsigned char)(c) <= 0x7f) 130 | 131 | #define isUni2(c) (((unsigned char)(c) >= 0xc2) && \ 132 | ((unsigned char) (c) <= 0xdf)) 133 | 134 | #define isUni3(c) (((unsigned char)(c) >= 0xe0) && \ 135 | ((unsigned char) (c) <= 0xef)) 136 | 137 | #define isUni4(c) (((unsigned char)(c) >= 0xf0) && \ 138 | ((unsigned char) (c) <= 0xf7)) 139 | 140 | 141 | #endif 142 | -------------------------------------------------------------------------------- /example/animal.pl: -------------------------------------------------------------------------------- 1 | % unicode example 2 | 3 | 動物(人間). 4 | 動物(X) :- 人間(X). 5 | 動物(_い) :- 鳥類(_い). 6 | 7 | 人間(ジョー). 8 | 9 | 10 | 鳥類(X) :- 11 | 温血(X), 12 | 脊椎動物(X), 13 | 羽根(X). 14 | 15 | 16 | ほ乳類(A) :- 17 | 温血(A), 18 | 脊椎動物(A), 19 | 体毛(A). 20 | 21 | 温血(熊). 22 | 温血(鷲). 23 | 温血(人). 24 | 温血(すずめ). 25 | 26 | 脊椎動物(熊). 27 | 脊椎動物(鷲). 28 | 脊椎動物(人). 29 | 脊椎動物(すずめ). 30 | 31 | 体毛(人). 32 | 体毛(熊). 33 | 34 | 羽根(鷲). 35 | 羽根(すずめ). 36 | 37 | -------------------------------------------------------------------------------- /example/assoc.pl: -------------------------------------------------------------------------------- 1 | % test for association 2 | 3 | % require ?- existerrors(_,no). for fib1/2 4 | 5 | fib(0,0). 6 | fib(1,1). 7 | fib(N,A) :- 8 | fib1(N,A). 9 | fib(N,A) :- 10 | N1 is N-1, N2 is N-2, 11 | fib(N1,A1),fib(N2,A2), 12 | A is A1+A2, 13 | asserta(fib1(N,A)). 14 | 15 | -------------------------------------------------------------------------------- /example/bagof.pl: -------------------------------------------------------------------------------- 1 | happy(fido). 2 | happy(harry). 3 | happy(X) :- rich(X). 4 | rich(harry). 5 | /* 6 | ?- setof(Y, happy(Y), Set). 7 | Y = _G180 8 | Set = [fido, harry] ; 9 | false. 10 | 11 | ?- bagof(Y, happy(Y), Bag). 12 | Y = _G180 13 | Bag = [fido, harry, harry] ; 14 | false. 15 | 16 | ?- findall(Y, happy(Y), Bag). 17 | Y = _G180 18 | Bag = [fido, harry, harry] ; 19 | false. 20 | 21 | */ 22 | 23 | foo(a, b, c). 24 | foo(a, b, d). 25 | foo(b, c, e). 26 | foo(b, c, f). 27 | foo(c, c, g). 28 | 29 | /* 30 | ?- bagof(C, foo(A, B, C), Cs). 31 | A = a, B = b, C = G308, Cs = [c, d] ; 32 | A = b, B = c, C = G308, Cs = [e, f] ; 33 | A = c, B = c, C = G308, Cs = [g]. 34 | 35 | ?- bagof(C, A^foo(A, B, C), Cs). 36 | A = G324, B = b, C = G326, Cs = [c, d] ; 37 | A = G324, B = c, C = G326, Cs = [e, f, g]. 38 | */ -------------------------------------------------------------------------------- /example/bignum.pl: -------------------------------------------------------------------------------- 1 | %BIGNUM test 2 | :- dynamic(foo/2). 3 | 4 | foo(X,Y) :- Y is X + 111111111111111111111111111111111111111111111111111111111111111111111. 5 | 6 | fact(0,1). 7 | fact(N,A) :- 8 | N1 is N-1, 9 | fact(N1,A1), 10 | A is N*A1. 11 | 12 | % fact(1000,X). -------------------------------------------------------------------------------- /example/comp.pl: -------------------------------------------------------------------------------- 1 | % complex number 2 | 3 | :- op(700,xfx,isc). 4 | 5 | X isc c(R1,I1)+c(R2,I2) :- 6 | R is R1+R2, 7 | I is I1+I2, 8 | X = c(R,I). 9 | 10 | X isc c(R1,I1)-c(R2,I2) :- 11 | R is R1-R2, 12 | I is I1-I2, 13 | X = c(R,I). 14 | 15 | X isc c(R1,I1)*c(R2,I2) :- 16 | R is R1*R2-I1*I2, 17 | I is R1*I2+I1*R2, 18 | X = c(R,I). 19 | 20 | X isc c(R1,I1)/c(R2,I2) :- 21 | D is R2^2+I2^2, 22 | R is (R1*R2-I1*I2)/D, 23 | I is (R1*I2+I1*R2)/D, 24 | X = c(R,I). 25 | 26 | X isc conjugate(c(R,I)) :- 27 | X = c(R,-I). 28 | 29 | X isc real_part(c(R,I)) :- 30 | X = R. 31 | 32 | X isc imag_part(c(R,I)) :- 33 | X = I. 34 | 35 | X isc abs(c(R,I)) :- 36 | X is sqrt(R^2+I^2). -------------------------------------------------------------------------------- /example/counter.pl: -------------------------------------------------------------------------------- 1 | %example of counter predicates 2 | 3 | now_tenof :- 4 | ctr_set(0,1), 5 | repeat, 6 | ctr_inc(0,Y), 7 | write(Y),nl, 8 | Y==10. 9 | -------------------------------------------------------------------------------- /example/cursor.pl: -------------------------------------------------------------------------------- 1 | % Cursor test code 2 | 3 | % Clear the screen and get the current cursor position 4 | test_ansi_cursor :- 5 | ansi_ed, % Clear the screen 6 | ansi_scp, % Save the current cursor position 7 | ansi_cuu(2), % Move the cursor up by 2 lines 8 | ansi_cud(1), % Move the cursor down by 1 line 9 | ansi_cuf(5), % Move the cursor forward by 5 columns 10 | ansi_cub(3), % Move the cursor back by 3 columns 11 | ansi_cpr(Row, Col), % Get the current cursor position 12 | write('Current Cursor Position: '), 13 | write(Row), write(','), write(Col), nl, 14 | ansi_rcp. % Restore the saved cursor position 15 | 16 | % Test for setting text attributes 17 | test_ansi_sgr :- 18 | ansi_sgr(1), 19 | ansi_sgr(31), % Set bold and red text 20 | write('This is bold and red text'), nl, 21 | ansi_sgr(0), % Reset to default attributes 22 | write('This is normal text'), nl. 23 | 24 | % Test for clearing the line 25 | test_ansi_clear_line :- 26 | write('This line will be partially erased...'), 27 | ansi_cub(10), % Move the cursor back by 10 columns 28 | ansi_el, % Erase from the cursor to the end of the line 29 | write('End of test for line clear'), nl. 30 | 31 | % Main predicate to run the tests 32 | run_tests :- 33 | nl, write('Testing Cursor Movement...'), nl, 34 | test_ansi_cursor, 35 | nl, write('Testing SGR...'), nl, 36 | test_ansi_sgr, 37 | nl, write('Testing Line Clear...'), nl, 38 | test_ansi_clear_line. 39 | 40 | 41 | % game 42 | show_cursor_position :- 43 | ansi_cpr(Row, Col), 44 | write('current position:'), 45 | write([Row, Col]), 46 | nl. 47 | 48 | game :- 49 | write('simple cursor game'),nl, 50 | write('input command（e.g.: ansi_cud(3), ansi_cuf(5), ansi_ed, halt）:'),nl, 51 | repeat, 52 | write('> '), 53 | read(Command), 54 | call(Command), 55 | show_cursor_position, 56 | fail. 57 | -------------------------------------------------------------------------------- /example/cut.pl: -------------------------------------------------------------------------------- 1 | /* 2 | written by M.Hiroi 3 | Thanks 4 | 5 | */ 6 | 7 | ticket(Age, Money) :- Age < 13, Money is 500, !. 8 | ticket(Age, Money) :- Money is 1000. 9 | 10 | take_integer([X | Xs], Ys) :- 11 | take_integer(X, Ys1), take_integer(Xs, Ys2), append(Ys1, Ys2, Ys), !. 12 | take_integer(X, [X]) :- integer(X), !. 13 | take_integer(X, []). 14 | % cut test from M.Hiroi's page 15 | 16 | fact(0,1) :- !. 17 | fact(X,Y) :- 18 | X1 is X-1, 19 | fact(X1,Y1), 20 | Y is X*Y1. 21 | 22 | yes_or_no(X) :- 23 | repeat, write('yes or no >'), read(X), (X == yes ; X == no), !. 24 | 25 | take_integer([X | Xs], Ys) :- 26 | take_integer(X, Ys1), take_integer(Xs, Ys2), append(Ys1, Ys2, Ys), !. 27 | take_integer(X, [X]) :- integer(X), !. 28 | take_integer(X, []). 29 | 30 | %?- take_integer([1, a, [2, b]], X). -------------------------------------------------------------------------------- /example/dcg.pl: -------------------------------------------------------------------------------- 1 | 2 | s --> np,vp. 3 | np --> det,n. 4 | det -->[a]. 5 | n -->[dog]. 6 | n -->[postman]. 7 | vp --> v,np. 8 | v -->[bites]. 9 | 10 | digit(D) --> [C],{0'0 =< C,C =< 0'9,D is C - 0'0}. 11 | 12 | as --> []. 13 | as --> [a], as. 14 | 15 | lis([]) --> []. 16 | lis([L|Ls]) --> [L], lis(Ls). 17 | -------------------------------------------------------------------------------- /example/dif.pl: -------------------------------------------------------------------------------- 1 | dif(F,X,Z) :- d(F,X,Y),simple(Y,Z). 2 | 3 | d(N,X,0) :- number(N). 4 | d(X,X,1). 5 | d(X^N,X,N*X). 6 | d(N*X,X,N). 7 | d(1/X,X,-1/X^2). 8 | d(sqrt(X),X,1/2*sqrt(X)). 9 | d(sin(X),X,cos(X)). 10 | d(cos(X),X,-sin(X)). 11 | d(tan(X),X,1/cos(X)^2). 12 | d(e^X,X,e^X). 13 | d(A^X,x,A^X*log(e,A)). 14 | d(log(e,X),X,1/X). 15 | d(log(A,X),X,1/(X*log(e,A))). 16 | d(F1+F2,X,A1+A2) :- 17 | d(F1,X,A1), 18 | d(F2,X,A2). 19 | d(F1-F2,X,A1-A2) :- 20 | d(F1,X,A1), 21 | d(F2,X,A2). 22 | 23 | 24 | simple(X^0,1). 25 | simple(X^1,X). 26 | simple(0*X,0). 27 | simple(X*0,0). 28 | simple(1*X,X1) :- simple(X,X1). 29 | simple(X*1,X1) :- simple(X,X1). 30 | simple(0+X,X1) :- simple(X,X1). 31 | simple(X+0,X1) :- simple(X,X1). 32 | simple(X*Y,Z) :- simple(X,X1),not(X=X1),!,simple(X1*Y,Z). 33 | simple(X*Y,Z) :- simple(Y,Y1),not(Y=Y1),!,simple(X*Y1,Z). 34 | simple(X+Y,Z) :- simple(X,X1),not(X=X1),!,simple(X1+Y,Z). 35 | simple(X+Y,Z) :- simple(Y,Y1),not(Y=Y1),!,simple(X+Y1,Z). 36 | simple(X,X). 37 | -------------------------------------------------------------------------------- /example/disj.pl: -------------------------------------------------------------------------------- 1 | test(X) :- 2 | X = 1; 3 | X = 2. 4 | 5 | test1 :- 6 | test(X), 7 | write(X), nl, 8 | fail. 9 | 10 | test2(X) :- 11 | X = a; 12 | X = b; 13 | X = c. 14 | 15 | test3(X) :- 16 | X = 1, !; 17 | X = 2. 18 | 19 | test4 :- 20 | test3(X), 21 | write(X), nl. 22 | 23 | test5 :- 24 | true,true,(fail;true),true. 25 | 26 | test6 :- 27 | true,true,(fail;fail),true. 28 | -------------------------------------------------------------------------------- /example/dna.pl: -------------------------------------------------------------------------------- 1 | %?-data(X),rna_amino(X,Y). 2 | %X = [a,u,g,c,g,c,a,a,u,g,u,g,u,a,a], 3 | %Y = [begin,arg,asn,val,end] 4 | %yes 5 | 6 | %?-rna_amino(X,[begin,arg,asn,val,end]). 7 | %X = [a,u,g,c,g,u,a,a,u,g,u,u,u,a,a] 8 | %yes 9 | 10 | 11 | %?-dna_rna([t,t,g,c,g,a,t],X). 12 | %X = [a,a,c,g,c,u,a] 13 | %yes 14 | 15 | 16 | %?- make_dna([arg,asn,val],X). 17 | %X = [[g,c],[c,g],[a,t],[t,a],[t,a],[a,t],[c,g],[a,t],[a,t]] 18 | %yes 19 | 20 | 21 | %Convert DNA code to amino acid name. 22 | %test data 23 | data([a,u,g,c,g,c,a,a,u,g,u,g,u,a,a]). 24 | 25 | % global variable that indicates whether the conversion is in progress. 26 | % Necessary for judging begin or met (methionine). 27 | trans(off). 28 | 29 | %Convert RNA sequence to amino acid name. Inverse conversion is also possible. 30 | rna_amino([],[]) :- 31 | abolish(trans/1), 32 | assert(trans(off)). 33 | 34 | rna_amino([A,B,C|Xs],[Z|Zs]) :- 35 | dnaward([A,B,C],Z), 36 | trans(on), 37 | rna_amino(Xs,Zs). 38 | 39 | rna_amino([A,B,C|Xs],[Z|Zs]) :- 40 | dnaward([A,B,C],Z), 41 | abolish(trans/1), 42 | assert(trans(on)), 43 | rna_amino(Xs,Zs). 44 | 45 | %RNA and its corresponding amino acid name 46 | dnaward([u,u,u],phe). 47 | dnaward([u,u,c],ala). 48 | dnaward([u,u,a],leu). 49 | dnaward([u,u,g],leu). 50 | dnaward([c,u,u],leu). 51 | dnaward([c,u,c],leu). 52 | dnaward([c,u,a],leu). 53 | dnaward([c,u,g],leu). 54 | dnaward([a,u,u],ile). 55 | dnaward([a,u,c],ile). 56 | dnaward([a,u,a],ile). 57 | dnaward([a,u,g],met) :- trans(on). 58 | dnaward([a,u,g],begin). 59 | dnaward([g,u,u],val). 60 | dnaward([g,u,c],val). 61 | dnaward([g,u,a],val). 62 | dnaward([g,u,g],val). 63 | dnaward([u,c,u],ser). 64 | dnaward([u,c,c],ser). 65 | dnaward([u,c,a],ser). 66 | dnaward([u,c,g],ser). 67 | dnaward([c,c,u],pro). 68 | dnaward([c,c,c],pro). 69 | dnaward([c,c,a],pro). 70 | dnaward([c,c,g],pro). 71 | dnaward([a,c,u],thr). 72 | dnaward([a,c,c],thr). 73 | dnaward([a,c,a],thr). 74 | dnaward([a,c,g],thr). 75 | dnaward([g,c,u],ala). 76 | dnaward([g,c,c],ala). 77 | dnaward([g,c,a],ala). 78 | dnaward([g,c,g],ala). 79 | dnaward([u,a,u],tyr). 80 | dnaward([u,a,c],thr). 81 | dnaward([u,a,a],end). 82 | dnaward([u,a,g],end). 83 | dnaward([c,a,u],his). 84 | dnaward([c,a,c],his). 85 | dnaward([c,a,a],gln). 86 | dnaward([c,a,g],gln). 87 | dnaward([a,a,u],asn). 88 | dnaward([a,a,c],asn). 89 | dnaward([a,a,a],lys). 90 | dnaward([a,a,g],lys). 91 | dnaward([g,a,u],asp). 92 | dnaward([g,a,c],asp). 93 | dnaward([g,a,a],glu). 94 | dnaward([g,a,g],glu). 95 | dnaward([u,g,u],cys). 96 | dnaward([u,g,c],cys). 97 | dnaward([u,g,a],end). 98 | dnaward([u,g,g],trp). 99 | dnaward([c,g,u],arg). 100 | dnaward([c,g,c],arg). 101 | dnaward([c,g,a],arg). 102 | dnaward([c,g,g],arg). 103 | dnaward([a,g,u],ser). 104 | dnaward([a,g,c],ser). 105 | dnaward([a,g,a],arg). 106 | dnaward([a,g,g],arg). 107 | dnaward([g,g,u],gly). 108 | dnaward([g,g,c],gly). 109 | dnaward([g,g,a],gly). 110 | dnaward([g,g,g],gly). 111 | 112 | %Convert DNA sequence (divided into one) to RNA sequence, reverse conversion possible 113 | dna_rna([],[]). 114 | dna_rna([X|Xs],[Z|Zs]) :- 115 | copy_rule(X,Z), 116 | dna_rna(Xs,Zs). 117 | 118 | copy_rule(a,u). 119 | copy_rule(t,a). 120 | copy_rule(g,c). 121 | copy_rule(c,g). 122 | 123 | %A pair of DNA strings is generated from one DNA string. 124 | make_dna_pair([],[]). 125 | make_dna_pair([X|Xs],[Z|Zs]) :- 126 | pair_rule(X,Z), 127 | make_dna_pair(Xs,Zs). 128 | 129 | pair_rule(a,t). 130 | pair_rule(t,a). 131 | pair_rule(g,c). 132 | pair_rule(c,g). 133 | 134 | %Attach two DNA strands into one double helix 135 | conjugate_dna([],[],[]). 136 | conjugate_dna([X|Xs],[Y|Ys],[[X,Y]|Zs]) :- 137 | conjugate_dna(Xs,Ys,Zs). 138 | 139 | %Generate double helix DNA sequence from amino acid name. 140 | make_dna(X,Z) :- 141 | rna_amino(Z1,X), 142 | dna_rna(X1,Z1), 143 | make_dna_pair(X1,X2), 144 | conjugate_dna(X1,X2,Z). 145 | -------------------------------------------------------------------------------- /example/doctor.pl: -------------------------------------------------------------------------------- 1 | /* doctor system from 2 | Prolog to sono ouyou 3 | humio mizoguchi 4 | ISBN-7952-6307-8 5 | */ 6 | flag(dummy). % to avoid existence error 7 | 8 | doctor :- 9 | write('Hi!,I am a doctor'), 10 | nl,tab(3),write('Speak up'), 11 | nl,prog. 12 | 13 | prog :- 14 | reader(X),!,rule(X),assertz((rule(X))),prog. 15 | 16 | 17 | reader(X) :- nl,input(X),nl. 18 | 19 | printer([]). 20 | printer([X|Y]) :- write(X),tab(1),printer(Y). 21 | 22 | 23 | rule([i,am,worried|L]) :- 24 | write('How long have you been worried'), 25 | tab(1),printer(L),tab(1),write('.'). 26 | 27 | rule([stop]) :- 28 | write('I am sorry our time is up.'), 29 | nl,write('Good bye !'),nl,clear,abort. 30 | rule([X]) :- 31 | member(mother,x),!, 32 | write('Tell me more about your family.'), 33 | assert((flag(on))),nl. 34 | 35 | 36 | rule(X) :- 37 | member(computer,X),write('Do machines frighten you.'). 38 | rule([yes]) :- message. 39 | rule([no]) :- message. 40 | rule(X) :- count(X,4), 41 | write('Please do not use Words like that.'). 42 | 43 | rule(X) :- flag(on), 44 | write('Earlier you spoke of your mother'),retract(flag). 45 | rule(X) :- 46 | write('You say so before, too?'). 47 | rule(X) :- member(remember,X),!, 48 | write('you spoke me next, ok!'),stem(Y), 49 | printlist(Y). 50 | rule(X) :- write('I see,tell me more.'),nl. 51 | 52 | message :- write('Please do not be so short with me'). 53 | 54 | count([X|[]],Y) :- name(X,Z),counter(Z,Y). 55 | counter([],0). 56 | counter([X|Y],M) :- counter(Y,N),M is N+1. 57 | 58 | clear :- flag(on),retract((flag(on))). 59 | clear. 60 | 61 | stm(S) :- findall(X,rules(X),S). 62 | 63 | printlist([A|B]) :- write(A),nl,printlist(B). 64 | printlist([]). 65 | 66 | input(X) :- in0(X,[],[]). 67 | in0(X,Y,Z) :- get0(C),test(C,X,Y,Z). 68 | 69 | test(31,X,Y,Z) :- in0(X,[],[]). 70 | test(32,X,Y,[]) :- in0(X,Y,[]). 71 | test(32,X,Y,Z) :- name(X1,Z),append(Y,[X1],Y1),in0(X,Y1,[]). 72 | test(46,X,Y,[]). 73 | test(46,X,Y,Z) :- name(X1,Z),append(Y,[X1],X). 74 | test(C,X,Y,Z) :- append(Z,[C],X1),in0(X,Y,X1). 75 | 76 | 77 | -------------------------------------------------------------------------------- /example/einstein.pl: -------------------------------------------------------------------------------- 1 | /* 2 | http://www.jekejeke.ch/idatab/doclet/prod/docs/10_dev/10_docu/03_interface/07_appendix/01_port/01_einstein.p.html 3 | */ 4 | 5 | rightTo(L, R, [L,R | _]). 6 | rightTo(L, R, [_ | Rest]) 7 | :- rightTo(L, R, Rest). 8 | 9 | nextTo(X, Y, List) :- 10 | rightTo(X, Y, List). 11 | nextTo(X, Y, List) :- 12 | rightTo(Y, X, List). 13 | 14 | einstein(Houses, FishOwner) :- 15 | Houses = [[house,norwegian,_,_,_,_],_,[house,_,_,_,milk,_],_,_], 16 | member([house,brit,_,_,_,red], Houses), 17 | member([house,swede,dog,_,_,_], Houses), 18 | member([house,dane,_,_,tea,_], Houses), 19 | rightTo([house,_,_,_,_,green], [house,_,_,_,_,white], Houses), 20 | member([house,_,_,_,coffee,green], Houses), 21 | member([house,_,bird,pallmall,_,_], Houses), 22 | member([house,_,_,dunhill,_,yellow], Houses), 23 | nextTo([house,_,_,dunhill,_,_], [house,_,horse,_,_,_], Houses), 24 | member([house,_,_,_,milk,_],Houses), 25 | nextTo([house,_,_,marlboro,_,_], [house,_,cat,_,_,_], Houses), 26 | nextTo([house,_,_,marlboro,_,_], [house,_,_,_,water,_], Houses), 27 | member([house,_,_,winfield,beer,_], Houses), 28 | member([house,german,_,rothmans,_,_], Houses), 29 | nextTo([house,norwegian,_,_,_,_], [house,_,_,_,_,blue], Houses), 30 | member([house,FishOwner,fish,_,_,_], Houses). 31 | 32 | test :- einstein(X,Y),write(X),write(Y). 33 | 34 | -------------------------------------------------------------------------------- /example/enigma.pl: -------------------------------------------------------------------------------- 1 | % ?- enigma([h,e,l,l,o],[a,a,a],X). 2 | % ?- enigma([s,i,r,h,d],[a,a,a],X). 3 | 4 | 5 | enigma([],_,[]). 6 | enigma([L|Ls],[R1,R2,R3],[M|Ms]) :- 7 | connecta(L,R3,L1), 8 | ic(L1,L2), 9 | connecta(L2,R2,L3), 10 | iic(L3,L4), 11 | connecta(L4,R1,L5), 12 | iiic(L5,L6), 13 | plug(L6,L7), 14 | iiic(L8,L7), 15 | connectb(L8,R1,L9), 16 | iic(L10,L9), 17 | connectb(L10,R2,L11), 18 | ic(L12,L11), 19 | connectb(L12,R3,M), 20 | count([R1,R2,R3],R), 21 | enigma(Ls,R,Ms). 22 | 23 | %adjust char when forward 24 | connecta(X,Y,Z) :- 25 | char_code(X,Cx), 26 | char_code(Y,Cy), 27 | Cz is mod((Cx-97) + (Cy-97),26)+97, 28 | char_code(Z,Cz). 29 | 30 | %adjust char when backward 31 | connectb(X,Y,Z) :- 32 | char_code(X,Cx), 33 | char_code(Y,Cy), 34 | Cz is mod((Cx-97+26) - (Cy-97),26)+97, 35 | char_code(Z,Cz). 36 | 37 | %count up roter 38 | count([X,Y,z],[X,Y1,a]) :- 39 | Y \== z, 40 | next(Y,Y1). 41 | 42 | count([X,z,z],[X1,a,a]) :- 43 | next(X,X1). 44 | 45 | count([X,Y,Z],[X,Y,Z1]) :- 46 | Z \== z, 47 | next(Z,Z1). 48 | 49 | next(X,Y) :- 50 | char_code(X,C), 51 | C1 is C+1, 52 | char_code(Y,C1). 53 | 54 | %rotor1 55 | %ABCDEFGHIJKLMNOPQRSTUVWXYZ 56 | %DMTWSILRUYQNKFEJCAZBPGXOHV 57 | ic(a,d). 58 | ic(b,m). 59 | ic(c,t). 60 | ic(d,w). 61 | ic(e,s). 62 | ic(f,i). 63 | ic(g,l). 64 | ic(h,r). 65 | ic(i,u). 66 | ic(j,y). 67 | ic(k,q). 68 | ic(l,n). 69 | ic(m,k). 70 | ic(n,f). 71 | ic(o,e). 72 | ic(p,j). 73 | ic(q,c). 74 | ic(r,a). 75 | ic(s,z). 76 | ic(t,b). 77 | ic(u,p). 78 | ic(v,g). 79 | ic(w,x). 80 | ic(x,o). 81 | ic(y,h). 82 | ic(z,v). 83 | 84 | 85 | %rotor2 86 | %ABCDEFGHIJKLMNOPQRSTUVWXYZ 87 | %HQZGPJTMOBLNCIFDYAWVEUSRKX 88 | iic(a,h). 89 | iic(b,q). 90 | iic(c,z). 91 | iic(d,g). 92 | iic(e,p). 93 | iic(f,j). 94 | iic(g,t). 95 | iic(h,m). 96 | iic(i,o). 97 | iic(j,b). 98 | iic(k,l). 99 | iic(l,n). 100 | iic(m,c). 101 | iic(n,i). 102 | iic(o,f). 103 | iic(p,d). 104 | iic(q,y). 105 | iic(r,a). 106 | iic(s,w). 107 | iic(t,v). 108 | iic(u,e). 109 | iic(v,u). 110 | iic(w,s). 111 | iic(x,r). 112 | iic(y,k). 113 | iic(z,x). 114 | 115 | %rotor3 116 | %ABCDEFGHIJKLMNOPQRSTUVWXYZ 117 | %UQNTLSZFMREHDPXKIBVYGJCWOA 118 | iiic(a,u). 119 | iiic(b,q). 120 | iiic(c,n). 121 | iiic(d,t). 122 | iiic(e,l). 123 | iiic(f,s). 124 | iiic(g,z). 125 | iiic(h,f). 126 | iiic(i,m). 127 | iiic(j,r). 128 | iiic(k,e). 129 | iiic(l,h). 130 | iiic(m,d). 131 | iiic(n,p). 132 | iiic(o,x). 133 | iiic(p,k). 134 | iiic(q,i). 135 | iiic(r,b). 136 | iiic(s,v). 137 | iiic(t,y). 138 | iiic(u,g). 139 | iiic(v,j). 140 | iiic(w,c). 141 | iiic(x,w). 142 | iiic(y,o). 143 | iiic(z,a). 144 | 145 | %plug 146 | %ABCDEFGHIJKLMNOPQRSTUVWXYZ 147 | %DPLAXGFMRSOCHZKBYIJVWTUEQN 148 | plug(a,d). 149 | plug(b,p). 150 | plug(c,l). 151 | plug(d,a). 152 | plug(e,x). 153 | plug(f,g). 154 | plug(g,f). 155 | plug(h,m). 156 | plug(i,r). 157 | plug(j,s). 158 | plug(k,o). 159 | plug(l,c). 160 | plug(m,h). 161 | plug(n,z). 162 | plug(o,k). 163 | plug(p,b). 164 | plug(q,y). 165 | plug(r,i). 166 | plug(s,j). 167 | plug(t,v). 168 | plug(u,w). 169 | plug(v,t). 170 | plug(w,u). 171 | plug(x,e). 172 | plug(y,q). 173 | plug(z,n). 174 | -------------------------------------------------------------------------------- /example/fact.pl: -------------------------------------------------------------------------------- 1 | 2 | fact(0,1) :- !. 3 | fact(N,X) :- 4 | N1 is N-1, 5 | fact(N1,X1), 6 | X is N*X1. 7 | -------------------------------------------------------------------------------- /example/fib.pl: -------------------------------------------------------------------------------- 1 | %fibonacci max fib(16,X). 2 | 3 | fib(0,0). 4 | fib(1,1). 5 | fib(N,X) :- 6 | N1 is N-1, 7 | fib(N1,X1), 8 | N2 is N-1, 9 | fib(N2,X2), 10 | X is X1+X2. 11 | 12 | foo(X,Y) :- 13 | X1 is X-1, 14 | X2 is X-2, 15 | mt_and([fib(X1,Y1),fib(X2,Y2)]), 16 | Y is Y1+Y2. 17 | -------------------------------------------------------------------------------- /example/fizzbuzz.pl: -------------------------------------------------------------------------------- 1 | % ?- test(0). 2 | 3 | test(20). 4 | test(N) :- 5 | fizzbuzz(N), 6 | N1 is N+1, 7 | test(N1). 8 | 9 | fizzbuzz(N) :- 10 | N mod 3 =:= 0, 11 | write(fizz). 12 | fizzbuzz(N) :- 13 | N mod 5 =:= 0, 14 | write(buzz). 15 | fizzbuzz(N) :- 16 | N mod 15 =:= 0, 17 | write(fizzbuzz). 18 | fizzbuzz(N) :- 19 | write(N). 20 | -------------------------------------------------------------------------------- /example/gcd.pl: -------------------------------------------------------------------------------- 1 | % parser test from iitaka book 2 | % ?- gcd(D=12*X+23*Y). 3 | 4 | 5 | gcd(A=A*1+0*0). 6 | gcd(D=A*X+B*Y):- 7 | res_q(A=B*Q+R), 8 | (A1,B1)=(B, R), 9 | gcd(D=A1*X1+B1*Y1), 10 | T is X1-Y1*Q, (X,Y) = (Y1,T). 11 | 12 | res_q(A=B*Q+R) :- 13 | Q is A // B, 14 | R is A mod B. 15 | 16 | -------------------------------------------------------------------------------- /example/led.pl: -------------------------------------------------------------------------------- 1 | setup :- 2 | not(flag),wiringpi_setup_gpio,assert(flag), 3 | pin_mode(5,output). 4 | 5 | test(0). 6 | test(N) :- 7 | digital_write(5,1), 8 | delay(1000), 9 | digital_write(5,0), 10 | delay(1000), 11 | N1 is N - 1, 12 | test(N1). 13 | 14 | -------------------------------------------------------------------------------- /example/length.pl: -------------------------------------------------------------------------------- 1 | % length naive definition. it has problem when backtrack. 2 | 3 | len([],0). 4 | len([L|Ls],N) :- len(Ls,N1),N is N1+1. 5 | -------------------------------------------------------------------------------- /example/lisp.pl: -------------------------------------------------------------------------------- 1 | %Lisp in Prolog 2 | fun(1,2,3). %dummy to avoid existence error 3 | 4 | repl :- 5 | repeat, 6 | write('> '), 7 | read(X), 8 | eval(X,Y,[]), 9 | write(Y),nl, 10 | (X=[quit]->true;fail). 11 | 12 | eval(X,X,E) :- 13 | integer(X). 14 | eval(X,X,E) :- 15 | float(X). 16 | eval(X,Y,E) :- 17 | atom(X), 18 | assoc(X,E,Y). 19 | eval(X,Y,E) :- 20 | atom(X), 21 | global(X,Y). 22 | eval([quit],t,E). 23 | eval([defun,F,A,B],t,E) :- 24 | assert(fun(F,A,B)). 25 | eval([setq,X,Y],t,E) :- 26 | eval(Y,Z,E), 27 | assert(global(X,Z)). 28 | eval(X,Y,E) :- 29 | funcall(X,Y,E). 30 | 31 | funcall([F|A1],Z,E) :- 32 | fun(F,A,B), 33 | argument(A,A1,Y), 34 | append(Y,E,E1), 35 | eval(B,Z,E1). 36 | funcall([+,X,Y],Z,E) :- 37 | eval(X,X1,E), 38 | eval(Y,Y1,E), 39 | Z is X1+Y1. 40 | funcall([-,X,Y],Z,E) :- 41 | eval(X,X1,E), 42 | eval(Y,Y1,E), 43 | Z is X1-Y1. 44 | funcall([*,X,Y],Z,E) :- 45 | eval(X,X1,E), 46 | eval(Y,Y1,E), 47 | Z is X1*Y1. 48 | funcall([/,X,Y],Z,E) :- 49 | eval(X,X1,E), 50 | eval(Y,Y1,E), 51 | Z is X1/Y1. 52 | 53 | assoc(X,[],Z) :- fail. 54 | assoc(X,[[X|Y]|Ys],Y). 55 | assoc(X,[_|Ys],Z) :- 56 | assoc(X,Ys,Z). 57 | 58 | 59 | 60 | argument([X],[Y],[X|Y]). 61 | argument([X|Xs],[Y|Ys],[[X|Y],Z]) :- 62 | argument(Xs,Ys,Z). 63 | 64 | 65 | global(t,t). 66 | global(nil,nil). 67 | 68 | -------------------------------------------------------------------------------- /example/list.pl: -------------------------------------------------------------------------------- 1 | % list tests from M.Hiroi's page 2 | 3 | my_flatten([X | Xs], Ys) :- 4 | my_flatten(X, Ys1), my_flatten(Xs, Ys2), append(Ys1, Ys2, Ys). 5 | my_flatten(X, [X]) :- atomic(X), X \== []. 6 | my_flatten([], []). 7 | 8 | %? my_flatten([a, [b, [c], d], [e, f]], X). 9 | %? my_flatten([[a, b], [], [c, d]], X). 10 | 11 | take_integer([X | Xs], Ys) :- 12 | take_integer(X, Ys1), take_integer(Xs, Ys2), append(Ys1, Ys2, Ys). 13 | take_integer(X, [X]) :- integer(X). 14 | take_integer(X, []). 15 | 16 | %? take_integer([1, a, [2, b]], X). 17 | 18 | -------------------------------------------------------------------------------- /example/math.pl: -------------------------------------------------------------------------------- 1 | foo(N) :- 2 | N1 is N+1,foo(N1). 3 | 4 | 5 | divisor(N,L) :- 6 | divisor1(N,N,L). 7 | 8 | divisor1(N,0,[]). 9 | divisor1(N,M,[M|L]) :- 10 | 0 is N mod M, 11 | M1 is M-1, 12 | divisor1(N,M1,L). 13 | divisor1(N,M,L) :- 14 | M1 is M-1, 15 | divisor1(N,M1,L). 16 | 17 | 18 | perfect(N) :- 19 | divisor(N,[L|Ls]), 20 | sigma(Ls,M),!, 21 | N == M. 22 | 23 | sigma([],0). 24 | sigma([L|Ls],N) :- 25 | sigma(Ls,M), 26 | N is L+M. -------------------------------------------------------------------------------- /example/maze.pl: -------------------------------------------------------------------------------- 1 | /* 2 | dice puzzle 3 | 4 | ?- solve. 5 | see https://qiita.com/sym_num/items/bc8bfb67fde98ce3787d 6 | */ 7 | 8 | 9 | data([[1,4,1,3,6,3,1,4,6,6,2,1,5,6,2,1,1,4], 10 | [5,4,2,4,5,5,5,5,5,3,2,3,5,4,2,3,5,5], 11 | [6,4,1,1,1,4,6,4,3,5,4,2,4,1,5,6,6,4], 12 | [2,4,2,3,5,5,1,2,6,2,6,5,1,2,6,3,2,2], 13 | [1,1,6,3,1,4,1,3,6,4,3,4,3,5,4,2,1,3], 14 | [5,3,2,5,1,2,5,5,1,2,1,2,6,1,3,6,6,5], 15 | [1,6,1,4,6,3,6,4,6,4,3,3,1,2,3,5,3,4], 16 | [2,2,6,5,1,2,2,5,5,5,6,5,1,2,6,2,1,2], 17 | [6,3,6,4,6,4,1,3,1,1,3,4,3,5,3,2,4,4], 18 | [5,5,5,4,2,3,5,4,2,3,1,2,6,6,1,6,1,5], 19 | [1,4,6,3,1,4,6,3,1,6,4,3,4,2,4,5,1,3], 20 | [5,2,1,5,6,2,2,4,5,3,6,5,1,2,6,5,1,2], 21 | [6,3,6,4,1,3,6,3,6,1,6,4,3,5,3,2,4,4], 22 | [2,5,2,4,2,5,1,2,5,4,2,3,6,6,3,1,4,6], 23 | [1,4,1,1,6,3,1,3,6,6,1,6,3,2,5,5,2,5], 24 | [1,5,6,3,5,3,5,4,2,3,5,4,3,1,4,6,4,1], 25 | [3,1,3,6,3,3,6,3,1,1,2,1,6,3,2,1,5,6], 26 | [6,5,1,2,6,5,1,5,1,2,6,5,5,3,2,4,5,3]]). 27 | 28 | aref(R,C,X) :- 29 | data(M), 30 | row(R,M,V), 31 | col(C,V,X). 32 | 33 | row(0,[V|Vs],V). 34 | row(N,[V|Vs],X) :- 35 | N1 is N-1, 36 | row(N1,Vs,X). 37 | 38 | col(0,[E|Es],E). 39 | col(N,[E|Es],X) :- 40 | N1 is N-1, 41 | col(N1,Es,X). 42 | 43 | diceU([F,B,U,D,L,R],[D,U,F,B,L,R]). 44 | diceD([F,B,U,D,L,R],[U,D,B,F,L,R]). 45 | diceL([F,B,U,D,L,R],[R,L,U,D,F,B]). 46 | diceR([F,B,U,D,L,R],[L,R,U,D,B,F]). 47 | 48 | %initial dice 49 | dice([1,6,5,2,4,3]). 50 | 51 | solve :- abolish(arrive/3),assert(arrive(-1,-1,-1)),dice(X),solve1(0,0,X,[]). 52 | 53 | solve1(17,17,X,Root) :- write(Root). 54 | 55 | %goto up 56 | solve1(S,T,X,Root) :- 57 | S > 0, 58 | S1 is S - 1, 59 | not(arrive(S,T,down)), 60 | not(arrive(S1,T,up)), 61 | diceU(X,[F,B,U,D,L,R]), 62 | aref(S1,T,F), 63 | assertz(arrive(S1,T,up)), 64 | solve1(S1,T,[F,B,U,D,L,R],[[[S1,T],F]|Root]). 65 | 66 | %goto right 67 | solve1(S,T,X,Root) :- 68 | T < 17, 69 | T1 is T + 1, 70 | not(arrive(S,T,left)), 71 | not(arrive(S,T1,right)), 72 | diceR(X,[F,B,U,D,L,R]), 73 | aref(S,T1,F), 74 | assertz(arrive(S,T1,right)), 75 | solve1(S,T1,[F,B,U,D,L,R],[[[S,T1],F]|Root]). 76 | 77 | %goto down 78 | solve1(S,T,X,Root) :- 79 | S < 17, 80 | S1 is S + 1, 81 | not(arrive(S,T,up)), 82 | not(arrive(S1,T,down)), 83 | diceD(X,[F,B,U,D,L,R]), 84 | aref(S1,T,F), 85 | assertz(arrive(S1,T,down)), 86 | solve1(S1,T,[F,B,U,D,L,R],[[[S1,T],F]|Root]). 87 | 88 | %goto left 89 | solve1(S,T,X,Root) :- 90 | T > 0, 91 | T1 is T - 1, 92 | not(arrive(S,T,right)), 93 | not(arrive(S,T1,left)), 94 | diceL(X,[F,B,U,D,L,R]), 95 | aref(S,T1,F), 96 | assertz(arrive(S,T1,left)), 97 | solve1(S,T1,[F,B,U,D,L,R],[[[S,T1],F]|Root]). 98 | 99 | -------------------------------------------------------------------------------- /example/measure.pl: -------------------------------------------------------------------------------- 1 | /* 2 | example for raspberry Pi3 3 | use ultrasonic sensor 4 | */ 5 | 6 | setup :- 7 | wiringpi_setup_gpio(X), 8 | pin_mode(23,output), 9 | pin_mode(24,input), 10 | digital_write(23,0), 11 | delay(1000). 12 | 13 | nmeasure(X) :- 14 | digital_write(23,1), 15 | delay_microseconds(11), 16 | digital_write(23,0), 17 | read_wait(1), 18 | timer_microseconds(on), 19 | read_wait(0), 20 | timer_microseconds(off), 21 | timer_microseconds(T), 22 | X is T * 34000 /2. 23 | 24 | read_wait(X) :- 25 | repeat, 26 | digital_read(24,Y), 27 | X == Y,!. 28 | -------------------------------------------------------------------------------- /example/monkey.pl: -------------------------------------------------------------------------------- 1 | % monkey and banana from Bratko's book 2 | 3 | move(state(middle,onbox,middle,hasnot), 4 | grasp, 5 | state(middle,onbox,middle,has)). 6 | 7 | move(state(P,onfloor,P,H), 8 | climb, 9 | state(P,onbox,P,H)). 10 | 11 | move(state(P1,onfloor,P1,H), 12 | push(P1,P2), 13 | state(P2,onfloor,P2,H)). 14 | 15 | move(state(P1,onfloor,B,H), 16 | walk(P1,P2), 17 | state(P2,onfloor,B,H)). 18 | 19 | canget(state(_,_,_,has)). 20 | canget(State1) :- 21 | move(State1,Move,State2), 22 | write(Move), 23 | canget(State2). 24 | 25 | 26 | %canget(state(atdoor,onfloor,atwindow,hasnot)). 27 | -------------------------------------------------------------------------------- /example/one-stroke.pl: -------------------------------------------------------------------------------- 1 | %one-stroke 2 | 3 | 4 | root(a,b,ab). 5 | root(b,c,bc). 6 | root(b,d,bd). 7 | root(b,e,be). 8 | root(c,e,ce). 9 | root(c,d,cd). 10 | root(d,e,de). 11 | root(e,a,ae). 12 | 13 | node([a,b,c,d,e]). 14 | edge([ab,bc,bd,be,ce,cd,de,ae]). 15 | 16 | run :- node(N),solve(N). 17 | 18 | solve([]). 19 | solve([N|Ns]) :- 20 | edge(E),solve1(N,E,[N]). 21 | solve([N|Ns]) :- 22 | solve(Ns). 23 | 24 | solve1(X,[],R) :- reverse(R,R1),write(R1),nl,fail. 25 | solve1(X,E,R) :- 26 | root(X,Y,E1), 27 | delete1(E,E1,E2), 28 | solve1(Y,E2,[Y|R]). 29 | 30 | solve1(X,E,R) :- 31 | root(Y,X,E1), 32 | delete1(E,E1,E2), 33 | solve1(Y,E2,[Y|R]). 34 | 35 | delete1([X|Xs],X,Xs). 36 | delete1([X|Xs],Y,[X|Z]) :- 37 | delete1(Xs,Y,Z). 38 | -------------------------------------------------------------------------------- /example/paip.pl: -------------------------------------------------------------------------------- 1 | %from PAIP example. 2 | 3 | 4 | likes(kim,robin). 5 | likes(sandy,lee). 6 | likes(sandy,kim). 7 | likes(robin,cats). 8 | likes(sandy,X) :- likes(X,cats). 9 | likes(kim,X) :- likes(X,lee),likes(X,kim). 10 | likes(X,X). 11 | 12 | /* 13 | ?- likes(sandy,Who). 14 | Who = lee; 15 | Who = kim; 16 | Who = robin; 17 | Who = sandy; 18 | Who = cats; 19 | Who = sandy; 20 | false 21 | */ -------------------------------------------------------------------------------- /example/pp.pl: -------------------------------------------------------------------------------- 1 | 2 | %prolog in prolog 3 | 4 | pp :- 5 | repeat, 6 | nl,write(': ?- '), 7 | read(X), 8 | (X=halt -> abort;true), 9 | (my_call(X) -> write(yes);write(no)), 10 | fail. 11 | 12 | %builtin 13 | my_call(X) :- 14 | predicate_property(X,built_in), 15 | call(X). 16 | %user predicate 17 | my_call(X) :- 18 | predicate_property(X,dynamic), 19 | clause(X,true), 20 | write(X), 21 | get(D), %discard EOL 22 | get(Z), 23 | (not(Z = ';') -> true;fail). 24 | %user clause 25 | my_call(X) :- 26 | predicate_property(X,dynamic), 27 | clause(X,Y), 28 | Y \= true, 29 | my_call(Y), 30 | write(X), 31 | get(D), %discard EOL 32 | get(Z), 33 | (not(Z = ';') -> true;fail). 34 | %variable 35 | my_call(X) :- 36 | var(X), 37 | call(X). 38 | %conjunction 39 | my_call((X,Y)) :- 40 | call(X), 41 | my_call(Y). 42 | %disjunction 43 | my_call((X;Y)) :- 44 | call(X),!. 45 | my_call((X;Y)) :- 46 | call(Y). -------------------------------------------------------------------------------- /example/production.pl: -------------------------------------------------------------------------------- 1 | /* 2 | toy production system 3 | | ?-reaction([c,h2,o2,o2,h2,],Y). 4 | [ch4,o2,o2] 5 | [co2,h2o,h2o] 6 | Y = [co2,h2o,h2o] 7 | yes 8 | | 9 | */ 10 | 11 | reaction(X,Y) :- 12 | rule(X,Y). 13 | 14 | 15 | rule(X,Y) :- 16 | check(c,1,X), 17 | check(h2,2,X), 18 | remove(c,1,X,X1), 19 | remove(h2,2,X1,X2), 20 | append([ch4],X2,Z), 21 | write(Z),nl, 22 | rule(Z,Y). 23 | 24 | rule(X,Y) :- 25 | check(c,1,X), 26 | check(o2,1,X), 27 | remove(c,1,X,X1), 28 | remove(o2,1,X1,X2), 29 | append([co2],X2,Z), 30 | write(Z),nl, 31 | rule(Z,Y). 32 | 33 | 34 | rule(X,Y) :- 35 | check(h2,2,X), 36 | check(o2,1,X), 37 | remove(h2,2,X,X1), 38 | remove(o2,1,X1,X2), 39 | append([h2o,h2o],X2,Z), 40 | write(Z),nl, 41 | rule(Z,Y). 42 | 43 | 44 | rule(X,Y) :- 45 | check(ch4,1,X), 46 | check(o2,2,X), 47 | remove(ch4,1,X,X1), 48 | remove(o2,2,X1,X2), 49 | append([co2,h2o,h2o],X2,Z), 50 | write(Z),nl, 51 | rule(Z,Y). 52 | 53 | rule(X,X). 54 | 55 | check(A,B,X) :- 56 | count(A,C,X), 57 | C >= B. 58 | 59 | 60 | count(A,0,[]). 61 | count(A,C,[A|L]) :- 62 | count(A,C1,L), 63 | C is C1 + 1. 64 | count(A,C,[L|Ls]) :- 65 | count(A,C,Ls). 66 | 67 | 68 | remove(A,0,L,L). 69 | remove(A,B,[A|L],Y) :- 70 | B1 is B - 1, 71 | remove(A,B1,L,Y). 72 | remove(A,B,[L|Ls],[L|Y]) :- 73 | remove(A,B,Ls,Y). 74 | -------------------------------------------------------------------------------- /example/prover.pl: -------------------------------------------------------------------------------- 1 | /* 2 | toy prover 3 | | ?- proof(a=>b=>a). 4 | rule7 rule5 rule6 rule7 rule5 rule6 yes 5 | | 6 | 7 | */ 8 | 9 | 10 | :- op(800,xfy,=>). 11 | :- op(700,xfy,v). 12 | :- op(600,xfy,&). 13 | :- op(500,fy,~). 14 | 15 | 16 | proof(X) :- cnf(X,Y),tautology(Y). 17 | 18 | %Logical expressions are represented by symbolic atoms 19 | cnf(X,X) :- atomic(X). 20 | %De Morgans law 21 | cnf(~(X & Y),Z) :- write('rule1 '),cnf(~X v ~Y,Z). 22 | 23 | %The rule of double negation 24 | cnf(~ ~ X,Z) :- write('rule2 '),cnf(X,Z). 25 | 26 | 27 | %Distribution rule 28 | cnf((A & B) v (A & C),Z) :- 29 | write('rule3 '),cnf(A & (B v C),Z). 30 | 31 | %Recursive structure 32 | cnf(X & Y,X1 & Y1) :- write('rule4 '),cnf(X,X1),cnf(Y,Y1). 33 | 34 | cnf(X v Y,X1 v Y1) :- write('rule5 '),cnf(X,X1),cnf(Y,Y1). 35 | 36 | cnf(~ X,~ Z) :- write('rule6 '),cnf(X,Z). 37 | 38 | %Implication 39 | cnf(X => Y,Z) :- write('rule7 '),cnf(~X v Y,Z). 40 | 41 | 42 | %tautology 43 | tautology(X & Y) :- or_tautology(X),tautology(Y). 44 | tautology(X) :- or_tautology(X). 45 | 46 | %Complementary check of partial logical expressions 47 | or_tautology(X v Y) :- complement(~X,Y). 48 | or_tautology(~X v Y) :- complement(X,Y). 49 | 50 | %Complementary 51 | complement(X,X). 52 | complement(X,X v _). 53 | complement(X,Y v Ys) :- complement(X,Ys). 54 | -------------------------------------------------------------------------------- /example/quarternion.pl: -------------------------------------------------------------------------------- 1 | /* quantum-number iitaka p41*/ 2 | 3 | :- op(700,xfx,isq). 4 | 5 | X isq q(R1,I1,J1,K1)+q(R2,I2,J2,K2) :- 6 | R is R1 + R2, 7 | I is I1 + I2, 8 | J is J1 + J2, 9 | K is K1 + K2, 10 | X = q(R,I,J,K). 11 | 12 | 13 | X isq q(R1,I1,J1,K1)-q(R2,I2,J2,K2) :- 14 | R is R1 - R2, 15 | I is I1 - I2, 16 | J is J1 - J2, 17 | K is K1 - K2, 18 | X = q(R,I,J,K). 19 | 20 | X isq q(R1,I1,J1,K1)*q(R2,I2,J2,K2) :- 21 | R is R1*R2 - I1*I2 - J1*J2 - K1*K2, 22 | I is R1*I2 + I1*R2 + J1*K2 - K1*J2, 23 | J is R1*J2 - I1*K2 + J1*R2 + K1*I2, 24 | K is R1*K2 + I1*J2 - J1*I2 + K1*R2, 25 | X= q(R,I,J,K). 26 | 27 | X isq q(R1,I1,J1,K1)/q(R2,I2,J2,K2) :- 28 | I3 is -I2, 29 | J3 is -J2, 30 | K3 is -K2, 31 | q(R4,I4,J4,K4) isq q(R1,I1,J1,K1)*q(R2,I3,J3,K3), 32 | D is (R2^2) + (I2^2) + (J2^2) + (K2^2), 33 | R is R4/D, 34 | I is I4/D, 35 | J is J4/D, 36 | K is K4/D, 37 | X = q(R,I,J,K). 38 | 39 | X isq conjugate(q(R,I,J,K)) :- 40 | X = q(R,-I,-J,-K). 41 | 42 | -------------------------------------------------------------------------------- /example/record.pl: -------------------------------------------------------------------------------- 1 | %example of recordz 2 | 3 | db_load(Fname,Key) :- 4 | open(H,Fname,r), 5 | get0(H,X), 6 | (x == 26, 7 | close(H); 8 | gets(H,X,L), 9 | name(M,L), 10 | atom_string(M,S), 11 | string_term(S,T), 12 | recordz(Key,T,_), 13 | fail). 14 | 15 | gets(_,10,_) :-!,fail. 16 | gets(_,13,[]) :-!. 17 | gets(H,X,[X|L]) :- 18 | get0(H,Z), 19 | gets(H,Z,L). 20 | 21 | 22 | test1 :- 23 | recordz(client,client(jones,life,00245),Refnum), 24 | recordh(alphabet,jones,Refnum), 25 | recordh(insurance,life,Refnum). 26 | 27 | test2 :- 28 | retrieveh(alphabet,jones,Refnum), 29 | instance(Refnum,X), 30 | write(X). 31 | 32 | test3 :- 33 | eraseall(foo), 34 | recordz(foo,foo(a,1),_), 35 | recordz(foo,foo(b,2),_), 36 | recorda(foo,foo(c,3),Ref), 37 | recorda(foo,foo(d,4),_), 38 | record_after(Ref,foo(e,5),_). 39 | 40 | test4 :- 41 | key(foo/2), 42 | key(foo,Ref), 43 | nref(Ref,Ref1), 44 | nref(Ref1,Ref2), 45 | nref(Ref2,Ref3), 46 | nref(Ref3,Ref4), 47 | not nref(Ref4,Ref5), 48 | pref(Ref4,Ref3), 49 | pref(Ref3,Ref2), 50 | pref(Ref2,Ref1), 51 | pref(Ref1,Ref). 52 | 53 | test5 :- 54 | recorded(foo,foo(c,3),R1), 55 | replace(R1,foo(f,6)). 56 | 57 | -------------------------------------------------------------------------------- /example/repeat.pl: -------------------------------------------------------------------------------- 1 | repeat0. 2 | repeat0 :- repeat0. 3 | 4 | test :- 5 | repeat, 6 | write(a), 7 | fail. 8 | -------------------------------------------------------------------------------- /example/sazaesan.pl: -------------------------------------------------------------------------------- 1 | 親子(波平,サザエ). 2 | 親子(ふね,サザエ). 3 | 親子(波平,カツオ). 4 | 親子(ふね,カツオ). 5 | 親子(波平,ワカメ). 6 | 親子(ふね,ワカメ). 7 | 親子(マスオ,タラオ). 8 | 親子(サザエ,タラオ). 9 | 10 | 夫婦(波平,ふね). 11 | 夫婦(マスオ,サザエ). 12 | -------------------------------------------------------------------------------- /example/tamura.pl: -------------------------------------------------------------------------------- 1 | /* 2 | from Mr. tamura's page (koube university) 3 | */ 4 | 5 | %https://tamura70.gitlab.io/web-prolog/intro/nat.html 6 | 7 | nat(0). 8 | nat(s(X)) :- nat(X). 9 | 10 | plus(0, Y, Y). 11 | plus(s(X), Y, s(Z)) :- plus(X, Y, Z). 12 | 13 | times(0, _, 0). 14 | times(s(X), Y, Z) :- times(X, Y, Z1), plus(Z1, Y, Z). 15 | 16 | le(X, Y) :- plus(X, _, Y). 17 | 18 | lt(X, Y) :- le(s(X), Y). 19 | 20 | quot(X, Y, 0, X) :- lt(X, Y). 21 | quot(X, Y, s(Q), R) :- plus(Y, X1, X), quot(X1, Y, Q, R). 22 | 23 | prime(s(X)) :- df(X, s(X)). 24 | 25 | df(s(0), _). 26 | df(s(s(M)), N) :- dnd(s(s(M)), N), df(s(M), N). 27 | 28 | dnd(M, N) :- quot(N, M, _, s(_)). 29 | 30 | %?- nat(N), prime(N). 31 | /* 32 | ?- [-'tests/tamura.pl']. 33 | yes 34 | ?- nat(N),prime(N). 35 | N = s(s(0)) ; 36 | N = s(s(s(0))) ; 37 | N = s(s(s(s(s(0))))) ; 38 | N = s(s(s(s(s(s(s(0))))))) ; 39 | N = s(s(s(s(s(s(s(s(s(s(s(0))))))))))) ; 40 | N = s(s(s(s(s(s(s(s(s(s(s(s(s(0))))))))))))) ; 41 | N = s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(0))))))))))))))))) ; 42 | N = s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(s(0))))))))))))))))))) . 43 | yes 44 | ?- 45 | */ 46 | 47 | %https://tamura70.gitlab.io/web-prolog/intro/search.html 48 | 49 | arc(a1, v1, v2). 50 | arc(a2, v2, v3). 51 | arc(a3, v3, v4). 52 | arc(a4, v4, v1). 53 | arc(a5, v3, v5). 54 | 55 | walk(U, U). 56 | walk(U, V) :- arc(_, U, U1), walk(U1, V). 57 | 58 | path(U, U, _, []). 59 | path(U, V, L, [A|P]) :- 60 | arc(A, U, U1), 61 | not(member(U1, L)), 62 | path(U1, V, [U1|L], P). 63 | 64 | path_find(U, V, P) :- path(U, V, [U], P). 65 | 66 | /* 67 | ?- [-'tests/tamura.pl']. 68 | yes 69 | ?- path_find(v1, v5, P). 70 | P = [a1,a2,a5] . 71 | yes 72 | ?- 73 | */ 74 | 75 | %https://tamura70.gitlab.io/web-prolog/intro/compile.html 76 | 77 | % 78 | % 簡単なコンパイラ 79 | % 80 | 81 | % 82 | % 命令文のコンパイル 83 | % 84 | c(X = A) :- 85 | !, 86 | c_assign(X, A). 87 | 88 | % 代入命令 89 | c_assign(X, A) :- 90 | atom(X), 91 | !, 92 | c_exp(A), 93 | instr('ST', ['GR1',X]). 94 | c_assign(_, _) :- 95 | write('代入命令の左辺は変数でなければならない'), 96 | fail. 97 | 98 | % 99 | % 式のコンパイル 100 | % 101 | c_exp(A) :- 102 | integer(A), 103 | !, 104 | instr('LEA', ['GR1',A]). 105 | c_exp(A) :- 106 | atom(A), 107 | !, 108 | instr('LD', ['GR1',A]). 109 | c_exp(A + B) :- 110 | !, 111 | c_exp(B), 112 | instr('PUSH', [0,'GR1']), 113 | c_exp(A), 114 | instr('ADD', ['GR1',0,'GR4']), 115 | instr('POP', ['GR0']). 116 | 117 | % 118 | % CASL命令の表示 119 | % 120 | instr(Instr, Args) :- 121 | put(9), 122 | write(Instr), 123 | put(9), 124 | instr_args(Args), 125 | nl. 126 | 127 | instr_args([]). 128 | instr_args([A]) :- 129 | !, 130 | write(A). 131 | instr_args([A|Args]) :- 132 | write(A), 133 | write(','), 134 | instr_args(Args). 135 | 136 | /* 137 | ?- [-'tests/tamura.pl']. 138 | yes 139 | ?- c(a = x + y + 123). 140 | LEA GR1,123 141 | PUSH 0,GR1 142 | LD GR1,y 143 | PUSH 0,GR1 144 | LD GR1,x 145 | ADD GR1,0,GR4 146 | POP GR0 147 | ADD GR1,0,GR4 148 | POP GR0 149 | ST GR1,a 150 | yes 151 | ?- 152 | */ -------------------------------------------------------------------------------- /example/taxi.pl: -------------------------------------------------------------------------------- 1 | /* 2 | The Hardy–Ramanujan number 3 | Originaly written by 犬童, modified by K.Sasagawa 4 | ?- r(X,Y,Z). 5 | X = 1729 6 | Y = 12 7 | Z = [[1,12],[9,10]] 8 | yes 9 | */ 10 | 11 | 12 | i(X,Y) :- length(L,Y),count(L,X). 13 | 14 | count(L,N) :- 15 | length(L,N). 16 | count([L|Ls],N) :- 17 | count(Ls,N). 18 | 19 | 20 | c( X, Z, Y):- i( Z, Y), X is Z ^3. 21 | 22 | d( X, Y, [Z, W]):- 23 | c( P, Z, Y), 24 | c( Q, W, Y), 25 | P < Q, 26 | X is P + Q. 27 | 28 | 29 | r(X, Y, [Z, W]):- 30 | d(X, Y, Z), 31 | d(X, Y, W), 32 | Z @< W . -------------------------------------------------------------------------------- /example/turing.pl: -------------------------------------------------------------------------------- 1 | /* 2 | Turing machine in prolog 3 | from Dr. Kaname Yoshida's book 4 | 5 | tm(State,Position,Tape). 6 | state: q0.q1...qN) 7 | position: start from 1 8 | tape: list 9 | 10 | ?- tm(q0,2,[0,1,1,1,0,1,1,1,1,0]). 11 | this calculates 2+3=5 12 | */ 13 | 14 | tm(q0,P,T) :- 15 | nth(P,T,1), 16 | state(q0,P,T), 17 | P1 is P+1, 18 | tm(q0,P1,T). 19 | tm(q0,P,T) :- 20 | nth(P,T,0), 21 | state(q0,P,T), 22 | set(P,T,1,T1), 23 | tm(q1,P,T1). 24 | tm(q1,P,T) :- 25 | nth(P,T,1), 26 | state(q1,P,T), 27 | P1 is P-1, 28 | tm(q1,P1,T). 29 | tm(q1,P,T) :- 30 | nth(P,T,0), 31 | state(q1,P,T), 32 | P1 is P+1, 33 | tm(q2,P1,T). 34 | tm(q2,P,T) :- 35 | nth(P,T,1), 36 | state(q2,P,T), 37 | set(P,T,0,T1), 38 | tm(q3,P,T1). 39 | tm(q3,P,T) :- 40 | nth(P,T,0), 41 | state(q3,P,T), 42 | P1 is P+1, 43 | tm(q4,P1,T). 44 | tm(q4,P,T) :- 45 | nth(P,T,1), 46 | state(q4,P,T), 47 | set(P,T,0,T1), 48 | tm(q5,P,T1). 49 | tm(q5,P,T) :- 50 | nth(P,T,0), 51 | state(q5,P,T), 52 | P1 is P+1, 53 | tm(qf,P1,T). 54 | tm(qf,P,T) :- 55 | state(qf,P,T). 56 | 57 | 58 | 59 | nth(1,[X|_],X). 60 | nth(N,[_|Xs],Y) :- 61 | N>1, 62 | N1 is N-1, 63 | nth(N1,Xs,Y). 64 | 65 | set(1,[_|Ls],X,[X|Ls]). 66 | set(N,[L|Ls],X,[L|Y]) :- 67 | N>1, 68 | N1 is N-1, 69 | set(N1,Ls,X,Y). 70 | 71 | state(S,P,T) :- 72 | P1 is P*2, 73 | tab(P1), 74 | write(S),nl, 75 | write(T),nl. 76 | 77 | -------------------------------------------------------------------------------- /example/utf8.pl: -------------------------------------------------------------------------------- 1 | %test for east asian language 2 | 3 | %Tai 4 | tai :- write(ขอบคุณ). 5 | 6 | %tamil 7 | tamil :- write(நன்றி). 8 | 9 | %arabian 10 | arabian :- write(شكرًا لك). 11 | 12 | %russian 13 | russian :- write(Спасибо). 14 | 15 | %hebrew 16 | hebrew :- write(תודה לך). 17 | -------------------------------------------------------------------------------- /example/zebra.pl: -------------------------------------------------------------------------------- 1 | % zebra puzzle 2 | % https://coursys.sfu.ca/2018fa-cmpt-384-d1/pages/ZebraPuzzle 3 | % Thanks to SFU 4 | %h(Nationality, Pet, Cigarette, Drink, Color) 5 | zebra_owner(Owner) :- 6 | houses(Hs), 7 | member(h(Owner,zebra,_,_,_), Hs). 8 | 9 | water_drinker(Drinker) :- 10 | houses(Hs), 11 | member(h(Drinker,_,_,water,_), Hs). 12 | 13 | 14 | houses(Hs) :- 15 | length(Hs, 5), % 1 16 | member(h(english,_,_,_,red), Hs), % 2 17 | member(h(spanish,dog,_,_,_), Hs), % 3 18 | member(h(_,_,_,coffee,green), Hs), % 4 19 | member(h(ukrainian,_,_,tea,_), Hs), % 5 20 | adjacent(h(_,_,_,_,green), h(_,_,_,_,white), Hs), % 6 21 | member(h(_,snake,winston,_,_), Hs), % 7 22 | member(h(_,_,kool,_,yellow), Hs), % 8 23 | Hs = [_,_,h(_,_,_,milk,_),_,_], % 9 24 | Hs = [h(norwegian,_,_,_,_)|_], % 10 25 | adjacent(h(_,fox,_,_,_), h(_,_,chesterfield,_,_), Hs), % 11 26 | adjacent(h(_,_,kool,_,_), h(_,horse,_,_,_), Hs), % 12 27 | member(h(_,_,lucky,juice,_), Hs), % 13 28 | member(h(japanese,_,kent,_,_), Hs), % 14 29 | adjacent(h(norwegian,_,_,_,_), h(_,_,_,_,blue), Hs), % 15 30 | member(h(_,_,_,water,_), Hs), % one of them drinks water 31 | member(h(_,zebra,_,_,_), Hs). % one of them owns a zebra 32 | 33 | adjacent(A, B, Ls) :- append(_, [A,B|_], Ls). 34 | adjacent(A, B, Ls) :- append(_, [B,A|_], Ls). 35 | 36 | 37 | test :- between(1,1000,N),zebra_owner(O),fail. 38 | 39 | /* 40 | Queries 41 | ?- zebra_owner(Owner). 42 | 43 | ?- water_drinker(Drinker). 44 | 45 | ?- houses(Houses). 46 | */ -------------------------------------------------------------------------------- /gbc.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include "npl.h" 7 | 8 | 9 | //---------garbage collection----------- 10 | void gbc(void) 11 | { 12 | int addr; 13 | 14 | if (gbc_flag) { 15 | printf("enter GBC free=%d\n", fc); 16 | fflush(stdout); 17 | } 18 | gc++; 19 | 20 | gbcmark(); 21 | gbcsweep(); 22 | fc = 0; 23 | for (addr = 0; addr < HEAPSIZE; addr++) 24 | if (IS_EMPTY(addr)) 25 | fc++; 26 | if (gbc_flag) { 27 | printf("exit GBC free=%d\n", fc); 28 | fflush(stdout); 29 | } 30 | } 31 | 32 | 33 | void markcell(int addr) 34 | { 35 | 36 | if (IS_ALPHA(addr)) { 37 | return; 38 | } 39 | if (IS_OUTCELL(addr)) 40 | return; 41 | 42 | if (USED_CELL(addr)) 43 | return; 44 | 45 | if (addr == 0) 46 | return; //NIL 47 | 48 | MARK_CELL(addr); 49 | switch (GET_TAG(addr)) { 50 | case EMP: 51 | case INTN: 52 | case FLTN: 53 | case LONGN: 54 | return; 55 | case STREAM: 56 | markcell(cdr(addr)); 57 | return; 58 | case SINGLE: 59 | markcell(car(addr)); 60 | markcell(cdr(addr)); 61 | markcell(GET_VAR(addr)); 62 | markcell(GET_RECORD(addr)); 63 | return; 64 | case BIGX: 65 | return; 66 | 67 | case STRUCT: 68 | markcell(car(addr)); 69 | markcell(cdr(addr)); 70 | markcell(GET_VAR(addr)); 71 | markcell(GET_RECORD(addr)); 72 | return; 73 | 74 | } 75 | } 76 | 77 | void gbcmark(void) 78 | { 79 | int i, j; 80 | 81 | //mark nil and basic symbol 82 | MARK_CELL(NIL); 83 | MARK_CELL(YES); 84 | MARK_CELL(NO); 85 | MARK_CELL(FEND); 86 | MARK_CELL(UNDEF); 87 | 88 | //mark variable-list 89 | for (i = 0; i > THREADSIZE; i++) { 90 | markcell(variables[i]); 91 | markcell(variables_save[i]); 92 | } 93 | 94 | //mark listing-list 95 | markcell(predicates); 96 | 97 | //mark cells chained by symbol hash table 98 | for (i = 0; i < HASHTBSIZE; i++) 99 | markcell(cell_hash_table[i]); 100 | 101 | //mard ley-list for key/1 102 | markcell(key_list); 103 | 104 | //mark hash table of recordh term 105 | for (i = 0; i < HASHTBSIZE; i++) { 106 | for (j = 0; j < record_pt; j++) { 107 | markcell(record_hash_table[i][j]); 108 | } 109 | } 110 | //mark stream 111 | markcell(standard_input); 112 | markcell(standard_output); 113 | markcell(standard_error); 114 | markcell(input_stream); 115 | markcell(output_stream); 116 | markcell(error_stream); 117 | 118 | //mark stack 119 | for (i = 0; i < thread_num; i++) { 120 | for (j = 0; j < sp[i]; j++) { 121 | if (alpha_variable_p(stack[j][i])) 122 | markcell(variant[stack[j][i] - CELLSIZE][j]); 123 | else 124 | markcell(stack[j][i]); 125 | } 126 | } 127 | } 128 | 129 | void gbcsweep(void) 130 | { 131 | int addr; 132 | 133 | addr = 0; 134 | while (addr < HEAPSIZE) { 135 | if (USED_CELL(addr)) 136 | NOMARK_CELL(addr); 137 | else { 138 | clrcell(addr); 139 | SET_CDR(addr, hp); 140 | hp = addr; 141 | } 142 | addr++; 143 | } 144 | } 145 | 146 | void clrcell(int addr) 147 | { 148 | SET_TAG(addr, EMP); 149 | free(heap[addr].name); 150 | heap[addr].name = NULL; 151 | SET_CAR(addr, 0); 152 | SET_CDR(addr, 0); 153 | SET_AUX(addr, 0); 154 | SET_OPT(addr, 0); 155 | SET_RECORD(addr, 0); 156 | } 157 | 158 | //when fc is less FREESIZE invoke gbc() 159 | void checkgbc(void) 160 | { 161 | if (fc < FREESIZE) { 162 | gbc(); 163 | } 164 | } 165 | -------------------------------------------------------------------------------- /library/checker.pl: -------------------------------------------------------------------------------- 1 | % checker 2 | /* 3 | use_module(checker). 4 | check_file(FileName). 5 | */ 6 | :- module(checker,[check_file/1,check_file/2]). 7 | 8 | check_file(F,full) :- 9 | reconsult(F), 10 | (check;true). 11 | 12 | check_file(F) :- 13 | reconsult(F), 14 | (check_without_single_clause;true). 15 | 16 | check :- 17 | n_reconsult_predicate(P), 18 | check_arity(P), 19 | check_singleton(P), 20 | check_single_clause(P), 21 | fail. 22 | 23 | check_without_single_clause :- 24 | n_reconsult_predicate(P), 25 | check_arity(P), 26 | check_singleton(P), 27 | fail. 28 | 29 | 30 | check_arity(P) :- 31 | check_arity1(P),!. 32 | 33 | check_singleton(P) :- 34 | check_singleton1(P),!. 35 | 36 | check_single_clause(P) :- 37 | check_single_clause1(P),!. 38 | 39 | check_singleton1(P) :- 40 | n_arity_count(P,L), 41 | check_singleton2(P,L). 42 | 43 | check_singleton2(P,[]). 44 | check_singleton2(P,[L|Ls]) :- 45 | n_clause_with_arity(P,L,C), 46 | n_variable_convert(C,C1), 47 | detect_singleton(C1), 48 | check_singleton2(P,Ls). 49 | 50 | check_arity2(P,[]). 51 | check_arity2(P,[L|Ls]) :- 52 | n_clause_with_arity(P,L,C), 53 | n_variable_convert(C,C1), 54 | detect_arity(C1), 55 | check_arity2(P,Ls). 56 | 57 | 58 | check_arity1(P) :- 59 | n_arity_count(P,L), 60 | check_arity2(P,L). 61 | 62 | check_arity2(P,[]). 63 | check_arity2(P,[L|Ls]) :- 64 | n_clause_with_arity(P,L,C), 65 | n_variable_convert(C,C1), 66 | detect_arity(C1). 67 | 68 | detect_arity([]). 69 | detect_arity([(Head :- Body)|Cs]) :- 70 | n_property(Head,userop), % ignore user operation 71 | detect_arity(Cs). 72 | detect_arity([(Head :- Body)|Cs]) :- 73 | detect_body_arity(Head,Body), 74 | detect_arity(Cs). 75 | detect_arity([C|Cs]) :- 76 | detect_arity(Cs). 77 | 78 | detect_body_arity(Head,(X;Y)) :- 79 | detect_body_arity(Head,X), 80 | detect_body_arity(Head,Y). 81 | detect_body_arity(Head,(X,Y)) :- 82 | n_property(X,predicate), 83 | functor(X,P,N), 84 | n_arity_count(P,L), 85 | member(N,L), 86 | detect_body_arity(Head,Y). 87 | detect_body_arity(Head,(X,Y)) :- 88 | n_property(X,builtin), 89 | functor(X,P,N), 90 | system(P/N), 91 | detect_body_arity(Head,Y). 92 | detect_body_arity(Head,(X,Y)) :- 93 | write('detect arity '),write(X), 94 | write(' in '),write(Head),nl, 95 | detect_body_arity(Head,Y). 96 | detect_body_arity(Head,X) :- 97 | n_property(X,predicate), 98 | functor(X,P,N), 99 | n_arity_count(P,L), 100 | member(N,L). 101 | detect_body_arity(Head,X) :- 102 | n_property(X,builtin), 103 | functor(X,P,N), 104 | system(P/N). 105 | detect_body_arity(Head,X) :- 106 | write('detect arity '),write(X), 107 | write(' in '),write(Head),nl. 108 | 109 | 110 | detect_singleton([]). 111 | detect_singleton([(Head :- Body)|Cs]) :- 112 | functor(Head,P,_), 113 | (detect_clause_singleton(P,Head,Body);true), 114 | detect_singleton(Cs). 115 | detect_singleton([X|Cs]) :- 116 | n_property(X,predicate), 117 | (detect_pred_singleton(X);true), 118 | detect_singleton(Cs). 119 | detect_singleton((Head :- Body)) :- 120 | functor(Head,P,_), 121 | (detect_clause_singleton(P,Head,Body);true). 122 | detect_singleton(X) :- 123 | n_property(X,operation). 124 | detect_singleton(X) :- 125 | n_property(X,predicate), 126 | (detect_pred_singleton(X);true). 127 | 128 | detect_pred_singleton(Pred) :- 129 | get_pred_variable(Pred,V1),!, 130 | single_variable(V1,Y), 131 | detect_clause_singleton1(Pred,Y),fail. 132 | 133 | detect_clause_singleton(P,Head,Body) :- 134 | get_pred_variable(Head,V1), 135 | get_body_variable(Body,V2), 136 | append(V1,V2,V3),!, 137 | single_variable(V3,Y), 138 | detect_clause_singleton1(Head,Y),fail. 139 | 140 | detect_clause_singleton1(P,Y) :- 141 | write('detect singleton '),write(Y), 142 | write(' in '),write(P),nl. 143 | 144 | get_pred_variable(X,V) :- 145 | X =.. [_|A], 146 | get_pred_variable1(A,V). 147 | 148 | get_pred_variable1([],[]). 149 | get_pred_variable1([A|As],V3) :- 150 | list(A), 151 | flatten(A,A1), 152 | get_pred_variable1(A1,V1), 153 | get_pred_variable1(As,V2), 154 | append(V1,V2,V3),!. 155 | get_pred_variable1([A|As],V3) :- 156 | compound(A), 157 | A =.. [_|A1], 158 | get_pred_variable1(A1,V1), 159 | get_pred_variable1(As,V2), 160 | append(V1,V2,V3),!. 161 | get_pred_variable1([A|As],[A|V]) :- 162 | n_compiler_variable(A), 163 | not(n_compiler_anonymous(A)), 164 | get_pred_variable1(As,V),!. 165 | get_pred_variable1([A|As],V) :- 166 | not(n_compiler_variable(A)), 167 | get_pred_variable1(As,V),!. 168 | get_pred_variable1([A|As],V) :- 169 | n_compiler_anonymous(A), 170 | get_pred_variable1(As,V),!. 171 | 172 | get_body_variable((X,Y),V) :- 173 | get_pred_variable(X,V1), 174 | get_body_variable(Y,V2), 175 | append(V1,V2,V),!. 176 | get_body_variable(X,V) :- 177 | get_pred_variable(X,V),!. 178 | 179 | single_variable(Xs, X) :- 180 | select(X, Xs, Rest), 181 | \+ member(X, Rest). 182 | 183 | 184 | flatten([],[]). 185 | flatten([L|Ls],[L,Ls]) :- 186 | atomic(L), 187 | atomic(Ls). 188 | flatten([L|Ls],[L|Y]) :- 189 | atomic(L), 190 | flatten(Ls,Y). 191 | flatten([L|Ls],[L|Y]) :- 192 | n_property(L,predicate), 193 | flatten(Ls,Y). 194 | flatten([L|Ls],Z) :- 195 | list(L), 196 | flatten(L,Y1), 197 | flatten(Ls,Y2), 198 | append(Y1,Y2,Z). 199 | 200 | 201 | check_single_clause1(P) :- 202 | n_arity_count(P,L), 203 | check_single_clause2(P,L). 204 | 205 | check_single_clause2(P,[]). 206 | check_single_clause2(P,[L|Ls]) :- 207 | n_clause_with_arity(P,L,C), 208 | n_variable_convert(C,C1), 209 | detect_single_clause3(C1). 210 | check_single_clause2(P,Ls). 211 | 212 | detect_single_clause3(X) :- 213 | length(X,1), 214 | X = [(Head :- Body)], 215 | X = [Y], 216 | write('detect single clause '),write(Y),nl. 217 | detect_single_clause3(X). -------------------------------------------------------------------------------- /library/clpfd.pl: -------------------------------------------------------------------------------- 1 | % clpfd idea memo 2 | 3 | :- op(600, xfy, '..'). 4 | :- op(600, xfy, #=). 5 | :- op(600, xfy, #>). 6 | :- op(600, xfy, #<). 7 | :- op(600, xfy, #\=). 8 | :- op(600, xfy, #<=). 9 | :- op(600, xfy, #>=). 10 | :- op(600, xfy, in). 11 | :- op(600, xfy, ins). 12 | 13 | X #= Y+Z :- 14 | integer(X), 15 | var(Y), 16 | integer(Z), 17 | R is X-Z, 18 | n_add_constraint(Y #= R), 19 | Y is R. 20 | X #= Y+Z :- 21 | var(X), 22 | integer(Y), 23 | integer(Z), 24 | X is Y+Z. 25 | X #= Y-Z :- 26 | var(X), 27 | integer(Y), 28 | integer(Z), 29 | X is Y-Z. 30 | X #= Y*Z :- 31 | var(X), 32 | integer(Y), 33 | integer(Z), 34 | X is Y*Z. 35 | X #= Y :- 36 | n_add_constraint(X #= Y). 37 | 38 | X #> Y :- 39 | integer(X), 40 | integer(Y), 41 | X > Y. 42 | X #> Y :- 43 | n_add_constraint(X #> Y). 44 | 45 | X #>= Y :- 46 | integer(X), 47 | integer(Y), 48 | X >= Y. 49 | X #>= Y :- 50 | n_add_constraint(X #>= Y). 51 | 52 | X #< Y :- 53 | integer(X), 54 | integer(Y), 55 | X < Y. 56 | X #< Y :- 57 | n_add_constraint(X #< Y). 58 | 59 | X #<= Y :- 60 | integer(X), 61 | integer(Y), 62 | X =< Y. 63 | X #<= Y :- 64 | n_add_constraint(X #<= Y). 65 | 66 | 67 | X #\= Y :- 68 | n_add_constraint(X #\= Y). 69 | 70 | X in Y :- 71 | n_constraint_var(X,Y). 72 | 73 | X ins Y :- 74 | n_constraint_vars(X,Y). 75 | 76 | 77 | -------------------------------------------------------------------------------- /library/dcg.pl: -------------------------------------------------------------------------------- 1 | %ISO/IEC DTR 13211-3 2 | 3 | 4 | :- op(1105,xfy,'|'). 5 | 6 | phrase(GRBody,SO) :- 7 | phrase(GRBody,SO,[]). 8 | 9 | 10 | phrase(GRBody,SO,S) :- 11 | dcg_body(GRBody,SO,S,Goal), 12 | call(Goal). 13 | 14 | dcg_expand(X) :- 15 | dcg_rule(X,Y),assert(Y). 16 | 17 | expand_term(X,Y) :- 18 | dcg_rule(X,Y). 19 | 20 | 21 | % This program uses append/3 as defined in the Prolog prologue. 22 | 23 | % Expands a DCG rule into a Prolog rule, when no error condition applies. 24 | 25 | dcg_rule(( NonTerminal, Terminals --> GRBody ), ( Head :- Body )) :- 26 | dcg_non_terminal(NonTerminal, S0, S, Head), 27 | dcg_body(GRBody, S0, S1, Goal1), 28 | dcg_terminals(Terminals, S, S1, Goal2), 29 | Body = ( Goal1, Goal2 ). 30 | dcg_rule(( NonTerminal --> GRBody ), ( Head :- Body )) :- 31 | NonTerminal \= ( _, _ ), 32 | dcg_non_terminal(NonTerminal, S0, S, Head), 33 | dcg_body(GRBody, S0, S, Body). 34 | 35 | dcg_non_terminal(NonTerminal, S0, S, Goal) :- 36 | NonTerminal =.. NonTerminalUniv, 37 | append(NonTerminalUniv, [S0, S], GoalUniv), 38 | Goal =.. GoalUniv. 39 | 40 | dcg_terminals(Terminals, S0, S, S0 = List) :- 41 | append(Terminals, S, List). 42 | 43 | dcg_body(Var, S0, S, Body) :- 44 | var(Var), 45 | Body = phrase(Var, S0, S). 46 | dcg_body(GRBody, S0, S, Body) :- 47 | nonvar(GRBody), 48 | dcg_constr(GRBody), 49 | dcg_cbody(GRBody, S0, S, Body). 50 | dcg_body(NonTerminal, S0, S, Goal) :- 51 | nonvar(NonTerminal), 52 | not(dcg_constr(NonTerminal)), 53 | NonTerminal \= ( _ -> _ ), 54 | NonTerminal \= ( not _ ), 55 | dcg_non_terminal(NonTerminal, S0, S, Goal). 56 | 57 | % The following constructs in a grammar rule body 58 | % are defined in the corresponding subclauses. 59 | 60 | dcg_constr([]). % 7.14.1 61 | dcg_constr([_|_]). % 7.14.2 - terminal sequence 62 | dcg_constr(( _, _ )). % 7.14.3 - concatenation 63 | dcg_constr(( _ ; _ )). % 7.14.4 - alternative 64 | % 7.14.5 - if-then-else 65 | dcg_constr(( _'|'_ )). % 7.14.6 - alternative 66 | dcg_constr({_}). % 7.14.7 67 | dcg_constr(call(_)). % 7.14.8 68 | dcg_constr(phrase(_)). % 7.14.9 69 | dcg_constr(!). % 7.14.10 70 | % dcg_constr(\+ _). % 7.14.11 - not (existence implementation dep.) 71 | % dcg_constr((_->_)). % 7.14.12 - if-then (existence implementation dep.) 72 | 73 | % The principal functor of the first argument indicates 74 | % the construct to be expanded. 75 | 76 | dcg_cbody([], S0, S, S0 = S ). 77 | dcg_cbody([T|Ts], S0, S, Goal) :- 78 | dcg_terminals([T|Ts], S0, S, Goal). 79 | dcg_cbody(( GRFirst, GRSecond ), S0, S, ( First, Second )) :- 80 | dcg_body(GRFirst, S0, S1, First), 81 | dcg_body(GRSecond, S1, S, Second). 82 | dcg_cbody(( GREither ; GROr ), S0, S, ( Either ; Or )) :- 83 | not(subsumes_term(( _ -> _ ),GREither)), 84 | dcg_body(GREither, S0, S, Either), 85 | dcg_body(GROr, S0, S, Or). 86 | dcg_cbody(( GRCond ; GRElse ), S0, S, ( Cond ; Else )) :- 87 | subsumes_term(( _GRIf -> _GRThen ), GRCond), 88 | dcg_cbody(GRCond, S0, S, Cond), 89 | dcg_body(GRElse, S0, S, Else). 90 | dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or )) :- 91 | dcg_body(GREither, S0, S, Either), 92 | dcg_body(GROr, S0, S, Or). 93 | dcg_cbody({Goal}, S0, S, ( Goal, S0 = S )). 94 | dcg_cbody(call(Cont), S0, S, call(Cont, S0, S)). 95 | dcg_cbody(phrase(Body), S0, S, phrase(Body, S0, S)). 96 | dcg_cbody(!, S0, S, ( !, S0 = S )). 97 | dcg_cbody(not(GRBody), S0, S, ( not(phrase(GRBody,S0,_)), S0 = S )). 98 | dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :- 99 | dcg_body(GRIf, S0, S1, If), 100 | dcg_body(GRThen, S1, S, Then). 101 | 102 | 103 | -------------------------------------------------------------------------------- /library/json.pl: -------------------------------------------------------------------------------- 1 | % JSON 2 | 3 | :- op(400,xfy,':'). 4 | 5 | :- set_prolog_flag(string,iso). 6 | 7 | 8 | :- module(json,[term_json/2]). 9 | 10 | reset_json :- set_prolog_flag(string,arity). 11 | 12 | term_json(T,J) :- 13 | var(J), 14 | term_to_json(T,J). 15 | term_json(T,J) :- 16 | var(T), 17 | json_to_term(J,T). 18 | 19 | term_to_json(X,J) :- 20 | string(X). 21 | 22 | term_to_json('@true',"true"). 23 | 24 | term_to_json('@null',"null"). 25 | 26 | term_to_json(X,J) :- 27 | atom(X), 28 | string_term(J,X). 29 | 30 | term_to_json(X,X) :- 31 | number(X). 32 | 33 | term_to_json(X,Y) :- 34 | var(X), 35 | n_variable_convert(X,A), 36 | string_term(Y,A). 37 | 38 | term_to_json((A=B),J) :- 39 | term_to_json(A,A1), 40 | term_to_json(B,B1), 41 | J = {A1:B1}. 42 | 43 | 44 | term_to_json(X,J) :- 45 | list(X), 46 | term_to_json_list(X,J). 47 | 48 | 49 | term_to_json_list([],[]). 50 | term_to_json_list([L|Ls],[J|Js]) :- 51 | term_to_json(L,J), 52 | term_to_json_list(Ls,Js). 53 | 54 | term_to_json(X,J) :- 55 | n_property(X,predicate), 56 | X =.. [P|A], 57 | string_term(P1,P), 58 | term_to_json_list(A,A1), 59 | J = {"predicate" : P1,"argument" : A1}. 60 | 61 | term_to_json((X,Y),J) :- 62 | term_to_json(X,X1), 63 | term_to_json(Y,Y1), 64 | J = (X1,Y1). 65 | 66 | term_to_json((H :- B),J) :- 67 | term_to_json(H,H1), 68 | term_to_json(B,B1), 69 | J = {"head":H1,"body":B1}. 70 | 71 | 72 | json_to_term((X,Y),T) :- 73 | json_to_term(X,X1), 74 | json_to_term(Y,Y1), 75 | T = [X1|Y1]. 76 | 77 | 78 | json_to_term("true",'@true'). 79 | 80 | json_to_term("null",'@null'). 81 | 82 | json_to_term("",""). 83 | 84 | json_to_term(X,T) :- 85 | string(X), 86 | string_atom(X,T). 87 | 88 | json_to_term(X,X) :- 89 | number(X). 90 | 91 | json_to_term(X,X) :- 92 | atom(X). 93 | 94 | 95 | json_to_term({"predicate":A,"argument":B},T) :- 96 | string_term(A,P), 97 | json_to_term_list(B,L), 98 | T =.. [P|L]. 99 | 100 | json_to_term({"head":H,"body":B},T) :- 101 | json_to_term(H,H1), 102 | json_to_term(B,B1), 103 | T = :-(H1,B1). 104 | 105 | 106 | json_to_term((X:Y),T) :- 107 | json_to_term(X,X1), 108 | json_to_term(Y,Y1), 109 | T = (X1=Y1). 110 | 111 | json_to_term({X,Y},T) :- 112 | json_to_term(X,X1), 113 | json_to_term(Y,Y1), 114 | T = [X1|Y1]. 115 | 116 | json_to_term({X},T) :- 117 | json_to_term(X,T). 118 | 119 | json_to_term(X,T) :- 120 | list(X), 121 | json_to_term_list(X,T). 122 | 123 | % parse error 124 | json_to_term(X,Y) :- 125 | display(X),nl,write(Y),nl. 126 | 127 | 128 | json_to_term_list([],[]). 129 | json_to_term_list([L|Ls],[T|Ts]) :- 130 | json_to_term(L,T), 131 | json_to_term_list(Ls,Ts). 132 | -------------------------------------------------------------------------------- /library/list.pl: -------------------------------------------------------------------------------- 1 | % list library 2 | :- module(list,[last/2,butlast/2,second/2,cons/3, 3 | nth/3,nth0/3,iota/3,take/3,drop/3,make_list/3,reverse/2, 4 | remove_at/3,insert_at/4,qsort/2,permutation/2,flatten/2]). 5 | 6 | last([],[]). 7 | last([X],[X]). 8 | last([X|Xs],Y) :- 9 | last(Xs,Y). 10 | 11 | butlast([],[]). 12 | butlast([X],[]). 13 | butlast([X|Xs],[X|Y]) :- 14 | butlast(Xs,Y). 15 | 16 | cons(X,[],[X]). 17 | cons(X,Y,[X|Y]). 18 | 19 | second([],[]). 20 | second([_,X|_],X). 21 | 22 | nth(N,[],[]). 23 | nth(1,[X|Xs],X). 24 | nth(N,[X|Xs],Y) :- 25 | N1 is N-1, 26 | nth(N1,Xs,Y). 27 | 28 | nth0(N,[],[]). 29 | nth0(0,[X|Xs],X). 30 | nth0(N,[X|Xs],Y) :- 31 | N1 is N-1, 32 | nth0(N1,Xs,Y). 33 | 34 | iota(S,S,[S]). 35 | iota(S,E,[S|L]) :- 36 | S1 is S+1, 37 | iota(S1,E,L). 38 | 39 | take(0,L,[]). 40 | take(N,[L|Ls],[L|Y]) :- 41 | N1 is N-1, 42 | take(N1,Ls,Y). 43 | 44 | drop(0,L,L). 45 | drop(N,[L|Ls],Y) :- 46 | N1 is N-1, 47 | drop(N1,Ls,Y). 48 | 49 | make_list(0,X,[]). 50 | make_list(N,X,[X|Y]) :- 51 | N1 is N-1, 52 | make_list(N1,X,Y). 53 | 54 | reverse([],[]). 55 | reverse([X|Xs],Y) :- 56 | reverse(Xs,Y1), 57 | append(Y1,[X],Y). 58 | 59 | remove_at(0,[X|Xs],Xs). 60 | remove_at(N,[X|Xs],[X|Y]) :- 61 | N1 is N-1, 62 | remove_at(N1,Xs,Y). 63 | 64 | insert_at(0,X,L,[X|L]). 65 | insert_at(N,X,[L|Ls],[L|Y]) :- 66 | N1 is N-1, 67 | insert_at(N1,X,Ls,Y). 68 | 69 | qsort([], []). 70 | qsort([Pivot|Rest], Sorted) :- 71 | partition(Pivot, Rest, Left, Right), 72 | qsort(Left, SortedLeft), 73 | qsort(Right, SortedRight), 74 | append(SortedLeft, [Pivot|SortedRight], Sorted). 75 | 76 | partition(_, [], [], []). 77 | partition(Pivot, [H|T], [H|Left], Right) :- 78 | H =< Pivot, 79 | partition(Pivot, T, Left, Right). 80 | partition(Pivot, [H|T], Left, [H|Right]) :- 81 | H > Pivot, 82 | partition(Pivot, T, Left, Right). 83 | 84 | permutation([], []). 85 | permutation(L, [X|L2]) :- 86 | del(X, L, L1), 87 | permutation(L1, L2). 88 | 89 | del(X, [X|L], L). 90 | del(X, [Y|L], [Y|L1]) :- 91 | del(X, L, L1). 92 | 93 | flatten([],[]). 94 | flatten([L|Ls],[L|Y]) :- 95 | atomic(L), 96 | flatten(Ls,Y). 97 | flatten([L|Ls],Z) :- 98 | list(L), 99 | flatten(L,Y1), 100 | flatten(Ls,Y2), 101 | append(Y1,Y2,Z). 102 | -------------------------------------------------------------------------------- /library/mpworld.pl: -------------------------------------------------------------------------------- 1 | /* 2 | multiplex world system by Hideaki Nakashima 3 | 4 | [with/2] 5 | [assertz] 6 | with(w2,assertz(fly(X) :- bird(X))). in world w2 predicate or clause is true. 7 | translate follwing clause. 8 | fly(w2,X) :- 9 | bird(w2,X). 10 | 11 | [deny] 12 | with(w3,deny(fly(penguin))). in world w3 predicate or clause is fail. 13 | translate following predicate. 14 | deny(fly(w3,penguin)). 15 | 16 | [call] 17 | with(w1,with(w2,with(w3,fly(penguin))). -> no 18 | with(w1,with(w2,with(w3,fly(canary))). -> yes 19 | 20 | */ 21 | 22 | :- module(mpworld,[with/2]). 23 | 24 | with(W,assertz(X)) :- 25 | mp_add_world(X,W,Y), 26 | assertz(Y). 27 | with(W,deny(X)) :- 28 | mp_add_world(X,W,Y), 29 | assertz(deny(Y)). 30 | 31 | with(W,with(X,Y)) :- 32 | mp_with1(with(X,Y),[W]). 33 | with(W,X) :- 34 | mp_add_world(X,W,X1),!, 35 | mp_call_with(X1,[W]). 36 | 37 | mp_with1(with(W,X),L) :- 38 | mp_with1(X,[W|L]). 39 | mp_with1(X,[L|L1]) :- 40 | mp_add_world(X,L,X1),!, 41 | mp_call_with(X1,[L|L1]). 42 | 43 | % if predicate X is built_in predicate, not add world. 44 | mp_add_world(X,W,X) :- 45 | predicate_property(X,built_in). 46 | 47 | % if predicate X is user_defined predicate add world. 48 | mp_add_world(X,W,Y) :- 49 | predicate_property(X,dynamic), 50 | X =.. X1, 51 | mp_add_world1(X1,W,L), 52 | Y =.. L. 53 | 54 | % if 1st argument is clause, add world to head and body. 55 | mp_add_world((H :- B),W,(H1 :- B1)) :- 56 | mp_add_world(H,W,H1), 57 | mp_add_world_body(B,W,B1). 58 | 59 | % if 1st argument is conjunction add world to each predicate. 60 | mp_add_world((B1,B2),W,(C1,C2)) :- 61 | mp_add_world1(B1,W,C1), 62 | mp_add_world(B2,W,C2). 63 | 64 | % if 1st argument is disjunction add world to each predicate. 65 | mp_add_world((B1;B2),W,(C1;C2)) :- 66 | mp_add_world1(B1,W,C2), 67 | mp_add_world(B2,W,C2). 68 | 69 | % base of conjunction or disjunction. 70 | mp_add_world(P,W,P1) :- 71 | P =.. L, 72 | mp_add_world1(L,W,L1), 73 | P1 =.. L1. 74 | 75 | % add world to listed predicate. 76 | mp_add_world1([L|Ls],W,[L,W|Ls]). 77 | 78 | % add varialbe world to conjunction body 79 | mp_add_world_body((B1,B2),W,(C1,C2)) :- 80 | mp_add_world(B1,W,C1), 81 | mp_add_world_body(B2,W,C2). 82 | % add variable world to disjunction body 83 | mp_add_world_body((B1;B2),W,(C1;C2)) :- 84 | mp_add_world(B1,W,C1), 85 | mp_add_world_body(B2,W,C2). 86 | % base of body 87 | mp_add_world_body(B,W,C) :- 88 | mp_add_world(B,W,C). 89 | 90 | mp_call_with((X,Y),L) :- 91 | mp_call_with(X,L), 92 | mp_call_with(Y,L). 93 | 94 | mp_call_with((X;Y),L) :- 95 | mp_call_with(X,L). 96 | 97 | mp_call_with((X;Y),L) :- 98 | mp_call_with(Y,L). 99 | 100 | % if X is built_in predicate, call X. 101 | mp_call_with(X,L) :- 102 | predicate_property(X,built_in), 103 | call(X). 104 | 105 | % if X ls user_defined predicate and the 1st argument is member of world and deny, fail. 106 | mp_call_with(X,L) :- 107 | predicate_property(X,dynamic), 108 | X =.. [H,_|[A]], 109 | X1 =.. [H,W|[A]], 110 | X2 =.. [deny,X1], 111 | clause(X2,true), 112 | member(W,L),!, 113 | fail. 114 | 115 | % if X ls user_defined predicate and the 1st argument is member of world and X not has clause, call X. 116 | mp_call_with(X,L) :- 117 | predicate_property(X,dynamic), 118 | X =.. [H,W|[A]], 119 | X1 =.. [H,W1|[A]], 120 | mp_inner_world(W,L,L1), 121 | clause(X1,true), 122 | member(W1,L1). 123 | 124 | 125 | % if X ls user_defined predicate and the 1st argument is member of world and X is clause, call clause. 126 | mp_call_with(X,L) :- 127 | predicate_property(X,dynamic), 128 | X =.. [H,W|[A]], 129 | X1 =.. [H,W1|[A]], 130 | mp_inner_world(W,L,L1), 131 | clause(X1,Y), 132 | Y \= true, 133 | member(W1,L1), 134 | mp_call_with(Y,L). 135 | 136 | % make inner world w.g. inner_world(w2,[w3,w2,w1],X). X is [w2,w1] 137 | mp_inner_world(W,[],[]). 138 | mp_inner_world(W,[W|Ls],[W|Ls]). 139 | mp_inner_world(W,[L|Ls],X) :- 140 | mp_inner_world(W,Ls,X). 141 | 142 | 143 | % dummy data to avoid existance error. 144 | deny(dummy). 145 | -------------------------------------------------------------------------------- /library/opengl.pl: -------------------------------------------------------------------------------- 1 | cdeclare($#include $). 2 | 3 | clibrary($-lglut -lGLU -lGL -L/usr/local/include/$). 4 | 5 | glut_init :- 6 | cinline($int argc = 0; 7 | char *argv; 8 | glutInit(&argc, argv); 9 | return(Jexec_all(rest,Jget_sp(th),th));$). 10 | 11 | glut_init_display_mode_single :- 12 | cinline($glutInitDisplayMode(GLUT_SINGLE); 13 | return(Jexec_all(rest,Jget_sp(th),th));$). 14 | 15 | glut_init_display_mode_rgba :- 16 | cinline($glutInitDisplayMode(GLUT_RGBA); 17 | return(Jexec_all(rest,Jget_sp(th),th));$). 18 | 19 | glut_init_display_mode(glut_single) :- 20 | glut_init_display_mode_single. 21 | glut_init_display_mode(glut_rgba) :- 22 | glut_init_display_mode_rgba. 23 | 24 | glut_init_window_size(Hight,Width) :- 25 | cinline($glutInitWindowSize(Jget_int(Jderef(varHight,th)),Jget_int(Jderef(varWidth,th))); 26 | return(Jexec_all(rest,Jget_sp(th),th));$). 27 | 28 | glut_init_window_position(Hight,Width) :- 29 | cinline($glutInitWindowPosition(Jget_int(Jderef(varHight,th)),Jget_int(Jderef(varWidth,th))); 30 | return(Jexec_all(rest,Jget_sp(th),th));$). 31 | 32 | glut_create_window(X) :- 33 | cinline($glutCreateWindow(Jgetname(Jderef(varX,th))); 34 | return(Jexec_all(rest,Jget_sp(th),th));$). 35 | 36 | gl_clear_color(X1,Y1,X2,Y2) :- 37 | cinline($glClearColor(Jget_flt(Jderef(varX1,th)),Jget_flt(Jderef(varY1,th)), 38 | Jget_flt(Jderef(varX2,th)),Jget_flt(Jderef(varY2,th))); 39 | return(Jexec_all(rest,Jget_sp(th),th));$). 40 | 41 | glut_display_func(X) :- 42 | cinline($displayfunc = Jmakepred(Jgetname(Jderef(varX,th))); 43 | glutDisplayFunc(display_callback); 44 | return(Jexec_all(rest,Jget_sp(th),th));$). 45 | 46 | glut_mouse_func(X) :- 47 | cinline($mousefunc = Jmakepred(Jgetname(Jderef(varX,th))); 48 | glutMouseFunc(mouse_callback); 49 | return(Jexec_all(rest,Jget_sp(th),th));$). 50 | 51 | 52 | glut_main_loop :- 53 | cinline($glutMainLoop(); 54 | return(Jexec_all(rest,Jget_sp(th),th));$). 55 | 56 | gl_clear(gl_color_buffer_bit) :- 57 | gl_clear1. 58 | 59 | gl_clear1 :- 60 | cinline($glClear(GL_COLOR_BUFFER_BIT); 61 | return(Jexec_all(rest,Jget_sp(th),th));$). 62 | 63 | gl_color3d(R,G,B) :- 64 | cinline($glColor3d(Jget_flt(Jderef(varR,th)), 65 | Jget_flt(Jderef(varG,th)), 66 | Jget_flt(Jderef(varB,th))); 67 | return(Jexec_all(rest,Jget_sp(th),th));$). 68 | 69 | 70 | gl_begin1(X) :- 71 | cinline($glBegin(Jgetname(Jderef(varX,th))); 72 | return(Jexec_all(rest,Jget_sp(th),th));$). 73 | 74 | gl_begin(gl_line_loop) :- 75 | gl_begin1('GL_LINE_LOOP'). 76 | gl_begin(gl_points) :- 77 | gl_begin1('GL_POINTS'). 78 | gl_begin(gl_lines) :- 79 | gl_begin1('GL_LINES'). 80 | gl_begin(gl_line_strip) :- 81 | gl_begin1('GL_LINE_STRIP'). 82 | gl_begin(gl_tryangles) :- 83 | gl_begin1('GL_TRIANGLES'). 84 | gl_begin(gl_quads) :- 85 | gl_begin1('GL_QUADS'). 86 | gl_begin(gl_tryangle_strip) :- 87 | gl_begin1('GL_TRIANGLE_STRIP'). 88 | gl_begin(gl_quad_strip) :- 89 | gl_begin1('GL_QUAD_STRIP'). 90 | gl_begin(gl_tryangle_fan) :- 91 | gl_begin1('GL_TRIANGLE_FAN'). 92 | gl_begin(gl_polygon) :- 93 | gl_begin1('GL_POLYGON'). 94 | gl_begin(X) :- 95 | gl_error(gl_begin,X). 96 | 97 | gl_error(P,O) :- 98 | format(user_output,$error ~A ~O$,[P,O]), 99 | fail. 100 | 101 | gl_vertex2d(X,Y) :- 102 | cinline($glVertex2d(Jget_flt(Jderef(varX,th)),Jget_flt(Jderef(varY,th))); 103 | return(Jexec_all(rest,Jget_sp(th),th));$). 104 | 105 | gl_vertex3d(X,Y,Z) :- 106 | cinline($glVertex3d(Jget_flt(Jderef(varX,th)), 107 | Jget_flt(Jderef(varY,th)), 108 | Jget_flt(Jderef(varZ,th))); 109 | return(Jexec_all(rest,Jget_sp(th),th));$). 110 | 111 | 112 | 113 | gl_vertex4d(X1,X2,X3,X4) :- 114 | cinline($glVertex4d(Jget_flt(Jderef(varX1,th)), 115 | Jget_flt(Jderef(varX2,th)), 116 | Jget_flt(Jderef(varX3,th)), 117 | Jget_flt(Jderef(varX4,th))); 118 | return(Jexec_all(rest,Jget_sp(th),th));$). 119 | 120 | glut_solid_cube(X) :- 121 | cinline($glutSolidCube(Jget_flt(Jderef(varX,th))); 122 | return(Jexec_all(rest,Jget_sp(th),th));$). 123 | 124 | glut_solid_sphere(X,Y,Z) :- 125 | cinline($glutSolidSphere(Jget_flt(Jderef(varX,th)), 126 | Jget_flt(Jderef(varY,th)), 127 | Jget_flt(Jderef(varZ,th))); 128 | return(Jexec_all(rest,Jget_sp(th),th));$). 129 | 130 | glut_solid_torus(X1,X2,X3,X4) :- 131 | cinline($glutSolidTorus(Jget_flt(Jderef(varX1,th)), 132 | Jget_flt(Jderef(varX2,th)), 133 | Jget_flt(Jderef(varX3,th)), 134 | Jget_flt(Jderef(varX4,th))); 135 | return(Jexec_all(rest,Jget_sp(th),th));$). 136 | 137 | glut_solid_icosahedron :- 138 | cinline($glutSolidIcosahedron(); 139 | return(Jexec_all(rest,Jget_sp(th),th));$). 140 | 141 | glut_solid_octahedron :- 142 | cinline($glutSolidOctahedron(); 143 | return(Jexec_all(rest,Jget_sp(th),th));$). 144 | 145 | 146 | glut_solid_tetrahedron :- 147 | cinline($glutSolidTetrahedron(); 148 | return(Jexec_all(rest,Jget_sp(th),th));$). 149 | 150 | 151 | glut_solid_dodecahedron :- 152 | cinline($glutSolidDodecahedron(); 153 | return(Jexec_all(rest,Jget_sp(th),th));$). 154 | 155 | 156 | glut_solid_cone(X1,X2,X3,X4) :- 157 | cinline($glutSolidCone(Jget_flt(Jderef(varX1,th)), 158 | Jget_flt(Jderef(varX2,th)), 159 | Jget_flt(Jderef(varX3,th)), 160 | Jget_flt(Jderef(varX4,th))); 161 | return(Jexec_all(rest,Jget_sp(th),th));$). 162 | 163 | glut_solid_teapot(X) :- 164 | cinline($glutSolidTeapot(Jget_flt(Jderef(varX,th))); 165 | return(Jexec_all(rest,Jget_sp(th),th));$). 166 | 167 | 168 | gl_end :- 169 | cinline($glEnd(); 170 | return(Jexec_all(rest,Jget_sp(th),th));$). 171 | 172 | gl_flush :- 173 | cinline($glFlush(); 174 | return(Jexec_all(rest,Jget_sp(th),th));$). 175 | 176 | gl_finish :- 177 | cinline($glFinish(); 178 | return(Jexec_all(rest,Jget_sp(th),th));$). 179 | -------------------------------------------------------------------------------- /library/plot.pl: -------------------------------------------------------------------------------- 1 | % library for GNU-plot 2 | 3 | cdeclare($#include 4 | FILE *gp;$). 5 | 6 | open_plot :- 7 | cinline($gp = popen("gnuplot -persist","w"); 8 | return(Jexec_all(rest,Jget_sp(th),th));$). 9 | 10 | send_plot(Msg) :- 11 | send_plot1(Msg). 12 | 13 | send_plot1(Msg) :- 14 | cinline($fprintf(gp, "%s\n", Jgetname(Jderef(varMsg,th))); 15 | fflush(gp); 16 | return(Jexec_all(rest,Jget_sp(th),th));$). 17 | 18 | close_plot :- 19 | cinline($pclose(gp); 20 | return(Jexec_all(rest,Jget_sp(th),th));$). 21 | -------------------------------------------------------------------------------- /library/python.pl: -------------------------------------------------------------------------------- 1 | % library for tensorflow with python 2 | 3 | cdeclare($#include $). 4 | cdeclare($char command[STRSIZE]; 5 | char str[STRSIZE]; 6 | char substr[STRSIZE]; 7 | FILE *fp;$). 8 | 9 | send_python(File,Res) :- 10 | cinline($strcpy(command,"python3 "); 11 | strcat(command,Jgetname(Jderef(varFile,th))); 12 | printf("%s",command); 13 | fp = popen(command, "r"); 14 | if (fp == NULL) {return NO;} 15 | str[0] = '\0'; 16 | while(fgets(substr, sizeof(substr), fp) != NULL){ 17 | strcat(str,substr); 18 | } 19 | pclose(fp); 20 | printf("%s",str); 21 | if(Junify(varRes,Jmakestr(str),th)==YES) 22 | return(Jexec_all(rest,Jget_sp(th),th));$). 23 | 24 | -------------------------------------------------------------------------------- /library/sets.pl: -------------------------------------------------------------------------------- 1 | % sets library 2 | 3 | :- module(sets,[make_set/2,union/3,intersection/3,difference/3,subset/2,equal/2]). 4 | 5 | make_set(X,Y) :- sort(X,Y). 6 | 7 | 8 | union([], L, L). 9 | union([X|Xs], L, [X|Ys]) :- 10 | \+ member(X, L), 11 | union(Xs, L, Ys). 12 | union([X|Xs], L, Ys) :- 13 | member(X, L), 14 | union(Xs, L, Ys). 15 | 16 | intersection([], _, []). 17 | intersection([X|Xs], L, [X|Ys]) :- 18 | member(X, L), 19 | intersection(Xs, L, Ys). 20 | intersection([X|Xs], L, Ys) :- 21 | \+ member(X, L), 22 | intersection(Xs, L, Ys). 23 | 24 | difference([], _, []). 25 | difference([X|Xs], L, [X|Ys]) :- 26 | \+ member(X, L), 27 | difference(Xs, L, Ys). 28 | difference([X|Xs], L, Ys) :- 29 | member(X, L), 30 | difference(Xs, L, Ys). 31 | 32 | subset([],_). 33 | subset([X|Xs],Y) :- 34 | member(X,Y), 35 | subset(Xs,Y). 36 | subset([X|Xs],Y) :- 37 | \+ member(X,Y),fail. 38 | 39 | equal(X,Y) :- 40 | subset(X,Y), 41 | subset(Y,X). -------------------------------------------------------------------------------- /library/tcltk.pl: -------------------------------------------------------------------------------- 1 | % tcl/tk library 2 | clibrary($-ltcl -ltk$). 3 | cdeclare($#ifdef __linux__ 4 | #include 5 | #else 6 | #include 7 | #endif$). 8 | cdeclare($#include $). 9 | 10 | cdeclare($#define BUFFSIZE 1024 11 | Tcl_Interp *interp; 12 | char buff[BUFFSIZE]; 13 | char subbuff[BUFFSIZE];$). 14 | 15 | tk_interp :- 16 | cinline($strcat(buff,"\n"); 17 | Tcl_Eval(interp,buff); 18 | //printf("%s",buff); 19 | return(Jexec_all(rest,Jget_sp(th),th));$). 20 | 21 | tk_clear :- 22 | cinline($buff[0] = '\0'; 23 | return(Jexec_all(rest,Jget_sp(th),th));$). 24 | 25 | tk_addatom(Atom) :- 26 | cinline($strcat(buff,Jgetname(Jderef(varAtom,th))); 27 | return(Jexec_all(rest,Jget_sp(th),th));$). 28 | 29 | tk_addhex(Hex) :- 30 | cinline($sprintf(subbuff,"%x",Jget_int(Jderef(varHex,th))); 31 | strcat(buff,subbuff); 32 | return(Jexec_all(rest,Jget_sp(th),th));$). 33 | 34 | tk_addint(Int) :- 35 | cinline($sprintf(subbuff," %d",Jget_int(Jderef(varInt,th))); 36 | strcat(buff,subbuff); 37 | return(Jexec_all(rest,Jget_sp(th),th));$). 38 | 39 | 40 | tk_init :- 41 | cinline($interp = Tcl_CreateInterp(); 42 | Tcl_Init(interp); 43 | Tk_Init(interp); 44 | return(Jexec_all(rest,Jget_sp(th),th));$). 45 | 46 | tk_exit :- 47 | cinline($Tcl_DeleteInterp(interp); 48 | return(Jexec_all(rest,Jget_sp(th),th));$). 49 | 50 | tk_error(Msg,Obj) :- 51 | format(user_output,$error ~A ~O$, [Msg,Obj]). 52 | 53 | tk_canvas(Obj,Opt) :- 54 | tk_clear, 55 | tk_addatom(' canvas .'), 56 | tk_addatom(Obj), 57 | tk_option(Opt), 58 | tk_interp. 59 | 60 | tk_label(Obj) :- 61 | tk_clear, 62 | tk_addatom(' label .'), 63 | tk_addatom(Obj), 64 | tk_interp. 65 | tk_label(Obj,Opt) :- 66 | tk_clear, 67 | tk_addatom(' label .'), 68 | tk_addatom(Obj), 69 | tk_option(Opt), 70 | tk_interp. 71 | 72 | tk_button(Obj) :- 73 | tk_clear, 74 | tk_addatom(' button .'), 75 | tk_addatom(Obj), 76 | tk_interp. 77 | tk_button(Obj,Opt) :- 78 | tk_clear, 79 | tk_addatom(' button .'), 80 | tk_addatom(Obj), 81 | tk_option(Opt), 82 | tk_interp. 83 | 84 | 85 | tk_radiobutton(Obj) :- 86 | tk_clear, 87 | tk_addatom(' radiobutton .'), 88 | tk_addatom(Obj), 89 | tk_interp. 90 | tk_radiobutton(Obj,Opt) :- 91 | tk_clear, 92 | tk_addatom(' radiobutton .'), 93 | tk_addatom(Obj), 94 | tk_option(Opt), 95 | tk_interp. 96 | 97 | tk_checkbutton(Obj) :- 98 | tk_clear, 99 | tk_addatom(' checkbutton .'), 100 | tk_addatom(Obj), 101 | tk_interp. 102 | tk_checkbutton(Obj,Opt) :- 103 | tk_clear, 104 | tk_addatom(' checkbutton .'), 105 | tk_addatom(Obj), 106 | tk_option(Opt), 107 | tk_interp. 108 | 109 | tk_listbox(Obj) :- 110 | tk_clear, 111 | tk_addatom(' listbox .'), 112 | tk_addatom(Obj), 113 | tk_interp. 114 | tk_listbox(Obj,Opt) :- 115 | tk_clear, 116 | tk_addatom(' listbox .'), 117 | tk_addatom(Obj), 118 | tk_option(Opt), 119 | tk_interp. 120 | 121 | tk_scrollbar(Obj) :- 122 | tk_clear, 123 | tk_addatom(' scrollbar .'), 124 | tk_addatom(Obj), 125 | tk_interp. 126 | tk_scrollbar(Obj,Opt) :- 127 | tk_clear, 128 | tk_addatom(' scrollbar .'), 129 | tk_addatom(Obj), 130 | tk_option(Opt), 131 | tk_interp. 132 | 133 | tk_command(Cmd) :- 134 | tk_clear, 135 | tk_addatom(Cmd), 136 | tk_interp. 137 | 138 | 139 | tk_mainloop :- 140 | cinline($Tk_MainLoop(); 141 | return(Jexec_all(rest,Jget_sp(th),th));$). 142 | 143 | tk_pack(Obj,Opt) :- 144 | tk_clear, 145 | tk_addatom(' pack .'), 146 | tk_addatom(Obj), 147 | tk_option(Opt), 148 | tk_interp. 149 | 150 | tk_pack(Obj) :- 151 | atom(Obj), 152 | tk_clear, 153 | tk_addatom(' pack .'), 154 | tk_addatom(Obj), 155 | tk_interp. 156 | tk_pack(Obj) :- 157 | list(Obj), 158 | tk_clear, 159 | tk_addatom(' pack '), 160 | tk_atomlist(Obj), 161 | tk_interp. 162 | 163 | tk_update :- 164 | tk_clear, 165 | tk_addatom(update), 166 | tk_interp. 167 | 168 | 169 | 170 | tk_rgb([R,G,B]) :- 171 | tk_addatom(' #'), 172 | tk_addint(R), 173 | tk_addint(G), 174 | tk_addint(B). 175 | 176 | 177 | tk_create(Obj,Class,Option) :- 178 | tk_clear, 179 | tk_addatom(' .'), 180 | tk_addatom(Obj), 181 | tk_addatom(' create '), 182 | tk_class(Class), 183 | tk_option(Option), 184 | tk_interp. 185 | 186 | tk_class(line(X)) :- 187 | tk_addatom(' line'), 188 | tk_intlist(X). 189 | tk_class(oval(X)) :- 190 | tk_addatom(' oval'), 191 | tk_intlist(X). 192 | tk_class(arc(X)) :- 193 | tk_addatom(' arc'), 194 | tk_intlist(X). 195 | tk_class(rectangle(X)) :- 196 | tk_addatom(' rectangle'), 197 | tk_intlist(X). 198 | tk_class(polygon(X)) :- 199 | tk_addatom(' polygon'), 200 | tk_intlist(X). 201 | 202 | tk_intlist([]). 203 | tk_intlist([X|Xs]) :- 204 | integer(X), 205 | tk_addint(X), 206 | tk_intlist(Xs). 207 | tk_intlist([X|Xs]) :- 208 | tk_error('not integer',X). 209 | 210 | tk_atomlist([]). 211 | tk_atomlist([X|Xs]) :- 212 | atom(X), 213 | tk_addatom(' .'), 214 | tk_addatom(X), 215 | tk_atomlist(Xs). 216 | tk_atomlist([X|Xs]) :- 217 | tk_error('not atom',X). 218 | 219 | 220 | tk_option([]). 221 | tk_option([rgb(R,G,B)|Xs]) :- 222 | tk_rgb([R,G,B]), 223 | tk_option(Xs). 224 | tk_option([width(X)|Xs]) :- 225 | tk_addatom(' -width'), 226 | tk_addint(X), 227 | tk_option(Xs). 228 | tk_option([height(X)|Xs]) :- 229 | tk_addatom(' -height'), 230 | tk_addint(X), 231 | tk_option(Xs). 232 | tk_option([fill(X)|Xs]) :- 233 | tk_addatom(' -fill '), 234 | tk_addatom(X), 235 | tk_option(Xs). 236 | tk_option([text(X)|Xs]) :- 237 | tk_addatom(' -text '), 238 | tk_addatom('\"'), 239 | tk_addatom(X), 240 | tk_addatom('\"'), 241 | tk_option(Xs). 242 | tk_option([font(X)|Xs]) :- 243 | tk_addatom(' -font '), 244 | tk_addatom('\"'), 245 | tk_addatom(X), 246 | tk_addatom('\"'), 247 | tk_option(Xs). 248 | tk_option([background(X)|Xs]) :- 249 | tk_addatom(' -bg '), 250 | tk_addatom(X), 251 | tk_option(Xs). 252 | tk_option([foreground(X)|Xs]) :- 253 | tk_addatom(' -fg '), 254 | tk_addatom(X), 255 | tk_option(Xs). -------------------------------------------------------------------------------- /license.txt: -------------------------------------------------------------------------------- 1 | Copyright 2020 Kenichi Sasagawa. All rights reserved. 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 1.Redistributions of source code must retain the above copyright notice, 6 | this list of conditions and the following disclaimer. 7 | 2.Redistributions in binary form must reproduce the above copyright notice, 8 | this list of conditions and the following disclaimer in the documentation 9 | and/or other materials provided with the distribution. 10 | 11 | 12 | THIS SOFTWARE IS PROVIDED BY KENICHI SASAGAWA ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, 13 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY 14 | AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 15 | IN NO EVENT SHALL Kenichi Sasagawa OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, 16 | INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 17 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 18 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 19 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 20 | 21 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 22 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, 23 | EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 | 25 | -------------------------------------------------------------------------------- /link.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "npl.h" 5 | 6 | 7 | typedef void (*tpred)(char *, int(*pred)(int, int)); 8 | typedef void (*tuser)(char *, int(*user)(int, int), int weight, int spec); 9 | 10 | 11 | char *get_name(int x) 12 | { 13 | return (GET_NAME(x)); 14 | } 15 | 16 | 17 | void dynamic_link(int x) 18 | { 19 | char str[256] = { "./" }; 20 | void *hmod; 21 | 22 | int (*init_f0)(int x, tpred y); 23 | int (*init_f1)(int x, tpred y); 24 | int (*init_f2)(int x, tpred y); 25 | int (*init_f3)(int x, tpred y); 26 | int (*init_f4)(int x, tpred y); 27 | int (*init_f5)(int x, tpred y); 28 | int (*init_f6)(int x, tpred y); 29 | int (*init_f7)(int x, tpred y); 30 | void (*init_deftpred)(tpred x); 31 | void (*init_deftinfix)(tuser x); 32 | void (*init_tpredicate)(); 33 | void (*init_declare)(); 34 | 35 | if (strstr(GET_NAME(x), "/")) 36 | strcpy(str, GET_NAME(x)); 37 | else 38 | strcat(str, GET_NAME(x)); 39 | 40 | hmod = dlopen(str, RTLD_LAZY); 41 | if (hmod == NULL) 42 | exception(SYSTEM_ERR, makestr("load"), x, 0); 43 | 44 | init_f0 = dlsym(hmod, "init0"); 45 | init_f1 = dlsym(hmod, "init1"); 46 | init_f2 = dlsym(hmod, "init2"); 47 | init_f3 = dlsym(hmod, "init3"); 48 | init_f4 = dlsym(hmod, "init4"); 49 | init_f5 = dlsym(hmod, "init5"); 50 | init_f6 = dlsym(hmod, "init6"); 51 | init_f7 = dlsym(hmod, "init7"); 52 | init_deftpred = dlsym(hmod, "init_deftpred"); 53 | init_deftinfix = dlsym(hmod, "init_deftinfix"); 54 | init_tpredicate = dlsym(hmod, "init_tpredicate"); 55 | init_declare = dlsym(hmod, "init_declare"); 56 | 57 | //argument-0 type 58 | init_f0(CHECKGBC_IDX, (tpred) checkgbc); 59 | init_f0(GBC_IDX, (tpred) gbc); 60 | init_f0(FRESHCELL_IDX, (tpred) freshcell); 61 | init_f0(DEBUG_IDX, (tpred) debug); 62 | 63 | 64 | //argument-1 type 65 | init_f1(CAR_IDX, (tpred) car); 66 | init_f1(CDR_IDX, (tpred) cdr); 67 | init_f1(CADR_IDX, (tpred) cadr); 68 | init_f1(CADDR_IDX, (tpred) caddr); 69 | init_f1(CAAR_IDX, (tpred) caar); 70 | init_f1(CADAR_IDX, (tpred) cadar); 71 | init_f1(PRINT_IDX, (tpred) print); 72 | init_f1(MAKEINT_IDX, (tpred) makeint); 73 | init_f1(LENGTH_IDX, (tpred) length); 74 | init_f1(GET_INT_IDX, (tpred) get_int); 75 | init_f1(LISTP_IDX, (tpred) listp); 76 | init_f1(STRUCTUREP_IDX, (tpred) structurep); 77 | init_f1(VARIABLEP_IDX, (tpred) variablep); 78 | init_f1(GET_SP_IDX, (tpred) get_sp); 79 | init_f1(GET_WP_IDX, (tpred) get_wp); 80 | init_f1(GET_AC_IDX, (tpred) get_ac); 81 | init_f1(INC_PROOF_IDX, (tpred) inc_proof); 82 | init_f1(MAKEVARIANT_IDX, (tpred) makevariant); 83 | init_f1(RANDOM_IDX, (tpred) f_random); 84 | init_f1(ADD_DYNAMIC_IDX, (tpred) add_dynamic); 85 | init_f1(BIGX_TO_PARMANENT_IDX, (tpred) bigx_to_parmanent); 86 | 87 | //argument-2 type 88 | init_f2(CONS_IDX, (tpred) cons); 89 | init_f2(EQP_IDX, (tpred) eqp); 90 | init_f2(EQUALP_IDX, (tpred) equalp); 91 | init_f2(NUMEQP_IDX, (tpred) numeqp); 92 | init_f2(SMALLERP_IDX, (tpred) smallerp); 93 | init_f2(EQSMALLERP_IDX, (tpred) eqsmallerp); 94 | init_f2(GREATERP_IDX, (tpred) greaterp); 95 | init_f2(EQGREATERP_IDX, (tpred) eqgreaterp); 96 | init_f2(LISTCONS_IDX, (tpred) listcons); 97 | init_f2(LIST2_IDX, (tpred) list2); 98 | init_f2(SET_CAR_IDX, (tpred) set_car); 99 | init_f2(SET_CDR_IDX, (tpred) set_cdr); 100 | init_f2(SET_AUX_IDX, (tpred) set_aux); 101 | init_f2(NOT_NUMEQP_IDX, (tpred) not_numeqp); 102 | init_f2(SET_VAR_IDX, (tpred) set_var); 103 | init_f2(NTH_IDX, (tpred) nth); 104 | init_f2(UNBIND_IDX, (tpred) unbind); 105 | init_f2(SET_SP_IDX, (tpred) set_sp); 106 | init_f2(SET_WP_IDX, (tpred) set_wp); 107 | init_f2(SET_AC_IDX, (tpred) set_ac); 108 | init_f2(DEREF_IDX, (tpred) deref); 109 | init_f2(WLIST1_IDX, (tpred) wlist1); 110 | init_f2(SIN_IDX, (tpred) f_sin); 111 | init_f2(ASIN_IDX, (tpred) f_asin); 112 | init_f2(COS_IDX, (tpred) f_cos); 113 | init_f2(ACOS_IDX, (tpred) f_acos); 114 | init_f2(TAN_IDX, (tpred) f_tan); 115 | init_f2(ATAN_IDX, (tpred) f_atan); 116 | init_f2(EXP_IDX, (tpred) f_exp); 117 | init_f2(LOG_IDX, (tpred) f_log); 118 | init_f2(LN_IDX, (tpred) f_ln); 119 | init_f2(LIST1_IDX, (tpred) list1); 120 | init_f2(RANDI_IDX, (tpred) f_randi); 121 | init_f2(SQRT_IDX, (tpred) f_sqrt); 122 | init_f2(INTEGER_IDX, (tpred) f_integer); 123 | init_f2(ABS_IDX, (tpred) f_abs); 124 | init_f2(COMPLEMENT_IDX, (tpred) f_complement); 125 | init_f2(UNIFY_NIL_IDX, (tpred) unify_nil); 126 | init_f2(COPY_WORK_IDX, (tpred) copy_work); 127 | 128 | //argument-3 129 | init_f3(LIST3_IDX, (tpred) list3); 130 | init_f3(ERRORCOMP_IDX, (tpred) errorcomp); 131 | init_f3(WLISTCONS_IDX, (tpred) wlistcons); 132 | init_f3(UNIFY_IDX, (tpred) unify); 133 | init_f3(UNIFY_PAIR_IDX, (tpred) unify_pair); 134 | init_f3(UNIFY_VAR_IDX, (tpred) unify_var); 135 | init_f3(UNIFY_INT_IDX, (tpred) unify_int); 136 | init_f3(UNIFY_FLT_IDX, (tpred) unify_flt); 137 | init_f3(UNIFY_BIG_IDX, (tpred) unify_big); 138 | init_f3(UNIFY_STR_IDX, (tpred) unify_str); 139 | init_f3(UNIFY_ATOM_IDX, (tpred) unify_atom); 140 | init_f3(EXEC_ALL_IDX, (tpred) exec_all); 141 | init_f3(WCONS_IDX, (tpred) wcons); 142 | init_f3(WLIST2_IDX, (tpred) wlist2); 143 | init_f3(ADDTAIL_BODY_IDX, (tpred) addtail_body); 144 | init_f3(PLUS_IDX, (tpred) f_plus); 145 | init_f3(MINUS_IDX, (tpred) f_minus); 146 | init_f3(MULT_IDX, (tpred) f_mult); 147 | init_f3(DIVIDE_IDX, (tpred) f_divide); 148 | init_f3(REMAINDER_IDX, (tpred) s_remainder); 149 | init_f3(QUOTIENT_IDX, (tpred) quotient); 150 | init_f3(MOD_IDX, (tpred) f_mod); 151 | init_f3(EXPT_IDX, (tpred) f_expt); 152 | init_f3(LEFTSHIFT_IDX, (tpred) f_leftshift); 153 | init_f3(RIGHTSHIFT_IDX, (tpred) f_rightshift); 154 | init_f3(LOGICALAND_IDX, (tpred) f_logicaland); 155 | init_f3(LOGICALOR_IDX, (tpred) f_logicalor); 156 | init_f3(ROUND_IDX, (tpred) f_round); 157 | init_f3(DIV_IDX, (tpred) f_div); 158 | init_f3(CALL_IDX, (tpred) call); 159 | 160 | //argument-1 string type 161 | init_f4(MAKECONST_IDX, (tpred) makeconst); 162 | init_f4(MAKEPRED_IDX, (tpred) makepred); 163 | init_f4(MAKEVAR_IDX, (tpred) makevar); 164 | init_f4(MAKESTRFLT_IDX, (tpred) makestrflt); 165 | init_f4(MAKECOMP_IDX, (tpred) makecomp); 166 | init_f4(MAKESYS_IDX, (tpred) makesys); 167 | init_f4(MAKEOPE_IDX, (tpred) makeope); 168 | init_f4(MAKEUSER_IDX, (tpred) makeuser); 169 | init_f4(MAKESTRLONG_IDX, (tpred) makestrlong); 170 | init_f4(MAKEBIGX_IDX, (tpred) makebigx); 171 | init_f4(MAKESTR_IDX, (tpred) makestr); 172 | init_f4(MAKEFUNC_IDX, (tpred) makefunc); 173 | 174 | /* argument 4 */ 175 | init_f5(CALLSUBR_IDX, (tpred) callsubr); 176 | init_f5(WLIST3_IDX, (tpred) wlist3); 177 | 178 | /* argument-1 return char* */ 179 | init_f6(GETNAME_IDX, (tpred) get_name); 180 | 181 | /* argument-1 return double */ 182 | init_f7(GET_FLT_IDX, (tpred) get_flt); 183 | 184 | init_deftpred((tpred) defcompiled); 185 | init_deftinfix((tuser) definfixcomp); 186 | init_tpredicate(); 187 | init_declare(); 188 | link_flag = 1; 189 | return; 190 | } 191 | -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | CC = gcc 2 | LIBS = -lm -ldl -pthread -lcurl 3 | LIBSRASPI = -lm -ldl -lwiringPi -pthread -lcurl 4 | INCS = 5 | CFLAGS = $(INCS) -Wall -O3 6 | LDFLAGS := 7 | DESTDIR := 8 | PREFIX := /usr/local 9 | BINDIR := /bin 10 | DEST = $(DESTDIR)$(PREFIX)$(BINDIR) 11 | CURSES_CFLAGS := $(shell ncursesw6-config --cflags) 12 | CURSES_LIBS := $(shell ncursesw6-config --libs) 13 | 14 | NPL = npl 15 | EDLOG = edlog 16 | 17 | NPL_OBJS = main.o \ 18 | parser.o \ 19 | function.o \ 20 | builtin.o \ 21 | extension.o \ 22 | parallel.o \ 23 | superset.o \ 24 | link.o \ 25 | data.o \ 26 | gbc.o \ 27 | cell.o \ 28 | error.o \ 29 | bignum.o \ 30 | compute.o \ 31 | clp.o \ 32 | edit.o \ 33 | syntax_highlight.o 34 | 35 | EDLOG_OBJS = edlog.o syntax_highlight.o 36 | 37 | ifeq ($(shell uname -n),raspberrypi) 38 | all: $(NPL_OBJS) $(NPL) 39 | $(NPL): $(NPL_OBJS) 40 | $(CC) $(NPL_OBJS) -o $(NPL) $(LIBSRASPI) 41 | else 42 | all: $(NPL_OBJS) $(NPL) $(EDLOG) 43 | $(NPL): $(NPL_OBJS) 44 | $(CC) $(NPL_OBJS) -o $(NPL) $(LIBS) $(LDFLAGS) 45 | endif 46 | 47 | $(EDLOG): $(EDLOG_OBJS) 48 | $(CC) $(LDFLAGS) $^ -o $@ $(CURSES_LIBS) 49 | 50 | edlog.o: edlog.c edlog.h term.h 51 | $(CC) $(CFLAGS) -c edlog.c $(CURSES_CFLAGS) 52 | 53 | install: $(NPL) $(EDLOG) 54 | mkdir -p $(DEST) 55 | install -s $(NPL) $(DEST) 56 | install -s $(EDLOG) $(DEST) 57 | 58 | uninstall: 59 | rm -f $(DEST)/npl $(DEST)/edlog 60 | 61 | %.o: %.c npl.h 62 | $(CC) -c $< -o $@ $(CFLAGS) 63 | 64 | .PHONY: clean all 65 | 66 | clean: 67 | rm -f *.o $(NPL) $(EDLOG) 68 | 69 | 70 | -------------------------------------------------------------------------------- /npl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/sasagawa888/nprolog/4149cc5da57e65c587fcb361a611eb4a453aa278/npl.png -------------------------------------------------------------------------------- /syntax_highlight.c: -------------------------------------------------------------------------------- 1 | 2 | #include 3 | #include 4 | #include "term.h" 5 | #include "npl.h" 6 | 7 | #define NELEM(X) (sizeof(X) / sizeof((X)[0])) 8 | 9 | // dummy 10 | char special[1][1] = { }; 11 | 12 | //operator token 13 | char operator[OPERATOR_NUMBER][5] = { 14 | { ":-" }, { "-->" }, { "," }, { ";" }, { "?-" }, { "." }, 15 | { "+" }, { "-" }, { "*" }, { "/" }, { "//" }, { "<<" }, { ">>" }, 16 | { "\\" }, { "/\\" }, { "\\/" }, { "mod" }, { "^" }, { "**" }, 17 | }; 18 | 19 | char function[FUNCTION_NUMBER][12] = { 20 | { "abs" }, { "sin" }, { "cos" }, { "tan" }, { "asin" }, { "acos" }, 21 | { "atan" }, { "exp" }, { "ln" }, { "log" }, { "sqrt" }, { "round" }, 22 | { "random" }, { "randi" }, { "pi" } 23 | }; 24 | 25 | 26 | //builtin token 27 | char builtin[BUILTIN_NUMBER][30] = { 28 | { "->" }, { "=.." }, { "==" }, { "\\==" }, { "@<" }, 29 | { "@=<" }, { "@>" }, { "@>=" }, { "=:=" }, { "=/=" }, { "=\\=" }, 30 | { "<" }, { "=<" }, { ">" }, { ">=" }, { "\\=" }, { "=" }, { "\\+" }, 31 | { "is" }, { "edit" }, { "open" }, { "close" }, { "create" }, { "dup" }, 32 | { "delete" }, { "rename" }, { "op" }, { "!" }, { "assert" }, 33 | { "asserta" }, { "assertz" }, { "abolish" }, { "read" }, { "write" }, 34 | { "display" }, { "put" }, { "get" }, { "get0" }, { "ifthen" }, 35 | { "ifthenelse" }, { "get0_noecho" }, { "nl" }, { "read_string" }, 36 | { "read_line" }, { "reset_op" }, { "skip" }, { "predicate_property" }, 37 | { "tab" }, { "fail" }, { "not" }, { "true" }, { "halt" }, { "abort" }, 38 | { "listing" }, { "functor" }, { "arg" }, { "writeq" }, { "display" }, 39 | { "ref" }, { "key" }, { "atom_string" }, { "write_canonical" }, 40 | { "consult" }, { "reconsult" }, { "see" }, { "seeing" }, { "seen" }, 41 | { "tell" }, { "telling" }, { "save" }, { "told" }, { "trace" }, 42 | { "notrace" }, { "spy" }, { "nospy" }, { "leash" }, { "atom" }, 43 | { "integer" }, { "real" }, { "float" }, { "number" }, 44 | { "var" }, { "nonvar" }, { "atomic" }, { "list" }, { "gc" }, 45 | { "time" }, { "name" }, { "nth_char" }, { "bounded" }, 46 | { "flush" }, { "date" }, { "date_day" }, 47 | { "string" }, { "string_chars" }, { "string_codes" }, 48 | { "concat" }, { "substring" }, { "string_term" }, { "float_text" }, 49 | { "inc" }, { "dec" }, { "compare" }, 50 | { "mkdir" }, { "rmdir" }, { "chdir" }, { "string_length" }, 51 | { "atom_length" }, 52 | { "sort" }, { "keysort" }, { "length" }, { "shell" }, { "measure" }, 53 | { "syntaxerrors" }, { "fileerrors" }, { "statistics" }, { "eq" }, 54 | { "ansi_cuu" }, { "ansi_cud" }, { "ansi_cuf" }, { "ansi_cub" }, 55 | { "ansi_cup" }, { "ansi_cpr" }, { "ansi_scp" }, { "ansi_rcp" }, 56 | { "ansi_ed" }, { "ansi_el" }, { "errcode" }, 57 | { "recordh" }, { "recorda" }, { "recordz" }, { "recorded" }, 58 | { "record_after" }, { "break" }, { "end_of_file" }, 59 | { "instance" }, { "removeallh" }, { "erase" }, 60 | { "eraseall" }, { "stdin" }, { "stdout" }, { "stdinout" }, 61 | { "ctr_set" }, { "ctr_dec" }, { "ctr_inc" }, { "ctr_is" }, 62 | { "heapd" }, { "list_text" }, { "nref" }, { "pref" }, { "nth_ref" }, 63 | { "replace" }, { "member" }, { "append" }, { "repeat" }, { "system" }, 64 | { "retract" }, { "clause" }, { "call" }, { "directory" }, { "select" }, 65 | { "maplist" }, { "ground" }, { "compound" }, { "once" }, 66 | { "atom_codes" }, { "char_code" }, 67 | { "between" }, { "bagof" }, { "setof" }, { "findall" }, { "succ" }, 68 | { "atom_chars" }, { "atom_concat" }, 69 | { "current_predicate" }, { "current_op" }, { "retrieveh" }, 70 | { "removeh" }, { "unify_with_occurs_check" }, 71 | { "get_code" }, { "get_char" }, { "get_byte" }, { "put_char" }, 72 | { "flush_output" }, { "put_code" }, { "put_byte" }, 73 | { "number_codes" }, { "number_chars" }, { "catch" }, { "throw" }, 74 | { "set_input" }, { "set_output" }, { "use_module" }, { "module" }, 75 | { "copy_term" }, { "set_prolog_flag" }, 76 | { "current_input" }, { "current_output" }, { "at_end_of_stream" }, 77 | { "peek_code" }, { "peek_char" }, { "peek_byte" }, 78 | { "stream_property" }, { "dynamic" }, 79 | { "create_client_socket" }, { "create_server_socket" }, 80 | { "recv_socket" }, { "close_socket" }, 81 | { "create_client_curl" }, { "send_curl" }, { "recv_curl" }, 82 | { "close_curl" }, 83 | { "set_curl_option" }, { "add_curl_header" }, { "string_atom" }, 84 | { "label" }, { "all_different" }, 85 | }; 86 | 87 | //compiled predicate 88 | char compiled[COMPILED_NUMBER][30] = { 89 | }; 90 | 91 | //extened predicate 92 | char extended[EXTENDED_NUMBER][30] = { 93 | { "wiringpi_setup_gpio" }, { "wiringpi_spi_setup" }, 94 | { "pwm_set_mode" }, { "pwm_set_clock" }, { "pwm_set_range" }, 95 | { "pin_mode" }, { "digital_write" }, 96 | { "pwm_write" }, { "pull_up_dn_control" }, { "digital_read" }, 97 | { "delay" }, { "delay_microseconds" }, 98 | { "compile_file" }, { "timer_microseconds" }, { "with" }, 99 | { "existerrors" }, { "dp_create" }, { "dp_consult" }, 100 | { "dp_transfer" }, { "dp_and" }, { "dp_or" }, 101 | { "dp_compile" }, { "dp_prove" }, { "dp_close" }, { "dp_parent" }, 102 | { "dp_child" }, { "dp_wait" }, { "dp_pause" }, { "dp_resume" }, 103 | { "mt_create" }, { "mt_close" }, { "mt_and" }, { "mt_or" }, 104 | { "mt_prove" }, { "cinline" }, { "check_file" }, { "cdeclare" }, 105 | { "clibrary" }, 106 | { "format" }, 107 | }; 108 | 109 | 110 | static bool in_operator_table(const char *str) 111 | { 112 | int i; 113 | 114 | for (i = 0; i < (int) NELEM(operator); i++) { 115 | if (strcmp(operator[i], str) == 0) { 116 | return true; 117 | } 118 | } 119 | return false; 120 | } 121 | 122 | static bool in_builtin_table(const char *str) 123 | { 124 | int i; 125 | 126 | for (i = 0; i < (int) NELEM(builtin); i++) { 127 | if (strcmp(builtin[i], str) == 0) { 128 | return true; 129 | } 130 | } 131 | return false; 132 | } 133 | 134 | static bool in_extended_table(const char *str) 135 | { 136 | int i; 137 | 138 | for (i = 0; i < (int) NELEM(extended); i++) { 139 | if (strcmp(extended[i], str) == 0) { 140 | return true; 141 | } 142 | } 143 | return false; 144 | } 145 | 146 | bool in_special_table(const char *str) 147 | { 148 | int i; 149 | 150 | for (i = 0; i < (int) NELEM(special); i++) { 151 | if (strcmp(special[i], str) == 0) { 152 | return true; 153 | } 154 | } 155 | return false; 156 | } 157 | 158 | bool in_function_table(const char *str) 159 | { 160 | int i; 161 | 162 | for (i = 0; i < (int) NELEM(function); i++) { 163 | if (strcmp(function[i], str) == 0) { 164 | return true; 165 | } 166 | } 167 | return false; 168 | } 169 | 170 | enum HighlightToken maybe_match(const char *str) 171 | { 172 | if (in_operator_table(str)) { 173 | return HIGHLIGHT_OPERATOR; 174 | } 175 | if (in_builtin_table(str)) { 176 | return HIGHLIGHT_BUILTIN; 177 | } 178 | if (in_extended_table(str)) { 179 | return HIGHLIGHT_EXTENDED; 180 | } 181 | if (in_function_table(str)) { 182 | return HIGHLIGHT_FUNCTION; 183 | } 184 | return HIGHLIGHT_NONE; 185 | } 186 | 187 | void 188 | gather_fuzzy_matches(const char *str, const char *candidates[], 189 | int *candidate_pt) 190 | { 191 | int i; 192 | 193 | for (i = 0; i < (int) NELEM(operator); i++) { 194 | if (strstr(operator[i], str) != NULL && operator[i][0] == str[0]) { 195 | candidates[*candidate_pt] = operator[i]; 196 | *candidate_pt = (*candidate_pt) + 1; 197 | } 198 | } 199 | for (i = 0; i < (int) NELEM(builtin); i++) { 200 | if (strstr(builtin[i], str) != NULL && builtin[i][0] == str[0]) { 201 | candidates[*candidate_pt] = builtin[i]; 202 | *candidate_pt = (*candidate_pt) + 1; 203 | } 204 | } 205 | for (i = 0; i < (int) NELEM(extended); i++) { 206 | if (strstr(extended[i], str) != NULL && extended[i][0] == str[0]) { 207 | candidates[*candidate_pt] = extended[i]; 208 | *candidate_pt = (*candidate_pt) + 1; 209 | } 210 | } 211 | } 212 | -------------------------------------------------------------------------------- /term.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Terminal-handling definitions common to the interpreter and edlis. 3 | * This also includes some presentation-related functions, e.g. syntax highlighting. 4 | * 5 | * There are two relevant library layers here: 6 | * 1. Curses is high-level, but only appropriate for fullscreen programs 7 | * 2. Terminfo is lower-level (curses is built on it) 8 | * 9 | * I only considered standardized libraries (e.g. X/Open). 10 | */ 11 | 12 | #ifndef TERM_H 13 | #define TERM_H 14 | 15 | //#include "compat/curses_stubs.h" 16 | #ifndef FULLSCREEN 17 | #include "compat/term_stubs.h" 18 | #endif 19 | #include 20 | 21 | #define COLOR_CYAN 6 22 | 23 | // special charactor 24 | #define EOL '\n' 25 | #define RET '\r' 26 | #define TAB '\t' 27 | #define SPACE ' ' 28 | #define ESC 27 29 | // TCC does not have support for "static conts" as compile time constant 30 | #ifdef __TINYC__ 31 | #define NUL '\0' 32 | #define BEL '\a' 33 | #define BS '\b' 34 | #else 35 | static const char NUL = '\0'; 36 | static const char BEL = '\a'; 37 | static const char BS = '\b'; 38 | #endif 39 | #define DEL 127 40 | 41 | #ifndef FULLSCREEN 42 | #define ARROW_PREFIX '[' 43 | extern char ed_key_down; 44 | extern char ed_key_left; 45 | extern char ed_key_right; 46 | extern char ed_key_up; 47 | #endif 48 | 49 | #ifdef FULLSCREEN 50 | /* 51 | * Edlis uses the higher-level curses interface 52 | */ 53 | 54 | __dead void errw(const char *msg); 55 | #define CHECK(fn, ...) { \ 56 | if ((fn)(__VA_ARGS__) == ERR) { \ 57 | errw(#fn); \ 58 | } \ 59 | } 60 | 61 | static inline void ESCHOME(void) 62 | { 63 | CHECK(move, 0, 0); 64 | } 65 | 66 | static inline void ESCTOP(void) 67 | { 68 | CHECK(move, 1, 0); 69 | } 70 | 71 | static inline void ESCCLS(void) 72 | { 73 | CHECK(clear); 74 | } 75 | 76 | static inline void ESCCLS1(void) 77 | { 78 | CHECK(clrtobot); 79 | } 80 | 81 | static inline void ESCCLSL(void) 82 | { 83 | CHECK(clrtoeol); 84 | } 85 | 86 | static inline void ESCMVLEFT(int x) 87 | { 88 | int dummy, cur_y; 89 | 90 | getyx(stdscr, cur_y, dummy); 91 | CHECK(move, cur_y, x - 1); 92 | } 93 | 94 | static inline void ESCCLSLA(void) 95 | { 96 | ESCMVLEFT(1); 97 | CHECK(clrtoeol); 98 | } 99 | 100 | static inline void ESCMOVE(int y, int x) 101 | { 102 | CHECK(move, y - 1, x - 1); 103 | } 104 | 105 | static inline void ESCFORG(void) 106 | { 107 | if (has_colors()) { 108 | CHECK(color_set, 0, NULL); 109 | } 110 | } 111 | 112 | enum Color { RED_ON_DFL = 113 | 1, YELLOW_ON_DFL, BLUE_ON_DFL, MAGENTA_ON_DFL, CYAN_ON_DFL, 114 | DFL_ON_CYAN, GREEN_ON_DFL, 115 | }; 116 | static inline void ESCBCYAN(void) 117 | { 118 | if (has_colors()) { 119 | CHECK(color_set, DFL_ON_CYAN, NULL); 120 | } 121 | } 122 | 123 | static inline void ESCBORG(void) 124 | { 125 | if (has_colors()) { 126 | CHECK(color_set, 0, NULL); 127 | } 128 | } 129 | 130 | static inline void ESCREV(void) 131 | { 132 | CHECK(attron, A_REVERSE); 133 | } 134 | 135 | static inline void ESCRST(void) 136 | { 137 | CHECK(attrset, A_NORMAL); 138 | } 139 | 140 | static inline void ESCBOLD(void) 141 | { 142 | CHECK(attron, A_BOLD); 143 | } 144 | #elif defined(WITHOUT_CURSES) 145 | #define ESCCLSL() 146 | #define ESCMVLEFT(x) 147 | #define ESCMVU() 148 | #define ESCSCR() 149 | #define ESCFORG() 150 | #define ESCBCYAN() 151 | #define ESCBORG() 152 | #define ESCREV() 153 | #define ESCRST() 154 | #define ESCBOLD() 155 | #else 156 | /* 157 | * The REPL uses the lower-level terminfo interface because we don't want 158 | * to clear the screen 159 | */ 160 | 161 | static inline void ESCCLSL(void) 162 | { 163 | putp(clr_eol); 164 | } 165 | 166 | static inline void ESCMVLEFT(int x) 167 | { 168 | putp(tparm(column_address, x - 1)); 169 | } 170 | 171 | static inline void ESCMVU(void) 172 | { 173 | putp(cursor_up); 174 | } 175 | 176 | static inline void ESCSCR(void) 177 | { 178 | putp(scroll_forward); 179 | } 180 | 181 | static inline void ESCFORG(void) 182 | { 183 | putp(exit_attribute_mode); 184 | } 185 | 186 | static inline void ESCBCYAN(void) 187 | { 188 | putp(tparm(set_a_background, COLOR_CYAN)); 189 | } 190 | 191 | static inline void ESCBORG(void) 192 | { 193 | putp(exit_attribute_mode); 194 | } 195 | 196 | static inline void ESCREV(void) 197 | { 198 | putp(enter_reverse_mode); 199 | } 200 | 201 | static inline void ESCRST(void) 202 | { 203 | putp(exit_attribute_mode); 204 | } 205 | 206 | static inline void ESCBOLD(void) 207 | { 208 | putp(enter_bold_mode); 209 | } 210 | #endif 211 | 212 | enum HighlightToken { HIGHLIGHT_NONE, HIGHLIGHT_OPERATOR, HIGHLIGHT_BUILTIN, 213 | HIGHLIGHT_STRING, HIGHLIGHT_COMMENT, HIGHLIGHT_EXTENDED, HIGHLIGHT_DOUBLEQUOTE, 214 | HIGHLIGHT_MULTILINE_COMMENT, HIGHLIGHT_QUOTE, HIGHLIGHT_FUNCTION, 215 | }; 216 | enum HighlightToken maybe_match(const char *str); 217 | bool in_special_table(const char *str); 218 | void gather_fuzzy_matches(const char *str, 219 | const char *candidates[], int *candidate_pt); 220 | #define COMPLETION_CANDIDATES_MAX 50 221 | 222 | #endif 223 | -------------------------------------------------------------------------------- /tests/ac3.pl: -------------------------------------------------------------------------------- 1 | % AC-3 test 2 | 3 | :- use_module(clpfd). 4 | 5 | test1(X,Y,Z) :- 6 | X in 1..3, 7 | Y in 1..3, 8 | Z in 1..5, 9 | X+Y+Z#=3, 10 | label([X,Y,Z],trace). 11 | 12 | test2(X,Y) :- 13 | X in 1..3, 14 | Y in 1..3, 15 | X #< Y, 16 | label([X,Y],trace). 17 | 18 | test3(X,Y) :- 19 | X in 1..3, 20 | Y in 2..6, 21 | Y #< X, 22 | label([X,Y],trace). 23 | 24 | test4(X,Y) :- 25 | X in 2..3, 26 | Y in 1..5, 27 | Y #<= X, 28 | label([X,Y],trace). 29 | 30 | test5(X,Y) :- 31 | X in 2..3, 32 | Y in 1..5, 33 | X #> Y, 34 | label([X,Y],trace). 35 | 36 | test6(X,Y) :- 37 | X in 2..3, 38 | Y in 1..5, 39 | X #>= Y, 40 | label([X,Y],trace). 41 | 42 | test7(X,Y) :- 43 | X in 1..10, 44 | Y in 1..10, 45 | X #= Y mod 3, 46 | label([X,Y],trace). 47 | 48 | test8(X,Y) :- 49 | X in 1..10, 50 | Y in 1..10, 51 | X #= Y ^ 3, 52 | label([X,Y],trace). 53 | 54 | test9(X,Y) :- 55 | X in 1..10, 56 | Y in 1..10, 57 | X #= Y ** 3, 58 | label([X,Y],trace). 59 | 60 | 61 | test10(X,Y) :- 62 | X in 1..10, 63 | Y in 1..10, 64 | X #= Y // 3, 65 | label([X,Y],trace). 66 | 67 | test11(X,Y) :- 68 | X in 1..3, 69 | Y in 1..3, 70 | X #> Y, 71 | Y #> X, 72 | label([X,Y],trace). 73 | -------------------------------------------------------------------------------- /tests/ack.pl: -------------------------------------------------------------------------------- 1 | % test for robustness 2 | 3 | %:- dynamic(ack/3). 4 | % association computation 5 | 6 | ack(0,N,A) :- 7 | A is N+1,asserta(ack(0,N,A)). 8 | ack(M,0,A) :- 9 | M1 is M-1,ack(M1,1,A), 10 | asserta(ack(M1,1,A)), 11 | asserta(ack(M,0,A)). 12 | ack(M,N,A) :- 13 | M1 is M-1,N1 is N-1, 14 | ack(M,N1,A1), ack(M1,A1,A), 15 | asserta(ack(M,N1,A1)), 16 | asserta(ack(M1,A1,A)). 17 | -------------------------------------------------------------------------------- /tests/ack1.pl: -------------------------------------------------------------------------------- 1 | 2 | ack(M,N,X) :- 3 | cinline($ //ackermann function 4 | int a(int m, int n){ 5 | if(m==0) return(n+1); 6 | else if(n==0) return(a(m-1,1)); 7 | else return(a(m-1,a(m,n-1))); 8 | } 9 | int m = Jget_int(Jderef(varM,th)); 10 | int n = Jget_int(Jderef(varN,th)); 11 | int res = a(m,n); 12 | Junify(varX,Jmakeint(res),th); 13 | return(Jexec_all(rest,Jget_sp(th),th)); $). -------------------------------------------------------------------------------- /tests/bench.pl: -------------------------------------------------------------------------------- 1 | % Benchmark and Measurement Program (DEC-10 Prolog) 2 | % Originally written by D.H.Warren. Modified for N-Prolog by K.Sasagawa 3 | 4 | % Reverse a list 5 | nreverse([X|L0], L) :- nreverse(L0, L1), concatenate(L1, [X], L). 6 | nreverse([], []) :- !. 7 | 8 | % Concatenate two lists 9 | concatenate([X|L1], L2, [X|L3]) :- !, concatenate(L1, L2, L3). 10 | concatenate([], L, L) :- !. 11 | 12 | % List of 30 elements for testing 13 | list30([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 15, 14, 15, 16, 17, 18, 19, 20, 14 | 21, 22, 25, 24, 25, 26, 27, 28, 29, 30]). 15 | 16 | % Quicksort 17 | qsort([X|L], R, R0) :- 18 | partition(L, X, L1, L2), 19 | qsort(L2, R1, R0), 20 | qsort(L1, R, [X|R1]). 21 | qsort([], R, R) :- !. 22 | 23 | % Partition list for quicksort 24 | partition([X|L], Y, [X|L1], L2) :- 25 | X < Y, !, partition(L, Y, L1, L2). 26 | partition([X|L], Y, L1, [X|L2]) :- 27 | !,partition(L, Y, L1, L2). 28 | partition([], _ , [], []) :- !. 29 | 30 | % List of 50 elements for another test 31 | list50([27, 74, 17, 33, 94, 18, 46, 83, 65, 2, 32, 53, 28, 85, 99, 47, 28, 82, 6, 11, 32 | 55, 29, 39, 81, 90, 37, 10, 0, 66, 51, 7, 21, 85, 27, 31, 63, 75, 4, 95, 99, 11, 28, 61, 33 | 74, 18, 92, 40, 55, 59, 8]). 34 | 35 | % Repeat a procedure 36 | repeat_for(0) :- !, fail. 37 | repeat_for(N). 38 | repeat_for(N) :- 39 | M is N - 1, 40 | repeat_for(M). 41 | 42 | % Run various tests 43 | run(none, N) :- repeat_for(N), fail. 44 | run(qsort, N) :- 45 | list50(X), 46 | repeat_for(N), 47 | qsort(X, _, []), 48 | fail. 49 | 50 | run(reverse, N) :- 51 | list30(X), 52 | repeat_for(N), 53 | nreverse(X, _), 54 | fail. 55 | 56 | run(_,_). 57 | 58 | % Testing and benchmarking 59 | test(F, N) :- 60 | measure(run(F, N)). 61 | -------------------------------------------------------------------------------- /tests/bug.pl: -------------------------------------------------------------------------------- 1 | % test for GNU-Prolog 2 | % ?- statistics(runtime, [T0|_]), send(Vars), statistics(runtime, [T1|_]), T is T1 - T0. 3 | send(Vars) :- 4 | Vars = [S,E,N,D,M,O,R,Y], 5 | fd_domain(Vars, 0, 9), 6 | fd_all_different(Vars), 7 | S #\= 0, 8 | M #\= 0, 9 | 1000*S + 100*E + 10*N + D + 1000*M + 100*O + 10*R + E 10 | #= 10000*M + 1000*O + 100*N + 10*E + Y, 11 | fd_labeling(Vars). 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /tests/calc.py: -------------------------------------------------------------------------------- 1 | # calc.py test for tensorflow 2 | import os 3 | os.environ['TF_CPP_MIN_LOG_LEVEL'] = '2' 4 | import tensorflow as tf 5 | print(tf.add(1, 2).numpy()) 6 | -------------------------------------------------------------------------------- /tests/chatgpt.pl: -------------------------------------------------------------------------------- 1 | :- use_module(json). 2 | 3 | % ChatGPT sned massage to API and recieve response 4 | call_chatgpt(Prompt, Response) :- 5 | create_curl_client(Curl, 'https://api.openai.com/v1/completions'), 6 | ApiKey = 'your-api-key-here', 7 | set_curl_option(Curl, header('Content-Type: application/json')), 8 | atom_concat('Authorization: Bearer ',Apikey,Header), 9 | set_curl_option(Curl, header(Header)), 10 | json_data(Prompt, JSONData), 11 | send_curl(Curl, JSONData), 12 | recv_curl(Curl, Response), 13 | close_curl(Curl). 14 | 15 | % convert prompt to JSON format 16 | json_data(Prompt, JSONData) :- 17 | format(JSONData, '{"model": "gpt-3.5-turbo", "messages": [{"role": "user", "content": "~w"}]}', [Prompt]). 18 | 19 | % ?- call_chatgpt('What is the capital of France?', Response). -------------------------------------------------------------------------------- /tests/clpfd.pl: -------------------------------------------------------------------------------- 1 | % CLP-test 2 | 3 | :- use_module(clpfd). 4 | 5 | ac(X,Y,Z) :- 6 | X in 1..3, 7 | Y in 1..3, 8 | Z in 1..5, 9 | X+Y+Z#=3, 10 | label([X,Y,Z],trace). 11 | 12 | foo(L) :- 13 | L = [A, B, C], 14 | L ins 1..3, 15 | all_different(L), 16 | A# 0, 22 | N1 #= N - 1, 23 | n_factorial(N1, F1), 24 | F #= N * F1. 25 | 26 | test1(X) :- 27 | X in 1..3, 28 | label([X]). 29 | 30 | 31 | test2(X, Y) :- 32 | X in 1..4, 33 | Y in 1..4, 34 | X #= Y+1, 35 | X #>= Y, 36 | label([X, Y]). 37 | 38 | test3(X, Y) :- 39 | X in 1..2, 40 | Y in 2..3, 41 | all_different([X, Y]), 42 | label([X, Y]). 43 | 44 | test4(X) :- 45 | X in 1..5, 46 | X #\= 3, 47 | label([X]). 48 | 49 | test5(X,Y) :- 50 | X in 1..5, 51 | Y in 1..3, 52 | X #= Y, 53 | X+Y #= 6, 54 | label([X,Y]). 55 | 56 | test6(X, Y, Z) :- 57 | X in 1..3, 58 | Y in 1..3, 59 | Z in 1..3, 60 | X + Y + Z #= 5, 61 | X #< Z, 62 | label([X, Y, Z]). 63 | 64 | test7(X,Y) :- 65 | X in 1..10, 66 | Y in 1..10, 67 | X #= Y mod 3, 68 | label([X,Y]). 69 | 70 | test8(X,Y) :- 71 | X in 1..10, 72 | Y in 1..10, 73 | X #= Y ^ 3, 74 | label([X,Y]). 75 | 76 | test9(X,Y) :- 77 | X in 1..10, 78 | Y in 1..10, 79 | X #= Y ** 3, 80 | label([X,Y]). 81 | 82 | 83 | test10(X,Y) :- 84 | X in 1..10, 85 | Y in 1..10, 86 | X #= Y // 3, 87 | label([X,Y]). 88 | 89 | 90 | test :- nqueens(X),fail. 91 | 92 | nqueens(Queens) :- 93 | length(Queens, 9), 94 | Queens ins 1..9, 95 | all_different(Queens), 96 | safe(Queens), 97 | label(Queens). 98 | 99 | safe([]). 100 | safe([Q|Rest]) :- 101 | safe(Rest), 102 | no_attack(Q, Rest, 1). 103 | 104 | no_attack(_, [], _). 105 | no_attack(Q, [Q2|Rest], Dist) :- 106 | Q #\= Q2 + Dist, 107 | Q #\= Q2 - Dist, 108 | Dist1 #= Dist + 1, 109 | no_attack(Q, Rest, Dist1). 110 | 111 | 112 | magic(Xs) :- 113 | Xs = [A, B, C, D, E, F, G, H, I], 114 | Xs ins 1..9, 115 | all_different(Xs), 116 | N #= A + B + C, 117 | N #= D + E + F, 118 | N #= G + H + I, 119 | N #= A + D + G, 120 | N #= B + E + H, 121 | N #= C + F + I, 122 | N #= A + E + I, 123 | N #= C + E + G, 124 | label(Xs). 125 | 126 | 127 | boo(Xs) :- 128 | Xs = [A,B,C], 129 | Xs ins 1..9, 130 | all_different(Xs), 131 | N #= A+B, 132 | N #= B+C, 133 | label(Xs). 134 | 135 | equations(X,Y,Z) :- 136 | X + Y + Z #= 10, 137 | 2*X + 4*Y + 6*Z #= 38, 138 | 2*X + 4*Z #= 14, 139 | [X,Y,Z] ins 1..10, 140 | label([X,Y,Z]). 141 | 142 | perm(Xs) :- 143 | Xs = [X, Y, Z], 144 | Xs ins 1..3, 145 | X #\= Y, 146 | X #\= Z, 147 | Y #\= Z, 148 | label(Xs). 149 | 150 | mask(Wrong,M,Right) :- 151 | Xs = [W, R, O, N, G, M, I, H, T], 152 | Xs ins 1..9, 153 | all_different(Xs), 154 | Wrong #= 10000*W + 1000*R + 100*O + 10*N + G, 155 | Right #= 10000*R + 1000*I + 100*G + 10*H + T, 156 | Wrong * M #= Right, 157 | label([Wrong,M,Right]). 158 | 159 | send([S,E,N,D,M,O,R,Y]) :- 160 | Vars = [M,S,E,O,N,R,D,Y], 161 | Vars ins 0..9, 162 | all_different(Vars), 163 | S #\= 0, 164 | M #\= 0, 165 | (D+E) mod 10 #= Y, 166 | (((D+E) // 10) + N+R) mod 10 #= E, 167 | (((((D+E) // 10) + N+R) // 10) + E+O) mod 10 #= N, 168 | %((((((D+E) // 10) + N+R) // 10) + E+O) // 10) + S+M #= 10*M, 169 | 1000*S + 100*E + 10*N + D + 1000*M + 100*O + 10*R + E 170 | #= 10000*M + 1000*O + 100*N + 10*E + Y, 171 | label(Vars). 172 | 173 | taxi(Vars) :- 174 | Vars = [A1, B1, A2, B2], 175 | Vars ins 1..20, 176 | all_different(Vars), 177 | A1 #< B1, 178 | A2 #< B2, 179 | N #= A1^3 + B1^3, 180 | N #= A2^3 + B2^3, 181 | label(Vars). 182 | -------------------------------------------------------------------------------- /tests/clpqueen.pl: -------------------------------------------------------------------------------- 1 | :- use_module(library(clpfd)). 2 | 3 | not_attack(_, [], _). 4 | not_attack(X, [Y | Ys], N) :- 5 | abs(X - Y) #\= N, 6 | N1 #= N + 1, 7 | not_attack(X, Ys, N1). 8 | 9 | safe([_]). 10 | safe([X | Xs]) :- not_attack(X, Xs, 1), safe(Xs). 11 | 12 | nqueens(N, Xs) :- 13 | length(Xs, N), 14 | Xs ins 1 .. N, 15 | all_different(Xs), 16 | safe(Xs). 17 | -------------------------------------------------------------------------------- /tests/collatz.pl: -------------------------------------------------------------------------------- 1 | % Collatz problem 2 | 3 | collatz(1). 4 | collatz(N) :- 5 | N > 1, N mod 2 =:= 0, 6 | N1 is N//2, 7 | write(N1), write(' '), 8 | collatz(N1). 9 | collatz(N) :- 10 | N > 1, N mod 2 =:= 1, 11 | N1 is 3*N+1, 12 | write(N1), write(' '), 13 | collatz(N1). -------------------------------------------------------------------------------- /tests/curl.pl: -------------------------------------------------------------------------------- 1 | 2 | % curl test 3 | :- use_module(json). 4 | 5 | foo(T) :- 6 | create_client_curl(C, "https://httpbin.org/post"), 7 | set_curl_option(C, method(post)), 8 | send_curl(C, "hello=world"), 9 | recv_curl(C, R), 10 | string_term(R,J), 11 | term_json(T,J), 12 | write(R),nl, 13 | close_curl(C). 14 | 15 | -------------------------------------------------------------------------------- /tests/dpqueens.pl: -------------------------------------------------------------------------------- 1 | % 10-queens program in parallel 2 | 3 | %parallel 10queens 4 | para :- dp_and([test1,test2]). 5 | 6 | test1 :- queens1,queens2,queens3,queens4,queens5. 7 | test2 :- queens6,queens7,queens8,queens9,queens10. 8 | 9 | queens1 :- pqueen(1,[2,3,4,5,6,7,8,9,10],_),fail. 10 | queens1. 11 | queens2 :- pqueen(2,[1,3,4,5,6,7,8,9,10],_),fail. 12 | queens2. 13 | queens3 :- pqueen(3,[1,2,4,5,6,7,8,9,10],_),fail. 14 | queens3. 15 | queens4 :- pqueen(4,[1,2,3,5,6,7,8,9,10],_),fail. 16 | queens4. 17 | queens5 :- pqueen(5,[1,2,3,4,6,7,8,9,10],_),fail. 18 | queens5. 19 | queens6 :- pqueen(6,[1,2,3,4,5,7,8,9,10],_),fail. 20 | queens6. 21 | queens7 :- pqueen(7,[1,2,3,4,5,6,8,9,10],_),fail. 22 | queens7. 23 | queens8 :- pqueen(8,[1,2,3,4,5,6,7,9,10],_),fail. 24 | queens8. 25 | queens9 :- pqueen(9,[1,2,3,4,5,6,7,8,10],_),fail. 26 | queens9. 27 | queens10 :- pqueen(10,[1,2,3,4,5,6,7,8,9],_),fail. 28 | queens10. 29 | 30 | pqueen(N, Data, [N|Out]) :- 31 | pqueen_2(N, Data, [N], Out). 32 | 33 | 34 | pqueen_2(_, [], _, []). 35 | pqueen_2(N, [H|T], History, [Q|M]) :- 36 | qdelete(Q, H, T, L1), 37 | nodiag(History, Q, 1), 38 | pqueen_2(N, L1, [Q|History], M). 39 | 40 | % sequential 10queens 41 | seq :- queen([1,2,3,4,5,6,7,8,9,10],_),fail. 42 | 43 | queen(Data, Out) :- 44 | queen_2(Data, [], Out). 45 | 46 | 47 | queen_2([], _, []). 48 | queen_2([H|T], History, [Q|M]) :- 49 | qdelete(Q, H, T, L1), 50 | nodiag(History, Q, 1), 51 | queen_2(L1, [Q|History], M). 52 | 53 | 54 | qdelete(A, A, L, L). 55 | qdelete(X, A, [H|T], [A|R]) :- 56 | qdelete(X, H, T, R). 57 | 58 | 59 | nodiag([], _, _). 60 | nodiag([N|L], B, D) :- 61 | D =\= N - B, 62 | D =\= B - N, 63 | D1 is D + 1, 64 | nodiag(L, B, D1). 65 | -------------------------------------------------------------------------------- /tests/exception.pl: -------------------------------------------------------------------------------- 1 | % verfication tests 2 | 3 | :- catch(length([],1.1),error(type_error(integer,1.1),length/2),true). 4 | :- catch(length(a,X),error(type_error(list,a),length/2),true). 5 | :- catch(length([1|2],X),error(type_error(list,[1|2]),length/2),true). 6 | :- catch(length([1],-1),error(domain_error(not_less_than_zero,-1),length/2),true). 7 | :- catch(length([],0,1),error(existence_error(predicate,length/3),length/3),true). 8 | :- catch(length(X,X),error(instantiation_error,length/2),true). 9 | 10 | :- catch(repeat(1),error(existence_error(predicate,repeat/1),repeat/1),true). 11 | :- catch(=(1,2,3),error(existence_error(predicate,(=)/3),(=)/3),true). 12 | :- catch(\=(1,2,3),error(existence_error(predicate,(\=)/3),(\=)/3),true). 13 | 14 | :- catch(write(X,1),error(instantiation_error,write/2),true). 15 | :- catch(write(1,1),error(domain_error(stream_or_alias,1),write/2),true). 16 | :- catch(display(X,1),error(instantiation_error,display/2),true). 17 | :- catch(display(1,1),error(domain_error(stream_or_alias,1),display/2),true). 18 | :- catch(writeq(X,1),error(instantiation_error,writeq/2),true). 19 | :- catch(writeq(1,1),error(domain_error(stream_or_alias,1),writeq/2),true). 20 | 21 | :- catch(nl(1),error(domain_error(stream_or_alias,1),nl/1),true). 22 | :- catch(nl(1,2),error(existence_error(predicate,nl/2),nl/2),true). 23 | 24 | :- catch(atom_length(1,X),error(type_error(atom,1),atom_length/2),true). 25 | :- catch(atom_length(abc,1.1),error(type_error(integer,1.1),atom_length/2),true). 26 | :- catch(atom_length,error(existence_error(predicate,atom_length/0),atom_length/0),true). 27 | 28 | :- catch(catch(1,2,3),error(type_error(callable,1),catch/3),true). 29 | 30 | :- catch(call(1),error(type_error(callable,1),call/1),true). 31 | 32 | :- catch(see(foo),error(existence_error(source_sink,foo),see/1),true). 33 | 34 | :- catch((X is a),error(type_error(number,a),is/2),true). 35 | :- catch((X is Y),error(instantiation_error,is/2),true). 36 | :- catch((X is 1/0),error(evaluation_error(evalution_error,zero_divisor),is/2),true). 37 | :- catch((X is log(0)),error(evaluation_error(float_overflow,0),log/1),true). 38 | :- catch((X is ln(0)),error(evaluation_error(float_overflow,0),ln/1),true). 39 | 40 | :- catch(compare(~,1,2),error(domain_error(order,'~'),compare/3),true). 41 | 42 | :- catch(succ(a,X),error(type_error(integer,a),succ/2),true). 43 | :- catch(succ(X,b),error(type_error(integer,b),succ/2),true). 44 | :- catch(succ(-1,X),error(domain_error(not_less_than_zero,-1),succ/2),true). 45 | :- catch(succ(X,-2),error(domain_error(not_less_than_zero,-2),succ/2),true). 46 | 47 | :- catch(maplist(1,[1,2,3]),error(type_error(callable,1),maplist/2),true). 48 | :- catch(maplist(sin,[1,2,3]),error(type_error(callable,sin(1)),maplist/2),true). 49 | :- catch(maplist(length,[1,2,3]),error(existence_error(predicate,length/1),length/1),true). 50 | 51 | :- catch(between(X,2,Y),error(instantiation_error,between/3),true). 52 | :- catch(between(1,X,Y),error(instantiation_error,between/3),true). -------------------------------------------------------------------------------- /tests/fact.pl: -------------------------------------------------------------------------------- 1 | fact(0,1). 2 | facT(N,X) :- 3 | N1 is N-1, 4 | fact(N1,X1), 5 | X is N*X1. 6 | -------------------------------------------------------------------------------- /tests/fact1.pl: -------------------------------------------------------------------------------- 1 | fact(0,1) :- !. 2 | fact(N,X) :- 3 | N1 is N-1, 4 | fact(N1,X1), 5 | X is N*X1. 6 | -------------------------------------------------------------------------------- /tests/function.pl: -------------------------------------------------------------------------------- 1 | 2 | test0(X,Y,Z) :- Z is X+Y. 3 | test1(X,Y,Z) :- Z is X << Y. 4 | test2(X,Y,Z) :- Z is X >> Y. 5 | test3(X,Y) :- Y is randi(X). 6 | test4(X) :- X is random. 7 | test5(X,Y,Z) :- Z is X / Y. 8 | test6(X,Y,Z) :- Z is X // Y. 9 | test7(X,Y,Z) :- Z is X*Y+1-3. 10 | test8(X,Y,Z) :- Z is X mod Y. 11 | test9(X,Y,Z) :- Z is X^Y. 12 | test10(X,Y) :- Y is sin(X). 13 | test11(X,Y) :- Y is cos(X). 14 | test12(X,Y) :- Y is tan(X). 15 | test13(X,Y) :- Y is integer(X). 16 | test14(X,Y) :- Y is abs(X). 17 | test15(X,Y) :- Y is sqrt(X). 18 | test16(X,Y) :- Y is log(X). 19 | test17(X,Y) :- Y is ln(X). 20 | test18(X,Y) :- Y is asin(X). 21 | test19(X,Y) :- Y is acos(X). 22 | test20(X,Y) :- Y is atan(X). 23 | test21(X,Y) :- Y is \X. 24 | test22(X,Y,Z) :- Z is X/\Y. 25 | test23(X,Y,Z) :- Z is X\/Y. 26 | 27 | 28 | -------------------------------------------------------------------------------- /tests/http.pl: -------------------------------------------------------------------------------- 1 | start_server(Port) :- 2 | create_server_socket(S, Port), 3 | loop(S). 4 | 5 | loop(ServerSocket) :- 6 | % クライアント接続を受け入れる 7 | accept_connection(ServerSocket, ClientSocket), 8 | recv_socket(ClientSocket, RequestAtom), 9 | % HTTPレスポンスを構築 10 | atom_concat('HTTP/1.1 200 OK\r\nContent-Type: text/plain\r\n\r\nHello, world!', '', Response), 11 | send_socket(ClientSocket, Response), 12 | close_socket(ClientSocket), 13 | loop(ServerSocket). 14 | 15 | accept_connection(ServerSocket, ClientSocket) :- 16 | % ServerSocketでrecv_socketを試してClientSocketにバインドするような処理が必要 17 | recv_socket(ServerSocket, ClientSocket). % この動作はN-Prologの実装次第 -------------------------------------------------------------------------------- /tests/iitaka.pl: -------------------------------------------------------------------------------- 1 | % codes from Dr. iidaka's book 2 | 3 | 4 | sum1(0,0) :- !. 5 | sum1(J,S1) :- I is J-1,sum1(I,S),S1 is S + J. 6 | 7 | sum2(0,0). 8 | sum2(J,S1) :- J>0,I is J-1,sum2(I,S),S1 is S + J. 9 | 10 | sigma(A - B,Sum) :- 11 | C is B - A, 12 | sigma_aux([A,C,Sum],0,A). 13 | 14 | sigma_aux([A,C,Sum],C,Sum). 15 | sigma_aux(Const,N,Sum) :- 16 | Const = [A|_], 17 | N1 is N+1, 18 | Sum1 is Sum + N1 + A, 19 | sigma_aux(Const,N1,Sum1). 20 | 21 | not0(P) :- P,!,fail. 22 | not0(P). 23 | 24 | for(I =< I,I) :- !. 25 | for(I =< J,I). 26 | for(I =< J,K) :- I1 is I+1,for(I1 =< J,K). 27 | 28 | f99 :- for( 1 =< 9,X),for(1 =< 9,Y), 29 | Z is X*Y, write((Z = X * Y)),nl,fail. 30 | 31 | 32 | test :- 33 | X = [1,2,3,4,5], 34 | member(A,X), 35 | write(A), 36 | tab(1), 37 | fail. 38 | 39 | positive(L) :- member(X,L),ifthenelse(X>0,fail,(!,fail)). 40 | positive(L). 41 | 42 | 43 | member2(A,B,[A|Y]) :- member(B,Y). 44 | member2(A,B,[_|Y]) :- member2(A,B,Y). 45 | 46 | set(L==M) :- 47 | sort(L,L0), 48 | sort(M,M0), 49 | L0 == M0. 50 | 51 | :- op(700,xfx,isl). 52 | 53 | Y isl [] + Y :- !. 54 | Z isl [A|X] + Y :- member(A,Y),!,Z isl X + Y. 55 | [A|Z] isl [A|X] + Y :- Z isl X + Y. 56 | 57 | %p131 58 | memberr([A],X,1) :- member(A,X). 59 | memberr([A|LA],[A|Y],R) :- 60 | R>1,R1 is R-1,memberr(LA,Y,R1). 61 | memberr(A,[_|Y],R) :- 62 | R>1,memberr(A,Y,R). 63 | 64 | /* generate [1,2,3,4,...] */ 65 | generate_e(N,E) :- gene_e_aux(E,N,[]). 66 | gene_e_aux(L,0,L) :- !. 67 | gene_e_aux(Result,N,L) :- 68 | N1 is N-1, 69 | gene_e_aux(Result,N1,[N|L]). 70 | 71 | /* problem */ 72 | 73 | 74 | comb(N,R) :- generate_e(N,X), 75 | memberr(A,X,R), 76 | write(A),nl,fail. 77 | 78 | 79 | permutation([],[]). 80 | permutation([A|X1],Y) :- 81 | delete0(Y1 = Y - A), 82 | permutation(X1,Y1). 83 | 84 | delete0(X = [A|X]-A). 85 | delete0([B|Y] = [B|X] - A) :- 86 | delete0(Y = X - A). 87 | 88 | 89 | %p41 90 | % quarternion q(A,B,C,D) see quarternion.pl 91 | 92 | 93 | %63 94 | newton(X, A) :- 95 | newton1(1.0, A, A, X). 96 | 97 | newton1(X1, X2, A, X) :- 98 | abs(X1 - X2) < 0.00001, 99 | X is X2. 100 | newton1(X1, X2, A, X) :- 101 | Y is X1 / 2 + A / (2 * X1), 102 | newton1(Y, X1, A, X). 103 | 104 | %p126 105 | factor(P,I*Q) :- 106 | Q is integer(P/I + 0.001), 107 | R is P - I*Q, 108 | (R==0 ; Q < I). 109 | 110 | factor(P/2):- factor(P,2*Q),!. 111 | factor(P/I):- for(I =< P,J), 112 | J1 is 2*J+1, 113 | factor(P,J1*Q), 114 | ifthenelse(Q put_char(OutStream, Char), 59 | copy_stream_data(InStream, OutStream) 60 | ; true 61 | ). 62 | -------------------------------------------------------------------------------- /tests/json.pl: -------------------------------------------------------------------------------- 1 | 2 | % JSON tests 3 | :- use_module(json). 4 | 5 | test(predicate) :- 6 | term_json(foo(1),J), 7 | J = {"predicate":"foo","argument":[1]}. 8 | test(rpredicate) :- 9 | J = {"predicate":"foo","argument":[1]}, 10 | term_json(T,J), 11 | T = foo(1). 12 | 13 | 14 | test(clause) :- 15 | term_json((foo(1):-bar(2)),J), 16 | J = {"head":{"predicate":"foo","argument":[1]},"body":{"predicate":"bar","argument":[2]}}. 17 | test(rclause) :- 18 | J = {"head":{"predicate":"foo","argument":[1]},"body":{"predicate":"bar","argument":[2]}}, 19 | term_json(T,J), 20 | T = ((foo(1):-bar(2))). 21 | 22 | 23 | test(true) :- 24 | term_json(T,"true"), 25 | T = '@true'. 26 | test(rtrue) :- 27 | term_json('@true',J), 28 | J = "true". 29 | 30 | test(null) :- 31 | term_json(T,"null"), 32 | T = '@null'. 33 | 34 | test(rnull) :- 35 | term_json('@null',J), 36 | J = "null". 37 | 38 | 39 | test(basic) :- 40 | term_json([id=1,id=2],J), 41 | J = [{"id":1},{"id":2}]. 42 | 43 | test(rbasic) :- 44 | J = [{"id":1},{"id":2}], 45 | term_json(T,J), 46 | T = [id=1,id=2]. 47 | -------------------------------------------------------------------------------- /tests/mpw.pl: -------------------------------------------------------------------------------- 1 | :- use_module(mpworld). 2 | 3 | % World multiplex mechanism 4 | %example1 5 | :- with(a,assertz(p(a))). 6 | :- with(b,assertz(p(b))). 7 | :- with(c,assertz(p(c1))). 8 | :- with(c,assertz(p(c2))). 9 | 10 | %example2 11 | % with(w1,with(w2,with(w3,fly(canary)))). -> yes 12 | % with(w1,with(w2,with(w3,fly(penguin)))). -> no 13 | :- with(w1,assertz(bird(canary))). 14 | :- with(w1,assertz(bird(penguin))). 15 | :- with(w2,assertz((fly(X) :- bird(X)))). 16 | :- with(w3,deny(fly(penguin))). -------------------------------------------------------------------------------- /tests/mtqueens.pl: -------------------------------------------------------------------------------- 1 | % 10-queens program in parallel 2 | 3 | :- mt_create(2). 4 | %parallel 10queens 5 | para :- mt_and([test1,test2]). 6 | 7 | test1 :- queens1,queens2,queens3,queens4,queens5. 8 | test2 :- queens6,queens7,queens8,queens9,queens10. 9 | 10 | queens1 :- pqueen(1,[2,3,4,5,6,7,8,9,10],X),fail. 11 | queens1. 12 | queens2 :- pqueen(2,[1,3,4,5,6,7,8,9,10],X),fail. 13 | queens2. 14 | queens3 :- pqueen(3,[1,2,4,5,6,7,8,9,10],X),fail. 15 | queens3. 16 | queens4 :- pqueen(4,[1,2,3,5,6,7,8,9,10],X),fail. 17 | queens4. 18 | queens5 :- pqueen(5,[1,2,3,4,6,7,8,9,10],X),fail. 19 | queens5. 20 | queens6 :- pqueen(6,[1,2,3,4,5,7,8,9,10],X),fail. 21 | queens6. 22 | queens7 :- pqueen(7,[1,2,3,4,5,6,8,9,10],X),fail. 23 | queens7. 24 | queens8 :- pqueen(8,[1,2,3,4,5,6,7,9,10],X),fail. 25 | queens8. 26 | queens9 :- pqueen(9,[1,2,3,4,5,6,7,8,10],X),fail. 27 | queens9. 28 | queens10 :- pqueen(10,[1,2,3,4,5,6,7,8,9],X),fail. 29 | queens10. 30 | 31 | pqueen(N, Data, [N|Out]) :- 32 | pqueen_2(N, Data, [N], Out). 33 | 34 | 35 | pqueen_2(_, [], _, []). 36 | pqueen_2(N, [H|T], History, [Q|M]) :- 37 | qdelete(Q, H, T, L1), 38 | nodiag(History, Q, 1), 39 | pqueen_2(N, L1, [Q|History], M). 40 | 41 | % sequential 10queens 42 | seq :- queen([1,2,3,4,5,6,7,8,9,10],X),fail. 43 | 44 | queen(Data, Out) :- 45 | queen_2(Data, [], Out). 46 | 47 | 48 | queen_2([], _, []). 49 | queen_2([H|T], History, [Q|M]) :- 50 | qdelete(Q, H, T, L1), 51 | nodiag(History, Q, 1), 52 | queen_2(L1, [Q|History], M). 53 | 54 | 55 | qdelete(A, A, L, L). 56 | qdelete(X, A, [H|T], [A|R]) :- 57 | qdelete(X, H, T, R). 58 | 59 | 60 | nodiag([], _, _). 61 | nodiag([N|L], B, D) :- 62 | D =\= N - B, 63 | D =\= B - N, 64 | D1 is D + 1, 65 | nodiag(L, B, D1). 66 | -------------------------------------------------------------------------------- /tests/opengl.pl: -------------------------------------------------------------------------------- 1 | main :- 2 | glut_init, 3 | glut_init_display_mode(glut_single), 4 | glut_init_window_size(400,300), 5 | glut_init_window_position(200,300), 6 | glut_create_window('GLUT test'), 7 | glut_init_display_mode(glut_rgba), 8 | gl_clear_color(1.0,1.0,1.0,1.0), 9 | glut_display_func(show), 10 | glut_main_loop. 11 | 12 | 13 | show :- 14 | gl_clear(gl_color_buffer_bit), 15 | gl_color3d(1.0,0.0,0.0), 16 | gl_begin(gl_line_loop), 17 | gl_vertex2d(-0.5,-0.5), 18 | gl_vertex2d(-0.5,0.5), 19 | gl_vertex2d(0.5,0.5), 20 | gl_vertex2d(0.5,-0.5), 21 | gl_end, 22 | glut_solid_teapot(0.5), 23 | gl_flush. 24 | 25 | -------------------------------------------------------------------------------- /tests/para1.pl: -------------------------------------------------------------------------------- 1 | % distributed parallel example 2 | 3 | 4 | para(X) :- list50(Y),psort(Y,X). 5 | 6 | psort([Pivot|Rest], Sorted) :- 7 | partition(Pivot, Rest, Left, Right), 8 | dp_and([qsort(Left, SortedLeft), qsort(Right, SortedRight)]), 9 | append(SortedLeft, [Pivot|SortedRight], Sorted). 10 | 11 | seq(X) :- list50(Y),qsort(Y,X). 12 | 13 | qsort([], []). 14 | qsort([Pivot|Rest], Sorted) :- 15 | partition(Pivot, Rest, Left, Right), 16 | qsort(Left, SortedLeft), 17 | qsort(Right, SortedRight), 18 | append(SortedLeft, [Pivot|SortedRight], Sorted). 19 | 20 | partition(_, [], [], []). 21 | partition(Pivot, [H|T], [H|Left], Right) :- 22 | H =< Pivot, 23 | partition(Pivot, T, Left, Right). 24 | partition(Pivot, [H|T], Left, [H|Right]) :- 25 | H > Pivot, 26 | partition(Pivot, T, Left, Right). 27 | 28 | % List of 50 elements for another test 29 | list50([27, 74, 17, 33, 94, 18, 46, 83, 65, 2, 32, 53, 28, 85, 99, 47, 28, 82, 6, 11, 30 | 55, 29, 39, 81, 90, 37, 10, 0, 66, 51, 7, 21, 85, 27, 31, 63, 75, 4, 95, 99, 11, 28, 61, 31 | 74, 18, 92, 40, 55, 59, 8]). 32 | 33 | %test report 34 | message(X) :- dp_report(X). 35 | 36 | 37 | foo(0). 38 | foo(N) :- write(N),N1 is N-1,foo(N1). -------------------------------------------------------------------------------- /tests/para2.pl: -------------------------------------------------------------------------------- 1 | % multi-thread parallel example 2 | 3 | :- mt_create(2). 4 | 5 | para(X) :- list50(Y),psort(Y,X). 6 | 7 | psort([Pivot|Rest], Sorted) :- 8 | partition(Pivot, Rest, Left, Right), 9 | mt_and([qsort(Left, SortedLeft), qsort(Right, SortedRight)]), 10 | append(SortedLeft, [Pivot|SortedRight], Sorted). 11 | 12 | seq(X) :- list50(Y),qsort(Y,X). 13 | 14 | qsort([], []). 15 | qsort([Pivot|Rest], Sorted) :- 16 | partition(Pivot, Rest, Left, Right), 17 | qsort(Left, SortedLeft), 18 | qsort(Right, SortedRight), 19 | append(SortedLeft, [Pivot|SortedRight], Sorted). 20 | 21 | partition(_, [], [], []). 22 | partition(Pivot, [H|T], [H|Left], Right) :- 23 | H =< Pivot, 24 | partition(Pivot, T, Left, Right). 25 | partition(Pivot, [H|T], Left, [H|Right]) :- 26 | H > Pivot, 27 | partition(Pivot, T, Left, Right). 28 | 29 | % List of 50 elements for another test 30 | list50([27, 74, 17, 33, 94, 18, 46, 83, 65, 2, 32, 53, 28, 85, 99, 47, 28, 82, 6, 11, 31 | 55, 29, 39, 81, 90, 37, 10, 0, 66, 51, 7, 21, 85, 27, 31, 63, 75, 4, 95, 99, 11, 28, 61, 32 | 74, 18, 92, 40, 55, 59, 8]). 33 | 34 | list800(E) :- list50(A),append(A,A,B),append(B,B,C),append(C,C,D),append(D,D,E). 35 | 36 | listn(0,[]). 37 | listn(N,[R|X]) :- R is randi(100),N1 is N-1,listn(N1,X). -------------------------------------------------------------------------------- /tests/plot.pl: -------------------------------------------------------------------------------- 1 | foo :- 2 | open_plot, 3 | send_plot($set title "sin cos curve"$), 4 | send_plot($set xlabel "x"$), 5 | send_plot($set ylabel "y"$), 6 | send_plot($set xtics 1$), 7 | send_plot($set ytics 0.5$), 8 | send_plot($plot sin(x),cos(x)$), 9 | close_plot. -------------------------------------------------------------------------------- /tests/queens.pl: -------------------------------------------------------------------------------- 1 | % 9-queens program 2 | 3 | test16 :- between(1,16,X),test1,fail. 4 | test :- queen([1,2,3,4,5,6,7,8,9],X),write(X),nl,fail. 5 | test1 :- queen([1,2,3,4,5,6,7,8,9],X),fail. 6 | 7 | queen(Data, Out) :- 8 | queen_2(Data, [], Out). 9 | 10 | queen_2([], _, []). 11 | queen_2([H|T], History, [Q|M]) :- 12 | qdelete(Q, H, T, L1), 13 | nodiag(History, Q, 1), 14 | queen_2(L1, [Q|History], M). 15 | 16 | 17 | qdelete(A, A, L, L). 18 | qdelete(X, A, [H|T], [A|R]) :- 19 | qdelete(X, H, T, R). 20 | 21 | 22 | nodiag([], _, _). 23 | nodiag([N|L], B, D) :- 24 | D =\= N - B, 25 | D =\= B - N, 26 | D1 is D + 1, 27 | nodiag(L, B, D1). 28 | 29 | -------------------------------------------------------------------------------- /tests/queens.pl~: -------------------------------------------------------------------------------- 1 | % 9-queens program 2 | 3 | test16 :- between(1,16,X),test1,fail. 4 | test :- queen([1,2,3,4,5,6,7,8,9],X),write(X),nl,fail. 5 | test1 :- queen([1,2,3,4,5,6,7,8,9],X),fail. 6 | 7 | queen(Data, Out) :- 8 | queen_2(Data, [], Out). 9 | 10 | queen_2([], _, []). 11 | queen_2([H|T], History, [Q|M]) :- 12 | qdelete(Q, H, T, L1), 13 | nodiag(History, Q, 1), 14 | queen_2(L1, [Q|History], M). 15 | 16 | 17 | qdelete(A, A, L, L). 18 | qdelete(X, A, [H|T], [A|R]) :- 19 | qdelete(X, H, T, R). 20 | 21 | 22 | nodiag([], _, _). 23 | nodiag([N|L], B, D) :- 24 | D =\= N - B, 25 | D =\= B - N, 26 | D1 is D + 1, 27 | nodiag(L, B, D1). 28 | -------------------------------------------------------------------------------- /tests/socket.pl: -------------------------------------------------------------------------------- 1 | % test socket 2 | 3 | 4 | start_server :- 5 | create_server_socket(ServerSocket, 5000), 6 | write('Server started on port 5000'),nl, 7 | recv_socket(ServerSocket, Message), 8 | write('Server received: '), 9 | write(Message),nl, 10 | send_socket(ServerSocket, Message), 11 | close_socket(ServerSocket). 12 | 13 | start_client :- 14 | create_client_socket(ClientSocket, 5000, '127.1.1.1'), 15 | send_socket(ClientSocket, hello), 16 | write('Client sent: hello'),nl, 17 | recv_socket(ClientSocket, Message), 18 | write('Client recv: '), 19 | write(Message),nl, 20 | close_socket(ClientSocket). 21 | 22 | 23 | -------------------------------------------------------------------------------- /tests/tail.pl: -------------------------------------------------------------------------------- 1 | foo(0). 2 | foo(X) :- 3 | write(X), 4 | X1 is X - 1,foo(X1). 5 | 6 | fact(0, 1). 7 | fact(X, Sum) :- 8 | X > 0, X1 is X - 1, fact(X1, Sum1), Sum is X * Sum1. 9 | 10 | nodiag([], _, _). 11 | nodiag([N|L],B,D) :- 12 | D =\= N - B, 13 | D =\= B - N, 14 | D1 is D + 1, 15 | nodiag(L,B,D1). 16 | 17 | fibo1(0, 0). 18 | fibo1(N, F) :- fibo1(N, 1, 0, F). 19 | fibo1(1, A1, _, A1). 20 | fibo1(N, A1, A2, F) :- 21 | N > 1, N1 is N - 1, A3 is A1 + A2, fibo1(N1, A3, A1, F). 22 | 23 | 24 | boo(X) :- write(X). -------------------------------------------------------------------------------- /tests/tcltk.pl: -------------------------------------------------------------------------------- 1 | % test of tcl/tk 2 | 3 | recur :- 4 | tk_init, 5 | tk_canvas(c0,[width(600),height(600)]), 6 | gasket([300,0],[0,600],[600,600],6), 7 | tk_pack(c0), 8 | tk_mainloop. 9 | 10 | midpoint([A0,A1],[B0,B1],[X0,X1]) :- 11 | X0 is (A0+B0)//2, 12 | X1 is (A1+B1)//2. 13 | 14 | draw_triang([A0,A1],[B0,B1],[C0,C1]) :- 15 | tk_create(c0,line([A0,A1,B0,B1,C0,C1,A0,A1]),[fill(green)]). 16 | 17 | 18 | gasket(A, B, C, 0) :- 19 | draw_triang(A, B, C). 20 | gasket(A, B, C, N) :- 21 | midpoint(A, B, AB), 22 | midpoint(B, C, BC), 23 | midpoint(C, A, CA), 24 | N1 is N - 1, 25 | gasket(A, AB, CA, N1), 26 | gasket(AB, B, BC, N1), 27 | gasket(CA, BC, C, N1). 28 | 29 | 30 | japan :- 31 | tk_init, 32 | tk_canvas(c0,[width(600),height(400)]), 33 | tk_create(c0,oval([200,100,400,300]),[fill(red)]), 34 | tk_pack(c0), 35 | tk_mainloop. 36 | 37 | 38 | hello :- 39 | tk_init, 40 | tk_label(hello,[text('hello world'),width(50),height(15),foreground(red),background(green)]), 41 | tk_pack(hello), 42 | tk_mainloop. -------------------------------------------------------------------------------- /tests/tfact.pl: -------------------------------------------------------------------------------- 1 | 2 | fact(N, X) :- fact_(N, 1, X). 3 | fact_(N, P, X) :- N > 0, 4 | N1 is N - 1, 5 | P1 is P * N, 6 | fact_(N1, P1, X). 7 | fact_(0, X, X). --------------------------------------------------------------------------------