├── LICENSE.txt ├── README.txt ├── binbuild.bat ├── doc ├── .log ├── README.txt ├── advanced.html ├── advanced.pdf ├── advanced.tex ├── bp.1 ├── crossref.html ├── crossref.pdf ├── crossref.tex ├── help.html ├── helpgen.pro ├── interface.html ├── interface.pdf ├── interface.tex ├── internet.html ├── internet.pdf ├── internet.tex ├── local.bib ├── makeall.bat ├── makefile ├── preds.pro ├── preds.tex ├── tarau.bib ├── toPDF.bat ├── user.html ├── user.pdf └── user.tex ├── library ├── bin2iso.pl ├── bpxref.pl ├── canonical.pl ├── catch_cont.pl ├── coord.pl ├── coord1.pl ├── deprecated.pl ├── engines.pl ├── file2or.pl ├── foldall.pro ├── format.pl ├── funs.pro ├── high.pl ├── if_syntax.pl ├── kernel_prolog.pl ├── lists.pl ├── lub.pl ├── matrix.pl ├── media.pl ├── monad.pl ├── prodoc.bat ├── prodoc.pl ├── record.pl ├── small_kernel_prolog.pl ├── test_kernel_prolog.pl ├── to_simple.pl ├── tree.pl ├── xref.pdf ├── xref.pl ├── xref2latex.pl └── xref2txt.pl ├── makeall.bat ├── makefile ├── progs ├── ag_ic.pl ├── algraph.pl ├── allperms.pl ├── assertbm.pl ├── backprop.pl ├── bbemul.pl ├── bcolor.pl ├── bestof.pl ├── bfmeta.pl ├── bincont.pl ├── bm.bat ├── bm.pl ├── bm.txt ├── bm1.bat ├── bm2.bat ├── bm2.txt ├── bm_tetris.pl ├── bmark.pl ├── boyer.pl ├── brev.pl ├── bug.pl ├── bugs.pl ├── cal.pl ├── calibrate.pro ├── callbm.pl ├── catch.pl ├── cbrev.pl ├── chat.pl ├── choice.pl ├── clean.bat ├── coco.pl ├── coco_data.pl ├── color.pl ├── cont.pl ├── cperms.pl ├── cube.pl ├── dboyer.pl ├── dbrev.pl ├── dbsort.pl ├── dcomp.pl ├── dfibo.pl ├── dhan.pl ├── differen.pl ├── disj.pl ├── dlg.pl ├── drive_tetris.pl ├── dtak.pl ├── eassert.pl ├── engines.pro ├── engtest.pl ├── eperms.pl ├── fbrev.pl ├── fcolor.pl ├── fcolor1.pl ├── ffibo.pl ├── fibo.pl ├── file2pred.pl ├── fknight.pl ├── fmoney.pl ├── fperms.pl ├── gc.pl ├── gc_bug.pl ├── hag_bm.pl ├── hag_bm1.pl ├── hag_bm2.pl ├── ham.pl ├── han.pl ├── hello.pro ├── horn_gram.pl ├── ic.pl ├── if0_fibo.pl ├── igmoney.pl ├── ilgraph.pl ├── infinite.pl ├── io.pl ├── ja_primes.pl ├── jnet.pl ├── kernel_prolog_parser.pl ├── knight.pl ├── l.pl ├── lat_plan.pl ├── lat_wam.pl ├── lattice.pl ├── lconstr.pl ├── lfibo.pl ├── lgraph.pl ├── linperms.pl ├── lknight.pl ├── lmap.pl ├── lmoney.pl ├── lq8.pl ├── lrev.pl ├── lsort.pl ├── lsum.pl ├── ltak.pl ├── macro.pl ├── maplist.pl ├── market.pro ├── market3.pl ├── mboyer.pl ├── mbrev.pl ├── meta.pl ├── mfibo.pl ├── mob.pl ├── money.pl ├── move.pl ├── move1.pl ├── mud.pl ├── natlog.pl ├── netkill.pl ├── netrun.pl ├── netscale.pl ├── nnet.pl ├── nping.pl ├── nrev.pl ├── nrev30.pl ├── obtest.pl ├── or.pl ├── or_engtest.pl ├── over_ex.pl ├── override.pl ├── p1.pl ├── p2.pl ├── p3.pl ├── pbench.pl ├── plain_tetris.pl ├── primes.pl ├── profile.pl ├── pure_io.pl ├── puzzle.pl ├── q8.pl ├── qbrev.pl ├── qrev.pl ├── qsort.pl ├── queens.pl ├── rantree.pl ├── recordbm.pl ├── rnet.pl ├── rpc_chat.pro ├── rtop.pl ├── semi3.pl ├── setarg_dcg.pl ├── show_tetris.pl ├── spy.pl ├── subset.pl ├── synco.pl ├── synco_data.pl ├── tak.pl ├── temp.pro ├── term2io.pl ├── test.pl ├── tetris.pl ├── tetris_trace.pl ├── thread_test.pro ├── tloop.pro ├── tmob.pl ├── tsp.pl ├── ttest.pl ├── tty_tetris.pl ├── untrail.pl ├── vfbrev.pl ├── war.pl ├── winthreads.pl └── xreftest.pl └── src ├── OLD ├── cboot.bat ├── genrun.bat ├── linux32mt ├── linux64mt ├── mac ├── mac32mt ├── mac64 ├── make64.bat ├── makeall.bat ├── makebp.bat ├── makebpr.bat ├── makebpx.bat ├── makedll.bat ├── makedllr.bat ├── makedllx.bat ├── makelib.bat ├── makemac ├── makenew ├── makenew.bat ├── makenew1 ├── makenew2 ├── makeprof ├── makeru.bat ├── remake.bat ├── tboot.bat ├── test.pro └── xtest.bat ├── bin.pl ├── binpro ├── binpro.c ├── binpro.h ├── binpro.o ├── binpro.pro ├── builtins.c ├── builtins.o ├── builtins.pl ├── c.c ├── c.o ├── c_comp.pl ├── c_defs.h ├── c_instr.pl ├── co.pl ├── cserver.pl ├── dcg.pl ├── debug.c ├── debug.o ├── defs.h ├── defs.ok ├── dict.c ├── dict.o ├── engine.c ├── engine.o ├── extra.pl ├── float.c ├── float.o ├── full.pro ├── gc.c ├── gc.h ├── gc.o ├── global.h ├── headers.pl ├── hmap.pl ├── init.pl ├── io.c ├── io.o ├── lib.pl ├── load.c ├── load.o ├── mac64mt.sh ├── main.c ├── main.o ├── makefile ├── maps.pl ├── net.pl ├── oper.pl ├── other.pl ├── otherwam.bp ├── prof.h ├── prof.ok ├── read.pl ├── remake.pro ├── ru ├── ru.a ├── ru.c ├── ru.o ├── run.pro ├── socket.c ├── socket.o ├── stub.c ├── stub.o ├── sym.c ├── sym.o ├── term.c ├── term.h ├── term.o ├── termStore.c ├── termStore.h ├── termStore.o ├── top.pl ├── tstore.pl ├── wam.bp ├── wam.c ├── wam.h ├── wam.o ├── wam.ok ├── wam.pro ├── write.pl └── xdb.pl /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Released under under GPL v. 3.0 license available at: 2 | http://www.gnu.org/licenses/gpl-3.0.txt 3 | 4 | If interested in a different licensing model, 5 | contact paul.tarau@gmail.com. 6 | 7 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | Welcome to BinProlog Open Source Edition! 2 | 3 | First, uncompress using unzip the source files (or use git 4 | to extract them from the repository). 5 | 6 | The main directories in this distribution are: 7 | 8 | -- TESTED recently on OS X Mountain Lion 9 | 10 | +---src ---------------------> BinProlog sources and makefile 11 | +---bin----------------------> executable 12 | +---lib----------------------> *.so *.a libraries 13 | +---doc ---------------------> documentation 14 | +---progs -------------------> sample programs 15 | +---library -----------------> Prolog libraries 16 | 17 | -- EXTENSIONS: UNTESTED recently - only available in the BinProlog.zip DOWNLOAD 18 | 19 | +---c_inter------------------> high performance C interface 20 | +---pl2c --------------------> Prolog to C translator 21 | +---csocks ------------------> simple C socket interface 22 | +---j_inter------------------> simple JNI Java interface 23 | 24 | After typing "make" look in directory "bin" for ready to run executables. Just copy the 25 | executable bp (on OS x, Linux) and bp.exe (on Windows) somewhere on your path. 26 | 27 | The directory "doc" contains the documentation in PDF and HTML form. 28 | The API description is in file help.html. You can regenerate 29 | it by just typing "help" in BinProlog. 30 | 31 | The documentation has not been recently revised - some things might be outdated. 32 | 33 | WITH THE EXCEPTION of the "make" process in src, no recent testing 34 | has been performed on the BinProlog EXTENSIONS. 35 | 36 | Please read the README.txt files in various directories before staring 37 | to work with them. 38 | 39 | On a win32 or win64 machine make sure cl.exe is in the path - i.e. run something like 40 | vc32.bat or similar, based on your Visual C installation. 41 | 42 | BinProlog's C-interface tools are in directory "c_inter". Type make of 43 | winmake.bat to recompile the files and link with the binary libraries 44 | provided in directory "lib". 45 | 46 | Tools for generation of standalone executables, through compilation to C 47 | are available in directory "pl2c". 48 | 49 | Header files and static libraries are available in directory "lib" - allowing 50 | to use the C-interface or generate C-code without need to recompile the sources. 51 | 52 | Just go in directory src and type make all (for gcc) or makeall.bat 53 | (for cl.exe - the Visual C compiler). 54 | 55 | The directory "csocks" contains tools for building standalone C-based 56 | socket based client, server and a remote toplevel components 57 | based on BinProlog's modular and portable socket package. 58 | 59 | Enjoy, 60 | 61 | Paul Tarau 62 | Nov 12, 2012 63 | 64 | -------------------------------------------------------------------------------- /binbuild.bat: -------------------------------------------------------------------------------- 1 | cd c_inter 2 | CALL winmake.bat 3 | cd ..\pl2c 4 | CALL winmake.bat 5 | @echo binbuild.bat DONE 6 | -------------------------------------------------------------------------------- /doc/.log: -------------------------------------------------------------------------------- 1 | This is pdfeTeX, Version 3.141592-1.20a-2.2 (MiKTeX 2.4) (preloaded format=latex 2004.10.3) 25 SEP 2005 22:34 2 | entering extended mode 3 | **.tex 4 | (C:\texmf\tex\latex\tools\.tex 5 | LaTeX2e <2003/12/01> 6 | Babel and hyphenation patterns for english, french, german, ngerman, du 7 | mylang, nohyphenation, loaded. 8 | File ignored) 9 | * 10 | ! Emergency stop. 11 | <*> .tex 12 | 13 | End of file on the terminal! 14 | 15 | 16 | Here is how much of TeX's memory you used: 17 | 7 strings out of 95518 18 | 102 string characters out of 1189590 19 | 44801 words of memory out of 1048577 20 | 3206 multiletter control sequences out of 35000 21 | 3640 words of font info for 14 fonts, out of 500000 for 1000 22 | 14 hyphenation exceptions out of 607 23 | 5i,0n,1p,85b,8s stack positions out of 1500i,500n,5000p,200000b,32768s 24 | 0 PDF objects out of 300000 25 | 0 named destinations out of 300000 26 | 1 words of extra memory for PDF output out of 65536 27 | No pages of output. 28 | -------------------------------------------------------------------------------- /doc/README.txt: -------------------------------------------------------------------------------- 1 | preds.tex - automatically generated predicate cross refs and help 2 | 3 | makefile - from *.tex+*.bib -> *.dvi -> *.ps and *.txt 4 | - use it if you edit and improve art.tex 5 | 6 | FILES: 7 | 8 | *.ps 9 | *.html 10 | 11 | User, Advanced, Interface and Internet Toolkit documentation. 12 | -------------------------------------------------------------------------------- /doc/advanced.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/doc/advanced.pdf -------------------------------------------------------------------------------- /doc/crossref.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/doc/crossref.pdf -------------------------------------------------------------------------------- /doc/crossref.tex: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | 3 | \textheight 21 cm 4 | \textwidth 14 cm 5 | 6 | \topmargin -1mm 7 | \marginparwidth 0mm 8 | \evensidemargin 1.5 cm 9 | \oddsidemargin 1.5 cm 10 | 11 | \begin{document} 12 | \pagestyle{plain} 13 | \bibliographystyle{abbrv} 14 | 15 | \title{ 16 | \Huge 17 | BinProlog Professional Edition\\ 18 | Predicate Cross-Reference Guide \\ 19 | \vskip 5cm 20 | } 21 | 22 | \author{ 23 | \Large 24 | Written by BinProlog Itself\\ 25 | under the kind regards of:\\ 26 | \large 27 | Paul Tarau\\ 28 | BinNet Corp.\\ 29 | WWW: http://www.binnetcorp.com\\ 30 | \normalsize 31 | } 32 | 33 | \maketitle 34 | \newpage 35 | \input preds.tex 36 | 37 | Related BinProlog documentation is available at: 38 | \cite{bp7user,bp7advanced,bp7interface,bp7crossref}. 39 | 40 | \bibliography{tarau} 41 | 42 | \end{document} 43 | -------------------------------------------------------------------------------- /doc/helpgen.pro: -------------------------------------------------------------------------------- 1 | main:-help,halt. 2 | -------------------------------------------------------------------------------- /doc/interface.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/doc/interface.pdf -------------------------------------------------------------------------------- /doc/internet.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/doc/internet.html -------------------------------------------------------------------------------- /doc/internet.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/doc/internet.pdf -------------------------------------------------------------------------------- /doc/local.bib: -------------------------------------------------------------------------------- 1 | 2 | @inproceedings{Demoen91:RU, 3 | title={{I}mplementation of {P}rolog as binary definite {P}rograms}, 4 | author={Demoen, Bart and Mari\"{e}n, Andr\'{e}}, 5 | pages={165--176}, 6 | booktitle = {Logic Programming, RCLP Proceedings}, 7 | year = {1992}, 8 | editor = {Voronkov, Andrei}, 9 | publisher = {Springer-Verlag}, 10 | series = {Lecture Notes in Artificial Intelligence}, 11 | number = {592}, 12 | address = {Berlin, Heidelberg}, 13 | } 14 | 15 | 16 | @TECHREPORT{Demoen90:KUL, 17 | author={Demoen, Bart}, 18 | title = {On the {T}ransformation of a {P}rolog Program to a more efficient 19 | {B}inary Program}, 20 | institution = "K.U.Leuven", 21 | number = "130", 22 | month = dec, 23 | year = 1990, 24 | } 25 | 26 | @inproceedings{LOPSTR93:Neumerkel, 27 | author="Ulrich Neumerkel", 28 | title= "A Transformation Based on the Equality between Terms", 29 | booktitle= "Logic Program Synthesis and Transformation, LOPSTR 1993", 30 | publisher = "Springer-Verlag", 31 | year = "1993" 32 | } 33 | 34 | 35 | @PHDTHESIS{Neum92, 36 | author = "Neumerkel, Ulrich", 37 | title = "Specialization of {Prolog} Programs with Partially 38 | Static Goals and Binarization", 39 | type={PhD thesis}, 40 | school={Technische Universit\"{a}t Wien}, 41 | year = 1992, 42 | } 43 | 44 | @Misc{lindgren, 45 | author = "Lindgren, T.", 46 | title = "Compiling Logic Programs Using a Binary Continuation Style", 47 | month = dec, 48 | year = 1992, 49 | note = "draft, Uppsala University" 50 | } 51 | 52 | @TECHREPORT{WA83, 53 | author={Warren, D. H. D.}, 54 | title = "An {A}bstract {P}rolog {I}nstruction {S}et", 55 | institution = "SRI International", 56 | type="Technical Note", 57 | number=309, 58 | month = Oct, 59 | year = 1983, 60 | } 61 | 62 | -------------------------------------------------------------------------------- /doc/makeall.bat: -------------------------------------------------------------------------------- 1 | @echo make sure vsvars32 is called first 2 | CALL nmake.exe -------------------------------------------------------------------------------- /doc/makefile: -------------------------------------------------------------------------------- 1 | #PROJ=art 2 | #PROJ=abs 3 | MAKEPROG=nmake 4 | it: all 5 | 6 | one: 7 | $(MAKEPROG) ps html pdf PROJ=user 8 | 9 | all: help 10 | @echo USE $(MAKEPROG) !!! 11 | $(MAKEPROG) ps html pdf PROJ=user 12 | $(MAKEPROG) ps html pdf PROJ=advanced 13 | $(MAKEPROG) ps html pdf PROJ=interface 14 | $(MAKEPROG) ps html pdf PROJ=internet 15 | $(MAKEPROG) ps html pdf PROJ=crossref 16 | @echo gzip *.ps 17 | @echo mv -f *.ps.gz *.html /bp_doc 18 | $(MAKEPROG) clean 19 | 20 | help: 21 | bp helpgen.pro 22 | rm -f help.txt 23 | 24 | htmls: 25 | $(MAKEPROG) html PROJ=user 26 | $(MAKEPROG) html PROJ=advanced 27 | $(MAKEPROG) html PROJ=interface 28 | $(MAKEPROG) html PROJ=internet 29 | $(MAKEPROG) html PROJ=crossref 30 | @echo TYPE mv -f *.html c:/bp_doc 31 | 32 | pdfs: 33 | $(MAKEPROG) pdf PROJ=user 34 | $(MAKEPROG) pdf PROJ=advanced 35 | $(MAKEPROG) pdf PROJ=interface 36 | $(MAKEPROG) pdf PROJ=internet 37 | $(MAKEPROG) pdf PROJ=crossref 38 | @echo TYPE mv -f *.pdf c:/bp_doc 39 | 40 | 41 | $(PROJ).dvi: $(PROJ).bbl $(PROJ).blg $(PROJ).aux $(PROJ).tex 42 | latex $(PROJ) 43 | 44 | bib $(PROJ).bbl $(PROJ).blg $(PROJ).aux: $(PROJ).tex 45 | latex $(PROJ) 46 | bibtex $(PROJ) 47 | latex $(PROJ) 48 | 49 | $(PROJ).tex: 50 | latex $(PROJ) 51 | 52 | $(PROJ).ps: $(PROJ).dvi 53 | # dvips -f $(PROJ) >$(PROJ).ps 54 | dvips $(PROJ) 55 | 56 | dvi: $(PROJ).dvi 57 | yap $(PROJ).dvi 58 | 59 | ps: $(PROJ).ps 60 | 61 | psview: 62 | #ghostview -swap -magstep 0 $(PROJ).ps 63 | #gw $(PROJ).ps 64 | #pageview $(PROJ).ps 65 | 66 | txt: $(PROJ).txt 67 | 68 | $(PROJ).txt: 69 | dvi2tty -l -w112 $(PROJ).dvi > $(PROJ).txt 70 | 71 | pdf $(PROJ).pdf: $(PROJ).tex 72 | toPDF.bat $(PROJ) 73 | 74 | html $(PROJ).html: $(PROJ).tex 75 | tth.exe <$(PROJ).tex >$(PROJ).html -L$(PROJ) -a -e1 76 | 77 | preds preds.tex: ../src/headers.pl 78 | bp -h40000 -s2000 -t2000 -b40000 preds.pro 79 | 80 | 81 | oldhtml: art.tex preds.tex 82 | rm -f -r html 83 | latex2html -split 2 -link 2 -contents_in_navigation -show_section_numbers -bottom_navigation art.tex 84 | mv art html 85 | (cd html; ln -s ../icons .) 86 | (cd html; perl -n -i.bak -e "s{/opt/tools/latex2html-95.3/}{}g;print;" *.html) 87 | (cd html; rm -f *.bak) 88 | 89 | 90 | print: art.ps 91 | lpr art.ps 92 | 93 | see: art.tex 94 | dvi2tty -l -w112 art 95 | 96 | wc: 97 | dvi2tty -l -w132 art | wc 98 | 99 | clean: 100 | rm -f crossref.ps *.aux *.blg *.log *.dlog *.bbl *.dvi 101 | 102 | realclean: clean 103 | rm -f *.bbl *.dvi *.ps *.html 104 | 105 | -------------------------------------------------------------------------------- /doc/preds.pro: -------------------------------------------------------------------------------- 1 | :-[library(bpxref)]. 2 | main:-cd('../src'),go. 3 | -------------------------------------------------------------------------------- /doc/tarau.bib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/doc/tarau.bib -------------------------------------------------------------------------------- /doc/toPDF.bat: -------------------------------------------------------------------------------- 1 | set PROJ=%1 2 | CALL clean.bat %PROJ% 3 | del /Q %PROJ%.pdf 4 | latex %PROJ%.tex 5 | bibtex %PROJ% 6 | latex %PROJ%.tex 7 | pdflatex %PROJ%.tex 8 | CALL clean.bat %PROJ% 9 | REM %PROJ%.pdf 10 | 11 | -------------------------------------------------------------------------------- /doc/user.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/doc/user.pdf -------------------------------------------------------------------------------- /library/bpxref.pl: -------------------------------------------------------------------------------- 1 | % xref based program checking tools 2 | 3 | :-[library(xref2latex)]. 4 | 5 | % tests on BinProlog, retunrns full latex document 6 | bptest:-xref(wam). 7 | 8 | % tests itself 9 | selftest:-xref(bpxref). 10 | 11 | % filters out unwanted predicates 12 | 13 | non_trivial(FN):-FN \== true/0,FN\==(!)/0. % FN\==fail/0, 14 | 15 | %filter(FN):-non_trivial(FN). 16 | %filter(F/N):-functor(P,F,N), \+ is_builtin(P). 17 | %filter(F/N):-non_trivial(F/N), functor(P,F,N), is_builtin(P). 18 | 19 | filter(F/N):-has_info(F/N),non_trivial(F/N). 20 | 21 | % adds some predicates that the system cannot see 22 | generator(F/N):- 23 | db_clause(wam,bu0(P1,_,_,_),_), 24 | functor(P1,F,N1), 25 | N is N1-1. 26 | 27 | go:- 28 | dynbbgc, 29 | create_engine(2000,1000,1000,E), 30 | load_engine(E,xref(wam,0),_), % \input this into ../doc/art.tex 31 | ask_engine(E,_), 32 | destroy_engine(E), 33 | system('mv wam.tex ../doc/preds.tex'). 34 | 35 | -------------------------------------------------------------------------------- /library/canonical.pl: -------------------------------------------------------------------------------- 1 | % file: canonical.pro 2 | 3 | % converts a term to parser independent representation 4 | 5 | to_canonical(T,CT):-if(atomic_to_canonical(T,X),eq(X,CT),compound_to_canonical(T,CT)). 6 | 7 | % converts a term back to normal Prolog representation 8 | 9 | 10 | from_canonical(CT,T):-if(canonical_to_atomic(CT,X),eq(X,T),from_compound_canonical(CT,T)). 11 | 12 | atomic_to_canonical(T,v(T)):-var(T). 13 | atomic_to_canonical(T,s(Cs)):-atom(T),atom_codes(T,Cs). 14 | atomic_to_canonical(T,i(T)):-integer(T). 15 | atomic_to_canonical(T,r(Cs)):-float(T),number_codes(T,Cs). 16 | 17 | canonical_to_atomic(v(T),T). 18 | canonical_to_atomic(s(Cs),T):-atom_codes(T,Cs). 19 | canonical_to_atomic(i(T),T). 20 | canonical_to_atomic(r(Cs),T):-number_codes(T,Cs). 21 | 22 | compound_to_canonical(T,f(CTs)):-'=..'(T,Ts),map(to_canonical,Ts,CTs). 23 | 24 | from_compound_canonical(f(CTs),T):-map(from_canonical,CTs,Ts),'=..'(T,Ts). 25 | -------------------------------------------------------------------------------- /library/catch_cont.pl: -------------------------------------------------------------------------------- 1 | go:-catch(go2,Any,println(uncought=Any)). 2 | 3 | go2:- 4 | catch( 5 | ( member(X,[a,f(A,A),c]), 6 | X=f(_,_), 7 | println(before_throw=X), 8 | throw(goooot(X)), 9 | println(after_trow) 10 | ), 11 | got(Y), 12 | println(cought(Y)) 13 | ), 14 | println(after(caught(Y))). 15 | 16 | ignore(_). 17 | 18 | go1:-consume_cont(println,boo),println(one),println(two),ignore(boo),println(hi). 19 | 20 | /* implementation of catch/throw - with first order continuations 21 | 22 | catch(Goal,Ball,Do,Cont) ::- catch0(Goal,Ball,Do,Cont,Cont) . 23 | catch(_,_,_) :- fail . 24 | 25 | catch0(Goal,Ball,Do,Cont) :- 26 | get_neck_cut(Choice), 27 | Goal, 28 | '$to_catch'('$catch_looking_for_throw'([Ball,Do,Choice,Cont])). 29 | 30 | '$to_catch'(_). 31 | 32 | '$process_catch'(Term,[Ball,Do,Choice,Cont],_):-copy_term(Term,Copy), 33 | % println(found(Term=Ball,Do)), 34 | untrail_to(Choice), 35 | do_or_throw_again(Term,Copy,Ball,Do,Cont). 36 | 37 | 38 | throw(Term):-consume_cont('$process_catch'(Term,X),'$catch_looking_for_throw'(X)). 39 | 40 | throw_with_cont(Term,Cont,_)::-throw(Term,Cont). 41 | 42 | do_or_throw_again(_Term,Ball,Ball,Do,Cont):- !,Do,call_cont(Cont). 43 | do_or_throw_again(Term,_Ball,_Copied,_Do,Cont):-throw_with_cont(Term,Cont). 44 | 45 | % gathers in conjunction goals from the current continuation 46 | % until Marker is reached when it calls Closure ont it 47 | consume_cont(Closure,Marker):- 48 | get_cont(Cont), 49 | consume_cont1(Marker,(_,_,_,Cs),Cont,NewCont), % first _ 50 | call(Closure,Cs), % second _ 51 | % sets current continuation to leftover NewCont 52 | call_cont(NewCont). % third _ 53 | 54 | % gathers goals in Gs until Marker is hit in continuation Cont 55 | % when leftover LastCont continuation (stripped of Gs) is returned 56 | consume_cont1(Marker,Gs,Cont,LastCont):- 57 | strip_cont(Cont,Goal,NextCont), 58 | ( nonvar(NextCont),NextCont=true-> !,errmes(in_consume_cont,expected_marker(Marker)) 59 | ; arg(1,NextCont,X),nonvar(X),Marker=X-> 60 | Gs=Goal,arg(2,NextCont,LastCont) 61 | ; Gs=(Goal,OtherGs), 62 | consume_cont1(Marker,OtherGs,NextCont,LastCont) 63 | ). 64 | 65 | % this `binarized clause' gets the current continuation 66 | get_cont(Cont,Cont)::-true(Cont). 67 | 68 | % setes calls NewCont as continuation to be called next 69 | call_cont(NewCont,_) ::- true(NewCont). 70 | 71 | % sets NewCont as continuation to be called next 72 | % instead of OldCont which is returned in arg 2 73 | swap_cont(NewCont,OldCont,OldCont) ::- true(NewCont). 74 | */ 75 | -------------------------------------------------------------------------------- /library/coord.pl: -------------------------------------------------------------------------------- 1 | server:- 2 | bg(run_server). 3 | 4 | cons:- 5 | bg(start_consumer), 6 | wait_for_consumer(X), 7 | println(redy_to_use=X). 8 | 9 | start_consumer:- 10 | remote_run(consumer(X)), 11 | println(received=X), 12 | db_assert(data,range(X)). 13 | 14 | wait_for_consumer(X):- 15 | for(_,1,20), 16 | sleep(1), 17 | db_asserted(data,range(X)), 18 | !. 19 | wait_for_consumer(no_range_found). 20 | 21 | 22 | consumer(R):- 23 | wait_for(in_range(ship,R),R<10), 24 | println(consumed(R)). 25 | 26 | prod:- 27 | Bad=11, 28 | remote_run(producer(Bad)), 29 | println(produced=Bad), 30 | sleep(3), 31 | Good=9, 32 | remote_run(producer(Good)). 33 | 34 | producer(X):- 35 | notify_about(in_range(ship,X)), 36 | println(produced(X)). 37 | 38 | /* 39 | server window 40 | ?-server. 41 | 42 | consumer window 43 | ?- cons. 44 | got = 9 45 | yes 46 | 47 | producer window 48 | 49 | ?- prod. 50 | produced = 11 51 | produced = 9 52 | yes 53 | */ 54 | -------------------------------------------------------------------------------- /library/coord1.pl: -------------------------------------------------------------------------------- 1 | init:- 2 | bb_let(server,host,localhost), 3 | bb_let(server,port,7001), 4 | bb_let(server,password,eureka). 5 | 6 | server:- 7 | bg(run_server). 8 | 9 | cons:- 10 | remote_run(consumer(X)), 11 | println(got=X). 12 | 13 | consumer(R):- 14 | wait_for(in_range(ship,R),R<10). 15 | 16 | prod:- 17 | Bad=11, 18 | remote_run(producer(Bad)), 19 | println(produced=Bad), 20 | sleep(3), 21 | Good=9, 22 | remote_run(producer(Good)), 23 | println(produced=Good). 24 | 25 | 26 | producer(X):- 27 | notify_about(in_range(ship,X)). 28 | 29 | /* 30 | server window 31 | ?-server. 32 | 33 | consumer window 34 | ?- cons. 35 | got = 9 36 | yes 37 | 38 | producer window 39 | 40 | ?- prod. 41 | produced = 11 42 | produced = 9 43 | yes 44 | */ 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /library/file2or.pl: -------------------------------------------------------------------------------- 1 | file2clause(F0,C):- 2 | seeing(S), 3 | find_file(F0,F),!, 4 | see(F), 5 | repeat, 6 | read(X), 7 | ( X=end_of_file,!,see(F),seen,see(S),fail 8 | ; C=X 9 | ). 10 | 11 | 12 | file2byte(F0,C):- 13 | seeing(S), 14 | find_file(F0,F),!, 15 | see(F), 16 | repeat, 17 | get0(X), 18 | ( X =:= -1,!,see(F),seen,see(S),fail 19 | ; C=X 20 | ). 21 | 22 | file2pred(F0,FNCs):- 23 | seeing(S), 24 | find_file(F0,F),!, 25 | see(F), 26 | repeat, 27 | get_a_predicate(mem,FN,Cs), 28 | ( FN==end_of_file/0,Cs=[end_of_file],!, 29 | see(F),seen,see(S),fail 30 | ; FNCs=FN-Cs 31 | ). 32 | 33 | -------------------------------------------------------------------------------- /library/foldall.pro: -------------------------------------------------------------------------------- 1 | foldall(F,X^G,R):- 2 | new_engine('$found'(X),G,E), 3 | get(E,the(A)), 4 | check_return(A,R1), 5 | combine_with(E,F,R1,R2), 6 | !, 7 | R=R2. 8 | 9 | combine_with(E,F,R1,R3):- 10 | get(E,the(A)), 11 | check_return(A,X), 12 | call(F,R1,X,R), 13 | !, 14 | R2=R, 15 | combine_with(E,F,R2,R3). 16 | combine_with(_,_,R,R). 17 | 18 | check_return(R,X):-nonvar(R),R='$found'(A),!,X=A. 19 | check_return(Ret,_):-return(Ret),fail. 20 | 21 | freverse(Xs,Ys):-foldall(rcons,X^(X=[];member(X,Xs)),Ys). 22 | 23 | rcons(Y,X,[X|Y]). 24 | 25 | xdiv(X,Y,R):-(X=0;Y=0)->return(0);R is X//Y. 26 | 27 | ydiv(X,Y,R):-(X=0;Y=0)->fail;R is X//Y. 28 | 29 | -------------------------------------------------------------------------------- /library/if_syntax.pl: -------------------------------------------------------------------------------- 1 | :-op(970,fx,if). 2 | :-op(980,xfy,then). 3 | :-op(990,xfy,else). 4 | 5 | else(then(if(If),Then),Else):-If->Then;Else. 6 | 7 | then(if(If),Then):-If->Then. 8 | 9 | if_example(if 1>0 then if 2>0 then (write(yes),nl) else (write(no),nl)). 10 | if_example( 11 | if_max(1,2,3) then write(1) 12 | else if 2<0 then write(2) 13 | else write(3) 14 | ). 15 | 16 | if_test:-if_example(T),write(T),nl,display(T),nl,T,nl,nl,fail;nl. 17 | 18 | if_max(X,Y,Z) :- if X>Y then Z is X else Z is Y. 19 | -------------------------------------------------------------------------------- /library/monad.pl: -------------------------------------------------------------------------------- 1 | % tools 2 | 3 | id(X,X). 4 | 5 | compose(F,G,X,Z):-call(F,X,Y),call(G,Y,Z). 6 | 7 | % basic operations on the monad of Lists 8 | 9 | unitList(X,[X]). 10 | 11 | bindList([],_,[]). 12 | bindList([X|Xs],K,R):- 13 | call(K,X,Ys), 14 | bindList(Xs,K,Zs), 15 | append(Ys,Zs,R). 16 | 17 | % derived operations on the monad of Lists 18 | 19 | joinList(Xss,Xs) :- bindList(Xss,id,Xs). 20 | 21 | mapList(F,Xs,Ys):-bindList(Xs,compose(F,unitList),Ys). 22 | 23 | 24 | % test predicates and data 25 | 26 | filterList(P,X,Xs) :- call(P,X), !, unitList(X,Xs). 27 | filterList(_,_,[]). 28 | 29 | flip(F,X,Y):-call(F,Y,X). 30 | 31 | dupList(X,[X,X]). 32 | 33 | %pair(X,Y,R):- 34 | % unitList(X,Xs), 35 | % unitList(Y,Ys), 36 | % bindList([Xs,Ys],id,R). 37 | 38 | mapcan(F,Xs,R):-bindList(Xs,F,R). 39 | 40 | test(L,R):-bindList(L,dupList,R). 41 | test(L,R):-bindList(L,compose(joinList,compose(dupList,dupList)),R). 42 | test(L,R):-bindList(L,unitList,R). 43 | test(L,R):-joinList([L,L,L,L],R). 44 | test(L,R):-mapList(unitList,L,Xss),joinList(Xss,R). 45 | test(L,R):-mapList(filterList(>(3)),L,Xss),joinList(Xss,R). 46 | test(L,R):-mapList(+(10),L,R). 47 | test(L,R):-mapList(compose(unitList,flip(unitList)),L,R). 48 | 49 | go:-test([1,2,3,4],R),write(R),nl,fail. 50 | -------------------------------------------------------------------------------- /library/prodoc.bat: -------------------------------------------------------------------------------- 1 | set PROJ=%1 2 | set BP_PATH=\tarau\BinProlog\library 3 | bp -q3 -b0 -h40000 -t10000 -s10000 -a20 -d21 prodoc.pl "xref(%1),halt" 4 | del /Q %PROJ%.pdf 5 | latex %PROJ%.tex 6 | bibtex %PROJ% 7 | latex %PROJ%.tex 8 | tth.exe <%PROJ%.tex >%PROJ%.html -L%PROJ% -a -e1 9 | pdflatex %PROJ%.tex 10 | del /Q %PROJ%.aux 11 | del /Q %PROJ%.bbl 12 | del /Q %PROJ%.log 13 | del /Q %PROJ%.blg 14 | del /Q %PROJ%.dvi 15 | del /Q %PROJ%.tex 16 | REM %PROJ%.html -------------------------------------------------------------------------------- /library/prodoc.pl: -------------------------------------------------------------------------------- 1 | % xref based program documentation tool 2 | 3 | :-[library(xref2latex)]. 4 | 5 | % tests itself 6 | selftest:-xref(prodoc). 7 | 8 | % filters out unwanted predicates 9 | 10 | non_trivial(FN):-FN \== true/0,FN\==(!)/0. % FN\==fail/0, 11 | 12 | filter(F/N):-functor(P,F,N), \+ is_builtin(P). 13 | 14 | % adds some predicates that the system cannot see 15 | generator(_F/_N):-fail. 16 | 17 | -------------------------------------------------------------------------------- /library/record.pl: -------------------------------------------------------------------------------- 1 | % fairly efficient legacy recorda-recordz familly 2 | % still useful for running old programs 3 | 4 | % sorry for explicit Refs, but as they are not present in ISO prolog 5 | % anymore, and are unsafe with gc, they are discontinued... 6 | % they will be emulated by returning the terms themselves 7 | % but this will be inefficient 8 | 9 | record(Key,Term,Term):-record(Key,Term). 10 | recorda(Key,Term,Term):-recorda(Key,Term). 11 | recordz(Key,Term,Term):-recordz(Key,Term). 12 | recorded(Key,Term,Term):-recorded(Key,Term). 13 | erase(Term):-recorded_key(Key),erase(Key,Term),!. 14 | 15 | % end of */3 emultaion 16 | 17 | record(Key,Term):-recordz(Key,Term). 18 | 19 | recorda(Key,Term):- 20 | pushq('$recorded',Key,Term), 21 | record_key(Key). 22 | 23 | recordz(Key,Term):- 24 | addq('$recorded',Key,Term), 25 | record_key(Key). 26 | 27 | recorded(Key,Term):-var(Key),!, 28 | recorded_key(Key), 29 | get_recorded(Key,Term). 30 | recorded(Key,Term):- 31 | get_recorded(Key,Term). 32 | 33 | erase(Key,Term):- 34 | cdelq('$recorded',Key,Term,_). 35 | 36 | current_key(Name,Key):- 37 | recorded_key(Key), 38 | functor(Key,Name,_). 39 | 40 | % hidden tools 41 | 42 | record_key(Key):- 43 | functor(Key,F1,N1), 44 | rmemoq('$keys','$recorded',F1/N1). 45 | 46 | recorded_key(Key):- 47 | cmembq('$keys','$recorded',F1/N1), 48 | functor(Key,F1,N1). 49 | 50 | get_recorded(Key,Term):- 51 | cmembq('$recorded',Key,Term). 52 | 53 | 54 | % adds a (assumed ground) object unless it is there 55 | rmemoq(Key,Name,X):- 56 | cmembq(Key,Name,X),!. 57 | rmemoq(Key,Name,X):- 58 | addq(Key,Name,X). 59 | -------------------------------------------------------------------------------- /library/small_kernel_prolog.pl: -------------------------------------------------------------------------------- 1 | % Kernel Prolog - defining Prolog in terms of Horn Clauses + Engines 2 | % see demo at http://pc87043.csci.unt.edu/bp_cgi/kernel_prolog/query.html 3 | 4 | 5 | % interface with existing BinProlog functionality 6 | 7 | new_engineK(Goal,AnswerPattern,Handle):- 8 | open_engine(Goal,AnswerPattern,Handle). 9 | 10 | new_answerK(Engine,Answer):- 11 | ask_engine(Engine,X)->Answer=the(X) 12 | ; Answer=no. 13 | 14 | % basic kernel Prolog definitions 15 | first_solutionK(X,G,Answer):- 16 | new_engineK(G,X,E), 17 | new_answerK(E,R), 18 | destroy_engine(E), % ensures early gc 19 | Answer=R. 20 | 21 | onceK(G):-first_solutionK(G,G,the(G)). 22 | 23 | notK(G):-first_solutionK(_,G,no). 24 | 25 | copy_termK(X,CX):-first_solutionK(X,true,the(CX)). 26 | 27 | ifK(Cond,Then,Else):- 28 | first_solutionK(successful(Cond,Then),Cond,R), 29 | select_then_else(R,Cond,Then,Else). 30 | 31 | findallK(X,G,Xs):- 32 | new_engineK(G,X,E), 33 | new_answerK(E,Answer), 34 | collect_all_answersK(Answer,E,Xs). 35 | 36 | collect_all_answersK(no,_,[]). 37 | collect_all_answersK(the(X),E,[X|Xs]):- 38 | new_answerK(E,Answer), 39 | collect_all_answersK(Answer,E,Xs). 40 | 41 | % this shows that meta cals can be seen as instances of engine operations 42 | callK(Goal):- 43 | new_engineK(Goal,Goal,E), 44 | collect_callK(E,Goal). 45 | 46 | collect_callK(E,Goal):- 47 | new_answerK(E,the(Answer)), 48 | collect_moreK(E,Answer,Goal). 49 | 50 | collect_moreK(_,Answer,Answer). 51 | collect_moreK(E,_,Answer):-collect_callK(E,Answer). 52 | 53 | varK(X):-copy_termK(X,a),copy_termK(X,b). 54 | 55 | variant_ofK(Term,Variant):- 56 | copy_termK(Term,T1), 57 | copy_termK(Variant,T2), 58 | numbervarsK(T1,T), 59 | numbervarsK(T2,T). 60 | 61 | engine_memberK(E,Answer):- 62 | new_answerK(E,the(X)), 63 | other_engine_memberK(E,X,Answer). 64 | 65 | other_engine_memberK(_,Answer,Answer). 66 | other_engine_memberK(E,_,Answer):- 67 | engine_memberK(E,Answer). 68 | 69 | engine_unionK(Es,Answer):- 70 | member(E,Es), 71 | engine_memberK(E,Answer). 72 | 73 | memo_transformerK(BaseEngine,list_engine(Xs)):- 74 | findallK(X,engine_memberK(BaseEngine,X),Xs). 75 | 76 | new_memo_engineK(list_engine(Xs),E):- 77 | new_engineK(member(X,Xs),X,E). 78 | 79 | % data-structure to engine transformer 80 | list_engineK(Xs,E):- 81 | new_engineK(member(X,Xs),X,E). 82 | 83 | -------------------------------------------------------------------------------- /library/test_kernel_prolog.pl: -------------------------------------------------------------------------------- 1 | :-[kernel_prolog]. 2 | 3 | t1:-t1(_). 4 | 5 | t1(NewEs):- 6 | assertK( 7 | (a(13):-true), 8 | [], 9 | Es 10 | ), 11 | assertK( 12 | (a(14):-true), 13 | Es, 14 | NewEs 15 | ), 16 | clauseK(NewEs,a(X),true), 17 | println(X), 18 | fail. 19 | 20 | t2:- 21 | t1(Es), 22 | assertK((b(X):-a(X)),Es,NewEs), 23 | solveK(NewEs,b(R)), 24 | println(R), 25 | fail. 26 | 27 | 28 | :-dynamic a/1. 29 | :-dynamic b/1. 30 | 31 | a(1). 32 | a(2). 33 | 34 | b(X):-a(X). 35 | -------------------------------------------------------------------------------- /library/to_simple.pl: -------------------------------------------------------------------------------- 1 | to_simple(Files,File):- 2 | Db='$temp', 3 | db_clean(Db), 4 | (atomic(Files)->Fs=[Files];Fs=Files), 5 | foreach(member(F,Fs),portable_consult(F,Db)), 6 | db_save(Db,File). 7 | 8 | portable_consult(File,Db):- 9 | ( is_prolog(binprolog)->consult(File,Db) 10 | ; db_consult(File,Db) 11 | ). 12 | 13 | /* 14 | 15 | Usually you make a file like: 16 | 17 | project.pl containing: 18 | 19 | :-[myfile1]. 20 | :-[myfile2]. 21 | ... 22 | 23 | and then call to_simple with it. Here is an example 24 | with a single file - note that discontiguous predicates are handled 25 | without problems. The same applies to multifile predicates. 26 | 27 | ?- to_simple('t1.pl','t2.pl'). 28 | 29 | % input: file: t1.pl 30 | 31 | a(1). 32 | 33 | b(X):-a(X). 34 | 35 | a(2). 36 | 37 | 38 | % output: file: t2.pl 39 | 40 | ':-'(a(1),true). 41 | ':-'(a(2),true). 42 | ':-'(b(_x2647),a(_x2647)). 43 | 44 | */ 45 | -------------------------------------------------------------------------------- /library/xref.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/library/xref.pdf -------------------------------------------------------------------------------- /library/xref2txt.pl: -------------------------------------------------------------------------------- 1 | :-[library(xref)]. 2 | 3 | plain_xref(File):- 4 | plain_xref_checks(File), 5 | plain_list_call_graph(File). 6 | 7 | 8 | plain_list_call_graph(File):- 9 | db_proc(File,FN), 10 | nl,write('*** PREDICATE ***: '),write(FN), 11 | nl,nl, 12 | write('CALLS: '), 13 | forall(calles_to(File,FN,Callee),(write(Callee),write(' '))), 14 | nl,nl, 15 | write('CALLED FROM: '), 16 | forall(called_from(File,FN,Caller),(write(Caller),write(' '))), 17 | nl,nl,nl, 18 | fail 19 | ; nl. 20 | 21 | 22 | plain_xref_checks(File):- 23 | plain_xref_checks(File, 24 | write('UNDEFINED:'), 25 | write('UNUSED (statically unreachable from definitions)') 26 | ), 27 | !. 28 | 29 | 30 | plain_undef_check(DB):- 31 | undefined(DB,F/N), 32 | write(F/N),nl, 33 | fail 34 | ; nl. 35 | 36 | 37 | plain_check_unused(DB):- 38 | unused(DB,F/N), 39 | write(F/N),nl, 40 | fail 41 | ; nl. 42 | 43 | plain_xref_checks(File,A1,A2):- 44 | init_xref(File), 45 | nl,A1,nl,nl, 46 | plain_undef_check(File), 47 | nl,A2,nl,nl, 48 | plain_check_unused(File). 49 | 50 | -------------------------------------------------------------------------------- /makeall.bat: -------------------------------------------------------------------------------- 1 | cd src 2 | CALL makeall.bat 3 | cd .. 4 | call binbuild.bat 5 | cd ..\csocks 6 | CALL winmake.bat 7 | cd .. 8 | @echo DONE! 9 | -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | all: 2 | cd src ; make nobp 3 | cd src ; make realclean 4 | @echo executable: bin/bp 5 | ./bin/bp 6 | -------------------------------------------------------------------------------- /progs/ag_ic.pl: -------------------------------------------------------------------------------- 1 | :-op(200,xf,(?)). 2 | 3 | ic([a,b,c]). 4 | ic([d,e]). 5 | 6 | violates(Abduced,IC):- 7 | select(X,Abduced,More), 8 | select(Y,More,_), 9 | member(X,IC), 10 | member(Y,IC). 11 | 12 | inconsistent(Abduced):-ic(IC),violates(Abduced,IC). 13 | 14 | select(X,[X|Xs],Xs). 15 | select(X,[Y|Xs],[Y|Ys]):-select(X,Xs,Ys). 16 | 17 | explain(G,Explanation):- 18 | G, 19 | \+ ( 20 | -Abduced, 21 | inconsistent(Abduced) 22 | ), 23 | findall(Abduced,-Abduced,As), 24 | sort(As,Explanation). 25 | 26 | /* 27 | to add an instance A of an abducible do: 28 | 29 | for all instances B of the same abducible 30 | take out B 31 | if B is more general than A, then succeed 32 | else 33 | remove B, 34 | if A does not violate any constraints 35 | then add A 36 | else fail 37 | */ 38 | 39 | pick_subsumed(A,Bs):- 40 | functor(A,F,N), 41 | functor(B,F,N), 42 | -B, 43 | ( subsumes_check(A,B)->Bs=[B|MoreBs] 44 | ; Bs=MoreBs 45 | ), 46 | !, 47 | pick_subsumed(A,MoreBs). 48 | pick_subsumed(_,[]). 49 | 50 | add_abduced(A):- 51 | - abduced(B), 52 | ( -B, subsumes_check(B,A) -> +B 53 | ; +A 54 | ). 55 | 56 | '?'(X):-add_abduced(X). 57 | 58 | go:-explain(g,Explanation),write(Explanation),nl,fail. 59 | go. 60 | 61 | g:- a?,h?,i. 62 | h:- i,b?,c? . 63 | h:- i,d?,c? . 64 | i:- f? . 65 | -------------------------------------------------------------------------------- /progs/algraph.pl: -------------------------------------------------------------------------------- 1 | 2 | p:-[algraph]. 3 | 4 | path(X,X,[X]). 5 | path(X,Z,[X|Xs]):-c(X,Y),path(Y,Z,Xs). 6 | 7 | % data 8 | 9 | go(Xs):- 10 | (c(1,X1):-c1(X1)) -: 11 | (c(2,X2):-c2(X2)) -: 12 | (c(3,X3):-c3(X3)) -: 13 | (c(4,X4):-c4(X4)) -: 14 | path(1,5,Xs). 15 | 16 | c1(2). 17 | c1(3). 18 | 19 | c2(1). 20 | c2(4). 21 | 22 | c3(1). 23 | c3(5). 24 | 25 | c4(1). 26 | c4(5). 27 | 28 | % test 29 | 30 | go:-go(Xs),write(Xs),nl,fail. 31 | -------------------------------------------------------------------------------- /progs/allperms.pl: -------------------------------------------------------------------------------- 1 | fast_findall(X,G,Xs):-findall(X,G,Xs). 2 | 3 | all_permutations([],[[]]). 4 | all_permutations([X|Xs],Perms2):- 5 | all_permutations(Xs,Perms1), 6 | extend_permutations(Perms1,X,Perms2). 7 | 8 | extend_permutations([],_,[]). 9 | extend_permutations([Perm|Perms1],X,[[X|Perm]|Perms3]):- 10 | extend_permutations(Perms1,X,Perms2), 11 | insert_item(Perm,X,[],Perms2,Perms3). 12 | 13 | insert_item([],_,_,Perms,Perms). 14 | insert_item([Y|Ys],X,Acc,Perms1,[Zs|Perms2]):- 15 | reverse_and_append(Acc,[Y,X|Ys],Zs), 16 | insert_item(Ys,X,[Y|Acc],Perms1,Perms2). 17 | 18 | reverse_and_append([],Acc,Acc). 19 | reverse_and_append([X|Xs],Acc,Zs):- 20 | reverse_and_append(Xs,[X|Acc],Zs). 21 | 22 | nats(Max,Max,[Max]):-!. 23 | nats(Curr,Max,[Curr|Ns]):- 24 | Currtrue 27 | ; bb_error(N) 28 | ). 29 | 30 | bb_error(T):-functor(T,F,N), 31 | write(F/N), 32 | write(' ??? bb_def/3 expected before bb_set/3, bb_rm/2'),nl, 33 | fail. 34 | 35 | bb_let(N,K,_):-bb_rm(N,K),fail. 36 | bb_let(N,K,X):-bb_set(N,K,X). 37 | 38 | bb_def(K,X):-bb_def(K,K,X). 39 | 40 | bb_set(K,X):-bb_set(K,K,X). 41 | 42 | bb_val(K,X):-bb_val(K,K,X). 43 | 44 | bb_rm(K):-bb_rm(K,K). 45 | 46 | bb_let(K,X):-bb_let(K,K,X). 47 | 48 | bb:- 49 | bb(N,K,X),functor(N,Nf,Nn),functor(K,Kf,Kn), 50 | write(Nf/Nn+Kf/Kn=X),nl,fail 51 | ; nl. 52 | 53 | bb_assert(N,K,X):- 54 | term2key(N,NewN), 55 | term2key(K,NewK), 56 | assert(bb(NewN,NewK,X)). 57 | 58 | go:- 59 | bb_def(a,13),bb_set(a,10),bb_val(a,X),write(X),nl,fail 60 | ; bb_set(b,5) 61 | ; bb_def(f(1,1),g(2,2)),fail 62 | ; bb_val(f(a,a),X),write(X),nl,fail 63 | ; bb_rm(c,d) 64 | ; bb_def(_,_,_) 65 | ; bb. 66 | 67 | p:-reconsult('bb.pl'). 68 | -------------------------------------------------------------------------------- /progs/bestof.pl: -------------------------------------------------------------------------------- 1 | go:-G=max([3,4.66,1,-0.5],_Max),G,write(G),nl. 2 | 3 | max(Xs,X):-bestof(X, >, member(X,Xs)). 4 | 5 | % The following is an efficient implementation 6 | % of bestof/3 using the blackboard. 7 | % You add it to extra.pl and type ?-boot. to integrate it in the kernel 8 | % if you plan to use it. 9 | 10 | % true if X is an answer of Generator such that 11 | % X Rel Y for every other answer Y of Generator 12 | bestof(X,Closure,Generator):- 13 | copy_term(X,Y), 14 | Closure=..L1, 15 | det_append(L1,[X,Y],L2), 16 | Test=..L2, 17 | bestof0(X,Y,Generator,Test). 18 | 19 | bestof0(X,Y,Generator,Test):- 20 | inc_level(bestof,Level), 21 | Generator, 22 | update_bestof(Level,X,Y,Test), 23 | fail. 24 | bestof0(X,_,_,_):- 25 | dec_level(bestof,Level), 26 | val(bestof,Level,X), 27 | rm(bestof,Level). 28 | 29 | % uses Rel to compare New with so far the best answer 30 | update_bestof(Level,New,Old,Test):- 31 | val(bestof,Level,Old),!, 32 | Test, 33 | bb_set(bestof,Level,New). 34 | update_bestof(Level,New,_,_):- 35 | bb_let(bestof,Level,New). 36 | 37 | % ensure correct implementation of embedded calls to bestof/3 38 | inc_level(Obj,X1):-val(Obj,Obj,X),!,X1 is X+1,bb_set(Obj,Obj,X1). 39 | inc_level(Obj,1):-bb_def(Obj,Obj,1). 40 | 41 | dec_level(Obj,X):-val(Obj,Obj,X),X>0,X1 is X-1,bb_set(Obj,Obj,X1). 42 | 43 | -------------------------------------------------------------------------------- /progs/bfmeta.pl: -------------------------------------------------------------------------------- 1 | :-op(600,xfx,<=). 2 | 3 | clauses([ 4 | app([],A,A,B)<=B, 5 | app([C|D],E,[C|F],G)<=app(D,E,F,G), 6 | 7 | nrev([],[],H)<=H, 8 | nrev([I|J],K,L)<=nrev(J,M,app(M,[I],K,L)), 9 | 10 | perm([],[],N)<=N, 11 | perm([O|P],Q,R)<=perm(P,S,ins(O,S,Q,R)), 12 | 13 | ins(T,U,[T|U],V)<=V, 14 | ins(W,[X|Y],[X|Z],X0)<=ins(W,Y,Z,X0) 15 | ]). 16 | 17 | all_(G,R):-clauses(C),all_instances(G,C,R). 18 | 19 | all_instances(Goal,Clauses,Answers):- 20 | derive_all([Goal<=Goal],Clauses,[],Answers). 21 | 22 | % derives all answers until there is no Arrow=(Answer<=Goal) left 23 | 24 | derive_all([],_,As,As). 25 | derive_all([Arrow|Fs],Cs,OldAs,NewAs):- 26 | derive_one(Arrow,Cs,Fs,NewFs,OldAs,As), 27 | derive_all(NewFs,Cs,As,NewAs). 28 | 29 | % if Answer<=true has been deduced then keep answer 30 | % else replace Answer<=Goal with its consequences Answer<=Body 31 | % obtained from input clauses of the form Goal<=Body 32 | 33 | derive_one(Answer<=true,_,Fs,Fs,As,[Answer|As]). 34 | derive_one(Answer<=Goal,Cs,Fs,NewFs,As,As):-Goal\==true, 35 | match_all(Cs,Answer<=Goal,Fs,NewFs). 36 | 37 | match_all([],_,Fs,Fs). 38 | match_all([Clause|Cs],Arrow,Fs1,Fs3):- 39 | match_one(Arrow,Clause,Fs1,Fs2), 40 | match_all(Cs,Arrow,Fs2,Fs3). 41 | 42 | % basic inference step 43 | 44 | match_one(F1,F2,Fs,[F3|Fs]):-compose(F1,F2,F3),!. 45 | match_one(_,_,Fs,Fs). 46 | 47 | /* 48 | compose(F1,F2,A<=C):- 49 | write(F1+F2=before),nl, 50 | copy_term(F1,A<=B), 51 | write(after(A<=B)),nl, 52 | copy_term(F2,B<=C),write(F1+F2=(A<=C)),nl 53 | . 54 | */ 55 | 56 | compose(A<=B1,B2<=C,R):-findall(A<=C,B1=B2,[R]). 57 | 58 | time(G,T):-statistics(runtime,_),G,!,statistics(runtime,[_,T]). 59 | 60 | i1:-G=nrev([a(X),b,c(X)],_,true), all_(G,R),write(R),nl. 61 | 62 | i2:-G=app(_,_,[a,b],true), all_(G,R),statistics,write(R),nl. 63 | 64 | i3:-G=perm([a,b,c],_,true), all_(G,R),statistics,write(R),nl. 65 | 66 | integers([],I,I):-!. 67 | integers([I0|L],I0,I):-I0 make assumptions use always new numbers - or make 34 | engine ids alswas new - independently of their 35 | recycling mechanism 36 | */ 37 | 38 | /* pbench: also in assertbm - FIXED - by making sure assumptions are ignored 39 | in bb_gc 40 | 41 | index took 42 | user cpu (5148-380)/364431 = 0.0130834 ms/iteration 43 | 4 ??? warning: *** bad stamp or empty slot in set/3 or rm/2 *** 44 | >>> blackboard overflow, left only(126476): culprit(bb_put_1([1206000,1212588],4 45 | ,cont_marker(_x109229),f(3,_x2322))) 46 | *** discarding inconsistent blackboard content 47 | *** BB_OVERFLOW: 48 | addq(user,(null)/0 ??? warning: *** bad data in args(1) of name/2 *** 49 | (addq(user,(null)/0 ??? warning: *** bad data in args(1) of name/2 *** 50 | */ -------------------------------------------------------------------------------- /progs/calibrate.pro: -------------------------------------------------------------------------------- 1 | go:-calibrate. 2 | 3 | calibrate:- 4 | calibrate(T,Times), 5 | write(T=Times),nl. 6 | 7 | calibrate(T):-calibrate(T,_). 8 | 9 | calibrate(T,Details):-calibrate(30,T,Details). 10 | 11 | calibrate(Multiplier,T,times(lips(LIPS),nrev(TN),perm(TP),assert(TA))):- 12 | Base is 5, 13 | NTimes is Base*Multiplier, 14 | PTimes is Base*Multiplier, 15 | ATimes is Base*Multiplier, 16 | Len is 200, 17 | getctime(TB), 18 | fortest(NTimes), 19 | getctime(T0), 20 | nrevtest(Len,NTimes), 21 | getctime(T1), 22 | permtest(7,PTimes), 23 | getctime(T2), 24 | asserttest(5,ATimes), 25 | getctime(T3), 26 | TF is T0-TB, 27 | TN is T1-T0, 28 | TP is T2-T1, 29 | TA is T3-T2, 30 | T is TN+TP+TA, 31 | LI is (NTimes/1.0001)*(((Len+1)*(Len+2))//2), 32 | TS is (TN-TF)/1000.0001, 33 | LIPS is integer(LI/TS). 34 | 35 | fortest(N):-'$for'(_I,1,N),fail. 36 | fortest(_). 37 | 38 | nrevtest(N,Times):- 39 | findall(I,'$for'(I,1,N),Is), 40 | '$for'(I,1,Times), 41 | '$nrev'(Is,_), 42 | fail. 43 | nrevtest(_N,_Times). 44 | 45 | '$app'([],Ys,Ys). 46 | '$app'([A|Xs],Ys,[A|Zs]):- 47 | '$app'(Xs,Ys,Zs). 48 | 49 | '$nrev'([],[]). 50 | '$nrev'([X|Xs],Zs):- 51 | '$nrev'(Xs,Ys), 52 | '$app'(Ys,[X],Zs). 53 | 54 | permtest(N,Times):- 55 | '$for'(_I,1,Times), 56 | permtest(N), 57 | fail. 58 | permtest(_N,_Times). 59 | 60 | permtest(N):- 61 | findall(I,'$for'(I,1,N),Is), 62 | '$perm'(Is,_), 63 | fail. 64 | permtest(_). 65 | 66 | '$perm'([],[]). 67 | '$perm'([X|Xs],Zs):- 68 | '$perm'(Xs,Ys), 69 | '$insert'(X,Ys,Zs). 70 | 71 | '$insert'(X,Ys,[X|Ys]). 72 | '$insert'(X,[Y|Ys],[Y|Zs]):- 73 | '$insert'(X,Ys,Zs). 74 | 75 | asserttest(MX,MY):- 76 | initboard1(MX,MY), 77 | updateboard1(MX,MY), 78 | accessboard1(MX,MY), 79 | cleanboard1. 80 | 81 | initboard1(MaxX,MaxY):- 82 | '$for'(X,1,MaxX), 83 | '$for'(Y,1,MaxY), 84 | assert('$board'(X,Y,0)), 85 | fail. 86 | initboard1(_,_). 87 | 88 | updateboard1(MaxX,MaxY):- 89 | '$for'(X,1,MaxX), 90 | '$for'(Y,1,MaxY), 91 | update1(X,Y), 92 | fail. 93 | updateboard1(_,_). 94 | 95 | update1(X,Y):- 96 | retract('$board'(X,Y,_)), 97 | !, 98 | assert('$board'(X,Y,1)). 99 | 100 | accessboard1(MaxX,MaxY):- 101 | '$for'(X,1,MaxX), 102 | '$for'(Y,1,MaxY), 103 | '$board'(X,Y,_), 104 | fail. 105 | accessboard1(_,_). 106 | 107 | cleanboard1:- 108 | abolish('$board'/3). 109 | 110 | getctime(T):-statistics(runtime,[T,_]). 111 | 112 | '$for'(Min,Min,Max):-Min= call2(Do,Cont) ; throw(Term)) . 31 | 32 | call2(Do,NewCont,_) ::- call(Do,NewCont) . 33 | */ 34 | 35 | /* non exhaustive tests follow */ 36 | 37 | l :- [catch4] . 38 | 39 | 40 | a :- catch(b,X,write(ball(X))) , write(7) . 41 | 42 | b :- throw(1) . 43 | 44 | c :- catch(d,X,write(ball(X))) , write(7) , nl, fail . 45 | 46 | d . 47 | d :- throw(66) , write(oei) . 48 | d . 49 | 50 | f :- catch(g,X,write(h(X))) , write(99) , nl , fail . 51 | 52 | g :- catch(h,3,write(c(3))) , write(bla) , nl . 53 | 54 | h :- throw(4) . 55 | h :- write(h2) . 56 | 57 | 58 | k :- catch(s,X,t(h(X))) , write(99) , nl, fail . 59 | m :- catch(s,X,t(h(X))) , write(99) , nl , ! , fail . 60 | 61 | s :- throw(137) . 62 | 63 | t(X) :- write(X) , nl . 64 | t(X) :- write(2-X) , nl . 65 | 66 | 67 | u :- catch(g(X),B,write(f(B,X))) . 68 | 69 | g(X) :- X = 2 , throw(X) . 70 | -------------------------------------------------------------------------------- /progs/cbrev.pl: -------------------------------------------------------------------------------- 1 | app(nil,Ys,Ys). 2 | app(A^Xs,Ys,A^Zs):- 3 | app(Xs,Ys,Zs). 4 | 5 | nrev(nil,nil). 6 | nrev(X^Xs,R):- 7 | nrev(Xs,T), 8 | app(T,X^nil,R). 9 | 10 | full_range(It,L):- range(_,1,It),nrev(L,_), fail. 11 | full_range(_,_). 12 | 13 | dummy(_,_). 14 | 15 | empty_range(It,L):-range(_,1,It),dummy(L,_),fail. 16 | empty_range(_,_). 17 | 18 | range(Min,Min,Max):-Min= !,errmes(in_consume_cont,expected_marker(Marker)) 28 | ; arg(1,NextCont,X),Marker==X-> 29 | Gs=Goal,arg(2,NextCont,LastCont) 30 | ; Gs=(Goal,OtherGs), 31 | consume_cont1(Marker,OtherGs,NextCont,LastCont) 32 | ). 33 | 34 | % this `binarized clause' gets the current continuation 35 | get_cont(Cont,Cont)::-true(Cont). 36 | 37 | % setes calls NewCont as continuation to be called next 38 | call_cont(NewCont,_) ::- true(NewCont). 39 | 40 | % sets NewCont as continuation to be called next 41 | % instead of OldCont which is returned in arg 2 42 | swap_cont(NewCont,OldCont,OldCont) ::- true(NewCont). 43 | -------------------------------------------------------------------------------- /progs/cperms.pl: -------------------------------------------------------------------------------- 1 | % ap4.pl 2 | 3 | all_permutations([],[[]]). 4 | all_permutations([X|Xs],Ps2):- 5 | all_permutations(Xs,Ps1), 6 | extend_permutations(Ps1,X,Ps2). 7 | 8 | extend_permutations([],_,[]). 9 | extend_permutations([P|Ps1],X,[[X|P]|Ps3]):- 10 | extend_permutations(Ps1,X,Ps2), 11 | insert_item(P,[],X,Ps2,Ps3). 12 | 13 | insert_item([],_,_,Ps,Ps). 14 | insert_item([Y|Ys],Ys0,X,Ps1,[Zs|Ps2]):- 15 | reverse_and_append(Ys0,Ys,X,Ps1,Ps2,[Y|Ys0],Zs,[Y,X|Ys]). 16 | 17 | reverse_and_append([],Ys,X,Ps1,Ps2,Ys1,Zs,Zs):- 18 | insert_item(Ys, Ys1, X,Ps1,Ps2). 19 | reverse_and_append([X1|Xs],Ys,X,Ps1,Ps2, Ys1,Zs,Zs1):- 20 | reverse_and_append(Xs,Ys,X,Ps1,Ps2,Ys1, Zs,[X1|Zs1]). 21 | 22 | nats(Max,Max,[Max]):-!. 23 | nats(Curr,Max,[Curr|Ns]):- 24 | CurrB),!, 19 | repl_body(A,NewA), 20 | repl_body(B,NewB), 21 | repl_body(C,NewC). 22 | r_disj0(A,B,or(NewA,NewB)):- 23 | repl_body(A,NewA), 24 | repl_body(B,NewB). 25 | 26 | 27 | r_disj((A;B))-->!, 28 | r_disj(A), 29 | r_disj(B). 30 | r_disj((A->B))-->!, 31 | { repl_body(A,NA), 32 | repl_macro('!',CUT), 33 | repl_body(B,NB) 34 | }, 35 | [(NA,CUT,NB)]. 36 | r_disj(A)--> 37 | {repl_body(A,NA)}, 38 | [NA]. 39 | 40 | 41 | 42 | :-module(user). 43 | 44 | go:-X=(m;(n1;n2);p,q),'prolog:disj'(X,(a->b;c,X;d),R), 45 | pp_clause(R),nl, 46 | listing. 47 | -------------------------------------------------------------------------------- /progs/dlg.pl: -------------------------------------------------------------------------------- 1 | % Requires BinProlog 5.40 2 | 3 | % Datalog `preprocessor' : made obsolete by the possibility 4 | % to override BinProlog's generic Assumption Grammar mechanism. 5 | % well, the DCG preprocessor is made obsolete too :-) 6 | 7 | % CODE 8 | 9 | % this defines advancement in Datalog `phrase' given as a set of w/3 facts 10 | 11 | w(X):- 12 | dcg_val(From), 13 | w(From,To,X), 14 | dcg_def(To). 15 | 16 | % this recognizes a phrase From..To 17 | 18 | dlg_phrase(From,To):-dcg_def(From),axiom,dcg_val(To). 19 | 20 | % DATA 21 | 22 | % grammar 23 | 24 | axiom:-ng,v. 25 | 26 | ng:-a,n. 27 | 28 | a:-w(the). 29 | a:-w(a). 30 | 31 | n:-w(cat). 32 | n:-w(dog). 33 | 34 | v:-w(walks). 35 | v:-w(sleeps). 36 | 37 | % recognizing a sentence 38 | 39 | % input phrase in Datalog form 40 | 41 | w(0,1,the). 42 | w(1,2,cat). 43 | w(2,3,walks). 44 | 45 | % TEST 46 | 47 | test:-dlg_phrase(0,3). 48 | 49 | % ?-test. % will answer yes 50 | 51 | /* 52 | ?-reconsult(dlg). 53 | .. 54 | ?-trace(test). 55 | 56 | Call: test 57 | !!! clause: test/0 58 | Call: dlg_phrase(0,3) 59 | !!! clause: dlg_phrase/2 60 | Call: dcg_def(0) 61 | !!! compiled(dcg_def/1) 62 | Exit: dcg_def(0) 63 | Call: axiom 64 | !!! clause: axiom/0 65 | Call: ng 66 | !!! clause: ng/0 67 | Call: a 68 | !!! clause: a/0 69 | Call: w(the) 70 | !!! clause: w/1 71 | Call: dcg_val(_x4907) 72 | !!! compiled(dcg_val/1) 73 | Exit: dcg_val(0) 74 | Call: w(0,_x4903,the) 75 | !!! clause: w/3 76 | Exit: w(0,1,the) 77 | Call: dcg_def(1) 78 | !!! compiled(dcg_def/1) 79 | Exit: dcg_def(1) 80 | Exit: w(the) 81 | Exit: a 82 | Call: n 83 | !!! clause: n/0 84 | Call: w(cat) 85 | !!! clause: w/1 86 | Call: dcg_val(_x6533) 87 | !!! compiled(dcg_val/1) 88 | Exit: dcg_val(1) 89 | Call: w(1,_x6529,cat) 90 | !!! clause: w/3 91 | Exit: w(1,2,cat) 92 | Call: dcg_def(2) 93 | !!! compiled(dcg_def/1) 94 | Exit: dcg_def(2) 95 | Exit: w(cat) 96 | Exit: n 97 | Exit: ng 98 | Call: v 99 | !!! clause: v/0 100 | Call: w(walks) 101 | !!! clause: w/1 102 | Call: dcg_val(_x8159) 103 | !!! compiled(dcg_val/1) 104 | Exit: dcg_val(2) 105 | Call: w(2,_x8155,walks) 106 | !!! clause: w/3 107 | Exit: w(2,3,walks) 108 | Call: dcg_def(3) 109 | !!! compiled(dcg_def/1) 110 | Exit: dcg_def(3) 111 | Exit: w(walks) 112 | Exit: v 113 | Exit: axiom 114 | Call: dcg_val(3) 115 | !!! compiled(dcg_val/1) 116 | Exit: dcg_val(3) 117 | Exit: dlg_phrase(0,3) 118 | Exit: test 119 | 120 | */ 121 | -------------------------------------------------------------------------------- /progs/drive_tetris.pl: -------------------------------------------------------------------------------- 1 | % Hor Vert Size - starts at 0 2 | 3 | :-[tetris]. 4 | 5 | % defines actions as (local) predicate calls 6 | 7 | scr_dir(D):-remote_run(scr_dir(D)). 8 | 9 | scr_init(N):-remote_run(scr_init(N)). 10 | 11 | scr_end :- remote_run(scr_end). 12 | 13 | scr_send(Position,Code):-remote_run(scr_send(Position,Code)). 14 | 15 | scr_score(Score):-remote_run(scr_score(Score)). 16 | 17 | scr_stat(Val):-remote_run(scr_stat(Val)). 18 | -------------------------------------------------------------------------------- /progs/dtak.pl: -------------------------------------------------------------------------------- 1 | :-delphi tak/3-10/[1,2,3]. 2 | :-[tak]. 3 | 4 | /* 5 | before 1150 6 | first run 180 7 | second run 10 8 | third run 5 9 | */ 10 | -------------------------------------------------------------------------------- /progs/eassert.pl: -------------------------------------------------------------------------------- 1 | % emulating assert with backtrackable assumptions 2 | % on top of an extra engine in BinProlog 4.xx 3 | 4 | new_engine(E):- 5 | engine_params(H,S,T), 6 | new_engine(H,S,T,make_worker(X),X,E). 7 | 8 | new_engine(H,S,T,Goal,Answer,Handle):- 9 | create_engine(H,S,T,Handle), 10 | load_engine(Handle,Goal,Answer). 11 | 12 | send_engine(E,Goal):-assumel(todo(Goal)),ask_engine(E,_). 13 | 14 | make_worker(E):-current_engine(E),worker. 15 | 16 | worker:- 17 | todo(X),X\==done, 18 | copy_term(X,G), 19 | (G->true;true), 20 | co_worker. 21 | 22 | co_worker. 23 | co_worker:-worker. 24 | 25 | eassert(E,A):-send_engine(E,assumei(A)). 26 | 27 | % query 28 | 29 | go:- 30 | engine_params(200,100,100)=> 31 | new_engine(E), 32 | send_engine(E,ttyprint(hello)), 33 | eassert(E,a(1)), 34 | eassert(E,a(2)), 35 | listing, 36 | send_engine(E,done), 37 | destroy_engine(E). 38 | 39 | /* 40 | ?-go. 41 | 42 | hello 43 | % assumed a/1: 44 | a(1). 45 | a(2). 46 | 47 | % assumed todo/1: 48 | 49 | % assumed engine_params/3: 50 | */ 51 | -------------------------------------------------------------------------------- /progs/engines.pro: -------------------------------------------------------------------------------- 1 | :-[library(engines)]. 2 | 3 | go:-all_tests. 4 | 5 | 6 | bug:-engine_params(64,32,32)=>gc_test. 7 | 8 | -------------------------------------------------------------------------------- /progs/engtest.pl: -------------------------------------------------------------------------------- 1 | :-[allperms]. 2 | 3 | go1:- 4 | write(starting),nl, 5 | create_engine(256,64,64,E1), 6 | write(create=E1),nl, 7 | create_engine(128,64,64,E2), 8 | write(create=E2),nl, 9 | destroy_engine(E1), 10 | destroy_engine(E2), 11 | write(kill=E1+E2),nl. 12 | 13 | new_engine(E):-create_engine(256,64,64,E). 14 | 15 | go2:-create_engine(256,64,64,E1),create_engine(100,32,32,E2), 16 | load_engine(E1, append([1,2],[3,4],Xs), Xs), 17 | ask_engine(E1,R1),write(R1),nl, 18 | load_engine(E2, (statistics,append(As,Bs,[A,B,B,A])), As+Bs), 19 | ask_engine(E2,R2),write(R2),nl, 20 | destroy_engine(E2), 21 | destroy_engine(E1). 22 | 23 | go3:- 24 | create_engine(256,64,64,E), 25 | G=append(As,Bs,[A,B,B,A]), 26 | load_engine(E,G,As+Bs), 27 | ask_engine(E,R1),copy_term(R1,C1), 28 | write(G=>R1),nl, 29 | ask_engine(E,R2),copy_term(R2,C2), 30 | write(C1),nl, 31 | write(C2),nl, 32 | ask_engine(E,R),write(R),nl, 33 | ask_engine(E,R),write(R),nl, 34 | load_engine(E,member(X,[1,2,3]),X), 35 | ask_engine(E,S),write(S),nl, 36 | ask_engine(E,S1),write(S1),nl, 37 | ask_engine(E,S2),write(S2),nl, 38 | (ask_engine(E,R)->write(R),nl;true), 39 | destroy_engine(E). 40 | 41 | go4:- 42 | create_engine(256,64,64,E), 43 | load_engine(E,(go;statistics),true), 44 | ask_engine(E,true). 45 | 46 | go5:- 47 | create_engine(256,64,64,E), 48 | load_engine(E,append(As,Bs,[A,B,B,A]),As+Bs), 49 | ask_engine(E,R1),write(R1),nl, 50 | ask_engine(E,R2),write(R2),nl, 51 | load_engine(E,member(X,[1,2,3]),X), 52 | ask_engine(E,R3),write(R3),nl, 53 | ask_engine(E,R4),write(R4),nl, 54 | destroy_engine(E). 55 | 56 | make_engine(Goal,Answer,E):- 57 | new_engine(E), 58 | load_engine(E,Goal,Answer). 59 | 60 | suspend:-suspend_engine(0). 61 | 62 | consume(X):-repeat,suspend,nonvar(X),assert(answer(X)),!. 63 | 64 | produce(X):-perm([1,2,3],X),suspend,write(after),nl. 65 | 66 | go6:- 67 | make_engine(produce(X),X,P),write(prolog_engine=P),nl, 68 | make_engine(consume(X),X,C),write(prolog_engine=C),nl, 69 | multitask_engines(5000), 70 | % ask_engine(P,R), 71 | % ask_engine(C,R), 72 | listing. 73 | 74 | 75 | -------------------------------------------------------------------------------- /progs/eperms.pl: -------------------------------------------------------------------------------- 1 | go:- 2 | all_permutations_with_engine([1,2,3],Ps), 3 | write(Ps),nl. 4 | 5 | % nondeterninistic permutation generator 6 | perm([],[]). 7 | perm([X|Xs],Zs):- 8 | perm(Xs,Ys), 9 | insert(X,Ys,Zs). 10 | 11 | insert(X,Ys,[X|Ys]). 12 | insert(X,[Y|Ys],[Y|Zs]):- 13 | insert(X,Ys,Zs). 14 | 15 | % list of all permutations generator 16 | all_permutations_with_engine(Xs,Ps):- 17 | create_engine(E), % create new engine 18 | load_engine(E,perm(Xs,P),P), % load engine with new goal 19 | grab_all(E,Ps), % process answers 20 | destroy_engine(E). % release engine 21 | 22 | % permutation processor 23 | grab_all(E,[P|Ps]):- 24 | ask_engine(E,P),!, 25 | grab_all(E,Ps). 26 | grab_all(_,[]). 27 | -------------------------------------------------------------------------------- /progs/fbrev.pl: -------------------------------------------------------------------------------- 1 | % uses builtin append 2 | 3 | nrev([],[]). 4 | nrev([X|Xs],R):- 5 | nrev(Xs,T), 6 | append(T,[X],R). 7 | 8 | full_range(It,L):- range(_,1,It),nrev(L,_), fail. 9 | full_range(_,_). 10 | 11 | dummy(_,_). 12 | 13 | empty_range(It,L):-range(_,1,It),dummy(L,_),fail. 14 | empty_range(_,_). 15 | 16 | range(Min,Min,Max):-Min=! %,fail 36 | ; true 37 | ). 38 | get_a_predicate(FN,Cs):- 39 | get_a_predicate(FN,Cs). 40 | 41 | read_predicate(FN,[C|Cs]):- 42 | rclause(FN,C), 43 | ( FN=end_of_file/0->Cs=[] 44 | ; get_all_clauses(FN,Cs) 45 | ). 46 | 47 | get_all_clauses(FN,Cs):-findall(C,get_a_clause(FN,C),Cs). 48 | 49 | get_a_clause(FN,C):- 50 | radd(NewFN,C), 51 | ( 52 | (NewFN = FN, NewFN\==(:-)/1) -> true 53 | ; !, bb_def(left,over,NewFN-C),fail 54 | ). 55 | get_a_clause(FN,C):- 56 | get_a_clause(FN,C). 57 | 58 | rclause(FN,C):-bb_val(left,over,FN-C),bb_rm(left,over),!. 59 | rclause(FN,C):-radd(FN,C). 60 | 61 | radd(FN,C):-read_clause(C),get_pred(C,FN). 62 | 63 | get_pred((H:-_),F/N):-!,functor(H,F,N). 64 | get_pred((::-(H,_)),F/N1):-!,functor(H,F,N),N1 is N-1. 65 | get_pred(H,F/N):-functor(H,F,N). 66 | 67 | 68 | '::-'(a(1,C),b(C)). 69 | a(2). 70 | 71 | b. 72 | 73 | :-write(a),nl. 74 | :-write(b),nl. 75 | 76 | c(X)-->{a(X)},[ok]. 77 | d(X)-->{X=3}. 78 | 79 | d(S,T):-c(2,S,T). 80 | ax(X)-->c(X);d(X). 81 | 82 | ax:-ax(X,Xs,[]),write(X+Xs),nl,fail. 83 | -------------------------------------------------------------------------------- /progs/fknight.pl: -------------------------------------------------------------------------------- 1 | p:-compile('fknight.pl'). 2 | 3 | /* 4 | adapted by Paul Tarau from (partial) KnightTour benchmark originally 5 | written by Evan Tick 6 | */ 7 | 8 | go:-go(5). 9 | 10 | go(N):- 11 | time(_), 12 | make_board(N,Board,NbMoves), 13 | knight(NbMoves,1,1,N,Board),!, 14 | time(T), 15 | nl,write('BMARK_fknight'=[time(T),'N'=N]),nl, 16 | statistics,show(N,Board). 17 | 18 | make_board(N,Board,M):- 19 | M is N*N, 20 | functor(Line,line,N), 21 | findall(Line,range(_,1,N),LBoard), 22 | Board=..[board|LBoard]. 23 | 24 | val(I,J,Val,N,Board):- 25 | I>0,I=0,J=nl;true), 53 | fail. 54 | show(_,_):-nl. 55 | 56 | move( 2, 1). 57 | move( 2,-1). 58 | move(-2, 1). 59 | move(-2,-1). 60 | move( 1, 2). 61 | move(-1, 2). 62 | move( 1,-2). 63 | move(-1,-2). 64 | 65 | 66 | time(T) :- statistics(runtime,[_,T]). 67 | 68 | -------------------------------------------------------------------------------- /progs/fmoney.pl: -------------------------------------------------------------------------------- 1 | go:- 2 | time(_), 3 | puzzle(Show,[0,1,2,3,4,5,6,7,8,9],_), 4 | time(T), 5 | Show, 6 | write(time(T)),nl. 7 | 8 | 9 | puzzle(show(S,E,N,D,M,O,R,Y))--> 10 | digit(D),digit(E),{add_digit(D,E,Y, 0,R1)},digit(Y), 11 | digit(N),digit(R),{add_digit(N,R,E, R1,R2)}, 12 | digit(O), {add_digit(E,O,N, R2,R3)}, 13 | digit(S),{S>0}, 14 | digit(M),{M>0}, {add_digit(S,M,O, R3, 15 | M)}. 16 | 17 | add_digit(C1,C2,Res,R1,R2):- 18 | S is C1+C2+R1, 19 | Res is S mod 10, 20 | R2 is S // 10. 21 | 22 | digit(X,[X|Xs],Xs). 23 | digit(X,[Y|Xs],[Y|Ys]):-digit(X,Xs,Ys). 24 | 25 | show(S,E,N,D,M,O,R,Y):- 26 | write(' '), 27 | write([S,E,N,D]), 28 | write(+),nl, 29 | write(' '), 30 | write([M,O,R,E]), 31 | write(=),nl, 32 | write([M,O,N,E,Y]),nl, 33 | fail 34 | ; nl. 35 | 36 | time(T):-statistics(runtime,[_,T]). 37 | -------------------------------------------------------------------------------- /progs/fperms.pl: -------------------------------------------------------------------------------- 1 | perms([],T,R,[T|R]). 2 | perms([X|Xs],T,R):-cycle([],X,Xs,T,R). 3 | 4 | cycle(L,M,[],T,R):-perms(L,[M|T],R). 5 | cycle(L,M,[R|RR],T,P):- 6 | append(L,R,LR), 7 | perms(LR,[M|T], R), 8 | cycle([M|L],R,RR,T,P). 9 | 10 | fperms(Xs,Ps):-perms(Xs,[],[],Ps). 11 | 12 | go:-fperms([1,2,3],Xs),write(Xs),nl,fail. 13 | 14 | /* 15 | 16 | 17 | Although your automatic programming system sounds interesting, that 18 | conclusion would be a bit premature. Here's another program for 19 | generating permutations: 20 | 21 | fun perms ([], tail, res) = tail :: res 22 | | perms (x::xr, tail, res) = cycle([], x, xr, tail, res) 23 | and cycle (left, mid, [], tail, res) = 24 | perms(left, mid::tail, res) 25 | | cycle (left, mid, right as r::rr, tail, res) = 26 | cycle(mid::left, r, rr, tail, perms(left @ right, mid::tail, res)) 27 | 28 | fun fastperms xs = perms(xs, [], []) 29 | 30 | (* The idea is to build the permutations from the tail rather than the 31 | * head of the list; and to use an accumulating parameter for the 32 | * resulting list of permutations; both reduce the number of cons 33 | * operations. 34 | * 35 | * perms(xs, tail, res) = map (fn pm => pm @ tail) xs_perms @ res 36 | * where xs_perms is a list of permutations of xs 37 | *) 38 | 39 | The programs compare as follows under SML/NJ 108.18 (on a Linux/133MHz 40 | Pentium): 41 | 42 | (1) The permutation algorithm generated by adate: 43 | 44 | time (length o f) [1,2,3,4,5,6,7,8,9]; 45 | User: 34.600 System: 3.920 GC: 27.780 Real: 40.425 46 | Memory: 39 MB resident 47 | 48 | (2) The above program: 49 | 50 | time (length o fastperms) [1,2,3,4,5,6,7,8,9]; 51 | User: 11.700 System: 1.240 GC: 8.460 Real: 13.743 52 | Memory: 18 MB resident 53 | 54 | 55 | I have received five permutation programs by e-mail. Asymptotically, the 56 | program written by Peter Sestoft seems to be the fastest. 57 | 58 | Rewritten into the ADATE subset of ML, this program is as follows. 59 | 60 | fun f(Xs) = 61 | let 62 | fun perms(As,Tail,Res) = 63 | case As of 64 | nil => Tail::Res 65 | | X::Xr => cycle(nil, X, Xr, Tail, Res) 66 | and cycle(Left, Mid, Right, Tail1, Res1) = 67 | case Right of 68 | nil => perms(Left,Mid::Tail1,Res1) 69 | | R::Rr => 70 | cycle(Mid::Left, R, Rr, Tail1, perms(Left@Right, Mid::Tail1, Res1)) 71 | in 72 | perms(Xs, nil, nil) 73 | end 74 | 75 | 76 | */ 77 | -------------------------------------------------------------------------------- /progs/gc.pl: -------------------------------------------------------------------------------- 1 | go:-go(1000000),go1(1000000),go2(10000). 2 | 3 | go(N):-loop(N),statistics. 4 | 5 | loop(0). 6 | loop(N):-N>0,N1 is N-1,make_garbage(N1,_),loop(N1). 7 | 8 | make_garbage(X,g(X)). 9 | 10 | go1(N):-loop1(N,dummy),statistics. 11 | 12 | loop1(0,_). 13 | loop1(N,X):-N>0,N1 is N-1,make_garbage(X,X1),loop1(N1,X1). 14 | 15 | go2(N) :- 16 | mkfreelist(N,L), 17 | ctime(A), 18 | (mmc(N,L), fail ; true), 19 | ctime(B), 20 | X is B - A, 21 | write(time(X)), nl, fail 22 | ; statistics. 23 | 24 | mmc(N,L) :- 25 | N > 0, 26 | M is N - 1, 27 | mmc(M,L), 28 | !. 29 | mmc(_,L) :- 30 | mkground(L). 31 | 32 | mkfreelist(N,L) :- 33 | (N = 0 -> 34 | L = [] 35 | ; 36 | NN is N - 1, 37 | L = [_|R], 38 | mkfreelist(NN,R) 39 | ). 40 | 41 | mkground([]). 42 | mkground([a|R]) :- 43 | mkground(R). 44 | 45 | -------------------------------------------------------------------------------- /progs/gc_bug.pl: -------------------------------------------------------------------------------- 1 | % bp -q0 -t2000 2 | go:-go(100000). 3 | 4 | go(N):-go(N,L),println(L). 5 | 6 | go(N,L):- 7 | gen_cs(N,Xs), 8 | #>Xs, 9 | get_cs(Cs), 10 | #<[], 11 | length(Cs,L). 12 | 13 | get_cs([C|Cs]):- #C,!,get_cs(Cs). 14 | get_cs([]). 15 | 16 | gen_cs(0,[]):-!. 17 | gen_cs(I,[C|Cs]):- 18 | I>0, 19 | I1 is I-1, 20 | C is 0'a + I mod 26, 21 | gen_cs(I1,Cs). 22 | -------------------------------------------------------------------------------- /progs/hag_bm.pl: -------------------------------------------------------------------------------- 1 | % comparision between HAGs and DCGs on arith. expr. grammar 2 | % author: Paul Tarau 3 | % timestamp: Sat Sep 30 13:45:39 ADT 1995 4 | 5 | go:-go(4). 6 | 7 | go(N):- 8 | test(N,'DCG_bmark:',dcgs(_)), 9 | test(N,'HAG_bmark:',hags(_)). 10 | 11 | % DCG 12 | 13 | axiom --> ex,[';']. 14 | 15 | ex --> term,terms. 16 | 17 | terms --> []. 18 | terms --> aterm,terms. 19 | 20 | aterm --> ['+'],term. 21 | aterm --> ['-'],term. 22 | 23 | term --> factor,factors. 24 | 25 | factors --> []. 26 | factors --> mfactor,factors. 27 | 28 | mfactor --> ['*'],factor. 29 | mfactor --> ['/'],factor. 30 | 31 | factor --> [id], subfactors. 32 | factor --> ['('], ex, [')']. 33 | 34 | subfactors --> []. 35 | subfactors --> ['('], ex, exs, [')']. 36 | 37 | exs --> []. 38 | exs --> [','],ex,exs. 39 | 40 | 41 | % equivalent HAG 42 | 43 | axiom :- ex, #(';'). 44 | 45 | ex :- term,terms. 46 | 47 | terms. 48 | terms :- aterm,terms. 49 | 50 | aterm:- #('+'),term. 51 | aterm:- #('-'),term. 52 | 53 | term :- factor,factors. 54 | 55 | factors. 56 | factors :- mfactor,factors. 57 | 58 | mfactor :- #('*'),factor. 59 | mfactor :- #('/'),factor. 60 | 61 | factor :- #id, subfactors. 62 | factor :- #('('), ex, #(')'). 63 | 64 | subfactors. 65 | subfactors :- #('('), ex, exs, #(')'). 66 | 67 | exs. 68 | exs :- #(',') ,ex,exs. 69 | 70 | 71 | % tools for DCG vs. HAG comparison 72 | 73 | dcgs(Xs):-axiom(Xs,[]). 74 | 75 | hags(Xs):-dcg_def(Xs),axiom,dcg_val([]). 76 | 77 | dummy(_):-fail. 78 | 79 | terminal(id). 80 | terminal('+'). 81 | terminal('-'). 82 | terminal('*'). 83 | terminal('/'). 84 | terminal(','). 85 | terminal('('). 86 | terminal(')'). 87 | terminal(';'). 88 | 89 | generate(0,[]). 90 | generate(N,[X|Xs]):-N>0,N1 is N-1,generate(N1,Xs),terminal(X). 91 | 92 | do(N,Goal):- 93 | write(begin(N)),nl, 94 | generate(N,Xs), 95 | arg(1,Goal,Xs), 96 | Goal, 97 | writeln(Xs), 98 | fail. 99 | do(N,_):-write(end(N)),nl. 100 | 101 | writeln([]):-nl. 102 | writeln([X|Xs]):-write(X),writeln(Xs). 103 | 104 | time(T):-statistics(runtime,[T,_]). 105 | 106 | test(N,Mes,Goal):- 107 | time(T0), 108 | do(N,dummy(_)), 109 | time(T1), 110 | do(N,Goal), 111 | time(T2), 112 | T is (T2-T1)-(T1-T0), 113 | write(Mes=time(T)),nl,nl. 114 | -------------------------------------------------------------------------------- /progs/hag_bm1.pl: -------------------------------------------------------------------------------- 1 | % DCG 2 | 3 | axiom --> ex,[';']. 4 | 5 | ex --> term,terms. 6 | 7 | terms --> []. 8 | terms --> plus_op,term,terms. 9 | 10 | term --> factor,factors. 11 | 12 | factors --> []. 13 | factors --> mul_op,factor,factors. 14 | 15 | factor --> [id], subfactors. 16 | factor --> ['(',ex,')']. 17 | 18 | subfactors --> []. 19 | subfactors --> ['('], ex, exs, [')']. 20 | 21 | exs --> []. 22 | exs --> [','],ex,exs. 23 | 24 | plus_op --> ['+']. 25 | plus_op --> ['-']. 26 | 27 | mul_op --> ['*']. 28 | mul_op --> ['/']. 29 | 30 | 31 | % HAG 32 | axiom :- ex, #(';'). 33 | 34 | ex :- term,terms. 35 | 36 | terms. 37 | terms :- plus_op,term,terms. 38 | 39 | term :- factor,factors. 40 | 41 | factors. 42 | factors :- mul_op,factor,factors. 43 | 44 | factor :- #id, subfactors. 45 | factor :- #('('), ex, #(')'). 46 | 47 | subfactors. 48 | subfactors :- #('('), ex, exs, #(')'). 49 | 50 | exs. 51 | exs :- #(',') ,ex,exs. 52 | 53 | plus_op :- #('+'). 54 | plus_op :- #('-'). 55 | 56 | mul_op :- #('*'). 57 | mul_op :- #('/'). 58 | 59 | % common data 60 | 61 | terminal(id). 62 | terminal('+'). 63 | terminal('-'). 64 | terminal('*'). 65 | terminal('/'). 66 | terminal(','). 67 | terminal('('). 68 | terminal(')'). 69 | terminal(';'). 70 | 71 | % DCG vs. HAG comparison 72 | 73 | generate(0,[]). 74 | generate(N,[X|Xs]):-N>0,N1 is N-1,generate(N1,Xs),terminal(X). 75 | 76 | do(N,Goal):- 77 | write(begin(N)),nl, 78 | generate(N,Xs), 79 | arg(1,Goal,Xs), 80 | Goal, 81 | writeln(Xs), 82 | fail. 83 | do(N,_):-write(end(N)),nl. 84 | 85 | test(N,Mes,Goal):- 86 | time(T0), 87 | do(N,dummy(_)), 88 | time(T1), 89 | do(N,Goal), 90 | time(T2), 91 | T is (T2-T1)-(T1-T0), 92 | write(Mes=time(T)),nl,nl. 93 | 94 | writeln([]):-nl. 95 | writeln([X|Xs]):-write(X),writeln(Xs). 96 | 97 | time(T):-statistics(runtime,[T,_]). 98 | 99 | dcgs(Xs):-axiom(Xs,[]). 100 | 101 | hags(Xs):-dcg_def(Xs),axiom,dcg_val([]). 102 | 103 | dummy(_):-fail. 104 | 105 | go(N):- 106 | test(N,'DCG_bmark:',dcgs(_)), 107 | test(N,'HAG_bmark:',hags(_)). 108 | 109 | go:-go(4). 110 | -------------------------------------------------------------------------------- /progs/hag_bm2.pl: -------------------------------------------------------------------------------- 1 | % DCG 2 | 3 | axiom --> ex,[';']. 4 | 5 | ex --> term,terms. 6 | 7 | terms --> []. 8 | terms --> ['+'],term,terms. 9 | terms --> ['-'],term,terms. 10 | 11 | term --> factor,factors. 12 | 13 | factors --> []. 14 | factors --> ['*'],factor,factors. 15 | factors --> ['/'],factor,factors. 16 | 17 | factor --> [id], subfactors. 18 | factor --> ['(',ex,')']. 19 | 20 | subfactors --> []. 21 | subfactors --> ['('], ex, exs, [')']. 22 | 23 | exs --> []. 24 | exs --> [','],ex,exs. 25 | 26 | % HAG 27 | axiom :- ex, #(';'). 28 | 29 | ex :- term,terms. 30 | 31 | terms. 32 | terms :- #('+'),term,terms. 33 | terms :- #('-'),term,terms. 34 | 35 | term :- factor,factors. 36 | 37 | factors. 38 | factors :- #('*'),factor,factors. 39 | factors :- #('/'),factor,factors. 40 | 41 | factor :- #id, subfactors. 42 | factor :- #('('), ex, #(')'). 43 | 44 | subfactors. 45 | subfactors :- #('('), ex, exs, #(')'). 46 | 47 | exs. 48 | exs :- #(',') ,ex,exs. 49 | 50 | 51 | % common data 52 | 53 | terminal(id). 54 | terminal('+'). 55 | terminal('-'). 56 | terminal('*'). 57 | terminal('/'). 58 | terminal(','). 59 | terminal('('). 60 | terminal(')'). 61 | terminal(';'). 62 | 63 | % DCG vs. HAG comparison 64 | 65 | generate(0,[]). 66 | generate(N,[X|Xs]):-N>0,N1 is N-1,generate(N1,Xs),terminal(X). 67 | 68 | do(N,Goal):- 69 | write(begin(N)),nl, 70 | generate(N,Xs), 71 | arg(1,Goal,Xs), 72 | Goal, 73 | writeln(Xs), 74 | fail. 75 | do(N,_):-write(end(N)),nl. 76 | 77 | test(N,Mes,Goal):- 78 | time(T0), 79 | do(N,dummy(_)), 80 | time(T1), 81 | do(N,Goal), 82 | time(T2), 83 | T is (T2-T1)-(T1-T0), 84 | write(Mes=time(T)),nl,nl. 85 | 86 | writeln([]):-nl. 87 | writeln([X|Xs]):-write(X),writeln(Xs). 88 | 89 | time(T):-statistics(runtime,[T,_]). 90 | 91 | dcgs(Xs):-axiom(Xs,[]). 92 | 93 | hags(Xs):-dcg_def(Xs),axiom,dcg_val([]). 94 | 95 | dummy(_):-fail. 96 | 97 | go(N):- 98 | test(N,'DCG_bmark:',dcgs(_)), 99 | test(N,'HAG_bmark:',hags(_)). 100 | 101 | go:-go(4). 102 | -------------------------------------------------------------------------------- /progs/ham.pl: -------------------------------------------------------------------------------- 1 | % benchmark by D. Diaz from the WAMCC distribution 2 | % slightly modified to remove irrelevant output by Paul tarau 3 | 4 | go:- statistics(runtime,_), 5 | ham, 6 | statistics(runtime,[_,Y]), 7 | write('Hamilton benchmark time : '), write(Y), nl. 8 | 9 | ham:-cycle_ham([a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t],_),fail. 10 | ham. 11 | 12 | 13 | cycle_ham([X|Y],[X,T|L]):- 14 | chain_ham([X|Y],[],[T|L]), 15 | edge(T,X). 16 | 17 | 18 | chain_ham([X],L,[X|L]). 19 | chain_ham([X|Y],K,L):- 20 | del(Z,Y,T), 21 | edge(X,Z), 22 | chain_ham([Z|T],[X|K],L). 23 | 24 | del(X,[X|Y],Y). 25 | del(X,[U|Y],[U|Z]):- 26 | del(X,Y,Z). 27 | 28 | edge(X,Y):- 29 | connect(X,L), 30 | el(Y,L). 31 | 32 | el(X,[X|_]). 33 | el(X,[_|L]):- 34 | el(X,L). 35 | 36 | connect(a,[b,j,k]). 37 | connect(b,[a,c,p]). 38 | connect(c,[b,d,l]). 39 | connect(d,[c,e,q]). 40 | connect(e,[d,f,m]). 41 | connect(f,[e,g,r]). 42 | connect(g,[f,h,n]). 43 | connect(h,[i,g,s]). 44 | connect(i,[j,h,o]). 45 | connect(j,[a,i,t]). 46 | connect(k,[o,l,a]). 47 | connect(l,[k,m,c]). 48 | connect(m,[l,n,e]). 49 | connect(n,[m,o,g]). 50 | connect(o,[n,k,i]). 51 | connect(p,[b,q,t]). 52 | connect(q,[p,r,d]). 53 | connect(r,[q,s,f]). 54 | connect(s,[r,t,h]). 55 | connect(t,[p,s,j]). 56 | 57 | 58 | 59 | -------------------------------------------------------------------------------- /progs/han.pl: -------------------------------------------------------------------------------- 1 | /* Prolog version of hanoi benchmark */ 2 | 3 | go:-go(16). 4 | 5 | time(T):-statistics(runtime,[T,_]). 6 | 7 | go(N) :- time(T1),han(N,1,2,3),time(T2),T is T2-T1,write(T),nl. 8 | 9 | han(N,_,_,_) :- N=<0,!. 10 | han(N,A,B,C) :- N>0, 11 | N1 is N - 1, 12 | %write(A+B=C),nl, 13 | han(N1,A,C,B), 14 | han(N1,C,B,A). 15 | 16 | -------------------------------------------------------------------------------- /progs/hello.pro: -------------------------------------------------------------------------------- 1 | /* 2 | do not consult directly: demo 3 | for creation of standalone executables 4 | 5 | requires full source BinProlog license 6 | */ 7 | :-op(200,fx,hello). 8 | 9 | :-begin_module(prolog). 10 | :-[wam]. 11 | :-end_module(prolog). 12 | 13 | main:-write(hello world),nl. 14 | -------------------------------------------------------------------------------- /progs/horn_gram.pl: -------------------------------------------------------------------------------- 1 | list2clause(Chars,Clause):- 2 | gc_call(( 3 | tokenizer(Chars,Tokens), parser(Tokens,Clause) 4 | )). 5 | 6 | % Horn clause parser 7 | 8 | parser(Tokens,Term):- 9 | dcg_def(Tokens), 10 | clause(Term), 11 | dcg_val([]). 12 | 13 | clause(':-'(H,B)) :- head(H), body(B). 14 | 15 | head(H) :- term(H). 16 | 17 | body(Bs) :- #iff,goal(B),goals(B,Bs). 18 | body(true) :- #eoc. 19 | 20 | goals(G,','(G,Gs)) :- #comma, goal(NewG), goals(NewG,Gs). 21 | goals(G,G) :- #eoc. 22 | 23 | goal(G) :- term(G). 24 | 25 | term(V) :- #var(T),lval(a_var,T,V). 26 | term(N) :- #num(N). 27 | term(T) :- #const(F),args(Xs),T=..[F|Xs]. 28 | 29 | args([T|Ts]) :- #lpar,term(T),arglist(Ts). 30 | args([]). 31 | 32 | arglist([]) :- #rpar. 33 | arglist([T|Ts]) :- #comma,term(T),arglist(Ts). 34 | 35 | 36 | % tokenizer 37 | 38 | tokenizer(Cs,Ws):-dcg_def([32|Cs]),words(Ws),!,dcg_val([]). 39 | 40 | words(Ws):-star(word,Ws),space. 41 | 42 | word(W):-space,token(W). 43 | 44 | token(lpar):-c("("). 45 | token(rpar):-c(")"). 46 | token(comma):-c(","). 47 | token(eoc):-c("."). 48 | token(iff):-c(":-"). 49 | token(Token):-token(F,Xs),name(N,Xs),Token=..[F,N]. 50 | 51 | token(num,Xs) :- plus(is_digit,Xs). 52 | token(const,Xs) :- one(is_punct,Xs). 53 | token(F,Xs) :- #X,sym(X,F,Xs). 54 | 55 | sym(X,var,[X|Xs]):-is_maj(X),!,star(is_letter,Xs). 56 | sym(X,const,[X|Xs]):-is_min(X),star(is_letter,Xs). 57 | 58 | c([]). 59 | c([X|Xs]) :- #X,c(Xs). 60 | 61 | space:-star(is_space,_). 62 | 63 | is_space(X):- #X, member(X,[32,7,9,10,13]). 64 | 65 | is_letter(X):- #X, is_an(X). 66 | 67 | is_punct(X):- #X, (is_spec(X);member(X,"!;`""'[]{}*")). 68 | 69 | is_digit(X):- #X, is_num(X). 70 | 71 | % regexp tools with AGs + high order 72 | 73 | one(F,[X]):- call(F,X). 74 | 75 | star(F,[X|Xs]):- call(F,X),!,star(F,Xs). 76 | star(_,[]). 77 | 78 | plus(F,[X|Xs]):- call(F,X),star(F,Xs). 79 | 80 | 81 | % tests 82 | 83 | data( 84 | "f(X,s(X))." 85 | ). 86 | data( 87 | "f(X,s(X)):- 88 | a(Y1,13,2, Y1 ),!, 89 | g(X,b). 90 | "). 91 | 92 | 93 | test:-data(Cs),tokenizer(Cs,Ws),write(Ws),nl,fail. 94 | 95 | go:- 96 | data(Cs), 97 | list2clause(Cs,T), 98 | write(T),nl, 99 | fail. 100 | 101 | 102 | -------------------------------------------------------------------------------- /progs/ic.pl: -------------------------------------------------------------------------------- 1 | ic([a,b,c]). 2 | ic([d,e]). 3 | 4 | ab([a,c,f]). 5 | ab([a,d]). 6 | ab([b,c,d]). 7 | 8 | violates(Abduced,IC):-select(X,Abduced,More),select(Y,More,_),member(X,IC),member(Y,IC). 9 | 10 | inconsistent(Abduced):-ic(IC),violates(Abduced,IC). 11 | 12 | select(X,[X|Xs],Xs). 13 | select(X,[Y|Xs],[Y|Ys]):-select(X,Xs,Ys). 14 | 15 | explanation(Abduced):- ab(Abduced), \+inconsistent(Abduced). 16 | 17 | go:-explanation(Abduced),write(Abduced),nl,fail. 18 | go. 19 | -------------------------------------------------------------------------------- /progs/if0_fibo.pl: -------------------------------------------------------------------------------- 1 | fibo(N,X):-if0(N=<1,X=1,fibo1(N,X)). 2 | 3 | fibo1(N,X):-N1 is N-1,N2 is N-2,fibo(N1,X1),fibo(N2,X2),X is X1+X2. 4 | 5 | range(Min,Min,Max):-Min=0, 17 | digit(M),M>0, add_digit(S,M,O, C3, 18 | M). 19 | 20 | digit(D):-dcg_val(Xs),select(D,Xs,Ys),dcg_def(Ys). 21 | 22 | select(X,[X|Xs],Xs). 23 | select(X,[Y|Xs],[Y|Ys]):-select(X,Xs,Ys). 24 | 25 | add_digit(D1,D2,Res,C1,C2):- 26 | S is D1+D2+C1, 27 | Res is S mod 10, 28 | C2 is S // 10. 29 | 30 | show(S,E,N,D,M,O,R,Y):- 31 | write(' '), 32 | write([S,E,N,D]), 33 | write(+),nl, 34 | write(' '), 35 | write([M,O,R,E]), 36 | write(=),nl, 37 | write([M,O,N,E,Y]),nl, 38 | fail 39 | ; nl. 40 | 41 | time(T):-statistics(runtime,[_,T]). 42 | 43 | /* 44 | 45 | % in BinProlog 3.30 46 | 47 | ?- go. 48 | [9,5,6,7]+ 49 | [1,0,8,5]= 50 | [1,0,6,5,2] 51 | 52 | time(140) <= it seems faster than with the best FD constraint solvers!!! 53 | 54 | */ 55 | -------------------------------------------------------------------------------- /progs/ilgraph.pl: -------------------------------------------------------------------------------- 1 | path(G,X,Z,[X|Xs]) :- 2 | linked(G,X,Ys)->member(Y,Ys),path(G,Y,Z,Xs) 3 | ; X=Z,Xs=[]. 4 | 5 | linked(G,X,Ys):-val(G,X,N-Ys),var(N),N=deja_vu. 6 | 7 | new_graph(G):- 8 | lval(G,1,_-[2,3]), 9 | lval(G,2,_-[1,4]), 10 | lval(G,3,_-[1,5]), 11 | lval(G,4,_-[1,5]). 12 | 13 | walk(G,Xs):- 14 | new_graph(G), 15 | path(G,1,5,Xs). 16 | 17 | go:-walk(g,Path),write(Path),nl,fail. 18 | 19 | % lval defines a 2 keyed backtrackable global variable 20 | % val gets the value of a 2 keyed backtrackable global variable if defined 21 | -------------------------------------------------------------------------------- /progs/infinite.pl: -------------------------------------------------------------------------------- 1 | a(Y):-X=(println(Y),X),X. 2 | 3 | repeat(Goal):-Gs=(Goal,Gs),Gs. 4 | 5 | go:-repeat(println(hello)). 6 | 7 | /* 8 | 9 | revisiting occur check 10 | 11 | Lemma 1: 12 | 13 | If infinite term unification fails then 14 | unification with occur check fails to. 15 | 16 | Corollarry: 17 | 18 | In a Prolog supporting infinite terms, occur check 19 | only needs to be performed when infinite 20 | term unification succeeds. 21 | 22 | Lemma 2: 23 | 24 | Assume infinite term unification is implemented with 25 | value trailing. Assume T0 is the top of the trail 26 | before infinite term unification is started on 27 | two terms. 28 | 29 | Let T1 be the top of the trail after the 30 | unification has succeded. If a pattern like 31 | 32 | X=f(... X ...) 33 | 34 | has occured in the unification process 35 | then X is reachable from at least one 36 | value trail cell between T0 and T1. 37 | 38 | Proof: Infinite term unification will not 39 | stop unless when f(..X ..) = f(..X..) shows up 40 | at some point, one of the two references to f 41 | is made to point to the other - which triggers 42 | value trailing. 43 | => wrong - X and f(...X...) could be in the 44 | same segment 45 | 46 | => a fast (how fast?) unification with occure check 47 | algorithm seem to be possible to be implemented by 48 | checking for cycles from the value trailed cells after 49 | successful unifications. 50 | 51 | 52 | */ 53 | -------------------------------------------------------------------------------- /progs/ja_primes.pl: -------------------------------------------------------------------------------- 1 | /* 2 | Elegant prime number program by Jamie Andrews 3 | posted in comp.lang.prolog on 23 Apr 1999 4 | Generates one prime at a time, on backtracking 5 | 6 | Modified by Paul Tarau - to use difference list prime queue 7 | */ 8 | 9 | primes_to(N,Ps):- 10 | this_or_later_prime(2, Xs-Xs, P), 11 | P>N, 12 | !, 13 | append(Xs,[],Ps). 14 | 15 | prime(P) :- 16 | this_or_later_prime(2, Xs-Xs, P). 17 | 18 | this_or_later_prime(P, _, P). 19 | this_or_later_prime(This, Previous_primes, P) :- 20 | N is This+1, 21 | % append newest prime at end because earlier primes will 22 | % detect composite numbers faster 23 | enq(This,Previous_primes,Previous_primes2), 24 | try_prime(N, Previous_primes2, P). 25 | 26 | enq(X,Xs-[X|Ys],Xs-Ys). 27 | 28 | try_prime(N, Previous, P) :- 29 | divisible_by_some(N, Previous), 30 | !, 31 | N1 is N+1, 32 | try_prime(N1, Previous, P). 33 | try_prime(N, Previous, P) :- 34 | this_or_later_prime(N, Previous, P). 35 | 36 | divisible_by_some(N, [P|_]-_) :- 37 | nonvar(P), 38 | 0 is N mod P. 39 | divisible_by_some(N, [_|Ps]-Qs) :- 40 | nonvar(Ps), 41 | divisible_by_some(N, Ps-Qs). 42 | -------------------------------------------------------------------------------- /progs/knight.pl: -------------------------------------------------------------------------------- 1 | /*---------------------------------------------------------------------------- 2 | Program: Knight's Tour 3 | Author: E. Tick 4 | Date: September 10 1989 5 | Notes: 6 | % adapted and optimized for BinProlog: Paul Tarau, August 1992 7 | % changed semantics: the knight has to cover the board completely 8 | 9 | 1. To run: 10 | ?- go(N,T,S). 11 | for input N (side of board), output T is execution time, and S is the number 12 | of solutions. Usually we run go(5,X,Y). 13 | 14 | ---------------------------------------------------------------------------- 15 | :- sequential. 16 | :- parallel move/2. 17 | */ 18 | 19 | p:-[knight]. 20 | 21 | 22 | go:-go(5). 23 | 24 | go(N):-time(_),init(N,M),knight(M,1,1),!,time(T), 25 | write(time=T),nl,statistics,show(N). 26 | 27 | init(N,_):- 28 | for(I,1,N), 29 | for(J,1,N), 30 | bb_def(I,J,_NewVar), 31 | fail. 32 | init(N,M):- 33 | M is N*N. 34 | 35 | knight(0,_,_) :- !. 36 | knight(K,A,B) :- 37 | K1 is K-1, 38 | val(A,B,K), 39 | move(Dx,Dy), 40 | step(K1,A,B,Dx,Dy). 41 | 42 | step(K1,A,B,Dx,Dy):- 43 | C is A + Dx, 44 | D is B + Dy, 45 | knight(K1,C,D). 46 | 47 | % wam.c: strange bug when cells are not cast to (int) in arith ops!!! 48 | show(N):- 49 | cwrite('The Board'),nl, 50 | for(I,1,N), 51 | nl, 52 | for(J,1,N), 53 | val(I,J,V), 54 | X is 1-V // 10, 55 | cwrite(' '),tab(X),cwrite(V), 56 | fail. 57 | show(_):-nl. 58 | 59 | move( 2, 1). 60 | move( 2,-1). 61 | move(-2, 1). 62 | move(-2,-1). 63 | move( 1, 2). 64 | move(-1, 2). 65 | move( 1,-2). 66 | move(-1,-2). 67 | 68 | time(T) :- statistics(runtime,[_,T]). 69 | -------------------------------------------------------------------------------- /progs/l.pl: -------------------------------------------------------------------------------- 1 | % permutation with linear assumptions 2 | % to be accelerated with a compiled implementation of linear assumptions 3 | 4 | max(7). 5 | 6 | t1(Mes):-test(Mes,lin_perm,g1). 7 | 8 | t2(Mes):-test(Mes,lperm,g2). 9 | 10 | t3(Mes):-test(Mes,lin_perm_with_findall,g3). 11 | 12 | go(Mes):- 13 | write('execute with -h20000 option'),nl, 14 | t1(Mes),fail;t2(Mes),fail;t3(Mes),fail. 15 | 16 | go:-go('BMARK_linperms'). 17 | 18 | nats(Max,Max):-!,assumel(n(Max)). 19 | nats(Curr,Max):- 20 | Curr, Head1, Tail1, _, Tail2, Intersection) :- 87 | ord_intersect([Head1|Tail1], Tail2, Intersection). 88 | 89 | subset([],[]). 90 | subset([_|Xs],Ys):-subset(Xs,Ys). 91 | subset([X|Xs],[X|Ys]):-subset(Xs,Ys). 92 | 93 | set_member(X,[X|_]). 94 | set_member(X,[_|Xs]):- 95 | set_member(X,Xs). 96 | -------------------------------------------------------------------------------- /progs/lfibo.pl: -------------------------------------------------------------------------------- 1 | :-write('Program: lfibo.pl'),nl. 2 | :-write('Author: Paul Tarau'),nl. 3 | :-write('fibonacci(40) program with constant time lemmas'),nl. 4 | :-write('executed 10000 times'),nl. 5 | 6 | go:- 7 | I=10000,N=40, 8 | statistics(runtime,_), 9 | statistics(global_stack,[H1,_]), 10 | statistics(trail,[TR1,_]), 11 | f_iter(I,N,R), 12 | statistics(runtime,[_,T]), 13 | statistics(global_stack,[H2,_]), 14 | statistics(trail,[TR2,_]), 15 | H is H2-H1,TR is TR2-TR1, 16 | bb, 17 | write([time=T,heap=H,trail=TR,fibo(N,R)]),nl. 18 | 19 | range(Min,Min,Max):-Min= --> X (P,I,O must be atomic) 36 | fibo_lemma(P,I,O):-val(P,I,X),!,X=O. 37 | fibo_lemma(P,I,O):-functor(G,P,2),arg(1,G,I),G,!, 38 | arg(2,G,O), 39 | def(P,I,O). 40 | -------------------------------------------------------------------------------- /progs/lgraph.pl: -------------------------------------------------------------------------------- 1 | path(X,X,[X]). 2 | path(X,Z,[X|Xs]):-linked(X,Y),path(Y,Z,Xs). 3 | 4 | linked(X,Y):-c(X,Ys),member(Y,Ys). 5 | 6 | go(Xs):- 7 | c(1,[2,3]) -: c(2,[1,4]) -: c(3,[1,5]) -: c(4,[1,5]) -: 8 | path(1,5,Xs). 9 | 10 | go:-go(Xs),write(Xs),nl,fail. 11 | -------------------------------------------------------------------------------- /progs/linperms.pl: -------------------------------------------------------------------------------- 1 | % permutation with linear assumptions 2 | % to be accelerated with a compiled implementation of linear assumptions 3 | 4 | max(7). 5 | 6 | t1(Mes):-test(Mes,lin_perm,g1). 7 | 8 | t2(Mes):-test(Mes,lperm,g2). 9 | 10 | t3(Mes):-test(Mes,lin_perm_with_findall,g3). 11 | 12 | go(Mes):- 13 | write('execute with -h20000 option'),nl, 14 | t1(Mes),fail;t2(Mes),fail;t3(Mes),fail. 15 | 16 | go:-go('BMARK_linperms'). 17 | 18 | nats(Max,Max):-!,assumel(n(Max)). 19 | nats(Curr,Max):- 20 | Currnl;true), 34 | fail. 35 | show(_):-nl. 36 | 37 | move( 2, 1). 38 | move( 2,-1). 39 | move(-2, 1). 40 | move(-2,-1). 41 | move( 1, 2). 42 | move(-1, 2). 43 | move( 1,-2). 44 | move(-1,-2). 45 | 46 | /* % now already in BinProlog 47 | nth_member(X,Xs,N):-member_i(X,Xs,1,N). 48 | 49 | member_i(X,[X|_],N,N). 50 | member_i(X,[_|Xs],N1,N3):- 51 | N2 is N1+1, 52 | member_i(X,Xs,N2,N3). 53 | */ 54 | 55 | time(T) :- statistics(runtime,[_,T]). 56 | 57 | -------------------------------------------------------------------------------- /progs/lmap.pl: -------------------------------------------------------------------------------- 1 | go:- go(Xs),write(Xs),nl. 2 | 3 | color_map([]). 4 | color_map([R|Rs]) :- 5 | color(red)-: 6 | color(yellow)-: 7 | color(blue)-: 8 | color(white)-: 9 | color_region(R), 10 | color_map(Rs). 11 | 12 | color_region(region(Color,Neighbors)):- 13 | color(Color), 14 | color_neighbors(Neighbors). 15 | 16 | 17 | color_neighbors([]). 18 | color_neighbors([X|Xs]) :- 19 | color(X), 20 | color(X)-:color_neighbors(Xs). 21 | 22 | 23 | go([france=F,belgium=B,holland=H,germany=G,luxembourg=L, 24 | italy=I,switzerland=S,austria=A]):- 25 | Rs= 26 | [ 27 | region(F,[I,S,B,G,L]), 28 | region(B,[F,H,L,G]), 29 | region(H,[B,G]), 30 | region(G,[F,A,S,H,B,L]), 31 | region(L,[F,B,G]), 32 | region(I,[F,A,S]), 33 | region(S,[F,I,A,G]), 34 | region(A,[I,S,G]) 35 | ], 36 | color_map(Rs). 37 | 38 | 39 | % Linear logic version of map coloring prog. 14.4 from Sterling & Shapiro 40 | -------------------------------------------------------------------------------- /progs/lmoney.pl: -------------------------------------------------------------------------------- 1 | % quick SEND+MORE=MONEY with linear implication 2 | 3 | :-dynamic digit/1. 4 | 5 | go:- 6 | time(_), 7 | digit(0)-:digit(1)-:digit(2)-:digit(3)-:digit(4)-: 8 | digit(5)-:digit(6)-:digit(7)-:digit(8)-:digit(9)-: puzzle(Show), 9 | time(T), 10 | Show, 11 | write(time(T)),nl. 12 | 13 | 14 | puzzle(show(S,E,N,D,M,O,R,Y)):- 15 | digit(D),digit(E),add_digit(D,E,Y, 0,C1),digit(Y), 16 | digit(N),digit(R),add_digit(N,R,E, C1,C2), 17 | digit(O), add_digit(E,O,N, C2,C3), 18 | digit(S),S>0, 19 | digit(M),M>0, add_digit(S,M,O, C3, 20 | M). 21 | 22 | add_digit(D1,D2,Res,C1,C2):- 23 | S is D1+D2+C1, 24 | Res is S mod 10, 25 | C2 is S // 10. 26 | 27 | show(S,E,N,D,M,O,R,Y):- 28 | write(' '), 29 | write([S,E,N,D]), 30 | write(+),nl, 31 | write(' '), 32 | write([M,O,R,E]), 33 | write(=),nl, 34 | write([M,O,N,E,Y]),nl, 35 | fail 36 | ; nl. 37 | 38 | time(T):-statistics(runtime,[_,T]). 39 | -------------------------------------------------------------------------------- /progs/lq8.pl: -------------------------------------------------------------------------------- 1 | make_board([l1,l2,l3,l4,l5,l6,l7,l8],[c1,c2,c3,c4,c5,c6,c7,c8]):- 2 | lval(c1,on,[A8 -B1 ,A9 -B2 ,A10-B3 ,A11-B4 ,A12-B5 ,A13-B6 ,A14-B7 ,A15-B8 ]), 3 | lval(c2,on,[A7 -B2 ,A8 -B3 ,A9 -B4 ,A10-B5 ,A11-B6 ,A12-B7 ,A13-B8 ,A14-B9 ]), 4 | lval(c3,on,[A6 -B3 ,A7 -B4 ,A8 -B5 ,A9 -B6 ,A10-B7 ,A11-B8 ,A12-B9 ,A13-B10]), 5 | lval(c4,on,[A5 -B4 ,A6 -B5 ,A7 -B6 ,A8 -B7 ,A9 -B8 ,A10-B9 ,A11-B10,A12-B11]), 6 | lval(c5,on,[A4 -B5 ,A5 -B6 ,A6 -B7 ,A7 -B8 ,A8 -B9 ,A9 -B10,A10-B11,A11-B12]), 7 | lval(c6,on,[A3 -B6 ,A4 -B7 ,A5 -B8 ,A6 -B9 ,A7 -B10,A8 -B11,A9 -B12,A10-B13]), 8 | lval(c7,on,[A2 -B7 ,A3 -B8 ,A4 -B9 ,A5 -B10,A6 -B11,A7 -B12,A8 -B13,A9 -B14]), 9 | lval(c8,on,[A1 -B8 ,A2 -B9 ,A3 -B10,A4 -B11,A5 -B12,A6 -B13,A7 -B14,A8 -B15]). 10 | 11 | queens(LCs):- 12 | make_board(Ls,Cs), 13 | queens(Ls,Cs,LCs). 14 | 15 | queens([],[],[]). 16 | queens([L|Ls],OldCs,[L-C|LCs]):- 17 | select(C,OldCs,NewCs), 18 | lval(C,on,Diags), 19 | mark(Ls,L,Diags), 20 | queens(Ls,NewCs,LCs). 21 | 22 | select(X,[X|Xs],Xs). 23 | select(X,[Y|Xs],[Y|Ys]):-select(X,Xs,Ys). 24 | 25 | mark([],L,[L-L|_]). 26 | mark([_|Ls],L,[_|Diags]):-mark(Ls,L,Diags). 27 | 28 | test(T):- 29 | statistics(runtime,_), 30 | ( 31 | queens(Qs), 32 | % write(Qs),nl, 33 | fail 34 | ; 35 | true 36 | ), 37 | statistics(runtime,[_,T]). 38 | 39 | go:-test(T),write(T),nl. 40 | 41 | -------------------------------------------------------------------------------- /progs/lrev.pl: -------------------------------------------------------------------------------- 1 | p:-[lrev]. 2 | 3 | nrev_lemma(Xs,Ys,Xs1,Ys1,L):- 4 | val(nrev_fact,L,[Xs,Ys,Xs1,Ys1]), 5 | !. 6 | nrev_lemma(Xs,Ys,Xs1,Ys1,L):- 7 | nrev(Xs,Ys,Xs1,Ys1,L), 8 | copy_term([Xs1,Ys1],Rest), 9 | bb_def(nrev_fact,L,[Xs1,Ys1|Rest]). 10 | 11 | app([],Ys,Ys,[],Ys1,Ys1). 12 | app([A|Xs],Ys,[A|Zs],[A1|Xs1],Ys1,[A1|Zs1]):- 13 | app(Xs,Ys,Zs,Xs1,Ys1,Zs1). 14 | 15 | nrev([],[],[],[],0). 16 | nrev([X|Xs],R,[X1|Xs1],R1,N):- 17 | N1 is N-1, 18 | nrev_lemma(Xs,T,Xs1,T1,N1), 19 | app(T,[X],R,T1,[X1],R1). 20 | 21 | nrev(Xs,Ys=L+nrev(Xs1,Ys1)):- 22 | length(Xs,L), 23 | nrev(Xs,Ys,Xs1,Ys1,L). 24 | 25 | range(Min,Min,Max):-Min= is already defined in terms of assumel/1 6 | 7 | collect([]). 8 | collect([X]) :- hyp(X). 9 | collect([X,Y|L]) :- hyp(X), collect([Y|L]), X @=< Y. 10 | 11 | unpack([]). 12 | unpack([X|L]) :- assumel(hyp(X)), unpack(L). 13 | 14 | lsort(L,K) :- unpack(L), collect(K), \+ hyp(X). 15 | 16 | go:-lsort([10,2,33,10,24,2],R),write(R),nl,fail. 17 | go. 18 | -------------------------------------------------------------------------------- /progs/lsum.pl: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | Hi Veronica and Jamie, 4 | 5 | Here are some thoughts following the linear logic paper and a 6 | previous message. 7 | 8 | Jamie writes: 9 | 10 | >I have been thinking also about some 11 | >possible source-to-source translation for clauses that would 12 | >allow for more efficient compilation. Lygon looks interesting, 13 | >I didn't realize it was based on BinProlog. 14 | 15 | An interesting way to enforce a resource-driven execution to 16 | Prolog programs is the following (# is BinProlog's Hidden Argument 17 | Grammar equivalent of DCGs 'C'/3): 18 | */ 19 | 20 | n(0) :- #t. 21 | n(s(N)):- #t, n(N). 22 | 23 | sum(0,N,N) :- #t. 24 | sum(s(N),M,s(K)):- #t, sum(N,M,K). 25 | 26 | prod(0,_,0) :- #t. 27 | prod(s(N),M,P):- #t, prod(N,M,P1), sum(P1,M,P). 28 | 29 | 30 | make_tokens(N,Ts):-findall(t,for(_,1,N),Ts). 31 | 32 | go(N,X*Y=Z):- 33 | make_tokens(N,Ts), 34 | dcg_def(Ts), 35 | prod(X,Y,Z), 36 | dcg_val([]). 37 | 38 | go:-go(10,R),write(R),nl,fail. 39 | 40 | /* 41 | ?- go. 42 | 43 | s(s(0))*s(s(s(s(s(0))))) = s(s(s(s(s(s(s(s(s(s(0)))))))))) 44 | s(s(s(0)))*s(0) = s(s(s(0))) 45 | 46 | If each use of a linear clause has it's `own' #t resource guard (say 47 | #t_n_1_1, #t_n_1_2, #t_sum_3_1, #t_sum_3_2, etc.) and the grammar is 48 | initialised with exactly 1 token for each of them, then a reasonably 49 | fast implementation is obtained at source level. (Heavy operations 50 | like clause selection and unification are still compiled. Using 51 | exactly once each clause in a proof is ensured by the fact that 52 | the grammar consumes the `usage' flag of the clause which will fail 53 | afterwards). 54 | 55 | In principle real DCGs can be used instead of HAGs so that this 56 | translates to a definite clause program. The effect of # tokens is 57 | simulated at WAM-level with a flag subject to value-trailing, so 58 | linearity of statically known predicates can be made a very cheap 59 | operation (probably within +-5% of ordinary Prolog execution time). 60 | 61 | The more general idea beyond the example is the use of grammars to 62 | specify/limit use of computational ressources. Linearity is an instance. 63 | Iterative deepening can also be emulated by giving progressively 64 | larger sets of tokens. 65 | 66 | More complex constraints like "using exactly one among a set of 67 | clauses" can be expressed by shared tokens. If a frequently occurring 68 | subset of the constructs supported by Lygon or Lolli fits in this scheme 69 | a speed-up of at least one order of magnitude can be expected. 70 | 71 | Cheers, 72 | 73 | Paul 74 | 75 | P.S. I am wondering if grammars with restrictions on the number of times 76 | a rule can be used have been investiagted. Maybe Veronica has some 77 | hints about this. Clearly counters in parametric grammars can be used 78 | to obtain this effect too. 79 | */ 80 | -------------------------------------------------------------------------------- /progs/ltak.pl: -------------------------------------------------------------------------------- 1 | :-write('Program: ltak.pl'),nl. 2 | :-write('Author: Paul Tarau'),nl. 3 | :-write('tak program with constant acces and create-time lemmas'),nl. 4 | 5 | tak(X,Y,Z,A) :- X =< Y, !, Z = A. 6 | tak(X,Y,Z,A) :- 7 | X1 is X - 1, 8 | Y1 is Y - 1, 9 | Z1 is Z - 1, 10 | ltak(X1,Y,Z,A1), 11 | ltak(Y1,Z,X,A2), 12 | ltak(Z1,X,Y,A3), 13 | ltak(A1,A2,A3,A). 14 | 15 | ltak(X,Y,Z,A):- 16 | tak_encode(X,Y,XY), 17 | tak_lemma(XY,Z,tak(X,Y,Z,A),A). 18 | 19 | tak_encode(Y,Z,Key):-Key is Y<<16 \/ Z. 20 | tak_decode(Key,Y,Z):-Y is Key>>16, Z is Key <<17>>17 . 21 | 22 | %optimized lemma --> O (instantiated executing G) 23 | tak_lemma(P,I,_,O):-val(P,I,X),!,X=O. 24 | tak_lemma(P,I,G,O):-G,!,def(P,I,O). 25 | 26 | go:- statistics(runtime,_), 27 | tak(24,16,8,X), 28 | statistics(runtime,[_,T]),statistics, 29 | write('BMARK_ltak:'=[time=T,tak=X]), nl. 30 | 31 | -------------------------------------------------------------------------------- /progs/macro.pl: -------------------------------------------------------------------------------- 1 | pi2(Y):- ##((X is 2*asin(1),Y is X*X)). 2 | 3 | -------------------------------------------------------------------------------- /progs/mboyer.pl: -------------------------------------------------------------------------------- 1 | :-nogc. 2 | 3 | :-memo rewrite/2. 4 | 5 | :-[boyer]. 6 | -------------------------------------------------------------------------------- /progs/mbrev.pl: -------------------------------------------------------------------------------- 1 | :-memo nrev/2. 2 | 3 | :-[brev]. 4 | 5 | -------------------------------------------------------------------------------- /progs/mfibo.pl: -------------------------------------------------------------------------------- 1 | :-memo fibo/2. 2 | 3 | :-[fibo]. 4 | -------------------------------------------------------------------------------- /progs/money.pl: -------------------------------------------------------------------------------- 1 | go:- 2 | time(_), 3 | puzzle(Show,[0,1,2,3,4,5,6,7,8,9],_), 4 | time(T), 5 | Show, 6 | write('BMARK_money:'=time(T)),nl. 7 | 8 | 9 | puzzle(show(S,E,N,D,M,O,R,Y))--> 10 | add_digits(D,E,Y, 0,R1), 11 | add_digits(N,R,E, R1,R2), 12 | add_digits(E,O,N, R2,R3), 13 | add_digits(S,M,O, R3, 14 | M), 15 | {S>0,M>0}. 16 | 17 | digit(X)-->{integer(X)},!. 18 | digit(X)-->select(X). 19 | 20 | add_digits(C1,C2,Res,R1,R2)--> 21 | digit(C1), 22 | digit(C2), 23 | digit(Res), 24 | {add_with_carry(C1,C2,R1,Res,R2)}. 25 | 26 | add_with_carry(C1,C2,R1,Res,R2):- 27 | S is C1+C2+R1, 28 | Res is S mod 10, 29 | R2 is S // 10. 30 | 31 | select(X,[X|Xs],Xs). 32 | select(X,[Y|Xs],[Y|Ys]):-select(X,Xs,Ys). 33 | 34 | show(S,E,N,D,M,O,R,Y):- 35 | write(' '), 36 | write([S,E,N,D]), 37 | write(+),nl, 38 | write(' '), 39 | write([M,O,R,E]), 40 | write(=),nl, 41 | write([M,O,N,E,Y]),nl, 42 | fail 43 | ; nl. 44 | 45 | time(T):-statistics(runtime,[_,T]). 46 | -------------------------------------------------------------------------------- /progs/move.pl: -------------------------------------------------------------------------------- 1 | /* 2 | % wrap_thread(Goal):-capture_cont_for(Goal). 3 | wrap_thread(Goal,LeftOver):-left_over_cont(LeftOver)-::capture_cont_for(Goal). 4 | 5 | move:- 6 | % assumes wrap_thread(...) has been executed before 7 | call_with_cont(run_and_return). 8 | 9 | run_and_return(Gs):- 10 | println(Gs), 11 | the( 12 | from_to(Gs,Cont), 13 | wrap_thread(Gs,Cont), % this send left over 14 | Result 15 | ), 16 | println(Result), 17 | eq(the(from_to(Gs,NewGs)),Result), 18 | ( var(NewGs)->true 19 | ; NewGs 20 | ). 21 | 22 | return:- 23 | call_with_cont(collect_left_over), 24 | true. % should be here: simplifies cont. cutting algo 25 | 26 | collect_left_over(Gs):- assumed(left_over_cont(Gs)). 27 | */ 28 | 29 | % should send canonical terms over sockets !!! 30 | 31 | go:-wrap_thread(go1). 32 | 33 | go1:- 34 | eq(X,1), 35 | there,move, 36 | member(Y,[X,2,X]),println(remote_values(X,Y)),return, 37 | println(back(X,Y)). 38 | 39 | 40 | go2:- 41 | there,move,println(there),return. 42 | -------------------------------------------------------------------------------- /progs/move1.pl: -------------------------------------------------------------------------------- 1 | fg(Goal):-end_cont-::capture_cont_for(Goal). 2 | 3 | move:- 4 | % assumes fg(...) has been executed before 5 | call_with_cont(run_and_return). 6 | 7 | run_and_return(Gs):- 8 | println(Gs), 9 | the(Gs,Gs,R), 10 | eq(the(Gs),R). 11 | 12 | go:-fg(test). 13 | 14 | test:-eq(X,1),there,move,and(member(Y,[X,2,X]),println(remote_values(X,Y))). 15 | -------------------------------------------------------------------------------- /progs/netrun.pl: -------------------------------------------------------------------------------- 1 | go:-go(10). 2 | 3 | go(N):-go(N,_). 4 | 5 | go(0,_):-!. 6 | go(N,Old):- 7 | N>0, 8 | N1 is N-1, 9 | println(before(N)), 10 | remote_run(eq(New,c(Old,Old))), 11 | println(after_(N)), 12 | go(N1,New). 13 | 14 | -------------------------------------------------------------------------------- /progs/netscale.pl: -------------------------------------------------------------------------------- 1 | /* run this on the server side */ 2 | light_server:- 3 | heap(500)=>trail(100)=>stack(100)=>trust. 4 | 5 | jserver:- 6 | run_server(7001,none,400,100,100). 7 | 8 | one_task(Id,I,IdleTime):- 9 | println(task_for(Id,I)), 10 | sleep(IdleTime). 11 | 12 | one_client(Id,Times,IdleTime):- 13 | for(I,1,Times), 14 | println(start_task(Id,I)), 15 | remote_run(one_task(Id,I,IdleTime)), 16 | println(end_task(Id,I)), 17 | sleep(IdleTime), 18 | fail. 19 | one_client(Id,_,_):- 20 | remote_run(println(finished(Id))), 21 | halt. 22 | 23 | /* run this, with various parameters on a W2000 or XP system */ 24 | rruns(Clients,Times,IdleTime):- 25 | for(I,1,Clients), 26 | swrite(one_client(I,Times,IdleTime),Goal), 27 | make_cmd(['START bp netscale ',Goal],Cmd), 28 | println(Cmd), 29 | bg(system(Cmd)), 30 | sleep(IdleTime), 31 | fail 32 | ; 33 | println(started(all)). 34 | 35 | /* example of small test which works fine */ 36 | go:- 37 | G=rruns(20,3,2), 38 | println(G), 39 | G. 40 | 41 | test:- 42 | G=rruns(3,2,1), 43 | println(G), 44 | G. 45 | -------------------------------------------------------------------------------- /progs/nping.pl: -------------------------------------------------------------------------------- 1 | go:- 2 | for(I,0,255), 3 | to_string(I,S), 4 | namecat('ping -n 1 -w 200 192.168.1.',S,'',Cmd), 5 | % quiet(10), 6 | (pcollect(Cmd,Rs)->true;Rs=[]), 7 | % quiet(2), 8 | ( is_sstring("100%",Rs)->write(I),write(' ') 9 | ; nl,println(Cmd) 10 | ), 11 | fail. 12 | go. 13 | 14 | is_sstring(Ss,Cs):-append(_,Xs,Cs),is_sstring(Ss,Xs,_),!. 15 | 16 | is_sstring([])-->[]. 17 | is_sstring([X|Xs]) --> [X],is_sstring(Xs). 18 | -------------------------------------------------------------------------------- /progs/nrev.pl: -------------------------------------------------------------------------------- 1 | app([],Ys,Ys). 2 | app([A|Xs],Ys,[A|Zs]):- 3 | app(Xs,Ys,Zs). 4 | 5 | nrev([],[]). 6 | nrev([X|Xs],Zs):- 7 | nrev(Xs,Ys), 8 | app(Ys,[X],Zs). 9 | 10 | fnrev([],[]). 11 | fnrev([X|Xs],Zs):- 12 | fnrev(Xs,Ys), 13 | det_app(Ys,[X],Zs). 14 | 15 | full_range(It,L):- range(_,1,It),nrev(L,_),fail. 16 | full_range(_,_). 17 | 18 | dummy(_,_). 19 | 20 | empty_range(It,L):-range(_,1,It),dummy(L,_),fail. 21 | empty_range(_,_). 22 | 23 | range(Min,Min,Max):-Min=>X, 9 | dx>>DX, 10 | NewX is X+DX, 11 | x<>DX,write(dx=DX),nl, 30 | inc,inc,x>>AA, 31 | plus(15,14,BB), 32 | *(15,14,CC) 33 | ), 34 | 35 | d with a:=44, 36 | 37 | write([X,AA,BB,CC]),nl, 38 | 39 | oblist. 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /progs/or_engtest.pl: -------------------------------------------------------------------------------- 1 | /* 2 engines are created and run in parallel */ 2 | /* both fully backtrack through their search-tree */ 3 | /* the result of the consumer is kept through a side-effect (assert) */ 4 | 5 | 6 | new_engine(G,X,E):- 7 | create_engine(100,100,100,E), 8 | load_engine(E,G,X). 9 | 10 | p(P):-new_engine(append(X,Y,[A,A]),sol(X,Y),P). 11 | 12 | consume(P,[X|Xs]):-ask_engine(P,A),!,copy_term(A,X),consume(P,Xs). 13 | consume(_,[]). 14 | 15 | keep(P):-consume(P,Xs),assert(sol(P,Xs)). 16 | 17 | c(P,C):-new_engine(keep(P),_,C). 18 | 19 | go:-p(A),c(A,B), 20 | multitask_engines(100), 21 | retract(sol(P,Xs)), 22 | !, 23 | destroy_engine(A), 24 | destroy_engine(B), 25 | write(P+Xs),nl. 26 | 27 | 28 | -------------------------------------------------------------------------------- /progs/over_ex.pl: -------------------------------------------------------------------------------- 1 | % needs source license so you can recompile BinProlog 2 | % with -DJUMP_COMPRESS=0 - it still might work in some cases without 3 | 4 | go:-g0,fail;g1,fail;g2,fail;g3,fail;g4,fail;g,fail. 5 | %bug,fail; 6 | %not_a_bug_anymore. 7 | 8 | a(1). 9 | a(2). 10 | 11 | b(10). 12 | b(20). 13 | 14 | c(100). 15 | c(200). 16 | 17 | d(1000). 18 | d(2000). 19 | d(3000). 20 | d(X):-X=4000. 21 | 22 | g0:-override(a(_),b(_)), 23 | override(b(_),c(_)), 24 | (override(c(_),d(_)),a(X),write(X),nl,fail; 25 | dummy,c(X),write(c(X)),nl,fail). 26 | 27 | 28 | forward(F,N,G,M):- 29 | functor(P,F,N), 30 | functor(Q,G,M), 31 | override(P,Q). 32 | 33 | g:-forward(a,1,b,1),forward(b,1,c,1),g1. 34 | g1:-dummy,a(X),write(X),nl,fail. 35 | 36 | dummy. 37 | 38 | g2:-override(a(_),d(_)),a(X),write(X),nl,fail. %NO 39 | 40 | g3:-override(d(_),a(_)),d(X),write(X),nl,fail. %NO 41 | 42 | g4:-override(d(_),a(_)),d(X),write(X),nl,fail. % YES 43 | 44 | 45 | let_pred(F/N,G/M,InG):- 46 | forward(F,N,G,M), 47 | InG, 48 | forward(G,M,F,N). % this gives a loop 49 | 50 | 51 | not_a_bug_anymore:-let_pred(b/1,c/1,b(X)),b(Y),write(X+Y),nl,fail. 52 | 53 | %bug:-override(put(_),string_put(_)),put_string("gaga"). 54 | 55 | bug:-override(put(_),string_put(_)),put_string("gaga"),nl,fail. 56 | bug:-override(my_put(_),string_put(_)),put_string("gaga"),nl,fail. 57 | bug:-put_string("gaga"),nl. 58 | 59 | put_string([]). 60 | put_string([X|Xs]):- 61 | % put(X), -- impossible to override inline builtins -- trigers the bug 62 | my_put(X), 63 | put_string(Xs). 64 | 65 | string_put(X):-cwrite(X),nl. % only for tracing purpose 66 | 67 | my_put(X):-put(X). 68 | -------------------------------------------------------------------------------- /progs/p1.pl: -------------------------------------------------------------------------------- 1 | /* facts */ 2 | likes(joe,beer). 3 | likes(mary,wine). 4 | likes(bill,water). 5 | likes(bill,wine). 6 | 7 | /* rules */ 8 | drinks(X,Drink):-likes(X,Drink). 9 | drinks(_,Drink):-likes(mary,Drink). 10 | 11 | /* projection */ 12 | person(X):-likes(X,_). 13 | 14 | /* join */ 15 | dry(X):-person(X), not(likes(X,beer)),not(likes(X,wine)). 16 | 17 | water_drinker(X):-drinks(X,water). 18 | 19 | -------------------------------------------------------------------------------- /progs/p2.pl: -------------------------------------------------------------------------------- 1 | % The Simpsons and the Royals 2 | 3 | parent_of(homer, abe). 4 | parent_of(maggie,homer). 5 | parent_of(bart,homer). 6 | parent_of(lisa,homer). 7 | parent_of(maggie, marge). 8 | parent_of(lisa, marge). 9 | parent_of(bart, marge). 10 | parent_of(homer,liz). 11 | parent_of(charles,liz). 12 | parent_of(charles,abe). 13 | parent_of(william,charles). 14 | 15 | male(bart). 16 | male(homer). 17 | male(abe). 18 | male(charles). 19 | male(william). 20 | 21 | female(maggie). 22 | female(marge). 23 | female(lisa). 24 | female(liz). 25 | 26 | % rules 27 | 28 | child_of(Parent,Child):- 29 | parent_of(Child,Parent). 30 | 31 | father_of(Child,Father):- 32 | parent_of(Child,Father), 33 | male(Father). 34 | 35 | mother_of(Child,Mother):- 36 | parent_of(Child,Mother), 37 | female(Mother). 38 | 39 | sibling_of(Child,Other):- 40 | parent_of(Child,Parent), 41 | parent_of(Other,Parent), 42 | not(Child=Other). 43 | 44 | sister_of(Child,Sister):- 45 | sibling_of(Child,Sister), 46 | female(Sister). 47 | 48 | brother_of(Child,Brother):- 49 | sibling_of(Child,Brother), 50 | male(Brother). 51 | 52 | aunt_or_uncle_of(Child,Person):- 53 | parent_of(Child,Parent), 54 | sibling_of(Parent,Person). 55 | 56 | aunt_of(Child,Aunt):- 57 | aunt_or_uncle_of(Child,Aunt), 58 | female(Aunt). 59 | 60 | uncle_of(Child,Uncle):- 61 | aunt_or_uncle_of(Child,Uncle), 62 | male(Uncle). 63 | 64 | cousin_of( Child, Cousin):- 65 | aunt_or_uncle_of(Child, Person), 66 | child_of(Person,Cousin). 67 | 68 | grand_parent_of(Child,GP):- 69 | parent_of(Child,P), 70 | parent_of(P,GP). 71 | 72 | grand_father_of(Child,GP):- 73 | grand_parent_of(Child,GP), 74 | male(GP). 75 | 76 | unique_call(Goal):- 77 | findall(Goal,Goal,Instances), 78 | sort(Instances,Sorted), 79 | member(Goal,Sorted). 80 | 81 | ancestor_of(Child,Parent):- 82 | parent_of(Child,Parent). 83 | 84 | ancestor_of(Child,Parent):- 85 | parent_of(Child,Person), 86 | ancestor_of(Person,Parent). 87 | 88 | 89 | -------------------------------------------------------------------------------- /progs/p3.pl: -------------------------------------------------------------------------------- 1 | my_member(X,[X|_]). 2 | my_member(X,[_|Xs]):- 3 | my_member(X,Xs). 4 | -------------------------------------------------------------------------------- /progs/plain_tetris.pl: -------------------------------------------------------------------------------- 1 | :-[tetris]. 2 | :-[tetris_trace]. 3 | -------------------------------------------------------------------------------- /progs/primes.pl: -------------------------------------------------------------------------------- 1 | :-write('computes primes using bboard operations for fast tabultation'),nl. 2 | 3 | max_prime(5000). 4 | 5 | go:-max_prime(Max),go(Max). 6 | 7 | cputime(T):-statistics(runtime,[_,T]). 8 | 9 | go(N):-cputime(_),primes_to(N),cputime(T),write(time=T),nl,statistics. 10 | 11 | primes_to(N):- 12 | init_primes, 13 | prime(2,N,Prime), 14 | Prime>N-100, 15 | write(Prime),nl, 16 | fail 17 | ; true. 18 | 19 | init_primes:-def(prime,limit,2),!,push(primes,2). 20 | init_primes. 21 | 22 | prime(Min,Max,P) :- 23 | range(P,Min,Max), 24 | sqr(P,Lim), 25 | \+(divisible(P,Lim)). 26 | 27 | divisible(P,Lim):- 28 | memo_prime(Lim,I), 29 | 0 is P mod I. 30 | 31 | range(Min,Min,Max):-Min=N,!,S is S1-1. 38 | 39 | memo_prime(Lim,I):-Lim>2, 40 | val(prime,limit,Old),Old>=Lim,!, 41 | stack(primes,Ps), 42 | member(I,Ps). 43 | memo_prime(Lim,I):-Lim>2, 44 | val(prime,limit,Old),Old0, M is N-1, 14 | gen_list(M,L). 15 | 16 | place_queens(0,_,_,_). 17 | place_queens(I,Cs,Us,[_|Ds]):- 18 | I>0, J is I-1, 19 | place_queens(J,Cs,[_|Us],Ds), 20 | place_queen(I,Cs,Us,Ds). 21 | 22 | place_queen(I,[I|_],[I|_],[I|_]). 23 | place_queen(I,[_|Cs],[_|Us],[_|Ds]):- 24 | place_queen(I,Cs,Us,Ds). 25 | -------------------------------------------------------------------------------- /progs/qbrev.pl: -------------------------------------------------------------------------------- 1 | nrev([],[]). 2 | nrev([X|Xs],R):- 3 | nrev(Xs,T), 4 | det_append(T,[X],R). 5 | 6 | full_range(It,L):- range(_,1,It),nrev(L,_), fail. 7 | full_range(_,_). 8 | 9 | dummy(_,_). 10 | 11 | empty_range(It,L):-range(_,1,It),dummy(L,_),fail. 12 | empty_range(_,_). 13 | 14 | range(Min,Min,Max):-Min= 16 | bg(service_loop(Service,Password)), 17 | fail 18 | ; true 19 | ), 20 | !. 21 | 22 | starting_service:-let(service_finished,no). 23 | stop_service:-let(service_finished,yes). 24 | service_stopped:-val(service_finished,yes). 25 | 26 | service_loop(Service,Password):- 27 | starting_service, 28 | repeat, 29 | ( service_stopped->true 30 | ; answer_one_query(Service,Password)->fail 31 | ; true 32 | ), 33 | !, 34 | 'prolog:disconnect'(Service). 35 | 36 | 37 | % client side 38 | 39 | 40 | ask(Client,X,G,R):- 41 | 'prolog:ask_service'(Client,X,G,none,R). 42 | 43 | ask(Client,G):-ask(Client,G,G,the(G)). 44 | 45 | stop_service(Client):- 46 | ask(Client,stop_service), 47 | 'prolog:disconnect'(Client). 48 | */ 49 | 50 | ctest1:- 51 | ctest(1000,_,true). 52 | 53 | ctest2:- 54 | ctest(100,I,println(I)). 55 | 56 | ctest3:- 57 | ctest(100,_,findall(K,for(K,1,10),Ks)), 58 | println(Ks). 59 | 60 | ctest(N,I,G):- 61 | println(ctest(N,G)), 62 | ctest(N,I,G,T), 63 | println(time=T). 64 | 65 | ctest(N,I,G,T):- 66 | new_client(C), 67 | ctime(T1), 68 | for(I,1,N), 69 | ( ask(C,G)->true 70 | ; !,println(unexpected_failure(I,G)) 71 | ), 72 | I=N, 73 | stop_service(C), 74 | ctime(T2), 75 | T is T2-T1. 76 | 77 | -------------------------------------------------------------------------------- /progs/rpc_chat.pro: -------------------------------------------------------------------------------- 1 | go1:-bg(listen1),talk1. 2 | go2:-bg(listen2),talk2. 3 | 4 | listen1:- 5 | set_this_port(5001), 6 | trust. 7 | 8 | talk1:- 9 | set_that_port(5002), 10 | for(I,1,5), 11 | remote_run(println(one(I))), 12 | fail. 13 | 14 | listen2:- 15 | set_this_port(5002), 16 | trust. 17 | 18 | talk2:- 19 | set_that_port(5001), 20 | for(I,1,5), 21 | remote_run(println(two(I))), 22 | fail. 23 | 24 | one:- 25 | set_that_port(5002), 26 | remote_run( 27 | and( 28 | set_that_port(5003), 29 | remote_run(println(hello)) 30 | ) 31 | ). 32 | 33 | two:- 34 | set_this_port(5002), 35 | trust. 36 | 37 | three:- 38 | set_this_port(5003), 39 | trust. 40 | -------------------------------------------------------------------------------- /progs/setarg_dcg.pl: -------------------------------------------------------------------------------- 1 | 2 | % DCGs with no preprocessor 3 | % expects: Sicstus-style backtrackable setarg + 4 | % BinProlog's backtrackable global variables 5 | 6 | % tools 7 | 8 | begin_dcg(Name,Xs):-lval(dcg,Name,Xs-Xs). 9 | 10 | end_dcg(Name,Xs):-lval(dcg,Name,Xs-[]). 11 | 12 | w(Word,Name):- 13 | lval(dcg,Name,State), 14 | State=_-[Word|Xs2], 15 | setarg(2,State,Xs2). 16 | 17 | begin_dcg(Xs):-begin_dcg(default,Xs). 18 | end_dcg(Xs):-end_dcg(default,Xs). 19 | w(Word):-w(Word,default). 20 | 21 | % grammar 22 | x:-ng,v. 23 | 24 | ng:-a,n. 25 | 26 | a:-w(the). 27 | a:-w(a). 28 | 29 | n:-w(cat). 30 | n:-w(dog). 31 | 32 | v:-w(walks). 33 | v:-w(sleeps). 34 | 35 | % test 36 | go:-begin_dcg(Xs),x,end_dcg(Ys),write(Ys),nl,fail. 37 | 38 | p:-[setarg_dcg]. 39 | 40 | /* 41 | 42 | ?- [setarg_dcg]. 43 | compiling(to(mem),myprogs/setarg_dcg.pl,...) 44 | compile_time(134) 45 | ?- go. 46 | [the,cat,walks] 47 | [the,cat,sleeps] 48 | [the,dog,walks] 49 | [the,dog,sleeps] 50 | [a,cat,walks] 51 | [a,cat,sleeps] 52 | [a,dog,walks] 53 | [a,dog,sleeps] 54 | 55 | */ 56 | -------------------------------------------------------------------------------- /progs/show_tetris.pl: -------------------------------------------------------------------------------- 1 | :-[tetris_trace]. 2 | 3 | dims(20,10,32). 4 | 5 | go:-tetris_server. 6 | 7 | tetris_server:- 8 | is_prolog(Prolog), 9 | prolog_action(Prolog,Action), 10 | call(Action). 11 | tetris_server:- 12 | println('Please run this with Jinni or BinProlog!'). 13 | 14 | prolog_action(jinni_compiled,run_server). 15 | prolog_action(jinni_interpreted,run_server). 16 | prolog_action(binprolog,trust). 17 | 18 | -------------------------------------------------------------------------------- /progs/spy.pl: -------------------------------------------------------------------------------- 1 | :-spy a/1. 2 | :-spy c/1. 3 | 4 | b(X):-a(X),c(X). 5 | 6 | a(1). 7 | a(2). 8 | 9 | c(2). 10 | c(3). 11 | 12 | go:-b(X),write(X),nl. 13 | 14 | :-go. 15 | -------------------------------------------------------------------------------- /progs/subset.pl: -------------------------------------------------------------------------------- 1 | subset([],[]). 2 | subset([_|Xs],Ys):-subset(Xs,Ys). 3 | subset([X|Xs],[X|Ys]):-subset(Xs,Ys). 4 | 5 | gen_list(0,[]). 6 | gen_list(N,[_|L]):- 7 | N>0, M is N-1, 8 | gen_list(M,L). 9 | 10 | test(S):-gen_list(14,L),subset(L,S). 11 | 12 | nondet:-gen_list(16,L),subset(L,_),fail. 13 | nondet. 14 | 15 | t:- 16 | statistics(runtime,_),all,fail 17 | ; statistics(runtime,[_,T]),write(time=T),nl. 18 | 19 | 20 | pow(S,Xs):-findall(X,subset(S,X),Xs). 21 | 22 | pow2(S,XXs):-findall(Xs,(pow(S,P),member(X,P),pow(X,Xs)),XXs). 23 | 24 | g(N):-gen_list(N,Xs),pow2(Xs,S),length(S,L),write(L),nl. 25 | 26 | go(Mes):-write('use bp -h20000'),nl, 27 | statistics(runtime,_), 28 | nondet, 29 | statistics(runtime,[_,T0]), 30 | findall(Q,test(Q),Qs), 31 | statistics(runtime,[_,T]), 32 | length(Qs,L), 33 | write(Mes=[nondet^16=T0,findall(L)=T]),nl. 34 | 35 | go:-go('BMARK_subset'). 36 | 37 | p:-[subset]. 38 | -------------------------------------------------------------------------------- /progs/synco_data.pl: -------------------------------------------------------------------------------- 1 | go:-schedule(top). 2 | 3 | top:- 4 | init, % creates prototypes `unique' and `cloneable' 5 | prelude, % specific prelude 6 | login(wizard), 7 | take(song,How), 8 | dig(room), 9 | craft(song), 10 | go(room), 11 | drop(song,How), 12 | logout,listing, 13 | fail. 14 | 15 | go1:- 16 | init, % creates prototypes `unique' and `cloneable' 17 | prelude, % specific prelude 18 | login(wizard), 19 | dig(room), 20 | go(room), 21 | craft(flower), 22 | move(flower,lobby), 23 | logout, 24 | login(mary), 25 | clone(poem), 26 | take(poem,Cloneable), 27 | go(room), 28 | drop(poem,Cloneable), 29 | logout, 30 | listing, 31 | fail. 32 | 33 | 34 | -------------------------------------------------------------------------------- /progs/tak.pl: -------------------------------------------------------------------------------- 1 | % 2 | % tak 3 | % 4 | % Evan Tick (from Lisp version by R. P. Gabriel) 5 | % 6 | % (almost) Takeuchi function (recursive arithmetic) 7 | % arithmetics reordered for optimal inline execution - Paul Tarau 1994 8 | 9 | :-write('In BinProlog use: -h1200 '),nl. 10 | :-set_c_threshold(9). 11 | 12 | go :- statistics(global_stack,[H1,_]), 13 | statistics(runtime,_), 14 | tak, 15 | statistics(runtime,[_,T]), 16 | statistics(global_stack,[H2,_]),H is H2-H1, 17 | nl,write('BMARK_tak:' = [time=T,heap=H]), nl. 18 | 19 | 20 | tak :- tak(18,12,6,R), write(tak(18,12,6)=R), nl. 21 | 22 | tak(X,Y,Z,A):- 23 | X =< Y,!, 24 | A = Z. 25 | tak(X,Y,Z,A):- 26 | X1 is X - 1, 27 | Y1 is Y - 1, 28 | Z1 is Z - 1, 29 | tak(X1,Y,Z,A1), 30 | tak(Y1,Z,X,A2), 31 | tak(Z1,X,Y,A3), 32 | tak(A1,A2,A3,A). 33 | 34 | -------------------------------------------------------------------------------- /progs/temp.pro: -------------------------------------------------------------------------------- 1 | 2 | main :- 3 | notepad. 4 | -------------------------------------------------------------------------------- /progs/term2io.pl: -------------------------------------------------------------------------------- 1 | % EXAMPLE of override/2 and hiden argument grammar (HAG) synergy 2 | % needs source license so you can recompile BinProlog 3 | % with -DJUMP_COMPRESS=0 - it still might work in some cases without 4 | 5 | % written by Paul Tarau - Thu Sep 14 21:51:52 ADT 1995 6 | 7 | go:- 8 | t2s(f(a,b,A,A,_),S),write(S),nl, 9 | s2t(S,T),write(T),nl. 10 | 11 | % term to string 12 | 13 | t2s(T,S):-findall(S,do_t2s(T,S),[S]). 14 | 15 | do_t2s(T,S):- 16 | override(nl,my_nl), 17 | override(put_code(_),my_put_code(_)), 18 | override(fast_write(_),my_cwrite(_)), 19 | numbervars(T,0,_), 20 | dcg_def(S), 21 | generic_write(T,write), 22 | dcg_val([]). 23 | 24 | % the only way to properly emulate write is with side effects 25 | % as write itself fail to save heap space after doing its work 26 | % however, generic_write/2 is clean 27 | % of side effects so grammar emulation is ok 28 | 29 | % string to term 30 | 31 | s2t(S,T):-findall(T,do_s2t(S,T),[T]). 32 | 33 | do_s2t(S,T):- 34 | override(get_code(_),my_get_code(_)), 35 | append(S,[46,10],NewS), % adds "." and end-of-line 36 | dcg_def(NewS), 37 | read(T), 38 | dcg_val([]). 39 | 40 | 41 | % tools using HAGs (hidden argument grammars - highly recommended !) 42 | 43 | my_get_code(X):- #X. 44 | 45 | my_nl:- #10. 46 | my_put_code(X) :- #X. 47 | my_cwrite(X):- name(X,Xs), my_write_name(Xs). 48 | 49 | my_write_name([]). 50 | my_write_name([X|Xs]):- #X, my_write_name(Xs). 51 | -------------------------------------------------------------------------------- /progs/test.pl: -------------------------------------------------------------------------------- 1 | a(1). 2 | a(2). 3 | a(3). 4 | 5 | -------------------------------------------------------------------------------- /progs/tetris_trace.pl: -------------------------------------------------------------------------------- 1 | scr_init(N):- 2 | dims(MaxL,MaxC,_), 3 | [Board]="#", 4 | (for(L,6,MaxL),scr_send(p(L,MaxC),Board),fail; true), 5 | (for(C,0,MaxC),scr_send(p(MaxL,C),Board),fail; true), 6 | N=0, 7 | scr_score(N), 8 | !. 9 | 10 | scr_end :- 11 | println(end), 12 | abort. 13 | 14 | scr_send(p(L0,C0),Char):-let(L0,C0,Char). 15 | 16 | scr_score(Score):- 17 | show_game, 18 | println('Score:'(Score)), 19 | nl. 20 | 21 | show_game:- 22 | dims(MaxL,MaxC,_), 23 | for(L,0,MaxL), 24 | nl, 25 | for(C,0,MaxC), 26 | get_val(L,C,Char), 27 | put(Char), 28 | fail. 29 | show_game:- 30 | sleep(1), 31 | nl,nl. 32 | 33 | get_val(L,C,Char):- val(L,C,X),!,Char=X. 34 | get_val(_,_,Space):- [Space]=" ". 35 | 36 | scr_stat(Val):- 37 | statistics(global_stack,HStat), 38 | show_game, 39 | println([energie(Val),heap(HStat)]), 40 | nl. 41 | 42 | % reading a direction: default falling direction 43 | scr_dir(1). 44 | 45 | -------------------------------------------------------------------------------- /progs/thread_test.pro: -------------------------------------------------------------------------------- 1 | go :- bg(say_hello, Thread, EngineAddr, EngineId), 2 | println(thread(Thread)), 3 | println(engine(Thread,EngineAddr,same(EngineId))), 4 | !. 5 | 6 | say_hello :- 7 | println('hello from background thread'), 8 | current_engine_addr(Addr), 9 | current_engine_id(Id), 10 | current_thread(T), 11 | println(bg_engine(T,Addr,same(Id))), 12 | !. 13 | 14 | go1:- 15 | bg(bg_process,Thread), 16 | fg_process(Thread), 17 | println(threads_joined). 18 | 19 | bg_process:- 20 | println(starting(bg_process)), 21 | local_in(a(X)), 22 | println(bg_process_got(a(X))), 23 | sleep(10), 24 | println(bg_meeting_point_1). 25 | 26 | fg_process(Thread):- 27 | sleep(5), 28 | println(starting(fg_process)), 29 | local_out(a(1)), 30 | thread_join(Thread), 31 | println(fg_meeting_point_1_with(Thread)). 32 | 33 | -------------------------------------------------------------------------------- /progs/tloop.pro: -------------------------------------------------------------------------------- 1 | loop(Max):-N is 1<0,N1 is N-1,loop(N1,c(X,N)). 5 | 6 | -------------------------------------------------------------------------------- /progs/tsp.pl: -------------------------------------------------------------------------------- 1 | % derived from a program by Thomas Conway 2 | 3 | travel(Places, Route) :- 4 | findall(Cost - Order, 5 | ( cperm(Places, Order), dist(Order, Cost)), 6 | Solns), 7 | sort(Solns, [_ - Route|_]). 8 | 9 | cperm([First|Is],CircPs):-perm([First|Is],Ps),append(Ps,[First],CircPs). 10 | 11 | perm([],[]). 12 | perm([X|Xs],Zs):- 13 | perm(Xs,Ys), 14 | insert(X,Ys,Zs). 15 | 16 | insert(X,Ys,[X|Ys]). 17 | insert(X,[Y|Ys],[Y|Zs]):- 18 | insert(X,Ys,Zs). 19 | 20 | dist(Ps,Dist):-foldl(dist2,0,Ps,Dist). 21 | 22 | dist2(P,P,0):-!. 23 | dist2(P1,P2,D):- D is (P1+P2). 24 | 25 | ints(N,Is):-findall(I,for(I,1,N),Is). 26 | 27 | go(N):-ctime(T1),ints(N,Ps),travel(Ps,Route),ctime(T2),T is T2-T1, 28 | write(time(T)+route(Route)),nl. 29 | 30 | go:-go(7). 31 | -------------------------------------------------------------------------------- /progs/ttest.pl: -------------------------------------------------------------------------------- 1 | nobug:- 2 | tstest(attr_ow(pax(1),type),attr_ow(pax(1),age),X), 3 | println(result=X). 4 | 5 | go:- 6 | tstest(key(k1,k2),value(a,b,c),R),println(result=R), 7 | N=1000000, 8 | T=f(0,a,X,g(X),h(1,314)), 9 | new_term(T,I), 10 | println(handle:T=>I), 11 | instance_of(I,T1), 12 | println(instance:I=>T1), 13 | instance_of(I,T2), 14 | println(instance:I=>T2), 15 | free_term(I), 16 | println(T=T1), 17 | (T=T1->println(equal);println(not_equal)), 18 | ctime(S1), 19 | ( for(_,1,N), 20 | new_term(T,Handle), 21 | instance_of(Handle,_), 22 | free_term(Handle), 23 | fail 24 | ; true 25 | ), 26 | ctime(S2), 27 | S0 is S2-S1, 28 | S is S0/3000.00001, 29 | OT is S/N, 30 | ST is N/S, 31 | println([create_free(N), total=S0, total_ms_per_op=S,one=OT, per_sec=ST]). 32 | 33 | go2:- 34 | K=f(a,b), 35 | push_term(K,g(c,d)), 36 | T0=h(f(123,b,U),g(m,3.14,U),n), 37 | put_term(K,T0), 38 | count_terms(K,N), 39 | new_iterator(K,Iter), 40 | println(t0=T0), 41 | println([count=N,iter=Iter]), 42 | ( for(I,1,N), 43 | get_next_term(Iter,T), 44 | println(K:I=>T), 45 | fail 46 | ; close_iterator(Iter) 47 | ), 48 | delete_all_terms(K), 49 | (has_terms(K)->println(has_terms);println(no_terms_left)). 50 | 51 | 52 | go1:- 53 | T0=f(a,X,[1,2],g(314,X),77), 54 | put_term(111,T0), 55 | new_iterator(a,I), 56 | get_next_term(I,T), 57 | println(T0=T), 58 | T=T0, 59 | println(equal). 60 | 61 | -------------------------------------------------------------------------------- /progs/tty_tetris.pl: -------------------------------------------------------------------------------- 1 | :-[tetris]. 2 | 3 | scr_init(N):- 4 | max(MaxL,MaxC), 5 | (for(_,1,60),nl,fail; true), 6 | [Board]="#", 7 | (for(L,6,MaxL),scr_send(p(L,MaxC),Board),fail; true), 8 | (for(C,0,MaxC),scr_send(p(MaxL,C),Board),fail; true), 9 | N=0, 10 | scr_score(N), 11 | !. 12 | 13 | scr_end :- 14 | max(L,_),L1 is L+3, 15 | scr_send(p(L1,0),32),nl, 16 | abort. 17 | 18 | scr_send(p(L0,C0),Char):- 19 | L is L0+1, C is C0+1, 20 | put(27), 21 | cwrite('['),cwrite(L), 22 | cwrite(';'),cwrite(C), 23 | cwrite('H'), 24 | put(Char). 25 | 26 | scr_score(Score):- 27 | max(MaxL,_), MesL is MaxL+1, 28 | scr_score0(MesL,Score). 29 | 30 | scr_score0(MesL,Score):- 31 | scr_send(p(MesL,0),32), 32 | cwrite('Score:'),cwrite(Score). 33 | 34 | scr_stat(Val):- 35 | max(MaxL,_),L is MaxL+2, 36 | [Prompt]=">", 37 | scr_send(p(L,0),Prompt), 38 | statistics(global_stack,HStat), 39 | statistics(trail,TStat), 40 | statistics(bboard,BBStat), 41 | write('Energie'(Val)), 42 | write(' Heap'(HStat)), 43 | write(' Trail'(TStat)), 44 | write(' BBoard'(BBStat)). 45 | 46 | % reading a direction: default falling direction 47 | scr_dir(1). 48 | 49 | /* 50 | scr_rec(_):-fail. 51 | 52 | scr_dir(D):- 53 | ctime(T0), 54 | repeat, 55 | ( scr_rec(C)->usr_dir(C,D) 56 | ; ctime(T1), DeltaT is T1-T0,DeltaT>0.20,D is 1 57 | ). 58 | usr_dir(-77,0). % right -77 59 | usr_dir(-80,1). % down -80 60 | usr_dir(-75,2). % left -75 61 | usr_dir(-72,3). % up -72 62 | usr_dir(10,-1). % enter -1 63 | usr_dir(27,0):-scr_end. % escape 64 | */ -------------------------------------------------------------------------------- /progs/untrail.pl: -------------------------------------------------------------------------------- 1 | go:- 2 | T=f(X,X),get_neck_cut(CUT), 3 | for(_,1,3),nl, 4 | write(cut=CUT),nl, 5 | T=f(Y,a), 6 | get_deep_cut(DEEP), 7 | write(deep_cut=DEEP),nl, 8 | CUT==DEEP, 9 | write(=),nl, 10 | write(before=Y+T),nl, 11 | untrail_to(DEEP),!, 12 | write(after=Y+T),nl, 13 | fail. 14 | 15 | -------------------------------------------------------------------------------- /progs/vfbrev.pl: -------------------------------------------------------------------------------- 1 | nrev([],[]). 2 | nrev([X|Xs],R):- 3 | nrev(Xs,T), 4 | det_append(T,[X],R). 5 | 6 | full_range(It,L):- range(_,1,It),nrev(L,_), fail. 7 | full_range(_,_). 8 | 9 | dummy(_,_). 10 | 11 | empty_range(It,L):-range(_,1,It),dummy(L,_),fail. 12 | empty_range(_,_). 13 | 14 | range(Min,Min,Max):-Min=>> '),fast_write(Mes),fast_write(': '), 41 | trim_term(Obj,T), 42 | fast_write(T),nl. 43 | portray_error(pretty,Mes,Obj):- 44 | write('*** '),write(Mes),write(': '),nl, 45 | trim_term(Obj,T), 46 | portray_clause(T). 47 | 48 | nth_member(X,Xs,N):-member_i(X,Xs,1,N). 49 | 50 | member_i(X,[X|_],N,N). 51 | member_i(X,[_|Xs],N1,N3):- 52 | N2 is N1+1, 53 | member_i(X,Xs,N2,N3). 54 | 55 | trim_detail('...'). 56 | 57 | trim_depth(N):-quiet(Q),trim_depth1(Q,N). 58 | 59 | trim_depth1(Q,N):-Q<3,!,N is 6-Q. 60 | trim_depth1(_,3). 61 | 62 | trim_term(T,NewT):-trim_depth(N),trim_term(N,T,NewT). 63 | 64 | trim_term(N,T,NewT):-trim_detail(D),trim_term(N,D,T,NewT). 65 | 66 | trim_term(_,_,T,NewT):-var(T),!,NewT=T. 67 | trim_term(_,_,T,NewT):-atomic(T),!,NewT=T. 68 | trim_term(_,_,T,NewT):-float(T),!,NewT=T. 69 | trim_term(0,NoMore,_,NoMore):-!. 70 | trim_term(N,D,T,NewT):-N1 is N-1, 71 | T=..[F|Xs], 72 | trim_args(Xs,Ys,N1,D), 73 | NewT=..[F|Ys]. 74 | 75 | trim_args([],[],_,_). 76 | trim_args([X|Xs],[Y|Ys],N,D):- 77 | trim_term(N,D,X,Y), 78 | trim_args(Xs,Ys,N,D). 79 | 80 | expand_call_body(Body, 81 | ( 82 | do_body(Body, AfterCut, HadCut), 83 | ( HadCut = yes, 84 | !, 85 | call_body(AfterCut) 86 | ; HadCut = no 87 | ) 88 | ) 89 | ). 90 | 91 | 92 | bp_val(bp_virtual,bu0(_,_,_,_),1). 93 | bp_val(bp_virtual,bu1(_,_),1). 94 | bp_val(bp_virtual,bu_ctr(_,_),1). 95 | 96 | bp_val(bp_virtual,portray_clause(_),2). 97 | bp_val(bp_virtual,portray(_),2). 98 | bp_val(bp_virtual,term_expansion(_,_),2). 99 | bp_val(bp_virtual,trim_detail(_),2). 100 | bp_val(bp_virtual,trim_depth(_),2). 101 | -------------------------------------------------------------------------------- /src/io.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/io.o -------------------------------------------------------------------------------- /src/load.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/load.o -------------------------------------------------------------------------------- /src/mac64mt.sh: -------------------------------------------------------------------------------- 1 | echo ---------------------- 2 | echo generates BinProlog 3 | 4 | mv -f wam.c wam_c.txt 5 | mv -f wam.h wam_h.txt 6 | mv -f binpro.c binpro_c.txt 7 | mv -f binpro.h binpro_h.txt 8 | gcc -o ru *.c 9 | ./ru remake 10 | ./ru "and(cboot,halt)" 11 | mv -f stub.c stub.txt 12 | 13 | echo makes static library in ../lib 14 | gcc -DW64 -DTHREADS=1 -m64 -arch x86_64 -g3 -O3 -Wall -fomit-frame-pointer -fmessage-length=0 -lpthread -c *.c 15 | gcc -DW64 -DTHREADS=1 -m64 -arch x86_64 -g3 -O3 -Wall -fomit-frame-pointer -fmessage-length=0 -lpthread -o bp *.o 16 | 17 | echo --------------------- 18 | echo calls ar 19 | ar -q libbps.a *.o 20 | mv -f bp ../bin 21 | mv -f libbps.a ../lib 22 | 23 | #cp c_defs.h global.h ../lib 24 | 25 | echo ------------------------ 26 | echo clean up 27 | mv -f stub.txt stub.c 28 | rm -f wam_c.txt 29 | rm -f wam_h.txt 30 | rm -f binpro_c.txt 31 | rm -f binpro_h.txt 32 | rm -f *.o 33 | rm -f *.a 34 | rm -f *.so 35 | 36 | 37 | 38 | -------------------------------------------------------------------------------- /src/main.c: -------------------------------------------------------------------------------- 1 | #include "global.h" 2 | 3 | #if VCCDLL 4 | /* 5 | #define DLL_EXPORT(Type) __declspec(dllexport) Type __stdcall 6 | */ 7 | #define DLL_EXPORT(Type) __declspec(dllexport) Type __cdecl 8 | #else 9 | #define DLL_EXPORT(Type) Type 10 | #endif 11 | 12 | extern void bp_exit_mes(string mes, bp_long i); 13 | extern void *init_bp0(bp_long argc, char **argv,FILE* bp_stdin,FILE* bp_stdout); 14 | extern char *run_bp0(register stack wam,char *query,bp_long *retcode); 15 | 16 | DLL_EXPORT(void*) init_bp(bp_long argc, char **argv, FILE* bp_stdin, FILE* bp_stdout) { 17 | 18 | char *default_argv[]={"bp.dll",NULL}; 19 | char **bp_argv; 20 | if(NULL==bp_stdin) bp_stdin=stdin; 21 | if(NULL==bp_stdout) bp_stdout=stdout; 22 | if(NULL==argv) { 23 | bp_argv=default_argv; 24 | argc=1; 25 | } 26 | else 27 | bp_argv=argv; 28 | 29 | return init_bp0(argc, bp_argv, bp_stdin, bp_stdout); 30 | } 31 | 32 | DLL_EXPORT(char*) run_bp(void *wam, char *query) { 33 | bp_long retcode=0; 34 | return run_bp0((stack)wam,query,&retcode); /* ignores retcode */ 35 | } 36 | 37 | /* inialisation work in c.c, useful if BinProlog is embedded \ 38 | in a C application 39 | */ 40 | 41 | extern int init_c(void); 42 | 43 | DLL_EXPORT(int) bp_main(int argc, char **argv) 44 | { int ok; bp_long retcode=0; int initcode=0; 45 | void *wam=init_bp(argc,argv,stdin,stdout); 46 | ok=(!!wam); 47 | initcode=init_c(); 48 | printf("Started Prolog Runtime System %d.\n",initcode); 49 | ok=ok && (initcode>0); /* inialise C-code for the host in c.c */ 50 | 51 | if(ok) { 52 | #if 0 53 | /* not used, but possible: see similar code in dir BP_DLL */ 54 | 55 | /* query/answer then stop */ 56 | char *query; 57 | char *answer; 58 | 59 | query="^(X,(for(X,1,5),>(X,2)))"; 60 | answer=run_bp(wam,query); 61 | if(NULL==answer) answer="no"; 62 | printf("query=>%s\nanswer=>%s\n",query,answer); 63 | 64 | query="*(I,for(I,1,10))"; 65 | answer=run_bp(wam,query); 66 | if(NULL==answer) answer="no"; 67 | printf("query=>%s\nanswer=>%s\n",query,answer); 68 | 69 | query="*(:(2,X),member(X,[a,b,c,d]))"; 70 | answer=run_bp(wam,query); 71 | if(NULL==answer) answer="no"; 72 | printf("query=>%s\nanswer=>%s\n",query,answer); 73 | 74 | ok=1; 75 | #else 76 | run_bp0(wam,NULL,&retcode); /* plain toplevel: keeps retcode info */ 77 | #endif 78 | } 79 | else 80 | retcode=!ok; 81 | bp_exit_mes("halted, code",retcode); 82 | return retcode; 83 | } 84 | -------------------------------------------------------------------------------- /src/main.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/main.o -------------------------------------------------------------------------------- /src/oper.pl: -------------------------------------------------------------------------------- 1 | :-op(1000,xfy,','). 2 | :-op(1100,xfy,(';')). 3 | 4 | :-op(1200,xfx,('-->')). 5 | :-op(1200,xfx,(':-')). 6 | :-op(1200,fx,(':-')). 7 | :-op(700,xfx,'is'). 8 | :-op(700,xfx,'='). 9 | 10 | :-op(1050,xfx,(@@)). 11 | 12 | :-op(500,yfx,'-'). 13 | :-op(200,fy,'-'). 14 | 15 | :-op(500,yfx,'+'). 16 | :-op(200,fy,'+'). 17 | 18 | :-op(400,yfx,'/'). 19 | :-op(400,yfx,'*'). 20 | :-op(400,fx,'*'). 21 | :-op(400,yfx,(mod)). 22 | :-op(200,yfx,(**)). 23 | :-op(200,xfy,(^)). 24 | 25 | :-op(300,fy,(~)). 26 | :-op(650,xfy,'.'). 27 | :-op(660,xfy,'++'). 28 | 29 | :-op(700,xfx,'>='). 30 | :-op(700,xfx,'>'). 31 | :-op(700,xfx,'=<'). 32 | :-op(700,xfx,(<)). 33 | :-op(700,xfx,(=\=)). 34 | :-op(700,xfx,(=:=)). 35 | 36 | :-op(400,yfx,(>>)). 37 | :-op(400,yfx,(<<)). 38 | :-op(400,yfx,(//)). 39 | 40 | :-op(200,yfx,(\/)). 41 | :-op(200,yfx,(/\)). 42 | :-op(200,yfx,(\)). 43 | :-op(200,fx,(\)). 44 | 45 | :-op(700,xfx,(@>=)). 46 | :-op(700,xfx,(@=<)). 47 | :-op(700,xfx,(@>)). 48 | :-op(700,xfx,(@<)). 49 | 50 | :-op(700,xfx,(\==)). 51 | :-op(700,xfx,(==)). 52 | :-op(700,xfx,(=..)). 53 | :-op(700,xfx,(\=)). 54 | 55 | :-op(900,fy,(not)). 56 | :-op(900,fy,(\+)). 57 | :-op(900,fx,(spy)). 58 | :-op(900,fx,(nospy)). 59 | 60 | :-op(950,fx,(##)). 61 | 62 | :-op(950,xfy,(=>)). 63 | :-op(950,xfx,(<=)). 64 | 65 | :-op(1050,xfy,(->)). 66 | 67 | /* 68 | :-op(1150,fx,(dynamic)). 69 | :-op(1150,fx,(public)). 70 | :-op(1150,fx,(module)). 71 | :-op(1150,fx,(mode)). 72 | :-op(1150,fx,(multifile)). 73 | :-op(1150,fx,(discontiguous)). 74 | */ 75 | 76 | :-op(850,fx,(dynamic)). 77 | :-op(850,fx,(public)). 78 | :-op(850,fx,(module)). 79 | :-op(850,fx,(mode)). 80 | :-op(850,fx,(multifile)). 81 | :-op(850,fx,(discontiguous)). 82 | 83 | :-op(1200,xfx,(::-)). 84 | 85 | :-op(50,yfx,(:)). 86 | 87 | % :-op(1200,fx,(?-)). 88 | 89 | :-op(100,fx,(@)). 90 | 91 | :-op(25,xfx,(@)). 92 | 93 | :-op(200,fx,(?)). 94 | 95 | :-op(50,fx,(^)). 96 | 97 | :-op(500,fx,(#>)). 98 | :-op(500,fx,(#<)). 99 | :-op(500,fx,(#:)). 100 | :-op(500,fx,(#+)). 101 | :-op(500,fx,(#*)). 102 | :-op(500,fx,(#=)). 103 | :-op(500,fx,(#-)). 104 | :-op(500,fx,(#?)). 105 | 106 | 107 | 108 | -------------------------------------------------------------------------------- /src/otherwam.bp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/otherwam.bp -------------------------------------------------------------------------------- /src/remake.pro: -------------------------------------------------------------------------------- 1 | :-[oper]. 2 | :-[headers]. 3 | main:-go,reboot. 4 | -------------------------------------------------------------------------------- /src/ru: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/ru -------------------------------------------------------------------------------- /src/ru.a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/ru.a -------------------------------------------------------------------------------- /src/ru.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/ru.o -------------------------------------------------------------------------------- /src/run.pro: -------------------------------------------------------------------------------- 1 | :-[oper]. 2 | :-[builtins]. 3 | :-[init]. 4 | 5 | :-[lib]. 6 | 7 | :-[xdb]. 8 | :-[hmap]. 9 | 10 | :-[tstore]. 11 | 12 | :-[maps]. 13 | :-[dcg]. 14 | :-[read]. 15 | :-[write]. 16 | :-[top]. 17 | :-[extra]. 18 | 19 | :-[net]. 20 | :-[cserver]. 21 | -------------------------------------------------------------------------------- /src/socket.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/socket.o -------------------------------------------------------------------------------- /src/stub.c: -------------------------------------------------------------------------------- 1 | #include "global.h" 2 | 3 | struct bp_instr *wam_bp=NULL,*user_bp=NULL; 4 | long wam_bp_size=0; 5 | 6 | -------------------------------------------------------------------------------- /src/stub.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/stub.o -------------------------------------------------------------------------------- /src/sym.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/sym.o -------------------------------------------------------------------------------- /src/term.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/term.o -------------------------------------------------------------------------------- /src/termStore.c: -------------------------------------------------------------------------------- 1 | #include "global.h" 2 | #include 3 | 4 | #ifdef TSTORE 5 | 6 | #if !defined(EXTERNAL_TSTORE) 7 | #include "term.h" 8 | #include "termStore.h" 9 | 10 | /* 11 | TODO: provide here implementations for the prototypes 12 | described in termStore.h 13 | 14 | THE folowing provide STUBS for trying out the API - to 15 | be progressively replaced with the real thing !!! 16 | */ 17 | 18 | static Term theTerm=NULL; 19 | 20 | void pushTerm(Term key, Term value){theTerm=value;} 21 | void putTerm(Term key, Term value){theTerm=value;} 22 | ulong newIterator(Term key){return ZERO;} 23 | void closeIterator(ulong iterator) {} 24 | BYTE hasTerms(Term key) {return NULL!=theTerm;} 25 | Term getNextTerm(ulong iterator) {return theTerm;} 26 | void removeCurrentTerm(ulong iterator) {theTerm=NULL;} 27 | void updateCurrentTerm(ulong iterator,Term value) {theTerm=value;} 28 | void deleteAllTerms(Term key) {theTerm=NULL;} 29 | bp_long countTerms(Term key) {return 1;} 30 | ulong newKeyIterator(){return ZERO;} 31 | Term processTerm(bp_long OpCode,Term arg){return arg;} 32 | char *newTermString(char *s) {return strdup(s);} 33 | void freeTermString(char *s) {free(s);} 34 | #endif 35 | 36 | #endif 37 | -------------------------------------------------------------------------------- /src/termStore.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/termStore.o -------------------------------------------------------------------------------- /src/top.pl: -------------------------------------------------------------------------------- 1 | % TOPLEVEL 2 | 3 | topcall(G):-metacall(G). 4 | 5 | prolog_run(_):-(prolog_run0,fail;true). 6 | 7 | prolog_run0:- 8 | exec_run_time_commands, 9 | fail. 10 | prolog_run0:- 11 | string_op(2,0,QueryChars), % +,+,- 12 | !, 13 | call_prolog(QueryChars,AnswerChars), 14 | string_op(4,AnswerChars,_). % +,+,- 15 | prolog_run0:- % default, calls toplevel/0, unless main/0 is defined 16 | call_ifdef(main,toplevel). 17 | 18 | call_prolog(QueryChars,AnswerChars):- 19 | term_chars(QueryTerm,QueryChars), 20 | debugmes(enter_call_prolog_term(QueryTerm)), 21 | call_prolog_term(QueryTerm,AnswerTerm), 22 | debugmes(exit_call_prolog_term(AnswerTerm)), 23 | term_chars(AnswerTerm,AnswerChars). 24 | 25 | call_prolog_term(QueryTerm,AnswerTerm):- 26 | nonvar(QueryTerm), 27 | ( QueryTerm=(Vars:-Goal)->Query=Goal,Answer=Vars 28 | ; QueryTerm=(Vars^Goal)->Query=Goal,Answer=Vars 29 | ; QueryTerm=the(Vars,Goal)->Query=the(Vars,Goal,Answer) 30 | ; QueryTerm=(K:Vars*Goal),nonvar(K)->Query=find_at_most(K,Vars,Goal,List),Answer=List 31 | ; QueryTerm=(Vars*Goal)->Query=findall(Vars,Goal,List),Answer=List 32 | ; Query=the(QueryTerm,QueryTerm,Answer) % NEW from 7.36 ! 33 | ), 34 | ( topcall(Query)->AnswerTerm=Answer 35 | ; AnswerTerm=no 36 | ). 37 | 38 | the(X,G,R):-copy_term(the(X,G),the(NewX,NewG)),NewG,!,R=the(NewX). 39 | the(_,_,no). 40 | 41 | the(X,G):-the(X,G,the(X)). 42 | the(G):-the(G,G). 43 | 44 | % LOCAL OR REMOTE TOPLEVEL 45 | 46 | toplevel:- 47 | % quiet(2), 48 | repeat, 49 | topstep('?- '), 50 | fail. 51 | 52 | topstep(Prompt):- 53 | ttyprin(Prompt),flush, 54 | ttyin(top_read_term(Body,Vs)), 55 | report_answers(Vs,Body,YN), 56 | ttyprint(YN). 57 | 58 | report_answers([],Goal,YN):- 59 | topcall(Goal)->YN=yes 60 | ; YN=no. 61 | report_answers([V|Vs],Goal,YN):- 62 | ask_answers(Goal,[V|Vs],YN). 63 | 64 | ask_answers(Goal,[V|Vs],YN):- 65 | topcall(Goal), 66 | report_one_var(V),report_top_vars(Vs), 67 | another_sol(Ok), 68 | ( Ok=no,!,YN=yes 69 | ; fail 70 | ) 71 | ; YN=no,!. 72 | 73 | report_top_vars(Eqs):- 74 | member(Eq,Eqs), 75 | ttyprint(','),report_one_var(Eq), 76 | fail. 77 | report_top_vars(_). 78 | 79 | report_one_var(V=E):- 80 | ttyprin(V),ttyprin(=),ttyout(writeq(E)). 81 | 82 | another_sol(Ok):- 83 | is_interactive,!, 84 | ttyin(get_code(A)),user_action(A,Ok),ttynl. 85 | another_sol(yes):-ttyprint(';'),ttynl. 86 | 87 | user_action(10,no):-!. 88 | user_action(59,yes):-!,ttyin(get_code(10)). 89 | user_action(_,Ok):-ttyprin(' ; for more, otherwise '), 90 | ttyin(get_code(10)),ttyin(get_code(U)),user_action(U,Ok). 91 | 92 | -------------------------------------------------------------------------------- /src/tstore.pl: -------------------------------------------------------------------------------- 1 | 2 | 3 | % API 4 | 5 | tstest(K,V,R):-term_store_op(0,K,V,R). 6 | push_term(K,T):-term_store_op(1,K,T,_). 7 | put_term(K,T):-term_store_op(2,K,T,_). 8 | new_iterator(K,I):-term_store_op(3,K,0,I). 9 | close_iterator(I):-term_store_op(4,I,0,_). 10 | has_terms(K):-term_store_op(5,K,0,YN), YN=1. 11 | get_next_term(I,T):-term_store_op(6,I,0,T). 12 | remove_current_term(I):-term_store_op(7,I,0,_). 13 | update_current_term(I,T):-term_store_op(8,I,0,T). 14 | delete_all_terms(K):-term_store_op(9,K,0,_). 15 | count_terms(K,N):-term_store_op(10,K,0,N). 16 | 17 | new_term(K,R):-term_store_op(11,K,0,R). 18 | instance_of(K,R):-term_store_op(12,K,0,R). 19 | free_term(K):-term_store_op(13,K,0,_). 20 | 21 | new_key_iterator(I):-term_store_op(14,0,0,I). 22 | 23 | process_term(OpCode,Input,Output):- 24 | term_store_op(15,OpCode,Input,Output). 25 | 26 | % derived operations 27 | 28 | get_term(K,T):-get_term(K,0,T). 29 | 30 | remove_term(K,T):-get_term(K,1,T). 31 | 32 | get_term(K,Remove,T):- 33 | count_terms(K,N), 34 | N>0, 35 | new_iterator(K,Iter), 36 | for(I,1,N), 37 | get_next_term(Iter,T), 38 | (0=:=Remove->true;remove_current_term(Iter)), 39 | ( I=:=N-> 40 | close_iterator(Iter) 41 | ; true 42 | ). 43 | 44 | /* similar to findall(Term,get_hash(Key,Term),Terms) */ 45 | 46 | get_all_terms(Key,Ts):- 47 | new_iterator(Key,Iterator), 48 | get_one_more_term(Iterator,Ts), 49 | close_iterator(Iterator). 50 | 51 | /* collects on term at a time from a new iterator */ 52 | get_one_more_term(Iterator,[T|Ts]):- 53 | get_next_term(Iterator,T), 54 | !, 55 | get_one_more_term(Iterator,Ts). 56 | get_one_more_term(_Iterator,[]). 57 | 58 | -------------------------------------------------------------------------------- /src/wam.bp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/wam.bp -------------------------------------------------------------------------------- /src/wam.h: -------------------------------------------------------------------------------- 1 | /* please do not edit: generated by co.pl */ 2 | -------------------------------------------------------------------------------- /src/wam.o: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/wam.o -------------------------------------------------------------------------------- /src/wam.ok: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mndrix/binprolog/fe9d7ae6106924d799d4d368d43d127d53680389/src/wam.ok -------------------------------------------------------------------------------- /src/wam.pro: -------------------------------------------------------------------------------- 1 | :-[run]. 2 | :-[bin]. 3 | :-[co]. 4 | :-[c_comp]. 5 | :-[c_instr]. 6 | 7 | 8 | --------------------------------------------------------------------------------