Prolog Cafe 1.2.5
Homepage: http://kaminari.scitec.kobe-u.ac.jp/PrologCafe/
Download: http://kaminari.scitec.kobe-u.ac.jp/PrologCafe/archives/PrologCafe1.2.5.tgz
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..1806bd3
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,5 @@
+*.jar
+*.class
+/bin/am2j.plj
+/bin/pl2am.plj
+/doc/javadoc
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..4cde1d7
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,115 @@
+################################################################
+# Makefile
+################################################################
+# PROLOG - the command of Prolog system
+# ::= sicstus | swipl | pl | prolog | ...
+# PSYSTEM- the type of Prolog system
+# ::= 'SICStus' | 'SWI-Prolog' | 'Others'
+
+PROLOG = sicstus
+PSYSTEM = 'SICStus'
+# PROLOG = swipl
+# PSYSTEM = 'SWI-Prolog'
+# PROLOG = prolog
+# PSYSTEM = 'Others'
+
+JAVA = java
+JAVAC = javac
+JAVACOPTS = -d . -J-Xmx100m
+JAR = jar
+JAROPTS = cf
+
+PWD := $(shell pwd)
+################################################################
+all: plc lang builtin compiler plcafe plj
+
+plc:
+ (cd src/compiler; $(MAKE) plc \
+ PROLOG='$(PROLOG)' PSYSTEM='$(PSYSTEM)')
+ cp src/compiler/pl2am.plc bin/
+ cp src/compiler/am2j.plc bin/
+
+lang:
+ (cd src/lang; $(MAKE) lang \
+ JAVAC='$(JAVAC)' JAVACOPTS='$(JAVACOPTS)' \
+ JAR='$(JAR)' JAROPTS='$(JAROPTS)')
+ cp src/lang/lang.jar .
+
+builtin:
+ (cd src/builtin; $(MAKE) builtin \
+ JAVAC='$(JAVAC)' JAVACOPTS='$(JAVACOPTS) -classpath $(PWD)/lang.jar' \
+ JAR='$(JAR)' JAROPTS='$(JAROPTS)')
+ cp src/builtin/builtin.jar .
+
+compiler:
+ (cd src/compiler; $(MAKE) compiler \
+ JAVAC='$(JAVAC)' \
+ JAVACOPTS='$(JAVACOPTS) -classpath $(PWD)/lang.jar:$(PWD)/builtin.jar' \
+ JAR='$(JAR)' JAROPTS='$(JAROPTS)')
+ cp src/compiler/compiler.jar .
+
+plcafe:
+ $(JAVAC) $(JAVACOPTS) src/lang/*.java src/builtin/*/*.java \
+ src/compiler/pl2am/*.java src/compiler/am2j/*.java src/compiler/Compiler.java
+ $(JAR) $(JAROPTS) plcafe.jar jp/ac/kobe_u/cs/prolog
+
+plj:
+ (cd src/compiler; $(MAKE) plj PROLOG='$(JAVA)')
+ cp src/compiler/pl2am.plj bin/
+ cp src/compiler/am2j.plj bin/
+################################################################
+clean:
+ (cd src/builtin; $(MAKE) clean)
+ (cd src/lang; $(MAKE) clean)
+ (cd src/compiler; $(MAKE) clean)
+ -rm -f bin/pl2am.plc
+ -rm -f bin/am2j.plc
+ -rm -f -r jp
+ -rm -f core *~
+
+realclean: clean
+ (cd src/builtin; $(MAKE) realclean)
+ (cd src/lang; $(MAKE) realclean)
+ (cd src/compiler; $(MAKE) realclean)
+ -rm -f -r doc/javadoc
+ -rm -f bin/pl2am.plj
+ -rm -f bin/am2j.plj
+ -rm -f plcafe.jar
+ -rm -f compiler.jar
+ -rm -f builtin.jar
+ -rm -f lang.jar
+################################################################
+ex:
+ (cd examples; $(MAKE) all)
+################################################################
+JAVADOC = javadoc
+JAVADOCOPTS = -J-Xmx100m \
+ -locale en_US -d doc/javadoc -breakiterator \
+ -windowtitle $(WINDOWTITLE) -doctitle $(DOCTITLE) \
+ -header $(HEADER) -bottom $(BOTTOM)
+
+WINDOWTITLE = 'Prolog Cafe v1.2 API Specification'
+DOCTITLE = 'Prolog Cafe v1.2 API Specification'
+HEADER = '<b><font color="red">Prolog Cafe v1.2</font></b><br>'
+BOTTOM = '<font size="-1"> \
+ Copyright (C) 1997-2009 \
+ <a href="http://kaminari.istc.kobe-u.ac.jp/banbara.html">M.BANBARA</a> and \
+ <a href="http://bach.istc.kobe-u.ac.jp/tamura.html">N.TAMURA</a> \
+ </font>'
+
+javadoc:
+ $(JAVADOC) $(JAVADOCOPTS) src/lang/*.java \
+ src/compiler/Compiler.java
+################################################################
+VER = 1.2.5
+DIR = PrologCafe$(VER)
+TGZ = PrologCafe$(VER).tgz
+ZIP = PrologCafe$(VER).zip
+
+tar: clean
+ (cd ..; tar cfz $(DIR)/$(TGZ) $(DIR)/*)
+
+zip: clean
+ (cd ..; zip -r $(DIR)/$(ZIP) $(DIR)/*)
+################################################################
+# END
diff --git a/README b/README
new file mode 100644
index 0000000..62fdcdd
--- /dev/null
+++ b/README
@@ -0,0 +1,19 @@
+################################################################
+ README
+################################################################
+
+* Prolog Cafe Web Page
+ http://kaminari.istc.kobe-u.ac.jp/PrologCafe/
+
+* Install
+ http://kaminari.istc.kobe-u.ac.jp/PrologCafe/install_en.html
+
+* Prolog Cafe User Manual
+ http://kaminari.istc.kobe-u.ac.jp/PrologCafe/manual_en.html
+
+* Prolog Cafe API Specification
+ ./doc/javadoc/index.html
+
+--
+Mutsunori BANBARA
+
diff --git a/bin/plcafe b/bin/plcafe
new file mode 100755
index 0000000..4a19ba1
--- /dev/null
+++ b/bin/plcafe
@@ -0,0 +1,99 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use Getopt::Long;
+use strict;
+
+my @optlist = ("h|help!","v|verbose!","cp|classpath=s","J=s", "t|toplevel=s", "rt|runtime!");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v, $opt_cp, $opt_J, $opt_t, $opt_rt);
+
+# -h option
+if ($opt_h) {
+ usage();
+ exit 1;
+}
+
+# local variables
+my $java = "java";
+my $classpath;
+my $opts;
+my $class;
+my @args;
+
+# set $class and @args
+if ($opt_t) {
+ if (@ARGV > 0) {
+ usage();
+ exit 1;
+ } else { # $opt_t && @ARGV <= 0
+ $class = "jp.ac.kobe_u.cs.prolog.lang.PrologMain";
+ @args = ($opt_t);
+ }
+} elsif (@ARGV > 0) { # !$opt_t && @ARGV > 0
+ ($class, @args) = @ARGV;
+} else { # !$opt_t && @ARGV <= 0
+ $class = "jp.ac.kobe_u.cs.prolog.lang.PrologMain";
+ @args = "jp.ac.kobe_u.cs.prolog.builtin:cafeteria";
+}
+
+# set $classpath
+$classpath = "\$PLCAFEDIR/plcafe.jar";
+if ($opt_rt) {
+ $classpath = "\$PLCAFEDIR/lang.jar:\$PLCAFEDIR/builtin.jar";
+}
+$classpath .= ":\$CLASSPATH";
+if ($opt_cp) { # -cp option
+ $classpath = "$opt_cp:$classpath";
+}
+#$classpath = ".:$classpath";
+
+# set $opts
+if ($opt_J) { # -J option
+ if ($opt_J =~ /(-cp|-classpath)\s+/) {
+ &error("can not use $1 in -J option");
+ }
+ $opts .= $opt_J;
+}
+
+my $cmd = "$java $opts -cp $classpath $class @args";
+&message("{Enjoy Prolog Cafe!}");
+&message($cmd);
+system($cmd) && error("launching fails");
+&message("{Thank you for using Prolog Cafe!}\n");
+
+exit 0;
+
+sub usage {
+ print "\nUsage: $0 [-options] [class] [args...]\n";
+ print "\n";
+ print "where options support:\n\n";
+ print "\t-h -help : print this help\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\t-cp -classpath <class search path of directories and zip/jar files>\n";
+ print "\t : A : separated list of directories and zip/jar files.\n";
+ print "\t-rt -runtime : boot a runtime environment,\n";
+ print "\t : not including compiler system\n";
+ print "\t-t -toplevel <predicate name possibly with package name>\n";
+ print "\t : set toplevel goal limited to atom\n";
+ print "\t : (ex. -t main)\n";
+ print "\t : (ex. -t package:main)\n";
+ print "\t : Note that class and args must be empty.\n";
+ print "\t-J option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Virtual Machine\n";
+ print "\t : (ex. -J '-Xmx100m -verbose:gc')\n";
+ print "\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x: $0\n";
+ exit(1);
+}
+
diff --git a/bin/plcomp b/bin/plcomp
new file mode 100755
index 0000000..b5d769c
--- /dev/null
+++ b/bin/plcomp
@@ -0,0 +1,93 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use strict;
+use Getopt::Long;
+
+# options
+my @optlist = ("h|help!","v|verbose!","d=s","J=s","cp|classpath=s","C=s");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v, $opt_d, $opt_J,$opt_cp, $opt_C);
+
+# -h option || check the number of arguments
+if ($opt_h || @ARGV < 1 ) {
+ usage();
+ exit 1;
+}
+
+# variables
+my $pljava = "pljava";
+my $pljava_opts = "";
+my $pljavac = "pljavac";
+my $pljavac_opts = "";
+my $java_dest = ".";
+
+if ($opt_v) { # -v option
+ $pljava_opts .= " -v";
+ $pljavac_opts .= " -v";
+}
+
+if ($opt_d) { # -d option
+ if (! -d $opt_d) {
+ &message("mkdir $opt_d, 0777");
+ mkdir $opt_d, 0777 || &error("can not mkdir $opt_d");
+ }
+ $java_dest = $opt_d;
+}
+
+if ($opt_J) { # -J option
+ $pljava_opts .= " -J '$opt_J'";
+}
+
+if ($opt_cp) { # -cp option
+ $pljavac_opts .= " -cp '$opt_cp'";
+}
+
+if ($opt_C) { # -C option
+ $pljavac_opts .= " -C '$opt_C'";
+}
+
+# Prolog --> Java
+foreach my $file (@ARGV) {
+ my $cmd1 = "$pljava $pljava_opts -d $java_dest $file";
+ &message($cmd1);
+ system($cmd1) && error("$cmd1 fails");
+}
+
+# Java --> Class
+my $cmd2 = "$pljavac $pljavac_opts $java_dest/*.java";
+&message($cmd2);
+system($cmd2) && error("$cmd2 fails");
+
+exit 0;
+
+# sub
+sub usage {
+ print "\nUsage: $0 [-options] prolog-file [prolog-files]\n";
+ print "\n where options include:\n";
+ print "\t-h -help : print this help message\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\t-d directory : set the destination directory for java files.\n";
+ print "\t : make it if not exist\n";
+ print "\t-J option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Virtual Machine\n";
+ print "\t : (ex. -J '-Xmx100m -verbose:gc')\n";
+ print "\t-cp -classpath <class search path of directories and zip/jar files>\n";
+ print "\t : A : separated list of directories and zip/jar files.\n";
+ print "\t-C option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Compiler\n";
+ print "\t : (ex. -C '-deprecation')\n";
+ print "\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x: $0\n";
+ exit(1);
+}
diff --git a/bin/pljar b/bin/pljar
new file mode 100755
index 0000000..ba474cd
--- /dev/null
+++ b/bin/pljar
@@ -0,0 +1,102 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use strict;
+use Getopt::Long;
+use File::Basename;
+
+# options
+my @optlist = ("h|help!","v|verbose!","J=s","cp|classpath=s","C=s");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v, $opt_J, $opt_cp, $opt_C);
+
+# -h option || check the number of arguments
+if ($opt_h || @ARGV < 2 ) {
+ usage();
+ exit 1;
+}
+
+# variables
+my ($file, @args) = @ARGV;
+my ($jar_file, $jar_path, $jar_suffix) = fileparse($file, (".jar"));
+my $plcomp = "plcomp";
+my $plcomp_opts = "";
+my $java_dest = "$jar_file";
+my $class_dest = "$java_dest/classes";
+my $jar = "jar";
+my $jar_opts = "cf $file";
+
+# check arguments
+if (-d $java_dest) {
+ &error("directory $java_dest is already exist.");
+}
+
+if ($jar_suffix ne ".jar") {
+ &error("$file is not suffixed by .jar");
+}
+
+if ($opt_v) { # -v option
+ $plcomp_opts .= " -v";
+}
+
+if ($opt_J) { # -J option
+ $plcomp_opts .= " -J '$opt_J'";
+ $jar_opts .= " -J'$opt_J'";
+}
+
+if ($opt_cp) { # -cp option
+ $plcomp_opts .= " -cp '$opt_cp'";
+}
+
+if ($opt_C) { # -C option
+ if ($opt_C =~ /-d\s+/) {
+ &error("can not use -d in -C option");
+ }
+ $plcomp_opts .= " -C '-d $class_dest $opt_C'";
+} else {
+ $plcomp_opts .= " -C '-d $class_dest'";
+}
+
+&message("mkdir $java_dest, 0777");
+mkdir $java_dest, 0777 || &error("can not mkdir $java_dest");
+&message("mkdir $class_dest, 0777");
+mkdir $class_dest, 0777 || &error("can not mkdir $class_dest");
+
+my $cmd1 = "$plcomp $plcomp_opts -d $java_dest @args";
+&message($cmd1);
+system($cmd1) && &error("$cmd1 fails");
+
+my $cmd2 = "$jar $jar_opts -C $class_dest .";
+&message($cmd2);
+system($cmd2) && &error("$cmd2 fails");
+
+exit 0;
+
+# sub
+sub usage {
+ print "\nUsage: $0 [-options] jar-file prolog-file [prolog-files]\n";
+ print "\n where options include:\n";
+ print "\t-h -help : print this help message\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\t-J option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Virtual Machine\n";
+ print "\t : (ex. -J '-Xmx100m -verbose:gc')\n";
+ print "\t-cp -classpath <class search path of directories and zip/jar files>\n";
+ print "\t : A : separated list of directories and zip/jar files.\n";
+ print "\t-C option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Compiler\n";
+ print "\t : (ex. -C '-deprecation')\n";
+ print "\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x: $0\n";
+ exit(1);
+}
diff --git a/bin/pljava b/bin/pljava
new file mode 100755
index 0000000..21fe11f
--- /dev/null
+++ b/bin/pljava
@@ -0,0 +1,105 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use strict;
+use Getopt::Long;
+use File::Copy;
+
+# options
+my @optlist = ("h|help!","v|verbose!","S!","d=s","J=s");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v, $opt_S, $opt_d, $opt_J);
+
+# -h option || check the number of arguments
+if ($opt_h || @ARGV < 1 ) {
+ usage();
+ exit 1;
+}
+
+# local variables
+my $pl2am = "pl2am.plj";
+my $pl2am_opts = "-O";
+my $am_dest = "/tmp";
+my $am2j = "am2j.plj";
+my $am2j_opts = "";
+my $java_dest = ".";
+
+# -v option
+if ($opt_v) {
+ $pl2am_opts .= " -v";
+ $am2j_opts .= " -v";
+}
+
+# -d option
+if ($opt_d) {
+ if (! -d $opt_d) {
+ &error("directory $opt_d does not exist.");
+ } else {
+ $java_dest = $opt_d;
+ }
+}
+
+# -J option
+if ($opt_J) {
+ $pl2am_opts .= " -J '$opt_J'";
+ $am2j_opts .= " -J '$opt_J'";
+}
+
+foreach my $file (@ARGV) {
+ my $f = $file;
+ $f =~ s/.pl$//g;
+ $f = &url_encode($f);
+ my $am_file = "$am_dest/$f.am";
+ my $cmd1 = "$pl2am $pl2am_opts $file $am_file";
+ my $cmd2 = "$am2j $am2j_opts -d $java_dest $am_file";
+ &message("{START translating $file --> java}");
+ &message($cmd1);
+ system($cmd1) && error("$cmd1 fails");
+ &message($cmd2);
+ system($cmd2) && error("$cmd2 fails");
+ if ($opt_S) {
+ &message("copy $am_file to $java_dest");
+ copy($am_file, $java_dest) || &error("can not copy $am_file to $java_dest");
+ } else {
+ &message("unlink $am_file");
+ unlink $am_file;
+ }
+ &message("{END translating $file --> java}\n");
+}
+
+exit 0;
+
+# sub
+sub usage {
+ print "\nUsage: $0 [-options] prolog-file [prolog-files]\n";
+ print "\n where options include:\n";
+ print "\t-h -help : print this help message\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\t-S : output WAM-like abstract machine codes\n";
+ print "\t : the files suffied by \".am\" is created.\n";
+ print "\t-d directory : set the destination directory for java files.\n";
+ print "\t : The destination directory must already exist\n";
+ print "\t-J option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Virtual Machine\n";
+ print "\t : (ex. -J '-Xmx100m -verbose:gc')\n";
+ print "\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x: $0\n";
+ exit(1);
+}
+
+sub url_encode{
+ my $x = shift;
+ $x =~ s/([^0-9A-Za-z_ ])/'%'.unpack('H2',$1)/ge;
+ $x =~ s/\s/+/g;
+ return $x;
+}
diff --git a/bin/pljavac b/bin/pljavac
new file mode 100755
index 0000000..ecdd162
--- /dev/null
+++ b/bin/pljavac
@@ -0,0 +1,72 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use Getopt::Long;
+use strict;
+
+my @optlist = ("h|help!","v|verbose!","cp|classpath=s","C=s");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v, $opt_cp, $opt_C);
+
+# -h option || check the number of arguments
+if ($opt_h || @ARGV < 1 ) {
+ usage();
+ exit 1;
+}
+
+# local variables
+my $javac = "javac";
+my $classpath;
+my $opts;
+my $files;
+
+# set $classpath
+$classpath = "\$PLCAFEDIR/plcafe.jar:\$CLASSPATH";
+#$classpath = "\$PLCAFEDIR/lang.jar:\$PLCAFEDIR/builtin.jar:\$PLCAFEDIR/compiler.jar:\$CLASSPATH";
+if ($opt_cp) { # -cp option
+ $classpath = ".:$opt_cp:$classpath";
+}
+
+# set $opts
+if ($opt_C) { # -C option
+ if ($opt_C =~ /(-cp|-classpath)\s+/) {
+ &error("can not use $1 in -C option");
+ }
+ $opts .= $opt_C;
+}
+
+# set $files
+$files = "@ARGV";
+$files =~ s/(\$)/\\$1/g;
+
+my $cmd = "$javac $opts -classpath $classpath $files";
+&message($cmd);
+system($cmd) && error("$cmd fails");
+
+exit 0;
+
+sub usage {
+ print "\nUsage: $0 [-options] [source files]\n";
+ print "\n";
+ print "where options support:\n\n";
+ print "\t-h -help : print this help\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\t-cp -classpath <class search path of directories and zip/jar files>\n";
+ print "\t : A : separated list of directories and zip/jar files.\n";
+ print "\t-C option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Compiler\n";
+ print "\t : (ex. -C '-deprecation')\n";
+ print "\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x: $0\n";
+ exit(1);
+}
diff --git a/examples/Makefile b/examples/Makefile
new file mode 100644
index 0000000..154970c
--- /dev/null
+++ b/examples/Makefile
@@ -0,0 +1,23 @@
+################################################################
+# Makefile
+################################################################
+all:
+# (cd benchmarks; $(MAKE) all)
+ (cd java; $(MAKE) all)
+ (cd plcafe; $(MAKE) all)
+ (cd prolog; $(MAKE) all)
+
+clean:
+ -rm -f core *~
+# (cd benchmarks; $(MAKE) clean)
+ (cd java; $(MAKE) clean)
+ (cd plcafe; $(MAKE) clean)
+ (cd prolog; $(MAKE) clean)
+
+realclean:
+ -rm -f core *~
+# (cd benchmarks; $(MAKE) realclean)
+ (cd java; $(MAKE) realclean)
+ (cd plcafe; $(MAKE) realclean)
+ (cd prolog; $(MAKE) realclean)
+
diff --git a/examples/benchmarks/.gitignore b/examples/benchmarks/.gitignore
new file mode 100644
index 0000000..57e74b0
--- /dev/null
+++ b/examples/benchmarks/.gitignore
@@ -0,0 +1,2 @@
+/*/out
+/src/*.tgz
diff --git a/examples/benchmarks/Makefile b/examples/benchmarks/Makefile
new file mode 100644
index 0000000..2f3b70e
--- /dev/null
+++ b/examples/benchmarks/Makefile
@@ -0,0 +1,151 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS = -J '-Xmx100m'
+PLJAR = pljar
+PLJAROPTS = -v -J '-Xmx100m' -C '-J-Xmx300m'
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+################################################################
+plcafe:
+ (cd brahme; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd dobry; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd ecrc; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd holmer; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd minerva; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd pereira; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd portland; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd quintus; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd xprolog; $(MAKE) plcafe \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+all:
+ (cd brahme; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd dobry; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd ecrc; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd holmer; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd minerva; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd pereira; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd portland; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd quintus; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+ (cd xprolog; $(MAKE) all \
+ PLCAFE='$(PLCAFE)' PLCAFEOPTS='$(PLCAFEOPTS)' \
+ PLJAR='$(PLJAR)' PLJAROPTS='$(PLJAROPTS)' \
+ SICSTUS='$(SICSTUS)' SICSTUSOPTS='$(SICSTUSOPTS)' \
+ SWI='$(SWI)' SWIOPTS='$(SWIOPTS)')
+
+clean:
+ -rm -f core *~
+ (cd brahme; $(MAKE) clean)
+ (cd dobry; $(MAKE) clean)
+ (cd ecrc; $(MAKE) clean)
+ (cd holmer; $(MAKE) clean)
+ (cd minerva; $(MAKE) clean)
+ (cd pereira; $(MAKE) clean)
+ (cd portland; $(MAKE) clean)
+ (cd quintus; $(MAKE) clean)
+ (cd xprolog; $(MAKE) clean)
+
+realclean:clean
+ (cd brahme; $(MAKE) realclean)
+ (cd dobry; $(MAKE) realclean)
+ (cd ecrc; $(MAKE) realclean)
+ (cd holmer; $(MAKE) realclean)
+ (cd minerva; $(MAKE) realclean)
+ (cd pereira; $(MAKE) realclean)
+ (cd portland; $(MAKE) realclean)
+ (cd quintus; $(MAKE) realclean)
+ (cd xprolog; $(MAKE) realclean)
+
+
+
+
+
diff --git a/examples/benchmarks/bench_util.pl b/examples/benchmarks/bench_util.pl
new file mode 100644
index 0000000..a490962
--- /dev/null
+++ b/examples/benchmarks/bench_util.pl
@@ -0,0 +1,47 @@
+% File : bench_util.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 24 February 2008
+% Purpose: Benchmark utilities
+% Note : based on driver.pl in Pereira's benchmark
+
+'$get_cpu_time'(T) :- statistics(runtime, [T,_]).
+
+'$report'(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ '$report_csv'(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+'$report_csv'([], _) :- !.
+'$report_csv'([X], _) :- !, write(X), nl.
+'$report_csv'([X|Xs], Delim) :- write(X), write(Delim), '$report_csv'(Xs, Delim).
+
+'$benchmark'(Name, Iterations, Action, Control) :-
+ '$get_cpu_time'(T0),
+ ( '$repeat'(Iterations), once(Action), fail
+ ; '$get_cpu_time'(T1)
+ ),
+ ( '$repeat'(Iterations), once(Control), fail
+ ; '$get_cpu_time'(T2)
+ ),
+ '$report'(Name, Iterations, T0, T1, T2).
+
+'$repeat'(N) :- N > 0, '$from'(1, N).
+
+'$from'(I, I) :- !.
+'$from'(L, U) :- M is (L+U)>>1, '$from'(L, M).
+'$from'(L, U) :- M is (L+U)>>1+1, '$from'(M, U).
+
+'$dummy'.
+'$dummy'(_).
+'$dummy'(_, _).
+'$dummy'(_, _, _).
diff --git a/examples/benchmarks/brahme/Makefile b/examples/benchmarks/brahme/Makefile
new file mode 100644
index 0000000..7813272
--- /dev/null
+++ b/examples/benchmarks/brahme/Makefile
@@ -0,0 +1,97 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS =
+PLJAR = pljar
+PLJAROPTS = -v
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar:bench_util.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+# /bin/echo "[$*], qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/brahme/bench_util.pl b/examples/benchmarks/brahme/bench_util.pl
new file mode 100644
index 0000000..a490962
--- /dev/null
+++ b/examples/benchmarks/brahme/bench_util.pl
@@ -0,0 +1,47 @@
+% File : bench_util.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 24 February 2008
+% Purpose: Benchmark utilities
+% Note : based on driver.pl in Pereira's benchmark
+
+'$get_cpu_time'(T) :- statistics(runtime, [T,_]).
+
+'$report'(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ '$report_csv'(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+'$report_csv'([], _) :- !.
+'$report_csv'([X], _) :- !, write(X), nl.
+'$report_csv'([X|Xs], Delim) :- write(X), write(Delim), '$report_csv'(Xs, Delim).
+
+'$benchmark'(Name, Iterations, Action, Control) :-
+ '$get_cpu_time'(T0),
+ ( '$repeat'(Iterations), once(Action), fail
+ ; '$get_cpu_time'(T1)
+ ),
+ ( '$repeat'(Iterations), once(Control), fail
+ ; '$get_cpu_time'(T2)
+ ),
+ '$report'(Name, Iterations, T0, T1, T2).
+
+'$repeat'(N) :- N > 0, '$from'(1, N).
+
+'$from'(I, I) :- !.
+'$from'(L, U) :- M is (L+U)>>1, '$from'(L, M).
+'$from'(L, U) :- M is (L+U)>>1+1, '$from'(M, U).
+
+'$dummy'.
+'$dummy'(_).
+'$dummy'(_, _).
+'$dummy'(_, _, _).
diff --git a/examples/benchmarks/brahme/plbench.in b/examples/benchmarks/brahme/plbench.in
new file mode 100644
index 0000000..bf799ae
--- /dev/null
+++ b/examples/benchmarks/brahme/plbench.in
@@ -0,0 +1,4 @@
+:- '$benchmark'(g1f(5000), 100, g1f(5000, _), '$dummy'(_,_)).
+:- '$benchmark'(g2f(5000), 100, g2f(5000, _), '$dummy'(_,_)).
+:- '$benchmark'(g2a(5000), 10, g2a(5000), '$dummy'(_)).
+
diff --git a/examples/benchmarks/brahme/plbench.pl b/examples/benchmarks/brahme/plbench.pl
new file mode 100644
index 0000000..d13d7cb
--- /dev/null
+++ b/examples/benchmarks/brahme/plbench.pl
@@ -0,0 +1,58 @@
+%%% A short post of benchmarks by Brahme
+
+/*
+ CHANGELOG by M.Banbara
+ - my_member/2 is add.
+*/
+
+my_member(X, [X|_]).
+my_member(X, [_|Ys]) :- my_member(X, Ys).
+
+/*
+From honeydew.srv.cs.cmu.edu!das-news.harvard.edu!noc.near.net!howland.reston.ans.net!vixen.cso.uiuc.edu!sdd.hp.com!decwrl!decwrl!netcomsv!netcom.com!brahme Wed Sep 15 17:25:28 EDT 1993
+Article: 8544 of comp.lang.prolog
+Xref: honeydew.srv.cs.cmu.edu comp.lang.prolog:8544
+Newsgroups: comp.lang.prolog
+Path: honeydew.srv.cs.cmu.edu!das-news.harvard.edu!noc.near.net!howland.reston.ans.net!vixen.cso.uiuc.edu!sdd.hp.com!decwrl!decwrl!netcomsv!netcom.com!brahme
+From: brahme@netcom.com (brahme)
+Subject: benchmarking prolog systems: Here is one small program
+Message-ID: <brahmeCDD9I4.645@netcom.com>
+Organization: NETCOM On-line Communication Services (408 241-9760 guest)
+Date: Tue, 14 Sep 1993 23:06:03 GMT
+Lines: 31
+*/
+
+%% Here are a few predicates which can be used to benchmark
+%% various prolog systems. This would test the prolog systems management of
+%% program space. This is the space typically used by asserts and retracts
+%% as well as built_ins like findall. Also comparing the times with g1 would
+%% indicate the overhead of findall and assert/retracts
+
+%% It would nice if people could develop such small benchmarks which
+%% test parts of various prolog systems that are not covered by the
+%% existing benchmarks.
+
+
+g1(N, L) :- length(L, N), same_value(L, e).
+
+g2(0) :- !.
+g2(N, A) :- N > 0, A = e.
+g2(N, A) :- N > 0, N1 is N - 1, g2(N1, A).
+
+g1f(N, Es) :-
+ g1(N, L),
+ findall(E, my_member(E, L), Es).
+
+g2f(N, Es) :-
+ g2(N, A), findall(A, g2(N, A), Es).
+
+g2a(N) :-
+ asserta(g2_ans([])),
+ g2(N, A), retract(g2_ans(List)), asserta(g2_ans([A|List])), fail.
+g2a(N) :- retract(g2_ans(List)).
+
+same_value([], _E).
+same_value([E|R], E) :- same_value(R, E).
+
+
+
diff --git a/examples/benchmarks/dobry/Makefile b/examples/benchmarks/dobry/Makefile
new file mode 100644
index 0000000..7813272
--- /dev/null
+++ b/examples/benchmarks/dobry/Makefile
@@ -0,0 +1,97 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS =
+PLJAR = pljar
+PLJAROPTS = -v
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar:bench_util.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+# /bin/echo "[$*], qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/dobry/bench_util.pl b/examples/benchmarks/dobry/bench_util.pl
new file mode 100644
index 0000000..a490962
--- /dev/null
+++ b/examples/benchmarks/dobry/bench_util.pl
@@ -0,0 +1,47 @@
+% File : bench_util.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 24 February 2008
+% Purpose: Benchmark utilities
+% Note : based on driver.pl in Pereira's benchmark
+
+'$get_cpu_time'(T) :- statistics(runtime, [T,_]).
+
+'$report'(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ '$report_csv'(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+'$report_csv'([], _) :- !.
+'$report_csv'([X], _) :- !, write(X), nl.
+'$report_csv'([X|Xs], Delim) :- write(X), write(Delim), '$report_csv'(Xs, Delim).
+
+'$benchmark'(Name, Iterations, Action, Control) :-
+ '$get_cpu_time'(T0),
+ ( '$repeat'(Iterations), once(Action), fail
+ ; '$get_cpu_time'(T1)
+ ),
+ ( '$repeat'(Iterations), once(Control), fail
+ ; '$get_cpu_time'(T2)
+ ),
+ '$report'(Name, Iterations, T0, T1, T2).
+
+'$repeat'(N) :- N > 0, '$from'(1, N).
+
+'$from'(I, I) :- !.
+'$from'(L, U) :- M is (L+U)>>1, '$from'(L, M).
+'$from'(L, U) :- M is (L+U)>>1+1, '$from'(M, U).
+
+'$dummy'.
+'$dummy'(_).
+'$dummy'(_, _).
+'$dummy'(_, _, _).
diff --git a/examples/benchmarks/dobry/dobry.in b/examples/benchmarks/dobry/dobry.in
new file mode 100644
index 0000000..71042b7
--- /dev/null
+++ b/examples/benchmarks/dobry/dobry.in
@@ -0,0 +1,13 @@
+:- '$benchmark'(con1, 100000, con1, '$dummy').
+:- '$benchmark'(con6, 100000, con6, '$dummy').
+:- '$benchmark'(diff, 100000, diff, '$dummy').
+:- '$benchmark'(hanoi, 100000, hanoi, '$dummy').
+:- '$benchmark'(mu, 100000, mu, '$dummy').
+:- '$benchmark'(nrev1, 100000, nrev1, '$dummy').
+:- '$benchmark'(queens, 100000, queens, '$dummy').
+:- '$benchmark'(query, 100000, query, '$dummy').
+:- '$benchmark'(qs4, 100000, qs4, '$dummy').
+:- '$benchmark'(palin25, 100000, palin25, '$dummy').
+:- '$benchmark'(sieve, 100000, sieve, '$dummy').
+
+
diff --git a/examples/benchmarks/dobry/dobry.pl b/examples/benchmarks/dobry/dobry.pl
new file mode 100644
index 0000000..ab06ff0
--- /dev/null
+++ b/examples/benchmarks/dobry/dobry.pl
@@ -0,0 +1,475 @@
+/*
+ Dobry's benchmarks
+*/
+
+/* CHANGELOG by M.Banbara
+ - [X,..Y] --> comment out
+ - not(X) --> \+(X)
+ - is(N2,N1,+,1) --> N2 is N1+1
+ - write/1, nl/0 --> comment out
+*/
+
+/****************************************************************************
+Here it is, I hope (I think I have left the code untouched, but I am not 100%
+sure). It comes from Tep Dobry when he was at UCB.
+
+By the way, these benchmarks are somehow outdated. Do you know about the
+benchmark
+suite used for assessing the BAM and the Aquarius Prolog Compiler? It is
+available by anonymous FTP from UCB. The suite of F. Pereira (published
+on the net in 86 or 87) is also quite interesting (it tries to test
+specific operations,
+unification, indexing, backtracking...).
+
+-- Jacques NOYE
+
+From: (Tep Dobry) Tep%ucbdali@Berkeley
+Subject: The Berkeley PLM Benchmarks
+Date: Wednesday, May 22 1985
+
+ At the Warren Abstract Machine Workshop a few weeks ago
+I was asked to publish the set of benchmarks programs I've
+been using on my simulator for the Berkeley Prolog
+Machine(PLM). I've finally got them all collected together
+in Prolog form (CProlog) and have sent them to the Digest.
+They're really too big to just publish in the Digest, so
+they are being set up in a directory in the PROLOG directory
+at SU-SCORE. There are 11 files with a total of 400 lines.
+Since our machine is based on compiled Prolog, the top level
+queries are also compiled in, generally as the predicate
+main/0.
+
+ The benchmarks were primarily chosen to exercise all of
+the features of the PLM, not for any complexity of program-
+ming. About half of them come from Warren's thesis, and the
+others we've added here. Our original performance figures
+were based on simulations of hand compiled versions of these
+benchmarks. We are currently looking for larger, more com-
+plex benchmarks to run on the hardware when it is available.
+So I'd be interested seeing large benchmarks sent to the
+Digest.
+
+-- Tep Dobry (TEP@Berkeley)
+****************************************************************************/
+
+% concat (con1, con6)
+% These two tests are simple examples of the concat predicate
+% con1 is determinate, con6 is non-determinate getting all 6 answers
+
+con1 :- concat([a,b,c],[d,e],X). % con1
+ %write(X),nl.
+con6 :- concat(X,Y,[a,b,c,d,e]), % con6
+ %write(X),nl,
+ %write(Y),nl,nl,
+ fail.
+
+concat([],L,L).
+concat([X|L1],L2,[X|L3]) :- concat(L1,L2,L3).
+
+
+% differen (times10,divide10,log10,ops8)
+% These 4 examples are from Warren's thesis
+
+diff :-
+ times10(I1),
+ d(I1,x,D1),
+ %write(D1), nl,
+ divide10(I2),
+ d(I2,x,D2),
+ %write(D2), nl,
+ log10(I3),
+ d(I3,x,D3),
+ %write(D3), nl,
+ ops8(I4),
+ d(I4,x,D4).
+ %write(D4), nl.
+
+d(U+V,X,DU+DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U-V,X,DU-DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U*V,X,DU*V+U*DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, d(U,X,DU), d(V,X,DV).
+d(^(U,N),X,DU*N*(^(U,N1))) :- !, integer(N), N1 is N - 1, d(U,X,DU).
+d(-U,X,-DU) :- !, d(U,X,DU).
+d(exp(U),X,exp(U)*DU) :- !, d(U,X,DU).
+d(log(U),X,DU/U) :- !, d(U,X,DU).
+d(X,X,1). % There is a cut in Warren's program! -- Jacques
+d(C,X,0).
+
+times10( ((((((((x*x)*x)*x)*x)*x)*x)*x)*x)*x ).
+divide10( ((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x ).
+log10( log(log(log(log(log(log(log(log(log(log(x)))))))))) ).
+ops8( (x+1)*((^(x,2)+2)*(^(x,3)+3)) ).
+
+
+
+% towers of hanoi ( hanoi ) for 8 disks
+
+hanoi :- hanoi(8).
+
+hanoi(N) :- move(N,left,center,right).
+
+move(0,_,_,_) :- !.
+%move(N,A,B,C) :- M is N-1, move(M,A,C,B), inform(A,B), move(M,C,B,A).
+move(N,A,B,C) :- M is N-1, move(M,A,C,B), move(M,C,B,A).
+
+inform(A,B) :- write([move,disk,from,A,to,B]), nl, fail.
+inform(_,_).
+
+/*
+% Main program to do branch and bound NAND gate designs.
+% Optimized for 2-input NAND gates and 3 input variables.
+% A. Despain, Feb 84.
+% In this case, design a 2-1 MUX (ckt2)
+
+main :- set_bound(32000), update_circuit([],0), r(0, [0,0,1,1,0,1,0,1]).
+
+run(Depth, Table, Circuit, Cost, Depth) :- search(Depth, Table),
+ circuit(Circuit),
+ Circuit\==[],
+ cost_bound(Cost),!.
+run(Depth, Table, Circuit, Cost, Delay) :- D is Depth + 1,
+ run(D, Table, Circuit, Cost, Delay),!.
+
+search(Depth, Table) :- t(Depth, Circuit, Table, 0, Cost_out),
+ update_circuit(Circuit,Cost_out),
+ update_bound(Cost_out).
+
+% Input signals are free and terminate the search.
+t(_, 0 , [0,1,0,1,0,1,0,1],C,C).
+t(_, 1 , [0,0,1,1,0,0,1,1],C,C).
+t(_, 2 , [0,0,0,0,1,1,1,1],C,C).
+t(_,i0 , [1,0,1,0,1,0,1,0],C,C).
+t(_,i1 , [1,1,0,0,1,1,0,0],C,C).
+t(_,i2 , [1,1,1,1,0,0,0,0],C,C).
+
+% Inverters are free in this model.
+t(Depth, [i,Z], Table, Cin, Cout) :- Depth > 0,
+ D is Depth -1,
+ sint(Table, Itable),
+ t(D, Z, Itable, Cin, Cout).
+
+% Main NAND gate clause.
+t(Depth, [n,Y,Z], Table, Cin, Cout) :- Depth > 0,
+ D is Depth -1,
+ update_cost(Cin,1,C2),
+ ngate(Table, A, B),
+ t(D,Y,A,C2,C3),
+ t(D,Z,B,C3,Cout).
+
+% Inverter signal transformation.
+%sint([H1,..T1],[H2,..T2]) :- inv(H1, H2), sint(T1, T2).
+sint([],[]).
+sint([X,..T1],[_,..T2]) :- var(X), sint(T1, T2),!.
+sint([0,..T1],[1,..T2]) :- sint(T1, T2).
+sint([1,..T1],[0,..T2]) :- sint(T1, T2).
+
+% Optimized gate signal transformation.
+ngate([], [], []).
+tgate([], [], []).
+ngate([X,..T0], [_,..T1], [_,..T2]) :- var(X), !, ngate(T0, T1, T2).
+ngate([X,..T0], [1,..T1], [1,..T2]) :- X==0, ngate(T0, T1, T2).
+ngate([X,..T0], [_,..T1], [0,..T2]) :- X==1, tgate(T0, T1, T2).
+tgate([X,..T0], [_,..T1], [_,..T2]) :- var(X), !, tgate(T0, T1, T2).
+tgate([X,..T0], [1,..T1], [1,..T2]) :- X==0, tgate(T0, T1, T2).
+tgate([X,..T0], [_,..T1], [0,..T2]) :- X==1, tgate(T0, T1, T2).
+tgate([X,..T0], [0,..T1], [_,..T2]) :- X==1, tgate(T0, T1, T2).
+
+
+r(Depth,Table) :- run(0, Table, L, C, D),
+ Depth =< D,
+ nl, write([minimum,cost,circuit,of,the,shortest,delay]),
+ nl, write([ circuit,=,L]),
+ nl, write([ cost,is,C,gates]),
+ nl, write([ delay,is,D,gate,times]),nl,!.
+r(Depth,Table) :- run(Depth, Table, L, C, D),
+ nl, write([lowest,cost,circuit,for,a,given,delay]),
+ nl, write([ circuit,=,L]),
+ nl, write([ cost,is,C,gates]),
+ nl, write([ delay,is,D,gate,times]),nl.
+
+%Utility procedures
+
+min(X,Y,X) :- X < Y , ! .
+min(X,Y,Y).
+
+update_cost(Cost_in, Cost, Cost_out) :- Cost_out is Cost_in + Cost,
+ cost_bound(B),
+ Cost_out < B, ! .
+
+cost_bound(32000).
+
+set_bound(X) :- retract((cost_bound(_))),
+ assert((cost_bound(X))), ! .
+
+update_bound(X) :- retract((cost_bound(Y))),
+ min(X,Y,Z),
+ assert((cost_bound(Z))), ! .
+
+update_circuit(Circuit,Cost) :- cost_bound(X),
+ Cost < X ,
+ retract((circuit(_))),
+ assert((circuit(Circuit))),!.
+update_circuit(Circuit,Cost).
+
+circuit([]).
+*/
+
+% Hofstader's mu math (mutest) proving muiiu
+% from Godel Escher Bach
+
+mu :- theorem(5,[m,u,i,i,u]).
+
+rules(S, R) :- rule3(S,R).
+rules(S, R) :- rule4(S,R).
+rules(S, R) :- rule1(S,R).
+rules(S, R) :- rule2(S,R).
+
+rule1(S,R) :-
+ append(X, [i], S),
+ append(X, [i,u], R).
+
+rule2([m | T], [m | R]) :- append(T, T, R).
+
+rule3([], -) :- fail.
+rule3(R, T) :-
+ append([i,i,i], S, R),
+ append([u], S, T).
+rule3([H | T], [H | R]) :- rule3(T, R).
+
+rule4([], -) :- fail.
+rule4(R, T) :- append([u, u], T, R).
+rule4([H | T], [H | R]) :- rule4(T, R).
+
+theorem(Depth, [m, i]).
+theorem(Depth, []) :- fail.
+
+theorem(Depth, R) :-
+ Depth > 0,
+ D is Depth - 1,
+ theorem(D, S),
+ rules(S, R).
+
+append([], X, X).
+append([A | B], X, [A | B1]) :-
+ !,
+ append(B, X, B1).
+
+
+% naive reverse (nrev1)
+% from Warren's thesis
+
+nrev1 :-
+ list30(L),
+ nreverse(L,X).
+ %write(X), nl.
+
+nreverse([X|L0],L) :- nreverse(L0,L1), concatenate(L1,[X],L).
+nreverse([],[]).
+
+concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3).
+concatenate([],L,L).
+
+list30([1,2,3,4,5,6,7,8,9,10,11,12,
+ 13,14,15,16,17,18,19,20,21,
+ 22,23,24,25,26,27,28,29,30]).
+
+
+% the queens on a chessboard problem (queens) for 4x4 board
+
+queens :- run(4,X), fail.
+
+size(4).
+int(1).
+int(2).
+int(3).
+int(4).
+
+%run(Size, Soln) :- get_solutions(Size, Soln), inform(Soln).
+run(Size, Soln) :- get_solutions(Size, Soln).
+
+get_solutions(Board_size, Soln) :- solve(Board_size, [], Soln).
+
+% newsquare generates legal positions for next queen
+
+newsquare([], square(1, X)) :- int(X).
+newsquare([square(I, J) | Rest], square(X, Y)) :-
+ X is I + 1,
+ int(Y),
+ \+(threatened(I, J, X, Y)),
+ safe(X, Y, Rest).
+
+
+% safe checks whether square(X, Y) is threatened by any
+% existing queens
+
+safe(X, Y, []).
+safe(X, Y, [square(I, J) | L]) :-
+ \+(threatened(I, J, X, Y)),
+ safe(X, Y, L).
+
+
+% threatened checks whether squares (I, J) and (X, Y)
+% threaten each other
+
+threatened(I, J, X, Y) :-
+ (I = X),
+ !.
+threatened(I, J, X, Y) :-
+ (J = Y),
+ !.
+threatened(I, J, X, Y) :-
+ (U is I - J),
+ (V is X - Y),
+ (U = V),
+ !.
+threatened(I, J, X, Y) :-
+ (U is I + J),
+ (V is X + Y),
+ (U = V),
+ !.
+
+
+% solve accumulates the positions of occupied squares
+
+solve(Bs, [square(Bs, Y) | L], [square(Bs, Y) | L]) :- size(Bs).
+solve(Board_size, Initial, Final) :-
+ newsquare(Initial, Next),
+ solve(Board_size, [Next | Initial], Final).
+
+inform([]) :- nl,nl.
+inform([M | L]) :- write(M), nl, inform(L).
+
+% query
+% from Warren's thesis
+
+query :-
+ query(X),
+ %write(X), nl,
+ fail.
+
+query([C1,D1,C2,D2]) :-
+ density(C1,D1),
+ density(C2,D2),
+ D1 > D2,
+ T1 is 20*D1,
+ T2 is 21*D2,
+ T1 < T2.
+
+density(C,D) :- pop(C,P), area(C,A), D is (P*100)//A.
+
+pop(china, 8250). area(china, 3380).
+pop(india, 5863). area(india, 1139).
+pop(ussr, 2521). area(ussr, 8708).
+pop(usa, 2119). area(usa, 3609).
+pop(indonesia, 1276). area(indonesia, 570).
+pop(japan, 1097). area(japan, 148).
+pop(brazil, 1042). area(brazil, 3288).
+pop(bangladesh, 750). area(bangladesh,55).
+pop(pakistan, 682). area(pakistan, 311).
+pop(w_germany, 620). area(w_germany, 96).
+pop(nigeria, 613). area(nigeria, 373).
+pop(mexico, 581). area(mexico, 764).
+pop(uk, 559). area(uk, 86).
+pop(italy, 554). area(italy, 116).
+pop(france, 525). area(france, 213).
+pop(phillipines,415). area(phillipines,90).
+pop(thailand, 410). area(thailand, 200).
+pop(turkey, 383). area(turkey, 296).
+pop(egypt, 364). area(egypt, 386).
+pop(spain, 352). area(spain, 190).
+pop(poland, 337). area(poland, 121).
+pop(s_korea, 335). area(s_korea, 37).
+pop(iran, 320). area(iran, 628).
+pop(ethiopia, 272). area(ethiopia, 350).
+pop(argentina, 251). area(argentina, 1080).
+
+
+% quicksort (qs4) on 50 items
+% from Warren's thesis
+
+qs4 :-
+ list50(L),
+ qsort(L,X,[]).
+ %write(X), nl.
+
+qsort([X|L],R,R0) :-
+ partition(L,X,L1,L2),
+ qsort(L2,R1,R0),
+ qsort(L1,R,[X|R1]).
+qsort([],R,R).
+
+partition([X|L],Y,[X|L1],L2) :-
+ X<Y, !,
+ partition(L,Y,L1,L2).
+partition([X|L],Y,L1,[X|L2]) :-
+ partition(L,Y,L1,L2).
+partition([],_,[],[]).
+
+list50([27,74,17,33,94,18,46,83,65,2,
+ 32,53,28,85,99,47,28,82,6,11,
+ 55,29,39,81,90,37,10,0,66,51,
+ 7,21,85,27,31,63,75,4,95,99,
+ 11,28,61,74,18,92,40,53,59,8]).
+
+
+
+% serialize (palin25)
+% from Warren's thesis
+
+palin25 :-
+ palin25(P),
+ serialize(P,X).
+ %write(X),nl.
+
+serialize(L,R) :-
+ pairlists(L,R,A),
+ arrange(A,T),
+ numbered(T,1,N).
+
+pairlists([X|L], [Y|R], [pair(X,Y)|A]) :- pairlists(L,R,A).
+pairlists([], [], []).
+
+arrange([X|L], tree(T1, X, T2)) :-
+ split(L, X, L1, L2),
+ arrange(L1, T1),
+ arrange(L2, T2).
+arrange([], void).
+
+split([X|L], X, L1, L2) :- !, split(L, X, L1, L2).
+split([X|L], Y, [X|L1], L2) :- before(X,Y), !, split(L,Y,L1,L2).
+split([X|L], Y, L1, [X|L2]) :- before(Y,X), !, split(L,Y,L1,L2).
+split([], _, [], []).
+
+before(pair(X1,Y1), pair(X2,Y2)) :- X1 < X2.
+
+numbered(tree(T1, pair(X,N1), T2), N0, N) :-
+ numbered(T1, N0, N1),
+ %is(N2,N1,+,1),
+ N2 is N1+1,
+ numbered(T2,N2,N).
+numbered(_,N,N).
+
+palin25("ABLE WAS I ERE I SAW ELBA").
+
+
+% The sieve of Eratosthenes, from Clocksin & Mellish (pri2)
+% finding the prime numbers up to 98.
+
+%sieve :- primes(98, X), write(X), nl.
+sieve :- primes(98, X).
+
+primes(Limit, Ps) :- integers(2, Limit, Is), sift(Is, Ps).
+
+integers(Low, High, [Low | Rest]) :-
+ Low =< High, !,
+ M is Low+1,
+ integers(M, High, Rest).
+integers(_,_,[]).
+
+sift([],[]).
+sift([I | Is], [I | Ps]) :- remove(I,Is,New), sift(New, Ps).
+
+remove(P,[],[]).
+remove(P,[I | Is], [I | Nis]) :- \+(0 is I mod P), !, remove(P,Is,Nis).
+remove(P,[I | Is], Nis) :- 0 is I mod P, !, remove(P,Is,Nis).
+
diff --git a/examples/benchmarks/ecrc/Makefile b/examples/benchmarks/ecrc/Makefile
new file mode 100644
index 0000000..3baa1b2
--- /dev/null
+++ b/examples/benchmarks/ecrc/Makefile
@@ -0,0 +1,95 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS = -J '-Xmx100m'
+PLJAR = pljar
+PLJAROPTS = -v -J '-Xmx100m' -C '-J-Xmx300m'
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/ecrc/bench_1_1.in b/examples/benchmarks/ecrc/bench_1_1.in
new file mode 100644
index 0000000..582cff8
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_1.in
@@ -0,0 +1 @@
+:- boresea(100000).
diff --git a/examples/benchmarks/ecrc/bench_1_1.pl b/examples/benchmarks/ecrc/bench_1_1.pl
new file mode 100644
index 0000000..ee7db9d
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_1.pl
@@ -0,0 +1,252 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+*/
+
+
+/* This program is called with the query "?-boresea(X)." */
+/* X is the number of loop iterations executed. It should be big */
+/* enough to give significant results. */
+/* suggested value for X: 100 for interpreted code*/
+/* 1000 for compiled code */
+/* average values for C-prolog interpreter: */
+/* X=1000, Tloop=27.1 T.comp=1.0 Tnet=26.1 Klips=7.7 */
+
+boresea(X)
+ :- statistics(runtime,[T1|_]),
+ do_max_KLips(X), /* calls the loop to execute the */
+ statistics(runtime,[T2|_]), /* sequence of 200 predicates */
+ compens_loop(X), /* compensation loop */
+ statistics(runtime,[T3|_]),
+ print_times(boresea(X),T1,T2,T3,X,200). /*compute and print results */
+
+compens_loop(0). /* compensation loop */
+compens_loop(X) :- Y is X - 1, compens_loop(Y).
+
+print_times(Name,T1,T2,T3,X,I) :- /* prints the results */
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ TT is TT1 - TT2,
+ write('# Name: '),write(Name), nl,
+ write('# T overall loop: '),write(TT1), write(' msec.'),nl,
+ write('# T compens loop: '),write(TT2), write(' msec.'),nl,
+ write('# T net: '),write(TT), write(' msec.'),nl,
+ write('# KLips: '),
+ Li is I * X,
+ Lips is Li / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
+
+
+
+do_max_KLips(0). /* loop calling the actual benchmark */
+do_max_KLips(X) :- lips1, Y is X - 1, do_max_KLips(Y).
+
+/* predicates to test call */
+
+lips1 :- lips2.
+lips2 :- lips3.
+lips3 :- lips4.
+lips4 :- lips5.
+lips5 :- lips6.
+lips6 :- lips7.
+lips7 :- lips8.
+lips8 :- lips9.
+lips9 :- lips10.
+lips10 :- lips11.
+lips11 :- lips12.
+lips12 :- lips13.
+lips13 :- lips14.
+lips14 :- lips15.
+lips15 :- lips16.
+lips16 :- lips17.
+lips17 :- lips18.
+lips18 :- lips19.
+lips19 :- lips20.
+lips20 :- lips21.
+lips21 :- lips22.
+lips22 :- lips23.
+lips23 :- lips24.
+lips24 :- lips25.
+lips25 :- lips26.
+lips26 :- lips27.
+lips27 :- lips28.
+lips28 :- lips29.
+lips29 :- lips30.
+lips30 :- lips31.
+lips31 :- lips32.
+lips32 :- lips33.
+lips33 :- lips34.
+lips34 :- lips35.
+lips35 :- lips36.
+lips36 :- lips37.
+lips37 :- lips38.
+lips38 :- lips39.
+lips39 :- lips40.
+lips40 :- lips41.
+lips41 :- lips42.
+lips42 :- lips43.
+lips43 :- lips44.
+lips44 :- lips45.
+lips45 :- lips46.
+lips46 :- lips47.
+lips47 :- lips48.
+lips48 :- lips49.
+lips49 :- lips50.
+lips50 :- lips51.
+lips51 :- lips52.
+lips52 :- lips53.
+lips53 :- lips54.
+lips54 :- lips55.
+lips55 :- lips56.
+lips56 :- lips57.
+lips57 :- lips58.
+lips58 :- lips59.
+lips59 :- lips60.
+lips60 :- lips61.
+lips61 :- lips62.
+lips62 :- lips63.
+lips63 :- lips64.
+lips64 :- lips65.
+lips65 :- lips66.
+lips66 :- lips67.
+lips67 :- lips68.
+lips68 :- lips69.
+lips69 :- lips70.
+lips70 :- lips71.
+lips71 :- lips72.
+lips72 :- lips73.
+lips73 :- lips74.
+lips74 :- lips75.
+lips75 :- lips76.
+lips76 :- lips77.
+lips77 :- lips78.
+lips78 :- lips79.
+lips79 :- lips80.
+lips80 :- lips81.
+lips81 :- lips82.
+lips82 :- lips83.
+lips83 :- lips84.
+lips84 :- lips85.
+lips85 :- lips86.
+lips86 :- lips87.
+lips87 :- lips88.
+lips88 :- lips89.
+lips89 :- lips90.
+lips90 :- lips91.
+lips91 :- lips92.
+lips92 :- lips93.
+lips93 :- lips94.
+lips94 :- lips95.
+lips95 :- lips96.
+lips96 :- lips97.
+lips97 :- lips98.
+lips98 :- lips99.
+lips99 :- lips100.
+lips100:- lips101.
+lips101 :- lips102.
+lips102 :- lips103.
+lips103 :- lips104.
+lips104 :- lips105.
+lips105 :- lips106.
+lips106 :- lips107.
+lips107 :- lips108.
+lips108 :- lips109.
+lips109 :- lips110.
+lips110 :- lips111.
+lips111 :- lips112.
+lips112 :- lips113.
+lips113 :- lips114.
+lips114 :- lips115.
+lips115 :- lips116.
+lips116 :- lips117.
+lips117 :- lips118.
+lips118 :- lips119.
+lips119 :- lips120.
+lips120 :- lips121.
+lips121 :- lips122.
+lips122 :- lips123.
+lips123 :- lips124.
+lips124 :- lips125.
+lips125 :- lips126.
+lips126 :- lips127.
+lips127 :- lips128.
+lips128 :- lips129.
+lips129 :- lips130.
+lips130 :- lips131.
+lips131 :- lips132.
+lips132 :- lips133.
+lips133 :- lips134.
+lips134 :- lips135.
+lips135 :- lips136.
+lips136 :- lips137.
+lips137 :- lips138.
+lips138 :- lips139.
+lips139 :- lips140.
+lips140 :- lips141.
+lips141 :- lips142.
+lips142 :- lips143.
+lips143 :- lips144.
+lips144 :- lips145.
+lips145 :- lips146.
+lips146 :- lips147.
+lips147 :- lips148.
+lips148 :- lips149.
+lips149 :- lips150.
+lips150 :- lips151.
+lips151 :- lips152.
+lips152 :- lips153.
+lips153 :- lips154.
+lips154 :- lips155.
+lips155 :- lips156.
+lips156 :- lips157.
+lips157 :- lips158.
+lips158 :- lips159.
+lips159 :- lips160.
+lips160 :- lips161.
+lips161 :- lips162.
+lips162 :- lips163.
+lips163 :- lips164.
+lips164 :- lips165.
+lips165 :- lips166.
+lips166 :- lips167.
+lips167 :- lips168.
+lips168 :- lips169.
+lips169 :- lips170.
+lips170 :- lips171.
+lips171 :- lips172.
+lips172 :- lips173.
+lips173 :- lips174.
+lips174 :- lips175.
+lips175 :- lips176.
+lips176 :- lips177.
+lips177 :- lips178.
+lips178 :- lips179.
+lips179 :- lips180.
+lips180 :- lips181.
+lips181 :- lips182.
+lips182 :- lips183.
+lips183 :- lips184.
+lips184 :- lips185.
+lips185 :- lips186.
+lips186 :- lips187.
+lips187 :- lips188.
+lips188 :- lips189.
+lips189 :- lips190.
+lips190 :- lips191.
+lips191 :- lips192.
+lips192 :- lips193.
+lips193 :- lips194.
+lips194 :- lips195.
+lips195 :- lips196.
+lips196 :- lips197.
+lips197 :- lips198.
+lips198 :- lips199.
+lips199 :- lips200.
+lips200.
diff --git a/examples/benchmarks/ecrc/bench_1_2.in b/examples/benchmarks/ecrc/bench_1_2.in
new file mode 100644
index 0000000..ba4dbb5
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_2.in
@@ -0,0 +1,5 @@
+:- choice_point(10000).
+:- choice_point(10000).
+:- choice_point0ar(10000).
+:- baktrak1(1000000).
+:- baktrak2(1000000).
diff --git a/examples/benchmarks/ecrc/bench_1_2.pl b/examples/benchmarks/ecrc/bench_1_2.pl
new file mode 100644
index 0000000..0b76662
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_2.pl
@@ -0,0 +1,255 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+*/
+
+/* The predicates are called: */
+
+/* o "choice_point(N)" - creation of choice points */
+/* o "choice_point0ar(N) - same, with 0 arg */
+/* o "baktrak1(N)" - deep backtracking */
+/* o "baktrak2(N)" - shallow backtracking */
+
+/* N is the number of loop iterations executed */
+
+
+/* predicate to test creation of choice points without backtracking */
+/* suggested value for N: 1000 */
+/* results for Cprolog N=1000 */
+/* Tloop=5.95 Tcompens=0.98 Tnet=4.97 Klips=4.02 */
+
+choice_point(N):-statistics(runtime,[T1|_]),
+ cre_CP(N), statistics(runtime,[T2|_]),
+ compens_loop(N), statistics(runtime,[T3|_]),
+ print_times(choice_point(N),T1,T2,T3,N,20).
+
+/* predicate choice_point, but with zero argument */
+/* suggested value for N: 1000 */
+/* results for Cprolog: N=1000 */
+/* Tloop=3.55 Tcompens=0.98 Tnet=2.57 Klips=7.7 */
+
+
+choice_point0ar(N):-statistics(runtime,[T1|_]),
+ cre_CP0ar(N), statistics(runtime,[T2|_]),
+ compens_loop(N), statistics(runtime,[T3|_]),
+ print_times(choice_point0ar(N),T1,T2,T3,N,20).
+/* Predicate to test the (deep) backtracking mechanism. */
+/* suggested value for N: 1000 (interp), 2000(comp) */
+/* results for Cprolog: N=1000 */
+/* Tloop=9.63 Tcomp=1 Tnet=8.63 Klips=2.32 */
+
+baktrak1(N)
+ :- statistics(runtime,[T1|_]),
+ deep_back(N),
+ statistics(runtime,[T2|_]),
+ compens_loop(N),
+ statistics(runtime,[T3|_]),
+ print_times(baktrak1(N),T1,T2,T3,N,20).
+
+
+/* Predicate to test the (shallow) backtracking mechanism */
+/* suggested value for N: 1000 (interp), 2000 (comp) */
+/* results for Cprolog: N=1000 */
+/* Tloop=3.63 Tcomp=0.95 Tnet=2.68 Klips=7.45 */
+
+baktrak2(X)
+ :- statistics(runtime,[T1|_]),
+ shallow_back(X), statistics(runtime,[T2|_]),
+ compens_loop(X), statistics(runtime,[T3|_]),
+ print_times(baktrak2(X),T1,T2,T3,X,20).
+
+
+/* compensation loop, used to measure the time spent in the loop */
+compens_loop(0).
+compens_loop(X) :- Y is X - 1, compens_loop(Y).
+
+/* loop to test choice point creation */
+cre_CP(0).
+cre_CP(N):-M is N-1, ccp1(0,0,0), cre_CP(M).
+
+cre_CP0ar(0).
+cre_CP0ar(N):-M is N-1, ccp1, cre_CP0ar(M).
+
+/* loop to test deep backtracking */
+deep_back(0).
+deep_back(X) :- pd(_,_,_), Y is X - 1, deep_back(Y).
+
+/* loop to test shallow backtracking */
+shallow_back(0).
+shallow_back(X) :- ps(_,a,b), Y is X - 1, shallow_back(Y).
+
+
+print_times(Name,T1,T2,T3,X,I) :- /* prints the results */
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ TT is TT1 - TT2,
+ write('# Name: '),write(Name), nl,
+ write('# T overall loop: '),write(TT1), write(' msec.'),nl,
+ write('# T compens loop: '),write(TT2), write(' msec.'),nl,
+ write('# T net: '),write(TT),write(' msec.'),nl,
+ write('# KLips: '),
+ Li is I * X,
+ Lips is Li / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
+
+
+/* ccp1 creates 20 choice points */
+/* ccp1 is the beginning of a set of predicates */
+/* composed of 2 clauses each. Every invokation of nd0 will create */
+/* a sequence of 20 choice points. The body of the clauses are */
+/* limited to one goal, thus avoiding a creation of environment */
+/* when the clause is activated. nd0, and its successors, have */
+/* three arguments to comply with our average static analysis */
+/* results made on more than 30 real Prolog programs. */
+/* ccpXX exists with 3 arguments, and 0 args. */
+
+ccp1(X,Y,Z):-ccp2(X,Y,Z).
+ccp1(X,Y,Z).
+ccp2(X,Y,Z):-ccp3(X,Y,Z).
+ccp2(X,Y,Z).
+ccp3(X,Y,Z):-ccp4(X,Y,Z).
+ccp3(X,Y,Z).
+ccp4(X,Y,Z):-ccp5(X,Y,Z).
+ccp4(X,Y,Z).
+ccp5(X,Y,Z):-ccp6(X,Y,Z).
+ccp5(X,Y,Z).
+ccp6(X,Y,Z):-ccp7(X,Y,Z).
+ccp6(X,Y,Z).
+ccp7(X,Y,Z):-ccp8(X,Y,Z).
+ccp7(X,Y,Z).
+ccp8(X,Y,Z):-ccp9(X,Y,Z).
+ccp8(X,Y,Z).
+ccp9(X,Y,Z):-ccp10(X,Y,Z).
+ccp9(X,Y,Z).
+ccp10(X,Y,Z):-ccp11(X,Y,Z).
+ccp10(X,Y,Z).
+ccp11(X,Y,Z):-ccp12(X,Y,Z).
+ccp11(X,Y,Z).
+ccp12(X,Y,Z):-ccp13(X,Y,Z).
+ccp12(X,Y,Z).
+ccp13(X,Y,Z):-ccp14(X,Y,Z).
+ccp13(X,Y,Z).
+ccp14(X,Y,Z):-ccp15(X,Y,Z).
+ccp14(X,Y,Z).
+ccp15(X,Y,Z):-ccp16(X,Y,Z).
+ccp15(X,Y,Z).
+ccp16(X,Y,Z):-ccp17(X,Y,Z).
+ccp16(X,Y,Z).
+ccp17(X,Y,Z):-ccp18(X,Y,Z).
+ccp17(X,Y,Z).
+ccp18(X,Y,Z):-ccp19(X,Y,Z).
+ccp18(X,Y,Z).
+ccp19(X,Y,Z):-ccp20(X,Y,Z).
+ccp19(X,Y,Z).
+
+ccp20(X,Y,Z).
+ccp20(X,Y,Z).
+
+ccp1:-ccp2.
+ccp1.
+ccp2:-ccp3.
+ccp2.
+ccp3:-ccp4.
+ccp3.
+ccp4:-ccp5.
+ccp4.
+ccp5:-ccp6.
+ccp5.
+ccp6:-ccp7.
+ccp6.
+ccp7:-ccp8.
+ccp7.
+ccp8:-ccp9.
+ccp8.
+ccp9:-ccp10.
+ccp9.
+ccp10:-ccp11.
+ccp10.
+ccp11:-ccp12.
+ccp11.
+ccp12:-ccp13.
+ccp12.
+ccp13:-ccp14.
+ccp13.
+ccp14:-ccp15.
+ccp14.
+ccp15:-ccp16.
+ccp15.
+ccp16:-ccp17.
+ccp16.
+ccp17:-ccp18.
+ccp17.
+ccp18:-ccp19.
+ccp18.
+ccp19:-ccp20.
+ccp19.
+
+ccp20.
+ccp20.
+
+
+/* deep backtracking */
+/* The call to pd creates a choice point, and invokes a */
+/* call to q. It will fail and there will be a backtracking */
+/* step to try the next clause defining pd. pd has 21 */
+/* clauses,thus failure */
+/* occurs 20 times */
+
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_) :- q(X1,X2,a).
+pd(X1,X2,_).
+
+q(X1,X2,b).
+
+
+/* shallow backtracking */
+/* The ps predicate fails 20 times. The shallow backtracking */
+/* will not restore all current state registers in Prolog */
+/* systems which perform this optimisation, while others will. */
+
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,X,X).
+ps(_,_,_).
diff --git a/examples/benchmarks/ecrc/bench_1_3.in b/examples/benchmarks/ecrc/bench_1_3.in
new file mode 100644
index 0000000..8e355d9
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_3.in
@@ -0,0 +1,2 @@
+:- envir(1000000).
+:- envir0ar(1000000).
diff --git a/examples/benchmarks/ecrc/bench_1_3.pl b/examples/benchmarks/ecrc/bench_1_3.pl
new file mode 100644
index 0000000..0a2dc69
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_3.pl
@@ -0,0 +1,85 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+*/
+
+/* envir(N): 3 arguments environment creation */
+/* creates 79 environments and 158 calls */
+/* suggested value for N: 1000 (interp), 1000 (comp) */
+/* results for Cprolog: N=1000 */
+/* Tloop=38.6 Tcomp=0.97 Tnet=37.6 Klips=4.23 */
+
+envir(N):-statistics(runtime,[T1|_]),
+ cre_env(N), statistics(runtime,[T2|_]),
+ compens_loop(N), statistics(runtime,[T3|_]),
+ print_times(envir(N),T1,T2,T3,N,159).
+
+cre_env(0).
+cre_env(N):-M is N-1, env0(X,Y,Z), cre_env(M).
+
+compens_loop(0).
+compens_loop(N):-M is N-1,compens_loop(M).
+
+env0(X,Y,Z):-env1(Z,X,Y),env2(Y,Z,X). /* creates 79 environments */
+env1(X,Y,Z):-env3(Z,Y,X),env4(Y,Z,X).
+env2(X,Y,Z):-env3(Z,Y,X),env4(Y,Z,X). /* and 158 calls */
+env3(X,Y,Z):-env5(Z,Y,X),env6(Y,Z,X).
+env4(X,Y,Z):-env5(Z,Y,X),env6(Y,Z,X).
+env5(X,Y,Z):-env7(Z,Y,X),env8(Y,Z,X).
+env6(X,Y,Z):-env7(Z,Y,X),env8(Y,Z,X).
+env7(X,Y,Z):-env9(Z,Y,X),env10(Y,Z,X).
+env8(X,Y,Z):-env9(Z,Y,X),env10(Y,Z,X).
+env9(X,Y,Z):-env11(Z,Y,X),env12(Y,Z,X).
+env10(X,Y,Z):-env12(Z,Y,X),env12(Y,Z,X).
+env11(X,Y,Z):-env12(Z,Y,X),env12(Y,Z,X).
+env12(X,Y,Z).
+
+
+/* envir0ar(N): zero argument environment creation */
+/* creates 79 environments and 158 calls */
+/* suggested value for N: 1000 (interp), 1000 (comp) */
+/* results for Cprolog: N=1000 */
+/* Tloop=18.88 Tcomp=1.01 Tnet=17.87 Klips=8.9 */
+
+envir0ar(N):-statistics(runtime,[T1|_]),
+ cre_env0ar(N), statistics(runtime,[T2|_]),
+ compens_loop(N), statistics(runtime,[T3|_]),
+ print_times(envir0ar(N),T1,T2,T3,N,159).
+
+cre_env0ar(0).
+cre_env0ar(N):-M is N-1, env0, cre_env(M).
+
+
+env0:-env1,env2. /* creates 79 environments */
+env1:-env3,env4.
+env2:-env3,env4. /* and 158 calls */
+env3:-env5,env6.
+env4:-env5,env6.
+env5:-env7,env8.
+env6:-env7,env8.
+env7:-env9,env10.
+env8:-env9,env10.
+env9:-env11,env12.
+env10:-env12,env12.
+env11:-env12,env12.
+env12.
+
+print_times(Name,T1,T2,T3,X,I) :- /* prints the results */
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ TT is TT1 - TT2,
+ write('# Name: '),write(Name), nl,
+ write('# T overall loop: '),write(TT1), write(' msec.'),nl,
+ write('# T compens loop: '),write(TT2), write(' msec.'),nl,
+ write('# T net: '),write(TT),write(' msec.'),nl,
+ write('# KLips: '),
+ Li is I * X,
+ Lips is Li / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
diff --git a/examples/benchmarks/ecrc/bench_1_4.in b/examples/benchmarks/ecrc/bench_1_4.in
new file mode 100644
index 0000000..dd103a2
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_4.in
@@ -0,0 +1 @@
+:- my_index(10000).
diff --git a/examples/benchmarks/ecrc/bench_1_4.pl b/examples/benchmarks/ecrc/bench_1_4.pl
new file mode 100644
index 0000000..48ae2e6
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_4.pl
@@ -0,0 +1,88 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+ - rename index/1 --> my_index/1
+*/
+
+/* This program is called with "index(N)" */
+/* It tests the efficiency of simple indexing on the 1st argument */
+/* suggested value for N: 500 (interp), 2000(comp) */
+/* results for Cprolog: N=500 */
+/* Tloop=8.98 Tcomp=0.52 Tnet=8.47 Klips=1.24 */
+
+my_index(N)
+ :- statistics(runtime,[T1|_]),
+ index_loop(N), statistics(runtime,[T2|_]),
+ compens_loop(N), statistics(runtime,[T3|_]),
+ print_times(index(N),T1,T2,T3,N,21).
+
+/* loop with calls to the actual benchmark program for indexing */
+index_loop(0).
+index_loop(X) :- p(a), p([a]), p(s(a)), /* queries to the actual */
+ p(b), p([b]), p(t(b)), /* benchmark program */
+ p(c), p([c]), p(u(c)),
+ p(d), p([d]), p(v(d)),
+ p(e), p([e]), p(w(e)),
+ p(f), p([f]), p(x(f)),
+ p(g), p([g]), p(y(g)),
+ Y is X - 1, index_loop(Y).
+
+/* compensation loop */
+compens_loop(0).
+compens_loop(X) :- Y is X - 1, compens_loop(Y).
+
+/* test program which can be optimised by indexing */
+p(a).
+p([a]).
+p(s(a)).
+p(b).
+p([b]).
+p(t(b)).
+p(c).
+p([c]).
+p(u(c)).
+p(d).
+p([d]).
+p(v(d)).
+p(e).
+p([e]).
+p(w(e)).
+p(f).
+p([f]).
+p(x(f)).
+p(g).
+p([g]).
+p(y(g)).
+
+%print_times(T1,T2,T3,X,I) :- /* prints the results */
+% TT1 is T2 - T1,
+% TT2 is T3 - T2,
+% TT is TT1 - TT2,
+% write('T first loop: '),write(TT1), nl,
+% write('T compens loop: '),write(TT2), nl,
+% write('T net: '),write(TT),nl,
+% write('KLips: '),
+% Li is I * X,
+% Lips is Li / TT,
+% KLips is Lips / 1000,
+% write(KLips),nl,nl.
+
+print_times(Name,T1,T2,T3,X,I) :- /* prints the results */
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ TT is TT1 - TT2,
+ write('# Name: '),write(Name), nl,
+ write('# T first loop: '),write(TT1), write(' msec.'),nl,
+ write('# T compens loop: '),write(TT2), write(' msec.'),nl,
+ write('# T net: '),write(TT),write(' msec.'),nl,
+ write('# KLips: '),
+ Li is I * X,
+ Lips is Li / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
diff --git a/examples/benchmarks/ecrc/bench_1_5.in b/examples/benchmarks/ecrc/bench_1_5.in
new file mode 100644
index 0000000..3e2c78a
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_5.in
@@ -0,0 +1,5 @@
+:- construct_list(100000).
+:- match_list(100000).
+:- construct_structure(100000).
+:- match_structure(100000).
+:- match_nested_structure(100000).
diff --git a/examples/benchmarks/ecrc/bench_1_5.pl b/examples/benchmarks/ecrc/bench_1_5.pl
new file mode 100644
index 0000000..38ebd9d
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_5.pl
@@ -0,0 +1,456 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+*/
+
+/* The predicates are called with: */
+/* benchmark_name(X). */
+/* where benchmark_name is the name of the predicate */
+/* and X is the number of (external) loop iterations */
+/* The benchmarks on this file are: construct_list */
+/* match_list */
+/* construct_structure */
+/* match_structure */
+/* match_nested_structure */
+/* general_unification */
+
+/* Test of list construction via unification */
+/* suggested value for N: 100 (interp), 500(comp) */
+/* results for Cprolog: N=100 */
+/* Tloop=2.49 Tcomp=0.08 Tnet=2.41 Klips=4.2 */
+construct_list(X) /* uses unification to */
+ :- statistics(runtime,[T1|_]), /* construct a list of 100 elts */
+ do_construct_list(X),
+ statistics(runtime,[T2|_]),
+ compens_loop(X),
+ statistics(runtime,[T3|_]),
+ print_times(construct_list(X),T1,T2,T3,X,100).
+
+
+/* Test of list matching unification */
+/* suggested value for N: 100 (interp), 1000(comp) */
+/* results for Cprolog: N=100 */
+/* Tloop=4.56 Tcomp=0.1 Tnet=4.46 Klips=2.2 */
+match_list(X)
+ :- list100(Z), /* construction of the matching list is done */
+ statistics(runtime,[T1|_]), /* outside of the loop, */
+ do_match_list(X,Z), /* in order not to coun */
+ statistics(runtime,[T2|_]), /* construction of the list */
+ compens_loop(X),
+ statistics(runtime,[T3|_]),
+ print_times(match_list(X),T1,T2,T3,X,100).
+
+
+/* Test of structure construction via unification */
+
+/* this program is equivalent to construct_list, except */
+/* that it uses the standard structure representation */
+/*instead of the simplified list notation */
+/* suggested value for N: 100 (interp), 500(comp) */
+/* results for Cprolog: N=100 */
+/* Tloop=2.56 Tcomp=0.08 Tnet=2.48 Klips=4 */
+construct_structure(X)
+ :- statistics(runtime,[T1|_]),
+ do_construct_structure(X),
+ statistics(runtime,[T2|_]),
+ compens_loop(X),
+ statistics(runtime,[T3|_]),
+ print_times(construct_structure(X),T1,T2,T3,X,100).
+
+
+/* Test of structure matching via unification */
+
+/* this predicate matches a list of 100 elements */
+/* in structure notation */
+/* suggested value for N: 100 (interp), 100(comp) */
+/* results for Cprolog: N=100 */
+/* Tloop=4.66 Tcomp=0.1 Tnet=4.56 Klips=2.2 */
+match_structure(X)
+ :- structure100(Z),
+ statistics(runtime,[T1|_]),
+ do_match_structure(X,Z),
+ statistics(runtime,[T2|_]),
+ compens_loop(X),
+ statistics(runtime,[T3|_]),
+ print_times(match_structure(X),T1,T2,T3,X,100).
+
+/* Test to match a nested structure */
+
+/* this predicate tests the (compiled) unification */
+/* of a complex structure */
+/* suggested value for N: 200 (interp), 200(comp) */
+/* results for Cprolog: N=200 */
+/* Tloop=1.34 Tcomp=0.17 Tnet=1.18 Klips=0.17 */
+match_nested_structure(X)
+ :- nested_structure1(Z), /* the structure to match is */
+ /* constructed outside the loop, */
+ /* in order to measure */
+ /* only the matching time */
+ statistics(runtime,[T1|_]),
+ do_match_nested_structure(X,Z),
+ statistics(runtime,[T2|_]),
+ compens_loop(X),
+ statistics(runtime,[T3|_]),
+ print_times(match_nested_structure(X),T1,T2,T3,X,1).
+
+
+/* Test of general unification of 2 complex structures */
+
+/* This predicate tests general unification. */
+/* We call it general unification, because it cannot */
+/* be analysed at compile time. Therefore this kind of */
+/* unification cannot be compiled and, even in */
+/* a compiled system, it must be handled at */
+/* run time, exactly as by an interpreter. */
+/* This is done by a general procedure for unification. */
+/* The name of the benchmark therefore does not */
+/* reflect that the unification is general, i.e. including */
+/* all Prolog types (e.g. it does not contain variables), */
+/* but it reflects the use of the procedure for general */
+/* unification as opposed to specific, compiled unification. */
+
+
+/* suggested value for N: 200 (interp), 500(comp) */
+/* results for Cprolog: N=200 */
+/* Tloop=1.38 Tcomp=0.18 Tnet=1.20 Klips=0.17 */
+general_unification(X) :-
+
+ nested_structure1(A),
+ nested_structure2(B),
+ statistics(runtime,[T1|_]),
+ do_general_unification(X,A,B),
+ statistics(runtime,[T2|_]),
+ compens_loop(X),
+ statistics(runtime,[T3|_]),
+ print_times(general_unification(X),T1,T2,T3,X,1).
+
+/* predicate to print the results of the benchmarking */
+%print_times(T1,T2,T3,X,I) :-
+% TT1 is T2 - T1,
+% TT2 is T3 - T2,
+% TT is TT1 - TT2,
+% write('T overall loop: '),write(TT1), nl,
+% write('T compens loop: '),write(TT2), nl,
+% write('T benchmark: '),write(TT),nl,
+% write('KLips: '),
+% Li is I * X,
+% Lips is Li / TT,
+% KLips is Lips / 1000,
+% write(KLips),nl,nl.
+
+print_times(Name,T1,T2,T3,X,I) :- /* prints the results */
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ TT is TT1 - TT2,
+ write('# Name: '),write(Name), nl,
+ write('# T overall loop: '),write(TT1), write(' msec.'),nl,
+ write('# T compens loop: '),write(TT2), write(' msec.'),nl,
+ write('# T benchmark: '),write(TT),write(' msec.'),nl,
+ write('# KLips: '),
+ Li is I * X,
+ Lips is Li / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
+
+/* compensation loop, used to measure the time spent in the loop */
+compens_loop(0).
+compens_loop(X) :- Y is X - 1, compens_loop(Y).
+
+/* list constructing loop */
+do_construct_list(0).
+do_construct_list(X) :- cl1(Z1,Z2,Z3), Y is X - 1,
+ do_construct_list(Y).
+
+/* list matching loop */
+do_match_list(0,Z).
+do_match_list(X,Z) :- cl1(Z,Z,Z), Y is X - 1, do_match_list(Y,Z).
+
+/* structure constructing loop */
+do_construct_structure(0).
+do_construct_structure(X) :- cs1(Z1,Z2,Z3), Y is X - 1,
+ do_construct_structure(Y).
+
+/* structure matching loop */
+do_match_structure(0,Z).
+do_match_structure(X,Z) :- cs1(Z,Z,Z), Y is X - 1,
+ do_match_structure(Y,Z).
+
+/* loop to match a nested structure */
+do_match_nested_structure(0,Z).
+do_match_nested_structure(X,Z) :-
+ nested_structure2(Z),
+ Y is X - 1,
+ do_match_nested_structure(Y,Z).
+
+/* loop for general unification */
+do_general_unification(0,A,B).
+do_general_unification(X,A,B) :-
+ unify(A,B),
+ Y is X - 1,
+ do_general_unification(Y,A,B).
+
+/* general unification */
+unify(X,X).
+
+/* complex structure as example for unification tests */
+
+/* the same structure is given twice, in order to make */
+/* sure that even implementations using structure sharing */
+/* execute the unification and do not just pass pointers */
+
+nested_structure1(
+[a( [a1([1,2,3],a),a2([4,5,6],b),a3([7,8,9],c)],
+ [a4([0,1,2],d),a5([3,4,5],e),a6([6,7,8],f)],
+ [a7([9,0,1],g),a8([2,3,4],h),a9([5,6,7],i)]),
+ b( [b1([1,2,3],a),b2([4,5,6],b),b3([7,8,9],c)],
+ [b4([0,1,2],d),b5([3,4,5],e),b6([6,7,8],f)],
+ [b7([9,0,1],g),b8([2,3,4],h),b9([5,6,7],i)]),
+ c( [c1([1,2,3],a),c2([4,5,6],b),c3([7,8,9],c)],
+ [c4([0,1,2],d),c5([3,4,5],e),c6([6,7,8],f)],
+ [c7([9,0,1],g),c8([2,3,4],h),c9([5,6,7],i)])]).
+
+
+nested_structure2(
+[a( [a1([1,2,3],a),a2([4,5,6],b),a3([7,8,9],c)],
+ [a4([0,1,2],d),a5([3,4,5],e),a6([6,7,8],f)],
+ [a7([9,0,1],g),a8([2,3,4],h),a9([5,6,7],i)]),
+ b( [b1([1,2,3],a),b2([4,5,6],b),b3([7,8,9],c)],
+ [b4([0,1,2],d),b5([3,4,5],e),b6([6,7,8],f)],
+ [b7([9,0,1],g),b8([2,3,4],h),b9([5,6,7],i)]),
+ c( [c1([1,2,3],a),c2([4,5,6],b),c3([7,8,9],c)],
+ [c4([0,1,2],d),c5([3,4,5],e),c6([6,7,8],f)],
+ [c7([9,0,1],g),c8([2,3,4],h),c9([5,6,7],i)])]).
+
+/* list of 100 elements used for match_list */
+list100([a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,
+ a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,
+ a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,
+ a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a]).
+
+/* structure of 100 elements used for match_structure */
+structure100(st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,st(a,
+ st(a,nil)))))))))))))))))))))))))))))))))
+ ))))))))))))))))))))))))))))
+ )))))))))))))))))))))))))))))))))))))))).
+
+/* predicates to test unification of lists */
+cl1([a|X],[a|Y],[a|Z]) :- cl2(X,Y,Z).
+cl2([a|X],[a|Y],[a|Z]) :- cl3(X,Y,Z).
+cl3([a|X],[a|Y],[a|Z]) :- cl4(X,Y,Z).
+cl4([a|X],[a|Y],[a|Z]) :- cl5(X,Y,Z).
+cl5([a|X],[a|Y],[a|Z]) :- cl6(X,Y,Z).
+cl6([a|X],[a|Y],[a|Z]) :- cl7(X,Y,Z).
+cl7([a|X],[a|Y],[a|Z]) :- cl8(X,Y,Z).
+cl8([a|X],[a|Y],[a|Z]) :- cl9(X,Y,Z).
+cl9([a|X],[a|Y],[a|Z]) :- cl10(X,Y,Z).
+cl10([a|X],[a|Y],[a|Z]) :- cl11(X,Y,Z).
+cl11([a|X],[a|Y],[a|Z]) :- cl12(X,Y,Z).
+cl12([a|X],[a|Y],[a|Z]) :- cl13(X,Y,Z).
+cl13([a|X],[a|Y],[a|Z]) :- cl14(X,Y,Z).
+cl14([a|X],[a|Y],[a|Z]) :- cl15(X,Y,Z).
+cl15([a|X],[a|Y],[a|Z]) :- cl16(X,Y,Z).
+cl16([a|X],[a|Y],[a|Z]) :- cl17(X,Y,Z).
+cl17([a|X],[a|Y],[a|Z]) :- cl18(X,Y,Z).
+cl18([a|X],[a|Y],[a|Z]) :- cl19(X,Y,Z).
+cl19([a|X],[a|Y],[a|Z]) :- cl20(X,Y,Z).
+cl20([a|X],[a|Y],[a|Z]) :- cl21(X,Y,Z).
+cl21([a|X],[a|Y],[a|Z]) :- cl22(X,Y,Z).
+cl22([a|X],[a|Y],[a|Z]) :- cl23(X,Y,Z).
+cl23([a|X],[a|Y],[a|Z]) :- cl24(X,Y,Z).
+cl24([a|X],[a|Y],[a|Z]) :- cl25(X,Y,Z).
+cl25([a|X],[a|Y],[a|Z]) :- cl26(X,Y,Z).
+cl26([a|X],[a|Y],[a|Z]) :- cl27(X,Y,Z).
+cl27([a|X],[a|Y],[a|Z]) :- cl28(X,Y,Z).
+cl28([a|X],[a|Y],[a|Z]) :- cl29(X,Y,Z).
+cl29([a|X],[a|Y],[a|Z]) :- cl30(X,Y,Z).
+cl30([a|X],[a|Y],[a|Z]) :- cl31(X,Y,Z).
+cl31([a|X],[a|Y],[a|Z]) :- cl32(X,Y,Z).
+cl32([a|X],[a|Y],[a|Z]) :- cl33(X,Y,Z).
+cl33([a|X],[a|Y],[a|Z]) :- cl34(X,Y,Z).
+cl34([a|X],[a|Y],[a|Z]) :- cl35(X,Y,Z).
+cl35([a|X],[a|Y],[a|Z]) :- cl36(X,Y,Z).
+cl36([a|X],[a|Y],[a|Z]) :- cl37(X,Y,Z).
+cl37([a|X],[a|Y],[a|Z]) :- cl38(X,Y,Z).
+cl38([a|X],[a|Y],[a|Z]) :- cl39(X,Y,Z).
+cl39([a|X],[a|Y],[a|Z]) :- cl40(X,Y,Z).
+cl40([a|X],[a|Y],[a|Z]) :- cl41(X,Y,Z).
+cl41([a|X],[a|Y],[a|Z]) :- cl42(X,Y,Z).
+cl42([a|X],[a|Y],[a|Z]) :- cl43(X,Y,Z).
+cl43([a|X],[a|Y],[a|Z]) :- cl44(X,Y,Z).
+cl44([a|X],[a|Y],[a|Z]) :- cl45(X,Y,Z).
+cl45([a|X],[a|Y],[a|Z]) :- cl46(X,Y,Z).
+cl46([a|X],[a|Y],[a|Z]) :- cl47(X,Y,Z).
+cl47([a|X],[a|Y],[a|Z]) :- cl48(X,Y,Z).
+cl48([a|X],[a|Y],[a|Z]) :- cl49(X,Y,Z).
+cl49([a|X],[a|Y],[a|Z]) :- cl50(X,Y,Z).
+cl50([a|X],[a|Y],[a|Z]) :- cl51(X,Y,Z).
+cl51([a|X],[a|Y],[a|Z]) :- cl52(X,Y,Z).
+cl52([a|X],[a|Y],[a|Z]) :- cl53(X,Y,Z).
+cl53([a|X],[a|Y],[a|Z]) :- cl54(X,Y,Z).
+cl54([a|X],[a|Y],[a|Z]) :- cl55(X,Y,Z).
+cl55([a|X],[a|Y],[a|Z]) :- cl56(X,Y,Z).
+cl56([a|X],[a|Y],[a|Z]) :- cl57(X,Y,Z).
+cl57([a|X],[a|Y],[a|Z]) :- cl58(X,Y,Z).
+cl58([a|X],[a|Y],[a|Z]) :- cl59(X,Y,Z).
+cl59([a|X],[a|Y],[a|Z]) :- cl60(X,Y,Z).
+cl60([a|X],[a|Y],[a|Z]) :- cl61(X,Y,Z).
+cl61([a|X],[a|Y],[a|Z]) :- cl62(X,Y,Z).
+cl62([a|X],[a|Y],[a|Z]) :- cl63(X,Y,Z).
+cl63([a|X],[a|Y],[a|Z]) :- cl64(X,Y,Z).
+cl64([a|X],[a|Y],[a|Z]) :- cl65(X,Y,Z).
+cl65([a|X],[a|Y],[a|Z]) :- cl66(X,Y,Z).
+cl66([a|X],[a|Y],[a|Z]) :- cl67(X,Y,Z).
+cl67([a|X],[a|Y],[a|Z]) :- cl68(X,Y,Z).
+cl68([a|X],[a|Y],[a|Z]) :- cl69(X,Y,Z).
+cl69([a|X],[a|Y],[a|Z]) :- cl70(X,Y,Z).
+cl70([a|X],[a|Y],[a|Z]) :- cl71(X,Y,Z).
+cl71([a|X],[a|Y],[a|Z]) :- cl72(X,Y,Z).
+cl72([a|X],[a|Y],[a|Z]) :- cl73(X,Y,Z).
+cl73([a|X],[a|Y],[a|Z]) :- cl74(X,Y,Z).
+cl74([a|X],[a|Y],[a|Z]) :- cl75(X,Y,Z).
+cl75([a|X],[a|Y],[a|Z]) :- cl76(X,Y,Z).
+cl76([a|X],[a|Y],[a|Z]) :- cl77(X,Y,Z).
+cl77([a|X],[a|Y],[a|Z]) :- cl78(X,Y,Z).
+cl78([a|X],[a|Y],[a|Z]) :- cl79(X,Y,Z).
+cl79([a|X],[a|Y],[a|Z]) :- cl80(X,Y,Z).
+cl80([a|X],[a|Y],[a|Z]) :- cl81(X,Y,Z).
+cl81([a|X],[a|Y],[a|Z]) :- cl82(X,Y,Z).
+cl82([a|X],[a|Y],[a|Z]) :- cl83(X,Y,Z).
+cl83([a|X],[a|Y],[a|Z]) :- cl84(X,Y,Z).
+cl84([a|X],[a|Y],[a|Z]) :- cl85(X,Y,Z).
+cl85([a|X],[a|Y],[a|Z]) :- cl86(X,Y,Z).
+cl86([a|X],[a|Y],[a|Z]) :- cl87(X,Y,Z).
+cl87([a|X],[a|Y],[a|Z]) :- cl88(X,Y,Z).
+cl88([a|X],[a|Y],[a|Z]) :- cl89(X,Y,Z).
+cl89([a|X],[a|Y],[a|Z]) :- cl90(X,Y,Z).
+cl90([a|X],[a|Y],[a|Z]) :- cl91(X,Y,Z).
+cl91([a|X],[a|Y],[a|Z]) :- cl92(X,Y,Z).
+cl92([a|X],[a|Y],[a|Z]) :- cl93(X,Y,Z).
+cl93([a|X],[a|Y],[a|Z]) :- cl94(X,Y,Z).
+cl94([a|X],[a|Y],[a|Z]) :- cl95(X,Y,Z).
+cl95([a|X],[a|Y],[a|Z]) :- cl96(X,Y,Z).
+cl96([a|X],[a|Y],[a|Z]) :- cl97(X,Y,Z).
+cl97([a|X],[a|Y],[a|Z]) :- cl98(X,Y,Z).
+cl98([a|X],[a|Y],[a|Z]) :- cl99(X,Y,Z).
+cl99([a|X],[a|Y],[a|Z]) :- cl100(X,Y,Z).
+cl100([a],[a],[a]).
+
+
+/* predicates to test unification of structures */
+
+cs1(st(a,X),st(a,Y),st(a,Z)) :- cs2(X,Y,Z).
+cs2(st(a,X),st(a,Y),st(a,Z)) :- cs3(X,Y,Z).
+cs3(st(a,X),st(a,Y),st(a,Z)) :- cs4(X,Y,Z).
+cs4(st(a,X),st(a,Y),st(a,Z)) :- cs5(X,Y,Z).
+cs5(st(a,X),st(a,Y),st(a,Z)) :- cs6(X,Y,Z).
+cs6(st(a,X),st(a,Y),st(a,Z)) :- cs7(X,Y,Z).
+cs7(st(a,X),st(a,Y),st(a,Z)) :- cs8(X,Y,Z).
+cs8(st(a,X),st(a,Y),st(a,Z)) :- cs9(X,Y,Z).
+cs9(st(a,X),st(a,Y),st(a,Z)) :- cs10(X,Y,Z).
+cs10(st(a,X),st(a,Y),st(a,Z)) :- cs11(X,Y,Z).
+cs11(st(a,X),st(a,Y),st(a,Z)) :- cs12(X,Y,Z).
+cs12(st(a,X),st(a,Y),st(a,Z)) :- cs13(X,Y,Z).
+cs13(st(a,X),st(a,Y),st(a,Z)) :- cs14(X,Y,Z).
+cs14(st(a,X),st(a,Y),st(a,Z)) :- cs15(X,Y,Z).
+cs15(st(a,X),st(a,Y),st(a,Z)) :- cs16(X,Y,Z).
+cs16(st(a,X),st(a,Y),st(a,Z)) :- cs17(X,Y,Z).
+cs17(st(a,X),st(a,Y),st(a,Z)) :- cs18(X,Y,Z).
+cs18(st(a,X),st(a,Y),st(a,Z)) :- cs19(X,Y,Z).
+cs19(st(a,X),st(a,Y),st(a,Z)) :- cs20(X,Y,Z).
+cs20(st(a,X),st(a,Y),st(a,Z)) :- cs21(X,Y,Z).
+cs21(st(a,X),st(a,Y),st(a,Z)) :- cs22(X,Y,Z).
+cs22(st(a,X),st(a,Y),st(a,Z)) :- cs23(X,Y,Z).
+cs23(st(a,X),st(a,Y),st(a,Z)) :- cs24(X,Y,Z).
+cs24(st(a,X),st(a,Y),st(a,Z)) :- cs25(X,Y,Z).
+cs25(st(a,X),st(a,Y),st(a,Z)) :- cs26(X,Y,Z).
+cs26(st(a,X),st(a,Y),st(a,Z)) :- cs27(X,Y,Z).
+cs27(st(a,X),st(a,Y),st(a,Z)) :- cs28(X,Y,Z).
+cs28(st(a,X),st(a,Y),st(a,Z)) :- cs29(X,Y,Z).
+cs29(st(a,X),st(a,Y),st(a,Z)) :- cs30(X,Y,Z).
+cs30(st(a,X),st(a,Y),st(a,Z)) :- cs31(X,Y,Z).
+cs31(st(a,X),st(a,Y),st(a,Z)) :- cs32(X,Y,Z).
+cs32(st(a,X),st(a,Y),st(a,Z)) :- cs33(X,Y,Z).
+cs33(st(a,X),st(a,Y),st(a,Z)) :- cs34(X,Y,Z).
+cs34(st(a,X),st(a,Y),st(a,Z)) :- cs35(X,Y,Z).
+cs35(st(a,X),st(a,Y),st(a,Z)) :- cs36(X,Y,Z).
+cs36(st(a,X),st(a,Y),st(a,Z)) :- cs37(X,Y,Z).
+cs37(st(a,X),st(a,Y),st(a,Z)) :- cs38(X,Y,Z).
+cs38(st(a,X),st(a,Y),st(a,Z)) :- cs39(X,Y,Z).
+cs39(st(a,X),st(a,Y),st(a,Z)) :- cs40(X,Y,Z).
+cs40(st(a,X),st(a,Y),st(a,Z)) :- cs41(X,Y,Z).
+cs41(st(a,X),st(a,Y),st(a,Z)) :- cs42(X,Y,Z).
+cs42(st(a,X),st(a,Y),st(a,Z)) :- cs43(X,Y,Z).
+cs43(st(a,X),st(a,Y),st(a,Z)) :- cs44(X,Y,Z).
+cs44(st(a,X),st(a,Y),st(a,Z)) :- cs45(X,Y,Z).
+cs45(st(a,X),st(a,Y),st(a,Z)) :- cs46(X,Y,Z).
+cs46(st(a,X),st(a,Y),st(a,Z)) :- cs47(X,Y,Z).
+cs47(st(a,X),st(a,Y),st(a,Z)) :- cs48(X,Y,Z).
+cs48(st(a,X),st(a,Y),st(a,Z)) :- cs49(X,Y,Z).
+cs49(st(a,X),st(a,Y),st(a,Z)) :- cs50(X,Y,Z).
+cs50(st(a,X),st(a,Y),st(a,Z)) :- cs51(X,Y,Z).
+cs51(st(a,X),st(a,Y),st(a,Z)) :- cs52(X,Y,Z).
+cs52(st(a,X),st(a,Y),st(a,Z)) :- cs53(X,Y,Z).
+cs53(st(a,X),st(a,Y),st(a,Z)) :- cs54(X,Y,Z).
+cs54(st(a,X),st(a,Y),st(a,Z)) :- cs55(X,Y,Z).
+cs55(st(a,X),st(a,Y),st(a,Z)) :- cs56(X,Y,Z).
+cs56(st(a,X),st(a,Y),st(a,Z)) :- cs57(X,Y,Z).
+cs57(st(a,X),st(a,Y),st(a,Z)) :- cs58(X,Y,Z).
+cs58(st(a,X),st(a,Y),st(a,Z)) :- cs59(X,Y,Z).
+cs59(st(a,X),st(a,Y),st(a,Z)) :- cs60(X,Y,Z).
+cs60(st(a,X),st(a,Y),st(a,Z)) :- cs61(X,Y,Z).
+cs61(st(a,X),st(a,Y),st(a,Z)) :- cs62(X,Y,Z).
+cs62(st(a,X),st(a,Y),st(a,Z)) :- cs63(X,Y,Z).
+cs63(st(a,X),st(a,Y),st(a,Z)) :- cs64(X,Y,Z).
+cs64(st(a,X),st(a,Y),st(a,Z)) :- cs65(X,Y,Z).
+cs65(st(a,X),st(a,Y),st(a,Z)) :- cs66(X,Y,Z).
+cs66(st(a,X),st(a,Y),st(a,Z)) :- cs67(X,Y,Z).
+cs67(st(a,X),st(a,Y),st(a,Z)) :- cs68(X,Y,Z).
+cs68(st(a,X),st(a,Y),st(a,Z)) :- cs69(X,Y,Z).
+cs69(st(a,X),st(a,Y),st(a,Z)) :- cs70(X,Y,Z).
+cs70(st(a,X),st(a,Y),st(a,Z)) :- cs71(X,Y,Z).
+cs71(st(a,X),st(a,Y),st(a,Z)) :- cs72(X,Y,Z).
+cs72(st(a,X),st(a,Y),st(a,Z)) :- cs73(X,Y,Z).
+cs73(st(a,X),st(a,Y),st(a,Z)) :- cs74(X,Y,Z).
+cs74(st(a,X),st(a,Y),st(a,Z)) :- cs75(X,Y,Z).
+cs75(st(a,X),st(a,Y),st(a,Z)) :- cs76(X,Y,Z).
+cs76(st(a,X),st(a,Y),st(a,Z)) :- cs77(X,Y,Z).
+cs77(st(a,X),st(a,Y),st(a,Z)) :- cs78(X,Y,Z).
+cs78(st(a,X),st(a,Y),st(a,Z)) :- cs79(X,Y,Z).
+cs79(st(a,X),st(a,Y),st(a,Z)) :- cs80(X,Y,Z).
+cs80(st(a,X),st(a,Y),st(a,Z)) :- cs81(X,Y,Z).
+cs81(st(a,X),st(a,Y),st(a,Z)) :- cs82(X,Y,Z).
+cs82(st(a,X),st(a,Y),st(a,Z)) :- cs83(X,Y,Z).
+cs83(st(a,X),st(a,Y),st(a,Z)) :- cs84(X,Y,Z).
+cs84(st(a,X),st(a,Y),st(a,Z)) :- cs85(X,Y,Z).
+cs85(st(a,X),st(a,Y),st(a,Z)) :- cs86(X,Y,Z).
+cs86(st(a,X),st(a,Y),st(a,Z)) :- cs87(X,Y,Z).
+cs87(st(a,X),st(a,Y),st(a,Z)) :- cs88(X,Y,Z).
+cs88(st(a,X),st(a,Y),st(a,Z)) :- cs89(X,Y,Z).
+cs89(st(a,X),st(a,Y),st(a,Z)) :- cs90(X,Y,Z).
+cs90(st(a,X),st(a,Y),st(a,Z)) :- cs91(X,Y,Z).
+cs91(st(a,X),st(a,Y),st(a,Z)) :- cs92(X,Y,Z).
+cs92(st(a,X),st(a,Y),st(a,Z)) :- cs93(X,Y,Z).
+cs93(st(a,X),st(a,Y),st(a,Z)) :- cs94(X,Y,Z).
+cs94(st(a,X),st(a,Y),st(a,Z)) :- cs95(X,Y,Z).
+cs95(st(a,X),st(a,Y),st(a,Z)) :- cs96(X,Y,Z).
+cs96(st(a,X),st(a,Y),st(a,Z)) :- cs97(X,Y,Z).
+cs97(st(a,X),st(a,Y),st(a,Z)) :- cs98(X,Y,Z).
+cs98(st(a,X),st(a,Y),st(a,Z)) :- cs99(X,Y,Z).
+cs99(st(a,X),st(a,Y),st(a,Z)) :- cs100(X,Y,Z).
+cs100(st(a,nil),st(a,nil),st(a,nil)).
diff --git a/examples/benchmarks/ecrc/bench_1_6.in b/examples/benchmarks/ecrc/bench_1_6.in
new file mode 100644
index 0000000..e95a6f5
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_6.in
@@ -0,0 +1 @@
+:- deref(100000).
diff --git a/examples/benchmarks/ecrc/bench_1_6.pl b/examples/benchmarks/ecrc/bench_1_6.pl
new file mode 100644
index 0000000..a2d102e
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_6.pl
@@ -0,0 +1,102 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+*/
+
+
+deref(N):-
+ make_list(500, L1, _),
+ make_list(500, L2, Last),
+ bind_forward(L1),
+ bind_backward(L2),
+ L2 = [a|_],
+ statistics(runtime,[T1|_]),
+ ref(N, L1),
+ statistics(runtime,[T2|_]),
+ ref(N, Last),
+ statistics(runtime,[T3|_]),
+ print_times(deref(N),T1,T2,T3,N,12).
+
+%print_times(T1,T2,T3,X,I) :- /* prints the results */
+% TT1 is T2 - T1,
+% TT2 is T3 - T2,
+% abs_diff(TT1, TT2, TT),
+% write('T first loop: '),write(TT1), nl,
+% write('T second loop: '),write(TT2), nl,
+% write('T net: '),write(TT),nl,
+% write('KLips: '),
+% Li is I * X,
+% Lips is Li / TT,
+% KLips is Lips / 1000,
+% write(KLips),nl,nl.
+print_times(Name,T1,T2,T3,X,I) :- /* prints the results */
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ abs_diff(TT1, TT2, TT),
+ write('# Name: '),write(Name), nl,
+ write('# T first loop: '),write(TT1), write(' msec.'),nl,
+ write('# T second loop: '),write(TT2), write(' msec.'),nl,
+ write('# T net: '),write(TT),write(' msec.'),nl,
+ write('# KLips: '),
+ Li is I * X,
+ Lips is Li / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
+
+abs_diff(X,Y,Z) :- X > Y, !, Z is X - Y.
+abs_diff(X,Y,Z) :- Z is Y - X.
+
+/*
+ * Bind repeatively a cons cell to another one.
+ */
+ref(0, _) :- !.
+ref(N, Cons) :-
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ Cons = [a|_],
+ N1 is N - 1,
+ ref(N1, Cons).
+
+/*
+ * Create a variable chain if in ?- equal(X, Y) the system binds
+ * X to Y.
+ */
+bind_forward([a]) :- !.
+bind_forward([X, Y|T]) :-
+ equal(X, Y),
+ bind_forward([Y|T]).
+
+/*
+ * Create a variable chain if in ?- equal(X, Y) the system binds
+ * Y to X.
+ */
+bind_backward([X]) :- !.
+bind_backward([X, Y|T]) :-
+ bind_backward([Y|T]),
+ equal(X, Y).
+
+equal(X, X).
+
+/*
+ * Create a list containing variables and return the pointer to the
+ * first and to the last cons cell.
+ */
+make_list(1, L, L) :-
+ L = [X],
+ !.
+make_list(N, [X|Rest], Last) :-
+ N1 is N - 1,
+ make_list(N1, Rest, Last).
diff --git a/examples/benchmarks/ecrc/bench_1_7.in b/examples/benchmarks/ecrc/bench_1_7.in
new file mode 100644
index 0000000..92f578c
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_7.in
@@ -0,0 +1 @@
+:- cuttest(100000).
diff --git a/examples/benchmarks/ecrc/bench_1_7.pl b/examples/benchmarks/ecrc/bench_1_7.pl
new file mode 100644
index 0000000..b595306
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_1_7.pl
@@ -0,0 +1,63 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+*/
+
+
+cuttest(N):-statistics(runtime,[T1|_]),
+ cutit11(N), statistics(runtime,[T2|_]),
+ compens_loop(N), statistics(runtime,[T3|_]),
+ print_times(cuttest(N),T1,T2,T3,N,300).
+
+compens_loop(0).
+compens_loop(X) :- Y is X - 1, compens_loop(Y).
+
+/* cutit11(N) */
+cutit11(0).
+cutit11(N):- cutt1([100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100,
+ 100,100,100,100,100,100,100,100,100,100]),
+ M is N-1, cutit11(M).
+
+cutt1([]).
+cutt1([X|L]):-X=100, !, cutt1(L).
+cutt1([X|L]):-X > 100, cutt1(L).
+
+%print_times(T1,T2,T3,X,I) :- /* prints the results */
+% TT1 is T2 - T1,
+% TT2 is T3 - T2,
+% TT is TT1 - TT2,
+% write('T overall loop: '),write(TT1), nl,
+% write('T compens loop: '),write(TT2), nl,
+% write('T net: '),write(TT),nl,
+% write('KLips: '),
+% Li is I * X,
+% Lips is Li / TT,
+% KLips is Lips / 1000,
+% write(KLips),nl,nl.
+print_times(Name,T1,T2,T3,X,I) :- /* prints the results */
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ TT is TT1 - TT2,
+ write('# Name: '),write(Name), nl,
+ write('# T overall loop: '),write(TT1), write(' msec.'),nl,
+ write('# T compens loop: '),write(TT2), write(' msec.'),nl,
+ write('# T net: '),write(TT),write(' msec.'),nl,
+ write('# KLips: '),
+ Li is I * X,
+ Lips is Li / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
diff --git a/examples/benchmarks/ecrc/bench_2.in b/examples/benchmarks/ecrc/bench_2.in
new file mode 100644
index 0000000..9098e76
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_2.in
@@ -0,0 +1,10 @@
+:- fibonacci(10000).
+:- map(100000).
+:- mham(100).
+:- mutest(10000).
+:- qs(10000).
+:- qu(10000).
+:- query(10000).
+:- differen(100000).
+:- diff(10000).
+:- nrev(5000).
diff --git a/examples/benchmarks/ecrc/bench_2.pl b/examples/benchmarks/ecrc/bench_2.pl
new file mode 100644
index 0000000..c4db210
--- /dev/null
+++ b/examples/benchmarks/ecrc/bench_2.pl
@@ -0,0 +1,531 @@
+/* CHANGELOG by M.Banbara
+ - print_times/4 --> print_times/5
+ - report_csv/2 is added.
+ - user --> user_output (stream alias)
+*/
+
+/* Common functions... */
+%print_times(T1,T2,T3,L) :-
+% TT1 is T2 - T1,
+% TT2 is T3 - T2,
+% TT is TT1 - TT2,
+% write('Net Time is: '), write(TT), nl,
+% Lips is L / TT,
+% Klips is Lips / 1000,
+% write('KLips are: '), write(Klips), nl.
+
+print_times(Name,T1,T2,T3,L) :-
+ TT1 is T2 - T1,
+ TT2 is T3 - T2,
+ TT is TT1 - TT2,
+ write('# Name: '),write(Name), nl,
+ write('# Net Time is: '),write(TT),write(' msec.'),nl,
+ write('# KLips are: '),
+ Lips is L / TT,
+ KLips is Lips / 1000,
+ write(KLips),nl,
+ report_csv(['###CSV###',Name,TT1,TT2,TT,KLips], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
+
+compens_loop(0).
+compens_loop(X) :- Y is X - 1, compens_loop(Y).
+
+el(X,[X|L]).
+el(X,[Y|L]):-el(X,L).
+
+list50([27,74,17,33,94,18,46,83,65,2,
+ 32,53,28,85,99,47,28,82,6,11,
+ 55,29,39,81,90,37,10,0,66,51,
+ 7,21,85,27,31,63,75,4,95,99,
+ 11,28,61,74,18,92,40,53,59,8]).
+
+/* Fibonacci Series the slow way */
+/* fibonacci(1) will do... */
+
+fibonacci(N) :- statistics(runtime,[X|_]),
+ fib_loop(N),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 4932 * N,
+ print_times(fibonacci(N),X,Now,M,Li).
+
+
+fib_loop(0).
+fib_loop(X) :- \+ \+ top_fib(15,Z), Y is X - 1, fib_loop(Y).
+
+top_fib(0,1).
+top_fib(1,1).
+top_fib(X,Y):-X1 is X-1,X2 is X-2,top_fib(X1,Y1),
+ top_fib(X2,Y2),Y is Y1+Y2.
+
+/* ------------------------------------ */
+/* Map colouring problem */
+/* map(200) is advised. */
+
+map(N) :- statistics(runtime,[X|_]),
+ map_loop(N),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 68 * N,
+ print_times(map(N),X,Now,M,Li).
+
+map_loop(0).
+map_loop(X) :- \+ \+ map_top, Y is X - 1, map_loop(Y).
+
+map_top:-
+ el(X1,[b]),
+ el(X2,[r]),
+ el(X7,[g]),
+ el(X13,[w]),
+ el(X3,[b,r,g,w]),
+ \+(X2=X3),
+ \+(X3=X13),
+ el(X4,[b,r,g,w]),
+ \+(X2=X4),
+ \+(X7=X4),
+ \+(X3=X4),
+ el(X5,[b,r,g,w]),
+ \+(X13=X5),
+ \+(X3=X5),
+ \+(X4=X5),
+ el(X6,[b,r,g,w]),
+ \+(X13=X6),
+ \+(X5=X6),
+ el(X8,[b,r,g,w]),
+ \+(X7=X8),
+ \+(X13=X8),
+ el(X9,[b,r,g,w]),
+ \+(X13=X9),
+ \+(X4=X9),
+ \+(X8=X9),
+ el(X10,[b,r,g,w]),
+ \+(X4=X10),
+ \+(X5=X10),
+ \+(X6=X10),
+ \+(X9=X10),
+ el(X11,[b,r,g,w]),
+ \+(X11=X13),
+ \+(X11=X10),
+ \+(X11=X6),
+ el(X12,[b,r,g,w]),
+ \+(X12=X13),
+ \+(X12=X11),
+ \+(X12=X9).
+ %write(user_output,[X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13]),nl.
+
+map_top.
+
+/* ---------------------------------------------- */
+/* Hamiltonian Graphs... */
+/* Extremely long (nearly half a million LI's !) */
+/* Only 1 advised ! */
+
+mham(N) :- statistics(runtime,[X|_]),
+ mham_loop(N),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 493824 * N,
+ print_times(mham(N),X,Now,M,Li).
+
+mham_loop(0).
+mham_loop(X) :- \+ \+ mham_top, Y is X - 1, mham_loop(Y).
+
+mham_top:-
+ cycle_ham([a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t],X),
+ fail.
+mham_top.
+
+cycle_ham([X|Y],[X,T|L]):-
+ chain_ham([X|Y],[],[T|L]),
+ edge(T,X).
+
+chain_ham([X],L,[X|L]).
+chain_ham([X|Y],K,L):-
+ delete(Z,Y,T),
+ edge(X,Z),
+ chain_ham([Z|T],[X|K],L).
+
+delete(X,[X|Y],Y).
+delete(X,[U|Y],[U|Z]):-
+ delete(X,Y,Z).
+
+edge(X,Y):-
+ connect(X,L),
+ el(Y,L).
+
+connect(0,[1,2,3,4,5,6,7,8,9]).
+connect(1,[0,2,3,4,5,6,7,8,9]).
+connect(2,[0,1,3,4,5,6,7,8,9]).
+connect(3,[0,1,2,4,5,6,7,8,9]).
+connect(4,[0,1,2,3,5,6,7,8,9]).
+connect(5,[0,1,2,3,4,6,7,8,9]).
+connect(6,[0,1,2,3,4,5,7,8,9]).
+connect(7,[0,1,2,3,4,5,6,8,9]).
+connect(8,[0,1,2,3,4,5,6,7,9]).
+connect(9,[0,1,2,3,4,5,6,7,8]).
+
+connect(a,[b,j,k]).
+connect(b,[a,c,p]).
+connect(c,[b,d,l]).
+connect(d,[c,e,q]).
+connect(e,[d,f,m]).
+connect(f,[e,g,r]).
+connect(g,[f,h,n]).
+connect(h,[i,g,s]).
+connect(i,[j,h,o]).
+connect(j,[a,i,t]).
+connect(k,[o,l,a]).
+connect(l,[k,m,c]).
+connect(m,[l,n,e]).
+connect(n,[m,o,g]).
+connect(o,[n,k,i]).
+connect(p,[b,q,t]).
+connect(q,[p,r,d]).
+connect(r,[q,s,f]).
+connect(s,[r,t,h]).
+connect(t,[p,s,j]).
+
+/* -------------------------------------------- */
+/* Hofstader's mu math (mutest) proving muiiu */
+/* from Godel Escher Bach */
+mutest(N) :- statistics(runtime,[X|_]),
+ mu_loop(N),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 1366 * N,
+ print_times(mutest(N),X,Now,M,Li).
+
+mu_loop(0).
+mu_loop(X) :- \+ \+ mu_top, Y is X - 1, mu_loop(Y).
+
+mu_top:- theorem(5,[m,u,i,i,u]).
+
+rules(S, R) :- rule3(S,R).
+rules(S, R) :- rule4(S,R).
+rules(S, R) :- rule1(S,R).
+rules(S, R) :- rule2(S,R).
+
+rule1(S,R) :-
+ append(X, [i], S),
+ append(X, [i,u], R).
+
+rule2([m | T], [m | R]) :- append(T, T, R).
+
+rule3([], -) :- fail.
+rule3(R, T) :-
+ append([i,i,i], S, R),
+ append([u], S, T).
+rule3([H | T], [H | R]) :- rule3(T, R).
+
+rule4([], -) :- fail.
+rule4(R, T) :- append([u, u], T, R).
+rule4([H | T], [H | R]) :- rule4(T, R).
+
+theorem(Depth, [m, i]).
+theorem(Depth, []) :- fail.
+
+theorem(Depth, R) :-
+ Depth > 0,
+ D is Depth - 1,
+ theorem(D, S),
+ rules(S, R).
+
+append([], X, X).
+append([A | B], X, [A | B1]) :-
+ !,
+ append(B, X, B1).
+/* ------------------------------------ */
+/* Quicksort of 50 element list */
+/* */
+
+qs(N) :- list50(L),
+ statistics(runtime,[X|_]),
+ qs_loop(N,L),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 601 * N,
+ print_times(qs(N),X,Now,M,Li).
+
+qs_loop(0,_).
+qs_loop(X,L) :- qsort(L,Z,[]), Y is X - 1,qs_loop(Y,L).
+
+qsort([X|L],R,R0) :-
+ partition(L,X,L1,L2),
+ qsort(L2,R1,R0),
+ qsort(L1,R,[X|R1]).
+qsort([],R,R).
+
+partition([X|L],Y,[X|L1],L2) :- X =< Y,!,
+ partition(L,Y,L1,L2).
+partition([X|L],Y,L1,[X|L2]) :-
+ partition(L,Y,L1,L2).
+partition([],_,[],[]).
+
+/* ------------------------------------ */
+/* Queens on a chess board problem... */
+/* Only two solution on a 4x4 board... */
+/* about 5 - 10 is advised for N. */
+qu(N) :- statistics(runtime,[X|_]),
+ qu_nloop(N),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 684 * N,
+ print_times(qu(N),X,Now,M,Li).
+
+qu_nloop(0).
+qu_nloop(X) :- qu_top, Y is X - 1, qu_nloop(Y).
+
+qu_top :- run(4,X), fail.
+qu_top.
+
+size(4).
+snint(1).
+snint(2).
+snint(3).
+snint(4).
+
+run(Size, Soln) :- get_solutions(Size, Soln).
+
+get_solutions(Board_size, Soln) :- solve(Board_size, [], Soln).
+
+/* newsquare generates legal positions for next queen */
+
+newsquare([], square(1, X)) :- snint(X).
+newsquare([square(I, J) | Rest], square(X, Y)) :-
+ X is I + 1,
+ snint(Y),
+ \+(threatened(I, J, X, Y)),
+ safe(X, Y, Rest).
+
+/* safe checks whether square(X, Y) is threatened by any */
+/* existing queens */
+
+safe(X, Y, []).
+safe(X, Y, [square(I, J) | L]) :-
+ \+(threatened(I, J, X, Y)),
+ safe(X, Y, L).
+
+/* threatened checks whether squares (I, J) and (X, Y) */
+/* threaten each other */
+
+threatened(I, J, X, Y) :-
+ (I = X),
+ !.
+threatened(I, J, X, Y) :-
+ (J = Y),
+ !.
+threatened(I, J, X, Y) :-
+ (U is I - J),
+ (V is X - Y),
+ (U = V),
+ !.
+threatened(I, J, X, Y) :-
+ (U is I + J),
+ (V is X + Y),
+ (U = V),
+ !.
+
+/* solve accumulates the positions of occupied squares */
+
+solve(Bs, [square(Bs, Y) | L], [square(Bs, Y) | L]) :- size(Bs).
+solve(Board_size, Initial, Final) :-
+ newsquare(Initial, Next),
+ solve(Board_size, [Next | Initial], Final).
+
+/* ------------------------------------ */
+/* Query does simple database queries. */
+/* */
+
+query(N) :- statistics(runtime,[X|_]),
+ que_nloop(N),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 2294 * N,
+ print_times(query(N),X,Now,M,Li).
+
+que_nloop(0).
+que_nloop(X) :- que_top, Y is X - 1, que_nloop(Y).
+
+que_top:- que(X), fail.
+que_top.
+
+que([C1,D1,C2,D2]) :-
+ density(C1,D1),
+ density(C2,D2),
+ D1>D2,
+ 20*D1<21*D2.
+
+density(C,D) :-
+ pop(C,P),
+ area(C,A),
+ D is (P*100)/A.
+
+pop(china,8250).
+pop(india,5863).
+pop(ussr,2521).
+pop(usa,2119).
+pop(indonesia,1276).
+pop(japan,1097).
+pop(brazil,1042).
+pop(bangladesh,750).
+pop(pakistan,682).
+pop(w_germany,620).
+pop(nigeria,613).
+pop(mexico,581).
+pop(uk,559).
+pop(italy,554).
+pop(france,525).
+pop(philippines,415).
+pop(thailand,410).
+pop(turkey,383).
+pop(egypt,364).
+pop(spain,352).
+pop(poland,337).
+pop(s_korea,335).
+pop(iran,320).
+pop(ethiopia,272).
+pop(argentina,251).
+
+area(china,3380).
+area(india,1139).
+area(ussr,8708).
+area(usa,3609).
+area(indonesia,570).
+area(japan,148).
+area(brazil,3288).
+area(bangladesh,55).
+area(pakistan,311).
+area(w_germany,96).
+area(nigeria,373).
+area(mexico,764).
+area(uk,86).
+area(italy,116).
+area(france,213).
+area(philippines,90).
+area(thailand,200).
+area(turkey,296).
+area(egypt,386).
+area(spain,190).
+area(poland,121).
+area(s_korea,37).
+area(iran,628).
+area(ethiopia,350).
+area(argentina,1080).
+
+/* --------------------------------------------------*/
+/* differen (times10,divide10,log10,ops8) */
+/* These 4 examples are from Warren's thesis */
+/* differen(150) will do. */
+
+differen(N) :- statistics(runtime,[X|_]),
+ differenloop(N),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 71 * N,
+ print_times(differen(N),X,Now,M,Li).
+
+differenloop(0).
+differenloop(X) :- \+ \+(differen_top), Y is X - 1, differenloop(Y).
+
+differen_top:-
+ times10(I1),
+ d(I1,x,D1),
+ divide10(I2),
+ d(I2,x,D2),
+ log10(I3),
+ d(I3,x,D3),
+ ops8(I4),
+ d(I4,x,D4).
+
+d(U+V,X,DU+DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U-V,X,DU-DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U*V,X,DU*V+U*DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, d(U,X,DU), d(V,X,DV).
+d(^(U,N),X,DU*N*(^(U,N1))) :- !, integer(N), N1 is N - 1, d(U,X,DU).
+d(-U,X,-DU) :- !, d(U,X,DU).
+d(exp(U),X,exp(U)*DU) :- !, d(U,X,DU).
+d(log(U),X,DU/U) :- !, d(U,X,DU).
+d(X,X,1).
+d(C,X,0).
+
+times10( ((((((((x*x)*x)*x)*x)*x)*x)*x)*x)*x ).
+divide10( ((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x ).
+log10( log(log(log(log(log(log(log(log(log(log(x)))))))))) ).
+ops8( (x+1)*((^(x,2)+2)*(^(x,3)+3)) ).
+
+/* --------------------------------------------------- */
+/* Difference Lists */
+/* quicksort on 50 items (difference lists) */
+
+diff(N) :- list50(L),
+ statistics(runtime,[X|_]),
+ difflistloop(N,L),
+ statistics(runtime,[Now|_]),
+ compens_loop(N),
+ statistics(runtime,[M|_]),
+ Li is 608 * N,
+ print_times(diff(N),X,Now,M,Li).
+
+difflistloop(0,_).
+difflistloop(X,L) :- qdsort(L,Z), Y is X - 1, difflistloop(Y,L).
+
+qdsort([X|L],R-R0) :-
+ dpartition(L,X,L1,L2),
+ qdsort(L1,R-[X|R1]),
+ qdsort(L2,R1-R0).
+qdsort([],R0-R0).
+
+dpartition([X|L],Y,[X|L1],L2) :-
+ X<Y, !,
+ dpartition(L,Y,L1,L2).
+dpartition([X|L],Y,L1,[X|L2]) :-
+ dpartition(L,Y,L1,L2).
+dpartition([],_,[],[]).
+
+/* -------------------------------------------------- */
+/* Naive reverse for variable length lists... */
+/* try with 10, 30, 50, 100, 150, 200. */
+
+nrev(X) :-
+ conslist(X, List),
+ statistics(runtime,[T1|_]),
+ nreverse(List, _),
+ statistics(runtime,[T2|_]),
+ I is (X*(X+3))/2 + 1,
+ print_times(nrev(X),T1,T2,T2,I).
+
+nrev:- write('list length: '),
+ read(X),
+ conslist(X, List),
+ statistics(runtime,[T1|_]),
+ nreverse(List, _),
+ statistics(runtime,[T2|_]),
+ T is T2 - T1,
+ I is (X*(X+3))/2 + 1,
+ LIPS is I/T,
+ write('LIPS= '),
+ write(LIPS).
+
+nreverse([], []).
+nreverse([X|L0],L) :- nreverse(L0, L1),
+ concatenate(L1, [X], L).
+
+concatenate([], L, L).
+concatenate([X|L1], L2, [X|L3]) :- concatenate(L1, L2, L3).
+
+conslist(0, []) :- !.
+conslist(N, [N|L]) :-
+ N1 is N-1,
+ conslist(N1, L).
diff --git a/examples/benchmarks/holmer/Makefile b/examples/benchmarks/holmer/Makefile
new file mode 100644
index 0000000..8f865b4
--- /dev/null
+++ b/examples/benchmarks/holmer/Makefile
@@ -0,0 +1,98 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS =
+
+PLJAR = pljar
+PLJAROPTS = -v
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar:bench_util.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+# /bin/echo "[$*], qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/holmer/README b/examples/benchmarks/holmer/README
new file mode 100644
index 0000000..e3dc3c7
--- /dev/null
+++ b/examples/benchmarks/holmer/README
@@ -0,0 +1,48 @@
+
+This package contains the benchmarks that were used in the papers:
+
+ "Fast Prolog with an Extended General Purpose Architecture", by Bruce Holmer
+ et al (holmer@ernie.berkeley.edu), 17th International Symposium on Computer
+ Architecture, May 1990.
+
+ "The Benefits of Global Dataflow Analysis for an Optimizing Prolog Compiler",
+ by Peter Van Roy (vanroy@ernie.berkeley.edu) and Alvin Despain, 1990 North
+ American Conference on Logic Programming, October 1990.
+
+The package contains 26 programs, grouped into "small" and "large". All
+program sizes are in lines of code excluding comments. The programs have been
+run on Quintus Prolog, C-Prolog, and Aquarius Prolog, a new system under
+development at Berkeley. The programs are to be run as is, with all built-in
+predicates *including* write/1 and nl/0.
+
+Small Program Size Description
+
+nreverse.pl 10 Naive reverse of a 30-element list.
+tak.pl 15 Recursive integer arithmetic.
+qsort.pl 19 Quicksort of a 50-element list.
+log10.pl 27 Symbolic differentiation.
+ops8.pl 27 Symbolic differentiation.
+times10.pl 27 Symbolic differentiation.
+divide10.pl 27 Symbolic differentiation.
+serialise.pl 29 Calculate serial numbers of a list.
+queens_8.pl 31 Solve the eight queens puzzle.
+mu.pl 33 Prove a theorem of Hofstadter's "mu-math".
+zebra.pl 36 A logical puzzle based on constraints.
+fast_mu.pl 54 An optimized version of the mu-math prover.
+query.pl 68 Query a static database (using integer arithmetic).
+poly_10.pl 86 Symbolically raise a polynomial to the tenth power.
+
+Large Program Size Description
+
+crypt.pl 64 Solve a simple cryptarithmetic puzzle.
+meta_qsort.pl 74 A meta-interpreter running qsort.
+prover.pl 81 A simple theorem prover.
+browse.pl 92 Build and query a database.
+unify.pl 125 A compiler code generator for unification.
+flatten.pl 158 Source transformation to remove disjunctions.
+sdda.pl 273 A dataflow analyzer that represents aliasing.
+reducer.pl 301 A graph reducer based on combinators.
+boyer.pl 377 An extract from a Boyer-Moore theorem prover.
+simple_analyzer.pl 443 A dataflow analyzer analyzing qsort.
+nand.pl 493 A logic synthesis program based on heuristic search.
+chat_parser.pl 1138 Parse a set of English sentences.
diff --git a/examples/benchmarks/holmer/bench_util.pl b/examples/benchmarks/holmer/bench_util.pl
new file mode 100644
index 0000000..a490962
--- /dev/null
+++ b/examples/benchmarks/holmer/bench_util.pl
@@ -0,0 +1,47 @@
+% File : bench_util.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 24 February 2008
+% Purpose: Benchmark utilities
+% Note : based on driver.pl in Pereira's benchmark
+
+'$get_cpu_time'(T) :- statistics(runtime, [T,_]).
+
+'$report'(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ '$report_csv'(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+'$report_csv'([], _) :- !.
+'$report_csv'([X], _) :- !, write(X), nl.
+'$report_csv'([X|Xs], Delim) :- write(X), write(Delim), '$report_csv'(Xs, Delim).
+
+'$benchmark'(Name, Iterations, Action, Control) :-
+ '$get_cpu_time'(T0),
+ ( '$repeat'(Iterations), once(Action), fail
+ ; '$get_cpu_time'(T1)
+ ),
+ ( '$repeat'(Iterations), once(Control), fail
+ ; '$get_cpu_time'(T2)
+ ),
+ '$report'(Name, Iterations, T0, T1, T2).
+
+'$repeat'(N) :- N > 0, '$from'(1, N).
+
+'$from'(I, I) :- !.
+'$from'(L, U) :- M is (L+U)>>1, '$from'(L, M).
+'$from'(L, U) :- M is (L+U)>>1+1, '$from'(M, U).
+
+'$dummy'.
+'$dummy'(_).
+'$dummy'(_, _).
+'$dummy'(_, _, _).
diff --git a/examples/benchmarks/holmer/boyer.in b/examples/benchmarks/holmer/boyer.in
new file mode 100644
index 0000000..e80a017
--- /dev/null
+++ b/examples/benchmarks/holmer/boyer.in
@@ -0,0 +1 @@
+:- '$benchmark'(boyer, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/boyer.pl b/examples/benchmarks/holmer/boyer.pl
new file mode 100644
index 0000000..8fc0fec
--- /dev/null
+++ b/examples/benchmarks/holmer/boyer.pl
@@ -0,0 +1,391 @@
+/* CHANGELOG by M.Banbara
+ - rename plus/3 to my_plus/3
+*/
+
+% generated: 20 November 1989
+% option(s):
+%
+% boyer
+%
+% Evan Tick (from Lisp version by R. P. Gabriel)
+%
+% November 1985
+%
+% prove arithmetic theorem
+
+main :- wff(Wff),
+ rewrite(Wff,NewWff),
+ tautology(NewWff,[],[]).
+
+wff(implies(and(implies(X,Y),
+ and(implies(Y,Z),
+ and(implies(Z,U),
+ implies(U,W)))),
+ implies(X,W))) :-
+ X = f(plus(plus(a,b),plus(c,zero))),
+ Y = f(times(times(a,b),plus(c,d))),
+ Z = f(reverse(append(append(a,b),[]))),
+ U = equal(plus(a,b),difference(x,y)),
+ W = lessp(remainder(a,b),member(a,length(b))).
+
+tautology(Wff) :-
+ write('rewriting...'),nl,
+ rewrite(Wff,NewWff),
+ write('proving...'),nl,
+ tautology(NewWff,[],[]).
+
+tautology(Wff,Tlist,Flist) :-
+ (truep(Wff,Tlist) -> true
+ ;falsep(Wff,Flist) -> fail
+ ;Wff = if(If,Then,Else) ->
+ (truep(If,Tlist) -> tautology(Then,Tlist,Flist)
+ ;falsep(If,Flist) -> tautology(Else,Tlist,Flist)
+ ;tautology(Then,[If|Tlist],Flist), % both must hold
+ tautology(Else,Tlist,[If|Flist])
+ )
+ ),!.
+
+rewrite(Atom,Atom) :-
+ atomic(Atom),!.
+rewrite(Old,New) :-
+ functor(Old,F,N),
+ functor(Mid,F,N),
+ rewrite_args(N,Old,Mid),
+ ( equal(Mid,Next), % should be ->, but is compiler smart
+ rewrite(Next,New) % enough to generate cut for -> ?
+ ; New=Mid
+ ),!.
+
+rewrite_args(0,_,_) :- !.
+rewrite_args(N,Old,Mid) :-
+ arg(N,Old,OldArg),
+ arg(N,Mid,MidArg),
+ rewrite(OldArg,MidArg),
+ N1 is N-1,
+ rewrite_args(N1,Old,Mid).
+
+truep(t,_) :- !.
+truep(Wff,Tlist) :- member(Wff,Tlist).
+
+falsep(f,_) :- !.
+falsep(Wff,Flist) :- member(Wff,Flist).
+
+member(X,[X|_]) :- !.
+member(X,[_|T]) :- member(X,T).
+
+
+equal( and(P,Q),
+ if(P,if(Q,t,f),f)
+ ).
+equal( append(append(X,Y),Z),
+ append(X,append(Y,Z))
+ ).
+equal( assignment(X,append(A,B)),
+ if(assignedp(X,A),
+ assignment(X,A),
+ assignment(X,B))
+ ).
+equal( assume_false(Var,Alist),
+ cons(cons(Var,f),Alist)
+ ).
+equal( assume_true(Var,Alist),
+ cons(cons(Var,t),Alist)
+ ).
+equal( boolean(X),
+ or(equal(X,t),equal(X,f))
+ ).
+equal( car(gopher(X)),
+ if(listp(X),
+ car(flatten(X)),
+ zero)
+ ).
+equal( compile(Form),
+ reverse(codegen(optimize(Form),[]))
+ ).
+equal( count_list(Z,sort_lp(X,Y)),
+ plus(count_list(Z,X),
+ count_list(Z,Y))
+ ).
+equal( countps_(L,Pred),
+ countps_loop(L,Pred,zero)
+ ).
+equal( difference(A,B),
+ C
+ ) :- difference(A,B,C).
+equal( divides(X,Y),
+ zerop(remainder(Y,X))
+ ).
+equal( dsort(X),
+ sort2(X)
+ ).
+equal( eqp(X,Y),
+ equal(fix(X),fix(Y))
+ ).
+equal( equal(A,B),
+ C
+ ) :- eq(A,B,C).
+equal( even1(X),
+ if(zerop(X),t,odd(decr(X)))
+ ).
+equal( exec(append(X,Y),Pds,Envrn),
+ exec(Y,exec(X,Pds,Envrn),Envrn)
+ ).
+equal( exp(A,B),
+ C
+ ) :- exp(A,B,C).
+equal( fact_(I),
+ fact_loop(I,1)
+ ).
+equal( falsify(X),
+ falsify1(normalize(X),[])
+ ).
+equal( fix(X),
+ if(numberp(X),X,zero)
+ ).
+equal( flatten(cdr(gopher(X))),
+ if(listp(X),
+ cdr(flatten(X)),
+ cons(zero,[]))
+ ).
+equal( gcd(A,B),
+ C
+ ) :- gcd(A,B,C).
+equal( get(J,set(I,Val,Mem)),
+ if(eqp(J,I),Val,get(J,Mem))
+ ).
+equal( greatereqp(X,Y),
+ not(lessp(X,Y))
+ ).
+equal( greatereqpr(X,Y),
+ not(lessp(X,Y))
+ ).
+equal( greaterp(X,Y),
+ lessp(Y,X)
+ ).
+equal( if(if(A,B,C),D,E),
+ if(A,if(B,D,E),if(C,D,E))
+ ).
+equal( iff(X,Y),
+ and(implies(X,Y),implies(Y,X))
+ ).
+equal( implies(P,Q),
+ if(P,if(Q,t,f),t)
+ ).
+equal( last(append(A,B)),
+ if(listp(B),
+ last(B),
+ if(listp(A),
+ cons(car(last(A))),
+ B))
+ ).
+equal( length(A),
+ B
+ ) :- mylength(A,B).
+equal( lesseqp(X,Y),
+ not(lessp(Y,X))
+ ).
+equal( lessp(A,B),
+ C
+ ) :- lessp(A,B,C).
+equal( listp(gopher(X)),
+ listp(X)
+ ).
+equal( mc_flatten(X,Y),
+ append(flatten(X),Y)
+ ).
+equal( meaning(A,B),
+ C
+ ) :- meaning(A,B,C).
+equal( member(A,B),
+ C
+ ) :- mymember(A,B,C).
+equal( not(P),
+ if(P,f,t)
+ ).
+equal( nth(A,B),
+ C
+ ) :- nth(A,B,C).
+equal( numberp(greatest_factor(X,Y)),
+ not(and(or(zerop(Y),equal(Y,1)),
+ not(numberp(X))))
+ ).
+equal( or(P,Q),
+ if(P,t,if(Q,t,f),f)
+ ).
+equal( plus(A,B),
+ C
+ ) :- my_plus(A,B,C).
+equal( power_eval(A,B),
+ C
+ ) :- power_eval(A,B,C).
+equal( prime(X),
+ and(not(zerop(X)),
+ and(not(equal(X,add1(zero))),
+ prime1(X,decr(X))))
+ ).
+equal( prime_list(append(X,Y)),
+ and(prime_list(X),prime_list(Y))
+ ).
+equal( quotient(A,B),
+ C
+ ) :- quotient(A,B,C).
+equal( remainder(A,B),
+ C
+ ) :- remainder(A,B,C).
+equal( reverse_(X),
+ reverse_loop(X,[])
+ ).
+equal( reverse(append(A,B)),
+ append(reverse(B),reverse(A))
+ ).
+equal( reverse_loop(A,B),
+ C
+ ) :- reverse_loop(A,B,C).
+equal( samefringe(X,Y),
+ equal(flatten(X),flatten(Y))
+ ).
+equal( sigma(zero,I),
+ quotient(times(I,add1(I)),2)
+ ).
+equal( sort2(delete(X,L)),
+ delete(X,sort2(L))
+ ).
+equal( tautology_checker(X),
+ tautologyp(normalize(X),[])
+ ).
+equal( times(A,B),
+ C
+ ) :- times(A,B,C).
+equal( times_list(append(X,Y)),
+ times(times_list(X),times_list(Y))
+ ).
+equal( value(normalize(X),A),
+ value(X,A)
+ ).
+equal( zerop(X),
+ or(equal(X,zero),not(numberp(X)))
+ ).
+
+difference(X, X, zero) :- !.
+difference(plus(X,Y), X, fix(Y)) :- !.
+difference(plus(Y,X), X, fix(Y)) :- !.
+difference(plus(X,Y), plus(X,Z), difference(Y,Z)) :- !.
+difference(plus(B,plus(A,C)), A, plus(B,C)) :- !.
+difference(add1(plus(Y,Z)), Z, add1(Y)) :- !.
+difference(add1(add1(X)), 2, fix(X)).
+
+eq(plus(A,B), zero, and(zerop(A),zerop(B))) :- !.
+eq(plus(A,B), plus(A,C), equal(fix(B),fix(C))) :- !.
+eq(zero, difference(X,Y),not(lessp(Y,X))) :- !.
+eq(X, difference(X,Y),and(numberp(X),
+ and(or(equal(X,zero),
+ zerop(Y))))) :- !.
+eq(times(X,Y), zero, or(zerop(X),zerop(Y))) :- !.
+eq(append(A,B), append(A,C), equal(B,C)) :- !.
+eq(flatten(X), cons(Y,[]), and(nlistp(X),equal(X,Y))) :- !.
+eq(greatest_factor(X,Y),zero, and(or(zerop(Y),equal(Y,1)),
+ equal(X,zero))) :- !.
+eq(greatest_factor(X,_),1, equal(X,1)) :- !.
+eq(Z, times(W,Z), and(numberp(Z),
+ or(equal(Z,zero),
+ equal(W,1)))) :- !.
+eq(X, times(X,Y), or(equal(X,zero),
+ and(numberp(X),equal(Y,1)))) :- !.
+eq(times(A,B), 1, and(not(equal(A,zero)),
+ and(not(equal(B,zero)),
+ and(numberp(A),
+ and(numberp(B),
+ and(equal(decr(A),zero),
+ equal(decr(B),zero))))))) :- !.
+eq(difference(X,Y), difference(Z,Y),if(lessp(X,Y),
+ not(lessp(Y,Z)),
+ if(lessp(Z,Y),
+ not(lessp(Y,X)),
+ equal(fix(X),fix(Z))))) :- !.
+eq(lessp(X,Y), Z, if(lessp(X,Y),
+ equal(t,Z),
+ equal(f,Z))).
+
+exp(I, plus(J,K), times(exp(I,J),exp(I,K))) :- !.
+exp(I, times(J,K), exp(exp(I,J),K)).
+
+gcd(X, Y, gcd(Y,X)) :- !.
+gcd(times(X,Z), times(Y,Z), times(Z,gcd(X,Y))).
+
+mylength(reverse(X),length(X)).
+mylength(cons(_,cons(_,cons(_,cons(_,cons(_,cons(_,X7)))))),
+ plus(6,length(X7))).
+
+lessp(remainder(_,Y), Y, not(zerop(Y))) :- !.
+lessp(quotient(I,J), I, and(not(zerop(I)),
+ or(zerop(J),
+ not(equal(J,1))))) :- !.
+lessp(remainder(X,Y), X, and(not(zerop(Y)),
+ and(not(zerop(X)),
+ not(lessp(X,Y))))) :- !.
+lessp(plus(X,Y), plus(X,Z), lessp(Y,Z)) :- !.
+lessp(times(X,Z), times(Y,Z), and(not(zerop(Z)),
+ lessp(X,Y))) :- !.
+lessp(Y, plus(X,Y), not(zerop(X))) :- !.
+lessp(length(delete(X,L)), length(L), member(X,L)).
+
+meaning(plus_tree(append(X,Y)),A,
+ plus(meaning(plus_tree(X),A),
+ meaning(plus_tree(Y),A))) :- !.
+meaning(plus_tree(plus_fringe(X)),A,
+ fix(meaning(X,A))) :- !.
+meaning(plus_tree(delete(X,Y)),A,
+ if(member(X,Y),
+ difference(meaning(plus_tree(Y),A),
+ meaning(X,A)),
+ meaning(plus_tree(Y),A))).
+
+mymember(X,append(A,B),or(member(X,A),member(X,B))) :- !.
+mymember(X,reverse(Y),member(X,Y)) :- !.
+mymember(A,intersect(B,C),and(member(A,B),member(A,C))).
+
+nth(zero,_,zero).
+nth([],I,if(zerop(I),[],zero)).
+nth(append(A,B),I,append(nth(A,I),nth(B,difference(I,length(A))))).
+
+my_plus(plus(X,Y),Z,
+ plus(X,plus(Y,Z))) :- !.
+my_plus(remainder(X,Y),
+ times(Y,quotient(X,Y)),
+ fix(X)) :- !.
+my_plus(X,add1(Y),
+ if(numberp(Y),
+ add1(plus(X,Y)),
+ add1(X))).
+
+power_eval(big_plus1(L,I,Base),Base,
+ plus(power_eval(L,Base),I)) :- !.
+power_eval(power_rep(I,Base),Base,
+ fix(I)) :- !.
+power_eval(big_plus(X,Y,I,Base),Base,
+ plus(I,plus(power_eval(X,Base),
+ power_eval(Y,Base)))) :- !.
+power_eval(big_plus(power_rep(I,Base),
+ power_rep(J,Base),
+ zero,
+ Base),
+ Base,
+ plus(I,J)).
+
+quotient(plus(X,plus(X,Y)),2,plus(X,quotient(Y,2))).
+quotient(times(Y,X),Y,if(zerop(Y),zero,fix(X))).
+
+remainder(_, 1,zero) :- !.
+remainder(X, X,zero) :- !.
+remainder(times(_,Z),Z,zero) :- !.
+remainder(times(Y,_),Y,zero).
+
+reverse_loop(X,Y, append(reverse(X),Y)) :- !.
+reverse_loop(X,[], reverse(X) ).
+
+times(X, plus(Y,Z), plus(times(X,Y),times(X,Z)) ) :- !.
+times(times(X,Y),Z, times(X,times(Y,Z)) ) :- !.
+times(X, difference(C,W),difference(times(C,X),times(W,X))) :- !.
+times(X, add1(Y), if(numberp(Y),
+ plus(X,times(X,Y)),
+ fix(X)) ).
diff --git a/examples/benchmarks/holmer/browse.in b/examples/benchmarks/holmer/browse.in
new file mode 100644
index 0000000..4c246cd
--- /dev/null
+++ b/examples/benchmarks/holmer/browse.in
@@ -0,0 +1 @@
+:- '$benchmark'(browse, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/browse.pl b/examples/benchmarks/holmer/browse.pl
new file mode 100644
index 0000000..b361b98
--- /dev/null
+++ b/examples/benchmarks/holmer/browse.pl
@@ -0,0 +1,100 @@
+% generated: 19 June 1990
+% option(s):
+%
+% browse
+%
+% Tep Dobry (from Lisp version by R. P. Gabriel)
+%
+% (modified January 1987 by Herve' Touati)
+
+main :-
+ init(100,10,4,
+ [[a,a,a,b,b,b,b,a,a,a,a,a,b,b,a,a,a],
+ [a,a,b,b,b,b,a,a,[a,a],[b,b]],
+ [a,a,a,b,[b,a],b,a,b,a]
+ ],
+ Symbols),
+ randomize(Symbols,RSymbols,21),!,
+ investigate(RSymbols,
+ [[star(SA),B,star(SB),B,a,star(SA),a,star(SB),star(SA)],
+ [star(SA),star(SB),star(SB),star(SA),[star(SA)],[star(SB)]],
+ [_,_,star(_),[b,a],star(_),_,_]
+ ]).
+
+
+init(N,M,Npats,Ipats,Result) :- init(N,M,M,Npats,Ipats,Result).
+
+init(0,_,_,_,_,_) :- !.
+init(N,I,M,Npats,Ipats,[Symb|Rest]) :-
+ fill(I,[],L),
+ get_pats(Npats,Ipats,Ppats),
+ J is M - I,
+ fill(J,[pattern(Ppats)|L],Symb),
+ N1 is N - 1,
+ (I =:= 0 -> I1 is M; I1 is I - 1),
+ init(N1,I1,M,Npats,Ipats,Rest).
+
+fill(0,L,L) :- !.
+fill(N,L,[dummy([])|Rest]) :-
+ N1 is N - 1,
+ fill(N1,L,Rest).
+
+randomize([],[],_) :- !.
+randomize(In,[X|Out],Rand) :-
+ length(In,Lin),
+ Rand1 is (Rand * 17) mod 251,
+ N is Rand1 mod Lin,
+ split(N,In,X,In1),
+ randomize(In1,Out,Rand1).
+
+split(0,[X|Xs],X,Xs) :- !.
+split(N,[X|Xs],RemovedElt,[X|Ys]) :-
+ N1 is N - 1,
+ split(N1,Xs,RemovedElt,Ys).
+
+investigate([],_) :- !.
+investigate([U|Units],Patterns) :-
+ property(U,pattern,Data),
+ p_investigate(Data,Patterns),
+ investigate(Units,Patterns).
+
+get_pats(Npats,Ipats,Result) :- get_pats(Npats,Ipats,Result,Ipats).
+
+get_pats(0,_,[],_) :- !.
+get_pats(N,[X|Xs],[X|Ys],Ipats) :-
+ N1 is N - 1,
+ get_pats(N1,Xs,Ys,Ipats).
+get_pats(N,[],Ys,Ipats) :-
+ get_pats(N,Ipats,Ys,Ipats).
+
+property([],_,_) :- fail. /* don't really need this */
+property([Prop|_],P,Val) :-
+ functor(Prop,P,_),!,
+ arg(1,Prop,Val).
+property([_|RProps],P,Val) :-
+ property(RProps,P,Val).
+
+p_investigate([],_).
+p_investigate([D|Data],Patterns) :-
+ p_match(Patterns,D),
+ p_investigate(Data,Patterns).
+
+p_match([],_).
+p_match([P|Patterns],D) :-
+ (match(D,P),fail; true),
+ p_match(Patterns,D).
+
+match([],[]) :- !.
+match([X|PRest],[Y|SRest]) :-
+ var(Y),!,X = Y,
+ match(PRest,SRest).
+match(List,[Y|Rest]) :-
+ nonvar(Y),Y = star(X),!,
+ concat(X,SRest,List),
+ match(SRest,Rest).
+match([X|PRest],[Y|SRest]) :-
+ (atom(X) -> X = Y; match(X,Y)),
+ match(PRest,SRest).
+
+concat([],L,L).
+concat([X|L1],L2,[X|L3]) :- concat(L1,L2,L3).
diff --git a/examples/benchmarks/holmer/chat_parser.in b/examples/benchmarks/holmer/chat_parser.in
new file mode 100644
index 0000000..eb364c9
--- /dev/null
+++ b/examples/benchmarks/holmer/chat_parser.in
@@ -0,0 +1 @@
+:- '$benchmark'(chat_parser, 1000, chat_parser, '$dummy').
diff --git a/examples/benchmarks/holmer/chat_parser.pl b/examples/benchmarks/holmer/chat_parser.pl
new file mode 100644
index 0000000..5ce4fe0
--- /dev/null
+++ b/examples/benchmarks/holmer/chat_parser.pl
@@ -0,0 +1,1180 @@
+/* CHANGELOG by M.Banbara
+ - rename open/4 to my_open/4
+ - rename string/1 to my_string/1
+ - rename trace/1 to my_trace/1
+ - rename trace/2 to my_trace/2
+*/
+
+
+% generated: 19 November 1989
+% option(s):
+%
+% chat_parser
+%
+% Fernando C. N. Pereira and David H. D. Warren
+
+chat_parser :- my_string(X),
+ determinate_say(X,_),
+ fail.
+chat_parser.
+
+
+% query set
+
+my_string([what,rivers,are,there,?]).
+my_string([does,afghanistan,border,china,?]).
+my_string([what,is,the,capital,of,upper_volta,?]).
+my_string([where,is,the,largest,country,?]).
+my_string([which,country,'`',s,capital,is,london,?]).
+my_string([which,countries,are,european,?]).
+my_string([how,large,is,the,smallest,american,country,?]).
+my_string([what,is,the,ocean,that,borders,african,countries,
+ and,that,borders,asian,countries,?]).
+my_string([what,are,the,capitals,of,the,countries,bordering,the,baltic,?]).
+my_string([which,countries,are,bordered,by,two,seas,?]).
+my_string([how,many,countries,does,the,danube,flow,through,?]).
+my_string([what,is,the,total,area,of,countries,south,of,the,equator,
+ and,not,in,australasia,?]).
+my_string([what,is,the,average,area,of,the,countries,in,each,continent,?]).
+my_string([is,there,more,than,one,country,in,each,continent,?]).
+my_string([is,there,some,ocean,that,does,not,border,any,country,?]).
+my_string([what,are,the,countries,from,which,a,river,flows,
+ into,the,black_sea,?]).
+
+
+% determinate_say
+
+determinate_say(X,Y) :-
+ say(X,Y), !.
+
+
+%-----------------------------------------------------------------------------
+%
+% xgrun
+%
+%-----------------------------------------------------------------------------
+
+terminal(T,S,S,x(_,terminal,T,X),X).
+terminal(T,[T|S],S,X,X) :-
+ gap(X).
+
+gap(x(gap,_,_,_)).
+gap([]).
+
+virtual(NT,x(_,nonterminal,NT,X),X).
+
+
+%----------------------------------------------------------------------------
+%
+% clotab
+%
+%----------------------------------------------------------------------------
+
+% normal form masks
+
+is_pp(#(1,_,_,_)).
+
+is_pred(#(_,1,_,_)).
+
+is_trace(#(_,_,1,_)).
+
+is_adv(#(_,_,_,1)).
+
+my_trace(#(_,_,1,_),#(0,0,0,0)).
+
+my_trace(#(0,0,1,0)).
+
+adv(#(0,0,0,1)).
+
+empty(#(0,0,0,0)).
+
+np_all(#(1,1,1,0)).
+
+s_all(#(1,0,1,1)).
+
+np_no_trace(#(1,1,0,0)).
+
+% mask operations
+
+myplus(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :-
+ or(B1,C1,D1),
+ or(B2,C2,D2),
+ or(B3,C3,D3),
+ or(B4,C4,D4).
+
+minus(#(B1,B2,B3,B4),#(C1,C2,C3,C4),#(D1,D2,D3,D4)) :-
+ anot(B1,C1,D1),
+ anot(B2,C2,D2),
+ anot(B3,C3,D3),
+ anot(B4,C4,D4).
+
+or(1,_,1).
+or(0,1,1).
+or(0,0,0).
+
+anot(X,0,X).
+anot(_X,1,0).
+
+% noun phrase position features
+
+role(subj,_,#(1,0,0)).
+role(compl,_,#(0,_,_)).
+role(undef,main,#(_,0,_)).
+role(undef,aux,#(0,_,_)).
+role(undef,decl,_).
+role(nil,_,_).
+
+subj_case(#(1,0,0)).
+verb_case(#(0,1,0)).
+prep_case(#(0,0,1)).
+compl_case(#(0,_,_)).
+
+
+%----------------------------------------------------------------------------
+%
+% newg
+%
+%----------------------------------------------------------------------------
+
+say(X,Y) :-
+ sentence(Y,X,[],[],[]).
+
+
+sentence(B,C,D,E,F) :-
+ declarative(B,C,G,E,H),
+ terminator(.,G,D,H,F).
+sentence(B,C,D,E,F) :-
+ wh_question(B,C,G,E,H),
+ terminator(?,G,D,H,F).
+sentence(B,C,D,E,F) :-
+ topic(C,G,E,H),
+ wh_question(B,G,I,H,J),
+ terminator(?,I,D,J,F).
+sentence(B,C,D,E,F) :-
+ yn_question(B,C,G,E,H),
+ terminator(?,G,D,H,F).
+sentence(B,C,D,E,F) :-
+ imperative(B,C,G,E,H),
+ terminator(!,G,D,H,F).
+
+
+pp(B,C,D,E,F,F,G,H) :-
+ virtual(pp(B,C,D,E),G,H).
+pp(pp(B,C),D,E,F,G,H,I,J) :-
+ prep(B,G,K,I,L),
+ prep_case(M),
+ np(C,_N,M,_O,D,E,F,K,H,L,J).
+
+
+topic(B,C,D,x(gap,nonterminal,pp(E,compl,F,G),H)) :-
+ pp(E,compl,F,G,B,I,D,J),
+ opt_comma(I,C,J,H).
+
+
+opt_comma(B,C,D,E) :-
+ `(',',B,C,D,E).
+opt_comma(B,B,C,C).
+
+
+declarative(decl(B),C,D,E,F) :-
+ s(B,_G,C,D,E,F).
+
+
+wh_question(whq(B,C),D,E,F,G) :-
+ variable_q(B,_H,I,J,D,K,F,L),
+ question(I,J,C,K,E,L,G).
+
+
+np(B,C,D,E,F,G,H,I,I,J,K) :-
+ virtual(np(B,C,D,E,F,G,H),J,K).
+np(np(B,C,[]),B,D,def,_E,F,G,H,I,J,K) :-
+ is_pp(F),
+ pers_pron(C,B,L,H,I,J,K),
+ empty(G),
+ role(L,decl,D).
+np(np(B,C,D),B,_E,F,G,H,I,J,K,L,M) :-
+ is_pp(H),
+ np_head(C,B,F+N,O,D,J,P,L,Q),
+ np_all(R),
+ np_compls(N,B,G,O,R,I,P,K,Q,M).
+np(part(B,C),3+D,_E,indef,F,G,H,I,J,K,L) :-
+ is_pp(G),
+ determiner(B,D,indef,I,M,K,N),
+ `(of,M,O,N,P),
+ s_all(Q),
+ prep_case(R),
+ np(C,3+plu,R,def,F,Q,H,O,J,P,L).
+
+
+variable_q(B,C,D,E,F,G,H,x(gap,nonterminal,np(I,C,E,_J,_K,L,M),N)) :-
+ whq(B,C,I,D,F,G,H,N),
+ my_trace(L,M).
+variable_q(B,C,compl,D,E,F,G,x(gap,nonterminal,pp(pp(H,I),compl,J,K),L)) :-
+ prep(H,E,M,G,N),
+ whq(B,C,I,_O,M,F,N,L),
+ my_trace(J,K),
+ compl_case(D).
+variable_q(B,C,compl,D,E,F,G,x(gap,nonterminal,
+ adv_phrase(pp(H,np(C,np_head(int_det(B),[],I),[])),J,K),L)) :-
+ context_pron(H,I,E,F,G,L),
+ my_trace(J,K),
+ verb_case(D).
+variable_q(B,_C,compl,D,E,F,G,
+ x(gap,nonterminal,predicate(adj,value(H,wh(B)),I),J)) :-
+ `(how,E,K,G,L),
+ adj(quant,H,K,F,L,J),
+ empty(I),
+ verb_case(D).
+
+
+adv_phrase(B,C,D,E,E,F,G) :-
+ virtual(adv_phrase(B,C,D),F,G).
+adv_phrase(pp(B,C),D,E,F,G,H,I) :-
+ loc_pred(B,F,J,H,K),
+ pp(pp(prep(of),C),compl,D,E,J,G,K,I).
+
+
+predicate(B,C,D,E,E,F,G) :-
+ virtual(predicate(B,C,D),F,G).
+predicate(_B,C,D,E,F,G,H) :-
+ adj_phrase(C,D,E,F,G,H).
+predicate(neg,B,C,D,E,F,G) :-
+ s_all(H),
+ pp(B,compl,H,C,D,E,F,G).
+predicate(_B,C,D,E,F,G,H) :-
+ s_all(I),
+ adv_phrase(C,I,D,E,F,G,H).
+
+
+whq(B,C,D,undef,E,F,G,H) :-
+ int_det(B,C,E,I,G,J),
+ s_all(K),
+ np(D,C,_L,_M,subj,K,_N,I,F,J,H).
+whq(B,3+C,np(3+C,wh(B),[]),D,E,F,G,H) :-
+ int_pron(D,E,F,G,H).
+
+
+int_det(B,3+C,D,E,F,G) :-
+ whose(B,C,D,E,F,G).
+int_det(B,3+C,D,E,F,G) :-
+ int_art(B,C,D,E,F,G).
+
+
+gen_marker(B,B,C,D) :-
+ virtual(gen_marker,C,D).
+gen_marker(B,C,D,E) :-
+ `('`',B,F,D,G),
+ an_s(F,C,G,E).
+
+
+whose(B,C,D,E,F,x(nogap,nonterminal,np_head0(wh(B),C,proper),
+ x(nogap,nonterminal,gen_marker,G))) :-
+ `(whose,D,E,F,G).
+
+
+question(B,C,D,E,F,G,H) :-
+ subj_question(B),
+ role(subj,_I,C),
+ s(D,_J,E,F,G,H).
+question(B,C,D,E,F,G,H) :-
+ fronted_verb(B,C,E,I,G,J),
+ s(D,_K,I,F,J,H).
+
+
+det(B,C,D,E,E,F,G) :-
+ virtual(det(B,C,D),F,G).
+det(det(B),C,D,E,F,G,H) :-
+ terminal(I,E,F,G,H),
+ det(I,C,B,D).
+det(generic,_B,generic,C,C,D,D).
+
+
+int_art(B,C,D,E,F,x(nogap,nonterminal,det(G,C,def),H)) :-
+ int_art(B,C,G,D,E,F,H).
+
+
+subj_question(subj).
+subj_question(undef).
+
+
+yn_question(q(B),C,D,E,F) :-
+ fronted_verb(nil,_G,C,H,E,I),
+ s(B,_J,H,D,I,F).
+
+
+verb_form(B,C,D,E,F,F,G,H) :-
+ virtual(verb_form(B,C,D,E),G,H).
+verb_form(B,C,D,_E,F,G,H,I) :-
+ terminal(J,F,G,H,I),
+ verb_form(J,B,C,D).
+
+
+neg(B,C,D,D,E,F) :-
+ virtual(neg(B,C),E,F).
+neg(aux+_B,neg,C,D,E,F) :-
+ `(not,C,D,E,F).
+neg(_B,pos,C,C,D,D).
+
+
+fronted_verb(B,C,D,E,F,x(gap,nonterminal,verb_form(G,H,I,J),
+ x(nogap,nonterminal,neg(_K,L),M))) :-
+ verb_form(G,H,I,_N,D,O,F,P),
+ verb_type(G,aux+_Q),
+ role(B,J,C),
+ neg(_R,L,O,E,P,M).
+
+
+imperative(imp(B),C,D,E,F) :-
+ imperative_verb(C,G,E,H),
+ s(B,_I,G,D,H,F).
+
+
+imperative_verb(B,C,D,x(nogap,terminal,you,x(nogap,nonterminal,
+ verb_form(E,imp+fin,2+sin,main),F))) :-
+ verb_form(E,inf,_G,_H,B,C,D,F).
+
+
+s(s(B,C,D,E),F,G,H,I,J) :-
+ subj(B,K,L,G,M,I,N),
+ verb(C,K,L,O,M,P,N,Q),
+ empty(R),
+ s_all(S),
+ verb_args(L,O,D,R,T,P,U,Q,V),
+ minus(S,T,W),
+ myplus(S,T,X),
+ verb_mods(E,W,X,F,U,H,V,J).
+
+
+subj(there,_B,_C+be,D,E,F,G) :-
+ `(there,D,E,F,G).
+subj(B,C,_D,E,F,G,H) :-
+ s_all(I),
+ subj_case(J),
+ np(B,C,J,_K,subj,I,_L,E,F,G,H).
+
+
+np_head(B,C,D,E,F,G,H,I,J) :-
+ np_head0(K,L,M,G,N,I,O),
+ possessive(K,L,M,P,P,B,C,D,E,F,N,H,O,J).
+
+
+np_head0(B,C,D,E,E,F,G) :-
+ virtual(np_head0(B,C,D),F,G).
+np_head0(name(B),3+sin,def+proper,C,D,E,F) :-
+ name(B,C,D,E,F).
+np_head0(np_head(B,C,D),3+E,F+common,G,H,I,J) :-
+ determiner(B,E,F,G,K,I,L),
+ adjs(C,K,M,L,N),
+ noun(D,E,M,H,N,J).
+np_head0(B,C,def+proper,D,E,F,x(nogap,nonterminal,gen_marker,G)) :-
+ poss_pron(B,C,D,E,F,G).
+np_head0(np_head(B,[],C),3+sin,indef+common,D,E,F,G) :-
+ quantifier_pron(B,C,D,E,F,G).
+
+
+np_compls(proper,_B,_C,[],_D,E,F,F,G,G) :-
+ empty(E).
+np_compls(common,B,C,D,E,F,G,H,I,J) :-
+ np_all(K),
+ np_mods(B,C,L,D,E,M,K,N,G,O,I,P),
+ relative(B,L,M,N,F,O,H,P,J).
+
+
+possessive(B,C,_D,[],E,F,G,H,I,J,K,L,M,N) :-
+ gen_case(K,O,M,P),
+ np_head0(Q,R,S,O,T,P,U),
+ possessive(Q,R,S,V,[pp(poss,np(C,B,E))|V],F,G,H,I,J,T,L,U,N).
+possessive(B,C,D,E,F,B,C,D,E,F,G,G,H,H).
+
+
+gen_case(B,C,D,x(nogap,terminal,the,E)) :-
+ gen_marker(B,C,D,E).
+
+
+an_s(B,C,D,E) :-
+ `(s,B,C,D,E).
+an_s(B,B,C,C).
+
+
+determiner(B,C,D,E,F,G,H) :-
+ det(B,C,D,E,F,G,H).
+determiner(B,C,D,E,F,G,H) :-
+ quant_phrase(B,C,D,E,F,G,H).
+
+
+quant_phrase(quant(B,C),D,E,F,G,H,I) :-
+ quant(B,E,F,J,H,K),
+ number(C,D,J,G,K,I).
+
+
+quant(B,indef,C,D,E,F) :-
+ neg_adv(G,B,C,H,E,I),
+ comp_adv(G,H,J,I,K),
+ `(than,J,D,K,F).
+quant(B,indef,C,D,E,F) :-
+ `(at,C,G,E,H),
+ sup_adv(I,G,D,H,F),
+ sup_op(I,B).
+quant(the,def,B,C,D,E) :-
+ `(the,B,C,D,E).
+quant(same,indef,B,B,C,C).
+
+
+neg_adv(B,not+B,C,D,E,F) :-
+ `(not,C,D,E,F).
+neg_adv(B,B,C,C,D,D).
+
+
+sup_op(least,not+less).
+sup_op(most,not+more).
+
+
+np_mods(B,C,D,[E|F],G,H,_I,J,K,L,M,N) :-
+ np_mod(B,C,E,G,O,K,P,M,Q),
+ my_trace(R),
+ myplus(R,O,S),
+ minus(G,S,T),
+ myplus(O,G,U),
+ np_mods(B,C,D,F,T,H,U,J,P,L,Q,N).
+np_mods(_B,_C,D,D,E,E,F,F,G,G,H,H).
+
+
+np_mod(_B,C,D,E,F,G,H,I,J) :-
+ pp(D,C,E,F,G,H,I,J).
+np_mod(B,_C,D,E,F,G,H,I,J) :-
+ reduced_relative(B,D,E,F,G,H,I,J).
+
+
+verb_mods([B|C],D,_E,F,G,H,I,J) :-
+ verb_mod(B,D,K,G,L,I,M),
+ my_trace(N),
+ myplus(N,K,O),
+ minus(D,O,P),
+ myplus(K,D,Q),
+ verb_mods(C,P,Q,F,L,H,M,J).
+verb_mods([],_B,C,C,D,D,E,E).
+
+
+verb_mod(B,C,D,E,F,G,H) :-
+ adv_phrase(B,C,D,E,F,G,H).
+verb_mod(B,C,D,E,F,G,H) :-
+ is_adv(C),
+ adverb(B,E,F,G,H),
+ empty(D).
+verb_mod(B,C,D,E,F,G,H) :-
+ pp(B,compl,C,D,E,F,G,H).
+
+
+adjs([B|C],D,E,F,G) :-
+ pre_adj(B,D,H,F,I),
+ adjs(C,H,E,I,G).
+adjs([],B,B,C,C).
+
+
+pre_adj(B,C,D,E,F) :-
+ adj(_G,B,C,D,E,F).
+pre_adj(B,C,D,E,F) :-
+ sup_phrase(B,C,D,E,F).
+
+
+sup_phrase(sup(most,B),C,D,E,F) :-
+ sup_adj(B,C,D,E,F).
+sup_phrase(sup(B,C),D,E,F,G) :-
+ sup_adv(B,D,I,F,J),
+ adj(quant,C,I,E,J,G).
+
+
+comp_phrase(comp(B,C,D),E,F,G,H,I) :-
+ comp(B,C,F,J,H,K),
+ np_no_trace(L),
+ prep_case(M),
+ np(D,_N,M,_O,compl,L,E,J,G,K,I).
+
+
+comp(B,C,D,E,F,G) :-
+ comp_adv(B,D,H,F,I),
+ adj(quant,C,H,J,I,K),
+ `(than,J,E,K,G).
+comp(more,B,C,D,E,F) :-
+ rel_adj(B,C,G,E,H),
+ `(than,G,D,H,F).
+comp(same,B,C,D,E,F) :-
+ `(as,C,G,E,H),
+ adj(quant,B,G,I,H,J),
+ `(as,I,D,J,F).
+
+
+relative(B,[C],D,_E,F,G,H,I,J) :-
+ is_pred(D),
+ rel_conj(B,_K,C,F,G,H,I,J).
+relative(_B,[],_C,D,D,E,E,F,F).
+
+
+rel_conj(B,C,D,E,F,G,H,I) :-
+ rel(B,J,K,F,L,H,M),
+ rel_rest(B,C,J,D,K,E,L,G,M,I).
+
+
+rel_rest(B,C,D,E,_F,G,H,I,J,K) :-
+ conj(C,L,D,M,E,H,N,J,O),
+ rel_conj(B,L,M,G,N,I,O,K).
+rel_rest(_B,_C,D,D,E,E,F,F,G,G).
+
+
+rel(B,rel(C,D),E,F,G,H,I) :-
+ my_open(F,J,H,K),
+ variable(B,C,J,L,K,M),
+ s(D,N,L,O,M,P),
+ my_trace(Q),
+ minus(N,Q,E),
+ close(O,G,P,I).
+
+
+variable(B,C,D,E,F,x(gap,nonterminal,np(np(B,wh(C),[]),B,_G,_H,_I,J,K),L)) :-
+ `(that,D,E,F,L),
+ my_trace(J,K).
+variable(B,C,D,E,F,x(gap,nonterminal,np(G,H,I,_J,_K,L,M),N)) :-
+ wh(C,B,G,H,I,D,E,F,N),
+ my_trace(L,M).
+variable(B,C,D,E,F,x(gap,nonterminal,pp(pp(G,H),compl,I,J),K)) :-
+ prep(G,D,L,F,M),
+ wh(C,B,H,_N,O,L,E,M,K),
+ my_trace(I,J),
+ compl_case(O).
+
+
+wh(B,C,np(C,wh(B),[]),C,D,E,F,G,H) :-
+ rel_pron(I,E,F,G,H),
+ role(I,decl,D).
+wh(B,C,np(D,E,[pp(F,G)]),D,_H,I,J,K,L) :-
+ np_head0(E,D,_M+common,I,N,K,O),
+ prep(F,N,P,O,Q),
+ wh(B,C,G,_R,_S,P,J,Q,L).
+wh(B,C,D,E,F,G,H,I,J) :-
+ whose(B,C,G,K,I,L),
+ s_all(M),
+ np(D,E,F,def,subj,M,_N,K,H,L,J).
+
+
+reduced_relative(B,C,D,E,F,G,H,I) :-
+ is_pred(D),
+ reduced_rel_conj(B,_J,C,E,F,G,H,I).
+
+
+reduced_rel_conj(B,C,D,E,F,G,H,I) :-
+ reduced_rel(B,J,K,F,L,H,M),
+ reduced_rel_rest(B,C,J,D,K,E,L,G,M,I).
+
+
+reduced_rel_rest(B,C,D,E,_F,G,H,I,J,K) :-
+ conj(C,L,D,M,E,H,N,J,O),
+ reduced_rel_conj(B,L,M,G,N,I,O,K).
+reduced_rel_rest(_B,_C,D,D,E,E,F,F,G,G).
+
+
+reduced_rel(B,reduced_rel(C,D),E,F,G,H,I) :-
+ my_open(F,J,H,K),
+ reduced_wh(B,C,J,L,K,M),
+ s(D,N,L,O,M,P),
+ my_trace(Q),
+ minus(N,Q,E),
+ close(O,G,P,I).
+
+
+reduced_wh(B,C,D,E,F,x(nogap,nonterminal,
+ np(np(B,wh(C),[]),B,G,_H,_I,J,K),x(nogap,nonterminal,
+ verb_form(be,pres+fin,B,main),x(nogap,nonterminal,
+ neg(_L,M),x(nogap,nonterminal,predicate(M,N,O),P))))) :-
+ neg(_Q,M,D,R,F,S),
+ predicate(M,N,O,R,E,S,P),
+ my_trace(J,K),
+ subj_case(G).
+reduced_wh(B,C,D,E,F,x(nogap,nonterminal,
+ np(np(B,wh(C),[]),B,G,_H,_I,J,K),x(nogap,nonterminal,
+ verb(L,_M,N,O),P))) :-
+ participle(L,N,O,D,E,F,P),
+ my_trace(J,K),
+ subj_case(G).
+reduced_wh(B,C,D,E,F,x(nogap,nonterminal,
+ np(G,H,I,J,_K,L,M),x(gap,nonterminal,
+ np(np(B,wh(C),[]),B,N,_O,_P,Q,R),S))) :-
+ s_all(T),
+ subj_case(I),
+ verb_case(N),
+ np(G,H,_U,J,subj,T,_V,D,E,F,S),
+ my_trace(L,M),
+ my_trace(Q,R).
+
+
+verb(B,C,D,E,F,F,G,H) :-
+ virtual(verb(B,C,D,E),G,H).
+verb(verb(B,C,D+fin,E,F),G,H,C,I,J,K,L) :-
+ verb_form(M,D+fin,G,N,I,O,K,P),
+ verb_type(M,Q),
+ neg(Q,F,O,R,P,S),
+ rest_verb(N,M,B,C,E,R,J,S,L),
+ verb_type(B,H).
+
+
+rest_verb(aux,have,B,C,[perf|D],E,F,G,H) :-
+ verb_form(I,past+part,_J,_K,E,L,G,M),
+ have(I,B,C,D,L,F,M,H).
+rest_verb(aux,be,B,C,D,E,F,G,H) :-
+ verb_form(I,J,_K,_L,E,M,G,N),
+ be(J,I,B,C,D,M,F,N,H).
+rest_verb(aux,do,B,active,[],C,D,E,F) :-
+ verb_form(B,inf,_G,_H,C,D,E,F).
+rest_verb(main,B,B,active,[],C,C,D,D).
+
+
+have(be,B,C,D,E,F,G,H) :-
+ verb_form(I,J,_K,_L,E,M,G,N),
+ be(J,I,B,C,D,M,F,N,H).
+have(B,B,active,[],C,C,D,D).
+
+
+be(past+part,B,B,passive,[],C,C,D,D).
+be(pres+part,B,C,D,[prog],E,F,G,H) :-
+ passive(B,C,D,E,F,G,H).
+
+
+passive(be,B,passive,C,D,E,F) :-
+ verb_form(B,past+part,_G,_H,C,D,E,F),
+ verb_type(B,I),
+ passive(I).
+passive(B,B,active,C,C,D,D).
+
+
+participle(verb(B,C,inf,D,E),F,C,G,H,I,J) :-
+ neg(_K,E,G,L,I,M),
+ verb_form(B,N,_O,_P,L,H,M,J),
+ participle(N,C,D),
+ verb_type(B,F).
+
+
+passive(_B+trans).
+passive(_B+ditrans).
+
+
+participle(pres+part,active,[prog]).
+participle(past+part,passive,[]).
+
+
+close(B,B,C,D) :-
+ virtual(close,C,D).
+
+
+my_open(B,B,C,x(gap,nonterminal,close,C)).
+
+
+verb_args(_B+C,D,E,F,G,H,I,J,K) :-
+ advs(E,L,_M,H,N,J,O),
+ verb_args(C,D,L,F,G,N,I,O,K).
+verb_args(trans,active,[arg(dir,B)],_C,D,E,F,G,H) :-
+ verb_arg(np,B,D,E,F,G,H).
+verb_args(ditrans,_B,[arg(C,D)|E],_F,G,H,I,J,K) :-
+ verb_arg(np,D,L,H,M,J,N),
+ object(C,E,L,G,M,I,N,K).
+verb_args(be,_B,[void],C,C,D,E,F,G) :-
+ terminal(there,D,E,F,G).
+verb_args(be,_B,[arg(predicate,C)],_D,E,F,G,H,I) :-
+ pred_conj(_J,C,E,F,G,H,I).
+verb_args(be,_B,[arg(dir,C)],_D,E,F,G,H,I) :-
+ verb_arg(np,C,E,F,G,H,I).
+verb_args(have,active,[arg(dir,B)],_C,D,E,F,G,H) :-
+ verb_arg(np,B,D,E,F,G,H).
+verb_args(B,_C,[],D,D,E,E,F,F) :-
+ no_args(B).
+
+
+object(B,C,D,E,F,G,H,I) :-
+ adv(J),
+ minus(J,D,K),
+ advs(C,L,K,F,M,H,N),
+ obj(B,L,D,E,M,G,N,I).
+
+
+obj(ind,[arg(dir,B)],_C,D,E,F,G,H) :-
+ verb_arg(np,B,D,E,F,G,H).
+obj(dir,[],B,B,C,C,D,D).
+
+
+pred_conj(B,C,D,E,F,G,H) :-
+ predicate(_I,J,K,E,L,G,M),
+ pred_rest(B,J,C,K,D,L,F,M,H).
+
+
+pred_rest(B,C,D,_E,F,G,H,I,J) :-
+ conj(B,K,C,L,D,G,M,I,N),
+ pred_conj(K,L,F,M,H,N,J).
+pred_rest(_B,C,C,D,D,E,E,F,F).
+
+
+verb_arg(np,B,C,D,E,F,G) :-
+ s_all(H),
+ verb_case(I),
+ np(B,_J,I,_K,compl,H,C,D,E,F,G).
+
+
+advs([B|C],D,E,F,G,H,I) :-
+ is_adv(E),
+ adverb(B,F,J,H,K),
+ advs(C,D,E,J,G,K,I).
+advs(B,B,_C,D,D,E,E).
+
+
+adj_phrase(B,C,D,E,F,G) :-
+ adj(_H,B,D,E,F,G),
+ empty(C).
+adj_phrase(B,C,D,E,F,G) :-
+ comp_phrase(B,C,D,E,F,G).
+
+
+no_args(trans).
+no_args(ditrans).
+no_args(intrans).
+
+
+conj(conj(B,C),conj(B,D),E,F,conj(B,E,F),G,H,I,J) :-
+ conj(B,C,D,G,H,I,J).
+
+
+noun(B,C,D,E,F,G) :-
+ terminal(H,D,E,F,G),
+ noun_form(H,B,C).
+
+
+adj(B,adj(C),D,E,F,G) :-
+ terminal(C,D,E,F,G),
+ adj(C,B).
+
+
+prep(prep(B),C,D,E,F) :-
+ terminal(B,C,D,E,F),
+ prep(B).
+
+
+rel_adj(adj(B),C,D,E,F) :-
+ terminal(G,C,D,E,F),
+ rel_adj(G,B).
+
+
+sup_adj(adj(B),C,D,E,F) :-
+ terminal(G,C,D,E,F),
+ sup_adj(G,B).
+
+
+comp_adv(less,B,C,D,E) :-
+ `(less,B,C,D,E).
+comp_adv(more,B,C,D,E) :-
+ `(more,B,C,D,E).
+
+
+sup_adv(least,B,C,D,E) :-
+ `(least,B,C,D,E).
+sup_adv(most,B,C,D,E) :-
+ `(most,B,C,D,E).
+
+
+rel_pron(B,C,D,E,F) :-
+ terminal(G,C,D,E,F),
+ rel_pron(G,B).
+
+
+name(B,C,D,E,F) :-
+ opt_the(C,G,E,H),
+ terminal(B,G,D,H,F),
+ name(B).
+
+
+int_art(B,plu,quant(same,wh(B)),C,D,E,F) :-
+ `(how,C,G,E,H),
+ `(many,G,D,H,F).
+int_art(B,C,D,E,F,G,H) :-
+ terminal(I,E,F,G,H),
+ int_art(I,B,C,D).
+
+
+int_pron(B,C,D,E,F) :-
+ terminal(G,C,D,E,F),
+ int_pron(G,B).
+
+
+adverb(adv(B),C,D,E,F) :-
+ terminal(B,C,D,E,F),
+ adverb(B).
+
+
+poss_pron(pronoun(B),C+D,E,F,G,H) :-
+ terminal(I,E,F,G,H),
+ poss_pron(I,B,C,D).
+
+
+pers_pron(pronoun(B),C+D,E,F,G,H,I) :-
+ terminal(J,F,G,H,I),
+ pers_pron(J,B,C,D,E).
+
+
+quantifier_pron(B,C,D,E,F,G) :-
+ terminal(H,D,E,F,G),
+ quantifier_pron(H,B,C).
+
+
+context_pron(prep(in),place,B,C,D,E) :-
+ `(where,B,C,D,E).
+context_pron(prep(at),time,B,C,D,E) :-
+ `(when,B,C,D,E).
+
+
+number(nb(B),C,D,E,F,G) :-
+ terminal(H,D,E,F,G),
+ number(H,B,C).
+
+
+terminator(B,C,D,E,F) :-
+ terminal(G,C,D,E,F),
+ terminator(G,B).
+
+
+opt_the(B,B,C,C).
+opt_the(B,C,D,E) :-
+ `(the,B,C,D,E).
+
+
+conj(_B,list,list,C,D,E,F) :-
+ terminal(',',C,D,E,F).
+conj(B,list,'end',C,D,E,F) :-
+ terminal(B,C,D,E,F),
+ conj(B).
+
+
+loc_pred(B,C,D,E,F) :-
+ terminal(G,C,D,E,F),
+ loc_pred(G,B).
+
+
+`(B,C,D,E,F) :-
+ terminal(B,C,D,E,F),
+ `(B).
+
+
+%----------------------------------------------------------------------------
+%
+% newdic
+%
+%----------------------------------------------------------------------------
+
+word(Word) :- `(Word).
+word(Word) :- conj(Word).
+word(Word) :- adverb(Word).
+word(Word) :- sup_adj(Word,_).
+word(Word) :- rel_adj(Word,_).
+word(Word) :- adj(Word,_).
+word(Word) :- name(Word).
+word(Word) :- terminator(Word,_).
+word(Word) :- pers_pron(Word,_,_,_,_).
+word(Word) :- poss_pron(Word,_,_,_).
+word(Word) :- rel_pron(Word,_).
+word(Word) :- verb_form(Word,_,_,_).
+word(Word) :- noun_form(Word,_,_).
+word(Word) :- prep(Word).
+word(Word) :- quantifier_pron(Word,_,_).
+word(Word) :- number(Word,_,_).
+word(Word) :- det(Word,_,_,_).
+word(Word) :- int_art(Word,_,_,_).
+word(Word) :- int_pron(Word,_).
+word(Word) :- loc_pred(Word,_).
+
+`(how).
+`(whose).
+`(there).
+`(of).
+`('`'). % use ` instead of ' to help assembler
+`(',').
+`(s).
+`(than).
+`(at).
+`(the).
+`(not).
+`(as).
+`(that).
+`(less).
+`(more).
+`(least).
+`(most).
+`(many).
+`(where).
+`(when).
+
+conj(and).
+conj(or).
+
+int_pron(what,undef).
+int_pron(which,undef).
+int_pron(who,subj).
+int_pron(whom,compl).
+
+int_art(what,X,_,int_det(X)).
+int_art(which,X,_,int_det(X)).
+
+det(the,No,the(No),def).
+det(a,sin,a,indef).
+det(an,sin,a,indef).
+det(every,sin,every,indef).
+det(some,_,some,indef).
+det(any,_,any,indef).
+det(all,plu,all,indef).
+det(each,sin,each,indef).
+det(no,_,no,indef).
+
+number(W,I,Nb) :-
+ tr_number(W,I),
+ ag_number(I,Nb).
+
+tr_number(nb(I),I).
+tr_number(one,1).
+tr_number(two,2).
+tr_number(three,3).
+tr_number(four,4).
+tr_number(five,5).
+tr_number(six,6).
+tr_number(seven,7).
+tr_number(eight,8).
+tr_number(nine,9).
+tr_number(ten,10).
+
+ag_number(1,sin).
+ag_number(N,plu) :- N>1.
+
+quantifier_pron(everybody,every,person).
+quantifier_pron(everyone,every,person).
+quantifier_pron(everything,every,thing).
+quantifier_pron(somebody,some,person).
+quantifier_pron(someone,some,person).
+quantifier_pron(something,some,thing).
+quantifier_pron(anybody,any,person).
+quantifier_pron(anyone,any,person).
+quantifier_pron(anything,any,thing).
+quantifier_pron(nobody,no,person).
+quantifier_pron(nothing,no,thing).
+
+prep(as).
+prep(at).
+prep(of).
+prep(to).
+prep(by).
+prep(with).
+prep(in).
+prep(on).
+prep(from).
+prep(into).
+prep(through).
+
+noun_form(Plu,Sin,plu) :- noun_plu(Plu,Sin).
+noun_form(Sin,Sin,sin) :- noun_sin(Sin).
+noun_form(proportion,proportion,_).
+noun_form(percentage,percentage,_).
+
+root_form(1+sin).
+root_form(2+_).
+root_form(1+plu).
+root_form(3+plu).
+
+verb_root(be).
+verb_root(have).
+verb_root(do).
+verb_root(border).
+verb_root(contain).
+verb_root(drain).
+verb_root(exceed).
+verb_root(flow).
+verb_root(rise).
+
+regular_pres(have).
+regular_pres(do).
+regular_pres(rise).
+regular_pres(border).
+regular_pres(contain).
+regular_pres(drain).
+regular_pres(exceed).
+regular_pres(flow).
+
+regular_past(had,have).
+regular_past(bordered,border).
+regular_past(contained,contain).
+regular_past(drained,drain).
+regular_past(exceeded,exceed).
+regular_past(flowed,flow).
+
+rel_pron(who,subj).
+rel_pron(whom,compl).
+rel_pron(which,undef).
+
+poss_pron(my,_,1,sin).
+poss_pron(your,_,2,_).
+poss_pron(his,masc,3,sin).
+poss_pron(her,fem,3,sin).
+poss_pron(its,neut,3,sin).
+poss_pron(our,_,1,plu).
+poss_pron(their,_,3,plu).
+
+pers_pron(i,_,1,sin,subj).
+pers_pron(you,_,2,_,_).
+pers_pron(he,masc,3,sin,subj).
+pers_pron(she,fem,3,sin,subj).
+pers_pron(it,neut,3,sin,_).
+pers_pron(we,_,1,plu,subj).
+pers_pron(them,_,3,plu,subj).
+pers_pron(me,_,1,sin,compl(_)).
+pers_pron(him,masc,3,sin,compl(_)).
+pers_pron(her,fem,3,sin,compl(_)).
+pers_pron(us,_,1,plu,compl(_)).
+pers_pron(them,_,3,plu,compl(_)).
+
+terminator(.,_).
+terminator(?,?).
+terminator(!,!).
+
+name(_).
+
+% ===========================================================================
+
+% specialised dictionary
+
+loc_pred(east,prep(eastof)).
+loc_pred(west,prep(westof)).
+loc_pred(north,prep(northof)).
+loc_pred(south,prep(southof)).
+
+adj(minimum,restr).
+adj(maximum,restr).
+adj(average,restr).
+adj(total,restr).
+adj(african,restr).
+adj(american,restr).
+adj(asian,restr).
+adj(european,restr).
+adj(great,quant).
+adj(big,quant).
+adj(small,quant).
+adj(large,quant).
+adj(old,quant).
+adj(new,quant).
+adj(populous,quant).
+
+rel_adj(greater,great).
+rel_adj(less,small).
+rel_adj(bigger,big).
+rel_adj(smaller,small).
+rel_adj(larger,large).
+rel_adj(older,old).
+rel_adj(newer,new).
+
+sup_adj(biggest,big).
+sup_adj(smallest,small).
+sup_adj(largest,large).
+sup_adj(oldest,old).
+sup_adj(newest,new).
+
+noun_sin(average).
+noun_sin(total).
+noun_sin(sum).
+noun_sin(degree).
+noun_sin(sqmile).
+noun_sin(ksqmile).
+noun_sin(thousand).
+noun_sin(million).
+noun_sin(time).
+noun_sin(place).
+noun_sin(area).
+noun_sin(capital).
+noun_sin(city).
+noun_sin(continent).
+noun_sin(country).
+noun_sin(latitude).
+noun_sin(longitude).
+noun_sin(ocean).
+noun_sin(person).
+noun_sin(population).
+noun_sin(region).
+noun_sin(river).
+noun_sin(sea).
+noun_sin(seamass).
+noun_sin(number).
+
+noun_plu(averages,average).
+noun_plu(totals,total).
+noun_plu(sums,sum).
+noun_plu(degrees,degree).
+noun_plu(sqmiles,sqmile).
+noun_plu(ksqmiles,ksqmile).
+noun_plu(million,million).
+noun_plu(thousand,thousand).
+noun_plu(times,time).
+noun_plu(places,place).
+noun_plu(areas,area).
+noun_plu(capitals,capital).
+noun_plu(cities,city).
+noun_plu(continents,continent).
+noun_plu(countries,country).
+noun_plu(latitudes,latitude).
+noun_plu(longitudes,longitude).
+noun_plu(oceans,ocean).
+noun_plu(persons,person). noun_plu(people,person).
+noun_plu(populations,population).
+noun_plu(regions,region).
+noun_plu(rivers,river).
+noun_plu(seas,sea).
+noun_plu(seamasses,seamass).
+noun_plu(numbers,number).
+
+verb_form(V,V,inf,_) :- verb_root(V).
+verb_form(V,V,pres+fin,Agmt) :-
+ regular_pres(V),
+ root_form(Agmt),
+ verb_root(V).
+verb_form(Past,Root,past+_,_) :-
+ regular_past(Past,Root).
+
+verb_form(am,be,pres+fin,1+sin).
+verb_form(are,be,pres+fin,2+sin).
+verb_form(is,be,pres+fin,3+sin).
+verb_form(are,be,pres+fin,_+plu).
+verb_form(was,be,past+fin,1+sin).
+verb_form(were,be,past+fin,2+sin).
+verb_form(was,be,past+fin,3+sin).
+verb_form(were,be,past+fin,_+plu).
+verb_form(been,be,past+part,_).
+verb_form(being,be,pres+part,_).
+verb_form(has,have,pres+fin,3+sin).
+verb_form(having,have,pres+part,_).
+verb_form(does,do,pres+fin,3+sin).
+verb_form(did,do,past+fin,_).
+verb_form(doing,do,pres+part,_).
+verb_form(done,do,past+part,_).
+verb_form(flows,flow,pres+fin,3+sin).
+verb_form(flowing,flow,pres+part,_).
+verb_form(rises,rise,pres+fin,3+sin).
+verb_form(rose,rise,past+fin,_).
+verb_form(risen,rise,past+part,_).
+verb_form(borders,border,pres+fin,3+sin).
+verb_form(bordering,border,pres+part,_).
+verb_form(contains,contain,pres+fin,3+sin).
+verb_form(containing,contain,pres+part,_).
+verb_form(drains,drain,pres+fin,3+sin).
+verb_form(draining,drain,pres+part,_).
+verb_form(exceeds,exceed,pres+fin,3+sin).
+verb_form(exceeding,exceed,pres+part,_).
+
+verb_type(have,aux+have).
+verb_type(be,aux+be).
+verb_type(do,aux+ditrans).
+verb_type(rise,main+intrans).
+verb_type(border,main+trans).
+verb_type(contain,main+trans).
+verb_type(drain,main+intrans).
+verb_type(exceed,main+trans).
+verb_type(flow,main+intrans).
+
+adverb(yesterday).
+adverb(tomorrow).
diff --git a/examples/benchmarks/holmer/crypt.in b/examples/benchmarks/holmer/crypt.in
new file mode 100644
index 0000000..dbafaa1
--- /dev/null
+++ b/examples/benchmarks/holmer/crypt.in
@@ -0,0 +1 @@
+:- '$benchmark'(crypt, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/crypt.pl b/examples/benchmarks/holmer/crypt.pl
new file mode 100644
index 0000000..3b121b6
--- /dev/null
+++ b/examples/benchmarks/holmer/crypt.pl
@@ -0,0 +1,84 @@
+
+% Cryptomultiplication:
+% Find the unique answer to:
+% OEE
+% EE
+% ---
+% EOEE
+% EOE
+% ----
+% OOEE
+%
+% where E=even, O=odd.
+% This program generalizes easily to any such problem.
+% Written by Peter Van Roy
+
+main :-
+ odd(A), even(B), even(C),
+ even(E),
+ mult([C,B,A], E, [I,H,G,F|X]),
+ lefteven(F), odd(G), even(H), even(I), zero(X),
+ lefteven(D),
+ mult([C,B,A], D, [L,K,J|Y]),
+ lefteven(J), odd(K), even(L), zero(Y),
+ sum([I,H,G,F], [0,L,K,J], [P,O,N,M|Z]),
+ odd(M), odd(N), even(O), even(P), zero(Z).
+ % write(' '), write(A), write(B), write(C), nl,
+ % write(' '), write(D), write(E), nl,
+ % write(F), write(G), write(H), write(I), nl,
+ % write(J), write(K), write(L), nl,
+ % write(M), write(N), write(O), write(P), nl.
+
+% Addition of two numbers
+sum(AL, BL, CL) :- sum(AL, BL, 0, CL).
+
+sum([A|AL], [B|BL], Carry, [C|CL]) :- !,
+ X is (A+B+Carry),
+ C is X mod 10,
+ NewCarry is X // 10,
+ sum(AL, BL, NewCarry, CL).
+sum([], BL, 0, BL) :- !.
+sum(AL, [], 0, AL) :- !.
+sum([], [B|BL], Carry, [C|CL]) :- !,
+ X is B+Carry,
+ NewCarry is X // 10,
+ C is X mod 10,
+ sum([], BL, NewCarry, CL).
+sum([A|AL], [], Carry, [C|CL]) :- !,
+ X is A+Carry,
+ NewCarry is X // 10,
+ C is X mod 10,
+ sum([], AL, NewCarry, CL).
+sum([], [], Carry, [Carry]).
+
+% Multiplication
+mult(AL, D, BL) :- mult(AL, D, 0, BL).
+
+mult([A|AL], D, Carry, [B|BL] ) :-
+ X is A*D+Carry,
+ B is X mod 10,
+ NewCarry is X // 10,
+ mult(AL, D, NewCarry, BL).
+mult([], _, Carry, [C,Cend]) :-
+ C is Carry mod 10,
+ Cend is Carry // 10.
+
+zero([]).
+zero([0|L]) :- zero(L).
+
+odd(1).
+odd(3).
+odd(5).
+odd(7).
+odd(9).
+
+even(0).
+even(2).
+even(4).
+even(6).
+even(8).
+
+lefteven(2).
+lefteven(4).
+lefteven(6).
+lefteven(8).
diff --git a/examples/benchmarks/holmer/divide10.in b/examples/benchmarks/holmer/divide10.in
new file mode 100644
index 0000000..ff74002
--- /dev/null
+++ b/examples/benchmarks/holmer/divide10.in
@@ -0,0 +1 @@
+:- '$benchmark'(divide10, 1000, divide10, '$dummy').
diff --git a/examples/benchmarks/holmer/divide10.pl b/examples/benchmarks/holmer/divide10.pl
new file mode 100644
index 0000000..8812c28
--- /dev/null
+++ b/examples/benchmarks/holmer/divide10.pl
@@ -0,0 +1,35 @@
+% generated: 7 March 1990
+% option(s):
+%
+% (deriv) divide10
+%
+% David H. D. Warren
+%
+% symbolic derivative of ((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x
+
+divide10 :- d(((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x,x,_).
+
+d(U+V,X,DU+DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U-V,X,DU-DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U*V,X,DU*V+U*DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(^(U,N),X,DU*N*(^(U,N1))) :- !,
+ integer(N),
+ N1 is N-1,
+ d(U,X,DU).
+d(-U,X,-DU) :- !,
+ d(U,X,DU).
+d(exp(U),X,exp(U)*DU) :- !,
+ d(U,X,DU).
+d(log(U),X,DU/U) :- !,
+ d(U,X,DU).
+d(X,X,1) :- !.
+d(_,_,0).
diff --git a/examples/benchmarks/holmer/fast_mu.in b/examples/benchmarks/holmer/fast_mu.in
new file mode 100644
index 0000000..4f9bf7a
--- /dev/null
+++ b/examples/benchmarks/holmer/fast_mu.in
@@ -0,0 +1 @@
+:- '$benchmark'(fast_mu, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/fast_mu.pl b/examples/benchmarks/holmer/fast_mu.pl
new file mode 100644
index 0000000..b97632f
--- /dev/null
+++ b/examples/benchmarks/holmer/fast_mu.pl
@@ -0,0 +1,100 @@
+%
+% The MU-puzzle
+% from Hofstadter's "Godel, Escher, Bach" (pp. 33-6).
+% written by Bruce Holmer
+%
+% To find a derivation type, for example:
+% theorem([m,u,i,i,u]).
+% Also try 'miiiii' (uses all rules) and 'muui' (requires 11 steps).
+% Note that it can be shown that (# of i's) cannot be a multiple
+% of three (which includes 0).
+% Some results:
+%
+% string # steps
+% ------ -------
+% miui 8
+% muii 8
+% muui 11
+% muiiu 6
+% miuuu 9
+% muiuu 9
+% muuiu 9
+% muuui 9
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+main :- theorem([m,u,i,i,u]).
+
+% First break goal atom into a list of characters,
+% find the derivation, and then print the results.
+theorem(G) :-
+ length(G, GL1),
+ GL is GL1 - 1,
+ derive([m,i], G, 1, GL, Derivation, 0).
+ % nl, print_results([rule(0,[m,i])|Derivation], 0).
+
+% derive(StartString, GoalString, StartStringLength, GoalStringLength,
+% Derivation, InitBound).
+derive(S, G, SL, GL, D, B) :-
+ % B1 is B + 1,
+ % write('depth '), write(B1), nl,
+ derive2(S, G, SL, GL, 1, D, B).
+derive(S, G, SL, GL, D, B) :-
+ B1 is B + 1,
+ derive(S, G, SL, GL, D, B1).
+
+% derive2(StartString, GoalString, StartStringLength, GoalStringLength,
+% ScanPointer, Derivation, NumRemainingSteps).
+derive2(S, S, SL, SL, _, [], _).
+derive2(S, G, SL, GL, Pin, [rule(N,I)|D], R) :-
+ lower_bound(SL, GL, B),
+ R >= B,
+ R1 is R - 1,
+ rule(S, I, SL, IL, Pin, Pout, N),
+ derive2(I, G, IL, GL, Pout, D, R1).
+
+rule([m|T1], [m|T2], L1, L2, Pin, Pout, N) :-
+ rule(T1, T2, L1, L2, Pin, Pout, 1, i, N, X, X).
+
+% rule(InitialString, FinalString, InitStrLength, FinStrLength,
+% ScanPtrIn, ScanPtrOut, StrPosition, PreviousChar,
+% RuleNumber, DiffList, DiffLink).
+% The difference list is used for doing a list concatenate in rule 2.
+rule([i], [i,u], L1, L2, Pin, Pout, Pos, _, 1, _, _) :-
+ Pos >= Pin,
+ Pout is Pos - 2,
+ L2 is L1 + 1.
+rule([], L, L1, L2, _, 1, _, _, 2, L, []) :-
+ L2 is L1 + L1.
+rule([i,i,i|T], [u|T], L1, L2, Pin, Pout, Pos, _, 3, _, _) :-
+ Pos >= Pin,
+ Pout is Pos - 1,
+ L2 is L1 - 2.
+rule([u,u|T], T, L1, L2, Pin, Pout, Pos, i, 4, _, _) :-
+ Pos >= Pin,
+ Pout is Pos - 2,
+ L2 is L1 - 2.
+rule([H|T1], [H|T2], L1, L2, Pin, Pout, Pos, _, N, L, [H|X]) :-
+ Pos1 is Pos + 1,
+ rule(T1, T2, L1, L2, Pin, Pout, Pos1, H, N, L, X).
+
+% print_results([], _).
+% print_results([rule(N,G)|T], M) :-
+% M1 is M + 1,
+% write(M1), write(' '), print_rule(N), write(G), nl,
+% print_results(T, M1).
+%
+% print_rule(0) :- write('axiom ').
+% print_rule(N) :- N =\= 0, write('rule '), write(N), write(' ').
+%
+lower_bound(N, M, 1) :- N < M.
+lower_bound(N, N, 2).
+lower_bound(N, M, B) :-
+ N > M,
+ Diff is N - M,
+ P is Diff/\1, % use and to do even test
+ (P =:= 0 ->
+ B is Diff >> 1; % use shifts to divide by 2
+ B is ((Diff + 1) >> 1) + 1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/examples/benchmarks/holmer/flatten.in b/examples/benchmarks/holmer/flatten.in
new file mode 100644
index 0000000..b17d148
--- /dev/null
+++ b/examples/benchmarks/holmer/flatten.in
@@ -0,0 +1 @@
+:- '$benchmark'(flatten, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/flatten.pl b/examples/benchmarks/holmer/flatten.pl
new file mode 100644
index 0000000..fd58481
--- /dev/null
+++ b/examples/benchmarks/holmer/flatten.pl
@@ -0,0 +1,191 @@
+/* CHANGELOG by M.Banbara
+ - name/2 --> atom_codes/2 or number_codes/2
+ - comment out write/1
+*/
+
+% preprocessing phase to eliminate disjunctions from the code
+
+% takes a list of clauses of the form source(Name,Clause)
+% returns these clauses with disjunctions replaced by dummy calls
+% and a list of NewClauses corresponding to those dummy calls
+% Link is the uninstantiated last cdr of this list
+
+main :-
+ eliminate_disjunctions([(a(A,B,C):-(b(A);c(C)))],X,Y,[]),
+ inst_vars((X,Y)).
+ %write((X,Y)), nl,
+ % (X,Y) == ([(a:-'_dummy_0')],[('_dummy_0':-b),('_dummy_0':-c)]),
+ %write(ok), nl.
+main.
+%main :- write(wrong), nl.
+
+eliminate_disjunctions(OneProc,NewProc,NewClauses,Link) :-
+ gather_disj(OneProc,NewProc,Disj,[]),
+ treat_disj(Disj,NewClauses,Link).
+
+gather_disj([],[],Link,Link).
+gather_disj([C|Cs],NewProc,Disj,Link) :-
+ extract_disj(C, NewC, Disj, Rest),
+ NewProc = [NewC|NewCs],
+ gather_disj(Cs,NewCs,Rest,Link).
+
+% given a clause, find in Disj the list of disj((A;B),N,X,C)
+% where N is a unique ID, X is a var that takes the place of
+% (A;B) in the code, NewC is the clause modified in such a way that
+% the disjunctions are replaced by the corresponding vars
+% Link is the last (uninstantiated) cdr of the list Disj.
+% do the work of pretrans for nots, -> etc...
+% put all those guys inside disjunctions
+extract_disj(C, (Head:-NewBody), Disj, Link) :-
+ C = (Head:-Body), !,
+ CtrIn = 0,
+ extract_disj(Body, NewBody, Disj, Link, C, CtrIn, CtrOut).
+extract_disj(Head, Head, Link, Link).
+
+extract_disj((C1,C2), (NewC1,NewC2), Disj, Link, C, CtrIn, CtrOut) :-
+ extract_disj(C1, NewC1, Disj, Link1, C, CtrIn, Ctr),
+ extract_disj(C2, NewC2, Link1, Link, C, Ctr, CtrOut).
+
+extract_disj(Goal, X, Disj, Link, C, CtrIn, CtrOut) :-
+ is_disj(Goal,NewGoal), !,
+ Disj = [disj(NewGoal,CtrIn,X,C)|Link],
+ CtrOut is CtrIn + 1.
+extract_disj(Goal, Goal, Link, Link, _, CtrIn, CtrIn).
+
+is_disj(((C1 -> C2); C3),((C1, !, C2); C3)) :- !.
+is_disj((C1;C2),(C1;C2)).
+is_disj(not(C),((C,!,fail);true)).
+is_disj(\+(C),((C,!,fail);true)).
+is_disj('\='(C1,C2),((C1 = C2,!,fail);true)).
+
+% given a list of disj((A;B),N,X,C), for each, do the following:
+% 1) find vars in (A;B)
+% 2) find the vars in C
+% 3) intersect the two sets of vars into one list
+% 4) make a predicate name using N as a part of it ('dummy_disjN')
+% 5) put a structure with that name and those vars as args
+% 6) binds X to this call
+% 7) add new clauses [(dummy:-A)),(dummy:-B))]
+treat_disj([], Link, Link).
+treat_disj([disj((A;B),N,X,C)|Disjs], DummyClauses, Link) :-
+ find_vars((A;B),Vars),
+ find_vars(C,CVars),
+ intersect_vars(Vars,CVars,Args),
+ make_dummy_name(N,Name),
+ X =.. [Name|Args],
+ make_dummy_clauses((A;B),X,DummyClauses,Rest),
+ treat_disj(Disjs, Rest, Link).
+
+make_dummy_clauses((A;B),X,[NewC|Cs],Link) :-
+ !,
+ copy((X:-A), NewC),
+ make_dummy_clauses(B,X,Cs,Link).
+make_dummy_clauses(A,X,[NewC|Link],Link) :- copy((X:-A),NewC).
+
+find_vars(X,Y) :- find_vars(X,Y,Link), Link = [].
+
+find_vars(Var,[Var|Link],Link) :- var(Var), !.
+find_vars(Cst,Link,Link) :- atomic(Cst), !.
+find_vars([T|Ts],Vars,NewLink) :- !,
+ find_vars(T,Vars,Link),
+ find_vars(Ts,Link,NewLink).
+find_vars(Term,Vars,Link) :-
+ Term =.. [_|Args],
+ find_vars(Args,Vars,Link).
+
+intersect_vars(V1,V2,Out) :-
+ sort_vars(V1,Sorted1),
+ sort_vars(V2,Sorted2),
+ intersect_sorted_vars(Sorted1,Sorted2,Out).
+
+sort_vars(V,Out) :- sort_vars(V,Out,[]).
+sort_vars([],Link,Link).
+sort_vars([V|Vs],Result,Link) :-
+ split_vars(Vs,V,Smaller,Bigger),
+ sort_vars(Smaller,Result,[V|SLink]),
+ sort_vars(Bigger,SLink,Link).
+
+split_vars([],_,[],[]).
+split_vars([V|Vs],A,[V|Ss],Bs) :-
+ V @< A, !,
+ split_vars(Vs,A,Ss,Bs).
+split_vars([V|Vs],A,Ss,Bs) :-
+ V == A, !,
+ split_vars(Vs,A,Ss,Bs).
+split_vars([V|Vs],A,Ss,[V|Bs]) :-
+ V @> A, !,
+ split_vars(Vs,A,Ss,Bs).
+
+intersect_sorted_vars([],_,[]) :- !.
+intersect_sorted_vars(_,[],[]).
+intersect_sorted_vars([X|Xs],[Y|Ys],[X|Rs]) :-
+ X == Y, !,
+ intersect_sorted_vars(Xs,Ys,Rs).
+intersect_sorted_vars([X|Xs],[Y|Ys],Rs) :-
+ X @< Y, !,
+ intersect_sorted_vars(Xs,[Y|Ys],Rs).
+intersect_sorted_vars([X|Xs],[Y|Ys],Rs) :-
+ X @> Y, !,
+ intersect_sorted_vars([X|Xs],Ys,Rs).
+
+make_dummy_name(N,Name) :-
+ %name('_dummy_',L1),
+ atom_codes('_dummy_',L1),
+ %name(N,L2),
+ number_codes(N,L2),
+ append(L1,L2,L),
+ %name(Name,L).
+ atom_codes(Name,L).
+
+append([], L, L).
+append([H|L1], L2, [H|Res]) :- append(L1, L2, Res).
+
+% copy_term using a symbol table.
+copy(Term1, Term2) :-
+ varset(Term1, Set), make_sym(Set, Sym),
+ copy2(Term1, Term2, Sym), !.
+
+copy2(V1, V2, Sym) :- var(V1), !, retrieve_sym(V1, Sym, V2).
+copy2(X1, X2, Sym) :- nonvar(X1), !,
+ functor(X1,Name,Arity),
+ functor(X2,Name,Arity),
+ copy2(X1, X2, Sym, 1, Arity).
+
+copy2(_X1,_X2,_Sym, N, Arity) :- N>Arity, !.
+copy2(X1, X2, Sym, N, Arity) :- N=<Arity, !,
+ arg(N, X1, Arg1),
+ arg(N, X2, Arg2),
+ copy2(Arg1, Arg2, Sym),
+ N1 is N+1,
+ copy2(X1, X2, Sym, N1, Arity).
+
+retrieve_sym(V, [p(W,X)|_Sym], X) :- V==W, !.
+retrieve_sym(V, [_|Sym], X) :- retrieve_sym(V, Sym, X).
+
+make_sym([], []).
+make_sym([V|L], [p(V,_)|S]) :- make_sym(L, S).
+
+% *** Gather all variables used in a term: (in a set or a bag)
+varset(Term, VarSet) :- varbag(Term, VB), sort(VB, VarSet).
+varbag(Term, VarBag) :- varbag(Term, VarBag, []).
+
+varbag(Var) --> {var(Var)}, !, [Var].
+varbag(Str) --> {nonvar(Str), !, functor(Str,_,Arity)}, varbag(Str, 1, Arity).
+
+varbag(_Str, N, Arity) --> {N>Arity}, !.
+varbag(Str, N, Arity) --> {N=<Arity}, !,
+ {arg(N, Str, Arg)}, varbag(Arg),
+ {N1 is N+1},
+ varbag(Str, N1, Arity).
+
+inst_vars(Term) :-
+ varset(Term, Vars),
+ A is "A",
+ inst_vars_list(Vars, A).
+
+inst_vars_list([], _).
+inst_vars_list([T|L], N) :-
+ %name(T, [N]),
+ atom_codes(T, [N]),
+ N1 is N+1,
+ inst_vars_list(L, N1).
diff --git a/examples/benchmarks/holmer/log10.in b/examples/benchmarks/holmer/log10.in
new file mode 100644
index 0000000..f72a44b
--- /dev/null
+++ b/examples/benchmarks/holmer/log10.in
@@ -0,0 +1 @@
+:- '$benchmark'(log10, 1000, log10, '$dummy').
diff --git a/examples/benchmarks/holmer/log10.pl b/examples/benchmarks/holmer/log10.pl
new file mode 100644
index 0000000..515562f
--- /dev/null
+++ b/examples/benchmarks/holmer/log10.pl
@@ -0,0 +1,35 @@
+% generated: 25 October 1989
+% option(s):
+%
+% (deriv) log10
+%
+% David H. D. Warren
+%
+% symbolic derivative of log(log(log(log(log(log(log(log(log(log(x))))))))))
+
+log10 :- d(log(log(log(log(log(log(log(log(log(log(x)))))))))),x,_).
+
+d(U+V,X,DU+DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U-V,X,DU-DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U*V,X,DU*V+U*DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(^(U,N),X,DU*N*(^(U,N1))) :- !,
+ integer(N),
+ N1 is N-1,
+ d(U,X,DU).
+d(-U,X,-DU) :- !,
+ d(U,X,DU).
+d(exp(U),X,exp(U)*DU) :- !,
+ d(U,X,DU).
+d(log(U),X,DU/U) :- !,
+ d(U,X,DU).
+d(X,X,1) :- !.
+d(_,_,0).
diff --git a/examples/benchmarks/holmer/meta_qsort.in b/examples/benchmarks/holmer/meta_qsort.in
new file mode 100644
index 0000000..cfc24f3
--- /dev/null
+++ b/examples/benchmarks/holmer/meta_qsort.in
@@ -0,0 +1 @@
+:- '$benchmark'(meta_qsort, 1000, meta_qsort, '$dummy').
diff --git a/examples/benchmarks/holmer/meta_qsort.pl b/examples/benchmarks/holmer/meta_qsort.pl
new file mode 100644
index 0000000..bfa277b
--- /dev/null
+++ b/examples/benchmarks/holmer/meta_qsort.pl
@@ -0,0 +1,102 @@
+% generated: 8 March 1990
+% option(s):
+%
+% meta_qsort
+%
+% Ralph M. Haygood
+%
+% meta-interpret Warren benchmark qsort
+%
+% For any meta-variable ~X~, interpret(~X~) behaves as if
+%
+% interpret(~X~) :- ~X~.
+%
+% Thus, for example, interpret((foo(X), bar(X), !)) behaves as if
+%
+% interpret((foo(X), bar(X), !)) :- foo(X), bar(X), !.
+%
+% Note that though ~X~ may contain cuts, those cuts cannot escape from
+% interpret(~X~) to effect the parent goal; interpret(!) is equivalent
+% to true.
+%
+% Cuts inside ~X~ are executed according to the rule that conjunction,
+% disjunction, and if-then-else are transparent to cuts, and any other
+% form is transparent to cuts if and only if it can be macro-expanded
+% into a form involving only these three without interpret/1. If-then
+% and negation are the only such other forms currently recognized; ( A
+% -> B) is equivalent to ( A -> B ; fail ), and \+ A is equivalent to
+% ( A -> fail ; true ).
+
+meta_qsort :- interpret(qsort).
+
+interpret(Goal) :-
+ interpret(Goal, Rest),
+ ( nonvar(Rest), !,
+ interpret(Rest)
+ ; true
+ ).
+
+interpret(G, _) :-
+ var(G), !,
+ fail.
+interpret((A, B), Rest) :- !,
+ interpret(A, Rest0),
+ ( nonvar(Rest0) ->
+ Rest = (Rest0, B)
+ ; interpret(B, Rest)
+ ).
+interpret((A ; B), Rest) :- !,
+ interpret_disjunction(A, B, Rest).
+interpret((A -> B), Rest) :- !,
+ interpret_disjunction((A -> B), fail, Rest).
+interpret(\+A, Rest) :- !,
+ interpret_disjunction((A -> fail), true, Rest).
+interpret(!, true) :- !.
+interpret(G, _) :-
+ number(G), !,
+ fail.
+interpret(G, _) :-
+ is_built_in(G), !,
+ interpret_built_in(G).
+interpret(G, _) :-
+ define(G, Body),
+ interpret(Body).
+
+interpret_disjunction((A -> B), _, Rest) :-
+ interpret(A, Rest0), !,
+ ( nonvar(Rest0) ->
+ Rest = (Rest0 -> B)
+ ; interpret(B, Rest)
+ ).
+interpret_disjunction((_ -> _), C, Rest) :- !,
+ interpret(C, Rest).
+interpret_disjunction(A, _, Rest) :-
+ interpret(A, Rest).
+interpret_disjunction(_, B, Rest) :-
+ interpret(B, Rest).
+
+is_built_in(true).
+is_built_in(_=<_).
+
+interpret_built_in(true).
+interpret_built_in(X=<Y) :- X =< Y.
+
+define(qsort,(
+ qsort([27,74,17,33,94,18,46,83,65, 2,
+ 32,53,28,85,99,47,28,82, 6,11,
+ 55,29,39,81,90,37,10, 0,66,51,
+ 7,21,85,27,31,63,75, 4,95,99,
+ 11,28,61,74,18,92,40,53,59, 8],_,[]))).
+
+define(qsort([X|L],R,R0),(
+ partition(L,X,L1,L2),
+ qsort(L2,R1,R0),
+ qsort(L1,R,[X|R1]))).
+define(qsort([],R,R),true).
+
+define(partition([X|L],Y,[X|L1],L2),(
+ X=<Y,!,
+ partition(L,Y,L1,L2))).
+define(partition([X|L],Y,L1,[X|L2]),(
+ partition(L,Y,L1,L2))).
+define(partition([],_,[],[]),true).
diff --git a/examples/benchmarks/holmer/mu.in b/examples/benchmarks/holmer/mu.in
new file mode 100644
index 0000000..7409d8a
--- /dev/null
+++ b/examples/benchmarks/holmer/mu.in
@@ -0,0 +1 @@
+:- '$benchmark'(mu, 1000, mu, '$dummy').
diff --git a/examples/benchmarks/holmer/mu.pl b/examples/benchmarks/holmer/mu.pl
new file mode 100644
index 0000000..5273d0d
--- /dev/null
+++ b/examples/benchmarks/holmer/mu.pl
@@ -0,0 +1,41 @@
+% generated: 9 November 1989
+% option(s):
+%
+% mu
+%
+% derived from Douglas R. Hofstadter, "Godel, Escher, Bach," pages 33-35.
+%
+% prove "mu-math" theorem muiiu
+
+mu :- theorem([m,u,i,i,u], 5, _), !.
+
+theorem([m,i], _, [[a|[m,i]]]).
+theorem(R, Depth, [[N|R]|P]) :-
+ Depth > 0,
+ D is Depth-1,
+ theorem(S, D, P),
+ rule(N, S, R).
+
+rule(1, S, R) :- rule1(S, R).
+rule(2, S, R) :- rule2(S, R).
+rule(3, S, R) :- rule3(S, R).
+rule(4, S, R) :- rule4(S, R).
+
+rule1([i], [i,u]).
+rule1([H|X], [H|Y]) :-
+ rule1(X, Y).
+
+rule2([m|X], [m|Y]) :-
+ append(X, X, Y).
+
+rule3([i,i,i|X], [u|X]).
+rule3([H|X], [H|Y]) :-
+ rule3(X, Y).
+
+rule4([u,u|X], X).
+rule4([H|X], [H|Y]) :-
+ rule4(X, Y).
+
+append([], X, X).
+append([A|B], X, [A|B1]) :-
+ append(B, X, B1).
diff --git a/examples/benchmarks/holmer/nand.pl.bak b/examples/benchmarks/holmer/nand.pl.bak
new file mode 100644
index 0000000..6687953
--- /dev/null
+++ b/examples/benchmarks/holmer/nand.pl.bak
@@ -0,0 +1,562 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% This is a rough approximation to the algorithm presented in:
+%
+% "An Algorithm for NAND Decomposition Under Network Constraints,"
+% IEEE Trans. Comp., vol C-18, no. 12, Dec. 1969, p. 1098
+% by E. S. Davidson.
+%
+% Written by Bruce Holmer
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% I have used the paper's terminology for names used in the program.
+%
+% The data structure for representing functions and variables is
+% function(FunctionNumber, TrueSet, FalseSet,
+% ConceivableInputs,
+% ImmediatePredecessors, ImmediateSuccessors,
+% Predecessors, Successors)
+%
+%
+% Common names used in the program:
+%
+% NumVars number of variables (signal inputs)
+% NumGs current number of variables and functions
+% Gs list of variable and function data
+% Gi,Gj,Gk,Gl individual variable or function--letter corresponds to
+% the subscript in the paper (most of the time)
+% Vector,V vector from a function's true set
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+main :- main(0).
+
+main(N) :-
+ init_state(N, NumVars, NumGs, Gs),
+ add_necessary_functions(NumVars, NumGs, Gs, NumGs2, Gs2),
+ test_bounds(NumVars, NumGs2, Gs2),
+ search(NumVars, NumGs2, Gs2).
+main(_) :-
+ write('Search completed'), nl.
+
+% Test input
+% init_state(circuit(NumInputs, NumOutputs, FunctionList))
+init_state(0, 2, 3, [ % 2 input xor
+ function(2, [1,2], [0,3], [], [], [], [], []),
+ function(1, [2,3], [0,1], [], [], [], [], []),
+ function(0, [1,3], [0,2], [], [], [], [], [])
+ ]) :-
+ update_bounds(_, 100, _).
+init_state(1, 3, 4, [ % carry circuit
+ function(3, [3,5,6,7], [0,1,2,4], [], [], [], [], []),
+ function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []),
+ function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []),
+ function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], [])
+ ]) :-
+ update_bounds(_, 100, _).
+init_state(2, 3, 4, [ % example in paper
+ function(3, [1,2,4,6,7], [0,3,5], [], [], [], [], []),
+ function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []),
+ function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []),
+ function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], [])
+ ]) :-
+ update_bounds(_, 100, _).
+init_state(3, 3, 4, [ % sum (3 input xor)
+ function(3, [1,2,4,7], [0,3,5,6], [], [], [], [], []),
+ function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []),
+ function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []),
+ function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], [])
+ ]) :-
+ update_bounds(_, 100, _).
+init_state(4, 3, 5, [ % do sum and carry together
+ function(4, [3,5,6,7], [0,1,2,4], [], [], [], [], []),
+ function(3, [1,2,4,7], [0,3,5,6], [], [], [], [], []),
+ function(2, [4,5,6,7], [0,1,2,3], [], [], [], [], []),
+ function(1, [2,3,6,7], [0,1,4,5], [], [], [], [], []),
+ function(0, [1,3,5,7], [0,2,4,6], [], [], [], [], [])
+ ]) :-
+ update_bounds(_, 100, _).
+init_state(5, 5, 8, [ % 2 bit full adder
+ function(7, % A2 (output)
+ [1,3,4,6,9,11,12,14,16,18,21,23,24,26,29,31],
+ [0,2,5,7,8,10,13,15,17,19,20,22,25,27,28,30],
+ [], [], [], [], []),
+ function(6, % B2 (output)
+ [2,3,5,6,8,9,12,15,17,18,20,21,24,27,30,31],
+ [0,1,4,7,10,11,13,14,16,19,22,23,25,26,28,29],
+ [], [], [], [], []),
+ function(5, % carry-out (output)
+ [7,10,11,13,14,15,19,22,23,25,26,27,28,29,30,31],
+ [0,1,2,3,4,5,6,8,9,12,16,17,18,20,21,24],
+ [], [], [], [], []),
+ function(4, % carry-in
+ [16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31],
+ [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15],
+ [], [], [], [], []),
+ function(3, % B1 input
+ [8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31],
+ [0,1,2,3,4,5,6,7,16,17,18,19,20,21,22,23],
+ [], [], [], [], []),
+ function(2, % B0 input
+ [4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31],
+ [0,1,2,3,8,9,10,11,16,17,18,19,24,25,26,27],
+ [], [], [], [], []),
+ function(1, % A1 input
+ [2,3,6,7,10,11,14,15,18,19,22,23,26,27,30,31],
+ [0,1,4,5,8,9,12,13,16,17,20,21,24,25,28,29],
+ [], [], [], [], []),
+ function(0, % A0 input
+ [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31],
+ [0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30],
+ [], [], [], [], [])
+ ]) :-
+ update_bounds(_, 21, _).
+
+
+% Iterate over all the TRUE vectors that need to be covered.
+% If no vectors remain to be covered (select_vector fails), then
+% the circuit is complete (printout results, update bounds, and
+% continue search for a lower cost circuit).
+search(NumVars, NumGsIn, GsIn) :-
+ select_vector(NumVars, NumGsIn, GsIn, Gj, Vector), !,
+ cover_vector(NumVars, NumGsIn, GsIn, Gj, Vector, NumGs, Gs),
+ add_necessary_functions(NumVars, NumGs, Gs, NumGsOut, GsOut),
+ test_bounds(NumVars, NumGsOut, GsOut),
+ search(NumVars, NumGsOut, GsOut).
+search(NumVars, NumGs, Gs) :-
+ output_results(NumVars, NumGs, Gs),
+ update_bounds(NumVars, NumGs, Gs),
+ fail.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Given the current solution, pick the best uncovered TRUE vector
+% for covering next.
+% The selected vector is specified by its vector number and function.
+% Select_vector fails if all TRUE vectors are covered.
+% Select_vector is determinant (gives only one solution).
+select_vector(NumVars, NumGs, Gs, Gj, Vector) :-
+ select_vector(Gs, NumVars, NumGs, Gs,
+ dummy, 0, nf, 999, Gj, Vector, Type, _), !,
+ \+ Type = cov,
+ \+ Type = nf.
+
+% loop over functions
+select_vector([Gk|_], NumVars, _, _, Gj, V, Type, N, Gj, V, Type, N) :-
+ function_number(Gk, K),
+ K < NumVars.
+select_vector([Gk|Gks], NumVars, NumGs, Gs,
+ GjIn, Vin, TypeIn, Nin, GjOut, Vout, TypeOut, Nout) :-
+ function_number(Gk, K),
+ K >= NumVars,
+ true_set(Gk, Tk),
+ select_vector(Tk, Gk, NumVars, NumGs, Gs,
+ GjIn, Vin, TypeIn, Nin, Gj, V, Type, N),
+ select_vector(Gks, NumVars, NumGs, Gs,
+ Gj, V, Type, N, GjOut, Vout, TypeOut, Nout).
+
+% loop over vectors
+select_vector([], _, _, _, _, Gj, V, Type, N, Gj, V, Type, N).
+select_vector([V|Vs], Gk, NumVars, NumGs, Gs,
+ GjIn, Vin, TypeIn, Nin, GjOut, Vout, TypeOut, Nout) :-
+ vector_cover_type(NumVars, Gs, Gk, V, Type, N),
+ best_vector(GjIn, Vin, TypeIn, Nin,
+ Gk, V, Type, N,
+ Gj2, V2, Type2, N2),
+ select_vector(Vs, Gk, NumVars, NumGs, Gs,
+ Gj2, V2, Type2, N2, GjOut, Vout, TypeOut, Nout).
+
+vector_cover_type(NumVars, Gs, Gj, Vector, Type, NumCovers) :-
+ immediate_predecessors(Gj, IPs),
+ conceivable_inputs(Gj, CIs),
+ false_set(Gj, Fj),
+ cover_type1(IPs, Gs, Vector, nf, 0, T, N),
+ cover_type2(CIs, Gs, NumVars, Fj, Vector, T, N, Type, NumCovers).
+
+cover_type1([], _, _, T, N, T, N).
+cover_type1([I|IPs], Gs, V, TypeIn, Nin, TypeOut, Nout) :-
+ function(I, Gs, Gi),
+ true_set(Gi, Ti),
+ \+ set_member(V, Ti), !,
+ false_set(Gi, Fi),
+ (set_member(V, Fi) ->
+ max_type(TypeIn, cov, Type);
+ max_type(TypeIn, exp, Type)),
+ N is Nin + 1,
+ cover_type1(IPs, Gs, V, Type, N, TypeOut, Nout).
+cover_type1([_|IPs], Gs, V, TypeIn, Nin, TypeOut, Nout) :-
+ cover_type1(IPs, Gs, V, TypeIn, Nin, TypeOut, Nout).
+
+cover_type2([], _, _, _, _, T, N, T, N).
+cover_type2([I|CIs], Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout) :-
+ I < NumVars,
+ function(I, Gs, Gi),
+ false_set(Gi, Fi),
+ set_member(V, Fi), !,
+ max_type(TypeIn, var, Type),
+ N is Nin + 1,
+ cover_type2(CIs, Gs, NumVars, Fj, V, Type, N, TypeOut, Nout).
+cover_type2([I|CIs], Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout) :-
+ I >= NumVars,
+ function(I, Gs, Gi),
+ true_set(Gi, Ti),
+ \+ set_member(V, Ti), !,
+ false_set(Gi, Fi),
+ (set_member(V, Fi) ->
+ (set_subset(Fj, Ti) ->
+ max_type(TypeIn, fcn, Type);
+ max_type(TypeIn, mcf, Type));
+ (set_subset(Fj, Ti) ->
+ max_type(TypeIn, exf, Type);
+ max_type(TypeIn, exmcf, Type))),
+ N is Nin + 1,
+ cover_type2(CIs, Gs, NumVars, Fj, V, Type, N, TypeOut, Nout).
+cover_type2([_|CIs], Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout) :-
+ cover_type2(CIs, Gs, NumVars, Fj, V, TypeIn, Nin, TypeOut, Nout).
+
+% The best vector to cover is the one with worst type, or, if types
+% are equal, with the least number of possible covers.
+best_vector(dummy, _, _, _, Gj2, V2, Type2, N2, Gj2, V2, Type2, N2) :- !.
+best_vector(Gj1, V1, Type1, N1, dummy, _, _, _, Gj1, V1, Type1, N1) :- !.
+best_vector(Gj1, V1, Type, N1, Gj2, _, Type, N2, Gj1, V1, Type, N1) :-
+ function_number(Gj1, J), function_number(Gj2, J),
+ N1 < N2, !.
+best_vector(Gj1, _, Type, N1, Gj2, V2, Type, N2, Gj2, V2, Type, N2) :-
+ function_number(Gj1, J), function_number(Gj2, J),
+ N1 >= N2, !.
+best_vector(Gj1, V1, Type, N1, Gj2, _, Type, _, Gj1, V1, Type, N1) :-
+ (Type = exp ; Type = var),
+ function_number(Gj1, J1), function_number(Gj2, J2),
+ J1 > J2, !.
+best_vector(Gj1, _, Type, _, Gj2, V2, Type, N2, Gj2, V2, Type, N2) :-
+ (Type = exp ; Type = var),
+ function_number(Gj1, J1), function_number(Gj2, J2),
+ J1 < J2, !.
+best_vector(Gj1, V1, Type, N1, Gj2, _, Type, _, Gj1, V1, Type, N1) :-
+ \+ (Type = exp ; Type = var),
+ function_number(Gj1, J1), function_number(Gj2, J2),
+ J1 < J2, !.
+best_vector(Gj1, _, Type, _, Gj2, V2, Type, N2, Gj2, V2, Type, N2) :-
+ \+ (Type = exp ; Type = var),
+ function_number(Gj1, J1), function_number(Gj2, J2),
+ J1 > J2, !.
+best_vector(Gj1, V1, Type1, N1, _, _, Type2, _, Gj1, V1, Type1, N1) :-
+ type_order(Type2, Type1), !.
+best_vector(_, _, Type1, _, Gj2, V2, Type2, N2, Gj2, V2, Type2, N2) :-
+ type_order(Type1, Type2), !.
+
+max_type(T1, T2, T1) :- type_order(T1, T2), !.
+max_type(T1, T2, T2) :- \+ type_order(T1, T2), !.
+
+% Order of types
+
+type_order(cov, exp).
+type_order(cov, var).
+type_order(cov, fcn).
+type_order(cov, mcf).
+type_order(cov, exf).
+type_order(cov, exmcf).
+type_order(cov, nf).
+type_order(exp, var).
+type_order(exp, fcn).
+type_order(exp, mcf).
+type_order(exp, exf).
+type_order(exp, exmcf).
+type_order(exp, nf).
+type_order(var, fcn).
+type_order(var, mcf).
+type_order(var, exf).
+type_order(var, exmcf).
+type_order(var, nf).
+type_order(fcn, mcf).
+type_order(fcn, exf).
+type_order(fcn, exmcf).
+type_order(fcn, nf).
+type_order(mcf, exf).
+type_order(mcf, exmcf).
+type_order(mcf, nf).
+type_order(exf, exmcf).
+type_order(exf, nf).
+type_order(exmcf, nf).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Cover_vector will cover the specified vector and
+% generate new circuit information.
+% Using backtracking, all possible coverings are generated.
+% The ordering of the possible coverings is approximately that
+% given in Davidson's paper, but has been simplified.
+
+cover_vector(NumVars, NumGsIn, GsIn, Gj, Vector, NumGsOut, GsOut) :-
+ immediate_predecessors(Gj, IPs),
+ conceivable_inputs(Gj, CIs),
+ vector_types(Type),
+ cover_vector(Type, IPs, CIs, Gj, Vector, NumVars, NumGsIn, GsIn,
+ NumGsOut, GsOut).
+
+vector_types(var).
+vector_types(exp).
+vector_types(fcn).
+vector_types(mcf).
+vector_types(exf).
+vector_types(exmcf).
+vector_types(nf).
+
+cover_vector(exp, [I|_], _, Gj, V, _, NumGs, GsIn, NumGs, GsOut) :-
+ function(I, GsIn, Gi),
+ true_set(Gi, Ti),
+ \+ set_member(V, Ti),
+ update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut).
+cover_vector(exp, [_|IPs], _, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ cover_vector(exp, IPs, _, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut).
+cover_vector(var, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ I < NumVars,
+ function(I, GsIn, Gi),
+ false_set(Gi, Fi),
+ set_member(V, Fi),
+ update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut).
+cover_vector(var, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ cover_vector(var, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut).
+cover_vector(fcn, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ I >= NumVars,
+ function(I, GsIn, Gi),
+ false_set(Gi, Fi),
+ set_member(V, Fi),
+ true_set(Gi, Ti),
+ false_set(Gj, Fj),
+ set_subset(Fj, Ti),
+ update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut).
+cover_vector(fcn, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ cover_vector(fcn, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut).
+cover_vector(mcf, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ I >= NumVars,
+ function(I, GsIn, Gi),
+ false_set(Gi, Fi),
+ set_member(V, Fi),
+ true_set(Gi, Ti),
+ false_set(Gj, Fj),
+ \+ set_subset(Fj, Ti),
+ update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut).
+cover_vector(mcf, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ cover_vector(mcf, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut).
+cover_vector(exf, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ I >= NumVars,
+ function(I, GsIn, Gi),
+ false_set(Gi, Fi),
+ \+ set_member(V, Fi),
+ true_set(Gi, Ti),
+ \+ set_member(V, Ti),
+ false_set(Gj, Fj),
+ set_subset(Fj, Ti),
+ update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut).
+cover_vector(exf, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ cover_vector(exf, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut).
+cover_vector(exmcf, _, [I|_], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ I >= NumVars,
+ function(I, GsIn, Gi),
+ false_set(Gi, Fi),
+ \+ set_member(V, Fi),
+ true_set(Gi, Ti),
+ \+ set_member(V, Ti),
+ false_set(Gj, Fj),
+ \+ set_subset(Fj, Ti),
+ update_circuit(GsIn, Gi, Gj, V, GsIn, GsOut).
+cover_vector(exmcf, _, [_|CIs], Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut) :-
+ cover_vector(exmcf, _, CIs, Gj, V, NumVars, NumGs, GsIn, NumGs, GsOut).
+cover_vector(nf, _, _, Gj, V, NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :-
+ NumGsOut is NumGsIn + 1,
+ false_set(Gj, Fj),
+ new_function_CIs(GsIn,
+ function(NumGsIn,Fj,[V],[],[],[],[],[]),
+ NumVars, Gs, Gi),
+ update_circuit(Gs, Gi, Gj, V, Gs, GsOut).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+update_circuit([], _, _, _, _, []).
+update_circuit([function(K,Tk,Fk,CIk,IPk,ISk,Pk,Sk)|GsIn],
+ Gi, Gj, V, Gs,
+ [function(K,Tko,Fko,CIko,IPko,ISko,Pko,Sko)|GsOut]) :-
+ Gi = function(I,_,Fi,_,IPi,ISi,Pi,_),
+ Gj = function(J,_,Fj,_,_,_,_,Sj),
+ set_union([I], Pi, PiI),
+ set_union([J], Sj, SjJ),
+ (K = J ->
+ set_union(Tk, Fi, Tk2);
+ Tk2 = Tk),
+ (K = I ->
+ set_union(Tk2, Fj, Tk3);
+ Tk3 = Tk2),
+ ((set_member(K, IPi); set_member(K, ISi)) ->
+ set_union(Tk3, [V], Tko);
+ Tko = Tk3),
+ (K = I ->
+ set_union(Fk, [V], Fko);
+ Fko = Fk),
+ ((set_member(K, Pi); K = I) ->
+ set_difference(CIk, SjJ, CIk2);
+ CIk2 = CIk),
+ ((set_member(I, CIk), set_member(V, Fk)) ->
+ set_difference(CIk2, [I], CIk3);
+ CIk3 = CIk2),
+ (K = I ->
+ exclude_if_vector_in_false_set(CIk3, Gs, V, CIk4);
+ CIk4 = CIk3),
+ (K = J ->
+ set_difference(CIk4, [I], CIko);
+ CIko = CIk4),
+ (K = J ->
+ set_union(IPk, [I], IPko);
+ IPko = IPk),
+ (K = I ->
+ set_union(ISk, [J], ISko);
+ ISko = ISk),
+ (set_member(K, SjJ) ->
+ set_union(Pk, PiI, Pko);
+ Pko = Pk),
+ (set_member(K, PiI) ->
+ set_union(Sk, SjJ, Sko);
+ Sko = Sk),
+ update_circuit(GsIn, Gi, Gj, V, Gs, GsOut).
+
+exclude_if_vector_in_false_set([], _, _, []).
+exclude_if_vector_in_false_set([K|CIsIn], Gs, V, CIsOut) :-
+ function(K, Gs, Gk),
+ false_set(Gk, Fk),
+ set_member(V, Fk), !,
+ exclude_if_vector_in_false_set(CIsIn, Gs, V, CIsOut).
+exclude_if_vector_in_false_set([K|CIsIn], Gs, V, [K|CIsOut]) :-
+ exclude_if_vector_in_false_set(CIsIn, Gs, V, CIsOut).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+add_necessary_functions(NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :-
+ add_necessary_functions(NumVars, NumVars, NumGsIn, GsIn,
+ NumGsOut, GsOut).
+
+add_necessary_functions(NumGs, _, NumGs, Gs, NumGs, Gs) :- !.
+add_necessary_functions(K, NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :-
+ function(K, GsIn, Gk),
+ function_type(NumVars, NumGsIn, GsIn, Gk, nf, V), !,
+ false_set(Gk, Fk),
+ new_function_CIs(GsIn,
+ function(NumGsIn,Fk,[V],[],[],[],[],[]),
+ NumVars, Gs, Gl),
+ function(K, Gs, Gk1),
+ update_circuit(Gs, Gl, Gk1, V, Gs, Gs1),
+ NumGs1 is NumGsIn + 1,
+ K1 is K + 1,
+ add_necessary_functions(K1, NumVars, NumGs1, Gs1, NumGsOut, GsOut).
+add_necessary_functions(K, NumVars, NumGsIn, GsIn, NumGsOut, GsOut) :-
+ K1 is K + 1,
+ add_necessary_functions(K1, NumVars, NumGsIn, GsIn, NumGsOut, GsOut).
+
+new_function_CIs(GsIn, function(L,Tl,Fl,_,IPl,ISl,Pl,Sl), NumVars,
+ [GlOut|GsOut], GlOut) :-
+ new_function_CIs(GsIn, L, Fl, NumVars, GsOut, [], CIlo),
+ GlOut = function(L,Tl,Fl,CIlo,IPl,ISl,Pl,Sl).
+
+new_function_CIs([], _, _, _, [], CIl, CIl).
+new_function_CIs([function(K,Tk,Fk,CIk,IPk,ISk,Pk,Sk)|GsIn], L, Fl, NumVars,
+ [function(K,Tk,Fk,CIko,IPk,ISk,Pk,Sk)|GsOut], CIlIn, CIlOut) :-
+ set_intersection(Fl, Fk, []), !,
+ (K >= NumVars ->
+ set_union(CIk, [L], CIko);
+ CIko = CIk),
+ new_function_CIs(GsIn, L, Fl, NumVars, GsOut, [K|CIlIn], CIlOut).
+new_function_CIs([Gk|GsIn], L, Fl, NumVars, [Gk|GsOut], CIlIn, CIlOut) :-
+ new_function_CIs(GsIn, L, Fl, NumVars, GsOut, CIlIn, CIlOut).
+
+function_type(NumVars, NumGs, Gs, Gk, Type, Vector) :-
+ true_set(Gk, Tk),
+ select_vector(Tk, Gk, NumVars, NumGs, Gs,
+ dummy, 0, nf, 999, _, Vector, Type, _).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Cost and constraint predicates:
+
+% very simple bound for now
+
+test_bounds(_, NumGs, _) :-
+ access(bound, Bound),
+ NumGs < Bound.
+
+update_bounds(_, NumGs, _) :-
+ set(bound, NumGs).
+
+% set and access for systems that don't support them
+set(N, A) :-
+ (recorded(N, _, Ref) -> erase(Ref) ; true),
+ recorda(N, A, _).
+
+access(N, A) :-
+ recorded(N, A, _).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Output predicates:
+
+% for now just dump everything
+
+output_results(NumVars, NumGs, Gs) :-
+ NumGates is NumGs - NumVars,
+ write(NumGates), write(' gates'), nl,
+ write_gates(Gs), nl,
+ write('searching for a better solution...'), nl, nl.
+
+write_gates([]).
+write_gates([Gi|Gs]) :-
+ function_number(Gi, I),
+ write('gate #'), write(I), write(' inputs: '),
+ immediate_predecessors(Gi, IPi),
+ write(IPi), nl,
+ write_gates(Gs).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Retrieve the specified function from the function list.
+% function(FunctionNumber, FunctionList, Function).
+function(I, [Gi|_], Gi) :- function_number(Gi, I), !.
+function(I, [_|Gs], Gi) :- function(I, Gs, Gi).
+
+function_number( function(I,_,_,_,_,_,_,_), I).
+true_set( function(_,T,_,_,_,_,_,_), T).
+false_set( function(_,_,F,_,_,_,_,_), F).
+conceivable_inputs( function(_,_,_,CI,_,_,_,_), CI).
+immediate_predecessors( function(_,_,_,_,IP,_,_,_), IP).
+immediate_successors( function(_,_,_,_,_,IS,_,_), IS).
+predecessors( function(_,_,_,_,_,_,P,_), P).
+successors( function(_,_,_,_,_,_,_,S), S).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Set operations assume that the sets are represented by an ordered list
+% of integers.
+
+set_union([], [], []).
+set_union([], [X|L2], [X|L2]).
+set_union([X|L1], [], [X|L1]).
+set_union([X|L1], [X|L2], [X|L3]) :- set_union(L1, L2, L3).
+set_union([X|L1], [Y|L2], [X|L3]) :- X < Y, set_union(L1, [Y|L2], L3).
+set_union([X|L1], [Y|L2], [Y|L3]) :- X > Y, set_union([X|L1], L2, L3).
+
+set_intersection([], [], []).
+set_intersection([], [_|_], []).
+set_intersection([_|_], [], []).
+set_intersection([X|L1], [X|L2], [X|L3]) :- set_intersection(L1, L2, L3).
+set_intersection([X|L1], [Y|L2], L3) :- X < Y, set_intersection(L1, [Y|L2], L3).
+set_intersection([X|L1], [Y|L2], L3) :- X > Y, set_intersection([X|L1], L2, L3).
+
+set_difference([], [], []).
+set_difference([], [_|_], []).
+set_difference([X|L1], [], [X|L1]).
+set_difference([X|L1], [X|L2], L3) :- set_difference(L1, L2, L3).
+set_difference([X|L1], [Y|L2], [X|L3]) :- X < Y, set_difference(L1, [Y|L2], L3).
+set_difference([X|L1], [Y|L2], L3) :- X > Y, set_difference([X|L1], L2, L3).
+
+set_subset([], _).
+set_subset([X|L1], [X|L2]) :- set_subset(L1, L2).
+set_subset([X|L1], [Y|L2]) :- X > Y, set_subset([X|L1], L2).
+
+set_member(X, [X|_]).
+set_member(X, [Y|T]) :- X > Y, set_member(X, T).
diff --git a/examples/benchmarks/holmer/nreverse.in b/examples/benchmarks/holmer/nreverse.in
new file mode 100644
index 0000000..744bf1e
--- /dev/null
+++ b/examples/benchmarks/holmer/nreverse.in
@@ -0,0 +1 @@
+:- '$benchmark'(nreverse, 1000, nreverse, '$dummy').
diff --git a/examples/benchmarks/holmer/nreverse.pl b/examples/benchmarks/holmer/nreverse.pl
new file mode 100644
index 0000000..048ecfa
--- /dev/null
+++ b/examples/benchmarks/holmer/nreverse.pl
@@ -0,0 +1,18 @@
+% generated: 25 October 1989
+% option(s):
+%
+% nreverse
+%
+% David H. D. Warren
+%
+% "naive"-reverse a list of 30 integers
+
+nreverse :- nreverse([1,2,3,4,5,6,7,8,9,10,11,12,
+ 13,14,15,16,17,18,19,20,21,
+ 22,23,24,25,26,27,28,29,30],_).
+
+nreverse([X|L0],L) :- nreverse(L0,L1), concatenate(L1,[X],L).
+nreverse([],[]).
+
+concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3).
+concatenate([],L,L).
diff --git a/examples/benchmarks/holmer/ops8.in b/examples/benchmarks/holmer/ops8.in
new file mode 100644
index 0000000..91548f6
--- /dev/null
+++ b/examples/benchmarks/holmer/ops8.in
@@ -0,0 +1 @@
+:- '$benchmark'(ops8, 1000, ops8, '$dummy').
diff --git a/examples/benchmarks/holmer/ops8.pl b/examples/benchmarks/holmer/ops8.pl
new file mode 100644
index 0000000..2571b4b
--- /dev/null
+++ b/examples/benchmarks/holmer/ops8.pl
@@ -0,0 +1,35 @@
+% generated: 25 October 1989
+% option(s):
+%
+% (deriv) ops8
+%
+% David H. D. Warren
+%
+% symbolic derivative of (x+1)*((^(x,2)+2)*(^(x,3)+3))
+
+ops8 :- d((x+1)*((^(x,2)+2)*(^(x,3)+3)),x,_).
+
+d(U+V,X,DU+DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U-V,X,DU-DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U*V,X,DU*V+U*DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(^(U,N),X,DU*N*(^(U,N1))) :- !,
+ integer(N),
+ N1 is N-1,
+ d(U,X,DU).
+d(-U,X,-DU) :- !,
+ d(U,X,DU).
+d(exp(U),X,exp(U)*DU) :- !,
+ d(U,X,DU).
+d(log(U),X,DU/U) :- !,
+ d(U,X,DU).
+d(X,X,1) :- !.
+d(_,_,0).
diff --git a/examples/benchmarks/holmer/poly_10.in b/examples/benchmarks/holmer/poly_10.in
new file mode 100644
index 0000000..2de2a89
--- /dev/null
+++ b/examples/benchmarks/holmer/poly_10.in
@@ -0,0 +1 @@
+:- '$benchmark'(poly_10, 1000, poly_10, '$dummy').
diff --git a/examples/benchmarks/holmer/poly_10.pl b/examples/benchmarks/holmer/poly_10.pl
new file mode 100644
index 0000000..9175166
--- /dev/null
+++ b/examples/benchmarks/holmer/poly_10.pl
@@ -0,0 +1,101 @@
+% generated: 8 March 1990
+% option(s): NO_TERM_COMPARE
+%
+% (poly) poly_10
+%
+% Ralph Haygood (based on Prolog version by Rick McGeer
+% based on Lisp version by R. P. Gabriel)
+%
+% raise a polynomial (1+x+y+z) to the 10th power (symbolically)
+
+:-op(700,xfx,less_than).
+
+poly_10 :- test_poly(P), poly_exp(10, P, _).
+
+% test polynomial definition
+
+test_poly(P) :-
+ poly_add(poly(x,[term(0,1),term(1,1)]),poly(y,[term(1,1)]),Q),
+ poly_add(poly(z,[term(1,1)]),Q,P).
+
+% 'less_than'/2 for x, y, z
+
+x less_than y.
+y less_than z.
+x less_than z.
+
+% polynomial addition
+
+poly_add(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
+ term_add(Terms1, Terms2, Terms).
+poly_add(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
+ Var1 less_than Var2, !,
+ add_to_order_zero_term(Terms1, poly(Var2,Terms2), Terms).
+poly_add(Poly, poly(Var,Terms2), poly(Var,Terms)) :- !,
+ add_to_order_zero_term(Terms2, Poly, Terms).
+poly_add(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
+ add_to_order_zero_term(Terms1, C, Terms).
+poly_add(C1, C2, C) :-
+ C is C1+C2.
+
+% term addition
+
+term_add([], X, X) :- !.
+term_add(X, [], X) :- !.
+term_add([term(E,C1)|Terms1], [term(E,C2)|Terms2], [term(E,C)|Terms]) :- !,
+ poly_add(C1, C2, C),
+ term_add(Terms1, Terms2, Terms).
+term_add([term(E1,C1)|Terms1], [term(E2,C2)|Terms2], [term(E1,C1)|Terms]) :-
+ E1 < E2, !,
+ term_add(Terms1, [term(E2,C2)|Terms2], Terms).
+term_add(Terms1, [term(E2,C2)|Terms2], [term(E2,C2)|Terms]) :-
+ term_add(Terms1, Terms2, Terms).
+
+add_to_order_zero_term([term(0,C1)|Terms], C2, [term(0,C)|Terms]) :- !,
+ poly_add(C1, C2, C).
+add_to_order_zero_term(Terms, C, [term(0,C)|Terms]).
+
+% polynomial exponentiation
+
+poly_exp(0, _, 1) :- !.
+poly_exp(N, Poly, Result) :-
+ M is N>>1,
+ N is M<<1, !,
+ poly_exp(M, Poly, Part),
+ poly_mul(Part, Part, Result).
+poly_exp(N, Poly, Result) :-
+ M is N-1,
+ poly_exp(M, Poly, Part),
+ poly_mul(Poly, Part, Result).
+
+% polynomial multiplication
+
+poly_mul(poly(Var,Terms1), poly(Var,Terms2), poly(Var,Terms)) :- !,
+ term_mul(Terms1, Terms2, Terms).
+poly_mul(poly(Var1,Terms1), poly(Var2,Terms2), poly(Var1,Terms)) :-
+ Var1 less_than Var2, !,
+ mul_through(Terms1, poly(Var2,Terms2), Terms).
+poly_mul(P, poly(Var,Terms2), poly(Var,Terms)) :- !,
+ mul_through(Terms2, P, Terms).
+poly_mul(poly(Var,Terms1), C, poly(Var,Terms)) :- !,
+ mul_through(Terms1, C, Terms).
+poly_mul(C1, C2, C) :-
+ C is C1*C2.
+
+term_mul([], _, []) :- !.
+term_mul(_, [], []) :- !.
+term_mul([Term|Terms1], Terms2, Terms) :-
+ single_term_mul(Terms2, Term, PartA),
+ term_mul(Terms1, Terms2, PartB),
+ term_add(PartA, PartB, Terms).
+
+single_term_mul([], _, []) :- !.
+single_term_mul([term(E1,C1)|Terms1], term(E2,C2), [term(E,C)|Terms]) :-
+ E is E1+E2,
+ poly_mul(C1, C2, C),
+ single_term_mul(Terms1, term(E2,C2), Terms).
+
+mul_through([], _, []) :- !.
+mul_through([term(E,Term)|Terms], Poly, [term(E,NewTerm)|NewTerms]) :-
+ poly_mul(Term, Poly, NewTerm),
+ mul_through(Terms, Poly, NewTerms).
diff --git a/examples/benchmarks/holmer/prover.in b/examples/benchmarks/holmer/prover.in
new file mode 100644
index 0000000..5418581
--- /dev/null
+++ b/examples/benchmarks/holmer/prover.in
@@ -0,0 +1 @@
+:- '$benchmark'(prover, 1000, prover, '$dummy').
diff --git a/examples/benchmarks/holmer/prover.pl b/examples/benchmarks/holmer/prover.pl
new file mode 100644
index 0000000..e9d42c8
--- /dev/null
+++ b/examples/benchmarks/holmer/prover.pl
@@ -0,0 +1,96 @@
+% generated: 30 October 1989
+% option(s):
+%
+% prover
+%
+% Richard A. O'Keefe
+%
+% Prolog theorem prover
+%
+% from "Prolog Compared with Lisp?," SIGPLAN Notices, v. 18 #5, May 1983
+
+% op/3 directives
+
+:- op(950, xfy, #). % disjunction
+:- op(850, xfy, &). % conjunction
+:- op(500, fx, +). % assertion
+:- op(500, fx, -). % denial
+
+prover :- problem(_, P, C),
+ implies(P, C),
+ fail.
+prover.
+
+% problem set
+
+problem( 1, -a, +a).
+
+problem( 2, +a, -a & -a).
+
+problem( 3, -a, +to_be # -to_be).
+
+problem( 4, -a & -a, -a).
+
+problem( 5, -a, +b # -a).
+
+problem( 6, -a & -b, -b & -a).
+
+problem( 7, -a, -b # (+b & -a)).
+
+problem( 8, -a # (-b # +c), -b # (-a # +c)).
+
+problem( 9, -a # +b, (+b & -c) # (-a # +c)).
+
+problem( 10, (-a # +c) & (-b # +c), (-a & -b) # +c).
+
+% Prolog theorem prover
+
+implies(Premise, Conclusion) :-
+ opposite(Conclusion, Denial),
+ add_conjunction(Premise, Denial, fs([],[],[],[])).
+
+opposite(F0 & G0, F1 # G1) :- !,
+ opposite(F0, F1),
+ opposite(G0, G1).
+opposite(F1 # G1, F0 & G0) :- !,
+ opposite(F1, F0),
+ opposite(G1, G0).
+opposite(+Atom, -Atom) :- !.
+opposite(-Atom, +Atom).
+
+add_conjunction(F, G, Set) :-
+ expand(F, Set, Mid),
+ expand(G, Mid, New),
+ refute(New).
+
+expand(_, refuted, refuted) :- !.
+expand(F & G, fs(D,_,_,_), refuted) :-
+ includes(D, F & G), !.
+expand(F & G, fs(D,C,P,N), fs(D,C,P,N)) :-
+ includes(C, F & G), !.
+expand(F & G, fs(D,C,P,N), New) :- !,
+ expand(F, fs(D,[F & G|C],P,N), Mid),
+ expand(G, Mid, New).
+expand(F # G, fs(D,C,P,N), Set) :- !,
+ opposite(F # G, Conj),
+ extend(Conj, D, C, D1, fs(D1,C,P,N), Set).
+expand(+Atom, fs(D,C,P,N), Set) :- !,
+ extend(Atom, P, N, P1, fs(D,C,P1,N), Set).
+expand(-Atom, fs(D,C,P,N), Set) :-
+ extend(Atom, N, P, N1, fs(D,C,P,N1), Set).
+
+includes([Head|_], Head) :- !.
+includes([_|Tail], This) :- includes(Tail, This).
+
+extend(Exp, _, Neg, _, _, refuted) :- includes(Neg, Exp), !.
+extend(Exp, Pos, _, Pos, Set, Set) :- includes(Pos, Exp), !.
+extend(Exp, Pos, _, [Exp|Pos], Set, Set).
+
+refute(refuted) :- !.
+refute(fs([F1 & G1|D], C, P, N)) :-
+ opposite(F1, F0),
+ opposite(G1, G0),
+ Set = fs(D, C, P, N),
+ add_conjunction(F0, G1, Set),
+ add_conjunction(F0, G0, Set),
+ add_conjunction(F1, G0, Set).
diff --git a/examples/benchmarks/holmer/qsort.in b/examples/benchmarks/holmer/qsort.in
new file mode 100644
index 0000000..bf69517
--- /dev/null
+++ b/examples/benchmarks/holmer/qsort.in
@@ -0,0 +1 @@
+:- '$benchmark'(qsort, 1000, qsort, '$dummy').
diff --git a/examples/benchmarks/holmer/qsort.pl b/examples/benchmarks/holmer/qsort.pl
new file mode 100644
index 0000000..ae5ddf8
--- /dev/null
+++ b/examples/benchmarks/holmer/qsort.pl
@@ -0,0 +1,27 @@
+% generated: 16 November 1989
+% option(s): SOURCE_TRANSFORM_1
+%
+% qsort
+%
+% David H. D. Warren
+%
+% quicksort a list of 50 integers
+
+qsort :- qsort([27,74,17,33,94,18,46,83,65, 2,
+ 32,53,28,85,99,47,28,82, 6,11,
+ 55,29,39,81,90,37,10, 0,66,51,
+ 7,21,85,27,31,63,75, 4,95,99,
+ 11,28,61,74,18,92,40,53,59, 8],_,[]).
+
+qsort([X|L],R,R0) :-
+ partition(L,X,L1,L2),
+ qsort(L2,R1,R0),
+ qsort(L1,R,[X|R1]).
+qsort([],R,R).
+
+partition([X|L],Y,[X|L1],L2) :-
+ X =< Y, !,
+ partition(L,Y,L1,L2).
+partition([X|L],Y,L1,[X|L2]) :-
+ partition(L,Y,L1,L2).
+partition([],_,[],[]).
diff --git a/examples/benchmarks/holmer/queens_8.in b/examples/benchmarks/holmer/queens_8.in
new file mode 100644
index 0000000..ad3a8e7
--- /dev/null
+++ b/examples/benchmarks/holmer/queens_8.in
@@ -0,0 +1 @@
+:- '$benchmark'(queens_8, 1000, queens_8, '$dummy').
diff --git a/examples/benchmarks/holmer/queens_8.pl b/examples/benchmarks/holmer/queens_8.pl
new file mode 100644
index 0000000..ca0da20
--- /dev/null
+++ b/examples/benchmarks/holmer/queens_8.pl
@@ -0,0 +1,62 @@
+% generated: 10 November 1989
+% option(s):
+%
+% (queens) queens_8
+%
+% from Sterling and Shapiro, "The Art of Prolog," page 211.
+%
+% solve the 8 queens problem
+
+queens_8 :- queens(8,_), !.
+
+% This program solves the N queens problem: place N pieces on an N
+% by N rectangular board so that no two pieces are on the same line
+% - horizontal, vertical, or diagonal. (N queens so placed on an N
+% by N chessboard are unable to attack each other in a single move
+% under the rules of chess.) The strategy is incremental generate-
+% and-test.
+%
+% A solution is specified by a permutation of the list of numbers 1 to
+% N. The first element of the list is the row number for the queen in
+% the first column, the second element is the row number for the queen
+% in the second column, et cetera. This scheme implicitly incorporates
+% the observation that any solution of the problem has exactly one queen
+% in each column.
+%
+% The program distinguishes symmetric solutions. For example,
+%
+% ?- queens(4, Qs).
+%
+% produces
+%
+% Qs = [3,1,4,2] ;
+%
+% Qs = [2,4,1,3]
+
+queens(N,Qs) :-
+ range(1,N,Ns),
+ queens(Ns,[],Qs).
+
+queens([],Qs,Qs).
+queens(UnplacedQs,SafeQs,Qs) :-
+ select(UnplacedQs,UnplacedQs1,Q),
+ not_attack(SafeQs,Q),
+ queens(UnplacedQs1,[Q|SafeQs],Qs).
+
+not_attack(Xs,X) :-
+ not_attack(Xs,X,1).
+
+not_attack([],_,_) :- !.
+not_attack([Y|Ys],X,N) :-
+ X =\= Y+N, X =\= Y-N,
+ N1 is N+1,
+ not_attack(Ys,X,N1).
+
+select([X|Xs],Xs,X).
+select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X).
+
+range(N,N,[N]) :- !.
+range(M,N,[M|Ns]) :-
+ M < N,
+ M1 is M+1,
+ range(M1,N,Ns).
diff --git a/examples/benchmarks/holmer/query.in b/examples/benchmarks/holmer/query.in
new file mode 100644
index 0000000..974b9e2
--- /dev/null
+++ b/examples/benchmarks/holmer/query.in
@@ -0,0 +1 @@
+:- '$benchmark'(query, 1000, query, '$dummy').
diff --git a/examples/benchmarks/holmer/query.pl b/examples/benchmarks/holmer/query.pl
new file mode 100644
index 0000000..d22cd5f
--- /dev/null
+++ b/examples/benchmarks/holmer/query.pl
@@ -0,0 +1,79 @@
+% generated: 17 November 1989
+% option(s): SOURCE_TRANSFORM_1
+%
+% query
+%
+% David H. D. Warren
+%
+% query population and area database to find coun-
+% tries of approximately equal population density
+
+query :- query(_), fail.
+query.
+
+query([C1,D1,C2,D2]) :-
+ density(C1,D1),
+ density(C2,D2),
+ D1 > D2,
+ T1 is 20*D1,
+ T2 is 21*D2,
+ T1 < T2.
+
+density(C,D) :-
+ pop(C,P),
+ area(C,A),
+ D is (P*100)//A.
+
+% populations in 100000's
+pop(china, 8250).
+pop(india, 5863).
+pop(ussr, 2521).
+pop(usa, 2119).
+pop(indonesia, 1276).
+pop(japan, 1097).
+pop(brazil, 1042).
+pop(bangladesh, 750).
+pop(pakistan, 682).
+pop(w_germany, 620).
+pop(nigeria, 613).
+pop(mexico, 581).
+pop(uk, 559).
+pop(italy, 554).
+pop(france, 525).
+pop(philippines, 415).
+pop(thailand, 410).
+pop(turkey, 383).
+pop(egypt, 364).
+pop(spain, 352).
+pop(poland, 337).
+pop(s_korea, 335).
+pop(iran, 320).
+pop(ethiopia, 272).
+pop(argentina, 251).
+
+% areas in 1000's of square miles
+area(china, 3380).
+area(india, 1139).
+area(ussr, 8708).
+area(usa, 3609).
+area(indonesia, 570).
+area(japan, 148).
+area(brazil, 3288).
+area(bangladesh, 55).
+area(pakistan, 311).
+area(w_germany, 96).
+area(nigeria, 373).
+area(mexico, 764).
+area(uk, 86).
+area(italy, 116).
+area(france, 213).
+area(philippines, 90).
+area(thailand, 200).
+area(turkey, 296).
+area(egypt, 386).
+area(spain, 190).
+area(poland, 121).
+area(s_korea, 37).
+area(iran, 628).
+area(ethiopia, 350).
+area(argentina, 1080).
diff --git a/examples/benchmarks/holmer/reducer.in b/examples/benchmarks/holmer/reducer.in
new file mode 100644
index 0000000..feb66d0
--- /dev/null
+++ b/examples/benchmarks/holmer/reducer.in
@@ -0,0 +1 @@
+:- '$benchmark'(reducer, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/reducer.pl b/examples/benchmarks/holmer/reducer.pl
new file mode 100644
index 0000000..b95281b
--- /dev/null
+++ b/examples/benchmarks/holmer/reducer.pl
@@ -0,0 +1,379 @@
+/* CHANGELOG by M.Banbara
+ - comment out write/1 and nl/0
+*/
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% A Graph Reducer for T-Combinators:
+% Reduces a T-combinator expression to a final answer. Recognizes
+% the combinators I,K,S,B,C,S',B',C', cond, apply, arithmetic, tests,
+% basic list operations, and function definitions in the data base stored
+% as facts of the form t_def(_func, _args, _expr).
+% Written by Peter Van Roy
+
+% Uses write/1, compare/3, functor/3, arg/3.
+main :-
+ try(fac(3), _ans1),
+ %write(_ans1), nl,
+ try(quick([3,1,2]), _ans2).
+ %write(_ans2), nl.
+
+try(_inpexpr, _anslist) :-
+ listify(_inpexpr, _list),
+ curry(_list, _curry),
+ t_reduce(_curry, _ans), %nl,
+ make_list(_ans, _anslist).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Examples of applicative functions which can be compiled & executed.
+% This test version compiles them just before each execution.
+
+% Factorial function:
+t_def(fac, [N], cond(N=0, 1, N*fac(N-1))).
+
+% Quicksort:
+t_def(quick, [_l], cond(_l=[], [],
+ cond(tl(_l)=[], _l,
+ quick2(split(hd(_l),tl(_l)))))).
+t_def(quick2, [_l], append(quick(hd(_l)), quick(tl(_l)))).
+
+t_def(split, [_e,_l], cond(_l=[], [[_e]|[]],
+ cond(hd(_l)=<_e, inserthead(hd(_l),split(_e,tl(_l))),
+ inserttail(hd(_l),split(_e,tl(_l)))))).
+t_def(inserthead, [_e,_l], [[_e|hd(_l)]|tl(_l)]).
+t_def(inserttail, [_e,_l], [hd(_l)|[_e|tl(_l)]]).
+
+t_def(append, [_a,_b], cond(_a=[], _b, [hd(_a)|append(tl(_a),_b)])).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Full reduction:
+% A dot '.' is printed for each reduction step.
+
+t_reduce(_expr, _ans) :-
+ atomic(_expr), !,
+ _ans=_expr.
+% The reduction of '.' must be here to avoid an infinite loop
+t_reduce([_y,_x|'.'], [_yr,_xr|'.']) :-
+ t_reduce(_x, _xr),
+ !,
+ t_reduce(_y, _yr),
+ !.
+t_reduce(_expr, _ans) :-
+ t_append(_next, _red, _form, _expr),
+ %write('.'),
+ t_redex(_form, _red),
+ !,
+ t_reduce(_next, _ans),
+ !.
+
+t_append(_link, _link, _l, _l).
+t_append([_a|_l1], _link, _l2, [_a|_l3]) :- t_append(_l1, _link, _l2, _l3).
+
+% One step of the reduction:
+
+% Combinators:
+t_redex([_x,_g,_f,_k|sp], [[_xr|_g],[_xr|_f]|_k]) :- t_reduce(_x, _xr).
+t_redex([_x,_g,_f,_k|bp], [[_x|_g],_f|_k]).
+t_redex([_x,_g,_f,_k|cp], [_g,[_x|_f]|_k]).
+t_redex([_x,_g,_f|s], [[_xr|_g]|[_xr|_f]]) :- t_reduce(_x, _xr).
+t_redex([_x,_g,_f|b], [[_x|_g]|_f]).
+t_redex([_x,_g,_f|c], [_g,_x|_f]).
+t_redex([_y,_x|k], _x).
+t_redex([_x|i], _x).
+
+% Conditional:
+t_redex([_elsepart,_ifpart,_cond|cond], _ifpart) :-
+ t_reduce(_cond, _bool), _bool=true, !.
+ % Does NOT work if _bool is substituted in the call!
+t_redex([_elsepart,_ifpart,_cond|cond], _elsepart).
+
+% Apply:
+t_redex([_f|apply], _fr) :-
+ t_reduce(_f, _fr).
+
+% List operations:
+t_redex([_arg|hd], _x) :-
+ t_reduce(_arg, [_y,_x|'.']).
+t_redex([_arg|tl], _y) :-
+ t_reduce(_arg, [_y,_x|'.']).
+
+% Arithmetic:
+t_redex([_y,_x|_op], _res) :-
+ atom(_op),
+ member(_op, ['+', '-', '*', '//', 'mod']),
+ t_reduce(_x, _xres),
+ t_reduce(_y, _yres),
+ number(_xres), number(_yres),
+ eval(_op, _res, _xres, _yres).
+
+% Tests:
+t_redex([_y,_x|_test], _res) :-
+ atom(_test),
+ member(_test, ['<', '>', '=<', '>=', '=\=', '=:=']),
+ t_reduce(_x, _xres),
+ t_reduce(_y, _yres),
+ number(_xres), number(_yres),
+ (relop(_test, _xres, _yres)
+ -> _res=true
+ ; _res=false
+ ), !.
+
+% Equality:
+t_redex([_y,_x|=], _res) :-
+ t_reduce(_x, _xres),
+ t_reduce(_y, _yres),
+ (_xres=_yres -> _res=true; _res=false), !.
+
+% Arithmetic functions:
+t_redex([_x|_op], _res) :-
+ atom(_op),
+ member(_op, ['-']),
+ t_reduce(_x, _xres),
+ number(_xres),
+ eval1(_op, _t, _xres).
+
+% Definitions:
+% Assumes a fact t_def(_func,_def) in the database for every
+% defined function.
+t_redex(_in, _out) :-
+ append(_par,_func,_in),
+ atom(_func),
+ t_def(_func, _args, _expr),
+ t(_args, _expr, _def),
+ append(_par,_def,_out).
+
+% Basic arithmetic and relational operators:
+
+eval( '+', C, A, B) :- C is A + B.
+eval( '-', C, A, B) :- C is A - B.
+eval( '*', C, A, B) :- C is A * B.
+eval( '//', C, A, B) :- C is A // B.
+eval('mod', C, A, B) :- C is A mod B.
+
+eval1('-', C, A) :- C is -A.
+
+relop( '<', A, B) :- A<B.
+relop( '>', A, B) :- A>B.
+relop( '=<', A, B) :- A=<B.
+relop( '>=', A, B) :- A>=B.
+relop('=\=', A, B) :- A=\=B.
+relop('=:=', A, B) :- A=:=B.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Scheme T:
+% A Translation Scheme for T-Combinators
+
+% Translate an expression to combinator form
+% by abstracting out all variables in _argvars:
+t(_argvars, _expr, _trans) :-
+ listify(_expr, _list),
+ curry(_list, _curry),
+ t_argvars(_argvars, _curry, _trans), !.
+
+t_argvars([], _trans, _trans).
+t_argvars([_x|_argvars], _in, _trans) :-
+ t_argvars(_argvars, _in, _mid),
+ t_vars(_mid, _vars), % calculate variables in each subexpression
+ t_trans(_x, _mid, _vars, _trans). % main translation routine
+
+% Curry the original expression:
+% This converts an applicative expression of any number
+% of arguments and any depth of nesting into an expression
+% where all functions are curried, i.e. all function
+% applications are to one argument and have the form
+% [_arg|_func] where _func & _arg are also of that form.
+% Input is a nested function application in list form.
+% Currying makes t_trans faster.
+curry(_a, _a) :- (var(_a); atomic(_a)), !.
+curry([_func|_args], _cargs) :-
+ currylist(_args, _cargs, _func).
+
+% Transform [_a1, ..., _aN] to [_cN, ..., _c1|_link]-_link
+currylist([], _link, _link) :- !.
+currylist([_a|_args], _cargs, _link) :-
+ curry(_a, _c),
+ currylist(_args, _cargs, [_c|_link]).
+
+% Calculate variables in each subexpression:
+% To any expression a list of the form
+% [_vexpr, _astr, _fstr] is matched.
+% If the expression is a variable or an atom
+% then this list only has the first element.
+% _vexpr = List of all variables in the expression.
+% _astr, _fstr = Similar structures for argument & function.
+t_vars(_v, [[_v]]) :- var(_v), !.
+t_vars(_a, [[]]) :- atomic(_a), !.
+t_vars([_func], [[]]) :- atomic(_func), !.
+t_vars([_arg|_func], [_g,[_g1|_af1],[_g2|_af2]]) :-
+ t_vars(_arg, [_g1|_af1]),
+ t_vars(_func, [_g2|_af2]),
+ unionv(_g1, _g2, _g).
+
+% The main translation routine:
+% trans(_var, _curriedexpr, _varexpr, _result)
+% The translation scheme T in the article is followed literally.
+% A good example of Prolog as a specification language.
+t_trans(_x, _a, _, [_a|k]) :- (atomic(_a); var(_a), _a\==_x), !.
+t_trans(_x, _y, _, i) :- _x==_y, !.
+t_trans(_x, _e, [_ve|_], [_e|k]) :- notinv(_x, _ve).
+t_trans(_x, [_f|_e], [_vef,_sf,_se], _res) :-
+ _sf=[_vf|_],
+ _se=[_ve|_other],
+ (atom(_e); _other=[_,[_ve1|_]], _ve1\==[]),
+ t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, _res).
+t_trans(_x, [_g|[_f|_e]], [_vefg,_sg,_sef], _res) :-
+ _sg=[_vg|_],
+ _sef=[_vef,_sf,_se],
+ _se=[_ve|_],
+ _sf=[_vf|_],
+ t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, _res).
+
+% First complex rule of translation scheme T:
+t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, _e) :-
+ notinv(_x, _ve), _x==_f, !.
+t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, [_resf,_e|b]) :-
+ notinv(_x, _ve), inv(_x, _vf), _x\==_f, !,
+ t_trans(_x, _f, _sf, _resf).
+t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, [_f,_rese|c]) :-
+ /* inv(_x, _ve), */
+ notinv(_x, _vf), !,
+ t_trans(_x, _e, _se, _rese).
+t_rule1(_x, _e, _ve, _se, _f, _vf, _sf, [_resf,_rese|s]) :-
+ /* inv(_x, _ve), inv(_x, _vf), */
+ t_trans(_x, _e, _se, _rese),
+ t_trans(_x, _f, _sf, _resf).
+
+% Second complex rule of translation scheme T:
+t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_g,_e|c]) :-
+ _x==_f, notinv(_x, _vg), !.
+t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_resg,_e|s]) :-
+ _x==_f, /* inv(_x, _vg), */ !,
+ t_trans(_x, _g, _sg, _resg).
+t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_g,_resf,_e|cp]) :-
+ /* _x\==_f, */ inv(_x, _vf), notinv(_x, _vg), !,
+ t_trans(_x, _f, _sf, _resf).
+t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_resg,_resf,_e|sp]) :-
+ /* _x\==_f, */ inv(_x, _vf), /* inv(_x, _vg), */ !,
+ t_trans(_x, _f, _sf, _resf),
+ t_trans(_x, _g, _sg, _resg).
+t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_f|_e]) :-
+ /* notinv(_x, _vf), */ _x==_g, !.
+t_rule2(_x, _e, _f, _vf, _sf, _g, _vg, _sg, [_resg,_f,_e|bp]) :-
+ /* notinv(_x, _vf), inv(_x, _vg), _x\==_g, */
+ t_trans(_x, _g, _sg, _resg).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% List utilities:
+
+% Convert curried list into a regular list:
+make_list(_a, _a) :- atomic(_a).
+make_list([_b,_a|'.'], [_a|_rb]) :- make_list(_b, _rb).
+
+listify(_X, _X) :-
+ (var(_X); atomic(_X)), !.
+listify(_Expr, [_Op|_LArgs]) :-
+ functor(_Expr, _Op, N),
+ listify_list(1, N, _Expr, _LArgs).
+
+listify_list(I, N, _, []) :- I>N, !.
+listify_list(I, N, _Expr, [_LA|_LArgs]) :- I=<N, !,
+ arg(I, _Expr, _A),
+ listify(_A, _LA),
+ I1 is I+1,
+ listify_list(I1, N, _Expr, _LArgs).
+
+member(X, [X|_]).
+member(X, [_|L]) :- member(X, L).
+
+append([], L, L).
+append([X|L1], L2, [X|L3]) :- append(L1, L2, L3).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Set utilities:
+% Implementation inspired by R. O'Keefe, Practical Prolog.
+% Sets are represented as sorted lists without duplicates.
+% Predicates with 'v' suffix work with sets containing uninstantiated vars.
+
+% *** Intersection
+intersectv([], _, []).
+intersectv([A|S1], S2, S) :- intersectv_2(S2, A, S1, S).
+
+intersectv_2([], _, _, []).
+intersectv_2([B|S2], A, S1, S) :-
+ compare(Order, A, B),
+ intersectv_3(Order, A, S1, B, S2, S).
+
+intersectv_3(<, _, S1, B, S2, S) :- intersectv_2(S1, B, S2, S).
+intersectv_3(=, A, S1, _, S2, [A|S]) :- intersectv(S1, S2, S).
+intersectv_3(>, A, S1, _, S2, S) :- intersectv_2(S2, A, S1, S).
+
+intersectv_list([], []).
+intersectv_list([InS|Sets], OutS) :- intersectv_list(Sets, InS, OutS).
+
+intersectv_list([]) --> [].
+intersectv_list([S|Sets]) --> intersectv(S), intersectv_list(Sets).
+
+% *** Difference
+diffv([], _, []).
+diffv([A|S1], S2, S) :- diffv_2(S2, A, S1, S).
+
+diffv_2([], A, S1, [A|S1]).
+diffv_2([B|S2], A, S1, S) :-
+ compare(Order, A, B),
+ diffv_3(Order, A, S1, B, S2, S).
+
+diffv_3(<, A, S1, B, S2, [A|S]) :- diffv(S1, [B|S2], S).
+diffv_3(=, A, S1, _, S2, S) :- diffv(S1, S2, S).
+diffv_3(>, A, S1, _, S2, S) :- diffv_2(S2, A, S1, S).
+
+% *** Union
+unionv([], S2, S2).
+unionv([A|S1], S2, S) :- unionv_2(S2, A, S1, S).
+
+unionv_2([], A, S1, [A|S1]).
+unionv_2([B|S2], A, S1, S) :-
+ compare(Order, A, B),
+ unionv_3(Order, A, S1, B, S2, S).
+
+unionv_3(<, A, S1, B, S2, [A|S]) :- unionv_2(S1, B, S2, S).
+unionv_3(=, A, S1, _, S2, [A|S]) :- unionv(S1, S2, S).
+unionv_3(>, A, S1, B, S2, [B|S]) :- unionv_2(S2, A, S1, S).
+
+% *** Subset
+subsetv([], _).
+subsetv([A|S1], [B|S2]) :-
+ compare(Order, A, B),
+ subsetv_2(Order, A, S1, S2).
+
+subsetv_2(=, _, S1, S2) :- subsetv(S1, S2).
+subsetv_2(>, A, S1, S2) :- subsetv([A|S1], S2).
+
+% For unordered lists S1:
+small_subsetv([], _).
+small_subsetv([A|S1], S2) :- inv(A, S2), small_subsetv(S1, S2).
+
+% *** Membership
+inv(A, [B|S]) :-
+ compare(Order, A, B),
+ inv_2(Order, A, S).
+
+inv_2(=, _, _).
+inv_2(>, A, S) :- inv(A, S).
+
+% *** Non-membership
+notinv(A, S) :- notinv_2(S, A).
+
+notinv_2([], _).
+notinv_2([B|S], A) :-
+ compare(Order, A, B),
+ notinv_3(Order, A, S).
+
+notinv_3(<, _, _).
+notinv_3(>, A, S) :- notinv_2(S, A).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/examples/benchmarks/holmer/sdda.in b/examples/benchmarks/holmer/sdda.in
new file mode 100644
index 0000000..33a6b7f
--- /dev/null
+++ b/examples/benchmarks/holmer/sdda.in
@@ -0,0 +1 @@
+:- '$benchmark'(sdda, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/sdda.pl b/examples/benchmarks/holmer/sdda.pl
new file mode 100644
index 0000000..c61c1c3
--- /dev/null
+++ b/examples/benchmarks/holmer/sdda.pl
@@ -0,0 +1,330 @@
+/* CHANGELOG by M.Banbara
+ - add ':- dynamic unify/3.' since unify/3 is not defined.
+ - rename name/2 to atom_codes/2
+*/
+
+:- dynamic unify/3.
+
+% Sdda3 5-Oct-86
+% For use on simulator
+
+%% To do: (look for '%%')
+%% recursion - keep list of call procedures, ignore recursive calls
+%% problem: doesn't work for typical procedure working on a list,
+%% since the list is smaller (different) each time.
+%% possible optimization: "recognize" base case & skip to it
+%% follow atoms, g is 'any atom', all others unique, does it work?
+%% stats - write heapused, cputime to files (as comments)
+%% worst_case - handle ground terms (copy unify, modify atomic)
+%% handle disjunction - needs worst_case
+%% add cuts where possible to save space
+%% fill in rest of built-ins
+%% how to handle op?
+%% Handle assert/retract? call? (If given ground terms- ok, vars- no)
+%% must have ground functor, definite number of args!
+
+% Front end for simulator use
+main :-
+ do_sdda(test,A,B,C).
+
+% Does the sdda on FileName, instantiates Exitmodes to list of exit modes,
+% ExitModes structure: [[Funtor/Arity, Activation, Exit], ... ],
+% e.g. [[a/2, [g,X], [g,g]]
+do_sdda(FileName, ExitModes, BackList, PredList) :-
+ %%see(FileName),
+ read_procedures(Procs, ExitModes, Entries), % collect all procedures
+ %%seen,
+ write('Procedures '), nl, write_list(Procs), nl,
+ write('Entry points '), nl, write_list(Entries), nl,
+ (nonvar(ExitModes) -> % Don't mention there
+ (write('Declared exit modes '), nl, % aren't any
+ write_list(ExitModes), nl) ;
+ true),
+ entry_exit_modes_list(Procs, ExitModes, Entries),
+ write('Exit modes '), nl, write_list(ExitModes), nl.
+
+%%% !!! Hard code in read for test:
+% sdda_entry(c(A,B,C)).
+% a(X, Y).
+% a(X, X).
+% c(A,B,C) :- a(A,B).
+
+read_procedures([[a/2,a(_109,_110),a(_148,_148)|_184],
+ [c/3,(c(_191,_192,_193):-a(_191,_192))|_238]|_239],
+ _68,[c(_76,_77,_78)|_102]) :- !.
+
+% For each entry point in Entries do sdda, building Known, an unbound-tail list
+% Known structure: [[Name/Arity, ActivationModes, ExitModes], ...|_],
+% where ActivationModes and ExitModes are lists of variables and the atom 'g'.
+% 'g' represents a ground element and variables represent equivalence classes.
+entry_exit_modes_list(_, _, Entries) :- % Done
+ var(Entries).
+entry_exit_modes_list(ProcList, Known, [Entry|Entries]) :-
+ Entry =.. [Functor|Act], % Get functor/arity & activation
+ length(Act, Arity), % from entry declaration
+ proc_exit_mode(ProcList, Known, [], Functor/Arity, Act, _), % No invoc.
+ entry_exit_modes_list(ProcList, Known, Entries).
+
+% Do sdda on procedure Functor/Arity, given activation mode Act. Instantiates
+% Known to known exit modes and Act to exit modes for Functor/Arity under Act
+proc_exit_mode(_, _, _, Functor/Arity, Act, Exit) :-
+ built_in(Functor/Arity, Act, Exit). % This is a built-in
+proc_exit_mode(_, Known, _, Functor/Arity, Act, Exit) :-
+ look_up_act([Functor/Arity, Act, Exit], Known). % Already did this
+proc_exit_mode(ProcList, Known, Invocations, Functor/Arity, Act, Exit) :-
+ umember([Functor/Arity|Clauses], ProcList), % Look up definition
+ dup(Clauses, ClausesCopy), % Don't munge original
+ clause_exit_modes_list(ProcList, Known, Invocations,
+ ClausesCopy, Act, Exits),
+ (Exits=[] -> fail ; true), % didn't find any => fail
+ worst_case(Exits, Exit), % assume the worst
+ dup(Act, ActCopy), % Need copy because Body
+ add_to_list([Functor/Arity, ActCopy, Exit], Known). % binds Act & Exit
+proc_exit_mode(_, Known, _, Functor/Arity, Act, Exit) :-
+ write('No such procedure at compile time '),
+ Activation=..[Functor|Act],
+ write(Activation), nl,
+ all_shared(Act, Exit), % return worst possible - all shared
+ add_to_list([Functor/Arity, Act, Exit], Known).
+
+% Analyze all clauses for this procedure, instantiate Exits to all exit modes
+clause_exit_modes_list(_, _, _, Clauses, _, []) :-
+ var(Clauses), !. % No more clauses => done
+clause_exit_modes_list(ProcList, Known, Invocations,
+ [Clause|Clauses], Act, Exits) :-
+ eqmember([Clause, Act], Invocations), % This is a recursive
+ write('skipping clause exit mode for '),
+ write(Clause), write(' '), write(Act), nl,
+ clause_exit_modes_list(ProcList, Known, Invocations, % call, ignore
+ Clauses, Act, Exits). % it
+clause_exit_modes_list(ProcList, Known, Invocations,
+ [Clause|Clauses], Act, [Exit|Exits]) :-
+ dup(Act, Exit), % We'll bind Exit
+ clause_exit_mode(ProcList, Known, [[Clause, Act]|Invocations],
+ Clause, Exit), % Record invocation
+ clause_exit_modes_list(ProcList, Known, Invocations,
+ Clauses, Act, Exits).
+clause_exit_modes_list(ProcList, Known, Invocations,
+ [Clause|Clauses], Act, Exits) :- % Unify failed
+ clause_exit_modes_list(ProcList, Known, Invocations,
+ Clauses, Act, Exits).
+
+% Given activation modes for this clause, return its exit modes
+clause_exit_mode(ProcList, Known, Invocations, Clause, Act) :-
+ (Clause = ':-'(Head, Body) ; Clause=Head, Body=true), % Decompose it
+ Head =.. [_|Args], % Bind the head
+ unify(Args, Act), % to activation
+ body_exit_mode(ProcList, Known, Invocations, Body). % do the body
+
+body_exit_mode(ProcList, Known, Invocations, ','(Goal, Goals)) :- % Conjunction
+ body_exit_mode(ProcList, Known, Invocations, Goal), % Do 1st
+ body_exit_mode(ProcList, Known, Invocations, Goals). % & rest
+body_exit_mode(ProcList, Known, Invocation, Goal) :-
+ functor(Goal, Functor, Arity),
+ Goal =.. [Functor|Act],
+ proc_exit_mode(ProcList, Known, Invocation, Functor/Arity, Act, Exit),
+ unify(Act, Exit).
+
+% Unifies Left and Right with the special case that the atom 'g' matches
+% any atom (except [])
+unify(Left, Left) :- !. % Try standard unify first
+unify(Left, g) :- % else, is it special case
+ atomic(Left), !,
+ \+ Left=[].
+unify(g, Right) :-
+ atomic(Right), !,
+ \+ Right=[].
+unify([LeftHead|LeftTail], [RightHead|RightTail]) :- % or list
+ !, unify(LeftHead, RightHead),
+ unify(LeftTail, RightTail).
+unify(Left, Right) :- % or structure
+ Left =.. [Functor|LeftArgs],
+ Right =.. [Functor|RightArgs],
+ unify(LeftArgs, RightArgs).
+
+% Succeed if Left and Right are equivalent, i.e. they are the exact same
+% with variables renamed
+equiv(Left, Right) :-
+ equiv(Left, Right, _).
+equiv(Left, Right, _) :-
+ Left==Right, !.
+equiv(g, Right, _) :-
+ atomic(Right), !,
+ \+ Right=[].
+equiv(Left, g, _) :-
+ atomic(Left), !,
+ \+ Left=[].
+equiv(Left, Right, Bindings) :-
+ var(Left), !,
+ var(Right),
+ equiv_vars(Left, Right, Bindings).
+equiv(Left, Right, Bindings) :-
+ var(Right), !,
+ var(Left),
+ equiv_vars(Left, Right, Bindings).
+equiv([LeftHead|LeftTail], [RightHead|RightTail], Bindings) :-
+ !, equiv(LeftHead, RightHead, Bindings),
+ equiv(LeftTail, RightTail, Bindings).
+equiv(Left, Right, Bindings) :-
+ Left=..[Functor|LeftArgs],
+ Right=..[Functor|RightArgs],
+ equiv(LeftArgs, RightArgs, Bindings).
+
+equiv_vars(Left, Right, Bindings) :-
+ var(Bindings), !,
+ Bindings=[[Left, Right]|_].
+equiv_vars(Left, Right, [[AnyVar, AnyBinding]|_]) :-
+ Left==AnyVar, !,
+ Right==AnyBinding.
+equiv_vars(Left, Right, [[AnyVar, AnyBinding]|_]) :-
+ Right==AnyBinding, !,
+ Left==AnyVar.
+equiv_vars(Left, Right, [ _|Bindings]) :-
+ equiv_vars(Left, Right, Bindings).
+
+% Make a copy of Orig with new vars. Copy must be a variable.
+% E.g. dup([A,s(A,B),[B,C]], New) binds New to [X,s(X,Y),[Y,Z]]
+dup(Orig, Copy) :-
+ dup(Orig, Copy, _).
+dup(Orig, Copy, Bindings) :-
+ var(Orig), !,
+ dup_var(Orig, Copy, Bindings).
+dup(Orig, Orig, _) :- % Atoms, including []
+ atomic(Orig), !.
+dup([OrigHead|OrigTail], [CopyHead|CopyTail], Bindings) :-
+ !, dup(OrigHead, CopyHead, Bindings),
+ dup(OrigTail, CopyTail, Bindings).
+dup(Orig, Copy, Bindings) :-
+ Orig=..[Functor|OrigArgs],
+ dup(OrigArgs, CopyArgs, Bindings),
+ Copy=..[Functor|CopyArgs].
+
+dup_var(Orig, Copy, Bindings) :-
+ var(Bindings), !,
+ Bindings=[[Orig, Copy]|_].
+dup_var(Orig, Copy, [[AnyVar, Copy]|_]) :-
+ Orig==AnyVar, !.
+dup_var(Orig, Copy, [_|Bindings]) :-
+ dup_var(Orig, Copy, Bindings).
+
+% ----- Built-ins ----- %
+
+built_in(true/0, [], []). % No change
+built_in(fail/0, [], []). % No change
+built_in('='/2, [X, Y], [g, g]) :-
+ (atomic(X) ; atomic(Y)). % Ground both if either atomic
+built_in('='/2, [X, Y], [X, X]). % else bind them
+built_in(/('+',2), [X, Y], [X, Y]). % No change
+built_in(/('-',2), [X, Y], [X, Y]). % No change
+built_in(/('*',2), [X, Y], [X, Y]). % No change
+built_in(/('/',2), [X, Y], [X, Y]). % No change
+built_in(/('>=',2), [X, Y], [X, Y]). % No change
+built_in(/('<',2), [X, Y], [X, Y]). % No change
+built_in(is/2, [X, Y], [g, Y]). % Ground result
+
+% ----- Utilities ----- %
+
+worst_case([], _). %% Doesn't work if any Exits
+worst_case([Exit|Exits], Worst) :- %% fail to match, e.g.
+ unify(Exit, Worst), %% [[s(1)], [f(1)]].
+ worst_case(Exits, Worst).
+
+look_up_act(_, Known) :-
+ var(Known),
+ !, fail.
+look_up_act([Functor/Arity, Act, Exit], [[Functor/Arity, KnownAct, Exit]|_]) :-
+ equiv(Act, KnownAct).
+look_up_act([Functor/Arity, Act, Exit], [_|Known]) :-
+ look_up_act([Functor/Arity, Act, Exit], Known).
+
+all_shared(Act, Exit) :- %% Wrong
+ unify(Act, _, VarModesList),
+ bind_all(_, VarModesList),
+ unify(Act, Exit, VarModesList).
+
+bind_all(_, VarModesList) :-
+ var(VarModesList).
+bind_all(Mode, [[Var, Mode]|VarModesList]) :-
+ var(Mode),
+ bind_all(Mode, VarModesList).
+bind_all(Mode, [[_, _]|VarModesList]) :-
+ bind_all(Mode, VarModesList).
+
+
+% Adds Element to the tail of List, an unbound-tail list
+add_to_list(Element, List) :-
+ var(List),
+ List=[Element|_].
+add_to_list(Element, [_|List]) :-
+ add_to_list(Element, List).
+
+% Membership relation for unbound-tail lists
+umember(_, List) :-
+ var(List), !, fail.
+umember(Element, [Element|_]).
+umember(Element, [_|Tail]) :- umember(Element, Tail).
+
+% Strict membership relation for unbound-tail lists
+sumember(_, List) :-
+ var(List), !, fail.
+sumember(Element, [AnyElement|_]) :- Element==AnyElement.
+sumember(Element, [_|Tail]) :- sumember(Element, Tail).
+
+% Membership relation for standard nil-tail lists
+member(X, [X|_]).
+member(X, [_|T]) :- member(X, T).
+
+% Strict membership relation for standard nil-tail lists
+smember(X, [Y|_]) :- X==Y.
+smember(X, [_|T]) :- smember(X, T).
+
+% Equiv membership relation for standard nil-tail lists
+eqmember(X, [Y|_]) :- equiv(X, Y).
+eqmember(X, [_|T]) :- eqmember(X, T).
+
+% Our old favorite
+concat([], L, L).
+concat([X|L1], L2, [X|L3]) :- concat(L1, L2, L3).
+
+% Pretty prints unbound-tail lists -- dies on NIL tail lists
+write_list(List) :-
+ dup(List, NewList),
+ (var(NewList) -> (name_vars(NewList, 0, _),
+ write(NewList)) ;
+ (write('['),
+ write_list2(NewList, 0, _),
+ write('|_].'))), % write('].') to write nil tails
+ nl.
+write_list2([H|T], NextName, NewNextName) :-
+ name_vars(H, NextName, TempNextName),
+ write(H),
+ (nonvar(T) -> (write(','), nl,
+ write(' '),
+ write_list2(T, TempNextName, NewNextName)) ;
+ NewNextName = TempNextName).
+
+name_vars(Term, NextName, NewNextName) :-
+ var(Term), !,
+ make_name(NextName, Term),
+ NewNextName is NextName + 1.
+name_vars(Term, NextName, NextName) :-
+ atom(Term), !.
+name_vars([TermHead|TermTail], NextName, NewNextName) :-
+ !, name_vars(TermHead, NextName, TempNextName),
+ name_vars(TermTail, TempNextName, NewNextName).
+name_vars(Term, NextName, NewNextName) :-
+ Term =.. [_|TermArgs],
+ name_vars(TermArgs, NextName, NewNextName).
+
+make_name(IntName, Variable) :-
+ Count is IntName // 26,
+ NewIntName is IntName mod 26 + "A",
+ build_name(Count, NewIntName, Name),
+ atom_codes(Variable, Name).
+ %name(Variable, Name).
+
+build_name(0, IntName, [IntName]) :- !.
+build_name(Count, IntName, [IntName|Rest]) :- Count>0,
+ NewCount is Count - 1,
+ build_name(NewCount, IntName, Rest).
+
diff --git a/examples/benchmarks/holmer/serialise.in b/examples/benchmarks/holmer/serialise.in
new file mode 100644
index 0000000..4c58d3b
--- /dev/null
+++ b/examples/benchmarks/holmer/serialise.in
@@ -0,0 +1 @@
+:- '$benchmark'(serialise, 1000, serialise, '$dummy').
diff --git a/examples/benchmarks/holmer/serialise.pl b/examples/benchmarks/holmer/serialise.pl
new file mode 100644
index 0000000..0cbd780
--- /dev/null
+++ b/examples/benchmarks/holmer/serialise.pl
@@ -0,0 +1,38 @@
+% generated: 17 November 1989
+% option(s):
+%
+% serialise
+%
+% David H. D. Warren
+%
+% itemize (pick a "serial number" for each
+% unique integer in) a list of 25 integers
+
+serialise :- serialise("ABLE WAS I ERE I SAW ELBA",_).
+
+serialise(L,R) :-
+ pairlists(L,R,A),
+ arrange(A,T),
+ numbered(T,1,_).
+
+pairlists([X|L],[Y|R],[pair(X,Y)|A]) :- pairlists(L,R,A).
+pairlists([],[],[]).
+
+arrange([X|L],tree(T1,X,T2)) :-
+ split(L,X,L1,L2),
+ arrange(L1,T1),
+ arrange(L2,T2).
+arrange([],void).
+
+split([X|L],X,L1,L2) :- !, split(L,X,L1,L2).
+split([X|L],Y,[X|L1],L2) :- before(X,Y), !, split(L,Y,L1,L2).
+split([X|L],Y,L1,[X|L2]) :- before(Y,X), !, split(L,Y,L1,L2).
+split([],_,[],[]).
+
+before(pair(X1,_),pair(X2,_)) :- X1 < X2.
+
+numbered(tree(T1,pair(_,N1),T2),N0,N) :-
+ numbered(T1,N0,N1),
+ N2 is N1+1,
+ numbered(T2,N2,N).
+numbered(void,N,N).
diff --git a/examples/benchmarks/holmer/simple_analyzer.in b/examples/benchmarks/holmer/simple_analyzer.in
new file mode 100644
index 0000000..06e76e0
--- /dev/null
+++ b/examples/benchmarks/holmer/simple_analyzer.in
@@ -0,0 +1 @@
+:- '$benchmark'(simple_analyzer, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/simple_analyzer.pl b/examples/benchmarks/holmer/simple_analyzer.pl
new file mode 100644
index 0000000..3f1088f
--- /dev/null
+++ b/examples/benchmarks/holmer/simple_analyzer.pl
@@ -0,0 +1,481 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Copyright (C) 1990 Peter Van Roy and Regents of the University of California.
+% All rights reserved. This program may be freely used and modified for
+% non-commercial purposes provided this copyright notice is kept unchanged.
+% Written by Peter Van Roy as a part of the Aquarius project.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Benchmark based on the Aquarius compiler flow analyzer version 1.
+% This program does a dataflow analysis of quicksort using abstract
+% interpretation. The lattice has two useful values: uninit and ground.
+% Analysis takes three passes (it prints three 'x' characters).
+% Builtins used: compare/3, arg/3, functor/3, sort/2, keysort/2, ==/2, \==/2.
+
+main :- main(_).
+% main :- main(Table), write(Table), nl.
+
+main(Table) :-
+ analyze_strees(
+ [stree(main/0,
+ (main:-
+ (qsort([1,2],L,[]),true
+ ;fail
+ )),
+ (main:-true),[],1),
+ stree(qsort/3,
+ (qsort(U,P,Q):-
+ (U=[N|O],part(O,N,R,S),qsort(S,T,Q),qsort(R,P,[N|T]),true
+ ;U=[],Q=P,true
+ ;fail
+ )),
+ (qsort(_,_,_):-true),[],1),
+ stree(part/4,
+ (part(W,X,Y,Z):-
+ ('$cut_load'(A1),'$cut_part/4_1'(W,X,Y,Z,A1),true
+ ;fail
+ )),
+ (part(_,_,_,_):-true),
+ [stree('$cut_part/4_1'/5,
+ ('$cut_part/4_1'(I1,E1,F1,G1,H1):-
+ (I1=[C1|D1],'$fac_$cut_part/4_1/5_2'(D1,E1,F1,G1,H1,C1),true
+ ;I1=[],F1=[],G1=[],true
+ ;fail
+ )),
+ ('$cut_part/4_1'(_,_,_,_,_):-true),
+ [stree('$fac_$cut_part/4_1/5_2'/6,
+ ('$fac_$cut_part/4_1/5_2'(K1,L1,Q1,O1,P1,M1):-
+ (Q1=[M1|N1],M1=<L1,'$cut_shallow'(P1),part(K1,L1,N1,O1),true
+ ;O1=[M1|R1],part(K1,L1,Q1,R1),true
+ ;fail
+ )),
+ ('$fac_$cut_part/4_1/5_2'(_,_,_,_,_,_):-true),[],1)
+ ],1)
+ ],1)
+ ], Table).
+
+analyze_strees(Strees, OutTable) :-
+ init_strees(Strees, _, Table),
+ seal(Table),
+ analyze_closure(Strees, Table, OutTable).
+
+% Repeat traversal step until there are no more changes:
+analyze_closure(Strees, InTable, OutTable) :-
+ traverse_strees(Strees, InTable, MidTable, 0, Changes),
+ % Mark an analysis pass:
+ % put("x"), nl,
+ analyze_closure(Strees, MidTable, OutTable, Changes).
+
+analyze_closure(Strees, InTable, InTable, N) :- N=<0, !.
+analyze_closure(Strees, InTable, OutTable, N) :- N>0, !,
+ analyze_closure(Strees, InTable, OutTable).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Initialize the table of call lattice values:
+
+init_strees([],_4,_4) :-
+ true.
+init_strees([_12|_13],_4,_5) :-
+ _12=stree(_14,(_15:-_16),_17,_18,_19),
+ bottom_call(_14,_20),
+ table_command(get(_14,_20),_4,_23),
+ init_disj(_16,_23,_24),
+ init_strees(_18,_24,_25),
+ init_strees(_13,_25,_5),
+ true.
+
+init_conj(true,_4,_4) :-
+ true.
+init_conj((_12,_13),_4,_5) :-
+ init_goal(_12,_4,_16),
+ init_conj(_13,_16,_5),
+ true.
+
+init_disj(fail,_4,_4) :-
+ true.
+init_disj((_12;_13),_4,_5) :-
+ init_conj(_12,_4,_16),
+ init_disj(_13,_16,_5),
+ true.
+
+init_goal(_3,_4,_5) :-
+ call_p(_3),
+ !,
+ functor(_3,_12,_13),
+ bottom_call(_12/_13,_14),
+ table_command(get(_12/_13,_14),_4,_5),
+ true.
+init_goal(_3,_4,_4) :-
+ unify_p(_3),
+ !,
+ true.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+traverse_strees([],_4,_4,_6,_6) :-
+ true.
+traverse_strees([_14|_15],_4,_5,_6,_7) :-
+ _14=stree(_16,(_17:-_18),_19,_20,_21),
+ traverse_disj(_17,_18,_4,_26,_6,_27),
+ traverse_strees(_20,_26,_28,_27,_29),
+ traverse_strees(_15,_28,_5,_29,_7),
+ true.
+
+traverse_disj(_3,fail,_5,_5,_7,_7) :-
+ true.
+traverse_disj(_3,(_15;_16),_5,_6,_7,_8) :-
+ traverse_conj(_3,_15,_5,_22,_7,_23),
+ traverse_disj(_3,_16,_22,_6,_23,_8),
+ true.
+
+traverse_conj(_3,_4,_5,_6,_7,_8) :-
+ varset(_3,_24),
+ functor(_3,_15,_16),
+ table_command(get(_15/_16,_17),_5,_25),
+ get_entry_modes(uninit,_3,_17,_26),
+ get_entry_modes(ground,_3,_17,_27),
+ traverse_conj(_4,_25,_6,_7,_8,_27,_28,_26,_29,_24,_30),
+ true.
+
+traverse_conj(true,_4,_4,_6,_6,_8,_8,_10,_10,_12,_12) :-
+ true.
+traverse_conj((_20,_21),_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) :-
+ varset(_20,_32),
+ update_goal(_20,_32,_4,_33,_6,_34,_8,_35,_10,_36,_12,_37),
+ unionv(_32,_37,_38),
+ traverse_conj(_21,_33,_5,_34,_7,_35,_9,_36,_11,_38,_13),
+ true.
+
+update_goal(_3,_4,_5,_5,_7,_7,_9,_10,_11,_12,_13,_13) :-
+ split_unify(_3,_21,_27),
+ var(_21),
+ nonvar(_27),
+ varset(_27,_28),
+ subsetv(_28,_9),
+ !,
+ set_command(add(_21),_9,_10),
+ set_command(sub(_21),_11,_12),
+ true.
+update_goal(_3,_4,_5,_5,_7,_7,_9,_9,_11,_12,_13,_13) :-
+ split_unify(_3,_21,_30),
+ var(_21),
+ nonvar(_30),
+ inv(_21,_11),
+ !,
+ diffv(_4,_13,_31),
+ diffv(_31,_9,_22),
+ set_command(add_set(_22),_11,_32),
+ set_command(sub(_21),_32,_33),
+ intersectv(_4,_13,_23),
+ set_command(sub_set(_23),_33,_12),
+ true.
+update_goal(_3,_4,_5,_5,_7,_7,_9,_10,_11,_12,_13,_13) :-
+ split_unify(_3,_27,_28),
+ var(_27),
+ inv(_27,_9),
+ !,
+ set_command(add_set(_4),_9,_10),
+ set_command(sub_set(_4),_11,_12),
+ true.
+update_goal(_3,_4,_5,_5,_7,_7,_9,_9,_11,_12,_13,_13) :-
+ unify_p(_3),
+ !,
+ set_command(sub_set(_4),_11,_12),
+ true.
+update_goal(_3,_4,_5,_6,_7,_8,_9,_9,_11,_12,_13,_13) :-
+ call_p(_3),
+ !,
+ goal_dupset(_3,_33),
+ var_args(_3,_34),
+ functor(_3,_22,_23),
+ functor(_35,_22,_23),
+ create_new_call(1,_23,_9,_34,_33,_11,_13,_3,_35),
+ update_table(_22/_23,_35,_5,_6,_7,_8),
+ set_command(sub_set(_4),_11,_12),
+ true.
+
+update_table(_15/_16,_4,_5,_6,_7,_8) :-
+ table_command(get(_15/_16,_18),_5,_24),
+ lub_call(_18,_4,_19),
+ _18\==_19,
+ !,
+ table_command(set(_15/_16,_19),_24,_6),
+ _8 is _7+1,
+ true.
+update_table(_15/_16,_4,_5,_5,_7,_7).
+
+create_new_call(I, Ar, _, _, _, _, _, _, _) :- I>Ar, !.
+create_new_call(I, Ar, Gnd, VarArgs, DupVars, Uni, SoFar, Goal, Call) :-
+ I=<Ar,
+ !,
+ arg(I, Goal, X),
+ arg(I, Call, Y),
+ ground_flag(X, Gnd, Gf),
+ membership_flag(X, VarArgs, Vf),
+ membership_flag(X, DupVars, Df),
+ membership_flag(X, Uni, Uf),
+ membership_flag(X, SoFar, Sf),
+ create_argument(Gf, Vf, Df, Uf, Sf, Y),
+ I1 is I+1,
+ create_new_call(I1, Ar, Gnd, VarArgs, DupVars, Uni, SoFar, Goal, Call).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Lattice utilities:
+
+lub(unknown, X, X) :- !.
+lub( X, unknown, X) :- !.
+lub( any, _, any) :- !.
+lub( _, any, any) :- !.
+lub( uninit, uninit, uninit) :- !.
+lub( ground, ground, ground) :- !.
+lub( uninit, ground, any) :- !.
+lub( ground, uninit, any) :- !.
+
+bottom(unknown).
+
+create_argument(yes, _, _, _, _, ground) :- !. % Ground argument.
+create_argument( no, yes, no, yes, _, uninit) :- !. % Non-duplicated uninit.
+create_argument( no, yes, no, _, no, uninit) :- !. % First occurrence.
+create_argument( no, yes, _, no, yes, any) :- !. % Already initialized.
+create_argument( no, yes, yes, _, _, any) :- !. % Duplicated argument.
+create_argument( no, no, _, _, _, any) :- !. % Non-variable argument.
+
+lub_call(Call1, Call2, Lub) :-
+ functor(Call1, Na, Ar),
+ functor(Call2, Na, Ar),
+ functor(Lub, Na, Ar),
+ lub_call(1, Ar, Call1, Call2, Lub).
+
+lub_call(I, Ar, _, _, _) :- I>Ar, !.
+lub_call(I, Ar, Call1, Call2, Lub) :- I=<Ar, !,
+ arg(I, Call1, X1),
+ arg(I, Call2, X2),
+ arg(I, Lub, X),
+ lub(X1, X2, X),
+ I1 is I+1,
+ lub_call(I1, Ar, Call1, Call2, Lub).
+
+bottom_call(Na/Ar, Bottom) :-
+ functor(Bottom, Na, Ar),
+ bottom_call(1, Ar, Bottom).
+
+bottom_call(I, Ar, Bottom) :- I>Ar, !.
+bottom_call(I, Ar, Bottom) :- I=<Ar, !,
+ bottom(B),
+ arg(I, Bottom, B),
+ I1 is I+1,
+ bottom_call(I1, Ar, Bottom).
+
+lattice_modes_call(Na/Ar, Table, (Head:-Formula)) :-
+ functor(Head, Na, Ar),
+ get(Table, Na/Ar, Value),
+ lattice_modes_call(1, Ar, Value, Head, Formula, true).
+
+lattice_modes_call(I, Ar, _, _, Link, Link) :- I>Ar, !.
+lattice_modes_call(I, Ar, Value, Head, Formula, Link) :- I=<Ar, !,
+ arg(I, Value, T),
+ arg(I, Head, X),
+ lattice_modes_arg(T, X, Formula, Mid),
+ I1 is I+1,
+ lattice_modes_call(I1, Ar, Value, Head, Mid, Link).
+
+lattice_modes_arg(uninit, X, (uninit(X),Link), Link) :- !.
+lattice_modes_arg(ground, X, (ground(X),Link), Link) :- !.
+lattice_modes_arg( Other, X, Link, Link).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Table utilities:
+
+% This code implements a mutable array, represented as a binary tree.
+
+% Access a value in logarithmic time and constant space:
+% This predicate can be used to create the array incrementally.
+get(node(N,W,L,R), I, V) :- get(N, W, L, R, I, V).
+
+get(N, V, _, _, I, V) :- I=N, !.
+get(N, _, L, R, I, V) :-
+ compare(Order, I, N),
+ get(Order, I, V, L, R).
+
+get(<, I, V, L, _) :- get(L, I, V).
+get(>, I, V, _, R) :- get(R, I, V).
+
+set(leaf, I, V, node(I,V,leaf,leaf)).
+set(node(N,W,L,R), I, V, node(N,NW,NL,NR)) :-
+ compare(Order, I, N),
+ set_2(Order, I, V, W, L, R, NW, NL, NR).
+
+set_2(<, I, V, W, L, R, W, NL, R) :- set(L, I, V, NL).
+set_2(=, I, V, _, L, R, V, L, R).
+set_2(>, I, V, W, L, R, W, L, NR) :- set(R, I, V, NR).
+
+% Prevent any further insertions in the array:
+seal(leaf).
+seal(node(_,_,L,R)) :- seal(L), seal(R).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% General utilities:
+
+membership_flag(X, Set, yes) :- inv(X, Set), !.
+membership_flag(X, Set, no).
+
+ground_flag(X, Ground, yes) :- varset(X, Set), subsetv(Set, Ground), !.
+ground_flag(X, Ground, no).
+
+get_entry_modes(Type, Head, Value, TypeSet) :-
+ functor(Head, Na, Ar),
+ get_entry_modes(Type, 1, Ar, Head, Value, Bag),
+ sort(Bag, TypeSet).
+
+get_entry_modes(_, I, Ar, _, _, []) :- I>Ar, !.
+get_entry_modes(T, I, Ar, Head, Value, [X|Bag]) :- I=<Ar, arg(I, Value, T), !,
+ arg(I, Head, X),
+ I1 is I+1,
+ get_entry_modes(T, I1, Ar, Head, Value, Bag).
+get_entry_modes(T, I, Ar, Head, Value, Bag) :- I=<Ar, !,
+ I1 is I+1,
+ get_entry_modes(T, I1, Ar, Head, Value, Bag).
+
+var_args(Goal, Set) :-
+ functor(Goal, _, Ar),
+ filter_vars(Ar, Goal, Bag),
+ sort(Bag, Set).
+
+filter_vars(Ar, Goal, Vs) :- filter_vars(Ar, Goal, Vs, []).
+
+filter_vars(N, Goal) --> {N=<0}, !.
+filter_vars(N, Goal) --> {N>0}, !,
+ {arg(N, Goal, V)},
+ filter_vars_arg(N, Goal, V).
+
+filter_vars_arg(N, Goal, V) --> {var(V)}, !, [V],
+ {N1 is N-1},
+ filter_vars(N1, Goal).
+filter_vars_arg(N, Goal, V) --> {nonvar(V)}, !,
+ {N1 is N-1},
+ filter_vars(N1, Goal).
+
+goal_dupset(Goal, DupSet) :-
+ goal_dupset_varbag(Goal, DupSet, _).
+
+goal_dupset_varset(Goal, DupSet, VarSet) :-
+ goal_dupset_varbag(Goal, DupSet, VarBag),
+ sort(VarBag, VarSet).
+
+goal_dupset_varbag(Goal, DupSet, VarBag) :-
+ varbag(Goal, VarBag),
+ make_key(VarBag, KeyBag),
+ keysort(KeyBag, KeySet),
+ filter_dups(KeySet, DupSet).
+
+make_key([], []).
+make_key([V|Bag], [V-dummy|KeyBag]) :- make_key(Bag, KeyBag).
+
+filter_dups(KeySet, Set) :- filter_dups(KeySet, Set, []).
+
+filter_dups([]) --> !.
+filter_dups([V1-_,V2-_,V3-_|KeySet]) --> {V1==V2,V2==V3}, !,
+ filter_dups([V2-_,V3-_|KeySet]).
+filter_dups([V1-_,V2-_|KeySet]) --> {V1==V2}, !,
+ [V1], filter_dups(KeySet).
+filter_dups([V1-_|KeySet]) --> !,
+ filter_dups(KeySet).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Low-level utilities:
+
+set_command(sub(X), In, Out) :- diffv(In, [X], Out).
+set_command(add(X), In, Out) :- includev(X, In, Out).
+set_command(sub_set(X), In, Out) :- diffv(In, X, Out).
+set_command(add_set(X), In, Out) :- unionv(X, In, Out).
+
+table_command(get(I,Val), In, In) :- get(In, I, Val).
+table_command(set(I,Val), In, Out) :- set(In, I, Val, Out).
+
+% Set utilities inspired by R. O'Keefe in Practical Prolog:
+inv(A, [B|S]) :-
+ compare(Order, A, B),
+ inv_2(Order, A, S).
+
+inv_2(=, _, _).
+inv_2(>, A, S) :- inv(A, S).
+
+intersectv([], _, []).
+intersectv([A|S1], S2, S) :- intersectv_2(S2, A, S1, S).
+
+intersectv_2([], A, S1, []).
+intersectv_2([B|S2], A, S1, S) :-
+ compare(Order, A, B),
+ intersectv_3(Order, A, S1, B, S2, S).
+
+intersectv_3(<, A, S1, B, S2, S) :- intersectv_2(S1, B, S2, S).
+intersectv_3(=, A, S1, _, S2, [A|S]) :- intersectv(S1, S2, S).
+intersectv_3(>, A, S1, B, S2, S) :- intersectv_2(S2, A, S1, S).
+
+diffv([], _, []).
+diffv([A|S1], S2, S) :- diffv_2(S2, A, S1, S).
+
+diffv_2([], A, S1, [A]).
+diffv_2([B|S2], A, S1, S) :-
+ compare(Order, A, B),
+ diffv_3(Order, A, S1, B, S2, S).
+
+diffv_3(<, A, S1, B, S2, [A|S]) :- diffv(S1, [B|S2], S).
+diffv_3(=, A, S1, _, S2, S) :- diffv(S1, S2, S).
+diffv_3(>, A, S1, _, S2, S) :- diffv_2(S2, A, S1, S).
+
+unionv([], S2, S2).
+unionv([A|S1], S2, S) :- unionv_2(S2, A, S1, S).
+
+unionv_2([], A, S1, [A|S1]).
+unionv_2([B|S2], A, S1, S) :-
+ compare(Order, A, B),
+ unionv_3(Order, A, S1, B, S2, S).
+
+unionv_3(<, A, S1, B, S2, [A|S]) :- unionv_2(S1, B, S2, S).
+unionv_3(=, A, S1, _, S2, [A|S]) :- unionv(S1, S2, S).
+unionv_3(>, A, S1, B, S2, [B|S]) :- unionv_2(S2, A, S1, S).
+
+includev(A, S1, S) :- includev_2(S1, A, S).
+
+includev_2([], A, [A]).
+includev_2([B|S1], A, S) :-
+ compare(Order, A, B),
+ includev_3(Order, A, B, S1, S).
+
+includev_3(<, A, B, S1, [A,B|S1]).
+includev_3(=, _, B, S1, [B|S1]).
+includev_3(>, A, B, S1, [B|S]) :- includev_2(S1, A, S).
+
+subsetv([], _).
+subsetv([A|S1], [B|S2]) :-
+ compare(Order, A, B),
+ subsetv_2(Order, A, S1, S2).
+
+subsetv_2(=, A, S1, S2) :- subsetv(S1, S2).
+subsetv_2(>, A, S1, S2) :- subsetv([A|S1], S2).
+
+varset(Term, VarSet) :- varbag(Term, VB), sort(VB, VarSet).
+varbag(Term, VarBag) :- varbag(Term, VarBag, []).
+
+varbag(Var) --> {var(Var)}, !, [Var].
+varbag(Str) --> {nonvar(Str), !, functor(Str,_,Arity)}, varbag(Str, 1, Arity).
+
+varbag(_Str, N, Arity) --> {N>Arity}, !.
+varbag(Str, N, Arity) --> {N=<Arity}, !,
+ {arg(N, Str, Arg)}, varbag(Arg),
+ {N1 is N+1},
+ varbag(Str, N1, Arity).
+
+unify_p(_=_).
+
+call_p(G) :- \+unify_p(G).
+
+split_unify(X=Y, X, Y).
+split_unify(Y=X, X, Y).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/examples/benchmarks/holmer/tak.in b/examples/benchmarks/holmer/tak.in
new file mode 100644
index 0000000..14372ec
--- /dev/null
+++ b/examples/benchmarks/holmer/tak.in
@@ -0,0 +1 @@
+:- '$benchmark'(tak, 1000, tak, '$dummy').
diff --git a/examples/benchmarks/holmer/tak.pl b/examples/benchmarks/holmer/tak.pl
new file mode 100644
index 0000000..ca9a042
--- /dev/null
+++ b/examples/benchmarks/holmer/tak.pl
@@ -0,0 +1,23 @@
+% generated: 17 November 1989
+% option(s): SOURCE_TRANSFORM_1
+%
+% tak
+%
+% Evan Tick (from Lisp version by R. P. Gabriel)
+%
+% (almost) Takeuchi function (recursive arithmetic)
+
+tak :- tak(18,12,6,_).
+
+tak(X,Y,Z,A) :-
+ X =< Y,
+ Z = A.
+tak(X,Y,Z,A) :-
+ X > Y,
+ X1 is X - 1,
+ tak(X1,Y,Z,A1),
+ Y1 is Y - 1,
+ tak(Y1,Z,X,A2),
+ Z1 is Z - 1,
+ tak(Z1,X,Y,A3),
+ tak(A1,A2,A3,A).
diff --git a/examples/benchmarks/holmer/times10.in b/examples/benchmarks/holmer/times10.in
new file mode 100644
index 0000000..cfd3eda
--- /dev/null
+++ b/examples/benchmarks/holmer/times10.in
@@ -0,0 +1 @@
+:- '$benchmark'(times10, 1000, times10, '$dummy').
diff --git a/examples/benchmarks/holmer/times10.pl b/examples/benchmarks/holmer/times10.pl
new file mode 100644
index 0000000..5740f17
--- /dev/null
+++ b/examples/benchmarks/holmer/times10.pl
@@ -0,0 +1,35 @@
+% generated: 7 March 1990
+% option(s):
+%
+% (deriv) times10
+%
+% David H. D. Warren
+%
+% symbolic derivative of ((((((((x*x)*x)*x)*x)*x)*x)*x)*x)*x
+
+times10 :- d(((((((((x*x)*x)*x)*x)*x)*x)*x)*x)*x,x,_).
+
+d(U+V,X,DU+DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U-V,X,DU-DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U*V,X,DU*V+U*DV) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !,
+ d(U,X,DU),
+ d(V,X,DV).
+d(^(U,N),X,DU*N*(^(U,N1))) :- !,
+ integer(N),
+ N1 is N-1,
+ d(U,X,DU).
+d(-U,X,-DU) :- !,
+ d(U,X,DU).
+d(exp(U),X,exp(U)*DU) :- !,
+ d(U,X,DU).
+d(log(U),X,DU/U) :- !,
+ d(U,X,DU).
+d(X,X,1) :- !.
+d(_,_,0).
diff --git a/examples/benchmarks/holmer/unify.in b/examples/benchmarks/holmer/unify.in
new file mode 100644
index 0000000..bcb942f
--- /dev/null
+++ b/examples/benchmarks/holmer/unify.in
@@ -0,0 +1 @@
+:- '$benchmark'(unify, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/unify.pl b/examples/benchmarks/holmer/unify.pl
new file mode 100644
index 0000000..43e73af
--- /dev/null
+++ b/examples/benchmarks/holmer/unify.pl
@@ -0,0 +1,156 @@
+/* CHANGELOG by M.Banbara
+ - rename compound/1 to '$compound'/1
+ - comment write/1 and nl/0 out
+*/
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Copyright (C) 1990 Regents of the University of California.
+% All rights reserved. This program may be freely used and modified for
+% non-commercial purposes provided this copyright notice is kept unchanged.
+% Written by Peter Van Roy as a part of the Aquarius project.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Benchmark based on part of Aquarius Prolog compiler
+% Compiling unification into abstract machine code.
+
+main :- main(X).
+%main :- main(X), write(X), nl.
+
+main(Size) :- u(X, [1,Y], [X], Code), size(Code, 0, Size).
+
+% Unify variable X with term T and write the result:
+u(X, T, In, Code) :- unify(X, T, In, _, Code, []).
+
+% Unify the variable X with the term T, given that
+% In = set of variables initialized before the unification.
+% Returns the intermediate code for the unification and
+% Out = set of variables initialized after the unification.
+unify(X, T, In, Out) --> {\+in(X, In)}, !, uninit(X, T, In, Out).
+unify(X, T, In, Out) --> {in(X, In)}, !, init(X, T, In, Out, nonlast, _).
+
+%**** Uninit assumes X has not yet been initialized:
+uninit(X, T, In, Out) --> {'$compound'(T)}, !, [move(Tag^h, X)],
+ {termtag(T, Tag)}, unify_block(nonlast, T, _, In, Mid, _), {incl(X, Mid, Out)}.
+uninit(X, T, In, Out) --> {atomic(T)}, !, [move(tatm^T, X)], {incl(X, In, Out)}.
+uninit(X, T, In, Out) --> {var(T)}, !, unify_var(X, T, In, Out).
+
+%**** Init assumes X has already been initialized:
+init(X, T, In, Out, Last, LLbls) --> {nonvar(T)}, !,
+ {termtag(T,Tag)}, [deref(X), switch(Tag,X,[trail(X) | Write],Read,fail)],
+ {unify_writemode(X, T, In, Last, LLbls, Write, [])},
+ {unify_readmode(X, T, In, Out, LLbls, Read, [])}.
+init(X, T, In, Out, _, _) --> {var(T)}, !, unify_var(X, T, In, Out).
+
+%**** Unifying two variables together:
+unify_var(X, Y, In, In) --> { in(X, In), in(Y, In)}, !, [unify(X,Y,fail)].
+unify_var(X, Y, In, Out) --> { in(X, In), \+in(Y, In)}, !, [move(X,Y)], {incl(Y, In, Out)}.
+unify_var(X, Y, In, Out) --> {\+in(X, In), in(Y, In)}, !, [move(Y,X)], {incl(X, In, Out)}.
+unify_var(X, Y, In, Out) --> {\+in(X, In), \+in(Y, In)}, !,
+ [move(tvar^h,X), move(tvar^h,Y), add(1,h), move(Y,[h-1])],
+ {incl(X, In, Mid), incl(Y, Mid, Out)}.
+
+%**** Unify_readmode assumes X is a dereferenced nonvariable
+% at run-time and T is a nonvariable at compile-time.
+unify_readmode(X, T, In, Out, LLbls) --> {structure(T)}, !, [equal([X],tatm^(F/N),fail)],
+ {functor(T, F, N)}, unify_args(1, N, T, In, Out, 0, X, LLbls).
+unify_readmode(X, T, In, Out, LLbls) --> {cons(T)}, !,
+ unify_args(1, 2, T, In, Out, -1, X, LLbls).
+unify_readmode(X, T, In, In, _) --> {atomic(T)}, !, [equal(X,tatm^T,fail)].
+
+unify_args(I, N, _, In, In, _, _, _) --> {I>N}, !.
+unify_args(I, N, T, In, Out, D, X, [ _ | LLbls]) --> {I=N}, !,
+ unify_arg(I, T, In, Out, D, X, last, LLbls).
+unify_args(I, N, T, In, Out, D, X, LLbls) --> {I<N}, !,
+ unify_arg(I, T, In, Mid, D, X, nonlast, _),
+ {I1 is I+1}, unify_args(I1, N, T, Mid, Out, D, X, LLbls).
+
+unify_arg(I, T, In, Out, D, X, Last, LLbls) --> [move([X+ID],Y)],
+ {ID is I+D, incl(Y, In, Mid), arg(I, T, A)},
+ init(Y, A, Mid, Out, Last, LLbls).
+
+%**** Unify_writemode assumes X is a dereferenced unbound
+% variable at run-time and T is a nonvariable at compile-time.
+unify_writemode(X, T, In, Last, LLbls) --> {'$compound'(T)}, !, [move(Tag^h,[X])],
+ {termtag(T, Tag)}, unify_block(Last, T, _, In, _, LLbls).
+unify_writemode(X, T, _, _, _) --> {atomic(T)}, !, [move(tatm^T,[X])].
+
+%**** Generate a minimal sequence of moves to create T on the heap:
+unify_block( last, T, Size, In, In, [Lbl | _ ]) --> !, [add(Size,h), jump(Lbl)],
+ {size(T, 0, Size)}.
+unify_block(nonlast, T, Size, In, Out, [ _ | LLbls]) --> !, [add(Size,h)],
+ {size(T, 0, Size), Offset is -Size}, block(T, Offset, 0, In, Out, LLbls).
+
+block(T, Inf, Outf, In, Out, LLbls) --> {structure(T)}, !, [move(tatm^(F/N), [h+Inf])],
+ {functor(T, F, N), Midf is Inf+N+1, S is Inf+1},
+ make_slots(1, N, T, S, Offsets, In, Mid),
+ block_args(1, N, T, Midf, Outf, Offsets, Mid, Out, LLbls).
+block(T, Inf, Outf, In, Out, LLbls) --> {cons(T)}, !,
+ {Midf is Inf+2},
+ make_slots(1, 2, T, Inf, Offsets, In, Mid),
+ block_args(1, 2, T, Midf, Outf, Offsets, Mid, Out, LLbls).
+block(T, Inf, Inf, In, In, []) --> {atomic(T)}, !.
+block(T, Inf, Inf, In, In, []) --> {var(T)}, !.
+
+block_args(I, N, _, Inf, Inf, [], In, In, []) --> {I>N}, !.
+block_args(I, N, T, Inf, Outf, [Inf], In, Out, [Lbl | LLbls]) --> {I=N}, !, [label(Lbl)],
+ {arg(I, T, A)}, block(A, Inf, Outf, In, Out, LLbls).
+block_args(I, N, T, Inf, Outf, [Inf | Offsets], In,Out,LLbls) --> {I<N}, !,
+ {arg(I, T, A)}, block(A, Inf, Midf, In, Mid, _), {I1 is I+1},
+ block_args(I1, N, T, Midf, Outf, Offsets, Mid, Out, LLbls).
+
+make_slots(I, N, _, _, [], In, In) --> {I>N}, !.
+make_slots(I, N, T, S, [Off | Offsets], In, Out) --> {I=<N}, !,
+ {arg(I, T, A)}, init_var(A, S, In),
+ {incl(A, In, Mid), make_word(A, Off, Word)}, [move(Word,[h+S])],
+ {S1 is S+1, I1 is I+1},
+ make_slots(I1, N, T, S1, Offsets, Mid, Out).
+
+% Initialize first-time variables in write mode:
+init_var(V, I, In) --> {var(V), \+in(V, In)}, !, [move(tvar^(h+I),V)].
+init_var(V, _, In) --> {var(V), in(V, In)}, !.
+init_var(V, _, _) --> {nonvar(V)}, !.
+
+make_word(C, Off, Tag^(h+Off)) :- '$compound'(C), !, termtag(C, Tag).
+make_word(V, _, V) :- var(V), !.
+make_word(A, _, tatm^A) :- atomic(A), !.
+
+% Calculate the size of T on the heap:
+size(T) --> {structure(T)}, !, {functor(T, _, N)}, add(1), add(N), size_args(1, N, T).
+size(T) --> {cons(T)}, !, add(2), size_args(1, 2, T).
+size(T) --> {atomic(T)}, !.
+size(T) --> {var(T)}, !.
+
+size_args(I, N, _) --> {I>N}, !.
+size_args(I, N, T) --> {I=<N}, !, {arg(I, T, A)}, size(A), {I1 is I+1}, size_args(I1, N, T).
+
+%**** Utility routines:
+
+add(I, X, Y) :- Y is X+I.
+
+in(A, [B|S]) :-
+ compare(Order, A, B),
+ in_2(Order, A, S).
+
+in_2(=, _, _).
+in_2(>, A, S) :- in(A, S).
+
+incl(A, S1, S) :- incl_2(S1, A, S).
+
+incl_2([], A, [A]).
+incl_2([B|S1], A, S) :-
+ compare(Order, A, B),
+ incl_3(Order, A, B, S1, S).
+
+incl_3(<, A, B, S1, [A,B|S1]).
+incl_3(=, _, B, S1, [B|S1]).
+incl_3(>, A, B, S1, [B|S]) :- incl_2(S1, A, S).
+
+'$compound'(X) :- nonvar(X), \+atomic(X).
+cons(X) :- nonvar(X), X=[_|_].
+structure(X) :- '$compound'(X), \+X=[_|_].
+
+termtag(T, tstr) :- structure(T).
+termtag(T, tlst) :- cons(T).
+termtag(T, tatm) :- atomic(T).
+termtag(T, tvar) :- var(T).
diff --git a/examples/benchmarks/holmer/zebra.in b/examples/benchmarks/holmer/zebra.in
new file mode 100644
index 0000000..360d2ab
--- /dev/null
+++ b/examples/benchmarks/holmer/zebra.in
@@ -0,0 +1 @@
+:- '$benchmark'(zebra, 1000, main, '$dummy').
diff --git a/examples/benchmarks/holmer/zebra.pl b/examples/benchmarks/holmer/zebra.pl
new file mode 100644
index 0000000..e1cdd0f
--- /dev/null
+++ b/examples/benchmarks/holmer/zebra.pl
@@ -0,0 +1,49 @@
+/* CHANGELOG by M.Banbara
+ - comment print_houses/1 out.
+*/
+
+
+% Where does the zebra live?
+% Puzzle solution written by Claude Sammut.
+main :-
+ houses(Houses),
+ member(house(red, english, _, _, _), Houses),
+ member(house(_, spanish, dog, _, _), Houses),
+ member(house(green, _, _, coffee, _), Houses),
+ member(house(_, ukrainian, _, tea, _), Houses),
+ right_of(house(green,_,_,_,_), house(ivory,_,_,_,_), Houses),
+ member(house(_, _, snails, _, winstons), Houses),
+ member(house(yellow, _, _, _, kools), Houses),
+ Houses = [_, _, house(_, _, _, milk, _), _,_],
+ Houses = [house(_, norwegian, _, _, _)|_],
+ next_to(house(_,_,_,_,chesterfields), house(_,_,fox,_,_), Houses),
+ next_to(house(_,_,_,_,kools), house(_,_,horse,_,_), Houses),
+ member(house(_, _, _, orange_juice, lucky_strikes), Houses),
+ member(house(_, japanese, _, _, parliaments), Houses),
+ next_to(house(_,norwegian,_,_,_), house(blue,_,_,_,_), Houses),
+ member(house(_, _, zebra, _, _), Houses),
+ member(house(_, _, _, water, _), Houses).
+ %print_houses(Houses).
+
+houses([
+ house(_, _, _, _, _),
+ house(_, _, _, _, _),
+ house(_, _, _, _, _),
+ house(_, _, _, _, _),
+ house(_, _, _, _, _)
+]).
+
+right_of(A, B, [B, A | _]).
+right_of(A, B, [_ | Y]) :- right_of(A, B, Y).
+
+next_to(A, B, [A, B | _]).
+next_to(A, B, [B, A | _]).
+next_to(A, B, [_ | Y]) :- next_to(A, B, Y).
+
+member(X, [X|_]).
+member(X, [_|Y]) :- member(X, Y).
+
+print_houses([A|B]) :- !,
+ write(A), nl,
+ print_houses(B).
+print_houses([]).
diff --git a/examples/benchmarks/minerva/Makefile b/examples/benchmarks/minerva/Makefile
new file mode 100644
index 0000000..7813272
--- /dev/null
+++ b/examples/benchmarks/minerva/Makefile
@@ -0,0 +1,97 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS =
+PLJAR = pljar
+PLJAROPTS = -v
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar:bench_util.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+# /bin/echo "[$*], qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/minerva/bench_util.pl b/examples/benchmarks/minerva/bench_util.pl
new file mode 100644
index 0000000..a490962
--- /dev/null
+++ b/examples/benchmarks/minerva/bench_util.pl
@@ -0,0 +1,47 @@
+% File : bench_util.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 24 February 2008
+% Purpose: Benchmark utilities
+% Note : based on driver.pl in Pereira's benchmark
+
+'$get_cpu_time'(T) :- statistics(runtime, [T,_]).
+
+'$report'(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ '$report_csv'(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+'$report_csv'([], _) :- !.
+'$report_csv'([X], _) :- !, write(X), nl.
+'$report_csv'([X|Xs], Delim) :- write(X), write(Delim), '$report_csv'(Xs, Delim).
+
+'$benchmark'(Name, Iterations, Action, Control) :-
+ '$get_cpu_time'(T0),
+ ( '$repeat'(Iterations), once(Action), fail
+ ; '$get_cpu_time'(T1)
+ ),
+ ( '$repeat'(Iterations), once(Control), fail
+ ; '$get_cpu_time'(T2)
+ ),
+ '$report'(Name, Iterations, T0, T1, T2).
+
+'$repeat'(N) :- N > 0, '$from'(1, N).
+
+'$from'(I, I) :- !.
+'$from'(L, U) :- M is (L+U)>>1, '$from'(L, M).
+'$from'(L, U) :- M is (L+U)>>1+1, '$from'(M, U).
+
+'$dummy'.
+'$dummy'(_).
+'$dummy'(_, _).
+'$dummy'(_, _, _).
diff --git a/examples/benchmarks/minerva/mrp_and_mrs.in b/examples/benchmarks/minerva/mrp_and_mrs.in
new file mode 100644
index 0000000..1180a29
--- /dev/null
+++ b/examples/benchmarks/minerva/mrp_and_mrs.in
@@ -0,0 +1,3 @@
+:- '$benchmark'('MrPandMrS', 10, ps, '$dummy').
+
+
diff --git a/examples/benchmarks/minerva/mrp_and_mrs.pl b/examples/benchmarks/minerva/mrp_and_mrs.pl
new file mode 100644
index 0000000..2c0856d
--- /dev/null
+++ b/examples/benchmarks/minerva/mrp_and_mrs.pl
@@ -0,0 +1,59 @@
+/* CHANGELOG by M.Banbara
+ - for/3 is added.
+ - comment out write/1, nl/0.
+*/
+
+% File : MrP_and_MrS.pl
+% Authors: IF Computer
+% Purpose: Martin Nilsson's Mr. P and Mr. S problem
+% Notes : http://www.ifcomputer.com/MINERVA/ExamplePrograms/Benchmarks/MrPandMrS/home_jp.html
+
+%ps :- w(o1, _, X), write(X), nl.
+ps :- w(o1, _, X).
+
+w(s1, (I,J), (M,N)) :-
+ for(2, M, 99),
+ for(2, N, M),
+ M+N =:= I+J.
+w(p1, (I,J), (M,N)) :-
+ for(2, M, 99),
+ for(2, N, M),
+ M*N =:= I*J.
+w(s2, S, X) :- w(s1, S, X), p3(X).
+w(p2, S, X) :- w(p1, S, X), p4(X).
+w(s3, S, X) :- w(s2, S, X), p5(X).
+w(o1, _, (M,N)) :-
+ for(2, M, 99), for(2, N, M), %write((M,N)), nl,
+ p3((M,N)), %write(p3), nl,
+ p4((M,N)), %write(p4), nl,
+ p5((M,N)), %write(p5), nl,
+ p6((M,N)). %write(p6), nl.
+
+p3(X) :- has_two_or_more_solutions(w(p1,X,_)).
+p4(X) :- has_two_or_more_solutions(w(s2,X,_)),
+ all_in_are(Z, (w(s1,X,W),value(p3(W),Z)),true).
+p5(X) :- has_exactly_one_solution(w(p2,X,_)).
+p6(X) :- has_exactly_one_solution(w(s3,X,_)).
+
+value(X,V) :- (X, V=true; V=false), !.
+
+all_in_are(X,G,Z) :- \+ ((G,X \= Z)), !.
+
+has_exactly_one_solution(X) :-
+ copy_term(X, X2),
+ X,
+ all_in_are(X2, X2, X),
+ !.
+
+has_two_or_more_solutions(X) :-
+ copy_term(X, X2),
+ X,
+ !,
+ X2,
+ X \= X2,
+ !.
+
+for(M, I, N) :- M =< N, I=M.
+for(M, I, N) :- M =< N, M1 is M+1, for(M1, I, N).
+
+
diff --git a/examples/benchmarks/pereira/Makefile b/examples/benchmarks/pereira/Makefile
new file mode 100644
index 0000000..e0f87cf
--- /dev/null
+++ b/examples/benchmarks/pereira/Makefile
@@ -0,0 +1,95 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS = -J '-Xmx500m'
+PLJAR = pljar
+PLJAROPTS = -v -J '-Xmx100m' -C '-J-Xmx300m'
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/pereira/pereira.in b/examples/benchmarks/pereira/pereira.in
new file mode 100644
index 0000000..b8af161
--- /dev/null
+++ b/examples/benchmarks/pereira/pereira.in
@@ -0,0 +1,2 @@
+:- benches.
+
diff --git a/examples/benchmarks/pereira/pereira.pl b/examples/benchmarks/pereira/pereira.pl
new file mode 100644
index 0000000..0c779d7
--- /dev/null
+++ b/examples/benchmarks/pereira/pereira.pl
@@ -0,0 +1,1873 @@
+%%% Fernando Pereira's benchmarks (26-DEC-86)
+
+/*
+ CHANGELOG by M.Banbara
+ - abolish/2 --> abolish/1
+ - dynamic dix/2 is add.
+ - dynamic ua/3 is add.
+ - op(1150,fx,(public)) is added.
+ - op(1150,fx,(mode)) is added.
+ - report/4 --> report/5
+ - bench_mark/1 is modified.
+*/
+:- dynamic dix/2.
+:- dynamic ua/3.
+:- op(1150, fx, (public)).
+:- op(1150, fx, (mode)).
+
+/* I've received several requests for the benchmarks that were used in
+the June issue of AI Expert. The purpose of these benchmarks is to try
+to identify strengths and weaknesses in the basic engine of a Prolog
+system. In particular, I try to separate costs normaly conflated in
+other benchmark suites, such as procedure call cost, term matching and
+term construction costs and the costs of tail calls vs. nontail calls.
+I'm sure the benchmarks could be improved, but I don't have time to
+work on them right now. Also, I must say that I have relatively little
+faith on small benchmark programs. I find that performance (both time
+and space) on substantial programs, reliability, adherence to de facto
+standards and ease of use are far more important in practice. I've
+tried several Prolog systems that performed very well on small
+benchmarks (including mine), but that failed badly on one or more of
+these criteria.
+
+Some of the benchmarks are inspired on a benchmark suite developed at
+ICOT for their SIM project, and other benchmark choices were
+influenced by discussions with ICOT researchers on the relative
+performance of SIM-I vs. Prolog-20.
+
+-- Fernando Pereira
+*/
+
+% File : driver.pl
+% Author : Richard O'Keefe based on earlier versions due to
+% Paul Wilk, Fernando Pereira, David Warren et al.
+% Updated: 29 December 1986
+% Defines: from/3 and get_cpu_time/1.
+% Version: Dec-10 Prolog & Quintus Prolog.
+
+:- public
+ from/3,
+ get_cpu_time/1.
+
+:- mode
+ from(+, +, -),
+ get_cpu_time(-).
+
+% from(LowerBound, UpperBound, I)
+% binds I to successive integers in the range LowerBound..UpperBound.
+% It is designed solely for use in this application; for a general
+% way of doing this use the standard library predicate between/3, or
+% perhaps repeat/1.
+
+from(I, I, I) :- !.
+from(L, U, I) :- M is (L+U) >> 1, from(L, M, I).
+from(L, U, I) :- M is (L+U) >> 1 + 1, from(M, U, I).
+
+
+% get_cpu_time(T)
+% unifies T with the run time since start-up in milliseconds.
+% (We can't use the second element of the list, as some of the
+% tests will call statistics/2 and reset it.)
+
+get_cpu_time(T) :-
+ statistics(runtime, [T,_]).
+
+
+% report(N, T0, T1, T2)
+% takes the three times yielded by get_cpu_time and the number
+% of iterations and prints the total, overhead, and average.
+
+%report(N, T0, T1, T2) :-
+% TestTime is T1-T0,
+% OverHead is T2-T1,
+% Average is (TestTime-OverHead)/N,
+% write((TestTime-OverHead)/N=Average),
+% write(' milli-seconds/iteration'), nl.
+
+report(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ report_csv(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+report_csv([], _) :- !.
+report_csv([X], _) :- !, write(X), nl.
+report_csv([X|Xs], Delim) :- write(X), write(Delim), report_csv(Xs, Delim).
+
+% bench_mark(Name)
+% is the new top level. It calls bench_mark/4 to find out
+% how many Iterations of the Action and its Control to perform.
+% To get the old effect, do something like
+% bench_mark(nrev, 50, nrev(L), dummy(L)) :- data(L).
+
+bench_mark(Name) :-
+ bench_mark(Name, Iterations, Action, Control),
+ get_cpu_time(T0),
+ ( repeat(Iterations), call(Action), fail
+ ; get_cpu_time(T1)
+ ),
+ ( repeat(Iterations), call(Control), fail
+ ; get_cpu_time(T2)
+ ),
+ report(Name, Iterations, T0, T1, T2).
+ %write(Name), write(' took '),
+ %report(Iterations, T0, T1, T2).
+
+
+% repeat(N)
+% succeeds precisely N times.
+
+repeat(N) :-
+ N > 0,
+ from(1, N).
+
+from(I, I) :- !.
+from(L, U) :- M is (L+U)>>1, from(L, M).
+from(L, U) :- M is (L+U)>>1+1, from(M, U).
+
+% File : benches.pl
+% Author : Fernando Pereira
+% Updated: 29 December 1986
+% Defines: benches/0, bench_mark/1
+% Purpose:
+% Here are all the benchmarks. Some are based on the ICOT benchmark set
+% (version of January 24, 1985), others are different. All the benchmarks
+% attempt to measure just one thing, eg. determinate procedure call, list
+% construction, list destruction.
+% To run the whole set, call 'benches'.
+
+% Do all the benchmarks
+
+:- public benches/0, bench_mark/1.
+
+benches :-
+ bench_mark(Name, _, _, _),
+ bench_mark(Name),
+ fail.
+benches.
+
+% Trivial predicates for use in controls.
+
+:- public dummy/0, dummy/1, dummy/2, dummy/3.
+
+dummy.
+
+dummy(_).
+
+dummy(_, _).
+
+dummy(_, _, _).
+
+% The actual benchamarks
+
+% 1. 100 determinate tail calls
+
+bench_mark(tail_call_atom_atom, 200000, p1(a), dummy(a)).
+
+:- public p1/1.
+
+p1(a) :- p2(a).
+p2(a) :- p3(a).
+p3(a) :- p4(a).
+p4(a) :- p5(a).
+p5(a) :- p6(a).
+p6(a) :- p7(a).
+p7(a) :- p8(a).
+p8(a) :- p9(a).
+p9(a) :- p10(a).
+p10(a) :- p11(a).
+p11(a) :- p12(a).
+p12(a) :- p13(a).
+p13(a) :- p14(a).
+p14(a) :- p15(a).
+p15(a) :- p16(a).
+p16(a) :- p17(a).
+p17(a) :- p18(a).
+p18(a) :- p19(a).
+p19(a) :- p20(a).
+p20(a) :- p21(a).
+p21(a) :- p22(a).
+p22(a) :- p23(a).
+p23(a) :- p24(a).
+p24(a) :- p25(a).
+p25(a) :- p26(a).
+p26(a) :- p27(a).
+p27(a) :- p28(a).
+p28(a) :- p29(a).
+p29(a) :- p30(a).
+p30(a) :- p31(a).
+p31(a) :- p32(a).
+p32(a) :- p33(a).
+p33(a) :- p34(a).
+p34(a) :- p35(a).
+p35(a) :- p36(a).
+p36(a) :- p37(a).
+p37(a) :- p38(a).
+p38(a) :- p39(a).
+p39(a) :- p40(a).
+p40(a) :- p41(a).
+p41(a) :- p42(a).
+p42(a) :- p43(a).
+p43(a) :- p44(a).
+p44(a) :- p45(a).
+p45(a) :- p46(a).
+p46(a) :- p47(a).
+p47(a) :- p48(a).
+p48(a) :- p49(a).
+p49(a) :- p50(a).
+p50(a) :- p51(a).
+p51(a) :- p52(a).
+p52(a) :- p53(a).
+p53(a) :- p54(a).
+p54(a) :- p55(a).
+p55(a) :- p56(a).
+p56(a) :- p57(a).
+p57(a) :- p58(a).
+p58(a) :- p59(a).
+p59(a) :- p60(a).
+p60(a) :- p61(a).
+p61(a) :- p62(a).
+p62(a) :- p63(a).
+p63(a) :- p64(a).
+p64(a) :- p65(a).
+p65(a) :- p66(a).
+p66(a) :- p67(a).
+p67(a) :- p68(a).
+p68(a) :- p69(a).
+p69(a) :- p70(a).
+p70(a) :- p71(a).
+p71(a) :- p72(a).
+p72(a) :- p73(a).
+p73(a) :- p74(a).
+p74(a) :- p75(a).
+p75(a) :- p76(a).
+p76(a) :- p77(a).
+p77(a) :- p78(a).
+p78(a) :- p79(a).
+p79(a) :- p80(a).
+p80(a) :- p81(a).
+p81(a) :- p82(a).
+p82(a) :- p83(a).
+p83(a) :- p84(a).
+p84(a) :- p85(a).
+p85(a) :- p86(a).
+p86(a) :- p87(a).
+p87(a) :- p88(a).
+p88(a) :- p89(a).
+p89(a) :- p90(a).
+p90(a) :- p91(a).
+p91(a) :- p92(a).
+p92(a) :- p93(a).
+p93(a) :- p94(a).
+p94(a) :- p95(a).
+p95(a) :- p96(a).
+p96(a) :- p97(a).
+p97(a) :- p98(a).
+p98(a) :- p99(a).
+p99(a) :- p100(a).
+p100(a).
+
+% 2. 63 determinate nontail calls, 64 determinate tail calls.
+
+bench_mark(binary_call_atom_atom, 200000, q1(a), dummy(a)).
+
+:- public q1/1.
+
+q1(a) :- q2(a), q3(a).
+q2(a) :- q4(a), q5(a).
+q3(a) :- q6(a), q7(a).
+q4(a) :- q8(a), q9(a).
+q5(a) :- q10(a), q11(a).
+q6(a) :- q12(a), q13(a).
+q7(a) :- q14(a), q15(a).
+q8(a) :- q16(a), q17(a).
+q9(a) :- q18(a), q19(a).
+q10(a) :- q20(a), q21(a).
+q11(a) :- q22(a), q23(a).
+q12(a) :- q24(a), q25(a).
+q13(a) :- q26(a), q27(a).
+q14(a) :- q28(a), q29(a).
+q15(a) :- q30(a), q31(a).
+q16(a) :- q32(a), q33(a).
+q17(a) :- q34(a), q35(a).
+q18(a) :- q36(a), q37(a).
+q19(a) :- q38(a), q39(a).
+q20(a) :- q40(a), q41(a).
+q21(a) :- q42(a), q43(a).
+q22(a) :- q44(a), q45(a).
+q23(a) :- q46(a), q47(a).
+q24(a) :- q48(a), q49(a).
+q25(a) :- q50(a), q51(a).
+q26(a) :- q52(a), q53(a).
+q27(a) :- q54(a), q55(a).
+q28(a) :- q56(a), q57(a).
+q29(a) :- q58(a), q59(a).
+q30(a) :- q60(a), q61(a).
+q31(a) :- q62(a), q63(a).
+q32(a) :- q64(a), q65(a).
+q33(a) :- q66(a), q67(a).
+q34(a) :- q68(a), q69(a).
+q35(a) :- q70(a), q71(a).
+q36(a) :- q72(a), q73(a).
+q37(a) :- q74(a), q75(a).
+q38(a) :- q76(a), q77(a).
+q39(a) :- q78(a), q79(a).
+q40(a) :- q80(a), q81(a).
+q41(a) :- q82(a), q83(a).
+q42(a) :- q84(a), q85(a).
+q43(a) :- q86(a), q87(a).
+q44(a) :- q88(a), q89(a).
+q45(a) :- q90(a), q91(a).
+q46(a) :- q92(a), q93(a).
+q47(a) :- q94(a), q95(a).
+q48(a) :- q96(a), q97(a).
+q49(a) :- q98(a), q99(a).
+q50(a) :- q100(a), q101(a).
+q51(a) :- q102(a), q103(a).
+q52(a) :- q104(a), q105(a).
+q53(a) :- q106(a), q107(a).
+q54(a) :- q108(a), q109(a).
+q55(a) :- q110(a), q111(a).
+q56(a) :- q112(a), q113(a).
+q57(a) :- q114(a), q115(a).
+q58(a) :- q116(a), q117(a).
+q59(a) :- q118(a), q119(a).
+q60(a) :- q120(a), q121(a).
+q61(a) :- q122(a), q123(a).
+q62(a) :- q124(a), q125(a).
+q63(a) :- q126(a), q127(a).
+q64(a).
+q65(a).
+q66(a).
+q67(a).
+q68(a).
+q69(a).
+q70(a).
+q71(a).
+q72(a).
+q73(a).
+q74(a).
+q75(a).
+q76(a).
+q77(a).
+q78(a).
+q79(a).
+q80(a).
+q81(a).
+q82(a).
+q83(a).
+q84(a).
+q85(a).
+q86(a).
+q87(a).
+q88(a).
+q89(a).
+q90(a).
+q91(a).
+q92(a).
+q93(a).
+q94(a).
+q95(a).
+q96(a).
+q97(a).
+q98(a).
+q99(a).
+q100(a).
+q101(a).
+q102(a).
+q103(a).
+q104(a).
+q105(a).
+q106(a).
+q107(a).
+q108(a).
+q109(a).
+q110(a).
+q111(a).
+q112(a).
+q113(a).
+q114(a).
+q115(a).
+q116(a).
+q117(a).
+q118(a).
+q119(a).
+q120(a).
+q121(a).
+q122(a).
+q123(a).
+q124(a).
+q125(a).
+q126(a).
+q127(a).
+
+% 3. Construct one 100 element list, nonrecursively.
+
+bench_mark(cons_list, 200000, r1(L), dummy(L)).
+
+:- public r1/1.
+
+% 4. Walk down a 100 element list, nonrecursively
+
+bench_mark(walk_list, 200000, r1(L), dummy(L)) :- r1(L).
+
+% 5. Walk down a 100 element list, recursively
+
+bench_mark(walk_list_rec, 200000, wlr(L), dummy(L)) :- r1(L).
+
+:- public wlr/1.
+
+% 6. Walk down N 100 copies of the same 100 element list, recursively.
+
+%bench_mark(args(N), 200000, args(N, L), dummy(N, L)) :- args(N), r1(L).
+bench_mark(walk_list(N), 200000, args(N, L), dummy(N, L)) :- args(N), r1(L).
+
+:- public args/2.
+
+args(1). args(2). args(4). args(8). args(16).
+
+args(1, L) :- wlr(L).
+args(2, L) :- wlr(L, L).
+args(4, L) :- wlr(L, L, L, L).
+args(8, L) :- wlr(L, L, L, L, L, L, L, L).
+args(16, L) :- wlr(L, L, L, L, L, L, L, L, L, L, L, L, L, L, L, L).
+
+wlr([]).
+wlr([_|L]) :- wlr(L).
+
+wlr([], []).
+wlr([_|L1], [_|L2]) :- wlr(L1, L2).
+
+wlr([], [], [], []).
+wlr([_|L1], [_|L2], [_|L3], [_|L4]) :- wlr(L1, L2, L3, L4).
+
+wlr([], [], [], [], [], [], [], []).
+wlr([_|L1], [_|L2], [_|L3], [_|L4], [_|L5], [_|L6], [_|L7], [_|L8]) :-
+ wlr(L1, L2, L3, L4, L5, L6, L7, L8).
+
+wlr([], [], [], [], [], [], [], [], [], [], [], [], [], [], [], []).
+wlr([_|L1], [_|L2], [_|L3], [_|L4], [_|L5], [_|L6], [_|L7], [_|L8],
+ [_|L9], [_|L10], [_|L11], [_|L12], [_|L13], [_|L14], [_|L15], [_|L16]) :-
+ wlr(L1, L2, L3, L4, L5, L6, L7, L8, L9, L10, L11, L12, L13, L14, L15, L16).
+
+% Nonrecursive list cruncher
+
+r1([1|R]) :- r2(R).
+r2([2|R]) :- r3(R).
+r3([3|R]) :- r4(R).
+r4([4|R]) :- r5(R).
+r5([5|R]) :- r6(R).
+r6([6|R]) :- r7(R).
+r7([7|R]) :- r8(R).
+r8([8|R]) :- r9(R).
+r9([9|R]) :- r10(R).
+r10([10|R]) :- r11(R).
+r11([11|R]) :- r12(R).
+r12([12|R]) :- r13(R).
+r13([13|R]) :- r14(R).
+r14([14|R]) :- r15(R).
+r15([15|R]) :- r16(R).
+r16([16|R]) :- r17(R).
+r17([17|R]) :- r18(R).
+r18([18|R]) :- r19(R).
+r19([19|R]) :- r20(R).
+r20([20|R]) :- r21(R).
+r21([21|R]) :- r22(R).
+r22([22|R]) :- r23(R).
+r23([23|R]) :- r24(R).
+r24([24|R]) :- r25(R).
+r25([25|R]) :- r26(R).
+r26([26|R]) :- r27(R).
+r27([27|R]) :- r28(R).
+r28([28|R]) :- r29(R).
+r29([29|R]) :- r30(R).
+r30([30|R]) :- r31(R).
+r31([31|R]) :- r32(R).
+r32([32|R]) :- r33(R).
+r33([33|R]) :- r34(R).
+r34([34|R]) :- r35(R).
+r35([35|R]) :- r36(R).
+r36([36|R]) :- r37(R).
+r37([37|R]) :- r38(R).
+r38([38|R]) :- r39(R).
+r39([39|R]) :- r40(R).
+r40([40|R]) :- r41(R).
+r41([41|R]) :- r42(R).
+r42([42|R]) :- r43(R).
+r43([43|R]) :- r44(R).
+r44([44|R]) :- r45(R).
+r45([45|R]) :- r46(R).
+r46([46|R]) :- r47(R).
+r47([47|R]) :- r48(R).
+r48([48|R]) :- r49(R).
+r49([49|R]) :- r50(R).
+r50([50|R]) :- r51(R).
+r51([51|R]) :- r52(R).
+r52([52|R]) :- r53(R).
+r53([53|R]) :- r54(R).
+r54([54|R]) :- r55(R).
+r55([55|R]) :- r56(R).
+r56([56|R]) :- r57(R).
+r57([57|R]) :- r58(R).
+r58([58|R]) :- r59(R).
+r59([59|R]) :- r60(R).
+r60([60|R]) :- r61(R).
+r61([61|R]) :- r62(R).
+r62([62|R]) :- r63(R).
+r63([63|R]) :- r64(R).
+r64([64|R]) :- r65(R).
+r65([65|R]) :- r66(R).
+r66([66|R]) :- r67(R).
+r67([67|R]) :- r68(R).
+r68([68|R]) :- r69(R).
+r69([69|R]) :- r70(R).
+r70([70|R]) :- r71(R).
+r71([71|R]) :- r72(R).
+r72([72|R]) :- r73(R).
+r73([73|R]) :- r74(R).
+r74([74|R]) :- r75(R).
+r75([75|R]) :- r76(R).
+r76([76|R]) :- r77(R).
+r77([77|R]) :- r78(R).
+r78([78|R]) :- r79(R).
+r79([79|R]) :- r80(R).
+r80([80|R]) :- r81(R).
+r81([81|R]) :- r82(R).
+r82([82|R]) :- r83(R).
+r83([83|R]) :- r84(R).
+r84([84|R]) :- r85(R).
+r85([85|R]) :- r86(R).
+r86([86|R]) :- r87(R).
+r87([87|R]) :- r88(R).
+r88([88|R]) :- r89(R).
+r89([89|R]) :- r90(R).
+r90([90|R]) :- r91(R).
+r91([91|R]) :- r92(R).
+r92([92|R]) :- r93(R).
+r93([93|R]) :- r94(R).
+r94([94|R]) :- r95(R).
+r95([95|R]) :- r96(R).
+r96([96|R]) :- r97(R).
+r97([97|R]) :- r98(R).
+r98([98|R]) :- r99(R).
+r99([99|R]) :- r100(R).
+r100([100|R]) :- r101(R).
+r101([]).
+
+% 7. Construct a term with 100 nodes, nonrecursively
+
+bench_mark(cons_term, 200000, s1(T), dummy(T)).
+
+:- public s1/1.
+
+% 8. Walk down a term with 100 nodes, nonrecursively.
+
+bench_mark(walk_term, 200000, s1(T), dummy(T)) :- s1(T).
+
+% 9. Walk down a term with 100 nodes, recursively.
+
+bench_mark(walk_term_rec, 200000, wtr(T), dummy(T)) :- s1(T).
+
+:- public wtr/1.
+
+wtr(nil).
+wtr(f(_,R)) :- wtr(R).
+
+% Nonrecursive term cruncher
+
+s1(f(1, R)) :- s2(R).
+s2(f(2, R)) :- s3(R).
+s3(f(3, R)) :- s4(R).
+s4(f(4, R)) :- s5(R).
+s5(f(5, R)) :- s6(R).
+s6(f(6, R)) :- s7(R).
+s7(f(7, R)) :- s8(R).
+s8(f(8, R)) :- s9(R).
+s9(f(9, R)) :- s10(R).
+s10(f(10, R)) :- s11(R).
+s11(f(11, R)) :- s12(R).
+s12(f(12, R)) :- s13(R).
+s13(f(13, R)) :- s14(R).
+s14(f(14, R)) :- s15(R).
+s15(f(15, R)) :- s16(R).
+s16(f(16, R)) :- s17(R).
+s17(f(17, R)) :- s18(R).
+s18(f(18, R)) :- s19(R).
+s19(f(19, R)) :- s20(R).
+s20(f(20, R)) :- s21(R).
+s21(f(21, R)) :- s22(R).
+s22(f(22, R)) :- s23(R).
+s23(f(23, R)) :- s24(R).
+s24(f(24, R)) :- s25(R).
+s25(f(25, R)) :- s26(R).
+s26(f(26, R)) :- s27(R).
+s27(f(27, R)) :- s28(R).
+s28(f(28, R)) :- s29(R).
+s29(f(29, R)) :- s30(R).
+s30(f(30, R)) :- s31(R).
+s31(f(31, R)) :- s32(R).
+s32(f(32, R)) :- s33(R).
+s33(f(33, R)) :- s34(R).
+s34(f(34, R)) :- s35(R).
+s35(f(35, R)) :- s36(R).
+s36(f(36, R)) :- s37(R).
+s37(f(37, R)) :- s38(R).
+s38(f(38, R)) :- s39(R).
+s39(f(39, R)) :- s40(R).
+s40(f(40, R)) :- s41(R).
+s41(f(41, R)) :- s42(R).
+s42(f(42, R)) :- s43(R).
+s43(f(43, R)) :- s44(R).
+s44(f(44, R)) :- s45(R).
+s45(f(45, R)) :- s46(R).
+s46(f(46, R)) :- s47(R).
+s47(f(47, R)) :- s48(R).
+s48(f(48, R)) :- s49(R).
+s49(f(49, R)) :- s50(R).
+s50(f(50, R)) :- s51(R).
+s51(f(51, R)) :- s52(R).
+s52(f(52, R)) :- s53(R).
+s53(f(53, R)) :- s54(R).
+s54(f(54, R)) :- s55(R).
+s55(f(55, R)) :- s56(R).
+s56(f(56, R)) :- s57(R).
+s57(f(57, R)) :- s58(R).
+s58(f(58, R)) :- s59(R).
+s59(f(59, R)) :- s60(R).
+s60(f(60, R)) :- s61(R).
+s61(f(61, R)) :- s62(R).
+s62(f(62, R)) :- s63(R).
+s63(f(63, R)) :- s64(R).
+s64(f(64, R)) :- s65(R).
+s65(f(65, R)) :- s66(R).
+s66(f(66, R)) :- s67(R).
+s67(f(67, R)) :- s68(R).
+s68(f(68, R)) :- s69(R).
+s69(f(69, R)) :- s70(R).
+s70(f(70, R)) :- s71(R).
+s71(f(71, R)) :- s72(R).
+s72(f(72, R)) :- s73(R).
+s73(f(73, R)) :- s74(R).
+s74(f(74, R)) :- s75(R).
+s75(f(75, R)) :- s76(R).
+s76(f(76, R)) :- s77(R).
+s77(f(77, R)) :- s78(R).
+s78(f(78, R)) :- s79(R).
+s79(f(79, R)) :- s80(R).
+s80(f(80, R)) :- s81(R).
+s81(f(81, R)) :- s82(R).
+s82(f(82, R)) :- s83(R).
+s83(f(83, R)) :- s84(R).
+s84(f(84, R)) :- s85(R).
+s85(f(85, R)) :- s86(R).
+s86(f(86, R)) :- s87(R).
+s87(f(87, R)) :- s88(R).
+s88(f(88, R)) :- s89(R).
+s89(f(89, R)) :- s90(R).
+s90(f(90, R)) :- s91(R).
+s91(f(91, R)) :- s92(R).
+s92(f(92, R)) :- s93(R).
+s93(f(93, R)) :- s94(R).
+s94(f(94, R)) :- s95(R).
+s95(f(95, R)) :- s96(R).
+s96(f(96, R)) :- s97(R).
+s97(f(97, R)) :- s98(R).
+s98(f(98, R)) :- s99(R).
+s99(f(99, R)) :- s100(R).
+s100(f(100, R)) :- s101(R).
+s101(nil).
+
+% 10. 99 shallow failures; assumes no indexing on 2nd argument
+
+bench_mark(shallow_backtracking, 200000, shallow, dummy).
+
+:- public shallow/0.
+
+% 11. 99 deep failures; assumes no indexing on 2nd argument
+
+bench_mark(deep_backtracking, 200000, deep, dummy).
+
+:- public deep/0.
+
+shallow :- b(_X, 100).
+deep :- b(_X, Y), Y = 100.
+
+b(_X, 1).
+b(_X, 2).
+b(_X, 3).
+b(_X, 4).
+b(_X, 5).
+b(_X, 6).
+b(_X, 7).
+b(_X, 8).
+b(_X, 9).
+b(_X, 10).
+b(_X, 11).
+b(_X, 12).
+b(_X, 13).
+b(_X, 14).
+b(_X, 15).
+b(_X, 16).
+b(_X, 17).
+b(_X, 18).
+b(_X, 19).
+b(_X, 20).
+b(_X, 21).
+b(_X, 22).
+b(_X, 23).
+b(_X, 24).
+b(_X, 25).
+b(_X, 26).
+b(_X, 27).
+b(_X, 28).
+b(_X, 29).
+b(_X, 30).
+b(_X, 31).
+b(_X, 32).
+b(_X, 33).
+b(_X, 34).
+b(_X, 35).
+b(_X, 36).
+b(_X, 37).
+b(_X, 38).
+b(_X, 39).
+b(_X, 40).
+b(_X, 41).
+b(_X, 42).
+b(_X, 43).
+b(_X, 44).
+b(_X, 45).
+b(_X, 46).
+b(_X, 47).
+b(_X, 48).
+b(_X, 49).
+b(_X, 50).
+b(_X, 51).
+b(_X, 52).
+b(_X, 53).
+b(_X, 54).
+b(_X, 55).
+b(_X, 56).
+b(_X, 57).
+b(_X, 58).
+b(_X, 59).
+b(_X, 60).
+b(_X, 61).
+b(_X, 62).
+b(_X, 63).
+b(_X, 64).
+b(_X, 65).
+b(_X, 66).
+b(_X, 67).
+b(_X, 68).
+b(_X, 69).
+b(_X, 70).
+b(_X, 71).
+b(_X, 72).
+b(_X, 73).
+b(_X, 74).
+b(_X, 75).
+b(_X, 76).
+b(_X, 77).
+b(_X, 78).
+b(_X, 79).
+b(_X, 80).
+b(_X, 81).
+b(_X, 82).
+b(_X, 83).
+b(_X, 84).
+b(_X, 85).
+b(_X, 86).
+b(_X, 87).
+b(_X, 88).
+b(_X, 89).
+b(_X, 90).
+b(_X, 91).
+b(_X, 92).
+b(_X, 93).
+b(_X, 94).
+b(_X, 95).
+b(_X, 96).
+b(_X, 97).
+b(_X, 98).
+b(_X, 99).
+b(_X, 100).
+
+
+% 12. Push 100 choice points
+% Assumes no super-clever (multipredicate) optimizer
+
+bench_mark(choice_point, 200000, choice, dummy).
+
+:- public choice/0.
+
+choice :- c1(a), !.
+
+c1(a) :- c2(a).
+c1(a).
+c2(a) :- c3(a).
+c2(a).
+c3(a) :- c4(a).
+c3(a).
+c4(a) :- c5(a).
+c4(a).
+c5(a) :- c6(a).
+c5(a).
+c6(a) :- c7(a).
+c6(a).
+c7(a) :- c8(a).
+c7(a).
+c8(a) :- c9(a).
+c8(a).
+c9(a) :- c10(a).
+c9(a).
+c10(a) :- c11(a).
+c10(a).
+c11(a) :- c12(a).
+c11(a).
+c12(a) :- c13(a).
+c12(a).
+c13(a) :- c14(a).
+c13(a).
+c14(a) :- c15(a).
+c14(a).
+c15(a) :- c16(a).
+c15(a).
+c16(a) :- c17(a).
+c16(a).
+c17(a) :- c18(a).
+c17(a).
+c18(a) :- c19(a).
+c18(a).
+c19(a) :- c20(a).
+c19(a).
+c20(a) :- c21(a).
+c20(a).
+c21(a) :- c22(a).
+c21(a).
+c22(a) :- c23(a).
+c22(a).
+c23(a) :- c24(a).
+c23(a).
+c24(a) :- c25(a).
+c24(a).
+c25(a) :- c26(a).
+c25(a).
+c26(a) :- c27(a).
+c26(a).
+c27(a) :- c28(a).
+c27(a).
+c28(a) :- c29(a).
+c28(a).
+c29(a) :- c30(a).
+c29(a).
+c30(a) :- c31(a).
+c30(a).
+c31(a) :- c32(a).
+c31(a).
+c32(a) :- c33(a).
+c32(a).
+c33(a) :- c34(a).
+c33(a).
+c34(a) :- c35(a).
+c34(a).
+c35(a) :- c36(a).
+c35(a).
+c36(a) :- c37(a).
+c36(a).
+c37(a) :- c38(a).
+c37(a).
+c38(a) :- c39(a).
+c38(a).
+c39(a) :- c40(a).
+c39(a).
+c40(a) :- c41(a).
+c40(a).
+c41(a) :- c42(a).
+c41(a).
+c42(a) :- c43(a).
+c42(a).
+c43(a) :- c44(a).
+c43(a).
+c44(a) :- c45(a).
+c44(a).
+c45(a) :- c46(a).
+c45(a).
+c46(a) :- c47(a).
+c46(a).
+c47(a) :- c48(a).
+c47(a).
+c48(a) :- c49(a).
+c48(a).
+c49(a) :- c50(a).
+c49(a).
+c50(a) :- c51(a).
+c50(a).
+c51(a) :- c52(a).
+c51(a).
+c52(a) :- c53(a).
+c52(a).
+c53(a) :- c54(a).
+c53(a).
+c54(a) :- c55(a).
+c54(a).
+c55(a) :- c56(a).
+c55(a).
+c56(a) :- c57(a).
+c56(a).
+c57(a) :- c58(a).
+c57(a).
+c58(a) :- c59(a).
+c58(a).
+c59(a) :- c60(a).
+c59(a).
+c60(a) :- c61(a).
+c60(a).
+c61(a) :- c62(a).
+c61(a).
+c62(a) :- c63(a).
+c62(a).
+c63(a) :- c64(a).
+c63(a).
+c64(a) :- c65(a).
+c64(a).
+c65(a) :- c66(a).
+c65(a).
+c66(a) :- c67(a).
+c66(a).
+c67(a) :- c68(a).
+c67(a).
+c68(a) :- c69(a).
+c68(a).
+c69(a) :- c70(a).
+c69(a).
+c70(a) :- c71(a).
+c70(a).
+c71(a) :- c72(a).
+c71(a).
+c72(a) :- c73(a).
+c72(a).
+c73(a) :- c74(a).
+c73(a).
+c74(a) :- c75(a).
+c74(a).
+c75(a) :- c76(a).
+c75(a).
+c76(a) :- c77(a).
+c76(a).
+c77(a) :- c78(a).
+c77(a).
+c78(a) :- c79(a).
+c78(a).
+c79(a) :- c80(a).
+c79(a).
+c80(a) :- c81(a).
+c80(a).
+c81(a) :- c82(a).
+c81(a).
+c82(a) :- c83(a).
+c82(a).
+c83(a) :- c84(a).
+c83(a).
+c84(a) :- c85(a).
+c84(a).
+c85(a) :- c86(a).
+c85(a).
+c86(a) :- c87(a).
+c86(a).
+c87(a) :- c88(a).
+c87(a).
+c88(a) :- c89(a).
+c88(a).
+c89(a) :- c90(a).
+c89(a).
+c90(a) :- c91(a).
+c90(a).
+c91(a) :- c92(a).
+c91(a).
+c92(a) :- c93(a).
+c92(a).
+c93(a) :- c94(a).
+c93(a).
+c94(a) :- c95(a).
+c94(a).
+c95(a) :- c96(a).
+c95(a).
+c96(a) :- c97(a).
+c96(a).
+c97(a) :- c98(a).
+c97(a).
+c98(a) :- c99(a).
+c98(a).
+c99(a) :- c100(a).
+c99(a).
+c100(a).
+c100(a).
+
+% 13. Create 100 choice points and trail 100 variables
+
+bench_mark(trail_variables, 200000, trail, dummy).
+
+:- public trail/0.
+
+trail :- t1(_X), !.
+
+t1(a) :- t2(_X).
+t1(b).
+t2(a) :- t3(_X).
+t2(b).
+t3(a) :- t4(_X).
+t3(b).
+t4(a) :- t5(_X).
+t4(b).
+t5(a) :- t6(_X).
+t5(b).
+t6(a) :- t7(_X).
+t6(b).
+t7(a) :- t8(_X).
+t7(b).
+t8(a) :- t9(_X).
+t8(b).
+t9(a) :- t10(_X).
+t9(b).
+t10(a) :- t11(_X).
+t10(b).
+t11(a) :- t12(_X).
+t11(b).
+t12(a) :- t13(_X).
+t12(b).
+t13(a) :- t14(_X).
+t13(b).
+t14(a) :- t15(_X).
+t14(b).
+t15(a) :- t16(_X).
+t15(b).
+t16(a) :- t17(_X).
+t16(b).
+t17(a) :- t18(_X).
+t17(b).
+t18(a) :- t19(_X).
+t18(b).
+t19(a) :- t20(_X).
+t19(b).
+t20(a) :- t21(_X).
+t20(b).
+t21(a) :- t22(_X).
+t21(b).
+t22(a) :- t23(_X).
+t22(b).
+t23(a) :- t24(_X).
+t23(b).
+t24(a) :- t25(_X).
+t24(b).
+t25(a) :- t26(_X).
+t25(b).
+t26(a) :- t27(_X).
+t26(b).
+t27(a) :- t28(_X).
+t27(b).
+t28(a) :- t29(_X).
+t28(b).
+t29(a) :- t30(_X).
+t29(b).
+t30(a) :- t31(_X).
+t30(b).
+t31(a) :- t32(_X).
+t31(b).
+t32(a) :- t33(_X).
+t32(b).
+t33(a) :- t34(_X).
+t33(b).
+t34(a) :- t35(_X).
+t34(b).
+t35(a) :- t36(_X).
+t35(b).
+t36(a) :- t37(_X).
+t36(b).
+t37(a) :- t38(_X).
+t37(b).
+t38(a) :- t39(_X).
+t38(b).
+t39(a) :- t40(_X).
+t39(b).
+t40(a) :- t41(_X).
+t40(b).
+t41(a) :- t42(_X).
+t41(b).
+t42(a) :- t43(_X).
+t42(b).
+t43(a) :- t44(_X).
+t43(b).
+t44(a) :- t45(_X).
+t44(b).
+t45(a) :- t46(_X).
+t45(b).
+t46(a) :- t47(_X).
+t46(b).
+t47(a) :- t48(_X).
+t47(b).
+t48(a) :- t49(_X).
+t48(b).
+t49(a) :- t50(_X).
+t49(b).
+t50(a) :- t51(_X).
+t50(b).
+t51(a) :- t52(_X).
+t51(b).
+t52(a) :- t53(_X).
+t52(b).
+t53(a) :- t54(_X).
+t53(b).
+t54(a) :- t55(_X).
+t54(b).
+t55(a) :- t56(_X).
+t55(b).
+t56(a) :- t57(_X).
+t56(b).
+t57(a) :- t58(_X).
+t57(b).
+t58(a) :- t59(_X).
+t58(b).
+t59(a) :- t60(_X).
+t59(b).
+t60(a) :- t61(_X).
+t60(b).
+t61(a) :- t62(_X).
+t61(b).
+t62(a) :- t63(_X).
+t62(b).
+t63(a) :- t64(_X).
+t63(b).
+t64(a) :- t65(_X).
+t64(b).
+t65(a) :- t66(_X).
+t65(b).
+t66(a) :- t67(_X).
+t66(b).
+t67(a) :- t68(_X).
+t67(b).
+t68(a) :- t69(_X).
+t68(b).
+t69(a) :- t70(_X).
+t69(b).
+t70(a) :- t71(_X).
+t70(b).
+t71(a) :- t72(_X).
+t71(b).
+t72(a) :- t73(_X).
+t72(b).
+t73(a) :- t74(_X).
+t73(b).
+t74(a) :- t75(_X).
+t74(b).
+t75(a) :- t76(_X).
+t75(b).
+t76(a) :- t77(_X).
+t76(b).
+t77(a) :- t78(_X).
+t77(b).
+t78(a) :- t79(_X).
+t78(b).
+t79(a) :- t80(_X).
+t79(b).
+t80(a) :- t81(_X).
+t80(b).
+t81(a) :- t82(_X).
+t81(b).
+t82(a) :- t83(_X).
+t82(b).
+t83(a) :- t84(_X).
+t83(b).
+t84(a) :- t85(_X).
+t84(b).
+t85(a) :- t86(_X).
+t85(b).
+t86(a) :- t87(_X).
+t86(b).
+t87(a) :- t88(_X).
+t87(b).
+t88(a) :- t89(_X).
+t88(b).
+t89(a) :- t90(_X).
+t89(b).
+t90(a) :- t91(_X).
+t90(b).
+t91(a) :- t92(_X).
+t91(b).
+t92(a) :- t93(_X).
+t92(b).
+t93(a) :- t94(_X).
+t93(b).
+t94(a) :- t95(_X).
+t94(b).
+t95(a) :- t96(_X).
+t95(b).
+t96(a) :- t97(_X).
+t96(b).
+t97(a) :- t98(_X).
+t97(b).
+t98(a) :- t99(_X).
+t98(b).
+t99(a) :- t100(_X).
+t99(b).
+t100(a).
+t100(b).
+
+% 14. Unify terms that are small in space but textually large.
+
+bench_mark(medium_unify, 200000, equal(Term1, Term2), dummy(Term1, Term2)) :-
+ term64(Term1),
+ term64(Term2).
+bench_mark(deep_unify, 200000, equal(Term1, Term2), dummy(Term1, Term2)) :-
+ term4096(Term1),
+ term4096(Term2).
+
+:- public equal/2.
+
+equal(X, X).
+
+term64(X1) :-
+ X1 = f(X2, X2),
+ X2 = f(X4, X4),
+ X4 = f(X8, X8),
+ X8 = f(X16, X16),
+ X16 = f(X32, X32),
+ X32 = f(X64, X64).
+
+term4096(X1) :-
+ X1 = f(X2, X2),
+ X2 = f(X4, X4),
+ X4 = f(X8, X8),
+ X8 = f(X16, X16),
+ X16 = f(X32, X32),
+ X32 = f(X64, X64),
+ X64 = f(X128, X128),
+ X128 = f(X256, X256),
+ X256 = f(X512, X512),
+ X512 = f(X1024, X1024),
+ X1024 = f(X2048, X2048),
+ X2048 = f(X4096, X4096).
+
+% 15. Do 100 integer additions nonrecursively,
+% avoiding obvious compiler optimizations.
+
+bench_mark(integer_add, 200000, a1(0, 1, R), dummy(0, 1, R)).
+
+:- public a1/3.
+
+a1(M, K, P) :- N is M + K, a2(N, 2, P).
+a2(M, K, P) :- N is M + K, a3(N, 3, P).
+a3(M, K, P) :- N is M + K, a4(N, 4, P).
+a4(M, K, P) :- N is M + K, a5(N, 5, P).
+a5(M, K, P) :- N is M + K, a6(N, 6, P).
+a6(M, K, P) :- N is M + K, a7(N, 7, P).
+a7(M, K, P) :- N is M + K, a8(N, 8, P).
+a8(M, K, P) :- N is M + K, a9(N, 9, P).
+a9(M, K, P) :- N is M + K, a10(N, 10, P).
+a10(M, K, P) :- N is M + K, a11(N, 11, P).
+a11(M, K, P) :- N is M + K, a12(N, 12, P).
+a12(M, K, P) :- N is M + K, a13(N, 13, P).
+a13(M, K, P) :- N is M + K, a14(N, 14, P).
+a14(M, K, P) :- N is M + K, a15(N, 15, P).
+a15(M, K, P) :- N is M + K, a16(N, 16, P).
+a16(M, K, P) :- N is M + K, a17(N, 17, P).
+a17(M, K, P) :- N is M + K, a18(N, 18, P).
+a18(M, K, P) :- N is M + K, a19(N, 19, P).
+a19(M, K, P) :- N is M + K, a20(N, 20, P).
+a20(M, K, P) :- N is M + K, a21(N, 21, P).
+a21(M, K, P) :- N is M + K, a22(N, 22, P).
+a22(M, K, P) :- N is M + K, a23(N, 23, P).
+a23(M, K, P) :- N is M + K, a24(N, 24, P).
+a24(M, K, P) :- N is M + K, a25(N, 25, P).
+a25(M, K, P) :- N is M + K, a26(N, 26, P).
+a26(M, K, P) :- N is M + K, a27(N, 27, P).
+a27(M, K, P) :- N is M + K, a28(N, 28, P).
+a28(M, K, P) :- N is M + K, a29(N, 29, P).
+a29(M, K, P) :- N is M + K, a30(N, 30, P).
+a30(M, K, P) :- N is M + K, a31(N, 31, P).
+a31(M, K, P) :- N is M + K, a32(N, 32, P).
+a32(M, K, P) :- N is M + K, a33(N, 33, P).
+a33(M, K, P) :- N is M + K, a34(N, 34, P).
+a34(M, K, P) :- N is M + K, a35(N, 35, P).
+a35(M, K, P) :- N is M + K, a36(N, 36, P).
+a36(M, K, P) :- N is M + K, a37(N, 37, P).
+a37(M, K, P) :- N is M + K, a38(N, 38, P).
+a38(M, K, P) :- N is M + K, a39(N, 39, P).
+a39(M, K, P) :- N is M + K, a40(N, 40, P).
+a40(M, K, P) :- N is M + K, a41(N, 41, P).
+a41(M, K, P) :- N is M + K, a42(N, 42, P).
+a42(M, K, P) :- N is M + K, a43(N, 43, P).
+a43(M, K, P) :- N is M + K, a44(N, 44, P).
+a44(M, K, P) :- N is M + K, a45(N, 45, P).
+a45(M, K, P) :- N is M + K, a46(N, 46, P).
+a46(M, K, P) :- N is M + K, a47(N, 47, P).
+a47(M, K, P) :- N is M + K, a48(N, 48, P).
+a48(M, K, P) :- N is M + K, a49(N, 49, P).
+a49(M, K, P) :- N is M + K, a50(N, 50, P).
+a50(M, K, P) :- N is M + K, a51(N, 51, P).
+a51(M, K, P) :- N is M + K, a52(N, 52, P).
+a52(M, K, P) :- N is M + K, a53(N, 53, P).
+a53(M, K, P) :- N is M + K, a54(N, 54, P).
+a54(M, K, P) :- N is M + K, a55(N, 55, P).
+a55(M, K, P) :- N is M + K, a56(N, 56, P).
+a56(M, K, P) :- N is M + K, a57(N, 57, P).
+a57(M, K, P) :- N is M + K, a58(N, 58, P).
+a58(M, K, P) :- N is M + K, a59(N, 59, P).
+a59(M, K, P) :- N is M + K, a60(N, 60, P).
+a60(M, K, P) :- N is M + K, a61(N, 61, P).
+a61(M, K, P) :- N is M + K, a62(N, 62, P).
+a62(M, K, P) :- N is M + K, a63(N, 63, P).
+a63(M, K, P) :- N is M + K, a64(N, 64, P).
+a64(M, K, P) :- N is M + K, a65(N, 65, P).
+a65(M, K, P) :- N is M + K, a66(N, 66, P).
+a66(M, K, P) :- N is M + K, a67(N, 67, P).
+a67(M, K, P) :- N is M + K, a68(N, 68, P).
+a68(M, K, P) :- N is M + K, a69(N, 69, P).
+a69(M, K, P) :- N is M + K, a70(N, 70, P).
+a70(M, K, P) :- N is M + K, a71(N, 71, P).
+a71(M, K, P) :- N is M + K, a72(N, 72, P).
+a72(M, K, P) :- N is M + K, a73(N, 73, P).
+a73(M, K, P) :- N is M + K, a74(N, 74, P).
+a74(M, K, P) :- N is M + K, a75(N, 75, P).
+a75(M, K, P) :- N is M + K, a76(N, 76, P).
+a76(M, K, P) :- N is M + K, a77(N, 77, P).
+a77(M, K, P) :- N is M + K, a78(N, 78, P).
+a78(M, K, P) :- N is M + K, a79(N, 79, P).
+a79(M, K, P) :- N is M + K, a80(N, 80, P).
+a80(M, K, P) :- N is M + K, a81(N, 81, P).
+a81(M, K, P) :- N is M + K, a82(N, 82, P).
+a82(M, K, P) :- N is M + K, a83(N, 83, P).
+a83(M, K, P) :- N is M + K, a84(N, 84, P).
+a84(M, K, P) :- N is M + K, a85(N, 85, P).
+a85(M, K, P) :- N is M + K, a86(N, 86, P).
+a86(M, K, P) :- N is M + K, a87(N, 87, P).
+a87(M, K, P) :- N is M + K, a88(N, 88, P).
+a88(M, K, P) :- N is M + K, a89(N, 89, P).
+a89(M, K, P) :- N is M + K, a90(N, 90, P).
+a90(M, K, P) :- N is M + K, a91(N, 91, P).
+a91(M, K, P) :- N is M + K, a92(N, 92, P).
+a92(M, K, P) :- N is M + K, a93(N, 93, P).
+a93(M, K, P) :- N is M + K, a94(N, 94, P).
+a94(M, K, P) :- N is M + K, a95(N, 95, P).
+a95(M, K, P) :- N is M + K, a96(N, 96, P).
+a96(M, K, P) :- N is M + K, a97(N, 97, P).
+a97(M, K, P) :- N is M + K, a98(N, 98, P).
+a98(M, K, P) :- N is M + K, a99(N, 99, P).
+a99(M, K, P) :- N is M + K, a100(N, 100, P).
+a100(M, K, P) :- P is M + K.
+
+% 16. 100 floating additions
+
+bench_mark(floating_add, 200000, fa1(0.1, 1.1, R), dummy(0.1, 1.1, R)).
+
+:- public fa1/3.
+
+fa1(M, K, P) :- N is M + K, fa2(N, 2.1, P).
+fa2(M, K, P) :- N is M + K, fa3(N, 3.1, P).
+fa3(M, K, P) :- N is M + K, fa4(N, 4.1, P).
+fa4(M, K, P) :- N is M + K, fa5(N, 5.1, P).
+fa5(M, K, P) :- N is M + K, fa6(N, 6.1, P).
+fa6(M, K, P) :- N is M + K, fa7(N, 7.1, P).
+fa7(M, K, P) :- N is M + K, fa8(N, 8.1, P).
+fa8(M, K, P) :- N is M + K, fa9(N, 9.1, P).
+fa9(M, K, P) :- N is M + K, fa10(N, 10.1, P).
+fa10(M, K, P) :- N is M + K, fa11(N, 11.1, P).
+fa11(M, K, P) :- N is M + K, fa12(N, 12.1, P).
+fa12(M, K, P) :- N is M + K, fa13(N, 13.1, P).
+fa13(M, K, P) :- N is M + K, fa14(N, 14.1, P).
+fa14(M, K, P) :- N is M + K, fa15(N, 15.1, P).
+fa15(M, K, P) :- N is M + K, fa16(N, 16.1, P).
+fa16(M, K, P) :- N is M + K, fa17(N, 17.1, P).
+fa17(M, K, P) :- N is M + K, fa18(N, 18.1, P).
+fa18(M, K, P) :- N is M + K, fa19(N, 19.1, P).
+fa19(M, K, P) :- N is M + K, fa20(N, 20.1, P).
+fa20(M, K, P) :- N is M + K, fa21(N, 21.1, P).
+fa21(M, K, P) :- N is M + K, fa22(N, 22.1, P).
+fa22(M, K, P) :- N is M + K, fa23(N, 23.1, P).
+fa23(M, K, P) :- N is M + K, fa24(N, 24.1, P).
+fa24(M, K, P) :- N is M + K, fa25(N, 25.1, P).
+fa25(M, K, P) :- N is M + K, fa26(N, 26.1, P).
+fa26(M, K, P) :- N is M + K, fa27(N, 27.1, P).
+fa27(M, K, P) :- N is M + K, fa28(N, 28.1, P).
+fa28(M, K, P) :- N is M + K, fa29(N, 29.1, P).
+fa29(M, K, P) :- N is M + K, fa30(N, 30.1, P).
+fa30(M, K, P) :- N is M + K, fa31(N, 31.1, P).
+fa31(M, K, P) :- N is M + K, fa32(N, 32.1, P).
+fa32(M, K, P) :- N is M + K, fa33(N, 33.1, P).
+fa33(M, K, P) :- N is M + K, fa34(N, 34.1, P).
+fa34(M, K, P) :- N is M + K, fa35(N, 35.1, P).
+fa35(M, K, P) :- N is M + K, fa36(N, 36.1, P).
+fa36(M, K, P) :- N is M + K, fa37(N, 37.1, P).
+fa37(M, K, P) :- N is M + K, fa38(N, 38.1, P).
+fa38(M, K, P) :- N is M + K, fa39(N, 39.1, P).
+fa39(M, K, P) :- N is M + K, fa40(N, 40.1, P).
+fa40(M, K, P) :- N is M + K, fa41(N, 41.1, P).
+fa41(M, K, P) :- N is M + K, fa42(N, 42.1, P).
+fa42(M, K, P) :- N is M + K, fa43(N, 43.1, P).
+fa43(M, K, P) :- N is M + K, fa44(N, 44.1, P).
+fa44(M, K, P) :- N is M + K, fa45(N, 45.1, P).
+fa45(M, K, P) :- N is M + K, fa46(N, 46.1, P).
+fa46(M, K, P) :- N is M + K, fa47(N, 47.1, P).
+fa47(M, K, P) :- N is M + K, fa48(N, 48.1, P).
+fa48(M, K, P) :- N is M + K, fa49(N, 49.1, P).
+fa49(M, K, P) :- N is M + K, fa50(N, 50.1, P).
+fa50(M, K, P) :- N is M + K, fa51(N, 51.1, P).
+fa51(M, K, P) :- N is M + K, fa52(N, 52.1, P).
+fa52(M, K, P) :- N is M + K, fa53(N, 53.1, P).
+fa53(M, K, P) :- N is M + K, fa54(N, 54.1, P).
+fa54(M, K, P) :- N is M + K, fa55(N, 55.1, P).
+fa55(M, K, P) :- N is M + K, fa56(N, 56.1, P).
+fa56(M, K, P) :- N is M + K, fa57(N, 57.1, P).
+fa57(M, K, P) :- N is M + K, fa58(N, 58.1, P).
+fa58(M, K, P) :- N is M + K, fa59(N, 59.1, P).
+fa59(M, K, P) :- N is M + K, fa60(N, 60.1, P).
+fa60(M, K, P) :- N is M + K, fa61(N, 61.1, P).
+fa61(M, K, P) :- N is M + K, fa62(N, 62.1, P).
+fa62(M, K, P) :- N is M + K, fa63(N, 63.1, P).
+fa63(M, K, P) :- N is M + K, fa64(N, 64.1, P).
+fa64(M, K, P) :- N is M + K, fa65(N, 65.1, P).
+fa65(M, K, P) :- N is M + K, fa66(N, 66.1, P).
+fa66(M, K, P) :- N is M + K, fa67(N, 67.1, P).
+fa67(M, K, P) :- N is M + K, fa68(N, 68.1, P).
+fa68(M, K, P) :- N is M + K, fa69(N, 69.1, P).
+fa69(M, K, P) :- N is M + K, fa70(N, 70.1, P).
+fa70(M, K, P) :- N is M + K, fa71(N, 71.1, P).
+fa71(M, K, P) :- N is M + K, fa72(N, 72.1, P).
+fa72(M, K, P) :- N is M + K, fa73(N, 73.1, P).
+fa73(M, K, P) :- N is M + K, fa74(N, 74.1, P).
+fa74(M, K, P) :- N is M + K, fa75(N, 75.1, P).
+fa75(M, K, P) :- N is M + K, fa76(N, 76.1, P).
+fa76(M, K, P) :- N is M + K, fa77(N, 77.1, P).
+fa77(M, K, P) :- N is M + K, fa78(N, 78.1, P).
+fa78(M, K, P) :- N is M + K, fa79(N, 79.1, P).
+fa79(M, K, P) :- N is M + K, fa80(N, 80.1, P).
+fa80(M, K, P) :- N is M + K, fa81(N, 81.1, P).
+fa81(M, K, P) :- N is M + K, fa82(N, 82.1, P).
+fa82(M, K, P) :- N is M + K, fa83(N, 83.1, P).
+fa83(M, K, P) :- N is M + K, fa84(N, 84.1, P).
+fa84(M, K, P) :- N is M + K, fa85(N, 85.1, P).
+fa85(M, K, P) :- N is M + K, fa86(N, 86.1, P).
+fa86(M, K, P) :- N is M + K, fa87(N, 87.1, P).
+fa87(M, K, P) :- N is M + K, fa88(N, 88.1, P).
+fa88(M, K, P) :- N is M + K, fa89(N, 89.1, P).
+fa89(M, K, P) :- N is M + K, fa90(N, 90.1, P).
+fa90(M, K, P) :- N is M + K, fa91(N, 91.1, P).
+fa91(M, K, P) :- N is M + K, fa92(N, 92.1, P).
+fa92(M, K, P) :- N is M + K, fa93(N, 93.1, P).
+fa93(M, K, P) :- N is M + K, fa94(N, 94.1, P).
+fa94(M, K, P) :- N is M + K, fa95(N, 95.1, P).
+fa95(M, K, P) :- N is M + K, fa96(N, 96.1, P).
+fa96(M, K, P) :- N is M + K, fa97(N, 97.1, P).
+fa97(M, K, P) :- N is M + K, fa98(N, 98.1, P).
+fa98(M, K, P) :- N is M + K, fa99(N, 99.1, P).
+fa99(M, K, P) :- N is M + K, fa100(N, 100.1, P).
+fa100(M, K, P) :- P is M + K.
+
+% 17. 100 calls to arg at position N
+
+bench_mark(arg(N), 200000, arg1(N, Term, R), dummy(N, Term, R)) :-
+ args(N),
+ complex_nary_term(100, N, Term).
+
+:- public arg1/3.
+
+complex_nary_term(0, N, N) :- !.
+complex_nary_term(I, N, Term) :-
+ I > 0, J is I - 1,
+ complex_nary_term(J, N, SubTerm),
+ nary_term(N, SubTerm, Term).
+
+nary_term(N, SubTerm, Term) :-
+ functor(Term, f, N),
+ fill_nary_term(N, SubTerm, Term).
+
+fill_nary_term(0, _, _) :- !.
+fill_nary_term(N, SubTerm, Term) :-
+ N > 0, M is N - 1,
+ arg(N, Term, SubTerm),
+ fill_nary_term(M, SubTerm, Term).
+
+arg1(N, T, R) :- arg(N, T, X), arg2(N, X, R).
+arg2(N, T, R) :- arg(N, T, X), arg3(N, X, R).
+arg3(N, T, R) :- arg(N, T, X), arg4(N, X, R).
+arg4(N, T, R) :- arg(N, T, X), arg5(N, X, R).
+arg5(N, T, R) :- arg(N, T, X), arg6(N, X, R).
+arg6(N, T, R) :- arg(N, T, X), arg7(N, X, R).
+arg7(N, T, R) :- arg(N, T, X), arg8(N, X, R).
+arg8(N, T, R) :- arg(N, T, X), arg9(N, X, R).
+arg9(N, T, R) :- arg(N, T, X), arg10(N, X, R).
+arg10(N, T, R) :- arg(N, T, X), arg11(N, X, R).
+arg11(N, T, R) :- arg(N, T, X), arg12(N, X, R).
+arg12(N, T, R) :- arg(N, T, X), arg13(N, X, R).
+arg13(N, T, R) :- arg(N, T, X), arg14(N, X, R).
+arg14(N, T, R) :- arg(N, T, X), arg15(N, X, R).
+arg15(N, T, R) :- arg(N, T, X), arg16(N, X, R).
+arg16(N, T, R) :- arg(N, T, X), arg17(N, X, R).
+arg17(N, T, R) :- arg(N, T, X), arg18(N, X, R).
+arg18(N, T, R) :- arg(N, T, X), arg19(N, X, R).
+arg19(N, T, R) :- arg(N, T, X), arg20(N, X, R).
+arg20(N, T, R) :- arg(N, T, X), arg21(N, X, R).
+arg21(N, T, R) :- arg(N, T, X), arg22(N, X, R).
+arg22(N, T, R) :- arg(N, T, X), arg23(N, X, R).
+arg23(N, T, R) :- arg(N, T, X), arg24(N, X, R).
+arg24(N, T, R) :- arg(N, T, X), arg25(N, X, R).
+arg25(N, T, R) :- arg(N, T, X), arg26(N, X, R).
+arg26(N, T, R) :- arg(N, T, X), arg27(N, X, R).
+arg27(N, T, R) :- arg(N, T, X), arg28(N, X, R).
+arg28(N, T, R) :- arg(N, T, X), arg29(N, X, R).
+arg29(N, T, R) :- arg(N, T, X), arg30(N, X, R).
+arg30(N, T, R) :- arg(N, T, X), arg31(N, X, R).
+arg31(N, T, R) :- arg(N, T, X), arg32(N, X, R).
+arg32(N, T, R) :- arg(N, T, X), arg33(N, X, R).
+arg33(N, T, R) :- arg(N, T, X), arg34(N, X, R).
+arg34(N, T, R) :- arg(N, T, X), arg35(N, X, R).
+arg35(N, T, R) :- arg(N, T, X), arg36(N, X, R).
+arg36(N, T, R) :- arg(N, T, X), arg37(N, X, R).
+arg37(N, T, R) :- arg(N, T, X), arg38(N, X, R).
+arg38(N, T, R) :- arg(N, T, X), arg39(N, X, R).
+arg39(N, T, R) :- arg(N, T, X), arg40(N, X, R).
+arg40(N, T, R) :- arg(N, T, X), arg41(N, X, R).
+arg41(N, T, R) :- arg(N, T, X), arg42(N, X, R).
+arg42(N, T, R) :- arg(N, T, X), arg43(N, X, R).
+arg43(N, T, R) :- arg(N, T, X), arg44(N, X, R).
+arg44(N, T, R) :- arg(N, T, X), arg45(N, X, R).
+arg45(N, T, R) :- arg(N, T, X), arg46(N, X, R).
+arg46(N, T, R) :- arg(N, T, X), arg47(N, X, R).
+arg47(N, T, R) :- arg(N, T, X), arg48(N, X, R).
+arg48(N, T, R) :- arg(N, T, X), arg49(N, X, R).
+arg49(N, T, R) :- arg(N, T, X), arg50(N, X, R).
+arg50(N, T, R) :- arg(N, T, X), arg51(N, X, R).
+arg51(N, T, R) :- arg(N, T, X), arg52(N, X, R).
+arg52(N, T, R) :- arg(N, T, X), arg53(N, X, R).
+arg53(N, T, R) :- arg(N, T, X), arg54(N, X, R).
+arg54(N, T, R) :- arg(N, T, X), arg55(N, X, R).
+arg55(N, T, R) :- arg(N, T, X), arg56(N, X, R).
+arg56(N, T, R) :- arg(N, T, X), arg57(N, X, R).
+arg57(N, T, R) :- arg(N, T, X), arg58(N, X, R).
+arg58(N, T, R) :- arg(N, T, X), arg59(N, X, R).
+arg59(N, T, R) :- arg(N, T, X), arg60(N, X, R).
+arg60(N, T, R) :- arg(N, T, X), arg61(N, X, R).
+arg61(N, T, R) :- arg(N, T, X), arg62(N, X, R).
+arg62(N, T, R) :- arg(N, T, X), arg63(N, X, R).
+arg63(N, T, R) :- arg(N, T, X), arg64(N, X, R).
+arg64(N, T, R) :- arg(N, T, X), arg65(N, X, R).
+arg65(N, T, R) :- arg(N, T, X), arg66(N, X, R).
+arg66(N, T, R) :- arg(N, T, X), arg67(N, X, R).
+arg67(N, T, R) :- arg(N, T, X), arg68(N, X, R).
+arg68(N, T, R) :- arg(N, T, X), arg69(N, X, R).
+arg69(N, T, R) :- arg(N, T, X), arg70(N, X, R).
+arg70(N, T, R) :- arg(N, T, X), arg71(N, X, R).
+arg71(N, T, R) :- arg(N, T, X), arg72(N, X, R).
+arg72(N, T, R) :- arg(N, T, X), arg73(N, X, R).
+arg73(N, T, R) :- arg(N, T, X), arg74(N, X, R).
+arg74(N, T, R) :- arg(N, T, X), arg75(N, X, R).
+arg75(N, T, R) :- arg(N, T, X), arg76(N, X, R).
+arg76(N, T, R) :- arg(N, T, X), arg77(N, X, R).
+arg77(N, T, R) :- arg(N, T, X), arg78(N, X, R).
+arg78(N, T, R) :- arg(N, T, X), arg79(N, X, R).
+arg79(N, T, R) :- arg(N, T, X), arg80(N, X, R).
+arg80(N, T, R) :- arg(N, T, X), arg81(N, X, R).
+arg81(N, T, R) :- arg(N, T, X), arg82(N, X, R).
+arg82(N, T, R) :- arg(N, T, X), arg83(N, X, R).
+arg83(N, T, R) :- arg(N, T, X), arg84(N, X, R).
+arg84(N, T, R) :- arg(N, T, X), arg85(N, X, R).
+arg85(N, T, R) :- arg(N, T, X), arg86(N, X, R).
+arg86(N, T, R) :- arg(N, T, X), arg87(N, X, R).
+arg87(N, T, R) :- arg(N, T, X), arg88(N, X, R).
+arg88(N, T, R) :- arg(N, T, X), arg89(N, X, R).
+arg89(N, T, R) :- arg(N, T, X), arg90(N, X, R).
+arg90(N, T, R) :- arg(N, T, X), arg91(N, X, R).
+arg91(N, T, R) :- arg(N, T, X), arg92(N, X, R).
+arg92(N, T, R) :- arg(N, T, X), arg93(N, X, R).
+arg93(N, T, R) :- arg(N, T, X), arg94(N, X, R).
+arg94(N, T, R) :- arg(N, T, X), arg95(N, X, R).
+arg95(N, T, R) :- arg(N, T, X), arg96(N, X, R).
+arg96(N, T, R) :- arg(N, T, X), arg97(N, X, R).
+arg97(N, T, R) :- arg(N, T, X), arg98(N, X, R).
+arg98(N, T, R) :- arg(N, T, X), arg99(N, X, R).
+arg99(N, T, R) :- arg(N, T, X), arg100(N, X, R).
+arg100(N, T, R) :- arg(N, T, R).
+
+% 18. 100 indexed calls; some systems may require extra declarations to
+% put an index on the first argument.
+
+bench_mark(index, 200000, ix(1), dummy(1)).
+
+:- public ix/1.
+
+ix(1) :- ix(10000).
+ix(4).
+ix(9) :- ix(4).
+ix(16) :- ix(9).
+ix(25) :- ix(16).
+ix(36) :- ix(25).
+ix(49) :- ix(36).
+ix(64) :- ix(49).
+ix(81) :- ix(64).
+ix(100) :- ix(81).
+ix(121) :- ix(100).
+ix(144) :- ix(121).
+ix(169) :- ix(144).
+ix(196) :- ix(169).
+ix(225) :- ix(196).
+ix(256) :- ix(225).
+ix(289) :- ix(256).
+ix(324) :- ix(289).
+ix(361) :- ix(324).
+ix(400) :- ix(361).
+ix(441) :- ix(400).
+ix(484) :- ix(441).
+ix(529) :- ix(484).
+ix(576) :- ix(529).
+ix(625) :- ix(576).
+ix(676) :- ix(625).
+ix(729) :- ix(676).
+ix(784) :- ix(729).
+ix(841) :- ix(784).
+ix(900) :- ix(841).
+ix(961) :- ix(900).
+ix(1024) :- ix(961).
+ix(1089) :- ix(1024).
+ix(1156) :- ix(1089).
+ix(1225) :- ix(1156).
+ix(1296) :- ix(1225).
+ix(1369) :- ix(1296).
+ix(1444) :- ix(1369).
+ix(1521) :- ix(1444).
+ix(1600) :- ix(1521).
+ix(1681) :- ix(1600).
+ix(1764) :- ix(1681).
+ix(1849) :- ix(1764).
+ix(1936) :- ix(1849).
+ix(2025) :- ix(1936).
+ix(2116) :- ix(2025).
+ix(2209) :- ix(2116).
+ix(2304) :- ix(2209).
+ix(2401) :- ix(2304).
+ix(2500) :- ix(2401).
+ix(2601) :- ix(2500).
+ix(2704) :- ix(2601).
+ix(2809) :- ix(2704).
+ix(2916) :- ix(2809).
+ix(3025) :- ix(2916).
+ix(3136) :- ix(3025).
+ix(3249) :- ix(3136).
+ix(3364) :- ix(3249).
+ix(3481) :- ix(3364).
+ix(3600) :- ix(3481).
+ix(3721) :- ix(3600).
+ix(3844) :- ix(3721).
+ix(3969) :- ix(3844).
+ix(4096) :- ix(3969).
+ix(4225) :- ix(4096).
+ix(4356) :- ix(4225).
+ix(4489) :- ix(4356).
+ix(4624) :- ix(4489).
+ix(4761) :- ix(4624).
+ix(4900) :- ix(4761).
+ix(5041) :- ix(4900).
+ix(5184) :- ix(5041).
+ix(5329) :- ix(5184).
+ix(5476) :- ix(5329).
+ix(5625) :- ix(5476).
+ix(5776) :- ix(5625).
+ix(5929) :- ix(5776).
+ix(6084) :- ix(5929).
+ix(6241) :- ix(6084).
+ix(6400) :- ix(6241).
+ix(6561) :- ix(6400).
+ix(6724) :- ix(6561).
+ix(6889) :- ix(6724).
+ix(7056) :- ix(6889).
+ix(7225) :- ix(7056).
+ix(7396) :- ix(7225).
+ix(7569) :- ix(7396).
+ix(7744) :- ix(7569).
+ix(7921) :- ix(7744).
+ix(8100) :- ix(7921).
+ix(8281) :- ix(8100).
+ix(8464) :- ix(8281).
+ix(8649) :- ix(8464).
+ix(8836) :- ix(8649).
+ix(9025) :- ix(8836).
+ix(9216) :- ix(9025).
+ix(9409) :- ix(9216).
+ix(9604) :- ix(9409).
+ix(9801) :- ix(9604).
+ix(10000) :- ix(9801).
+
+% 19. Make 1000 asserts of unit clauses
+bench_mark(assert_unit, 100, assert_clauses(L), dummy(L)) :-
+ %abolish(ua,3),
+ abolish(ua/3),
+ create_units(1, 1000, L).
+
+:- public assert_clauses/1.
+
+create_units(I, N, []) :- I > N, !.
+create_units(I, N, [ua(K, X, f(K, X))|Rest]) :-
+ K is I * (1 + I//100),
+ J is I + 1,
+ create_units(J, N, Rest).
+
+assert_clauses([]).
+assert_clauses([Clause|Rest]) :-
+ assert(Clause),
+ assert_clauses(Rest).
+
+% 20. Access 100 dynamically-created clauses with 1st arg. instantiated
+
+bench_mark(access_unit, 5000, access_dix(1, 1), dummy(1, 1)) :-
+ %abolish(dix, 2),
+ abolish(dix/2),
+ dix_clauses(1, 100, L),
+ assert_clauses(L).
+
+:- public access_dix/2.
+
+dix_clauses(I, N, []) :- I > N, !.
+dix_clauses(I, N, [dix(P, Q) | L]) :-
+ I =< N,
+ P is I*I,
+ R is 1 + (I+N-2) mod N,
+ Q is R*R,
+ J is I + 1,
+ dix_clauses(J, N, L).
+
+access_dix(Start, End) :-
+ dix(Start, Where),
+ ( Where = End -> true | access_dix(Where, End) ).
+
+% 21. Access 100 dynamic unit clauses (2nd argument instantiated)
+
+:- public access_back/2.
+
+bench_mark(slow_access_unit, 1000, access_back(1, 1), dummy(1, 1)) :-
+ %abolish(dix, 2),
+ abolish(dix/2),
+ dix_clauses(1, 100, L),
+ assert_clauses(L).
+
+access_back(Start, End) :-
+ dix(Where, Start),
+ ( Where = End -> true | access_back(Where, End) ).
+
+% 22. Setof and bagof
+
+bench_mark(setof, 10000, setof(X, Y^pr(X, Y), S), dummy(X, Y^pr(X, Y), S)).
+bench_mark(pair_setof, 10000,
+ setof((X,Y), pr(X, Y), S),
+ dummy((X,Y), pr(X, Y), S)).
+bench_mark(double_setof, 10000, setof((X,S), setof(Y, pr(X, Y), S), T),
+ dummy(S, setof(Y, pr(X, Y), S), T)).
+bench_mark(bagof, 10000, bagof(X, Y^pr(X, Y), S), dummy(X, Y^pr(X, Y), S)).
+
+pr(99, 1).
+pr(98, 2).
+pr(97, 3).
+pr(96, 4).
+pr(95, 5).
+pr(94, 6).
+pr(93, 7).
+pr(92, 8).
+pr(91, 9).
+pr(90, 10).
+pr(89, 11).
+pr(88, 12).
+pr(87, 13).
+pr(86, 14).
+pr(85, 15).
+pr(84, 16).
+pr(83, 17).
+pr(82, 18).
+pr(81, 19).
+pr(80, 20).
+pr(79, 21).
+pr(78, 22).
+pr(77, 23).
+pr(76, 24).
+pr(75, 25).
+pr(74, 26).
+pr(73, 27).
+pr(72, 28).
+pr(71, 29).
+pr(70, 30).
+pr(69, 31).
+pr(68, 32).
+pr(67, 33).
+pr(66, 34).
+pr(65, 35).
+pr(64, 36).
+pr(63, 37).
+pr(62, 38).
+pr(61, 39).
+pr(60, 40).
+pr(59, 41).
+pr(58, 42).
+pr(57, 43).
+pr(56, 44).
+pr(55, 45).
+pr(54, 46).
+pr(53, 47).
+pr(52, 48).
+pr(51, 49).
+pr(50, 50).
+pr(49, 51).
+pr(48, 52).
+pr(47, 53).
+pr(46, 54).
+pr(45, 55).
+pr(44, 56).
+pr(43, 57).
+pr(42, 58).
+pr(41, 59).
+pr(40, 60).
+pr(39, 61).
+pr(38, 62).
+pr(37, 63).
+pr(36, 64).
+pr(35, 65).
+pr(34, 66).
+pr(33, 67).
+pr(32, 68).
+pr(31, 69).
+pr(30, 70).
+pr(29, 71).
+pr(28, 72).
+pr(27, 73).
+pr(26, 74).
+pr(25, 75).
+pr(24, 76).
+pr(23, 77).
+pr(22, 78).
+pr(21, 79).
+pr(20, 80).
+pr(19, 81).
+pr(18, 82).
+pr(17, 83).
+pr(16, 84).
+pr(15, 85).
+pr(14, 86).
+pr(13, 87).
+pr(12, 88).
+pr(11, 89).
+pr(10, 90).
+pr(9, 91).
+pr(8, 92).
+pr(7, 93).
+pr(6, 94).
+pr(5, 95).
+pr(4, 96).
+pr(3, 97).
+pr(2, 98).
+pr(1, 99).
+pr(0, 100).
diff --git a/examples/benchmarks/portland/Makefile b/examples/benchmarks/portland/Makefile
new file mode 100644
index 0000000..1d9ec92
--- /dev/null
+++ b/examples/benchmarks/portland/Makefile
@@ -0,0 +1,97 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS = -J '-Xmx100m'
+PLJAR = pljar
+PLJAROPTS = -v -J '-Xmx100m' -C '-J-Xmx100m'
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar:bench_util.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+# /bin/echo "[$*], qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/portland/bench_util.pl b/examples/benchmarks/portland/bench_util.pl
new file mode 100644
index 0000000..a490962
--- /dev/null
+++ b/examples/benchmarks/portland/bench_util.pl
@@ -0,0 +1,47 @@
+% File : bench_util.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 24 February 2008
+% Purpose: Benchmark utilities
+% Note : based on driver.pl in Pereira's benchmark
+
+'$get_cpu_time'(T) :- statistics(runtime, [T,_]).
+
+'$report'(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ '$report_csv'(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+'$report_csv'([], _) :- !.
+'$report_csv'([X], _) :- !, write(X), nl.
+'$report_csv'([X|Xs], Delim) :- write(X), write(Delim), '$report_csv'(Xs, Delim).
+
+'$benchmark'(Name, Iterations, Action, Control) :-
+ '$get_cpu_time'(T0),
+ ( '$repeat'(Iterations), once(Action), fail
+ ; '$get_cpu_time'(T1)
+ ),
+ ( '$repeat'(Iterations), once(Control), fail
+ ; '$get_cpu_time'(T2)
+ ),
+ '$report'(Name, Iterations, T0, T1, T2).
+
+'$repeat'(N) :- N > 0, '$from'(1, N).
+
+'$from'(I, I) :- !.
+'$from'(L, U) :- M is (L+U)>>1, '$from'(L, M).
+'$from'(L, U) :- M is (L+U)>>1+1, '$from'(M, U).
+
+'$dummy'.
+'$dummy'(_).
+'$dummy'(_, _).
+'$dummy'(_, _, _).
diff --git a/examples/benchmarks/portland/bintree.in b/examples/benchmarks/portland/bintree.in
new file mode 100644
index 0000000..19cf2dc
--- /dev/null
+++ b/examples/benchmarks/portland/bintree.in
@@ -0,0 +1 @@
+:- P = 100, make_list(P, L), '$benchmark'(bintree(P), 1000, make_tree(_,L), '$dummy'(_,L)).
diff --git a/examples/benchmarks/portland/bintree.pl b/examples/benchmarks/portland/bintree.pl
new file mode 100644
index 0000000..1631f76
--- /dev/null
+++ b/examples/benchmarks/portland/bintree.pl
@@ -0,0 +1,46 @@
+:- dynamic seed/1.
+
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+bintree(N,T) :-
+ make_list(N,L),
+ make_tree(T,L).
+
+make_tree(T,[H|L]) :-
+ create_node(T,H),
+ build_tree(T,L), !.
+
+create_node(N,V) :-
+ N =.. [node,V,_,_].
+
+build_tree(_,[]) :- !.
+
+build_tree(T,[H|L]) :-
+ insert(T,H),
+ build_tree(T,L).
+
+insert(node(C,L,R),V) :-
+ V<C, var(L), create_node(L,V).
+
+insert(node(C,L,R),V) :-
+ V<C, nonvar(L), insert(L,V).
+
+insert(node(C,L,R),V) :-
+ V>=C, var(R), create_node(R,V).
+
+insert(node(C,L,R),V) :-
+ V>=C, nonvar(R), insert(R,V).
+make_list(0,[]) :- !.
+
+make_list(N,[X|L]) :-
+ rnd(100,X),
+ N1 is N-1,
+ make_list(N1,L).
+
+seed(13).
+
+rnd(R,N) :-
+ retract(seed(S)), N is (S mod R) + 1,
+ Newseed is (125*S+1) mod 4096,
+ asserta(seed(Newseed)), !.
diff --git a/examples/benchmarks/portland/cd.in b/examples/benchmarks/portland/cd.in
new file mode 100644
index 0000000..c861046
--- /dev/null
+++ b/examples/benchmarks/portland/cd.in
@@ -0,0 +1 @@
+:- P = 10000, '$benchmark'(cd(P), 1000, cd(P, 0), '$dummy'(P,0)).
diff --git a/examples/benchmarks/portland/cd.pl b/examples/benchmarks/portland/cd.pl
new file mode 100644
index 0000000..880eda3
--- /dev/null
+++ b/examples/benchmarks/portland/cd.pl
@@ -0,0 +1,11 @@
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+/* cd(Up,Down) counts down from Up to Down */
+
+cd(X, X).
+
+cd(Up, Down) :-
+ X is Up-1,
+ cd(X,Down).
+
diff --git a/examples/benchmarks/portland/genlist.in b/examples/benchmarks/portland/genlist.in
new file mode 100644
index 0000000..642cff1
--- /dev/null
+++ b/examples/benchmarks/portland/genlist.in
@@ -0,0 +1 @@
+:- P = 300, '$benchmark'(make_list(P), 1000, make_list(P,_), '$dummy'(P,_)).
diff --git a/examples/benchmarks/portland/genlist.pl b/examples/benchmarks/portland/genlist.pl
new file mode 100644
index 0000000..3a5a91d
--- /dev/null
+++ b/examples/benchmarks/portland/genlist.pl
@@ -0,0 +1,18 @@
+:- dynamic seed/1.
+
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+make_list(0,[]) :- !.
+
+make_list(N,[X|L]) :-
+ rnd(100,X),
+ N1 is N-1,
+ make_list(N1,L).
+
+seed(13).
+
+rnd(R,N) :-
+ retract(seed(S)), N is (S mod R) + 1,
+ Newseed is (125*S+1) mod 4096,
+ asserta(seed(Newseed)), !.
diff --git a/examples/benchmarks/portland/hanoi.in b/examples/benchmarks/portland/hanoi.in
new file mode 100644
index 0000000..8c24001
--- /dev/null
+++ b/examples/benchmarks/portland/hanoi.in
@@ -0,0 +1 @@
+:- P = 20, '$benchmark'(hanoi(P), 10, hanoi(P), '$dummy'(P)).
diff --git a/examples/benchmarks/portland/hanoi.pl b/examples/benchmarks/portland/hanoi.pl
new file mode 100644
index 0000000..f3e8c71
--- /dev/null
+++ b/examples/benchmarks/portland/hanoi.pl
@@ -0,0 +1,8 @@
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+hanoi(N) :- move(N,left,center,right).
+move(0,_,_,_) :- !.
+move(N,A,B,C) :- M is N-1, move(M,A,C,B), move(M,C,B,A).
+
+
diff --git a/examples/benchmarks/portland/loop.in b/examples/benchmarks/portland/loop.in
new file mode 100644
index 0000000..ece86f2
--- /dev/null
+++ b/examples/benchmarks/portland/loop.in
@@ -0,0 +1 @@
+:- P = 20000, '$benchmark'(loop(P), 1000, loop(P), '$dummy'(P)).
diff --git a/examples/benchmarks/portland/loop.pl b/examples/benchmarks/portland/loop.pl
new file mode 100644
index 0000000..bff17bf
--- /dev/null
+++ b/examples/benchmarks/portland/loop.pl
@@ -0,0 +1,18 @@
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+:- dynamic n/1.
+
+/*********************************************************/
+/* Prolog fragment that demonstrates how much time is */
+/* consumed in the loop housekeeping alone that is */
+/* being used in some of the benchmarks. */
+/*************************************************RLA*****/
+
+loop(Max) :-
+ asserta(n(0)),
+ repeat,
+ retract(n(N)),
+ N1 is N+1,
+ asserta(n(N1)),
+ N1>=Max, !.
diff --git a/examples/benchmarks/portland/memfill.in b/examples/benchmarks/portland/memfill.in
new file mode 100644
index 0000000..0f51424
--- /dev/null
+++ b/examples/benchmarks/portland/memfill.in
@@ -0,0 +1 @@
+:- P = 1000, '$benchmark'(memfill(P), 100, memfill(P), '$dummy'(P)).
diff --git a/examples/benchmarks/portland/memfill.pl b/examples/benchmarks/portland/memfill.pl
new file mode 100644
index 0000000..658d10c
--- /dev/null
+++ b/examples/benchmarks/portland/memfill.pl
@@ -0,0 +1,17 @@
+:- dynamic n/1.
+:- dynamic the_memory_filler_statement/1.
+
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+memfill(Limit) :-
+ abolish(the_memory_filler_statement/1),
+ abolish(n/1),
+ assert(n(0)),
+ repeat,
+ retract(n(N)),
+ assert(the_memory_filler_statement(N)),
+ N1 is N+1,
+ assert(n(N1)),
+ N1=Limit.
+
diff --git a/examples/benchmarks/portland/nairev.in b/examples/benchmarks/portland/nairev.in
new file mode 100644
index 0000000..c16239b
--- /dev/null
+++ b/examples/benchmarks/portland/nairev.in
@@ -0,0 +1 @@
+:- P = 2000, mk_list(P, L), '$benchmark'(nairev(P), 10, rev(L,_), '$dummy'(L,_)).
diff --git a/examples/benchmarks/portland/nairev.pl b/examples/benchmarks/portland/nairev.pl
new file mode 100644
index 0000000..e993f00
--- /dev/null
+++ b/examples/benchmarks/portland/nairev.pl
@@ -0,0 +1,14 @@
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+mk_list(0,[]).
+mk_list(N,[N|L]) :-
+ N1 is N-1, mk_list(N1,L).
+
+rev([],[]).
+rev([X|L],Rlx) :-
+ rev(L,Rl), app(Rl,[X],Rlx).
+
+app([],L,L).
+app([X|L1],L2,[X|L3]) :-
+ app(L1,L2,L3).
diff --git a/examples/benchmarks/portland/polyeval.in b/examples/benchmarks/portland/polyeval.in
new file mode 100644
index 0000000..2196a78
--- /dev/null
+++ b/examples/benchmarks/portland/polyeval.in
@@ -0,0 +1 @@
+:- P = 51, '$benchmark'(polybench(P), 1000, polybench(P,_), '$dummy'(P,_)).
diff --git a/examples/benchmarks/portland/polyeval.pl b/examples/benchmarks/portland/polyeval.pl
new file mode 100644
index 0000000..515cd10
--- /dev/null
+++ b/examples/benchmarks/portland/polyeval.pl
@@ -0,0 +1,19 @@
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+gen_list(0,[]).
+gen_list(N,[[N,N]|L]) :- N1 is N-1, gen_list(N1,L).
+expand_term(0,Xvalue, Tvalue) :- Tvalue is Xvalue.
+expand_term(Power,Xvalue, Tvalue) :- TempValue is 2*Xvalue,
+ Power1 is Power - 1,
+ expand_term(Power1 ,TempValue, Tvalue).
+
+eval_term([Coef,Power],Value,Xvalue) :- expand_term(Power,Xvalue, Tvalue),
+ Value is Coef*Tvalue .
+
+eval_poly([],Answer, Svalue) :- Answer is Svalue .
+eval_poly([Term|Rest],Answer, Svalue) :- eval_term(Term,Value,1),
+ Ans is Svalue + Value,
+ eval_poly(Rest,Answer,Ans).
+polybench(N,Answer) :- gen_list(N,Poly),!,
+ eval_poly(Poly,Answer, 0 ).
diff --git a/examples/benchmarks/portland/primes.in b/examples/benchmarks/portland/primes.in
new file mode 100644
index 0000000..753d8cb
--- /dev/null
+++ b/examples/benchmarks/portland/primes.in
@@ -0,0 +1 @@
+:- P = 1000, '$benchmark'(primes(P), 1000, primes(P,_), '$dummy'(P,_)).
diff --git a/examples/benchmarks/portland/primes.pl b/examples/benchmarks/portland/primes.pl
new file mode 100644
index 0000000..0e0ccad
--- /dev/null
+++ b/examples/benchmarks/portland/primes.pl
@@ -0,0 +1,38 @@
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+
+/* The sieve of Erastosthenes. */
+/* */
+/* Benchmark prolog program which requires the upper limit as a */
+/* parameter, and will find all prime numbers between 1 and upper */
+/* bound. Execution time is given in milliseconds. */
+/* */
+
+primes(Limit, Prime_nums) :-
+ integer_list(2,Limit,Ints),
+ sift(Ints,Prime_nums).
+
+integer_list(Low,High,[Low|Rest]) :-
+ Low =< High, !,
+ M is Low + 1,
+ integer_list(M,High,Rest).
+
+integer_list(_,_,[]).
+
+sift([],[]).
+
+sift([Int|Ints],[Int|Primes]) :-
+ remove(Int,Ints,New),
+ sift(New,Primes).
+
+remove(Prime,[],[]).
+
+remove(Prime,[Int|Ints],[Int|New_ints]) :-
+ \+(0 is Int mod Prime), !,
+ remove(Prime,Ints,New_ints).
+
+remove(Prime,[Int|Ints],New_ints) :-
+ 0 is Int mod Prime, !,
+ remove(Prime,Ints,New_ints).
+
diff --git a/examples/benchmarks/portland/snairev.in b/examples/benchmarks/portland/snairev.in
new file mode 100644
index 0000000..5b0e515
--- /dev/null
+++ b/examples/benchmarks/portland/snairev.in
@@ -0,0 +1 @@
+:- P = 2000, mk_list(P, L), '$benchmark'(snairev(P), 10, rev(L,_), '$dummy'(L,_)).
diff --git a/examples/benchmarks/portland/snairev.pl b/examples/benchmarks/portland/snairev.pl
new file mode 100644
index 0000000..3809b7b
--- /dev/null
+++ b/examples/benchmarks/portland/snairev.pl
@@ -0,0 +1,14 @@
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+mk_list(0,nil).
+mk_list(N,cons(N,L)) :-
+ N1 is N-1, mk_list(N1,L).
+
+rev(nil,nil).
+rev(cons(X,L),Rlx) :-
+ rev(L,Rl), app(Rl,cons(X,nil),Rlx).
+
+app(nil,L,L).
+app(cons(X,L1),L2,cons(X,L3)) :-
+ app(L1,L2,L3).
diff --git a/examples/benchmarks/portland/sort.in b/examples/benchmarks/portland/sort.in
new file mode 100644
index 0000000..18ba37d
--- /dev/null
+++ b/examples/benchmarks/portland/sort.in
@@ -0,0 +1 @@
+:- P = 1000, '$benchmark'(qsort(P), 100, qsort(P), '$dummy'(P)).
diff --git a/examples/benchmarks/portland/sort.pl b/examples/benchmarks/portland/sort.pl
new file mode 100644
index 0000000..683d1bc
--- /dev/null
+++ b/examples/benchmarks/portland/sort.pl
@@ -0,0 +1,36 @@
+:- dynamic seed/1.
+
+/* VAX C-Prolog Benchmark Package */
+/* Copyright 1985 by Tektronix, Inc., and Portland State University */
+
+qsort(N) :-
+ generate(0,N,L), !,
+ quicksort(L,S).
+
+generate(I,N,[]) :- I = N.
+generate(I,N,L) :-
+ J is I+1,
+ random(1001,X),
+ generate(J,N,L1),
+ append([X],L1,L).
+
+append([],L,L).
+append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
+
+seed(1301).
+
+random(R,N) :- retract(seed(S)),
+ N is (S mod R)+1,
+ NewSeed is (125*S+1) mod 4096,
+ asserta(seed(NewSeed)), !.
+
+quicksort([],[]).
+quicksort([H|T],S) :- split(H,T,A,B),
+ quicksort(A,A1),
+ quicksort(B,B1),
+ append(A1,[H|B1],S).
+
+split(H,[A|X],[A|Y],Z) :- A > H, split(H,X,Y,Z).
+split(H,[A|X],Y,[A|Z]) :- A < H, split(H,X,Y,Z).
+split(_,[],[],[]).
+
diff --git a/examples/benchmarks/quintus/Makefile b/examples/benchmarks/quintus/Makefile
new file mode 100644
index 0000000..3baa1b2
--- /dev/null
+++ b/examples/benchmarks/quintus/Makefile
@@ -0,0 +1,95 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS = -J '-Xmx100m'
+PLJAR = pljar
+PLJAROPTS = -v -J '-Xmx100m' -C '-J-Xmx300m'
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/quintus/bench.in b/examples/benchmarks/quintus/bench.in
new file mode 100644
index 0000000..fd6ac97
--- /dev/null
+++ b/examples/benchmarks/quintus/bench.in
@@ -0,0 +1 @@
+:- lots.
diff --git a/examples/benchmarks/quintus/bench.pl b/examples/benchmarks/quintus/bench.pl
new file mode 100644
index 0000000..a725fb2
--- /dev/null
+++ b/examples/benchmarks/quintus/bench.pl
@@ -0,0 +1,199 @@
+%%% BENCH.PL : The classic Prolog benchmark
+%%% Supplied by Quintus Computer Systems, Inc.
+%%% April 30th 1984
+
+/* ======================================================================
+ This benchmark gives the raw speed of a Prolog system.
+
+ The measure of logical inferences per second (Lips) used here is taken to
+ be procedure calls per second over an example with not very complex
+ procedure calls. The example used is that of "naive reversing" a list,
+ which is an expensive, and therefore stupid, way of reversing a list. It
+ does, however, produce a lot of procedure calls. (In theoretical terms,
+ this algorithm is O(n^2) on the length of the list).
+
+ The use of a single simple benchmark like this cannot, of course, be
+ taken to signify a great deal. However, experience has shown that this
+ benchmark does provide a very good measure of basic Prolog speed and
+ produces figures which match more complex benchmarks. The reason for
+ this is that the basic operations performed here: procedure calls with a
+ certain amount of data structure access and construction; are absolutely
+ fundamental to Prolog execution. If these are done right, then more
+ complex benchmarks tend to scale accordingly. This particular benchmark
+ has thus been used as a good rule of thumb by Prolog implementors for
+ over a decade and forms a part of the unwritten Prolog folklore. So -
+ use this benchmark, with this in mind, as a quick, but extremely useful,
+ test of Prolog performance.
+
+ In a complete evaluation of a Prolog system you should also be taking
+ account speeds of asserting and compiling, tail recursion, memory
+ utilisation, compactness of programs, storage management and garbage
+ collection, debugging and editing facilities, program checking and help
+ facilities, system provided predicates, interfaces to external
+ capabilities, documentation and support, amongst other factors.
+
+ ====================================================================== */
+
+
+/* ----------------------------------------------------------------------
+ get_cpu_time(T) -- T is the current cpu time.
+
+ ** This bit will probably require changes to work on your Prolog
+ system, since different systems provide this facility in
+ different ways. See your Prolog manual for details.
+ ** Also check the code for calculate_lips/4 below.
+ ---------------------------------------------------------------------- */
+
+get_cpu_time(T) :- statistics(runtime,[T,_]). /* Quintus Prolog version */
+
+/* get_cpu_time(T) :- T is cputime. C-Prolog version */
+
+
+/* ----------------------------------------------------------------------
+ nrev(L1,L2) -- L2 is the list L1 reversed.
+ append(L1,L2,L3) -- L1 appended to L2 is L3.
+ data(L) -- L is a thirty element list.
+
+ This is the program executed by the benchmark.
+ It is called "naive reverse" because it is a very expensive way
+ of reversing a list. Its advantage, for our purposes, is that
+ it generates a lot of procedure calls. To reverse a thirty element
+ list requires 496 Prolog procedure calls.
+ ---------------------------------------------------------------------- */
+
+nrev([],[]).
+nrev([X|Rest],Ans) :- nrev(Rest,L), concatenate(L,[X],Ans).
+
+concatenate([],L,L).
+concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3).
+
+
+data([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
+ 21,22,23,24,25,26,27,28,29,30]).
+
+
+/* ----------------------------------------------------------------------
+ lots -- Run benchmark with a variety of iteration counts.
+
+ Call this to run the benchmark with increasing numbers
+ of iterations. The figures produced should be about the same -
+ except that there may be inaccuracies at low iteration numbers
+ if the time these examples take to execute on your machine are
+ too small to be very precise (because of the accuracy the
+ operating system itself is capable of providing).
+ If the time taken for these examples is too long or short then
+ you should adjust the eg_count(_) facts.
+ ---------------------------------------------------------------------- */
+
+lots :-
+ eg_count(Count),
+ bench(Count),
+ fail.
+lots.
+
+eg_count(10).
+eg_count(20).
+eg_count(50).
+eg_count(100).
+eg_count(200).
+eg_count(500).
+eg_count(1000).
+eg_count(2000).
+eg_count(5000).
+eg_count(10000).
+
+
+/* ----------------------------------------------------------------------
+ bench(Count) -- Run the benchmark for Count iterations.
+
+ bench provides a test harness for running the naive reverse
+ benchmark. It is important to factor out the overhead of setting
+ the test up and using repeat(_) to iterate the right number of
+ times. This is done by running some dummy code as well to see how
+ much time the extra operations take.
+ ---------------------------------------------------------------------- */
+
+bench(Count) :-
+ get_cpu_time(T0),
+ dodummy(Count),
+ get_cpu_time(T1),
+ dobench(Count),
+ get_cpu_time(T2),
+ report(Count,T0,T1,T2).
+
+
+/* ----------------------------------------------------------------------
+ dobench(Count) -- nrev a 30 element list Count times.
+ dodummy(Count) -- Perform the overhead operations Count times.
+ repeat(Count) -- Predicate which succeeds Count times
+
+ This is the supporting code, which is reasonably clear.
+ ---------------------------------------------------------------------- */
+
+dobench(Count) :-
+ data(List),
+ repeat(Count),
+ nrev(List,_),
+ fail.
+dobench(_).
+
+
+dodummy(Count) :-
+ data(List),
+ repeat(Count),
+ dummy(List,_),
+ fail.
+dodummy(_).
+
+dummy(_,_).
+
+repeat(_N).
+repeat(N) :- N > 1, N1 is N-1, repeat(N1).
+
+
+/* ----------------------------------------------------------------------
+ report(Count,T0,T1,T2) -- Report the results of the benchmark.
+ calculate_lips(Count,Time,Lips,Units) --
+ Doing Count interations in Time implies Lips lips assuming
+ that time is given in Units.
+
+ This calculates the logical inferences per second (lips) figure.
+ Remember that it takes 496 procedure calls to naive reverse a
+ thirty element list once. Lips, under this benchmark, thus means
+ "Prolog procedure calls per second, where the procedure calls
+ are not too complex (i.e. those for nrev and append)".
+
+ ** This version of the code assumes that the times (T0.. etc)
+ are integers giving the time in milliseconds. This is true for
+ Quintus Prolog. Your Prolog system may use some other
+ representation. If so, you will need to adjust the Lips
+ calculation. There is a C-Prolog version below for the case
+ where times are floating point numbers giving the time in
+ seconds.
+ ---------------------------------------------------------------------- */
+
+report(Count,T0,T1,T2) :-
+ Time1 is T1-T0,
+ Time2 is T2-T1,
+ Time is Time2-Time1, /* Time spent on nreving lists */
+ calculate_lips(Count,Time,Lips,Units),
+ nl,
+ write(Lips), write(' lips for '), write(Count),
+ write(' iterations taking '), write(Time),
+ write(' '), write(Units), write(' ('),
+ write(Time2-Time1), write(')'),
+ nl.
+
+
+
+calculate_lips(_Count,Time,Lips,'msecs') :- /* Time can be 0 for small */
+ Time is 0, !, Lips is 0. /* values of Count! */
+calculate_lips(Count,Time,Lips,'msecs') :-
+ Lips is (496*float(Count)*1000)/Time.
+
+/* --- C-Prolog version
+
+calculate_lips(Count,Time,Lips,'secs') :- Lips is (496*Count)/Time.
+
+ --- */
+
diff --git a/examples/benchmarks/src/bench.pl b/examples/benchmarks/src/bench.pl
new file mode 100644
index 0000000..fbe5ac1
--- /dev/null
+++ b/examples/benchmarks/src/bench.pl
@@ -0,0 +1,201 @@
+/* BENCH.PL : The classic Prolog benchmark
+
+ Supplied by Quintus Computer Systems, Inc.
+ April 30th 1984
+*/
+
+/* ======================================================================
+ This benchmark gives the raw speed of a Prolog system.
+
+ The measure of logical inferences per second (Lips) used here is taken to
+ be procedure calls per second over an example with not very complex
+ procedure calls. The example used is that of "naive reversing" a list,
+ which is an expensive, and therefore stupid, way of reversing a list. It
+ does, however, produce a lot of procedure calls. (In theoretical terms,
+ this algorithm is O(n^2) on the length of the list).
+
+ The use of a single simple benchmark like this cannot, of course, be
+ taken to signify a great deal. However, experience has shown that this
+ benchmark does provide a very good measure of basic Prolog speed and
+ produces figures which match more complex benchmarks. The reason for
+ this is that the basic operations performed here: procedure calls with a
+ certain amount of data structure access and construction; are absolutely
+ fundamental to Prolog execution. If these are done right, then more
+ complex benchmarks tend to scale accordingly. This particular benchmark
+ has thus been used as a good rule of thumb by Prolog implementors for
+ over a decade and forms a part of the unwritten Prolog folklore. So -
+ use this benchmark, with this in mind, as a quick, but extremely useful,
+ test of Prolog performance.
+
+ In a complete evaluation of a Prolog system you should also be taking
+ account speeds of asserting and compiling, tail recursion, memory
+ utilisation, compactness of programs, storage management and garbage
+ collection, debugging and editing facilities, program checking and help
+ facilities, system provided predicates, interfaces to external
+ capabilities, documentation and support, amongst other factors.
+
+ ====================================================================== */
+
+
+/* ----------------------------------------------------------------------
+ get_cpu_time(T) -- T is the current cpu time.
+
+ ** This bit will probably require changes to work on your Prolog
+ system, since different systems provide this facility in
+ different ways. See your Prolog manual for details.
+ ** Also check the code for calculate_lips/4 below.
+ ---------------------------------------------------------------------- */
+
+get_cpu_time(T) :- statistics(runtime,[T,_]). /* Quintus Prolog version */
+
+/* get_cpu_time(T) :- T is cputime. C-Prolog version */
+
+
+/* ----------------------------------------------------------------------
+ nrev(L1,L2) -- L2 is the list L1 reversed.
+ append(L1,L2,L3) -- L1 appended to L2 is L3.
+ data(L) -- L is a thirty element list.
+
+ This is the program executed by the benchmark.
+ It is called "naive reverse" because it is a very expensive way
+ of reversing a list. Its advantage, for our purposes, is that
+ it generates a lot of procedure calls. To reverse a thirty element
+ list requires 496 Prolog procedure calls.
+ ---------------------------------------------------------------------- */
+
+nrev([],[]).
+nrev([X|Rest],Ans) :- nrev(Rest,L), concatenate(L,[X],Ans).
+
+concatenate([],L,L).
+concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3).
+
+
+data([1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
+ 21,22,23,24,25,26,27,28,29,30]).
+
+
+/* ----------------------------------------------------------------------
+ lots -- Run benchmark with a variety of iteration counts.
+
+ Call this to run the benchmark with increasing numbers
+ of iterations. The figures produced should be about the same -
+ except that there may be inaccuracies at low iteration numbers
+ if the time these examples take to execute on your machine are
+ too small to be very precise (because of the accuracy the
+ operating system itself is capable of providing).
+ If the time taken for these examples is too long or short then
+ you should adjust the eg_count(_) facts.
+ ---------------------------------------------------------------------- */
+
+lots :-
+ eg_count(Count),
+ bench(Count),
+ fail.
+lots.
+
+eg_count(10).
+eg_count(20).
+eg_count(50).
+eg_count(100).
+eg_count(200).
+eg_count(500).
+eg_count(1000).
+eg_count(2000).
+eg_count(5000).
+eg_count(10000).
+
+
+/* ----------------------------------------------------------------------
+ bench(Count) -- Run the benchmark for Count iterations.
+
+ bench provides a test harness for running the naive reverse
+ benchmark. It is important to factor out the overhead of setting
+ the test up and using repeat(_) to iterate the right number of
+ times. This is done by running some dummy code as well to see how
+ much time the extra operations take.
+ ---------------------------------------------------------------------- */
+
+bench(Count) :-
+ get_cpu_time(T0),
+ dodummy(Count),
+ get_cpu_time(T1),
+ dobench(Count),
+ get_cpu_time(T2),
+ report(Count,T0,T1,T2).
+
+
+/* ----------------------------------------------------------------------
+ dobench(Count) -- nrev a 30 element list Count times.
+ dodummy(Count) -- Perform the overhead operations Count times.
+ repeat(Count) -- Predicate which succeeds Count times
+
+ This is the supporting code, which is reasonably clear.
+ ---------------------------------------------------------------------- */
+
+dobench(Count) :-
+ data(List),
+ repeat(Count),
+ nrev(List,_),
+ fail.
+dobench(_).
+
+
+dodummy(Count) :-
+ data(List),
+ repeat(Count),
+ dummy(List,_),
+ fail.
+dodummy(_).
+
+dummy(_,_).
+
+repeat(_N).
+repeat(N) :- N > 1, N1 is N-1, repeat(N1).
+
+
+/* ----------------------------------------------------------------------
+ report(Count,T0,T1,T2) -- Report the results of the benchmark.
+ calculate_lips(Count,Time,Lips,Units) --
+ Doing Count interations in Time implies Lips lips assuming
+ that time is given in Units.
+
+ This calculates the logical inferences per second (lips) figure.
+ Remember that it takes 496 procedure calls to naive reverse a
+ thirty element list once. Lips, under this benchmark, thus means
+ "Prolog procedure calls per second, where the procedure calls
+ are not too complex (i.e. those for nrev and append)".
+
+ ** This version of the code assumes that the times (T0.. etc)
+ are integers giving the time in milliseconds. This is true for
+ Quintus Prolog. Your Prolog system may use some other
+ representation. If so, you will need to adjust the Lips
+ calculation. There is a C-Prolog version below for the case
+ where times are floating point numbers giving the time in
+ seconds.
+ ---------------------------------------------------------------------- */
+
+report(Count,T0,T1,T2) :-
+ Time1 is T1-T0,
+ Time2 is T2-T1,
+ Time is Time2-Time1, /* Time spent on nreving lists */
+ calculate_lips(Count,Time,Lips,Units),
+ nl,
+ write(Lips), write(' lips for '), write(Count),
+ write(' iterations taking '), write(Time),
+ write(' '), write(Units), write(' ('),
+ write(Time2-Time1), write(')'),
+ nl.
+
+
+
+calculate_lips(_Count,Time,Lips,'msecs') :- /* Time can be 0 for small */
+ Time is 0, !, Lips is 0. /* values of Count! */
+calculate_lips(Count,Time,Lips,'msecs') :-
+ Lips is (496*float(Count)*1000)/Time.
+
+/* --- C-Prolog version
+
+calculate_lips(Count,Time,Lips,'secs') :- Lips is (496*Count)/Time.
+
+ --- */
+
diff --git a/examples/benchmarks/src/dobry.txt b/examples/benchmarks/src/dobry.txt
new file mode 100644
index 0000000..f67a37d
--- /dev/null
+++ b/examples/benchmarks/src/dobry.txt
@@ -0,0 +1,478 @@
+
+Received: from ashe.cs.tcd.ie by cs.tcd.ie (PMDF #12050) id
+ <01GL39HKYNEO9BVR5R@cs.tcd.ie>; Thu, 11 Jun 1992 13:48 GMT
+Received: by ashe.cs.tcd.ie (5.57/Ultrix3.0-C) id AA14680; Thu,
+ 11 Jun 92 13:50:05 +0100
+Received: from scorpio.ecrc.de by ecrc.de with SMTP id AA17725 (5.65c/IDA-1.4.4
+ for <brady@cs.tcd.ie>); Thu, 11 Jun 1992 14:49:51 +0200
+Received: from janus6.ecrc by scorpio.ecrc.de (4.1/SMI-3.2) id AA15740; Thu,
+ 11 Jun 92 14:49:49 +0200
+Received: by janus6.ecrc (4.1/SMI-4.1) id AA03886; Thu, 11 Jun 92 14:49:47 +0200
+Date: Thu, 11 Jun 92 14:49:49 +0200
+From: Jacques Noye <Jacques.Noye@ecrc.de>
+Subject: Re: Machine readable standard benchmarks?
+To: brady@cs.tcd.ie (Brady Michael)
+Message-Id: <9206111249.AA15740@scorpio.ecrc.de>
+X-Envelope-To: brady@ashe.cs.tcd.ie
+
+Here it is, I hope (I think I have left the code untouched, but I am not 100%
+sure). It comes from Tep Dobry when he was at UCB.
+
+By the way, these benchmarks are somehow outdated. Do you know about the
+benchmark
+suite used for assessing the BAM and the Aquarius Prolog Compiler? It is
+available by anonymous FTP from UCB. The suite of F. Pereira (published
+on the net in 86 or 87) is also quite interesting (it tries to test
+specific operations,
+unification, indexing, backtracking...).
+
+-- Jacques NOYE
+
+
+
+From: (Tep Dobry) Tep%ucbdali@Berkeley
+Subject: The Berkeley PLM Benchmarks
+Date: Wednesday, May 22 1985
+
+ At the Warren Abstract Machine Workshop a few weeks ago
+I was asked to publish the set of benchmarks programs I've
+been using on my simulator for the Berkeley Prolog
+Machine(PLM). I've finally got them all collected together
+in Prolog form (CProlog) and have sent them to the Digest.
+They're really too big to just publish in the Digest, so
+they are being set up in a directory in the PROLOG directory
+at SU-SCORE. There are 11 files with a total of 400 lines.
+Since our machine is based on compiled Prolog, the top level
+queries are also compiled in, generally as the predicate
+main/0.
+
+ The benchmarks were primarily chosen to exercise all of
+the features of the PLM, not for any complexity of program-
+ming. About half of them come from Warren's thesis, and the
+others we've added here. Our original performance figures
+were based on simulations of hand compiled versions of these
+benchmarks. We are currently looking for larger, more com-
+plex benchmarks to run on the hardware when it is available.
+So I'd be interested seeing large benchmarks sent to the
+Digest.
+
+-- Tep Dobry (TEP@Berkeley)
+
+
+% concat (con1, con6)
+% These two tests are simple examples of the concat predicate
+% con1 is determinate, con6 is non-determinate getting all 6 answers
+
+con1 :- concat([a,b,c],[d,e],X), % con1
+ write(X),nl.
+con6 :- concat(X,Y,[a,b,c,d,e]), % con6
+ write(X),nl,
+ write(Y),nl,nl,
+ fail.
+
+concat([],L,L).
+concat([X|L1],L2,[X|L3]) :- concat(L1,L2,L3).
+
+
+% differen (times10,divide10,log10,ops8)
+% These 4 examples are from Warren's thesis
+
+diff :-
+ times10(I1),
+ d(I1,x,D1),
+ write(D1), nl,
+ divide10(I2),
+ d(I2,x,D2),
+ write(D2), nl,
+ log10(I3),
+ d(I3,x,D3),
+ write(D3), nl,
+ ops8(I4),
+ d(I4,x,D4),
+ write(D4), nl.
+
+d(U+V,X,DU+DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U-V,X,DU-DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U*V,X,DU*V+U*DV) :- !, d(U,X,DU), d(V,X,DV).
+d(U/V,X,(DU*V-U*DV)/(^(V,2))) :- !, d(U,X,DU), d(V,X,DV).
+d(^(U,N),X,DU*N*(^(U,N1))) :- !, integer(N), N1 is N - 1, d(U,X,DU).
+d(-U,X,-DU) :- !, d(U,X,DU).
+d(exp(U),X,exp(U)*DU) :- !, d(U,X,DU).
+d(log(U),X,DU/U) :- !, d(U,X,DU).
+d(X,X,1). % There is a cut in Warren's program! -- Jacques
+d(C,X,0).
+
+times10( ((((((((x*x)*x)*x)*x)*x)*x)*x)*x)*x ).
+divide10( ((((((((x/x)/x)/x)/x)/x)/x)/x)/x)/x ).
+log10( log(log(log(log(log(log(log(log(log(log(x)))))))))) ).
+ops8( (x+1)*((^(x,2)+2)*(^(x,3)+3)) ).
+
+
+
+% towers of hanoi ( hanoi ) for 8 disks
+
+hanoi :- hanoi(8).
+
+hanoi(N) :- move(N,left,center,right).
+
+move(0,_,_,_) :- !.
+move(N,A,B,C) :- M is N-1, move(M,A,C,B), inform(A,B), move(M,C,B,A).
+
+inform(A,B) :- write([move,disk,from,A,to,B]), nl, fail.
+inform(_,_).
+
+
+% Main program to do branch and bound NAND gate designs.
+% Optimized for 2-input NAND gates and 3 input variables.
+% A. Despain, Feb 84.
+% In this case, design a 2-1 MUX (ckt2)
+
+main :- set_bound(32000), update_circuit([],0), r(0, [0,0,1,1,0,1,0,1]).
+
+run(Depth, Table, Circuit, Cost, Depth) :- search(Depth, Table),
+ circuit(Circuit),
+ Circuit\==[],
+ cost_bound(Cost),!.
+run(Depth, Table, Circuit, Cost, Delay) :- D is Depth + 1,
+ run(D, Table, Circuit, Cost, Delay),!.
+
+search(Depth, Table) :- t(Depth, Circuit, Table, 0, Cost_out),
+ update_circuit(Circuit,Cost_out),
+ update_bound(Cost_out).
+
+% Input signals are free and terminate the search.
+t(_, 0 , [0,1,0,1,0,1,0,1],C,C).
+t(_, 1 , [0,0,1,1,0,0,1,1],C,C).
+t(_, 2 , [0,0,0,0,1,1,1,1],C,C).
+t(_,i0 , [1,0,1,0,1,0,1,0],C,C).
+t(_,i1 , [1,1,0,0,1,1,0,0],C,C).
+t(_,i2 , [1,1,1,1,0,0,0,0],C,C).
+
+% Inverters are free in this model.
+t(Depth, [i,Z], Table, Cin, Cout) :- Depth > 0,
+ D is Depth -1,
+ sint(Table, Itable),
+ t(D, Z, Itable, Cin, Cout).
+
+% Main NAND gate clause.
+t(Depth, [n,Y,Z], Table, Cin, Cout) :- Depth > 0,
+ D is Depth -1,
+ update_cost(Cin,1,C2),
+ ngate(Table, A, B),
+ t(D,Y,A,C2,C3),
+ t(D,Z,B,C3,Cout).
+
+% Inverter signal transformation.
+%sint([H1,..T1],[H2,..T2]) :- inv(H1, H2), sint(T1, T2).
+sint([],[]).
+sint([X,..T1],[_,..T2]) :- var(X), sint(T1, T2),!.
+sint([0,..T1],[1,..T2]) :- sint(T1, T2).
+sint([1,..T1],[0,..T2]) :- sint(T1, T2).
+
+% Optimized gate signal transformation.
+ngate([], [], []).
+tgate([], [], []).
+ngate([X,..T0], [_,..T1], [_,..T2]) :- var(X), !, ngate(T0, T1, T2).
+ngate([X,..T0], [1,..T1], [1,..T2]) :- X==0, ngate(T0, T1, T2).
+ngate([X,..T0], [_,..T1], [0,..T2]) :- X==1, tgate(T0, T1, T2).
+tgate([X,..T0], [_,..T1], [_,..T2]) :- var(X), !, tgate(T0, T1, T2).
+tgate([X,..T0], [1,..T1], [1,..T2]) :- X==0, tgate(T0, T1, T2).
+tgate([X,..T0], [_,..T1], [0,..T2]) :- X==1, tgate(T0, T1, T2).
+tgate([X,..T0], [0,..T1], [_,..T2]) :- X==1, tgate(T0, T1, T2).
+
+
+r(Depth,Table) :- run(0, Table, L, C, D),
+ Depth =< D,
+ nl, write([minimum,cost,circuit,of,the,shortest,delay]),
+ nl, write([ circuit,=,L]),
+ nl, write([ cost,is,C,gates]),
+ nl, write([ delay,is,D,gate,times]),nl,!.
+r(Depth,Table) :- run(Depth, Table, L, C, D),
+ nl, write([lowest,cost,circuit,for,a,given,delay]),
+ nl, write([ circuit,=,L]),
+ nl, write([ cost,is,C,gates]),
+ nl, write([ delay,is,D,gate,times]),nl.
+
+%Utility procedures
+
+min(X,Y,X) :- X < Y , ! .
+min(X,Y,Y).
+
+update_cost(Cost_in, Cost, Cost_out) :- Cost_out is Cost_in + Cost,
+ cost_bound(B),
+ Cost_out < B, ! .
+
+cost_bound(32000).
+
+set_bound(X) :- retract((cost_bound(_))),
+ assert((cost_bound(X))), ! .
+
+update_bound(X) :- retract((cost_bound(Y))),
+ min(X,Y,Z),
+ assert((cost_bound(Z))), ! .
+
+update_circuit(Circuit,Cost) :- cost_bound(X),
+ Cost < X ,
+ retract((circuit(_))),
+ assert((circuit(Circuit))),!.
+update_circuit(Circuit,Cost).
+
+circuit([]).
+
+
+% Hofstader's mu math (mutest) proving muiiu
+% from Godel Escher Bach
+
+mu :- theorem(5,[m,u,i,i,u]).
+
+rules(S, R) :- rule3(S,R).
+rules(S, R) :- rule4(S,R).
+rules(S, R) :- rule1(S,R).
+rules(S, R) :- rule2(S,R).
+
+rule1(S,R) :-
+ append(X, [i], S),
+ append(X, [i,u], R).
+
+rule2([m | T], [m | R]) :- append(T, T, R).
+
+rule3([], -) :- fail.
+rule3(R, T) :-
+ append([i,i,i], S, R),
+ append([u], S, T).
+rule3([H | T], [H | R]) :- rule3(T, R).
+
+rule4([], -) :- fail.
+rule4(R, T) :- append([u, u], T, R).
+rule4([H | T], [H | R]) :- rule4(T, R).
+
+theorem(Depth, [m, i]).
+theorem(Depth, []) :- fail.
+
+theorem(Depth, R) :-
+ Depth > 0,
+ D is Depth - 1,
+ theorem(D, S),
+ rules(S, R).
+
+append([], X, X).
+append([A | B], X, [A | B1]) :-
+ !,
+ append(B, X, B1).
+
+
+% naive reverse (nrev1)
+% from Warren's thesis
+
+nrev1 :-
+ list30(L),
+ nreverse(L,X),
+ write(X), nl.
+
+nreverse([X|L0],L) :- nreverse(L0,L1), concatenate(L1,[X],L).
+nreverse([],[]).
+
+concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3).
+concatenate([],L,L).
+
+list30([1,2,3,4,5,6,7,8,9,10,11,12,
+ 13,14,15,16,17,18,19,20,21,
+ 22,23,24,25,26,27,28,29,30]).
+
+
+% the queens on a chessboard problem (queens) for 4x4 board
+
+queens :- run(4,X), fail.
+
+size(4).
+int(1).
+int(2).
+int(3).
+int(4).
+
+run(Size, Soln) :- get_solutions(Size, Soln), inform(Soln).
+
+get_solutions(Board_size, Soln) :- solve(Board_size, [], Soln).
+
+% newsquare generates legal positions for next queen
+
+newsquare([], square(1, X)) :- int(X).
+newsquare([square(I, J) | Rest], square(X, Y)) :-
+ X is I + 1,
+ int(Y),
+ not(threatened(I, J, X, Y)),
+ safe(X, Y, Rest).
+
+
+% safe checks whether square(X, Y) is threatened by any
+% existing queens
+
+safe(X, Y, []).
+safe(X, Y, [square(I, J) | L]) :-
+ not(threatened(I, J, X, Y)),
+ safe(X, Y, L).
+
+
+% threatened checks whether squares (I, J) and (X, Y)
+% threaten each other
+
+threatened(I, J, X, Y) :-
+ (I = X),
+ !.
+threatened(I, J, X, Y) :-
+ (J = Y),
+ !.
+threatened(I, J, X, Y) :-
+ (U is I - J),
+ (V is X - Y),
+ (U = V),
+ !.
+threatened(I, J, X, Y) :-
+ (U is I + J),
+ (V is X + Y),
+ (U = V),
+ !.
+
+
+% solve accumulates the positions of occupied squares
+
+solve(Bs, [square(Bs, Y) | L], [square(Bs, Y) | L]) :- size(Bs).
+solve(Board_size, Initial, Final) :-
+ newsquare(Initial, Next),
+ solve(Board_size, [Next | Initial], Final).
+
+inform([]) :- nl,nl.
+inform([M | L]) :- write(M), nl, inform(L).
+
+% query
+% from Warren's thesis
+
+query :-
+ query(X),
+ write(X), nl,
+ fail.
+
+query([C1,D1,C2,D2]) :-
+ density(C1,D1),
+ density(C2,D2),
+ D1 > D2,
+ T1 is 20*D1,
+ T2 is 21*D2,
+ T1 < T2.
+
+density(C,D) :- pop(C,P), area(C,A), D is (P*100)//A.
+
+pop(china, 8250). area(china, 3380).
+pop(india, 5863). area(india, 1139).
+pop(ussr, 2521). area(ussr, 8708).
+pop(usa, 2119). area(usa, 3609).
+pop(indonesia, 1276). area(indonesia, 570).
+pop(japan, 1097). area(japan, 148).
+pop(brazil, 1042). area(brazil, 3288).
+pop(bangladesh, 750). area(bangladesh,55).
+pop(pakistan, 682). area(pakistan, 311).
+pop(w_germany, 620). area(w_germany, 96).
+pop(nigeria, 613). area(nigeria, 373).
+pop(mexico, 581). area(mexico, 764).
+pop(uk, 559). area(uk, 86).
+pop(italy, 554). area(italy, 116).
+pop(france, 525). area(france, 213).
+pop(phillipines,415). area(phillipines,90).
+pop(thailand, 410). area(thailand, 200).
+pop(turkey, 383). area(turkey, 296).
+pop(egypt, 364). area(egypt, 386).
+pop(spain, 352). area(spain, 190).
+pop(poland, 337). area(poland, 121).
+pop(s_korea, 335). area(s_korea, 37).
+pop(iran, 320). area(iran, 628).
+pop(ethiopia, 272). area(ethiopia, 350).
+pop(argentina, 251). area(argentina, 1080).
+
+
+% quicksort (qs4) on 50 items
+% from Warren's thesis
+
+qs4 :-
+ list50(L),
+ qsort(L,X,[]),
+ write(X), nl.
+
+qsort([X|L],R,R0) :-
+ partition(L,X,L1,L2),
+ qsort(L2,R1,R0),
+ qsort(L1,R,[X|R1]).
+qsort([],R,R).
+
+partition([X|L],Y,[X|L1],L2) :-
+ X<Y, !,
+ partition(L,Y,L1,L2).
+partition([X|L],Y,L1,[X|L2]) :-
+ partition(L,Y,L1,L2).
+partition([],_,[],[]).
+
+list50([27,74,17,33,94,18,46,83,65,2,
+ 32,53,28,85,99,47,28,82,6,11,
+ 55,29,39,81,90,37,10,0,66,51,
+ 7,21,85,27,31,63,75,4,95,99,
+ 11,28,61,74,18,92,40,53,59,8]).
+
+
+
+% serialize (palin25)
+% from Warren's thesis
+
+palin25 :-
+ palin25(P),
+ serialize(P,X),
+ write(X),nl.
+
+serialize(L,R) :-
+ pairlists(L,R,A),
+ arrange(A,T),
+ numbered(T,1,N).
+
+pairlists([X|L], [Y|R], [pair(X,Y)|A]) :- pairlists(L,R,A).
+pairlists([], [], []).
+
+arrange([X|L], tree(T1, X, T2)) :-
+ split(L, X, L1, L2),
+ arrange(L1, T1),
+ arrange(L2, T2).
+arrange([], void).
+
+split([X|L], X, L1, L2) :- !, split(L, X, L1, L2).
+split([X|L], Y, [X|L1], L2) :- before(X,Y), !, split(L,Y,L1,L2).
+split([X|L], Y, L1, [X|L2]) :- before(Y,X), !, split(L,Y,L1,L2).
+split([], _, [], []).
+
+before(pair(X1,Y1), pair(X2,Y2)) :- X1 < X2.
+
+numbered(tree(T1, pair(X,N1), T2), N0, N) :-
+ numbered(T1, N0, N1),
+ is(N2,N1,+,1),
+ numbered(T2,N2,N).
+numbered(_,N,N).
+
+palin25("ABLE WAS I ERE I SAW ELBA").
+
+
+% The sieve of Eratosthenes, from Clocksin & Mellish (pri2)
+% finding the prime numbers up to 98.
+
+sieve :- primes(98, X), write(X), nl.
+
+primes(Limit, Ps) :- integers(2, Limit, Is), sift(Is, Ps).
+
+integers(Low, High, [Low | Rest]) :-
+ Low =< High, !,
+ M is Low+1,
+ integers(M, High, Rest).
+integers(_,_,[]).
+
+sift([],[]).
+sift([I | Is], [I | Ps]) :- remove(I,Is,New), sift(New, Ps).
+
+remove(P,[],[]).
+remove(P,[I | Is], [I | Nis]) :- not(0 is I mod P), !, remove(P,Is,Nis).
+remove(P,[I | Is], Nis) :- 0 is I mod P, !, remove(P,Is,Nis).
+
diff --git a/examples/benchmarks/src/path.pro b/examples/benchmarks/src/path.pro
new file mode 100644
index 0000000..1a85e1e
--- /dev/null
+++ b/examples/benchmarks/src/path.pro
@@ -0,0 +1,71 @@
+% XProlog (http://www.iro.umontreal.ca/~vaucher/XProlog/)
+%
+% path.pro: Benchmark program to evaluate light-weight
+% Prolog interpreters for use with Java agents....
+
+% Depth-first search to find a path between Point1 and Point2 on
+% an 8x8 grid with walls. The top-level predicate to call is:
+
+% solve( Point1, Point2, Path).
+% or solve( Point2, Path). ...implies P1 = (1,1)
+
+% Try in order:
+% solve( Dest, L).
+% solve( p(8,8), L).
+% solve( p(2,2), L). << this may take several minutes
+
+% The program has been adapted to WProlog which has no arithmetic and
+% simplified mechanisms: not( X ) and once( Pred ) instead of CUT
+% but is easy to change. Note, the last test involves 84 million
+% calls of the recursive "unify" method in WProlog.
+% Some results of last test:
+
+% my PC: WProlog 157 sec.
+% my PC: XProlog 67 sec (slightly modified WProlog)
+% my PC JIProlog 168 sec
+% 51 sec XProlog on 1.1 GHz P3 Notebook, 368 MB Ram, JDK 1.3.1 (F.Kratzer)
+
+% Univ server: To compare to Sicstus, industrial Prolog (interpreted)
+% WProlog 215 sec
+% XProlog 140 sec
+% Sicstus 14 sec
+
+
+solve(Dest,L) :-
+ solve(p(1,1), Dest, L).
+solve(S, Dest, Sol) :-
+ path(S, Dest, [S], Path),
+ invert(Path, Sol).
+
+path( P, P, L, L).
+path( Node, Goal, Path, Sol) :-
+ arc( Node, Node2), not( wall(Node2) ),
+ not( member( Node2, Path)),
+ path( Node2, Goal, [Node2 | Path], Sol).
+
+arc( p(X,Y), p(X1,Y) ) :- suc(X,X1).
+arc( p(X,Y), p(X1,Y) ) :- suc(X1,X).
+arc( p(X,Y), p(X,Y1) ) :- suc(Y,Y1).
+arc( p(X,Y), p(X,Y1) ) :- suc(Y1,Y).
+
+wall( p(3,2) ).
+wall( p(3,3) ).
+wall( p(3,4) ).
+wall( p(5,3) ).
+
+suc(1,2).
+suc(2,3).
+suc(3,4).
+suc(4,5).
+suc(5,6).
+suc(6,7).
+suc(7,8).
+
+invert(IN, OUT) :- invert1(IN,[],OUT).
+
+invert1([], L,L).
+invert1( [A | Tail], L,Res) :-
+ invert1( Tail, [A | L], Res).
+
+member(X, [X|Y]).
+member(X, [A|B]) :- member(X,B).
diff --git a/examples/benchmarks/src/plbench.txt b/examples/benchmarks/src/plbench.txt
new file mode 100644
index 0000000..b9f2799
--- /dev/null
+++ b/examples/benchmarks/src/plbench.txt
@@ -0,0 +1,46 @@
+From honeydew.srv.cs.cmu.edu!das-news.harvard.edu!noc.near.net!howland.reston.ans.net!vixen.cso.uiuc.edu!sdd.hp.com!decwrl!decwrl!netcomsv!netcom.com!brahme Wed Sep 15 17:25:28 EDT 1993
+Article: 8544 of comp.lang.prolog
+Xref: honeydew.srv.cs.cmu.edu comp.lang.prolog:8544
+Newsgroups: comp.lang.prolog
+Path: honeydew.srv.cs.cmu.edu!das-news.harvard.edu!noc.near.net!howland.reston.ans.net!vixen.cso.uiuc.edu!sdd.hp.com!decwrl!decwrl!netcomsv!netcom.com!brahme
+From: brahme@netcom.com (brahme)
+Subject: benchmarking prolog systems: Here is one small program
+Message-ID: <brahmeCDD9I4.645@netcom.com>
+Organization: NETCOM On-line Communication Services (408 241-9760 guest)
+Date: Tue, 14 Sep 1993 23:06:03 GMT
+Lines: 31
+
+%% Here are a few predicates which can be used to benchmark
+%% various prolog systems. This would test the prolog systems management of
+%% program space. This is the space typically used by asserts and retracts
+%% as well as built_ins like findall. Also comparing the times with g1 would
+%% indicate the overhead of findall and assert/retracts
+
+%% It would nice if people could develop such small benchmarks which
+%% test parts of various prolog systems that are not covered by the
+%% existing benchmarks.
+
+
+g1(N, L) :- length(L, N), same_value(L, e).
+
+g2(0) :- !.
+g2(N, A) :- N > 0, A = e.
+g2(N, A) :- N > 0, N1 is N - 1, g2(N1, A).
+
+g1f(N, Es) :-
+ g1(N, L),
+ findall(E, member(E, L), Es).
+
+g2f(N, Es) :-
+ g2(N, A), findall(A, g2(N, A), Es).
+
+g2a(N) :-
+ asserta(g2_ans([])),
+ g2(N, A), retract(g2_ans(List)), asserta(g2_ans([A|List])), fail.
+g2a(N) :- retract(g2_ans(List)).
+
+same_value([], _E).
+same_value([E|R], E) :- same_value(R, E).
+
+
+
diff --git a/examples/benchmarks/xprolog/Makefile b/examples/benchmarks/xprolog/Makefile
new file mode 100644
index 0000000..7813272
--- /dev/null
+++ b/examples/benchmarks/xprolog/Makefile
@@ -0,0 +1,97 @@
+################################################################
+# Makefile
+################################################################
+PLCAFE = plcafe
+PLCAFEOPTS =
+PLJAR = pljar
+PLJAROPTS = -v
+
+SICSTUS = /usr/local/bin/sicstus
+SICSTUSOPTS =
+
+SWI = /opt/local/bin/swipl
+SWIOPTS = -L100m
+
+################################################################
+.SUFFIXES:
+.SUFFIXES: .ql .qlf .jar .pl .sicstus .swi .plcafe .in $(SUFFIXES)
+
+plcafe: comp_plcafe run_plcafe
+
+sicstus: comp_sicstus run_sicstus
+
+swi: comp_swi run_swi
+
+all: comp run
+
+################################################################
+# run
+################################################################
+plcafe_out_objects := $(patsubst %.in,%.plcafe, $(wildcard *.in))
+sicstus_out_objects := $(patsubst %.in,%.sicstus,$(wildcard *.in))
+swi_out_objects := $(patsubst %.in,%.swi, $(wildcard *.in))
+
+.in.plcafe:
+ -rm -f out/$@
+ /bin/echo "['$<'], halt." \
+ | $(PLCAFE) $(PLCAFEOPTS) -cp $*.jar:bench_util.jar > out/$@
+
+.in.sicstus:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SICSTUS) $(SICSTUSOPTS) > out/$@
+
+.in.swi:
+ -rm -f out/$@
+ /bin/echo "ensure_loaded($*), ensure_loaded(bench_util), ['$<'], halt." \
+ | $(SWI) $(SWIOPTS) > out/$@
+
+run: run_plcafe run_sicstus run_swi
+
+run_plcafe: $(plcafe_out_objects)
+
+run_sicstus: $(sicstus_out_objects)
+
+run_swi: $(swi_out_objects)
+
+################################################################
+# compile
+################################################################
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+ql_objects := $(patsubst %.pl,%.ql, $(wildcard *.pl))
+qlf_objects := $(patsubst %.pl,%.qlf,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+.pl.ql:
+ /bin/echo "[$*], fcompile($*), halt." | $(SICSTUS) $(SICSTUSOPTS)
+
+.pl.qlf:
+ /bin/echo "qcompile($*), halt." | $(SWI) $(SWIOPTS)
+# /bin/echo "[$*], qcompile($*), halt." | $(SWI) $(SWIOPTS)
+
+comp: comp_plcafe comp_sicstus comp_swi
+
+comp_plcafe: $(jar_objects)
+
+comp_sicstus: $(ql_objects)
+
+comp_swi: $(qlf_objects)
+
+################################################################
+# clean up
+################################################################
+clean:
+ -rm -f core *~
+ -rm -f /out/core out/*~
+ -rm -f *.ql
+ -rm -f *.qlf
+
+realclean: clean
+ -rm -f *.jar *.class
+ -rm -f out/*.plcafe out/*.sicstus out/*.swi
+
+# END
+
diff --git a/examples/benchmarks/xprolog/bench_util.pl b/examples/benchmarks/xprolog/bench_util.pl
new file mode 100644
index 0000000..a490962
--- /dev/null
+++ b/examples/benchmarks/xprolog/bench_util.pl
@@ -0,0 +1,47 @@
+% File : bench_util.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 24 February 2008
+% Purpose: Benchmark utilities
+% Note : based on driver.pl in Pereira's benchmark
+
+'$get_cpu_time'(T) :- statistics(runtime, [T,_]).
+
+'$report'(Name, N, T0, T1, T2) :-
+ TestTime is T1-T0,
+ OverHead is T2-T1,
+ Time is TestTime-OverHead,
+ Average is Time/N,
+ nl,
+ write('# Name: '), write(Name), nl,
+ write('# Iterations: '), write(N), nl,
+ write('# TestTime: '), write(TestTime), write(' msec.\n'),
+ write('# OverHead: '), write(OverHead), write(' msec.\n'),
+ write('# TestTime-OverHead: '), write(Time), write(' msec.\n'),
+ write('# (TestTime-OverHead)/Iterations: '), write(Average), write(' msec.\n'),
+ '$report_csv'(['###CSV###',Name,N,TestTime,OverHead,Time,Average], ','),
+ nl.
+
+'$report_csv'([], _) :- !.
+'$report_csv'([X], _) :- !, write(X), nl.
+'$report_csv'([X|Xs], Delim) :- write(X), write(Delim), '$report_csv'(Xs, Delim).
+
+'$benchmark'(Name, Iterations, Action, Control) :-
+ '$get_cpu_time'(T0),
+ ( '$repeat'(Iterations), once(Action), fail
+ ; '$get_cpu_time'(T1)
+ ),
+ ( '$repeat'(Iterations), once(Control), fail
+ ; '$get_cpu_time'(T2)
+ ),
+ '$report'(Name, Iterations, T0, T1, T2).
+
+'$repeat'(N) :- N > 0, '$from'(1, N).
+
+'$from'(I, I) :- !.
+'$from'(L, U) :- M is (L+U)>>1, '$from'(L, M).
+'$from'(L, U) :- M is (L+U)>>1+1, '$from'(M, U).
+
+'$dummy'.
+'$dummy'(_).
+'$dummy'(_, _).
+'$dummy'(_, _, _).
diff --git a/examples/benchmarks/xprolog/path.in b/examples/benchmarks/xprolog/path.in
new file mode 100644
index 0000000..424f317
--- /dev/null
+++ b/examples/benchmarks/xprolog/path.in
@@ -0,0 +1,2 @@
+:- '$benchmark'(path, 10, main, '$dummy').
+
diff --git a/examples/benchmarks/xprolog/path.pl b/examples/benchmarks/xprolog/path.pl
new file mode 100644
index 0000000..92b663f
--- /dev/null
+++ b/examples/benchmarks/xprolog/path.pl
@@ -0,0 +1,82 @@
+%%% Jean Vaucher's benchmark
+
+/*
+ CHANGELOG by M.Banbara
+ - main/0 is added.
+ - not/1 --> (\+)/1
+*/
+
+main :- solve(p(2,2), _).
+
+% Author: Jean Vaucher
+% path.pro: Benchmark program to evaluate light-weight
+% Prolog interpreters for use with Java agents....
+
+% XProlog (http://www.iro.umontreal.ca/~vaucher/XProlog/)
+
+% Depth-first search to find a path between Point1 and Point2 on
+% an 8x8 grid with walls. The top-level predicate to call is:
+
+% solve( Point1, Point2, Path).
+% or solve( Point2, Path). ...implies P1 = (1,1)
+
+% Try in order:
+% solve( Dest, L).
+% solve( p(8,8), L).
+% solve( p(2,2), L). << this may take several minutes
+
+% The program has been adapted to WProlog which has no arithmetic and
+% simplified mechanisms: not( X ) and once( Pred ) instead of CUT
+% but is easy to change. Note, the last test involves 84 million
+% calls of the recursive "unify" method in WProlog.
+% Some results of last test:
+
+% my PC: WProlog 157 sec.
+% my PC: XProlog 67 sec (slightly modified WProlog)
+% my PC JIProlog 168 sec
+% 51 sec XProlog on 1.1 GHz P3 Notebook, 368 MB Ram, JDK 1.3.1 (F.Kratzer)
+
+% Univ server: To compare to Sicstus, industrial Prolog (interpreted)
+% WProlog 215 sec
+% XProlog 140 sec
+% Sicstus 14 sec
+
+
+solve(Dest,L) :-
+ solve(p(1,1), Dest, L).
+solve(S, Dest, Sol) :-
+ path(S, Dest, [S], Path),
+ invert(Path, Sol).
+
+path( P, P, L, L).
+path( Node, Goal, Path, Sol) :-
+ arc( Node, Node2), \+( wall(Node2) ),
+ \+( member( Node2, Path)),
+ path( Node2, Goal, [Node2 | Path], Sol).
+
+arc( p(X,Y), p(X1,Y) ) :- suc(X,X1).
+arc( p(X,Y), p(X1,Y) ) :- suc(X1,X).
+arc( p(X,Y), p(X,Y1) ) :- suc(Y,Y1).
+arc( p(X,Y), p(X,Y1) ) :- suc(Y1,Y).
+
+wall( p(3,2) ).
+wall( p(3,3) ).
+wall( p(3,4) ).
+wall( p(5,3) ).
+
+suc(1,2).
+suc(2,3).
+suc(3,4).
+suc(4,5).
+suc(5,6).
+suc(6,7).
+suc(7,8).
+
+invert(IN, OUT) :- invert1(IN,[],OUT).
+
+invert1([], L,L).
+invert1( [A | Tail], L,Res) :-
+ invert1( Tail, [A | L], Res).
+
+member(X, [X|Y]).
+member(X, [A|B]) :- member(X,B).
diff --git a/examples/java/Knight.java b/examples/java/Knight.java
new file mode 100644
index 0000000..5cddaae
--- /dev/null
+++ b/examples/java/Knight.java
@@ -0,0 +1,145 @@
+import java.awt.*;
+import java.util.Vector;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * Knight Tour.<br>
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ */
+public class Knight extends PrologFrame {
+ private KnightPanel knightPanel;
+ private TextField N_Field;
+ private int N = 5;
+
+ public Knight() {
+ setSize(500, 400);
+ setLayout(new BorderLayout());
+ add("North", new Label("Knight Tour", Label.CENTER));
+ knightPanel = new KnightPanel();
+ add("Center", knightPanel);
+ Panel p = new Panel();
+ add("South", p);
+ p.add(new Label("N="));
+ N_Field = new TextField(Integer.toString(N), 2);
+ p.add(N_Field);
+ control = new PrologControlPanel(this);
+ p.add(control);
+ validate();
+ }
+
+ Term arg1 = null;
+ Term arg2 = null;
+ Predicate knight = null;
+
+ public void sendArgument() {
+ try {
+ N = Integer.parseInt(N_Field.getText());
+ } catch (NumberFormatException e) {
+ N = 1;
+ N_Field.setText(Integer.toString(N));
+ }
+ this.prolog = new PrologControl();
+ arg1 = new IntegerTerm(N);
+ arg2 = new VariableTerm();
+ Term[] args = {arg1,arg2};
+ knight = new PRED_knight_tour_applet_2();
+ prolog.setPredicate(knight, args);
+ knightPanel.setKnight(N, null);
+ }
+
+ public void receiveResult(){
+ Vector v = (Vector)(arg2.toJava());
+ if(v == null) return;
+ if(v.size() != N*N) return;
+ int knight[][] = new int[N][N];
+ try {
+ for (int i = 0; i < N; i++) {
+ for (int j = 0; j < N; j++) {
+ knight[i][j]= ((Integer)(v.elementAt(i*N+j))).intValue();
+ }
+ }
+ knightPanel.setKnight(N, knight);
+ } catch (NumberFormatException e) {}
+ }
+
+ public static void main(String args[]) {
+ new Knight();
+ }
+}
+
+class KnightPanel extends Panel {
+ private int N = 0;
+ private int knightI[] = null;
+ private int knightJ[] = null;
+ private int w;
+ private int h;
+ private int cellSize;
+ private int x0;
+ private int y0;
+
+ public void setKnight(int n, int k[][]) {
+ if (n < 1) {
+ N = 0;
+ return;
+ }
+ N = n;
+ if (k == null) {
+ knightI = null;
+ knightJ = null;
+ repaint();
+ return;
+ }
+ knightI = new int[N*N];
+ knightJ = new int[N*N];
+ for (int i = 0; i < N; i++) {
+ for (int j = 0; j < N; j++) {
+ int s = k[i][j] - 1;
+ knightI[s] = i;
+ knightJ[s] = j;
+ }
+ }
+ repaint();
+ }
+
+ private int xpos(int j) {
+ return x0+j*cellSize;
+ }
+
+ private int ypos(int i) {
+ return y0+i*cellSize;
+ }
+
+ public void paint(Graphics g) {
+ if (N < 1)
+ return;
+ w = getSize().width;
+ h = getSize().height;
+ cellSize = Math.min(w, h) / N;
+ x0 = (w - N * cellSize) / 2;
+ y0 = (h - N * cellSize) / 2;
+ g.setColor(Color.white);
+ g.fillRect(x0, y0, N*cellSize, N*cellSize);
+ g.setColor(Color.black);
+ for (int i = 0; i <= N; i++)
+ g.drawLine(xpos(0), ypos(i), xpos(N), ypos(i));
+ for (int j = 0; j <= N; j++)
+ g.drawLine(xpos(j), ypos(0), xpos(j), ypos(N));
+ if (knightI == null || knightJ == null)
+ return;
+ int hs = cellSize / 2;
+ Font font = g.getFont();
+ FontMetrics fontMetrics = g.getFontMetrics();
+ g.setColor(Color.gray);
+ for (int s = 0; s < N*N; s++) {
+ String str = Integer.toString(s + 1);
+ int x = xpos(knightJ[s])+hs;
+ int y = ypos(knightI[s])+hs;
+ x = x - fontMetrics.stringWidth(str) / 2;
+ y = y + fontMetrics.getAscent() / 2;
+ g.drawString(str, x, y);
+ }
+ g.setColor(Color.blue);
+ for (int s = 0; s < N*N - 1; s++)
+ g.drawLine(xpos(knightJ[s ])+hs, ypos(knightI[s ])+hs,
+ xpos(knightJ[s+1])+hs, ypos(knightI[s+1])+hs);
+ }
+}
diff --git a/examples/java/Makefile b/examples/java/Makefile
new file mode 100644
index 0000000..4c9d632
--- /dev/null
+++ b/examples/java/Makefile
@@ -0,0 +1,35 @@
+################################################################
+# Makefile for Prolog Cafe
+################################################################
+
+################################################################
+PLJAVAC = pljavac
+PLJAVACOPTS = -v
+
+PLJAR = pljar
+PLJAROPTS = -v
+################################################################
+all:
+ -rm -f *.pl
+ ln -s ../prolog/peg.pl .
+ ln -s ../prolog/pentomino.pl .
+ ln -s ../prolog/queens.pl .
+ ln -s ../prolog/knight.pl .
+ $(PLJAR) $(PLJAROPTS) peg.jar peg.pl
+ $(PLJAR) $(PLJAROPTS) pentomino.jar pentomino.pl
+ $(PLJAR) $(PLJAROPTS) queens.jar queens.pl
+ $(PLJAR) $(PLJAROPTS) knight.jar knight.pl
+ -rm -f -r peg
+ -rm -f -r pentomino
+ -rm -f -r queens
+ -rm -f -r knight
+ $(PLJAVAC) $(PLJAVACOPTS) -cp peg.jar Peg.java
+ $(PLJAVAC) $(PLJAVACOPTS) -cp pentomino.jar Pentomino.java
+ $(PLJAVAC) $(PLJAVACOPTS) -cp queens.jar Queens.java
+ $(PLJAVAC) $(PLJAVACOPTS) -cp knight.jar Knight.java
+
+clean:
+ -rm -f core *~
+
+realclean: clean
+ -rm -f *.jar *.class *.pl
diff --git a/examples/java/Peg.java b/examples/java/Peg.java
new file mode 100644
index 0000000..1d38c3b
--- /dev/null
+++ b/examples/java/Peg.java
@@ -0,0 +1,184 @@
+import java.awt.*;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>Peg</code><br>
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ */
+public class Peg extends PrologFrame {
+ private PegPanel pegPanel;
+ private TextField N_Field;
+ private TextField I_Field;
+ private TextField J_Field;
+ private int N = 5;
+ private int I0 = 5;
+ private int J0 = 3;
+
+ public Peg() {
+ setSize(500, 400);
+ setBackground(Color.lightGray);
+ setLayout(new BorderLayout());
+ add("North", new Label("Peg", Label.CENTER));
+ pegPanel = new PegPanel();
+ add("Center", pegPanel);
+ Panel p = new Panel();
+ add("South", p);
+ p.add(new Label("N="));
+ N_Field = new TextField(Integer.toString(N), 2);
+ p.add(N_Field);
+ p.add(new Label("(I, J)=("));
+ I_Field = new TextField(Integer.toString(I0), 1);
+ p.add(I_Field);
+ p.add(new Label(","));
+ J_Field = new TextField(Integer.toString(J0), 1);
+ p.add(J_Field);
+ p.add(new Label(")"));
+ control = new PrologControlPanel(this);
+ p.add(control);
+ validate();
+ }
+
+ Term a1 = null;
+ Term a2 = null;
+ Term a3 = null;
+ Term a4 = null;
+ Predicate peg = null;
+
+ void sendArgument() {
+ try {
+ N = Integer.parseInt(N_Field.getText());
+ I0 = Integer.parseInt(I_Field.getText());
+ J0 = Integer.parseInt(J_Field.getText());
+ } catch (NumberFormatException e) {
+ N = 1;
+ N_Field.setText(Integer.toString(N));
+ I0 = 1;
+ I_Field.setText(Integer.toString(I0));
+ J0 = 1;
+ J_Field.setText(Integer.toString(J0));
+ }
+ this.prolog = new PrologControl();
+ a1 = new IntegerTerm(N);
+ a2 = new IntegerTerm(I0);
+ a3 = new IntegerTerm(J0);
+ a4 = new VariableTerm();
+ Term[] args = {a1,a2,a3,a4};
+ peg = new PRED_peg_game_4();
+ prolog.setPredicate(peg, args);
+ }
+
+ void receiveResult() {
+ Term result = a4.dereference();
+ if (! result.isList()) {
+ System.out.println("Invalid result!");
+ return;
+ }
+ int len = ((ListTerm)result).length();
+ int moves[][] = new int[len][4];
+ Term elm;
+ Term[] args;
+ try {
+ for (int i=0; i<len; i++) {
+ elm = ((ListTerm)result).car().dereference();
+ args = ((StructureTerm)elm).args();
+ moves[i][0] = ((IntegerTerm)(args[0].dereference())).intValue();
+ moves[i][1] = ((IntegerTerm)(args[1].dereference())).intValue();
+ moves[i][2] = ((IntegerTerm)(args[2].dereference())).intValue();
+ moves[i][3] = ((IntegerTerm)(args[3].dereference())).intValue();
+ result = ((ListTerm)result).cdr().dereference();
+ }
+ pegPanel.setSol(N, I0, J0, moves);
+ } catch (Exception e) {
+ System.out.println("are?");
+ }
+ pegPanel.start(); // start animation
+ }
+
+ public static void main(String args[]) {
+ new Peg();
+ }
+}
+
+class PegPanel extends Panel implements Runnable {
+ private Thread pegAnimator = null;
+ private int N;
+ private int I0;
+ private int J0;
+ private Color peg[][] = null;
+ private int moves[][] = null;
+ private int cellSize;
+ private int x0;
+ private int y0;
+ private int wait = 300;
+
+ public synchronized void start() {
+ stop();
+ pegAnimator = new Thread(this);
+ pegAnimator.start();
+ }
+
+ public synchronized void stop() {
+ pegAnimator = null;
+ }
+
+ public synchronized void setSol(int n, int i0, int j0, int m[][]) {
+ N = n;
+ I0 = i0;
+ J0 = j0;
+ moves = m;
+ peg = null;
+ repaint();
+ }
+
+ public void paint(Graphics g) {
+ int m, n;
+ if (peg == null)
+ return;
+ /* this.g = g; */
+ int w = getSize().width;
+ int h = getSize().height;
+ cellSize = Math.min(w, h) / N;
+ x0 = (w - N * cellSize) / 2;
+ y0 = (h - N * cellSize) / 2;
+ for (int i = 1; i <= N; ++i)
+ for (int j = 1; j <= i; ++j) {
+ g.setColor(peg[i][j]);
+ m = i-1;
+ n = j-1;
+ int x = x0 + (N-1-m)*cellSize/2 + n*cellSize;
+ int y = y0 + m*cellSize;
+ g.fillOval(x+cellSize/4, y+cellSize/4, cellSize/2, cellSize/2);
+ }
+ }
+
+ private void sleep(int t) {
+ try {
+ Thread.sleep(t);
+ } catch (InterruptedException e) {}
+ }
+
+ public void run() {
+ if (moves == null)
+ return;
+ peg = new Color[N+1][N+1];
+ for (int i = 1; i <= N; ++i)
+ for (int j = 1; j <= i; ++j)
+ peg[i][j] = Color.blue;
+ peg[I0][J0] = Color.white;
+ repaint();
+ for (int k = 0; k < moves.length; ++k) {
+ sleep(wait);
+ int i0 = moves[k][0];
+ int j0 = moves[k][1];
+ int di = moves[k][2];
+ int dj = moves[k][3];
+ peg[i0][j0] = Color.red;
+ repaint();
+ sleep(wait);
+ peg[i0][j0] = Color.white;
+ peg[i0+di][j0+dj] = Color.white;
+ peg[i0+2*di][j0+2*dj] = Color.blue;
+ repaint();
+ sleep(wait);
+ }
+ }
+}
diff --git a/examples/java/Pentomino.java b/examples/java/Pentomino.java
new file mode 100644
index 0000000..427431f
--- /dev/null
+++ b/examples/java/Pentomino.java
@@ -0,0 +1,135 @@
+import java.awt.*;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>Pentomino</code><br>
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ */
+public class Pentomino extends PrologFrame {
+ private PentominoPanel pentominoPanel;
+ private TextField M_Field;
+ private int M = 4;
+
+ public Pentomino() {
+ setSize(500, 400);
+ setBackground(Color.lightGray);
+ setLayout(new BorderLayout());
+ add("North", new Label("Pentominos Solver", Label.CENTER));
+ pentominoPanel = new PentominoPanel();
+ add("Center", pentominoPanel);
+ Panel p = new Panel();
+ add("South", p);
+ p.add(new Label("Rows="));
+ M_Field = new TextField("4", 2);
+ p.add(M_Field);
+ control = new PrologControlPanel(this);
+ p.add(control);
+ validate();
+ }
+
+ Term a1 = null;
+ Term a2 = null;
+ Predicate pentomino = null;
+
+ void sendArgument() {
+ try {
+ M = Integer.parseInt(M_Field.getText());
+ } catch (NumberFormatException e) {
+ M = 4;
+ M_Field.setText(Integer.toString(M));
+ }
+ this.prolog = new PrologControl();
+ a1 = new IntegerTerm(M);
+ a2 = new VariableTerm();
+ Term[] args = {a1,a2};
+ pentomino = new PRED_pentomino_applet_2();
+ prolog.setPredicate(pentomino, args);
+ }
+
+ void receiveResult() {
+ Term result = a2.dereference();
+ if ( !result.isList() ) {
+ System.out.println("Invalid result!");
+ return;
+ }
+ int Row, Col;
+ if (M == 8) {
+ Row = Col = 8;
+ }
+ else if (3 <= M && M <= 6) {
+ Row = M;
+ Col = (int)(60/M);
+ } else {
+ Row = 4;
+ Col = 15;
+ }
+ char pentomino[][] = new char[Row][Col];
+ Term elm;
+ try {
+ for (int i = 0; i < Row; i++) {
+ for (int j = 0; j < Col; j++) {
+ elm = ((ListTerm)result).car().dereference();
+ pentomino[i][j] = elm.toString().toCharArray()[0];
+ result = ((ListTerm)result).cdr().dereference();
+ }
+ }
+ } catch (Exception e) {
+ System.out.println("are?");
+ }
+ pentominoPanel.setPentomino(Row, Col, pentomino);
+ }
+
+ public static void main(String args[]) {
+ new Pentomino();
+ }
+}
+
+
+class PentominoPanel extends Panel {
+ private int M;
+ private int N;
+ private Color pentomino[][] = null;
+
+ public void setPentomino(int m, int n, char p[][]) {
+ M = m;
+ N = n;
+ pentomino = new Color[M][N];
+ for (int i = 0; i < M; i++) {
+ for (int j = 0; j < N; j++) {
+ Color c = Color.white;
+ switch (p[i][j]) {
+ case 'F': c = Color.blue; break;
+ case 'I': c = Color.green; break;
+ case 'L': c = Color.red; break;
+ case 'N': c = Color.cyan; break;
+ case 'P': c = Color.magenta; break;
+ case 'T': c = Color.yellow; break;
+ case 'U': c = Color.orange; break;
+ case 'V': c = Color.pink; break;
+ case 'W': c = Color.black; break;
+ case 'X': c = Color.gray; break;
+ case 'Y': c = new Color(64,128,128); break;
+ case 'Z': c = new Color(128,64,128); break;
+ }
+ pentomino[i][j] = c;
+ }
+ }
+ repaint();
+ }
+
+ public void paint(Graphics g) {
+ if (pentomino == null)
+ return;
+ int w = getSize().width;
+ int h = getSize().height;
+ w = w - 10;
+ h = h - 10;
+ int cellSize = Math.min(w/N, h/M);
+ int x0 = (w - N * cellSize) / 2 + 5;
+ int y0 = (h - M * cellSize) / 2 + 5;
+ for (int i = 0; i < M; i++)
+ for (int j = 0; j < N; j++) {
+ g.setColor(pentomino[i][j]);
+ g.fillRect(x0+j*cellSize, y0+i*cellSize, cellSize, cellSize);
+ }
+ }
+}
diff --git a/examples/java/PrologControlPanel.java b/examples/java/PrologControlPanel.java
new file mode 100644
index 0000000..b0a4fee
--- /dev/null
+++ b/examples/java/PrologControlPanel.java
@@ -0,0 +1,172 @@
+import java.awt.*;
+import java.awt.event.*;
+/**
+ * <code>PrologControlPanel</code><br>
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ */
+public class PrologControlPanel extends Panel implements ActionListener {
+ private PrologFrame prologFrame = null;
+ private Button startButton;
+ private Button nextButton;
+ private Button abortButton;
+ private Button quitButton;
+ private TextField message;
+ private int count = 0;
+ private int state;
+ public final int START = 1;
+ public final int WAIT = 2;
+ public final int NEXT = 3;
+ public final int DONE = 4;
+ public final int ERROR = 5;
+ public final int QUIT = 6;
+
+ public PrologControlPanel(PrologFrame _prologFrame) {
+ prologFrame = _prologFrame;
+ startButton = new Button("Start");
+ startButton.addActionListener(this);
+ nextButton = new Button("Next");
+ nextButton.addActionListener(this);
+ abortButton = new Button("Abort");
+ abortButton.addActionListener(this);
+ quitButton = new Button("Quit");
+ quitButton.addActionListener(this);
+ message = new TextField(20);
+ message.setEditable(false);
+ Panel p = new Panel();
+ p.add(startButton);
+ p.add(nextButton);
+ p.add(abortButton);
+ p.add(quitButton);
+ setLayout(new BorderLayout());
+ add("Center", p);
+ add("South", message);
+ validate();
+ setState(START);
+ }
+
+ public void close() {
+ if (prologFrame.prolog == null)
+ return;
+ prologFrame.prolog.stop();
+ prologFrame.prolog = null;
+ }
+
+ public synchronized int getState() {
+ return state;
+ }
+
+ private synchronized void setState(int s) {
+ switch (s) {
+ case START:
+ startButton.setEnabled(true);
+ startButton.requestFocus();
+ nextButton.setEnabled(false);
+ abortButton.setEnabled(false);
+ quitButton.setEnabled(true);
+ message.setText("");
+ break;
+ case WAIT:
+ startButton.setEnabled(false);
+ nextButton.setEnabled(false);
+ abortButton.setEnabled(true);
+ abortButton.requestFocus();
+ quitButton.setEnabled(true);
+ message.setText("Wait");
+ break;
+ case NEXT:
+ startButton.setEnabled(true);
+ nextButton.setEnabled(true);
+ nextButton.requestFocus();
+ abortButton.setEnabled(true);
+ quitButton.setEnabled(true);
+ message.setText("Count = " + count);
+ break;
+ case DONE:
+ startButton.setEnabled(true);
+ startButton.requestFocus();
+ nextButton.setEnabled(false);
+ abortButton.setEnabled(false);
+ quitButton.setEnabled(true);
+ message.setText("Count = " + count + " (no more)");
+ break;
+ case ERROR:
+ startButton.setEnabled(true);
+ nextButton.setEnabled(false);
+ abortButton.setEnabled(false);
+ quitButton.setEnabled(true);
+ quitButton.requestFocus();
+ message.setText("Error");
+ break;
+ case QUIT:
+ startButton.setEnabled(false);
+ nextButton.setEnabled(false);
+ abortButton.setEnabled(false);
+ quitButton.setEnabled(false);
+ message.setText("Bye");
+ break;
+ }
+ state = s;
+ repaint();
+ }
+
+ public synchronized void actionStart() {
+ prologFrame.sendArgument();
+ if (prologFrame.prolog == null)
+ setState(ERROR);
+ setState(WAIT);
+ if ( prologFrame.prolog.call() ) {
+ prologFrame.receiveResult();
+ count = 1;
+ setState(NEXT);
+ } else {
+ close();
+ setState(DONE);
+ count = 0;
+ }
+ }
+
+ public synchronized void actionNext() {
+ if (prologFrame.prolog == null)
+ setState(ERROR);
+ setState(WAIT);
+ if ( prologFrame.prolog.redo() ) {
+ prologFrame.receiveResult();
+ count++;
+ setState(NEXT);
+ } else {
+ close();
+ setState(DONE);
+ count = 0;
+ }
+ }
+
+ public synchronized void actionAbort() {
+ close();
+ setState(START);
+ }
+
+ public synchronized void actionQuit() {
+ close();
+ setState(QUIT);
+ }
+
+ public void actionPerformed(ActionEvent e){
+ String action = e.getActionCommand();
+ if (action.equals("Start"))
+ actionStart();
+ else if (action.equals("Next"))
+ actionNext();
+ else if (action.equals("Abort"))
+ actionAbort();
+ else if (action.equals("Quit"))
+ actionQuit();
+ else
+ super.processEvent(e);
+ }
+
+ public void paint(Graphics g) {
+ paintComponents(g);
+ }
+}
+
+
diff --git a/examples/java/PrologFrame.java b/examples/java/PrologFrame.java
new file mode 100644
index 0000000..1291e08
--- /dev/null
+++ b/examples/java/PrologFrame.java
@@ -0,0 +1,47 @@
+import java.awt.*;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>PrologFrame</code><br>
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ */
+public abstract class PrologFrame extends Frame implements Runnable {
+ PrologControlPanel control = null;
+ Thread frameThread = null;
+ PrologControl prolog = null;
+
+ public PrologFrame() {
+ frameThread = new Thread(this);
+ frameThread.start();
+ }
+
+ void sendArgument() {}
+
+ void receiveResult() {}
+
+ void aborted() {}
+
+ void quit() {
+ System.exit(0);
+ }
+
+ public void run() {
+ try {
+ Thread.sleep(500);
+ } catch (InterruptedException e) {}
+ setVisible(true);
+ while (Thread.currentThread() == frameThread) {
+ // repaint();
+ try {
+ Thread.sleep(500);
+ } catch (InterruptedException e) {}
+ int state = control.getState();
+ if (state == control.ABORT) {
+ aborted();
+ } else if (state == control.QUIT) {
+ break;
+ }
+ }
+ control.close();
+ quit();
+ }
+}
diff --git a/examples/java/Queens.java b/examples/java/Queens.java
new file mode 100644
index 0000000..82beb9d
--- /dev/null
+++ b/examples/java/Queens.java
@@ -0,0 +1,139 @@
+import java.awt.*;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>Queens</code><br>
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ */
+public class Queens extends PrologFrame {
+ private QueensPanel queensPanel;
+ private TextField N_Field;
+ private int N = 8;
+
+ public Queens() {
+ setSize(500,400);
+ setBackground(Color.lightGray);
+ setLayout(new BorderLayout());
+ add("North", new Label("N-Queens Solver", Label.CENTER));
+ queensPanel = new QueensPanel(N);
+ add("Center", queensPanel);
+ Panel p = new Panel();
+ add("South", p);
+ p.add(new Label("N="));
+ N_Field = new TextField(Integer.toString(N), 2);
+ p.add(N_Field);
+ control = new PrologControlPanel(this);
+ p.add(control);
+ validate();
+ }
+
+ Term a1 = null;
+ Term a2 = null;
+ Predicate nqueens = null;
+
+ void sendArgument() {
+ try {
+ N = Integer.parseInt(N_Field.getText());
+ } catch (NumberFormatException e) {
+ N = 1;
+ N_Field.setText(Integer.toString(N));
+ }
+ queensPanel.setN(N);
+ this.prolog = new PrologControl();
+ a1 = new IntegerTerm(N);
+ a2 = new VariableTerm();
+ Term[] args = {a1,a2};
+ nqueens = new PRED_queens_2();
+ prolog.setPredicate(nqueens, args);
+ }
+
+ void receiveResult() {
+ Term result = a2.dereference();
+ if ( !result.isList() || ((ListTerm)result).length() != N ){
+ System.out.println("Invalid result!");
+ return;
+ }
+ int queens[] = new int[N];
+ Term elm;
+ try {
+ for (int i = 0; i < N; i++) {
+ elm = ((ListTerm)result).car().dereference();
+ queens[i] = ((IntegerTerm)elm).intValue() - 1;
+ result = ((ListTerm)result).cdr();
+ /* System.out.println(queens[i]); */
+ }
+ } catch (Exception e){}
+ queensPanel.setQueens(queens);
+ }
+
+ public static void main(String args[]) {
+ new Queens();
+ }
+}
+
+class QueensPanel extends Panel {
+ private int N = 0;
+ private int queens[] = null;
+ private int cellSize = 0;
+ private Image boardImage = null;
+ private int boardN = 0;
+
+ public QueensPanel(int n) {
+ setN(n);
+ }
+
+ public void setN(int n) {
+ if (n > 0) {
+ N = n;
+ setQueens(null);
+ repaint();
+ }
+ }
+
+ public void setQueens(int q[]) {
+ queens = q;
+ repaint();
+ }
+
+ private void drawBoard(Graphics g, int x0, int y0) {
+ int size = N * cellSize;
+ if (boardImage == null || N != boardN
+ || boardImage.getWidth(null) != size
+ || boardImage.getHeight(null) != size) {
+ boardImage = createImage(size, size);
+ Graphics b = boardImage.getGraphics();
+ b.setColor(Color.white);
+ b.fillRect(0, 0, size, size);
+ b.setColor(Color.gray);
+ for (int i = 0; i < N; i++)
+ for (int j = 0; j < N; j++)
+ if ((i + j) % 2 == 1) {
+ b.fillRect(i*cellSize, j*cellSize, cellSize, cellSize);
+ }
+ boardN = N;
+ }
+ g.drawImage(boardImage, x0, y0, null);
+ }
+
+ public void paint(Graphics g) {
+ if (N < 1)
+ return;
+ int w = getSize().width;
+ int h = getSize().height;
+ cellSize = Math.min(w, h) / N;
+ int x0 = (w - N * cellSize) / 2;
+ int y0 = (h - N * cellSize) / 2;
+ drawBoard(g, x0, y0);
+ if (queens == null || N != queens.length)
+ return;
+ int d = (8*cellSize)/10;
+ g.setColor(Color.orange);
+ for (int i = 0; i < N; i++) {
+ int j = queens[i];
+ int x = x0 + i * cellSize + (cellSize - d) / 2;
+ int y = y0 + j * cellSize + (cellSize - d) / 2;
+ g.fillArc(x, y, d, d, 0, 360);
+ }
+ }
+}
+
+
diff --git a/examples/java/README b/examples/java/README
new file mode 100644
index 0000000..78f576a
--- /dev/null
+++ b/examples/java/README
@@ -0,0 +1,25 @@
+################################################################
+ README
+################################################################
+
+This directory contains some demonstrations of calling Prolog from
+Java.
+
+* Knight tour
+
+ % java -cp .:knight.jar:$PLCAFEDIR/plcafe.jar Knight
+
+* Peg solitaire
+
+ % java -cp .:peg.jar:$PLCAFEDIR/plcafe.jar Peg
+
+* Pentomino puzzle
+
+ % java -cp .:pentomino.jar:$PLCAFEDIR/plcafe.jar Pentomino
+
+* N-Queens puzzle
+
+ % java -cp .:queens.jar:$PLCAFEDIR/plcafe.jar Queens
+
+--
+Mutsunori BANBARA
diff --git a/examples/java/knight.pl b/examples/java/knight.pl
new file mode 120000
index 0000000..3d4f07a
--- /dev/null
+++ b/examples/java/knight.pl
@@ -0,0 +1 @@
+../prolog/knight.pl
\ No newline at end of file
diff --git a/examples/java/peg.pl b/examples/java/peg.pl
new file mode 120000
index 0000000..20e6937
--- /dev/null
+++ b/examples/java/peg.pl
@@ -0,0 +1 @@
+../prolog/peg.pl
\ No newline at end of file
diff --git a/examples/java/pentomino.pl b/examples/java/pentomino.pl
new file mode 120000
index 0000000..e847184
--- /dev/null
+++ b/examples/java/pentomino.pl
@@ -0,0 +1 @@
+../prolog/pentomino.pl
\ No newline at end of file
diff --git a/examples/java/queens.pl b/examples/java/queens.pl
new file mode 120000
index 0000000..8e7e6df
--- /dev/null
+++ b/examples/java/queens.pl
@@ -0,0 +1 @@
+../prolog/queens.pl
\ No newline at end of file
diff --git a/examples/plcafe/Makefile b/examples/plcafe/Makefile
new file mode 100644
index 0000000..3dd0348
--- /dev/null
+++ b/examples/plcafe/Makefile
@@ -0,0 +1,29 @@
+################################################################
+# Makefile for Prolog Cafe
+################################################################
+
+################################################################
+PLJAVAC = pljavac
+PLJAVACOPTS = -v
+
+PLJAR = pljar
+PLJAROPTS = -v
+################################################################
+.SUFFIXES:
+.SUFFIXES: .jar .pl $(SUFFIXES)
+
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+all: $(jar_objects)
+ $(PLJAVAC) $(PLJAVACOPTS) -cp queens.jar T.java
+
+clean:
+ -rm -f core *~
+
+realclean: clean
+ -rm -f *.jar *.class
+
diff --git a/examples/plcafe/T.java b/examples/plcafe/T.java
new file mode 100644
index 0000000..c0fa287
--- /dev/null
+++ b/examples/plcafe/T.java
@@ -0,0 +1,62 @@
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * A sample program for multi-thread execution.<br>
+ * Usage: <br>
+ * <pre>
+ * % plcafe -cp queens.jar T
+ * </pre>
+ *
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ */
+public class T {
+ public static void main(String args[]) {
+ long t = System.currentTimeMillis();
+ boolean r1 = true;
+ boolean r2 = true;
+ Term a1[] = {new IntegerTerm(10), new VariableTerm()};
+ Term a2[] = {new IntegerTerm(8), new VariableTerm()};
+
+ PrologControl e1 = new PrologControl();
+ PrologControl e2 = new PrologControl();
+ Term v1 = new VariableTerm();
+ Term v2 = new VariableTerm();
+ e1.setPredicate(new PRED_queens_2(), a1);
+ e2.setPredicate(new PRED_queens_2(), a2);
+ System.out.println("Start");
+ e1.start();
+ e2.start();
+ while (r1 || r2) {
+ try {
+ Thread.sleep(10);
+ } catch (InterruptedException e) {}
+ if (r1 && e1.ready()) {
+ r1 = e1.next();
+ if (r1) {
+ System.out.println("Success1 = " + a1[1]);
+ e1.cont();
+ } else {
+ System.out.println("Fail1");
+ }
+ } else if (r2 && e2.ready()) {
+ r2 = e2.next();
+ if (r2) {
+ System.out.println("Success2 = " + a2[1]);
+ e2.cont();
+ } else {
+ System.out.println("Fail2");
+ }
+ } else {
+ System.out.println("Waiting");
+ try {
+ Thread.sleep(100);
+ } catch (InterruptedException e) {}
+ }
+ }
+ System.out.println("End");
+ long t1 = System.currentTimeMillis();
+ long t2 = t1 - t;
+ System.out.println("time = " + t2 + "msec.");
+
+ }
+}
diff --git a/examples/plcafe/border_layout.pl b/examples/plcafe/border_layout.pl
new file mode 100644
index 0000000..80a7dc1
--- /dev/null
+++ b/examples/plcafe/border_layout.pl
@@ -0,0 +1,36 @@
+% File : border_layout.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 15 May 2008
+% Purpose: java.awt.BorderLayout
+% Usage :
+% % plcafe -cp border_layout.jar
+% ?- main.
+
+main :-
+ java_constructor('java.awt.Frame', X),
+ java_get_field('java.awt.Color', blue, Blue),
+ java_get_field('java.awt.Color', white, White),
+ java_method(X, setSize(300,200), _),
+ java_method(X, setBackground(Blue), _),
+ java_method(X, setForeground(White), _),
+ java_method(X, setTitle('Prolog Cafe'), _),
+ java_constructor('java.awt.BorderLayout', Border),
+ java_method(X, setLayout(Border), _),
+ java_get_field('java.awt.Font', 'BOLD', Bold),
+ java_constructor('java.awt.Font'('Helvetica', Bold, 12), F1),
+ java_method(X, setFont(F1), _),
+ java_constructor('java.awt.Button'('A Prolog to Java Translator'), B1),
+ java_constructor('java.awt.Button'('Prolog Cafe'), B2),
+ java_constructor('java.awt.Button'('Prolog'), B3),
+ java_constructor('java.awt.Button'('Java'), B4),
+ java_constructor('java.awt.Button'('produced by M.Banbara and N.Tamura'), B5),
+ java_method(X, add('North', B1),_),
+ java_method(X, add('Center', B2),_),
+ java_method(X, add('West', B3),_),
+ java_method(X, add('East', B4),_),
+ java_method(X, add('South', B5),_),
+ java_get_field('java.lang.Boolean', 'TRUE', True),
+ java_method(X, setVisible(True), _).
+
+
+
diff --git a/examples/plcafe/frame.pl b/examples/plcafe/frame.pl
new file mode 100644
index 0000000..a77e87a
--- /dev/null
+++ b/examples/plcafe/frame.pl
@@ -0,0 +1,16 @@
+% File : frame.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 14 February 2008
+% Purpose: java.awt.Frame
+% Usage :
+% % plcafe -cp frame.jar
+% ?- main.
+
+main :-
+ java_constructor('java.awt.Frame', X),
+ java_method(X, setSize(200,200), _),
+ java_get_field('java.lang.Boolean', 'TRUE', True),
+ java_method(X, setVisible(True), _).
+
+
+
diff --git a/examples/plcafe/paint.pl b/examples/plcafe/paint.pl
new file mode 100644
index 0000000..a5e88ec
--- /dev/null
+++ b/examples/plcafe/paint.pl
@@ -0,0 +1,325 @@
+% File : paint.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 15 May 2008
+% Purpose: Graphics
+% Usage :
+% % plcafe -cp paint.jar
+% ?- main.
+% or
+% % plcafe -cp paint.jar -t main
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Main
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+main :-
+ start,
+ repeat,
+ write('Simple Graphical Examples (bye. to quit)'), nl,
+ tab(4), write('Example: ex1.'), nl,
+ tab(4), write('Example: ex2.'), nl,
+ tab(4), write('Example: ex3.'), nl, nl,
+ write('|: '), flush_output,
+ read(Cmd),
+ do(Cmd),
+ !.
+
+do(X) :- var(X), !, fail.
+do(bye) :- !, stop.
+do(quit) :- !, stop.
+do(end_of_file) :- !, stop.
+do(Cmd) :-
+ statistics(runtime, _),
+ call(Cmd),
+ statistics(runtime, [_,T]),
+ tab(3), write('Time = '), write(T), write(' msec'), nl, nl,
+ fail.
+
+%%% Example 1
+ex1 :- init, ex1(30).
+
+ex1(N) :-
+ integer(N),
+ R is random*255,
+ G is random*255,
+ B is random*255,
+ setColor(rgb(R,G,B)),
+ getCenter(Cx, Cy),
+ for(I, -N, N),
+ X1 is Cx+I*5,
+ Y1 is Cy+N*5,
+ X2 is Cx+N*5,
+ Y2 is Cy-I*5,
+ drawLine(X1, Y1, X2, Y2),
+ A1 is Cx-I*5,
+ B1 is Cy-N*5,
+ A2 is Cx-N*5,
+ B2 is Cy+I*5,
+ drawLine(A1, B1, A2, B2),
+ fail.
+ex1(_).
+
+%%% Example 2
+ex2 :- init, ex2(6).
+
+ex2(N) :-
+ integer(N),
+ for(I, 1, N),
+ M is I*5,
+ ex1(M),
+ fail.
+ex2(_).
+
+%%% Example 3
+ex3 :- init, ex3(100).
+
+ex3(N) :-
+ integer(N),
+ getCenter(Cx, Cy),
+ R is random*255,
+ G is random*255,
+ B is random*255,
+ setColor(rgb(R,G,B)),
+ for(I, 1, N),
+ X is round(Cx-I*3/2),
+ Y is round(Cy-I*3/2),
+ W is I*3,
+ H is I*3,
+ drawOval(X, Y, W, H),
+ fail.
+ex3(X).
+
+%%% Utilities
+for(I, I, N) :- I =< N.
+for(I, J, N) :- J < N, J1 is J+1, for(I, J1, N).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Start, Init, and Stop
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- dynamic current_image/1, current_canvas/1, current_frame/1.
+:- dynamic current_color/2, current_font/3.
+
+start :- start(350, 350), init.
+
+start(Width, Height) :-
+ integer(Width),
+ integer(Height),
+ retractall(current_frame(_)),
+ retractall(current_canvas(_)),
+ retractall(current_image(_)),
+ retractall(current_color(_,_)),
+ retractall(current_font(_,_,_)),
+ java_constructor('java.awt.Frame', Frame),
+ java_constructor('java.awt.BorderLayout', Border),
+ java_method(Frame, setLayout(Border), _),
+ java_method(Frame, setSize(Width,Height), _),
+ java_method(Frame, setTitle('Simple Graphical Examples'), _),
+ java_constructor('java.awt.Canvas', Canvas),
+ java_method(Frame, add('Center', Canvas), _),
+ java_get_field('java.lang.Boolean', 'TRUE', True),
+ java_method(Frame, setVisible(True), _),
+ java_method(Canvas, getWidth, CW),
+ java_method(Canvas, getHeight, CH),
+ java_method(Canvas, createImage(CW,CH), Image),
+ assertz(current_frame(Frame)),
+ assertz(current_canvas(Canvas)),
+ assertz(current_image(Image)).
+
+init :-
+ setColor(black),
+ setBackground(white),
+ setFont(dialog, italic, 12),
+ getSize(W, H),
+ clearRect(0, 0, W, H).
+
+stop :-
+ current_frame(Frame),
+ java_get_field('java.lang.Boolean', 'FALSE', F),
+ java_method(Frame, setVisible(F), _).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Size
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+getHeight(X) :-
+ current_canvas(C),
+ java_method(C, getHeight, X).
+
+getWidth(X) :-
+ current_canvas(C),
+ java_method(C, getWidth, X).
+
+getCenter(X, Y) :-
+ getWidth(W),
+ getHeight(H),
+ X is (W+1)//2,
+ Y is (H+1)//2.
+
+getSize(X, Y) :-
+ getWidth(X),
+ getHeight(Y).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Graphics
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_graphics(Gra, Canvas) :-
+ current_canvas(Canvas),
+ java_method(Canvas, getGraphics, Gra).
+
+get_image_graphics(ImgGra, Image) :-
+ current_image(Image),
+ java_method(Image, getGraphics, ImgGra).
+
+paint(Function) :-
+ get_graphics(Gra, Canvas),
+ get_image_graphics(ImgGra, Image),
+ java_method(Gra, Function, _),
+ java_method(ImgGra, Function, _),
+ java_method(Gra, drawImage(Image,0,0,Canvas), _).
+
+repaint :-
+ get_graphics(Gra, Canvas),
+ get_image_graphics(_, Image),
+ java_method(Gra, drawImage(Image,0,0,Canvas), _).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Drawing Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+clearRect(X, Y, Width, Height) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ paint(clearRect(X,Y,Width,Height)).
+
+drawLine(X1, Y1, X2, Y2) :-
+ integer(X1), integer(Y1), integer(X2), integer(Y2),
+ paint(drawLine(X1,Y1,X2,Y2)).
+
+drawString(Str, X, Y) :-
+ atom(Str), integer(X), integer(Y),
+ paint(drawString(Str,X,Y)).
+
+drawOval(X, Y, Width, Height) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ paint(drawOval(X,Y,Width,Height)).
+
+fill3DRect(X, Y, Width, Height, Raise) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ boolean_map(Raise, Bool),
+ paint(fill3DRect(X,Y,Width,Height,Bool)).
+
+drawRect(X, Y, Width, Height) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ paint(drawRect(X,Y,Width,Height)).
+
+fillRect(X, Y, Width, Height) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ paint(fillRect(X,Y,Width,Height)).
+
+draw3DRect(X, Y, Width, Height, Raise) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ boolean_map(Raise, Bool),
+ paint(draw3DRect(X,Y,Width,Height,Bool)).
+
+fillOval(X, Y, Width, Height) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ paint(fillOval(X,Y,Width,Height)).
+
+drawArc(X, Y, Width, Height, StartAngle, ArcAngle) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ integer(StartAngle), integer(ArcAngle),
+ paint(drawArc(X,Y,Width,Height,StartAngle,ArcAngle)).
+
+fillArc(X, Y, Width, Height, StartAngle, ArcAngle) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ integer(StartAngle), integer(ArcAngle),
+ paint(fillArc(X,Y,Width,Height,StartAngle,ArcAngle)).
+
+drawRoundRect(X, Y, Width, Height, ArcWidth, ArcHeight) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ integer(ArcWidth), integer(ArcHeight),
+ paint(drawRoundRect(X,Y,Width,Height,ArcWidth,ArcHeight)).
+
+fillRoundRect(X, Y, Width, Height, ArcWidth, ArcHeight) :-
+ integer(X), integer(Y), integer(Width), integer(Height),
+ integer(ArcWidth), integer(ArcHeight),
+ paint(fillRoundRect(X,Y,Width,Height,ArcWidth,ArcHeight)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Color
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+setColor(Co) :- color_map(Co, Obj), !,
+ current_canvas(Canvas),
+ java_method(Canvas, setForeground(Obj), _),
+ retractall(current_color(_,_)),
+ assertz(current_color(Co, Obj)).
+setColor(Co) :-
+ findall(Co, color(Co), Domain),
+ throw(domain_error(setColor(Co),1,['rgb(R,G,B)'|Domain],Co)).
+
+setBackground(Co) :- color_map(Co, Obj), !,
+ current_canvas(Canvas),
+ java_method(Canvas, setBackground(Obj), _).
+setBackground(Co) :-
+ findall(Co, color(Co), Domain),
+ throw(domain_error(setBackground(Co),1,['rgb(R,G,B)'|Domain],Co)).
+
+color_map(Co, Obj) :- color(Co), !,
+ java_get_field('java.awt.Color', Co, Obj).
+color_map(Co, Obj) :-
+ Co = rgb(X,Y,Z),
+ R is round(X), 0 =< R, R =< 255,
+ G is round(Y), 0 =< G, G =< 255,
+ B is round(Z), 0 =< B, B =< 255,
+ !,
+ java_constructor('java.awt.Color'(R,G,B), Obj).
+
+color(black).
+color(blue).
+color(cyan).
+color(darkGray).
+color(gray).
+color(green).
+color(lightGray).
+color(magenta).
+color(orange).
+color(pink).
+color(red).
+color(white).
+color(yellow).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Font
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+setFont(Font, Style, Size) :- font_map(Font, Style, Size, Obj), !,
+ current_canvas(Canvas),
+ java_method(Canvas, setFont(Obj), _),
+ retractall(current_font(_,_,_)),
+ assertz(current_font(Font,Style,Size)).
+setFont(Font, Style, Size) :-
+ findall(F, font(F), Domain),
+ throw(domain_error(setFont(Font, Style, Size),1,Domain,Font)).
+
+font_map(Font, Style, Size, Obj) :-
+ integer(Size),
+ font(Font, F),
+ font_style(Style, St),
+ java_constructor('java.awt.Font'(F, St, Size), Obj).
+
+font(helvetica, 'Helvetica').
+font(times_roman, 'TimesRoman').
+font(courier, 'Courier').
+font(dialog, 'Dialog').
+font(dialog_input, 'DialogInput').
+
+font_style(plain, 0).
+font_style(bold, 1).
+font_style(italic, 2).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Boolean
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+boolean_map(Bool, Obj) :-
+ boolean(Bool, B),
+ java_get_field('java.lang.Boolean', B, Obj).
+
+boolean(true, 'TRUE').
+boolean(false, 'FALSE').
+
+%%% END
diff --git a/examples/plcafe/queens.pl b/examples/plcafe/queens.pl
new file mode 100644
index 0000000..8b21eb1
--- /dev/null
+++ b/examples/plcafe/queens.pl
@@ -0,0 +1,31 @@
+% File : queens.pl
+% Updated: 14 February 2008
+% Purpose: N-Queen Puzzle (posed by Franz Nauch, 1850)
+
+queens(N,Qs) :-
+ range(1,N,Ns),
+ queens(Ns,[],Qs).
+
+queens([],Qs,Qs).
+queens(UnplacedQs,SafeQs,Qs) :-
+ select(UnplacedQs,UnplacedQs1,Q),
+ not_attack(SafeQs,Q),
+ queens(UnplacedQs1,[Q|SafeQs],Qs).
+
+not_attack(Xs,X) :-
+ not_attack(Xs,X,1).
+
+not_attack([],_,_) :- !.
+not_attack([Y|Ys],X,N) :-
+ X =\= Y+N, X =\= Y-N,
+ N1 is N+1,
+ not_attack(Ys,X,N1).
+
+select([X|Xs],Xs,X).
+select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X).
+
+range(N,N,[N]) :- !.
+range(M,N,[M|Ns]) :-
+ M < N,
+ M1 is M+1,
+ range(M1,N,Ns).
diff --git a/examples/plcafe/thread.pl b/examples/plcafe/thread.pl
new file mode 100644
index 0000000..05cf53e
--- /dev/null
+++ b/examples/plcafe/thread.pl
@@ -0,0 +1,84 @@
+% File : thread.pl
+% Authors: Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 26 May 2008
+% Purpose: Multi-thread execution
+% Usage :
+% % plcafe -cp queens.jar
+% ?- [thread].
+% ?- main.
+% or
+% % plcafe -cp thread.jar:queens.jar
+% ?- main.
+
+main :-
+ statistics(runtime, _),
+ start,
+ statistics(runtime, [_,T]),
+ write('Time = '), write(T),
+ write(' msec.'), nl.
+
+start :-
+ G1 = (queens(10, X), write(X), nl),
+ msg(start1 = G1),
+ start(G1, E1),
+ G2 = (queens(8, Y), write(Y), nl),
+ msg(start2 = G2),
+ start(G2, E2),
+ loop(G1, E1, G2, E2),
+ stop(E1),
+ stop(E2),
+ msg(end).
+
+loop(G1, E1, G2, E2) :-
+ in_failure(E1),
+ in_failure(E2),
+ !.
+loop(G1, E1, G2, E2) :-
+ in_success(E1),
+ !,
+ cont(E1),
+ loop(G1, E1, G2, E2).
+loop(G1, E1, G2, E2) :-
+ in_success(E2),
+ !,
+ cont(E2),
+ loop(G1, E1, G2, E2).
+loop(G1, E1, G2, E2) :-
+ msg(waiting),
+ sleep(5),
+ loop(G1, E1, G2, E2).
+
+msg(Msg) :-
+ write(Msg), nl, flush_output.
+
+%%
+%% Utilities
+%%
+start(G, Engine) :-
+ java_constructor0('jp.ac.kobe_u.cs.prolog.lang.PrologControl', Engine),
+ java_method0(Engine, setPredicate(G), _),
+ java_method0(Engine, start, _).
+
+in_success(Engine) :-
+ java_get_field0('java.lang.Boolean', 'TRUE', T),
+ java_method(Engine, in_success, T).
+
+in_failure(Engine) :-
+ java_get_field0('java.lang.Boolean', 'TRUE', T),
+ java_method(Engine, in_failure, T).
+
+ready(Engine) :-
+ java_get_field0('java.lang.Boolean', 'TRUE', T),
+ java_method(Engine, ready, T).
+
+cont(Engine) :- java_method0(Engine, cont, _).
+
+join(Engine) :- java_method0(Engine, join, _).
+
+stop(Engine) :- java_method0(Engine, stop, _).
+
+sleep(N) :- java_method('java.lang.Thread', sleep(N), _).
+
+%result(Engine, Result) :- java_method0(Engine, next, Result).
+
diff --git a/examples/plcafe/thread2.pl b/examples/plcafe/thread2.pl
new file mode 100644
index 0000000..509e418
--- /dev/null
+++ b/examples/plcafe/thread2.pl
@@ -0,0 +1,66 @@
+% File : thread2.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Updated: 26 May 2008
+% Purpose: Multi-thread execution
+% Usage :
+% % plcafe -cp queens.jar
+% ?- [thread2].
+% ?- main.
+% or
+% % plcafe -cp thread2.jar:queens.jar
+% ?- main.
+
+main :-
+ statistics(runtime, _),
+ start,
+ statistics(runtime, [_,T]),
+ write('Time = '), write(T),
+ write(' msec.'), nl.
+
+start :-
+ G1 = (queens(10, X), write(X), nl, fail),
+ msg(start1 = G1),
+ start(G1, E1),
+ G2 = (queens(8, Y), write(Y), nl, fail),
+ msg(start2 = G2),
+ start(G2, E2),
+ join(E1),
+ join(E2),
+ stop(E1),
+ stop(E2),
+ msg(end).
+
+msg(Msg) :-
+ write(Msg), nl, flush_output.
+
+%%
+%% Utilities
+%%
+start(G, Engine) :-
+ java_constructor0('jp.ac.kobe_u.cs.prolog.lang.PrologControl', Engine),
+ java_method0(Engine, setPredicate(G), _),
+ java_method0(Engine, start, _).
+
+in_success(Engine) :-
+ java_get_field0('java.lang.Boolean', 'TRUE', T),
+ java_method(Engine, in_success, T).
+
+in_failure(Engine) :-
+ java_get_field0('java.lang.Boolean', 'TRUE', T),
+ java_method(Engine, in_failure, T).
+
+ready(Engine) :-
+ java_get_field0('java.lang.Boolean', 'TRUE', T),
+ java_method(Engine, ready, T).
+
+cont(Engine) :- java_method0(Engine, cont, _).
+
+join(Engine) :- java_method0(Engine, join, _).
+
+stop(Engine) :- java_method0(Engine, stop, _).
+
+sleep(N) :- java_method('java.lang.Thread', sleep(N), _).
+
+%result(Engine, Result) :- java_method0(Engine, next, Result).
+
diff --git a/examples/prolog/Makefile b/examples/prolog/Makefile
new file mode 100644
index 0000000..ebf843d
--- /dev/null
+++ b/examples/prolog/Makefile
@@ -0,0 +1,28 @@
+################################################################
+# Makefile for Prolog Cafe
+################################################################
+
+################################################################
+PLJAVAC = pljavac
+PLJAVACOPTS = -v
+
+PLJAR = pljar
+PLJAROPTS = -v
+################################################################
+.SUFFIXES:
+.SUFFIXES: .jar .pl $(SUFFIXES)
+
+jar_objects := $(patsubst %.pl,%.jar,$(wildcard *.pl))
+
+.pl.jar:
+ $(PLJAR) $(PLJAROPTS) $@ $<
+ -rm -f -r $*
+
+all: $(jar_objects)
+
+clean:
+ -rm -f core *~
+
+realclean: clean
+ -rm -f *.jar *.class
+
diff --git a/examples/prolog/knight.pl b/examples/prolog/knight.pl
new file mode 100644
index 0000000..06dd9ca
--- /dev/null
+++ b/examples/prolog/knight.pl
@@ -0,0 +1,199 @@
+% File : knight.pl
+% Authors: Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 26 May 2008
+% Purpose: Knight's Tour (posed by Brook Taylor, 18C)
+% Note : Each position (I,J) on the board N*N
+% is indexed by (N+2)*(I-1)+J-1
+
+/*
+| ?- main.
+Finds a Knight's Tour (N>=8 takes a long time...)
+N = 8.
+
+ 1 12 9 6 3 14 17 20
+ 10 7 2 13 18 21 4 15
+ 31 28 11 8 5 16 19 22
+ 64 25 32 29 36 23 48 45
+ 33 30 27 24 49 46 37 58
+ 26 63 52 35 40 57 44 47
+ 53 34 61 50 55 42 59 38
+ 62 51 54 41 60 39 56 43
+
+yes
+*/
+
+:- dynamic n/1, corner/1, next_K/1.
+
+main :-
+ write('Finds a Knight''s Tour (N>=8 takes a long time...)'), nl,
+ write('N = '),
+ flush_output,
+ read(N),
+ statistics(runtime, _),
+ knight_tour(N),
+ statistics(runtime, [_,T]),
+ nl,
+ write('CPU time = '), write(T), write(' msec'), nl,
+ !.
+
+knight_tour(N) :-
+ knight_init(N),
+ gen_res(L),
+ solve(1, 1, L),
+ write_board(L).
+
+knight_init(N) :-
+ retractall(n(_)),
+ retractall(corner(_)),
+ retractall(next_K(_)),
+ assertz(n(N)).
+
+% gen_res/1 creates resources k/2 as a list, and asserts corner/1 and next_K/1.
+% - k(K, _) for K = (N+2)*(I-1)+J-1, I = 1..N, J = 1..N
+% - corner(K) for K = (N+2)*(I-1)+J-1, I = 1,N, J = 1,N
+% - next_K(DK) for DK = (N+2)*DI+DJ, (DI,DJ) = (+-2,+-1),(+-1,+-2)
+
+gen_res(L) :- gen_res(1, 1, L).
+
+gen_res(I, _, []) :- clause(n(N), _), I > N, !,
+ calc_K(1, 1, C1),
+ calc_K(1, N, C2),
+ calc_K(N, 1, C3),
+ calc_K(N, N, C4),
+ calc_DK(-2, -1, DK1),
+ calc_DK(-2, 1, DK2),
+ calc_DK(-1, -2, DK3),
+ calc_DK(-1, 2, DK4),
+ calc_DK( 1, -2, DK5),
+ calc_DK( 1, 2, DK6),
+ calc_DK( 2, -1, DK7),
+ calc_DK( 2, 1, DK8),
+ assertz(corner(C1)),
+ assertz(corner(C2)),
+ assertz(corner(C3)),
+ assertz(corner(C4)),
+ assertz(next_K(DK1)),
+ assertz(next_K(DK2)),
+ assertz(next_K(DK3)),
+ assertz(next_K(DK4)),
+ assertz(next_K(DK5)),
+ assertz(next_K(DK6)),
+ assertz(next_K(DK7)),
+ assertz(next_K(DK8)).
+gen_res(I, J, L) :- clause(n(N), _), J > N, !,
+ I1 is I + 1,
+ gen_res(I1, 1, L).
+gen_res(I, J, [k(K, _)|L]) :-
+ clause(n(N), _),
+ I =< N, J =< N,
+ calc_K(I, J, K),
+ J1 is J + 1,
+ gen_res(I, J1, L).
+
+% solve(+I, +J, +R) finds knight tour starting from the position (I,J).
+% R is a list of k(Index, Step).
+solve(I, J, R) :-
+ clause(n(N), _),
+ Step = 1,
+ calc_K(I, J, K),
+ del_res(k(K,Step), R, R0),
+ solve(Step, N, K, R0).
+
+solve(Step, N, _, []) :-
+ Step >= N*N,
+ !.
+solve(Step, N, K, R) :-
+ Step < N*N,
+ check(Step, N, R),
+ Step1 is Step + 1,
+ next(K, K1, R),
+ del_res(k(K1,Step1), R, R0),
+ solve(Step1, N, K1, R0).
+
+del_res(X, [X|Xs], Xs).
+del_res(X, [Y|Ys], [Y|Zs]) :- del_res(X, Ys, Zs).
+
+check(Step, N, R) :-
+ (Step mod 4 =:= 0, Step < N*N-1
+ -> \+ isolate_one(_, R)
+ ; true),
+ !.
+
+isolate_one(K, R) :-
+ del_res(k(K, _), R, _),
+ \+ (next0(K, K1), del_res(k(K1, _), R, _)).
+
+% if current is a corner, it's ok
+next(K, K1, _) :-
+ clause(corner(K), _),
+ !,
+ next0(K, K1).
+% if the next can be a not-visitied corner, it should be selected
+next(K, K1, R) :-
+ next0(K, K1),
+ clause(corner(K1), _),
+ not_visited(K1, R),
+ !.
+% otherwise
+next(K, K1, _) :- next0(K, K1).
+
+next0(K, K1) :- clause(next_K(DK), _), K1 is K + DK.
+
+not_visited(K, R) :- \+ \+ del_res(k(K, _), R, _).
+
+calc_K(I, J, K) :- clause(n(N), _), K is (N+2)*(I-1)+(J-1).
+
+calc_DK(DI, DJ, DK) :- clause(n(N), _), DK is (N+2)*DI+DJ.
+
+
+% write_board(L) writes step numbers S for each I = 1..N, J = 1..N
+write_board(L) :-
+ clause(n(N), _),
+ for(I, 1, N),
+ nl,
+ for(J, 1, N),
+ calc_K(I, J, K),
+ member(k(K, Step), L),
+ write_number(Step),
+ fail.
+write_board(_) :- nl.
+
+for(M, M, N) :- M =< N.
+for(I, M, N) :- M =< N, M1 is M + 1, for(I, M1, N).
+
+write_number(C) :- C < 10, !, write(' '), write(C).
+write_number(C) :- write(' '), write(C).
+
+member(X, [X|_]).
+member(X, [_|Xs]) :- member(X, Xs).
+
+
+%%%
+knight_tour_applet(N, Ans) :-
+ knight_init(N),
+ gen_res(L),
+ solve(1, 1, L),
+ get_step(L, Ans).
+
+get_step(L, A) :-
+ clause(n(N), _),
+ get_step(1, 1, N, L, A).
+
+get_step(I, _, N, _, []) :-
+ I > N,
+ !.
+get_step(I, J, N, L, A) :- J > N, !,
+ I1 is I+1,
+ get_step(I1, 1, N, L, A).
+get_step(I, J, N, L, [Step|A]) :-
+ I =< N, J =< N,
+ calc_K(I, J, K),
+ member(k(K,Step), L),
+ !,
+ J1 is J+1,
+ get_step(I, J1, N, L, A).
+
+
+
+
diff --git a/examples/prolog/komachi.pl b/examples/prolog/komachi.pl
new file mode 100644
index 0000000..d38e527
--- /dev/null
+++ b/examples/prolog/komachi.pl
@@ -0,0 +1,61 @@
+% File : komachi.pl
+% Authors: Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Updated: 10 March 2008
+% Purpose: Solve komachi-zan
+
+main :-
+ write('Komachi-zan'), nl,
+ write('N = '),
+ flush_output,
+ read(N),
+ N > 0,
+ read_yn('All solutions (y/n)? ', All),
+ read_yn('Output (y/n)? ', Output),
+ statistics(runtime, _),
+ komachi_solve(N, all(All), output(Output)),
+ statistics(runtime, [_,T]),
+ write('CPU time = '), write(T), write(' msec'), nl.
+
+read_yn(Message, YN) :-
+ write(Message),
+ flush_output,
+ read(X),
+ (X == 'y' -> YN = yes; YN = no).
+
+komachi_solve(N, all(X), output(Y)) :-
+ komachi(N, E),
+ (Y == yes -> write(E=N), nl; true),
+ X == no,
+ !.
+komachi_solve(_,_,_).
+
+komachi(N, E) :-
+ generate(9, E),
+ eval(E, N).
+
+generate(I, E) :-
+ I > 0,
+ gen_num(M, I, I1),
+ gen_next(I1, M, E).
+
+gen_num(I0, I0, I) :-
+ I0 > 0,
+ I is I0-1.
+gen_num(M, I0, I) :-
+ I0 > 0,
+ I1 is I0-1,
+ gen_num(M0, I1, I),
+ M is 10*M0 + I0.
+
+gen_next(0, M, M ).
+gen_next(0, M, E ) :- E is -M.
+gen_next(I, M, E+M) :- I > 0, generate(I, E).
+gen_next(I, M, E-M) :- I > 0, generate(I, E).
+gen_next(I, M, E*M) :- I > 0, generate(I, E).
+
+% Evaluates arithmethic expression
+eval(E, N) :- N is E.
+
+% for(I, Start, End, Inc)
+for(M, M, N, _) :- M =< N.
+for(I, M, N, S) :- M =< N, M1 is M+S, for(I, M1, N, S).
diff --git a/examples/prolog/list.pl b/examples/prolog/list.pl
new file mode 100644
index 0000000..223f56e
--- /dev/null
+++ b/examples/prolog/list.pl
@@ -0,0 +1,15 @@
+% File : list.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Updated: 14 February 2008
+% Purpose: List processing
+
+append([], Zs, Zs).
+append([X|Xs], Ys, [X|Zs]) :- append(Xs, Ys, Zs).
+
+nrev([], []).
+nrev([X|Xs], Y) :-
+ nrev(Xs, Ys), append(Ys, [X], Y).
+
+range(I, N, []) :- I > N, !.
+range(I, N, [I|L]) :- I =< N, I1 is I+1, range(I1, N, L).
+
diff --git a/examples/prolog/maketen.pl b/examples/prolog/maketen.pl
new file mode 100644
index 0000000..0f55a73
--- /dev/null
+++ b/examples/prolog/maketen.pl
@@ -0,0 +1,214 @@
+% File : maketen.pl
+% Authors: Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Updated: 14 February 2008
+% Purpose: Make 10 from given 4 numbers
+% Notes : Slightly changed by M.Banbara
+
+
+%%
+%% Make 10 from given 4 numbers
+%%
+
+%% Examples
+%% [1,1,5,8] 10=8/(1-1/5)
+%% [1,1,9,9] 10=9*(1/9+1)
+%% [3,4,7,8] 10=8*(3-7/4)
+%% [5,5,5,7] 10=7*5-5*5
+%% [9,9,9,9] 10=(9*9+9)/9
+ex :-
+ make_number([1,1,5,8], 10),
+ make_number([1,1,9,9], 10),
+ make_number([3,4,7,8], 10),
+ make_number([5,5,5,7], 10),
+ make_number([9,9,9,9], 10).
+
+%% ¤¹¤Ù¤Æ¤Î4¿ô»ú¤Ë¤Ä¤¤¤ÆÄ´¤Ù¤ë
+make_ten_all :-
+ make_number_all(10).
+
+make_number_all(N) :-
+ for(I, 0, 9),
+ for(J, I, 9),
+ for(K, J, 9),
+ for(L, K, 9),
+% make_number([I,J,K,L], N),
+ make_number_x([I,J,K,L], N),
+ fail.
+make_number_all(_).
+
+make_number(Ds, N) :-
+ write(Ds), write(' '),
+ make_num(Ds, N, E),
+ write(N=E), nl,
+ !.
+make_number(_, _) :-
+ write(fail), nl.
+
+make_number_x(Ds, N) :-
+ write('Make '), write(N), write(' from '),
+ write(Ds), write(': '),
+ findall(E, make_num(Ds, N, E), Ss),
+ length(Ss, L),
+ write(L), write(' sol(s): '),
+ write_heads(3, Ss),
+ nl.
+
+write_heads(_, []) :- !.
+write_heads(0, _) :- !,
+ write('...').
+write_heads(N, [X]) :- N > 0, !,
+ write(X).
+write_heads(N, [X|Xs]) :- N > 0, !,
+ N1 is N-1,
+ write(X), write(', '),
+ write_heads(N1, Xs).
+
+make_num(Ds, N, E) :-
+ all_exp(Ds, E),
+ q(E, [N,1]).
+
+%%
+%% all_exp(:List, ?Exp)
+%% List¤ÎÍ×ÁǤ«¤é¡¤²Ã¸º¾è½ü±é»»»Ò¤Çºî¤é¤ì¤ë¼°Exp¤òÊÖ¤¹
+%% + ¤È * ¤Ï²Ä´¹¤È¤¹¤ë
+%%
+all_exp(Ds0, E) :-
+ sort_list(Ds0, Ds),
+ all_exp0(Ds, E).
+
+all_exp0([D], D).
+all_exp0(Ds0, E) :-
+ Ds1 = [_|_],
+ Ds2 = [_|_],
+ div_list(Ds0, Ds1, Ds2),
+ all_exp0(Ds1, E1),
+ all_exp0(Ds2, E2),
+ add_op(E1, E2, E).
+
+add_op(E1, E2, E1+E2) :- E1 @=< E2.
+add_op(E1, E2, E1-E2).
+add_op(E1, E2, E1*E2) :- E1 @=< E2.
+add_op(E1, E2, E1/E2).
+
+div_list(Ds0, Ds1, Ds2) :-
+ de_merge(Ds1, Ds2, Ds0).
+% Ds1 @>= Ds2.
+
+de_merge([], [], []).
+de_merge(Zs, [], Zs) :- Zs = [_|_].
+de_merge([], Zs, Zs) :- Zs = [_|_].
+de_merge([X|Xs], [Y|Ys], [X|Zs]) :-
+ de_merge(Xs, [Y|Ys], Zs),
+ X @< Y.
+de_merge([X|Xs], [Y|Ys], [Y|Zs]) :-
+ de_merge([X|Xs], Ys, Zs),
+ Y @=< X.
+
+%% ¥½¡¼¥È (ÃÙ¤¤!)
+sort_list([], []).
+sort_list([D|Ds0], Ds) :-
+ sort_list(Ds0, Ds1),
+ insert(D, Ds1, Ds).
+
+insert(D0, [], [D0]).
+insert(D0, [D|Ds0], [D0,D|Ds0]) :-
+ D0 @=< D, !.
+insert(D0, [D|Ds0], [D|Ds]) :-
+ D0 @> D,
+ insert(D0, Ds0, Ds).
+
+for(I, M, N) :- M =< N, I=M.
+for(I, M, N) :- M =< N, M1 is M+1, for(I, M1, N).
+
+%%
+%% q(X, Q)
+%% ¼° X ¤Î·×»»·ë²Ì¤È¤·¤ÆÍÍý¿ô Q ¤òÊÖ¤¹
+%% Q = [N,D] N>0, D>0, Àµ¤ÎÍÍý¿ô¤òɽ¤¹ (N¤ÈD¤Ï¸ß¤¤¤ËÁÇ)
+%% Q = [N,D] N<0, D>0, Éé¤ÎÍÍý¿ô¤òɽ¤¹ (N¤ÈD¤Ï¸ß¤¤¤ËÁÇ)
+%% Q = [0,1] 0¤òɽ¤¹
+%% Q = [1,0] ̵¸ÂÂç¤òɽ¤¹
+%% Q = [-1,0] -̵¸ÂÂç¤òɽ¤¹
+%% Q = [0,0] ÉÔÄê¤òɽ¤¹
+%%
+q(X, [X,1]) :-
+ integer(X).
+q(-X, Q) :-
+ q(X, Q1),
+ q_neg(Q1, Q).
+q(X+Y, Q) :-
+ q(X, Q1),
+ q(Y, Q2),
+ q_add(Q1, Q2, Q).
+q(X-Y, Q) :-
+ q(X, Q1),
+ q(Y, Q2),
+ q_neg(Q2, Q3),
+ q_add(Q1, Q3, Q).
+q(X*Y, Q) :-
+ q(X, Q1),
+ q(Y, Q2),
+ q_mul(Q1, Q2, Q).
+q(X/Y, Q) :-
+ q(X, Q1),
+ q(Y, Q2),
+ q_inv(Q2, Q3),
+ q_mul(Q1, Q3, Q).
+
+%%
+%% ÍÍý¿ô¤Î²Ã»»
+%%
+q_add([0,0], _, [0,0]) :- !.
+q_add(_, [0,0], [0,0]) :- !.
+q_add([1,0], [1,0], [1,0]) :- !.
+q_add([1,0], [-1,0], [0,0]) :- !.
+q_add([-1,0], [1,0], [0,0]) :- !.
+q_add([-1,0], [-1,0], [-1,0]) :- !.
+q_add([N1,D1], [N2,D2], Q) :- D1 =\= 0, D2 =\= 0,
+ N is N1*D2+N2*D1,
+ D is D1*D2,
+ q_norm([N,D], Q).
+
+%%
+%% ÍÍý¿ô¤ÎÉé¿ô
+%%
+q_neg([N1,D], Q) :-
+ N is -N1,
+ q_norm([N,D], Q).
+
+%%
+%% ÍÍý¿ô¤Î¾è»»
+%%
+q_mul([N1,D1], [N2,D2], Q) :-
+ N is N1*N2,
+ D is D1*D2,
+ q_norm([N,D], Q).
+
+%%
+%% ÍÍý¿ô¤ÎµÕ¿ô
+%%
+q_inv([N1,D1], Q) :-
+ q_norm([D1,N1], Q).
+
+%%
+%% ÍÍý¿ô¤ÎÀµµ¬²½
+%%
+q_norm([0,0], [0,0]) :- !.
+q_norm([N,0], [1,0]) :- N > 0, !.
+q_norm([N,0], [-1,0]) :- N < 0, !.
+q_norm([0,D], [0,1]) :- D =\= 0, !.
+q_norm([N1,D1], Q) :- N1 =\= 0, D1 < 0, !,
+ N2 is -N1,
+ D2 is -D1,
+ q_norm([N2,D2], Q).
+q_norm([N1,D1], [N,D]) :- N1 =\= 0, D1 > 0, !,
+ gcd(N1, D1, G),
+ N is N1//G,
+ D is D1//G.
+
+gcd(0, B, G) :-
+ G is abs(B).
+gcd(A, B, G) :-
+ A =\= 0,
+ R is B mod A,
+ gcd(R, A, G).
+
diff --git a/examples/prolog/peg.pl b/examples/prolog/peg.pl
new file mode 100644
index 0000000..65a85e2
--- /dev/null
+++ b/examples/prolog/peg.pl
@@ -0,0 +1,97 @@
+% File : peg.pl
+% Authors: Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Updated: 14 February 2008
+% Purpose: Peg solitaire game
+% Notes : Slightly changed by M.Banbara
+
+/*
+This solitaire game consists of a board of the following shape
+and initial configuration
+
+ x
+ x x
+ x o x
+ x x x x
+ x x x x x
+
+where x denotes a peg and o an empty hole. A peg may jump over
+an adjacent peg if the hole behind it is empty. The goal is to
+be left with one peg. I fooled around with this for about 2
+minutes and decided it was too hard by hand---a Lolli program
+was called for.
+*/
+
+main :-
+ write('Peg puzzle (N>=6 takes a long time...)'), nl,
+ write('N = '),
+ current_output(Out),
+ flush_output(Out),
+ read(N), integer(N),
+ write('Position of the first empty hole'), nl,
+ write('Row (1..'), write(N), write(') = '),
+ flush_output(Out),
+ read(I0), integer(I0),
+ write('Col (1..'), write(I0), write(') = '),
+ flush_output(Out),
+ read(J0), integer(J0),
+ statistics(runtime, _),
+ peg_game(N, I0, J0, Solution),
+ statistics(runtime, [_,T]),
+ write(Solution), nl,
+ write('CPU time = '), write(T), write(' msec'), nl.
+main :-
+ statistics(runtime, [_,T]),
+ write('No solutions'), nl,
+ write('CPU time = '), write(T), write(' msec'), nl.
+
+peg_game(N, I0, J0, S) :-
+ N >= 3,
+ 0 < I0, I0 =< N,
+ 0 < J0, J0 =< I0,
+ Step is N*(N+1)//2 - 2,
+ place_pegs(N, N, I0, J0, Board),
+ jump(Step, Board, S).
+
+place_pegs(N, N, I0, J0, Board) :-
+ place_pegs(N, N, I0, J0, [], Board).
+
+place_pegs(0, 0, I0, J0, B0, B) :-
+ peg_delete(B0, peg(I0, J0), B1),!,
+ B = [empty(I0, J0)|B1].
+place_pegs(M, 0, I0, J0, B0, B) :-
+ M > 0,
+ M1 is M-1,
+ place_pegs(M1, M1, I0, J0, B0, B).
+place_pegs(M, N, I0, J0, B0, B) :-
+ M > 0, N > 0,
+ N1 is N-1,
+ place_pegs(M, N1, I0, J0, [peg(M,N)|B0], B).
+
+peg_delete([P|Ys], P, Ys) :- !.
+peg_delete([X|Ys], P, [X|Zs]) :-
+ peg_delete(Ys, P, Zs).
+
+peg_select(X, [X|Xs], Xs).
+peg_select(X, [Y|Ys], [Y|Zs]) :- peg_select(X, Ys, Zs).
+
+jump(Step, Board0, [move(X,Y,DX,DY)|Ms]) :-
+ Step > 0,
+ peg_select(peg(X,Y), Board0, Board1),
+ direction(DX, DY),
+ X1 is X+DX, Y1 is Y+DY,
+ peg_select(peg(X1,Y1), Board1, Board2),
+ X2 is X1+DX, Y2 is Y1+DY,
+ peg_select(empty(X2,Y2), Board2, Board3),
+ Step1 is Step-1,
+ Board = [empty(X,Y), empty(X1, Y1), peg(X2, Y2)|Board3],
+ jump(Step1, Board, Ms).
+jump(0, _, []).
+
+direction( 1, 0).
+direction( 1, 1).
+direction( 0, 1).
+direction(-1, 0).
+direction(-1,-1).
+direction( 0,-1).
+
+
diff --git a/examples/prolog/pentomino.pl b/examples/prolog/pentomino.pl
new file mode 100644
index 0000000..ac6ccfa
--- /dev/null
+++ b/examples/prolog/pentomino.pl
@@ -0,0 +1,1279 @@
+% File : pentomino.pl
+% Authors: Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Updated: 14 February 2008
+% Purpose: Pentomino Puzzle
+% (posed by Henry E. Dudeny, 1907 and Solomon W. Golomb, 1953)
+
+/****************************************************************
+ Count All Solutions
+****************************************************************/
+count_all(N) :-
+ findall(B, solve_pentomino(N, B), L),
+ length(L, C),
+ write(C), write(' solutions'), nl.
+
+/****************************************************************
+ Main
+****************************************************************/
+main :-
+ write('Pentomino Puzzle '), nl,
+ write(' Please select a board size.'), nl,
+ write(' 3 : 3 * 20'), nl,
+ write(' 4 : 4 * 15'), nl,
+ write(' 5 : 5 * 12'), nl,
+ write(' 6 : 6 * 10'), nl,
+ write(' 8 : 8 * 8 (with 4 blanks in the center)'), nl,
+ write('Please select a board size in (3..8).'), nl,
+ write('Number = '),
+ current_output(Out),
+ flush_output(Out),
+ read(X),
+ read_yn('All solutions (y/n)? ', All),
+ read_yn('Output (y/n)? ', Output),
+ statistics(runtime, _),
+ solve_pent(X, all(All), output(Output)),
+ statistics(runtime, [_,T]),
+ write('CPU time = '), write(T), write(' msec'), nl.
+
+read_yn(Message, YN) :-
+ write(Message),
+ flush_output,
+ read(X),
+ (X == 'y' -> YN = yes; YN = no).
+
+solve_pent(X, all(All), output(Output)) :-
+ solve_pentomino(X, Board),
+ (Output == yes -> show_result(Board),nl; true),
+ All == no,
+ !.
+solve_pent(_, _, _).
+/****************************************************************
+ Ê£¿ô¤Î¥Ú¥ó¥È¥ß¥Î¤òÇÛÃÖ¤¹¤ë
+ solve_pentomino(X, B)
+ X : ¥Ü¡¼¥É¤Î½ÄÉý(¹Ô¤Î¿ô)
+ B : ¥Ü¡¼¥É¤Î¹½Â¤ÂÎ
+****************************************************************/
+solve_pentomino(X, Board) :-
+ pent_board(X, Y, Board),
+ Col is Y+2,
+ set_x_pentomino(X, Y, Col, Board, Z0, Z),
+ solve_pent(X, Y, Col, Board),
+ remove_symmetry(Z0, Z).
+
+remove_symmetry(Z0, Z) :-
+ nonvar(Z0), nonvar(Z),
+ !,
+ Z0 @=< Z.
+remove_symmetry(_, _).
+
+solve_pent(X, Y, Col, Board) :-
+ get_search_list(List, 1, 1, X, Y, Col, Board),
+ Pts = ['F','I','L','N','P','T','U','V','W','Y','Z'],
+ solve_pent0(Pts, List, Col, Board).
+
+solve_pent0([], _, _, _) :- !.
+solve_pent0(Pts, [(N, E)|Ls], Col, Board) :-
+ var(E),
+ !,
+ not_one_space(N, Col, Board),
+ pent_select(P, Pts, Pts1),
+ place_pent(P, N, Col, Board),
+ solve_pent0(Pts1, Ls, Col, Board).
+solve_pent0(Pts, [_|Ls], Col, Board) :-
+ solve_pent0(Pts, Ls, Col, Board).
+
+not_one_space(N, Col, B) :-
+ (
+ N1 is N+1, arg(N1, B, X1), var(X1)
+ ;
+ N2 is N+Col, arg(N2, B, X2), var(X2)
+ ),
+ !.
+
+get_search_list([], I, J, X, Y, _, _) :-
+ J =:= Y+1, I =:= X-1,
+ !.
+get_search_list(L, I, J, X, Y, Col, B) :-
+ I =:= 0, J =< X,
+ !,
+ get_search_list(L, J, 1, X, Y, Col, B).
+get_search_list(L, I, J, X, Y, Col, B) :-
+ I =:= 0, J > X,
+ !,
+ J1 is J-X+1,
+ get_search_list(L, X, J1, X, Y, Col, B).
+get_search_list(L, I, J, X, Y, Col, B) :-
+ J =:= Y+1,
+ !,
+ J1 is I+2+Y-X,
+ get_search_list(L, X, J1, X, Y, Col, B).
+get_search_list([(N,Z)|Ls], I, J, X, Y, Col, B) :-
+ N is Col*I+J+1,
+ arg(N, B, Z),
+ var(Z),
+ !,
+ I1 is I-1,
+ J1 is J+1,
+ get_search_list(Ls, I1, J1, X, Y, Col, B).
+get_search_list(L, I, J, X, Y, Col, B) :-
+ I1 is I-1,
+ J1 is J+1,
+ get_search_list(L, I1, J1, X, Y, Col, B).
+/****************************************************************
+ Remove Symmetry by using X-pentomino
+****************************************************************/
+set_x_pentomino(X, _, _, Board, Z0, Z) :-
+ X =:= 3, !,
+ (
+ place_pent('X', 2, 1, 22, Board),
+ look_up_board(1, 3, 22, Board, Z0),
+ look_up_board(3, 3, 22, Board, Z)
+ ;
+ place_pent('X', 2, 2, 22, Board),
+ look_up_board(1, 4, 22, Board, Z0),
+ look_up_board(3, 4, 22, Board, Z)
+ ;
+ place_pent('X', 2, 3, 22, Board),
+ look_up_board(1, 5, 22, Board, Z0),
+ look_up_board(3, 5, 22, Board, Z)
+ ;
+ place_pent('X', 2, 4, 22, Board),
+ look_up_board(1, 6, 22, Board, Z0),
+ look_up_board(3, 6, 22, Board, Z)
+ ;
+ place_pent('X', 2, 5, 22, Board),
+ look_up_board(1, 7, 22, Board, Z0),
+ look_up_board(3, 7, 22, Board, Z)
+ ;
+ place_pent('X', 2, 6, 22, Board),
+ look_up_board(1, 8, 22, Board, Z0),
+ look_up_board(3, 8, 22, Board, Z)
+ ;
+ place_pent('X', 2, 7, 22, Board),
+ look_up_board(1, 9, 22, Board, Z0),
+ look_up_board(3, 9, 22, Board, Z)
+ ;
+ place_pent('X', 2, 8, 22, Board),
+ look_up_board(1, 10, 22, Board, Z0),
+ look_up_board(3, 10, 22, Board, Z)
+ ;
+ place_pent('X', 2, 9, 22, Board),
+ look_up_board(1, 11, 22, Board, Z0),
+ look_up_board(3, 11, 22, Board, Z)
+ ).
+
+set_x_pentomino(X, _, _, Board, Z0, Z) :-
+ X =:= 8, !,
+ (
+ place_pent('X', 3, 1, 10, Board)
+ ;
+ place_pent('X', 4, 1, 10, Board)
+ ;
+ place_pent('X', 3, 2, 10, Board),
+ look_up_board(2, 4, 10, Board, Z0),
+ look_up_board(4, 2, 10, Board, Z)
+ ).
+set_x_pentomino(X, Y, Col, Board, Z0, Z) :-
+ 4 =< X, X =< 6, !,
+ M is (X-1)//2,
+ N is (Y-1)//2,
+ for(J0, 1, N),
+ for(I0, 1, M),
+ I is I0+1,
+ J is J0,
+ place_pent('X', I, J, Col, Board),
+ (
+ X =:= 5, I =:= 3 ->
+ look_up_board(1, J, Col, Board, Z0),
+ look_up_board(5, J, Col, Board, Z)
+ ;
+ true
+ ),
+ (
+ X =:= 4, I =:= 2, J =:= 7 ->
+ look_up_board(1, 7, Col, Board, Z0),
+ look_up_board(1, 9, Col, Board, Z)
+ ;
+ true
+ ).
+/****************************************************************
+ ¥Ü¡¼¥É¤Î(I¡¢J)À®Ê¬¤òÊÖ¤¹
+ look_up_board(I, J, Col, B, X)
+ I : ¹ÔÈÖ¹æ
+ J : ÎóÈÖ¹æ
+ Col: Îó¤Î¿ô+2(+2¤ÏÊɤΤ¿¤áɬÍ×)
+ B : ¥Ü¡¼¥É¤Î¹½Â¤ÂÎ
+ X : ¥Þ¥¹
+****************************************************************/
+look_up_board(I, J, Col, B, X) :-
+ P is Col*I+J+1,
+ arg(P, B, X).
+/****************************************************************
+ ¥Ü¡¼¥É¤ÎºîÀ®
+ pent_board(I, J, B)
+ I : ¥Ü¡¼¥É¤Î½ÄÉý(¹Ô¤Î¿ô)
+ J : ¥Ü¡¼¥É¤Î²£Éý(Îó¤Î¿ô)
+ B : ¥Ü¡¼¥É¤Î¹½Â¤ÂÎ
+****************************************************************/
+pent_board(I, J, Board) :- 3 =< I, I =< 6, !,
+ J is 60//I,
+ make_board(I, J, Board).
+
+pent_board(I, I, Board) :- I == 8, !,
+ make_board(8, 8, Board),
+ look_up_board(4, 4, 10, Board, ' '),
+ look_up_board(4, 5, 10, Board, ' '),
+ look_up_board(5, 4, 10, Board, ' '),
+ look_up_board(5, 5, 10, Board, ' ').
+
+make_board(I, J, Board) :-
+ M is I+2, N is J+2,
+ Total is M*N,
+ functor(Board, b, Total),
+ frame(1, 1, M, N, Board).
+
+frame(_, J, _, N, _) :- J > N, !.
+frame(I, J, M, N, Board) :- I > M, !,
+ J1 is J+1,
+ frame(1, J1, M, N, Board).
+frame(I, J, M, N, Board) :-
+ (I =:= 1 ; I =:= M ; J =:= 1 ; J =:= N),
+ !,
+ L is (I-1)*N+J,
+ arg(L, Board, '*'),
+ I1 is I+1,
+ J1 is J,
+ frame(I1, J1, M, N, Board).
+frame(I, J, M, N, Board) :-
+ I1 is I+1,
+ J1 is J,
+ frame(I1, J1, M, N, Board).
+/****************************************************************
+ ¥Ü¡¼¥É¤Îɽ¼¨
+ show_result(B)
+ B : ¥Ü¡¼¥É¤Î¹½Â¤ÂÎ
+****************************************************************/
+show_result(B) :-
+ board_size(B, H, W),
+ Col is W+2,
+ for(I, 1, H),
+ nl,
+ for(J, 1, W),
+ look_up_board(I, J, Col, B, P),
+ write_pent(P),
+ fail.
+show_result(_) :- nl.
+
+write_pent(P) :- var(P), !, write('_ ').
+write_pent(P) :- write(P), write(' ').
+/****************************************************************
+ ¥Ü¡¼¥É¤Î¥µ¥¤¥º
+ board_size(B, H, W)
+ B : ¥Ü¡¼¥É¤Î¹½Â¤ÂÎ
+ H : ¥Ü¡¼¥É¤Î½ÄÉý
+ W : ¥Ü¡¼¥É¤Î²£Éý
+****************************************************************/
+board_size(B, H, W) :-
+ board_width(B, W),
+ board_height(W, H).
+
+board_width(B, W) :-
+ count_flame(B, 1, W).
+
+count_flame(B, N, W) :-
+ arg(N, B, P), P == '*',
+ !,
+ N1 is N+1,
+ count_flame(B, N1, W).
+count_flame(_, N, W) :-
+ W is N-4.
+
+board_height(W, H) :-
+ 10 =< W, W =< 20,
+ !,
+ H is 60//W.
+board_height(8, 8).
+/****************************************************************
+ ¥Ú¥ó¥È¥ß¥Î¤ò£±¤ÄÇÛÃÖ¤¹¤ë
+ place_pent(P, I, J, Col, B)
+ P : ¥Ú¥ó¥È¥ß¥Î¤Î¼ïÎà̾
+ I : ¹ÔÈÖ¹æ
+ J : ÎóÈÖ¹æ
+ Col: Îó¤Î¿ô+2(+2¤ÏÊɤΤ¿¤áɬÍ×)
+ B : ¥Ü¡¼¥É¤Î¹½Â¤ÂÎ
+****************************************************************/
+place_pent(P, I, J, Col, B) :-
+ C is Col*I+J+1,
+ !,
+ place_pent(P, C, Col, B).
+
+% Pentmino = 'X'
+% Number = 1
+% D
+% C E G
+% F
+place_pent('X', C, Col, Board) :-
+ arg(C, Board, 'X'),
+ D is C-Col+1,
+ arg(D, Board, 'X'),
+ E is C+1,
+ arg(E, Board, 'X'),
+ F is E+Col,
+ arg(F, Board, 'X'),
+ G is E+1,
+ arg(G, Board, 'X').
+% Pentmino = 'F'
+% Number = 1
+% D F
+% C E
+% G
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C-Col+1,
+ arg(D, Board, 'F'),
+ E is C+1,
+ arg(E, Board, 'F'),
+ F is D+1,
+ arg(F, Board, 'F'),
+ G is E+Col,
+ arg(G, Board, 'F').
+% Pentmino = 'F'
+% Number = 2
+% D
+% C E F
+% G
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C-Col+1,
+ arg(D, Board, 'F'),
+ E is C+1,
+ arg(E, Board, 'F'),
+ F is E+1,
+ arg(F, Board, 'F'),
+ G is F+Col,
+ arg(G, Board, 'F').
+% Pentmino = 'F'
+% Number = 3
+% C
+% E G
+% D F
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C+(2*Col)-1,
+ arg(D, Board, 'F'),
+ E is C+Col,
+ arg(E, Board, 'F'),
+ F is D+1,
+ arg(F, Board, 'F'),
+ G is E+1,
+ arg(G, Board, 'F').
+% Pentmino = 'F'
+% Number = 4
+% C
+% D E G
+% F
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C+Col,
+ arg(D, Board, 'F'),
+ E is D+1,
+ arg(E, Board, 'F'),
+ F is E+Col,
+ arg(F, Board, 'F'),
+ G is E+1,
+ arg(G, Board, 'F').
+% Pentmino = 'F'
+% Number = 5
+% C D
+% E G
+% F
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C+1,
+ arg(D, Board, 'F'),
+ E is D+Col,
+ arg(E, Board, 'F'),
+ F is E+Col,
+ arg(F, Board, 'F'),
+ G is E+1,
+ arg(G, Board, 'F').
+% Pentmino = 'F'
+% Number = 6
+% E
+% C D G
+% F
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C+1,
+ arg(D, Board, 'F'),
+ E is C-Col+2,
+ arg(E, Board, 'F'),
+ F is D+Col,
+ arg(F, Board, 'F'),
+ G is D+1,
+ arg(G, Board, 'F').
+% Pentmino = 'F'
+% Number = 7
+% D
+% C E
+% F G
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C-Col+1,
+ arg(D, Board, 'F'),
+ E is C+1,
+ arg(E, Board, 'F'),
+ F is E+Col,
+ arg(F, Board, 'F'),
+ G is F+1,
+ arg(G, Board, 'F').
+% Pentmino = 'F'
+% Number = 8
+% D
+% C F G
+% E
+place_pent('F', C, Col, Board) :-
+ arg(C, Board, 'F'),
+ D is C-Col+1,
+ arg(D, Board, 'F'),
+ E is C+Col,
+ arg(E, Board, 'F'),
+ F is C+1,
+ arg(F, Board, 'F'),
+ G is F+1,
+ arg(G, Board, 'F').
+% Pentmino = 'I'
+% Number = 1
+% C
+% D
+% E
+% F
+% G
+place_pent('I', C, Col, Board) :-
+ arg(C, Board, 'I'),
+ D is C+Col,
+ arg(D, Board, 'I'),
+ E is D+Col,
+ arg(E, Board, 'I'),
+ F is E+Col,
+ arg(F, Board, 'I'),
+ G is F+Col,
+ arg(G, Board, 'I').
+% Pentmino = 'I'
+% Number = 2
+% C D E F G
+place_pent('I', C, _, Board) :-
+ arg(C, Board, 'I'),
+ D is C+1,
+ arg(D, Board, 'I'),
+ E is D+1,
+ arg(E, Board, 'I'),
+ F is E+1,
+ arg(F, Board, 'I'),
+ G is F+1,
+ arg(G, Board, 'I').
+% Pentmino = 'L'
+% Number = 1
+% C
+% D
+% E
+% F G
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+Col,
+ arg(D, Board, 'L'),
+ E is D+Col,
+ arg(E, Board, 'L'),
+ F is E+Col,
+ arg(F, Board, 'L'),
+ G is F+1,
+ arg(G, Board, 'L').
+% Pentmino = 'L'
+% Number = 2
+% C E F G
+% D
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+Col,
+ arg(D, Board, 'L'),
+ E is C+1,
+ arg(E, Board, 'L'),
+ F is E+1,
+ arg(F, Board, 'L'),
+ G is F+1,
+ arg(G, Board, 'L').
+% Pentmino = 'L'
+% Number = 3
+% C D
+% E
+% F
+% G
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+1,
+ arg(D, Board, 'L'),
+ E is D+Col,
+ arg(E, Board, 'L'),
+ F is E+Col,
+ arg(F, Board, 'L'),
+ G is F+Col,
+ arg(G, Board, 'L').
+% Pentmino = 'L'
+% Number = 4
+% F
+% C D E G
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+1,
+ arg(D, Board, 'L'),
+ E is D+1,
+ arg(E, Board, 'L'),
+ F is E-Col+1,
+ arg(F, Board, 'L'),
+ G is E+1,
+ arg(G, Board, 'L').
+% Pentmino = 'L'
+% Number = 5
+% C
+% D
+% F
+% E G
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+Col,
+ arg(D, Board, 'L'),
+ E is D+(2*Col)-1,
+ arg(E, Board, 'L'),
+ F is D+Col,
+ arg(F, Board, 'L'),
+ G is E+1,
+ arg(G, Board, 'L').
+% Pentmino = 'L'
+% Number = 6
+% C
+% D E F G
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+Col,
+ arg(D, Board, 'L'),
+ E is D+1,
+ arg(E, Board, 'L'),
+ F is E+1,
+ arg(F, Board, 'L'),
+ G is F+1,
+ arg(G, Board, 'L').
+% Pentmino = 'L'
+% Number = 7
+% C E
+% D
+% F
+% G
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+Col,
+ arg(D, Board, 'L'),
+ E is C+1,
+ arg(E, Board, 'L'),
+ F is D+Col,
+ arg(F, Board, 'L'),
+ G is F+Col,
+ arg(G, Board, 'L').
+% Pentmino = 'L'
+% Number = 8
+% C D E F
+% G
+place_pent('L', C, Col, Board) :-
+ arg(C, Board, 'L'),
+ D is C+1,
+ arg(D, Board, 'L'),
+ E is D+1,
+ arg(E, Board, 'L'),
+ F is E+1,
+ arg(F, Board, 'L'),
+ G is F+Col,
+ arg(G, Board, 'L').
+% Pentmino = 'N'
+% Number = 1
+% C
+% D
+% E F
+% G
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C+Col,
+ arg(D, Board, 'N'),
+ E is D+Col,
+ arg(E, Board, 'N'),
+ F is E+1,
+ arg(F, Board, 'N'),
+ G is F+Col,
+ arg(G, Board, 'N').
+% Pentmino = 'N'
+% Number = 2
+% D F G
+% C E
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C-Col+1,
+ arg(D, Board, 'N'),
+ E is C+1,
+ arg(E, Board, 'N'),
+ F is D+1,
+ arg(F, Board, 'N'),
+ G is F+1,
+ arg(G, Board, 'N').
+% Pentmino = 'N'
+% Number = 3
+% C
+% D E
+% F
+% G
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C+Col,
+ arg(D, Board, 'N'),
+ E is D+1,
+ arg(E, Board, 'N'),
+ F is E+Col,
+ arg(F, Board, 'N'),
+ G is F+Col,
+ arg(G, Board, 'N').
+% Pentmino = 'N'
+% Number = 4
+% E G
+% C D F
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C+1,
+ arg(D, Board, 'N'),
+ E is C-Col+2,
+ arg(E, Board, 'N'),
+ F is D+1,
+ arg(F, Board, 'N'),
+ G is E+1,
+ arg(G, Board, 'N').
+% Pentmino = 'N'
+% Number = 5
+% C
+% E
+% D G
+% F
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C+(2*Col)-1,
+ arg(D, Board, 'N'),
+ E is C+Col,
+ arg(E, Board, 'N'),
+ F is D+Col,
+ arg(F, Board, 'N'),
+ G is D+1,
+ arg(G, Board, 'N').
+% Pentmino = 'N'
+% Number = 6
+% C D
+% E F G
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C+1,
+ arg(D, Board, 'N'),
+ E is D+Col,
+ arg(E, Board, 'N'),
+ F is E+1,
+ arg(F, Board, 'N'),
+ G is F+1,
+ arg(G, Board, 'N').
+% Pentmino = 'N'
+% Number = 7
+% D
+% C F
+% E
+% G
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C-Col+1,
+ arg(D, Board, 'N'),
+ E is C+Col,
+ arg(E, Board, 'N'),
+ F is C+1,
+ arg(F, Board, 'N'),
+ G is E+Col,
+ arg(G, Board, 'N').
+% Pentmino = 'N'
+% Number = 8
+% C D E
+% F G
+place_pent('N', C, Col, Board) :-
+ arg(C, Board, 'N'),
+ D is C+1,
+ arg(D, Board, 'N'),
+ E is D+1,
+ arg(E, Board, 'N'),
+ F is E+Col,
+ arg(F, Board, 'N'),
+ G is F+1,
+ arg(G, Board, 'N').
+% Pentmino = 'P'
+% Number = 1
+% C E
+% D G
+% F
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C+Col,
+ arg(D, Board, 'P'),
+ E is C+1,
+ arg(E, Board, 'P'),
+ F is D+Col,
+ arg(F, Board, 'P'),
+ G is D+1,
+ arg(G, Board, 'P').
+% Pentmino = 'P'
+% Number = 2
+% C D F
+% E G
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C+1,
+ arg(D, Board, 'P'),
+ E is D+Col,
+ arg(E, Board, 'P'),
+ F is D+1,
+ arg(F, Board, 'P'),
+ G is E+1,
+ arg(G, Board, 'P').
+% Pentmino = 'P'
+% Number = 3
+% D
+% C F
+% E G
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C-(Col-1),
+ arg(D, Board, 'P'),
+ E is C+Col,
+ arg(E, Board, 'P'),
+ F is C+1,
+ arg(F, Board, 'P'),
+ G is E+1,
+ arg(G, Board, 'P').
+% Pentmino = 'P'
+% Number = 4
+% C E
+% D F G
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C+Col,
+ arg(D, Board, 'P'),
+ E is C+1,
+ arg(E, Board, 'P'),
+ F is D+1,
+ arg(F, Board, 'P'),
+ G is F+1,
+ arg(G, Board, 'P').
+% Pentmino = 'P'
+% Number = 5
+% C E
+% D F
+% G
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C+Col,
+ arg(D, Board, 'P'),
+ E is C+1,
+ arg(E, Board, 'P'),
+ F is D+1,
+ arg(F, Board, 'P'),
+ G is F+Col,
+ arg(G, Board, 'P').
+% Pentmino = 'P'
+% Number = 6
+% D F
+% C E G
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C-(Col-1),
+ arg(D, Board, 'P'),
+ E is C+1,
+ arg(E, Board, 'P'),
+ F is D+1,
+ arg(F, Board, 'P'),
+ G is E+1,
+ arg(G, Board, 'P').
+% Pentmino = 'P'
+% Number = 7
+% C
+% D F
+% E G
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C+Col,
+ arg(D, Board, 'P'),
+ E is D+Col,
+ arg(E, Board, 'P'),
+ F is D+1,
+ arg(F, Board, 'P'),
+ G is E+1,
+ arg(G, Board, 'P').
+% Pentmino = 'P'
+% Number = 8
+% C E G
+% D F
+place_pent('P', C, Col, Board) :-
+ arg(C, Board, 'P'),
+ D is C+Col,
+ arg(D, Board, 'P'),
+ E is C+1,
+ arg(E, Board, 'P'),
+ F is D+1,
+ arg(F, Board, 'P'),
+ G is E+1,
+ arg(G, Board, 'P').
+% Pentmino = 'T'
+% Number = 1
+% C D F
+% E
+% G
+place_pent('T', C, Col, Board) :-
+ arg(C, Board, 'T'),
+ D is C+1,
+ arg(D, Board, 'T'),
+ E is D+Col,
+ arg(E, Board, 'T'),
+ F is D+1,
+ arg(F, Board, 'T'),
+ G is E+Col,
+ arg(G, Board, 'T').
+% Pentmino = 'T'
+% Number = 2
+% E
+% C D F
+% G
+place_pent('T', C, Col, Board) :-
+ arg(C, Board, 'T'),
+ D is C+1,
+ arg(D, Board, 'T'),
+ E is C-(Col-2),
+ arg(E, Board, 'T'),
+ F is D+1,
+ arg(F, Board, 'T'),
+ G is F+Col,
+ arg(G, Board, 'T').
+% Pentmino = 'T'
+% Number = 3
+% C
+% E
+% D F G
+place_pent('T', C, Col, Board) :-
+ arg(C, Board, 'T'),
+ D is C+(Col*2)-1,
+ arg(D, Board, 'T'),
+ E is C+Col,
+ arg(E, Board, 'T'),
+ F is D+1,
+ arg(F, Board, 'T'),
+ G is F+1,
+ arg(G, Board, 'T').
+% Pentmino = 'T'
+% Number = 4
+% C
+% D F G
+% E
+place_pent('T', C, Col, Board) :-
+ arg(C, Board, 'T'),
+ D is C+Col,
+ arg(D, Board, 'T'),
+ E is D+Col,
+ arg(E, Board, 'T'),
+ F is D+1,
+ arg(F, Board, 'T'),
+ G is F+1,
+ arg(G, Board, 'T').
+% Pentmino = 'U'
+% Number = 1
+% C F
+% D E G
+place_pent('U', C, Col, Board) :-
+ arg(C, Board, 'U'),
+ D is C+Col,
+ arg(D, Board, 'U'),
+ E is D+1,
+ arg(E, Board, 'U'),
+ F is C+2,
+ arg(F, Board, 'U'),
+ G is E+1,
+ arg(G, Board, 'U').
+% Pentmino = 'U'
+% Number = 2
+% C E
+% D
+% F G
+place_pent('U', C, Col, Board) :-
+ arg(C, Board, 'U'),
+ D is C+Col,
+ arg(D, Board, 'U'),
+ E is C+1,
+ arg(E, Board, 'U'),
+ F is D+Col,
+ arg(F, Board, 'U'),
+ G is F+1,
+ arg(G, Board, 'U').
+% Pentmino = 'U'
+% Number = 3
+% C E F
+% D G
+place_pent('U', C, Col, Board) :-
+ arg(C, Board, 'U'),
+ D is C+Col,
+ arg(D, Board, 'U'),
+ E is C+1,
+ arg(E, Board, 'U'),
+ F is E+1,
+ arg(F, Board, 'U'),
+ G is D+2,
+ arg(G, Board, 'U').
+% Pentmino = 'U'
+% Number = 4
+% C D
+% F
+% E G
+place_pent('U', C, Col, Board) :-
+ arg(C, Board, 'U'),
+ D is C+1,
+ arg(D, Board, 'U'),
+ E is C+(2*Col),
+ arg(E, Board, 'U'),
+ F is D+Col,
+ arg(F, Board, 'U'),
+ G is E+1,
+ arg(G, Board, 'U').
+% Pentmino = 'V'
+% Number = 1
+% C
+% D
+% E F G
+place_pent('V', C, Col, Board) :-
+ arg(C, Board, 'V'),
+ D is C+Col,
+ arg(D, Board, 'V'),
+ E is D+Col,
+ arg(E, Board, 'V'),
+ F is E+1,
+ arg(F, Board, 'V'),
+ G is F+1,
+ arg(G, Board, 'V').
+% Pentmino = 'V'
+% Number = 2
+% C E G
+% D
+% F
+place_pent('V', C, Col, Board) :-
+ arg(C, Board, 'V'),
+ D is C+Col,
+ arg(D, Board, 'V'),
+ E is C+1,
+ arg(E, Board, 'V'),
+ F is D+Col,
+ arg(F, Board, 'V'),
+ G is E+1,
+ arg(G, Board, 'V').
+% Pentmino = 'V'
+% Number = 3
+% C D E
+% F
+% G
+place_pent('V', C, Col, Board) :-
+ arg(C, Board, 'V'),
+ D is C+1,
+ arg(D, Board, 'V'),
+ E is D+1,
+ arg(E, Board, 'V'),
+ F is E+Col,
+ arg(F, Board, 'V'),
+ G is F+Col,
+ arg(G, Board, 'V').
+% Pentmino = 'V'
+% Number = 4
+% D
+% F
+% C E G
+place_pent('V', C, Col, Board) :-
+ arg(C, Board, 'V'),
+ D is C-(2*Col)+2,
+ D > 0, %%% arg/3 ¤ÎÂè°ì°ú¿ô¤¬Éé¤Î¿ô¤Ë¤Ê¤é¤Ê¤¤¤¿¤áɬÍ×
+ arg(D, Board, 'V'),
+ E is C+1,
+ arg(E, Board, 'V'),
+ F is D+Col,
+ arg(F, Board, 'V'),
+ G is E+1,
+ arg(G, Board, 'V').
+% Pentmino = 'W'
+% Number = 1
+% C
+% D E
+% F G
+place_pent('W', C, Col, Board) :-
+ arg(C, Board, 'W'),
+ D is C+Col,
+ arg(D, Board, 'W'),
+ E is D+1,
+ arg(E, Board, 'W'),
+ F is E+Col,
+ arg(F, Board, 'W'),
+ G is F+1,
+ arg(G, Board, 'W').
+% Pentmino = 'W'
+% Number = 2
+% D G
+% C F
+% E
+place_pent('W', C, Col, Board) :-
+ arg(C, Board, 'W'),
+ D is C-(Col-1),
+ arg(D, Board, 'W'),
+ E is C+Col,
+ arg(E, Board, 'W'),
+ F is C+1,
+ arg(F, Board, 'W'),
+ G is D+1,
+ arg(G, Board, 'W').
+% Pentmino = 'W'
+% Number = 3
+% C D
+% E F
+% G
+place_pent('W', C, Col, Board) :-
+ arg(C, Board, 'W'),
+ D is C+1,
+ arg(D, Board, 'W'),
+ E is D+Col,
+ arg(E, Board, 'W'),
+ F is E+1,
+ arg(F, Board, 'W'),
+ G is F+Col,
+ arg(G, Board, 'W').
+% Pentmino = 'W'
+% Number = 4
+% E
+% D G
+% C F
+place_pent('W', C, Col, Board) :-
+ arg(C, Board, 'W'),
+ D is C-(Col-1),
+ arg(D, Board, 'W'),
+ E is D-(Col-1),
+ arg(E, Board, 'W'),
+ F is C+1,
+ arg(F, Board, 'W'),
+ G is D+1,
+ arg(G, Board, 'W').
+% Pentmino = 'Y'
+% Number = 1
+% E
+% C D F G
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C+1,
+ arg(D, Board, 'Y'),
+ E is C-(Col-2),
+ arg(E, Board, 'Y'),
+ F is D+1,
+ arg(F, Board, 'Y'),
+ G is F+1,
+ arg(G, Board, 'Y').
+% Pentmino = 'Y'
+% Number = 2
+% C
+% D
+% E G
+% F
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C+Col,
+ arg(D, Board, 'Y'),
+ E is D+Col,
+ arg(E, Board, 'Y'),
+ F is E+Col,
+ arg(F, Board, 'Y'),
+ G is E+1,
+ arg(G, Board, 'Y').
+% Pentmino = 'Y'
+% Number = 3
+% C D F G
+% E
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C+1,
+ arg(D, Board, 'Y'),
+ E is D+Col,
+ arg(E, Board, 'Y'),
+ F is D+1,
+ arg(F, Board, 'Y'),
+ G is F+1,
+ arg(G, Board, 'Y').
+% Pentmino = 'Y'
+% Number = 4
+% D
+% C E
+% F
+% G
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C-(Col-1),
+ arg(D, Board, 'Y'),
+ E is C+1,
+ arg(E, Board, 'Y'),
+ F is E+Col,
+ arg(F, Board, 'Y'),
+ G is F+Col,
+ arg(G, Board, 'Y').
+% Pentmino = 'Y'
+% Number = 5
+% C
+% D F
+% E
+% G
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C+Col,
+ arg(D, Board, 'Y'),
+ E is D+Col,
+ arg(E, Board, 'Y'),
+ F is D+1,
+ arg(F, Board, 'Y'),
+ G is E+Col,
+ arg(G, Board, 'Y').
+% Pentmino = 'Y'
+% Number = 6
+% C D E G
+% F
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C+1,
+ arg(D, Board, 'Y'),
+ E is D+1,
+ arg(E, Board, 'Y'),
+ F is E+Col,
+ arg(F, Board, 'Y'),
+ G is E+1,
+ arg(G, Board, 'Y').
+% Pentmino = 'Y'
+% Number = 7
+% C
+% E
+% D F
+% G
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C+(2*Col)-1,
+ arg(D, Board, 'Y'),
+ E is C+Col,
+ arg(E, Board, 'Y'),
+ F is D+1,
+ arg(F, Board, 'Y'),
+ G is F+Col,
+ arg(G, Board, 'Y').
+% Pentmino = 'Y'
+% Number = 8
+% D
+% C E F G
+place_pent('Y', C, Col, Board) :-
+ arg(C, Board, 'Y'),
+ D is C-(Col-1),
+ arg(D, Board, 'Y'),
+ E is C+1,
+ arg(E, Board, 'Y'),
+ F is E+1,
+ arg(F, Board, 'Y'),
+ G is F+1,
+ arg(G, Board, 'Y').
+% Pentmino = 'Z'
+% Number = 1
+% C D
+% E
+% F G
+place_pent('Z', C, Col, Board) :-
+ arg(C, Board, 'Z'),
+ D is C+1,
+ arg(D, Board, 'Z'),
+ E is D+Col,
+ arg(E, Board, 'Z'),
+ F is E+Col,
+ arg(F, Board, 'Z'),
+ G is F+1,
+ arg(G, Board, 'Z').
+% Pentmino = 'Z'
+% Number = 2
+% F
+% C E G
+% D
+place_pent('Z', C, Col, Board) :-
+ arg(C, Board, 'Z'),
+ D is C+Col,
+ arg(D, Board, 'Z'),
+ E is C+1,
+ arg(E, Board, 'Z'),
+ F is C-(Col-2),
+ arg(F, Board, 'Z'),
+ G is E+1,
+ arg(G, Board, 'Z').
+% Pentmino = 'Z'
+% Number = 3
+% C F
+% E
+% D G
+place_pent('Z', C, Col, Board) :-
+ arg(C, Board, 'Z'),
+ D is C+(2*Col)-1,
+ arg(D, Board, 'Z'),
+ E is C+Col,
+ arg(E, Board, 'Z'),
+ F is C+1,
+ arg(F, Board, 'Z'),
+ G is D+1,
+ arg(G, Board, 'Z').
+% Pentmino = 'Z'
+% Number = 4
+% C
+% D E F
+% G
+place_pent('Z', C, Col, Board) :-
+ arg(C, Board, 'Z'),
+ D is C+Col,
+ arg(D, Board, 'Z'),
+ E is D+1,
+ arg(E, Board, 'Z'),
+ F is E+1,
+ arg(F, Board, 'Z'),
+ G is F+Col,
+ arg(G, Board, 'Z').
+
+/****************************************************************
+ Utilities
+****************************************************************/
+for(M, M, N) :- M =< N.
+for(I, M, N) :- M =< N, M1 is M + 1, for(I, M1, N).
+
+pent_select(X, [X|Xs], Xs).
+pent_select(X, [Y|Ys], [Y|Zs]) :- pent_select(X, Ys, Zs).
+
+/****************************************************************
+ For applet
+****************************************************************/
+
+pentomino_applet(X, B) :-
+ solve_pentomino(X, B0),
+ remove_asterisk(B0, B).
+
+remove_asterisk(B0, B) :-
+ B0 =.. [_|As],
+ rm_aster(As, B).
+
+rm_aster([], []) :- !.
+rm_aster([A|As], Ps) :- A == '*', !,
+ rm_aster(As,Ps).
+rm_aster([A|As], [A|Ps]) :-
+ rm_aster(As,Ps).
+
+
diff --git a/examples/prolog/queens.pl b/examples/prolog/queens.pl
new file mode 100644
index 0000000..f286a2e
--- /dev/null
+++ b/examples/prolog/queens.pl
@@ -0,0 +1,57 @@
+% File : queens.pl
+% Updated: 14 February 2008
+% Purpose: N-Queen Puzzle (posed by Franz Nauch, 1850)
+
+main :-
+ write('N-Queen Puzzle (posed by Franz Nauch, 1850) '), nl,
+ write('N = '),
+ flush_output,
+ read(N),
+ N >= 4,
+ read_yn('All solutions (y/n)? ', All),
+ read_yn('Output (y/n)? ', Output),
+ statistics(runtime, _),
+ queen_solve(N, all(All), output(Output)),
+ statistics(runtime, [_,T]),
+ write('CPU time = '), write(T), write(' msec'), nl.
+
+read_yn(Message, YN) :-
+ write(Message),
+ flush_output,
+ read(X),
+ (X == 'y' -> YN = yes; YN = no).
+
+queen_solve(N, all(X), output(Y)) :-
+ queens(N, Q),
+ (Y == yes -> write(Q), nl; true),
+ X == no,
+ !.
+queen_solve(_,_,_).
+
+queens(N,Qs) :-
+ range(1,N,Ns),
+ queens(Ns,[],Qs).
+
+queens([],Qs,Qs).
+queens(UnplacedQs,SafeQs,Qs) :-
+ select(UnplacedQs,UnplacedQs1,Q),
+ not_attack(SafeQs,Q),
+ queens(UnplacedQs1,[Q|SafeQs],Qs).
+
+not_attack(Xs,X) :-
+ not_attack(Xs,X,1).
+
+not_attack([],_,_) :- !.
+not_attack([Y|Ys],X,N) :-
+ X =\= Y+N, X =\= Y-N,
+ N1 is N+1,
+ not_attack(Ys,X,N1).
+
+select([X|Xs],Xs,X).
+select([Y|Ys],[Y|Zs],X) :- select(Ys,Zs,X).
+
+range(N,N,[N]) :- !.
+range(M,N,[M|Ns]) :-
+ M < N,
+ M1 is M+1,
+ range(M1,N,Ns).
diff --git a/src/builtin/Base/PRED_$atom_type0_2.java b/src/builtin/Base/PRED_$atom_type0_2.java
new file mode 100644
index 0000000..2e01755
--- /dev/null
+++ b/src/builtin/Base/PRED_$atom_type0_2.java
@@ -0,0 +1,45 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$atom_type0'/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$atom_type0_2 extends Predicate {
+ Term arg1, arg2;
+
+ public PRED_$atom_type0_2(Term a1, Term a2, Predicate cont){
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$atom_type0_2(){}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "$atom_type0(" + arg1 + ", " + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ int type;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ if(! a1.isSymbol())
+ return engine.fail();
+ type = Token.getStringType(((SymbolTerm)a1).name());
+ if(! a2.unify(new IntegerTerm(type), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$begin_exception_1.java b/src/builtin/Base/PRED_$begin_exception_1.java
new file mode 100644
index 0000000..cb1ba85
--- /dev/null
+++ b/src/builtin/Base/PRED_$begin_exception_1.java
@@ -0,0 +1,77 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$begin_exception'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2
+ */
+class PRED_$begin_exception_1 extends BlockPredicate {
+ Term arg1;
+
+ public PRED_$begin_exception_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$begin_exception_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$begin_exception(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ if (! a1.unify(new JavaObjectTerm(this), engine.trail))
+ return engine.fail();
+ Predicate code = cont;
+ int B = engine.stack.top();
+ this.outOfScope = false;
+ this.outOfLoop = false;
+ engine.trail.push(new OutOfLoop(this));
+
+ try {
+ main_loop:while(true) {
+ while (engine.exceptionRaised == 0) {
+ if (engine.control.thread == null)
+ break main_loop;
+ if (outOfLoop)
+ break main_loop;
+ code = code.exec(engine);
+ }
+ switch (engine.exceptionRaised) {
+ case 1: // halt/0
+ break main_loop;
+ case 2: // freeze/2
+ throw new SystemException("freeze/2 is not supported yet");
+ // Do something here
+ // engine.exceptionRaised = 0 ;
+ // break
+ default:
+ break main_loop;
+ }
+ }
+ } catch (PrologException e) {
+ if (outOfScope)
+ throw e;
+ engine.setException(engine.copy(e.getMessageTerm()));
+ engine.cut(B);
+ return engine.fail();
+ } catch (Exception e) {
+ if (outOfScope)
+ throw new JavaException(e);
+ engine.setException(new JavaObjectTerm(e));
+ engine.cut(B);
+ return engine.fail();
+ }
+ return code;
+ }
+}
diff --git a/src/builtin/Base/PRED_$begin_sync_2.java b/src/builtin/Base/PRED_$begin_sync_2.java
new file mode 100644
index 0000000..af92a69
--- /dev/null
+++ b/src/builtin/Base/PRED_$begin_sync_2.java
@@ -0,0 +1,102 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$begin_sync'/2</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2
+ */
+class PRED_$begin_sync_2 extends BlockPredicate {
+ Term arg1, arg2;
+
+ public PRED_$begin_sync_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+ public PRED_$begin_sync_2() {}
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "$begin_sync(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ Object o = null;
+ Predicate code = null;
+
+ // 1st. argument
+ a1 = a1.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (! a1.isJavaObject())
+ throw new IllegalTypeException(this, 1, "java", a1);
+ o = ((JavaObjectTerm)a1).object();
+ // 2nd. argument
+ a2 = a2.dereference();
+ if (! a2.isVariable())
+ throw new IllegalTypeException(this, 2, "variable", a1);
+ ((VariableTerm) a2).bind(new JavaObjectTerm(this), engine.trail);
+ //
+ code = cont;
+ this.outOfScope = false;
+ this.outOfLoop = false;
+ engine.trail.push(new OutOfLoop(this));
+ main_loop:while(true) {
+ synchronized (o) {
+ while (! outOfScope) {
+ if (engine.exceptionRaised != 0) {
+ switch (engine.exceptionRaised) {
+ case 1: // halt/0
+ break main_loop;
+ case 2: // freeze/2
+ throw new SystemException("freeze/2 is not supported yet");
+ // Do something here
+ // engine.exceptionRaised = 0 ;
+ // break
+ default:
+ break main_loop;
+ }
+ }
+ if (engine.control.thread == null)
+ break main_loop;
+ if (outOfLoop)
+ break main_loop;
+ code = code.exec(engine);
+ }
+
+ }
+ while (outOfScope) {
+ if (engine.exceptionRaised != 0) {
+ switch (engine.exceptionRaised) {
+ case 1: // halt/0
+ break main_loop;
+ case 2: // freeze/2
+ throw new SystemException("freeze/2 is not supported yet");
+ // Do something here
+ // engine.exceptionRaised = 0 ;
+ // break
+ default:
+ break main_loop;
+ }
+ }
+ if (engine.control.thread == null)
+ break main_loop;
+ if (outOfLoop)
+ break main_loop;
+ code = code.exec(engine);
+ }
+
+ }
+ return code;
+ }
+}
diff --git a/src/builtin/Base/PRED_$call_2.java b/src/builtin/Base/PRED_$call_2.java
new file mode 100644
index 0000000..8927d1a
--- /dev/null
+++ b/src/builtin/Base/PRED_$call_2.java
@@ -0,0 +1,92 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>'$call'/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$call_2 extends Predicate {
+ Term arg1, arg2;
+ Predicate cont;
+ public static SymbolTerm SYM_SLASH_2 = SymbolTerm.makeSymbol("/", 2);
+
+ public PRED_$call_2() {}
+ public PRED_$call_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public void setArgument(Term args[], Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "$call(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1.dereference(); // a1 must be atom of package name
+ a2 = arg2.dereference(); // a2 must be callable name
+
+ String functor;
+ int arity;
+ Term[] args;
+ Class clazz;
+ Constructor constr;
+ Predicate pred;
+
+ try {
+ if (! a1.isSymbol())
+ throw new IllegalTypeException(this, 1, "atom", a1);
+ if (a2.isSymbol()) {
+ functor = ((SymbolTerm)a2).name();
+ args = null;
+ arity = 0;
+ } else if (a2.isStructure()) {
+ functor = ((StructureTerm)a2).functor().name();
+ args = ((StructureTerm)a2).args();
+ arity = ((StructureTerm)a2).arity();
+ } else {
+ throw new IllegalTypeException(this, 2, "callable", a2);
+ }
+ try {
+ clazz = engine.pcl.loadPredicateClass(((SymbolTerm)a1).name(), functor, arity, true);
+ } catch (ClassNotFoundException e) {
+ try {
+ clazz = engine.pcl.loadPredicateClass("jp.ac.kobe_u.cs.prolog.builtin", functor, arity, true);
+ } catch (ClassNotFoundException ee) {
+ if ((engine.getUnknown()).equals("fail"))
+ return engine.fail();
+ Term[] fa = {SymbolTerm.makeSymbol(functor), new IntegerTerm(arity)};
+ throw new ExistenceException(this, 0, "procedure", new StructureTerm(SYM_SLASH_2, fa), "");
+ }
+ }
+ constr = clazz.getConstructor();
+ constr.setAccessible(true);
+ pred = (Predicate)constr.newInstance();
+ pred.setArgument(args, cont);
+ return pred;
+ } catch (NoSuchMethodException e) {
+ throw new SystemException(e.toString() + " in " + this.toString());
+ } catch (InstantiationException e) {
+ throw new SystemException(e.toString() + " in " + this.toString());
+ } catch (IllegalAccessException e) {
+ throw new SystemException(e.toString() + " in " + this.toString());
+ } catch (SecurityException e) {
+ throw new SystemException(e.toString() + " in " + this.toString());
+ } catch (IllegalArgumentException e) {
+ throw new SystemException(e.toString() + " in " + this.toString());
+ } catch (InvocationTargetException e) {
+ throw new SystemException(e.toString() + " in " + this.toString());
+ }
+ }
+}
+
+
diff --git a/src/builtin/Base/PRED_$call_closure_1.java b/src/builtin/Base/PRED_$call_closure_1.java
new file mode 100644
index 0000000..1615206
--- /dev/null
+++ b/src/builtin/Base/PRED_$call_closure_1.java
@@ -0,0 +1,47 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$call_closure'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$call_closure_1 extends Predicate {
+ Term arg1;
+ Predicate cont;
+
+ public PRED_$call_closure_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$call_closure_1() {}
+
+ public void setArgument(Term args[], Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "$call_closure(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ Predicate code;
+
+ // a1 must be closure
+ a1 = arg1.dereference();
+
+ if (! a1.isClosure())
+ return engine.fail();
+ code = ((ClosureTerm) a1).getCode();
+ code.cont = this.cont;
+ return code;
+ }
+}
+
+
diff --git a/src/builtin/Base/PRED_$cut_1.java b/src/builtin/Base/PRED_$cut_1.java
new file mode 100644
index 0000000..a8c75fe
--- /dev/null
+++ b/src/builtin/Base/PRED_$cut_1.java
@@ -0,0 +1,43 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$cut'/1</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_$cut_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_$cut_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$cut_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "$cut(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ // engine.setB0();
+ Term a1;
+ a1 = arg1;
+ a1 = a1.dereference();
+ if (! a1.isInteger()) {
+ throw new IllegalTypeException("integer", a1);
+ } else {
+ engine.cut(((IntegerTerm) a1).intValue());
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$end_exception_1.java b/src/builtin/Base/PRED_$end_exception_1.java
new file mode 100644
index 0000000..696c73d
--- /dev/null
+++ b/src/builtin/Base/PRED_$end_exception_1.java
@@ -0,0 +1,44 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$end_exception'/1<code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$end_exception_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$end_exception_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$end_exception_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$end_exception(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (! a1.isJavaObject())
+ throw new IllegalTypeException(this, 1, "java", a1);
+ Object obj = ((JavaObjectTerm)a1).object();
+ if (! (obj instanceof PRED_$begin_exception_1))
+ throw new SystemException("a1 must be an object of PRED_$begin_exception_1: " + this.toString());
+ PRED_$begin_exception_1 p = ((PRED_$begin_exception_1) obj);
+ p.outOfScope = true;
+ engine.trail.push(new OutOfScope(p));
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$end_sync_1.java b/src/builtin/Base/PRED_$end_sync_1.java
new file mode 100644
index 0000000..6e3949c
--- /dev/null
+++ b/src/builtin/Base/PRED_$end_sync_1.java
@@ -0,0 +1,43 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$end_sync'/1</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$end_sync_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$end_sync_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+ public PRED_$end_sync_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$end_sync(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (! a1.isJavaObject())
+ throw new IllegalTypeException(this, 1, "java", a1);
+ Object obj = ((JavaObjectTerm)a1).object();
+ if (! (obj instanceof PRED_$begin_sync_2))
+ throw new SystemException("a1 must be an object of PRED_$begin_sync_2: " + this);
+ PRED_$begin_sync_2 p = ((PRED_$begin_sync_2) obj);
+ p.outOfScope = true;
+ engine.trail.push(new OutOfScope(p));
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$erase_1.java b/src/builtin/Base/PRED_$erase_1.java
new file mode 100644
index 0000000..c57075d
--- /dev/null
+++ b/src/builtin/Base/PRED_$erase_1.java
@@ -0,0 +1,40 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$erase'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+class PRED_$erase_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$erase_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$erase_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$erase(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1 = arg1;
+ int idx;
+
+ a1 = a1.dereference();
+ if (! a1.isInteger())
+ throw new IllegalTypeException(this, 1, "integer", a1);
+ idx = ((IntegerTerm)a1).intValue();
+ engine.internalDB.erase(idx);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$fast_write_1.java b/src/builtin/Base/PRED_$fast_write_1.java
new file mode 100644
index 0000000..7ab5310
--- /dev/null
+++ b/src/builtin/Base/PRED_$fast_write_1.java
@@ -0,0 +1,34 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$fast_write'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_$fast_write_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$fast_write_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+ public PRED_$fast_write_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$fast_write(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1.dereference();
+ engine.getCurrentOutput().print(a1.toString());
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$fast_write_2.java b/src/builtin/Base/PRED_$fast_write_2.java
new file mode 100644
index 0000000..07d7efd
--- /dev/null
+++ b/src/builtin/Base/PRED_$fast_write_2.java
@@ -0,0 +1,57 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.PrintWriter;
+/**
+ * <code>'$fast_write'/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_$fast_write_2 extends Predicate {
+ Term arg1, arg2;
+
+ public PRED_$fast_write_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$fast_write_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2;}
+
+ public String toString() { return "$fast_write(" + arg1 + ", " + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ // print term
+ ((PrintWriter) stream).print(a2.dereference().toString());
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$fast_writeq_1.java b/src/builtin/Base/PRED_$fast_writeq_1.java
new file mode 100644
index 0000000..f1f0bee
--- /dev/null
+++ b/src/builtin/Base/PRED_$fast_writeq_1.java
@@ -0,0 +1,35 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$fast_writeq'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_$fast_writeq_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$fast_writeq_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$fast_writeq_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$fast_writeq(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1.dereference();
+ engine.getCurrentOutput().print(a1.toQuotedString());
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$fast_writeq_2.java b/src/builtin/Base/PRED_$fast_writeq_2.java
new file mode 100644
index 0000000..c858248
--- /dev/null
+++ b/src/builtin/Base/PRED_$fast_writeq_2.java
@@ -0,0 +1,56 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.PrintWriter;
+/**
+ * <code>'$fast_writeq'/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_$fast_writeq_2 extends Predicate {
+ Term arg1, arg2;
+
+ public PRED_$fast_writeq_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+ public PRED_$fast_writeq_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "$fast_writeq(" + arg1 + ", " + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ // print term
+ ((PrintWriter) stream).print(a2.dereference().toQuotedString());
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$get_current_B_1.java b/src/builtin/Base/PRED_$get_current_B_1.java
new file mode 100644
index 0000000..7954947
--- /dev/null
+++ b/src/builtin/Base/PRED_$get_current_B_1.java
@@ -0,0 +1,36 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$get_current_B'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$get_current_B_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$get_current_B_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$get_current_B_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$get_current_B(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+ if (! a1.unify(new IntegerTerm(engine.stack.top()), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$get_exception_1.java b/src/builtin/Base/PRED_$get_exception_1.java
new file mode 100644
index 0000000..f51c295
--- /dev/null
+++ b/src/builtin/Base/PRED_$get_exception_1.java
@@ -0,0 +1,37 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$get_exception'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$get_exception_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$get_exception_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$get_exception_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$get_exception(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ if (! a1.unify(engine.getException(), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$get_hash_manager_1.java b/src/builtin/Base/PRED_$get_hash_manager_1.java
new file mode 100644
index 0000000..91f2510
--- /dev/null
+++ b/src/builtin/Base/PRED_$get_hash_manager_1.java
@@ -0,0 +1,43 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$get_hash_manager'/1</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$get_hash_manager_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_$get_hash_manager_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$get_hash_manager_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "$get_hash_manager(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (! a1.isVariable())
+ throw new IllegalTypeException(this, 1, "variable", a1);
+ if (! a1.unify(new JavaObjectTerm(engine.getHashManager()), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$get_instances_2.java b/src/builtin/Base/PRED_$get_instances_2.java
new file mode 100644
index 0000000..822e6e1
--- /dev/null
+++ b/src/builtin/Base/PRED_$get_instances_2.java
@@ -0,0 +1,76 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$get_instances'/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.1
+*/
+class PRED_$get_instances_2 extends Predicate {
+ public Term arg1, arg2;
+ public static SymbolTerm COMMA = SymbolTerm.makeSymbol(",", 2);
+
+ public PRED_$get_instances_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$get_instances_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "$get_instances(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int idx;
+
+ a1 = a1.dereference();
+ if (a1.isNil())
+ return engine.fail();
+ if (! a1.isList())
+ throw new IllegalTypeException(this, 1, "list", a1);
+ Term x = Prolog.Nil;
+ Term tmp = a1;
+ while(! tmp.isNil()) {
+ if (! tmp.isList())
+ throw new IllegalTypeException(this, 1, "list", a1);
+ Term car = ((ListTerm)tmp).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (! car.isInteger())
+ throw new RepresentationException(this, 1, "integer");
+ // car is an integer
+ int i = ((IntegerTerm)car).intValue();
+ Term e = engine.internalDB.get(i);
+ if (e != null) {
+ Term[] arg = {e, car};
+ x = new ListTerm(new StructureTerm(COMMA, arg), x);
+ }
+ // else {
+ // System.out.println("index " + i + " is deleted.");
+ // }
+
+ // if (e == null)
+ // throw new SystemException("invalid index");
+ // Term[] arg = {e, car};
+ // x = new ListTerm(new StructureTerm(COMMA, arg), x);
+ tmp = ((ListTerm)tmp).cdr().dereference();
+ }
+ if (! a2.unify(x, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$get_level_1.java b/src/builtin/Base/PRED_$get_level_1.java
new file mode 100644
index 0000000..b954e93
--- /dev/null
+++ b/src/builtin/Base/PRED_$get_level_1.java
@@ -0,0 +1,40 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$get_level'/1</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_$get_level_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_$get_level_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$get_level_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "$get_level(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ // engine.setB0();
+ Term a1;
+ a1 = arg1;
+ if (! a1.unify(new IntegerTerm(engine.B0), engine.trail)) {
+ return engine.fail();
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$get_prolog_impl_flag_2.java b/src/builtin/Base/PRED_$get_prolog_impl_flag_2.java
new file mode 100644
index 0000000..883f5f1
--- /dev/null
+++ b/src/builtin/Base/PRED_$get_prolog_impl_flag_2.java
@@ -0,0 +1,93 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$get_prolog_impl_flag'/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$get_prolog_impl_flag_2 extends Predicate {
+ static SymbolTerm TRUE = SymbolTerm.makeSymbol("true");
+ static SymbolTerm FALSE = SymbolTerm.makeSymbol("false");
+ static SymbolTerm BOUNDED = SymbolTerm.makeSymbol("bounded");
+ static SymbolTerm MAX_INTEGER = SymbolTerm.makeSymbol("max_integer");
+ static SymbolTerm MIN_INTEGER = SymbolTerm.makeSymbol("min_integer");
+ static SymbolTerm INTEGER_ROUNDING_FUNCTION = SymbolTerm.makeSymbol("integer_rounding_function");
+ static SymbolTerm CHAR_CONVERSION = SymbolTerm.makeSymbol("char_conversion");
+ static SymbolTerm DEBUG = SymbolTerm.makeSymbol("debug");
+ static SymbolTerm MAX_ARITY = SymbolTerm.makeSymbol("max_arity");
+ static SymbolTerm UNKNOWN = SymbolTerm.makeSymbol("unknown");
+ static SymbolTerm DOUBLE_QUOTES = SymbolTerm.makeSymbol("double_quotes");
+ static SymbolTerm PRINT_STACK_TRACE = SymbolTerm.makeSymbol("print_stack_trace");
+
+ public Term arg1, arg2;
+
+ public PRED_$get_prolog_impl_flag_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$get_prolog_impl_flag_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "$get_prolog_impl_flag(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+
+ if (a1.equals(BOUNDED)) {
+ if (engine.isBounded()) {
+ if (! a2.unify(TRUE, engine.trail))
+ return engine.fail();
+ } else {
+ if (! a2.unify(FALSE, engine.trail))
+ return engine.fail();
+ }
+ } else if (a1.equals(MAX_INTEGER)) {
+ if (! a2.unify(new IntegerTerm(engine.getMaxInteger()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(MIN_INTEGER)) {
+ if (! a2.unify(new IntegerTerm(engine.getMinInteger()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(INTEGER_ROUNDING_FUNCTION)) {
+ if (! a2.unify(SymbolTerm.makeSymbol(engine.getIntegerRoundingFunction()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(CHAR_CONVERSION)) {
+ if (! a2.unify(SymbolTerm.makeSymbol(engine.getCharConversion()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(DEBUG)) {
+ if (! a2.unify(SymbolTerm.makeSymbol(engine.getDebug()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(MAX_ARITY)) {
+ if (! a2.unify(new IntegerTerm(engine.getMaxArity()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(UNKNOWN)) {
+ if (! a2.unify(SymbolTerm.makeSymbol(engine.getUnknown()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(DOUBLE_QUOTES)) {
+ if (! a2.unify(SymbolTerm.makeSymbol(engine.getDoubleQuotes()), engine.trail))
+ return engine.fail();
+ } else if (a1.equals(PRINT_STACK_TRACE)) {
+ if (! a2.unify(SymbolTerm.makeSymbol(engine.getPrintStackTrace()), engine.trail))
+ return engine.fail();
+ } else {
+ return engine.fail();
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$get_stream_manager_1.java b/src/builtin/Base/PRED_$get_stream_manager_1.java
new file mode 100644
index 0000000..9425460
--- /dev/null
+++ b/src/builtin/Base/PRED_$get_stream_manager_1.java
@@ -0,0 +1,43 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$get_stream_manager'/1</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$get_stream_manager_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_$get_stream_manager_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$get_stream_manager_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "$get_stream_manager(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (! a1.isVariable())
+ throw new IllegalTypeException(this, 1, "variable", a1);
+ if (! a1.unify(new JavaObjectTerm(engine.getStreamManager()), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$hash_adda_3.java b/src/builtin/Base/PRED_$hash_adda_3.java
new file mode 100644
index 0000000..325e517
--- /dev/null
+++ b/src/builtin/Base/PRED_$hash_adda_3.java
@@ -0,0 +1,67 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>'$hash_adda'/3</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$hash_adda_3 extends Predicate {
+ public static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public Term arg1, arg2, arg3;
+
+ public PRED_$hash_adda_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_$hash_adda_3(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "$hash_adda(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ Term elem = ((HashtableOfTerm) hash).get(a2);
+ if (elem == null)
+ elem = SYM_NIL;
+ a3 = a3.dereference();
+ ((HashtableOfTerm) hash).put(a2, new ListTerm(a3, elem));
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$hash_addz_3.java b/src/builtin/Base/PRED_$hash_addz_3.java
new file mode 100644
index 0000000..f93b9b3
--- /dev/null
+++ b/src/builtin/Base/PRED_$hash_addz_3.java
@@ -0,0 +1,83 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>'$hash_addz'/3</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$hash_addz_3 extends Predicate {
+ public static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public Term arg1, arg2, arg3;
+
+ public PRED_$hash_addz_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_$hash_addz_3(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "$hash_addz(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ Term elem = ((HashtableOfTerm) hash).get(a2);
+ if (elem == null)
+ elem = SYM_NIL;
+ a3 = a3.dereference();
+ if (elem.isNil()) {
+ elem = new ListTerm(a3, elem);
+ } else {
+ Term x = elem;
+ Term y;
+ while(true) {
+ if (! x.isList())
+ throw new InternalException(this + ": the valus of " + a2 + " is not list structure");
+ y = ((ListTerm)x).cdr().dereference();
+ if (y.isNil()) {
+ ((ListTerm)x).setCdr(new ListTerm(a3, SYM_NIL));
+ break;
+ }
+ x = y;
+ }
+ }
+ ((HashtableOfTerm) hash).put(a2, elem);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$hash_remove_first_3.java b/src/builtin/Base/PRED_$hash_remove_first_3.java
new file mode 100644
index 0000000..7c2f201
--- /dev/null
+++ b/src/builtin/Base/PRED_$hash_remove_first_3.java
@@ -0,0 +1,95 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>'$hash_remove_first'/3</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$hash_remove_first_3 extends Predicate {
+ public static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public Term arg1, arg2, arg3;
+
+ public PRED_$hash_remove_first_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_$hash_remove_first_3(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "$hash_remove_first(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ Term elem = ((HashtableOfTerm) hash).get(a2);
+ if (elem == null || elem.isNil())
+ return cont;
+ a3 = a3.dereference();
+ Term x = elem;
+ Term x0 = Prolog.Nil;
+ Term y,z;
+ while(! x.isNil()) {
+ if (! x.isList())
+ throw new InternalException(this + ": the valus of " + a2 + " is not list structure");
+ y = ((ListTerm)x).car().dereference();
+ z = ((ListTerm)x).cdr().dereference();
+ if (y.equals(a3)) {
+ if (z.isNil()) {
+ if (x0.isList())
+ ((ListTerm)x0).setCdr(Prolog.Nil);
+ else
+ elem = Prolog.Nil;
+ } else {
+ ((ListTerm)x).setCar(((ListTerm)z).car().dereference());
+ ((ListTerm)x).setCdr(((ListTerm)z).cdr().dereference());
+ }
+ break;
+ }
+ x0 = x;
+ x = z;
+ }
+ if (elem.isNil() && a2.isInteger()) {
+ ((HashtableOfTerm)hash).remove(a2);
+ // System.out.println("################ key " + a2 + " is removed");
+ } else {
+ ((HashtableOfTerm) hash).put(a2, elem);
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$insert_2.java b/src/builtin/Base/PRED_$insert_2.java
new file mode 100644
index 0000000..7884517
--- /dev/null
+++ b/src/builtin/Base/PRED_$insert_2.java
@@ -0,0 +1,48 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$insert'/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.1
+*/
+class PRED_$insert_2 extends Predicate {
+ public Term arg1, arg2;
+
+ public PRED_$insert_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$insert_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "$insert(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int idx;
+
+ a2 = a2.dereference();
+ if (! a2.isVariable())
+ throw new IllegalTypeException(this, 2, "variable", a2);
+ a1 = a1.dereference();
+ idx = engine.internalDB.insert(a1);
+ if (! a2.unify(new IntegerTerm(idx), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$neck_cut_0.java b/src/builtin/Base/PRED_$neck_cut_0.java
new file mode 100644
index 0000000..97238fb
--- /dev/null
+++ b/src/builtin/Base/PRED_$neck_cut_0.java
@@ -0,0 +1,32 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$neck_cut'/0</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_$neck_cut_0 extends Predicate {
+
+ public PRED_$neck_cut_0(Predicate cont) {
+ this.cont = cont;
+ }
+
+ public PRED_$neck_cut_0(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ this.cont = cont;
+ }
+
+ public int arity() { return 0; }
+
+ public String toString() {
+ return "$neck_cut";
+ }
+
+ public Predicate exec(Prolog engine) {
+ // engine.setB0();
+ engine.neckCut();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$print_stack_trace_1.java b/src/builtin/Base/PRED_$print_stack_trace_1.java
new file mode 100644
index 0000000..11d1dc9
--- /dev/null
+++ b/src/builtin/Base/PRED_$print_stack_trace_1.java
@@ -0,0 +1,48 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$print_stack_trace'/1</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+class PRED_$print_stack_trace_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_$print_stack_trace_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$print_stack_trace_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "$print_stack_trace(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (! a1.isJavaObject())
+ throw new IllegalTypeException(this, 1, "java", a1);
+ Object obj = ((JavaObjectTerm) a1).object();
+ if (obj instanceof InterruptedException)
+ System.exit(1);
+ if (engine.getPrintStackTrace().equals("on"))
+ ((Exception) obj).printStackTrace();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$read_token0_3.java b/src/builtin/Base/PRED_$read_token0_3.java
new file mode 100644
index 0000000..d9fec05
--- /dev/null
+++ b/src/builtin/Base/PRED_$read_token0_3.java
@@ -0,0 +1,95 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ * <code>'$read_token0'/3</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ * @since 0.7
+ */
+class PRED_$read_token0_3 extends Predicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_$read_token0_3(Term a1, Term a2, Term a3, Predicate cont){
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+ public PRED_$read_token0_3(){}
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "$read_token0(" + arg1 + ", " + arg2 + "," + arg3 + ")";
+ }
+
+ /* The a1 must be user, user_input, and
+ java.io.PushbackReader, otherwise fails. */
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Object stream = null;
+ StringBuffer s;
+ int type;
+ Term token;
+
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read token
+ s = new StringBuffer();
+ try {
+ type = Token.read_token(s, (PushbackReader)stream);
+ switch(type) {
+ case 'I':
+ token = new IntegerTerm(Integer.parseInt(s.toString()));
+ break;
+ case 'D':
+ token = new DoubleTerm(Double.parseDouble(s.toString()));
+ break;
+ case 'S':
+ char[] chars = (s.toString()).toCharArray();
+ token = Prolog.Nil;
+ for (int i=chars.length; i>0; i--){
+ token = new ListTerm(new IntegerTerm((int)chars[i-1]), token);
+ }
+ break;
+ default :
+ token = SymbolTerm.makeSymbol(s.toString());
+ break;
+ }
+ } catch (Exception e) {
+ throw new JavaException(this, 1, e);
+ }
+ if (! a2.unify(new IntegerTerm(type), engine.trail))
+ return engine.fail();
+ if (! a3.unify(token, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
+
diff --git a/src/builtin/Base/PRED_$set_exception_1.java b/src/builtin/Base/PRED_$set_exception_1.java
new file mode 100644
index 0000000..21bf8db
--- /dev/null
+++ b/src/builtin/Base/PRED_$set_exception_1.java
@@ -0,0 +1,37 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$set_exception'/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$set_exception_1 extends Predicate {
+ Term arg1;
+
+ public PRED_$set_exception_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_$set_exception_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "$set_exception(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ engine.setException(a1);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$set_prolog_impl_flag_2.java b/src/builtin/Base/PRED_$set_prolog_impl_flag_2.java
new file mode 100644
index 0000000..250cc06
--- /dev/null
+++ b/src/builtin/Base/PRED_$set_prolog_impl_flag_2.java
@@ -0,0 +1,71 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$set_prolog_impl_flag'/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$set_prolog_impl_flag_2 extends Predicate {
+ static SymbolTerm CHAR_CONVERSION = SymbolTerm.makeSymbol("char_conversion");
+ static SymbolTerm DEBUG = SymbolTerm.makeSymbol("debug");
+ static SymbolTerm UNKNOWN = SymbolTerm.makeSymbol("unknown");
+ static SymbolTerm DOUBLE_QUOTES = SymbolTerm.makeSymbol("double_quotes");
+ static SymbolTerm PRINT_STACK_TRACE = SymbolTerm.makeSymbol("print_stack_trace");
+
+ public Term arg1, arg2;
+
+ public PRED_$set_prolog_impl_flag_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$set_prolog_impl_flag_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "$set_prolog_impl_flag(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+
+ if (a1.equals(CHAR_CONVERSION)) {
+ if (! a2.isSymbol())
+ return engine.fail();
+ engine.setCharConversion(((SymbolTerm)a2).name());
+ } else if (a1.equals(DEBUG)) {
+ if (! a2.isSymbol())
+ return engine.fail();
+ engine.setDebug(((SymbolTerm)a2).name());
+ } else if (a1.equals(UNKNOWN)) {
+ if (! a2.isSymbol())
+ return engine.fail();
+ engine.setUnknown(((SymbolTerm)a2).name());
+ } else if (a1.equals(DOUBLE_QUOTES)) {
+ if (! a2.isSymbol())
+ return engine.fail();
+ engine.setDoubleQuotes(((SymbolTerm)a2).name());
+ } else if (a1.equals(PRINT_STACK_TRACE)) {
+ if (! a2.isSymbol())
+ return engine.fail();
+ engine.setPrintStackTrace(((SymbolTerm)a2).name());
+ } else {
+ return engine.fail();
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$statistics_2.java b/src/builtin/Base/PRED_$statistics_2.java
new file mode 100644
index 0000000..8224c5b
--- /dev/null
+++ b/src/builtin/Base/PRED_$statistics_2.java
@@ -0,0 +1,78 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$statistics'/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+class PRED_$statistics_2 extends Predicate {
+ public static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ public static SymbolTerm SYM_RUNTIME = SymbolTerm.makeSymbol("runtime");
+ public static SymbolTerm SYM_TRAIL = SymbolTerm.makeSymbol("trail");
+ public static SymbolTerm SYM_CHOICE = SymbolTerm.makeSymbol("choice");
+
+ Term arg1, arg2;
+
+ public PRED_$statistics_2(Term a1, Term a2, Predicate cont){
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+ public PRED_$statistics_2(){}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString(){ return "$statistics(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine){
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Term result = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (! a1.isSymbol()) {
+ throw new IllegalTypeException(this, 1, "atom", a1);
+ } else if (a1.equals(SYM_RUNTIME)) {
+ long val1, val2;
+ Term start, previous;
+ val1 = System.currentTimeMillis() - engine.getStartRuntime();
+ val2 = val1 - engine.getPreviousRuntime();
+ engine.setPreviousRuntime(val1);
+ start = new IntegerTerm((int)val1);
+ previous = new IntegerTerm((int)val2);
+ result = new ListTerm(start, new ListTerm(previous, Nil));
+ } else if (a1.equals(SYM_TRAIL)) {
+ int top, max;
+ Term free, used;
+ top = engine.trail.top();
+ max = engine.trail.max();
+ used = new IntegerTerm(top);
+ free = new IntegerTerm(max - top);
+ result = new ListTerm(used, new ListTerm(free, Nil));
+ } else if (a1.equals(SYM_CHOICE)) {
+ int top, max;
+ Term free, used;
+ top = engine.stack.top();
+ max = engine.stack.max();
+ used = new IntegerTerm(top);
+ free = new IntegerTerm(max - top);
+ result = new ListTerm(used, new ListTerm(free, Nil));
+ } else {
+ return engine.fail();
+ }
+ if (! a2.unify(result, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$term_hash_2.java b/src/builtin/Base/PRED_$term_hash_2.java
new file mode 100644
index 0000000..df6194b
--- /dev/null
+++ b/src/builtin/Base/PRED_$term_hash_2.java
@@ -0,0 +1,41 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>'$term_hash'/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_$term_hash_2 extends Predicate {
+ Term arg1, arg2;
+
+ public PRED_$term_hash_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$term_hash_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2;}
+
+ public String toString() { return "$term_hash(" + arg1 + ", " + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ if (! a2.unify(new IntegerTerm(a1.hashCode()), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$univ_2.java b/src/builtin/Base/PRED_$univ_2.java
new file mode 100644
index 0000000..a00ab7c
--- /dev/null
+++ b/src/builtin/Base/PRED_$univ_2.java
@@ -0,0 +1,103 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>'$univ'/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_$univ_2 extends Predicate {
+ static SymbolTerm SYM_DOT = SymbolTerm.makeSymbol(".");
+ static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public Term arg1, arg2;
+
+ public PRED_$univ_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$univ_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "=..(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ if (a1.isSymbol() || a1.isNumber() || a1.isJavaObject() || a1.isClosure()) {
+ if (! a2.unify(new ListTerm(a1, SYM_NIL), engine.trail))
+ return engine.fail();
+ } else if (a1.isList()) {
+ Term t = new ListTerm(((ListTerm)a1).cdr(), SYM_NIL);
+ t = new ListTerm(((ListTerm)a1).car(), t);
+ t = new ListTerm(SYM_DOT, t);
+ if (! a2.unify(t, engine.trail))
+ return engine.fail();
+ } else if (a1.isStructure()) {
+ SymbolTerm sym = SymbolTerm.makeSymbol(((StructureTerm)a1).functor().name());
+ Term[] args = ((StructureTerm)a1).args();
+ Term t = SYM_NIL;
+ for (int i=args.length; i>0; i--)
+ t = new ListTerm(args[i-1], t);
+ if (! a2.unify(new ListTerm(sym, t), engine.trail))
+ return engine.fail();
+ } else if (a1.isVariable()) {
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ else if (a2.equals(SYM_NIL))
+ throw new IllegalDomainException(this, 2, "non_empty_list", a2);
+ else if (! a2.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ Term head = ((ListTerm)a2).car().dereference();
+ Term tail = ((ListTerm)a2).cdr().dereference();
+ if (head.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (tail.equals(SYM_NIL)) {
+ if (head.isSymbol() || head.isNumber() || head.isJavaObject() || head.isClosure()) {
+ if (! a1.unify(head, engine.trail))
+ return engine.fail();
+ return cont;
+ } else {
+ throw new IllegalTypeException(this, 2, "atomic", head);
+ }
+ }
+ if (! head.isSymbol())
+ throw new IllegalTypeException(this, 2, "atom", head);
+ Term x = tail;
+ while(! x.equals(SYM_NIL)) {
+ if (x.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! x.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ x = ((ListTerm)x).cdr().dereference();
+ }
+ int n = ((ListTerm)a2).length() - 1;
+ SymbolTerm sym = SymbolTerm.makeSymbol(((SymbolTerm)head).name(), n);
+ Term[] args = new Term[n];
+ for(int i=0; i<n; i++) {
+ args[i] = ((ListTerm)tail).car().dereference();
+ tail = ((ListTerm)tail).cdr().dereference();
+ }
+ if (! a1.unify(new StructureTerm(sym, args), engine.trail))
+ return engine.fail();
+ } else {
+ return engine.fail();
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_$write_toString_2.java b/src/builtin/Base/PRED_$write_toString_2.java
new file mode 100644
index 0000000..0a45c3c
--- /dev/null
+++ b/src/builtin/Base/PRED_$write_toString_2.java
@@ -0,0 +1,60 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.PrintWriter;
+/**
+ * <code>'$write_toString'/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_$write_toString_2 extends Predicate {
+ Term arg1, arg2;
+
+ public PRED_$write_toString_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_$write_toString_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2;}
+
+ public String toString() { return "$write_toString(" + arg1 + ", " + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ a2 = a2.dereference();
+ if (! a2.isJavaObject())
+ throw new IllegalTypeException(this, 2, "java", a2);
+ // print java
+ ((PrintWriter) stream).print(((JavaObjectTerm)a2).object().toString());
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_arg_3.java b/src/builtin/Base/PRED_arg_3.java
new file mode 100644
index 0000000..8a6efe4
--- /dev/null
+++ b/src/builtin/Base/PRED_arg_3.java
@@ -0,0 +1,70 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>arg/3</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_arg_3 extends Predicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_arg_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_arg_3(){}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3 ; }
+
+ public String toString() { return "arg(" + arg1 + "," + arg2 + "," + arg3 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Term[] args;
+ int arity, argNo;
+
+ a1 = a1.dereference();
+ if(a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ else if(! a1.isInteger())
+ throw new IllegalTypeException(this, 1, "integer", a1);
+ a2 = a2.dereference();
+ if (a2.isList()) {
+ args = new Term[2];
+ args[0] = ((ListTerm)a2).car();
+ args[1] = ((ListTerm)a2).cdr();
+ arity = 2;
+ } else if (a2.isStructure()) {
+ args = ((StructureTerm)a2).args();
+ arity = ((StructureTerm)a2).arity();
+ } else if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else {
+ throw new IllegalTypeException(this, 2, "compound", a2);
+ }
+ argNo = ((IntegerTerm)a1).intValue();
+ if (argNo < 0)
+ throw new IllegalDomainException(this, 1, "not_less_than_zero", a1);
+ if (argNo > arity || argNo < 1)
+ return engine.fail();
+ if (! a3.unify(args[argNo-1], engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_atom_chars_2.java b/src/builtin/Base/PRED_atom_chars_2.java
new file mode 100644
index 0000000..0c58b7e
--- /dev/null
+++ b/src/builtin/Base/PRED_atom_chars_2.java
@@ -0,0 +1,82 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>atom_chars/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_atom_chars_2 extends Predicate {
+ static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ Term arg1, arg2;
+
+ public PRED_atom_chars_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_atom_chars_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString() { return "atom_chars(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+ if (a1.isVariable()) { // atom_chars(-Atom, +CharList)
+ if (a2.isNil()) {
+ if (! a1.unify(SymbolTerm.makeSymbol(""), engine.trail))
+ return engine.fail();
+ return cont;
+ } else if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (! a2.isList()) {
+ throw new IllegalTypeException(this, 2, "list", a2);
+ }
+ StringBuffer sb = new StringBuffer();
+ Term x = a2;
+ while(! x.isNil()) {
+ if (x.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! x.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ Term car = ((ListTerm)x).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! car.isSymbol() || ((SymbolTerm)car).name().length() != 1)
+ throw new IllegalTypeException(this, 2, "character", a2);
+ sb.append(((SymbolTerm)car).name());
+ x = ((ListTerm)x).cdr().dereference();
+ }
+ if (! a1.unify(SymbolTerm.makeSymbol(sb.toString()), engine.trail))
+ return engine.fail();
+ return cont;
+ } else if (a2.isNil() || a2.isVariable() || a2.isList()) { // atom_chars(+Atom, ?CharList)
+ if (! a1.isSymbol())
+ throw new IllegalTypeException(this, 1, "atom", a1);
+ String s = ((SymbolTerm)a1).name();
+ Term x = Nil;
+ for (int i=s.length(); i>0; i--) {
+ x = new ListTerm(SymbolTerm.makeSymbol(s.substring(i-1,i)), x);
+ }
+ if(! a2.unify(x, engine.trail))
+ return engine.fail();
+ return cont;
+ } else {
+ return engine.fail();
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_atom_codes_2.java b/src/builtin/Base/PRED_atom_codes_2.java
new file mode 100644
index 0000000..4f4791b
--- /dev/null
+++ b/src/builtin/Base/PRED_atom_codes_2.java
@@ -0,0 +1,75 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>atom_codes/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_atom_codes_2 extends Predicate {
+ static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ Term arg1, arg2;
+
+ public PRED_atom_codes_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_atom_codes_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString() { return "atom_codes(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+ if (a1.isVariable()) { // atom_codes(-Atom, +CharCodeList)
+ StringBuffer sb = new StringBuffer();
+ Term x = a2;
+ while(! x.isNil()) {
+ if (x.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! x.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ Term car = ((ListTerm)x).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! car.isInteger())
+ throw new RepresentationException(this, 2, "character_code");
+ // car is an integer
+ int i = ((IntegerTerm)car).intValue();
+ if (! Character.isDefined((char)i))
+ throw new RepresentationException(this, 2, "character_code");
+ sb.append((char)i);
+ x = ((ListTerm)x).cdr().dereference();
+ }
+ if (! a1.unify(SymbolTerm.makeSymbol(sb.toString()), engine.trail))
+ return engine.fail();
+ return cont;
+ } else { // atom_codes(+Atom, ?CharCodeList)
+ if (! a1.isSymbol())
+ throw new IllegalTypeException(this, 1, "atom", a1);
+ char[] chars = ((SymbolTerm)a1).name().toCharArray();
+ Term x = Nil;
+ for (int i=chars.length; i>0; i--) {
+ x = new ListTerm(new IntegerTerm((int)chars[i-1]), x);
+ }
+ if(! a2.unify(x, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_atom_concat_3.java b/src/builtin/Base/PRED_atom_concat_3.java
new file mode 100644
index 0000000..53d254b
--- /dev/null
+++ b/src/builtin/Base/PRED_atom_concat_3.java
@@ -0,0 +1,73 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>atom_concat/3</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_atom_concat_3 extends Predicate {
+ static SymbolTerm AC_2 = SymbolTerm.makeSymbol("ac", 2);
+ public Term arg1, arg2, arg3;
+
+ public PRED_atom_concat_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_atom_concat_3(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "atom_concat(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ a3 = a3.dereference();
+ if (a3.isSymbol()) {
+ String str3 = ((SymbolTerm)a3).name();
+ int endIndex = str3.length();
+ Term t = Prolog.Nil;
+ for (int i=0; i<=endIndex; i++) {
+ Term[] args = {SymbolTerm.makeSymbol(str3.substring(0, i)),
+ SymbolTerm.makeSymbol(str3.substring(i, endIndex))};
+ t = new ListTerm(new StructureTerm(AC_2, args), t);
+ }
+ Term[] args12 = {a1,a2};
+ return new PRED_$member_in_reverse_2(new StructureTerm(AC_2, args12), t, cont);
+ } else if (! a3.isVariable()) {
+ throw new IllegalTypeException(this, 3, "atom", a3);
+ }
+ // a3 is a variable
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! a1.isSymbol())
+ throw new IllegalTypeException(this, 1, "integer", a1);
+ if (! a2.isSymbol())
+ throw new IllegalTypeException(this, 2, "integer", a2);
+ String str3 = ((SymbolTerm) a1).name().concat(((SymbolTerm) a2).name());
+ if (! a3.unify(SymbolTerm.makeSymbol(str3), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_atom_length_2.java b/src/builtin/Base/PRED_atom_length_2.java
new file mode 100644
index 0000000..dfcd636
--- /dev/null
+++ b/src/builtin/Base/PRED_atom_length_2.java
@@ -0,0 +1,62 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>atom_lengt/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_atom_length_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_atom_length_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_atom_length_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "atom_length(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int length;
+
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (! a1.isSymbol())
+ throw new IllegalTypeException(this, 1, "atom", a1);
+ length = ((SymbolTerm)a1).name().length();
+ if (a2.isVariable()) {
+ if (! a2.unify(new IntegerTerm(length), engine.trail))
+ return engine.fail();
+ } else if (a2.isInteger()) {
+ int n = ((IntegerTerm)a2).intValue();
+ if (n < 0)
+ throw new IllegalDomainException(this, 2, "not_less_than_zero", a2);
+ if (length != n)
+ return engine.fail();
+ } else {
+ throw new IllegalTypeException(this, 1, "integer", a2);
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_char_code_2.java b/src/builtin/Base/PRED_char_code_2.java
new file mode 100644
index 0000000..54fe40e
--- /dev/null
+++ b/src/builtin/Base/PRED_char_code_2.java
@@ -0,0 +1,61 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>char_code/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_char_code_2 extends Predicate {
+ // static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ Term arg1, arg2;
+
+ public PRED_char_code_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_char_code_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString() { return "char_code(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+ if (a1.isVariable()) { // char_code(-Char, +CharCode)
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (! a2.isInteger()) {
+ throw new IllegalTypeException(this, 2, "integer", a2);
+ }
+ int i = ((IntegerTerm)a2).intValue();
+ if (! Character.isDefined(i))
+ throw new RepresentationException(this, 2, "character_code");
+ if (! a1.unify(SymbolTerm.makeSymbol(String.valueOf((char)i)), engine.trail))
+ return engine.fail();
+ } else if (a1.isSymbol()) { // char_code(+Char, ?CharCode)
+ String s = ((SymbolTerm)a1).name();
+ if (s.length() != 1)
+ throw new IllegalTypeException(this, 1, "character", a1);
+ if(! a2.unify(new IntegerTerm((int)s.charAt(0)), engine.trail))
+ return engine.fail();
+ } else {
+ return engine.fail();
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_close_2.java b/src/builtin/Base/PRED_close_2.java
new file mode 100644
index 0000000..d76c242
--- /dev/null
+++ b/src/builtin/Base/PRED_close_2.java
@@ -0,0 +1,140 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ * <code>close/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_close_2 extends Predicate {
+ public static SymbolTerm SYM_ALIAS_1 = SymbolTerm.makeSymbol("alias", 1);
+ public static SymbolTerm SYM_FORCE_1 = SymbolTerm.makeSymbol("force", 1);
+ public static SymbolTerm SYM_TRUE = SymbolTerm.makeSymbol("true");
+ public static SymbolTerm SYM_FALSE = SymbolTerm.makeSymbol("false");
+ public Term arg1, arg2;
+
+ public PRED_close_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_close_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "close(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ boolean forceFlag = false;
+ Object stream = null;
+
+ // close options
+ a2 = a2.dereference();
+ Term tmp = a2;
+ while (! tmp.isNil()) {
+ if (tmp.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! tmp.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ Term car = ((ListTerm) tmp).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (car.isStructure()) {
+ SymbolTerm functor = ((StructureTerm) car).functor();
+ Term[] args = ((StructureTerm) car).args();
+ if (functor.equals(SYM_FORCE_1)) {
+ Term bool = args[0].dereference();
+ if (bool.equals(SYM_TRUE))
+ forceFlag = true;
+ else if (bool.equals(SYM_FALSE))
+ forceFlag = false;
+ else
+ throw new IllegalDomainException(this, 2, "close_option", car);
+ } else {
+ throw new IllegalDomainException(this, 2, "close_option", car);
+ }
+ } else {
+ throw new IllegalDomainException(this, 2, "close_option", car);
+ }
+ tmp = ((ListTerm) tmp).cdr().dereference();
+ }
+ //stream
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (stream instanceof PushbackReader) {
+ PushbackReader in = (PushbackReader) stream;
+ if (in.equals(engine.getUserInput()))
+ return cont;
+ if (in.equals(engine.getCurrentInput()))
+ engine.setCurrentInput(engine.getUserInput());
+ try {
+ in.close();
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ } else if (stream instanceof PrintWriter) {
+ PrintWriter out = (PrintWriter) stream;
+ if (out.checkError()) {
+ if (! forceFlag)
+ throw new SystemException("output stream error");
+ }
+ out.flush();
+ if (out.equals(engine.getUserOutput()) || out.equals(engine.getUserError()))
+ return cont;
+ if (out.equals(engine.getCurrentOutput()))
+ engine.setCurrentOutput(engine.getUserOutput());
+ out.close();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ // delete associated entries from the stream manager
+ HashtableOfTerm streamManager = engine.getStreamManager();
+ if (a1.isSymbol()) {
+ streamManager.remove(engine.getStreamManager().get(a1));
+ streamManager.remove(a1);
+ } else if (a1.isJavaObject()) {
+ Term tmp2 = streamManager.get(a1);
+ while (! tmp2.isNil()) {
+ Term car = ((ListTerm) tmp2).car().dereference();
+ if (car.isStructure()) {
+ SymbolTerm functor = ((StructureTerm) car).functor();
+ Term[] args = ((StructureTerm) car).args();
+ if (functor.equals(SYM_ALIAS_1)) {
+ Term alias = args[0].dereference();
+ streamManager.remove(alias);
+ }
+ }
+ tmp2 = ((ListTerm) tmp2).cdr().dereference();
+ }
+ streamManager.remove(a1);
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_current_engine_1.java b/src/builtin/Base/PRED_current_engine_1.java
new file mode 100644
index 0000000..ef155ea
--- /dev/null
+++ b/src/builtin/Base/PRED_current_engine_1.java
@@ -0,0 +1,37 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>current_engine/1</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_current_engine_1 extends Predicate {
+ Term arg1;
+
+ public PRED_current_engine_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+ public PRED_current_engine_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "current_engine(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (! a1.unify(new JavaObjectTerm(engine), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_current_input_1.java b/src/builtin/Base/PRED_current_input_1.java
new file mode 100644
index 0000000..16e4512
--- /dev/null
+++ b/src/builtin/Base/PRED_current_input_1.java
@@ -0,0 +1,42 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>current_input/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_current_input_1 extends Predicate {
+ Term arg1;
+
+ public PRED_current_input_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+ public PRED_current_input_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "current_input(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ ((VariableTerm)a1).bind(new JavaObjectTerm(engine.getCurrentInput()), engine.trail);
+ } else if (a1.isJavaObject()) {
+ if (! a1.unify(new JavaObjectTerm(engine.getCurrentInput()), engine.trail))
+ return engine.fail();
+ } else {
+ throw new IllegalDomainException(this,1,"stream",a1);
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_current_output_1.java b/src/builtin/Base/PRED_current_output_1.java
new file mode 100644
index 0000000..58e2566
--- /dev/null
+++ b/src/builtin/Base/PRED_current_output_1.java
@@ -0,0 +1,42 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>current_output/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_current_output_1 extends Predicate {
+ Term arg1;
+
+ public PRED_current_output_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+ public PRED_current_output_1() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "current_output(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ ((VariableTerm)a1).bind(new JavaObjectTerm(engine.getCurrentOutput()), engine.trail);
+ } else if (a1.isJavaObject()) {
+ if (! a1.unify(new JavaObjectTerm(engine.getCurrentOutput()), engine.trail))
+ return engine.fail();
+ } else {
+ throw new IllegalDomainException(this,1,"stream",a1);
+ }
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_flush_output_1.java b/src/builtin/Base/PRED_flush_output_1.java
new file mode 100644
index 0000000..9b19516
--- /dev/null
+++ b/src/builtin/Base/PRED_flush_output_1.java
@@ -0,0 +1,55 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.PrintWriter;
+/**
+ * <code>flush_output/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_flush_output_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_flush_output_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_flush_output_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "flush_output(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+ Object stream = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ ((PrintWriter)stream).flush();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_functor_3.java b/src/builtin/Base/PRED_functor_3.java
new file mode 100644
index 0000000..81f6690
--- /dev/null
+++ b/src/builtin/Base/PRED_functor_3.java
@@ -0,0 +1,97 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>functor/3</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_functor_3 extends Predicate {
+ static SymbolTerm SYM_DOT = SymbolTerm.makeSymbol(".");
+ Term arg1, arg2, arg3;
+
+ public PRED_functor_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_functor_3() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+ public String toString() { return "functor(" + arg1 + "," + arg2 + "," + arg3 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ // functor(?X,+Y,+Z)
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (!a2.isSymbol() && !a2.isNumber() && !a2.isJavaObject() && !a2.isClosure())
+ throw new IllegalTypeException(this, 2, "atomic", a2);
+ a3 = a3.dereference();
+ if (a3.isVariable())
+ throw new PInstantiationException(this, 3);
+ if (! a3.isInteger())
+ throw new IllegalTypeException(this, 3, "integer", a3);
+ int n = ((IntegerTerm)a3).intValue();
+ if (n < 0)
+ throw new IllegalDomainException(this, 3, "not_less_than_zero", a3);
+ if (n == 0) {
+ if(! a1.unify(a2, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (! a2.isSymbol())
+ throw new IllegalTypeException(this, 2, "atom", a2);
+ if (n == 2 && a2.equals(SYM_DOT)) {
+ Term t = new ListTerm(new VariableTerm(engine), new VariableTerm(engine));
+ if(! a1.unify(t, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ Term[] args = new Term[n];
+ for(int i=0; i<n; i++)
+ args[i] = new VariableTerm(engine);
+ SymbolTerm sym = SymbolTerm.makeSymbol(((SymbolTerm)a2).name(), n);
+ if(! a1.unify(new StructureTerm(sym, args), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ // functor(+X,?Y,?Z)
+ Term functor;
+ IntegerTerm arity;
+ if (a1.isSymbol() || a1.isNumber() || a1.isJavaObject() || a1.isClosure()) {
+ functor = a1;
+ arity = new IntegerTerm(0);
+ } else if (a1.isList()) {
+ functor = SYM_DOT;
+ arity = new IntegerTerm(2);
+ } else if (a1.isStructure()) {
+ functor = SymbolTerm.makeSymbol(((StructureTerm)a1).name());
+ arity = new IntegerTerm(((StructureTerm)a1).arity());
+ } else {
+ return engine.fail();
+ }
+ if(! a2.unify(functor, engine.trail))
+ return engine.fail();
+ if(! a3.unify(arity, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_get_2.java b/src/builtin/Base/PRED_get_2.java
new file mode 100644
index 0000000..ecbedf9
--- /dev/null
+++ b/src/builtin/Base/PRED_get_2.java
@@ -0,0 +1,85 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ * <code>get/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_get_2 extends Predicate {
+ public static IntegerTerm INT_EOF = new IntegerTerm(-1);
+ public Term arg1, arg2;
+
+ public PRED_get_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_get_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "get(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (! a2.isVariable()) {
+ if (! a2.isInteger())
+ throw new IllegalTypeException(this, 2, "integer", a2);
+ int n = ((IntegerTerm)a2).intValue();
+ if (n != -1 && ! Character.isDefined(n))
+ throw new RepresentationException(this, 2, "in_character_code");
+ }
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read a non-blank single character
+ try {
+ PushbackReader in = (PushbackReader) stream;
+ int c = in.read();
+ while(Character.isWhitespace((char)c))
+ c = in.read();
+ if (c < 0) { // EOF
+ if (! a2.unify(INT_EOF, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 0, "character");
+ if (! a2.unify(new IntegerTerm(c), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_get_byte_2.java b/src/builtin/Base/PRED_get_byte_2.java
new file mode 100644
index 0000000..28ad2d7
--- /dev/null
+++ b/src/builtin/Base/PRED_get_byte_2.java
@@ -0,0 +1,83 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ * <code>get_byte/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ * @since 1.1
+*/
+public class PRED_get_byte_2 extends Predicate {
+ public static IntegerTerm INT_EOF = new IntegerTerm(-1);
+ public Term arg1, arg2;
+
+ public PRED_get_byte_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_get_byte_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "get_byte(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // InByte
+ a2 = a2.dereference();
+ if (! a2.isVariable()) {
+ if (! a2.isInteger())
+ throw new IllegalTypeException(this, 2, "in_byte", a2);
+ int n = ((IntegerTerm)a2).intValue();
+ if (n != -1 && (n < 0 || n > 255))
+ throw new RepresentationException(this, 2, "in_byte");
+ }
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read single byte
+ try {
+ int c = ((PushbackReader)stream).read();
+ if (c < 0) { // EOF
+ if (! a2.unify(INT_EOF, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (c > 255)
+ throw new RepresentationException(this, 0, "byte");
+ if (! a2.unify(new IntegerTerm(c), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_get_char_2.java b/src/builtin/Base/PRED_get_char_2.java
new file mode 100644
index 0000000..4f8969c
--- /dev/null
+++ b/src/builtin/Base/PRED_get_char_2.java
@@ -0,0 +1,85 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ * <code>get_char/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_get_char_2 extends Predicate {
+ public static SymbolTerm SYM_EOF = SymbolTerm.makeSymbol("end_of_file");
+ public Term arg1, arg2;
+
+ public PRED_get_char_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_get_char_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "get_char(" + arg1 + "," + arg2 + ")";
+ }
+
+ boolean inCharacter(Term t) {
+ if (! t.isSymbol())
+ return false;
+ if (t.equals(SYM_EOF))
+ return true;
+ return ((SymbolTerm)t).name().length() == 1;
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (! a2.isVariable() && ! inCharacter(a2))
+ throw new IllegalTypeException(this, 2, "in_character", a2);
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read single character
+ try {
+ int c = ((PushbackReader)stream).read();
+ if (c < 0) { // EOF
+ if (! a2.unify(SYM_EOF, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 0, "character");
+ if (! a2.unify(SymbolTerm.makeSymbol(String.valueOf((char)c)), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_get_code_2.java b/src/builtin/Base/PRED_get_code_2.java
new file mode 100644
index 0000000..f3310ba
--- /dev/null
+++ b/src/builtin/Base/PRED_get_code_2.java
@@ -0,0 +1,82 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ * <code>get_code/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_get_code_2 extends Predicate {
+ public static IntegerTerm INT_EOF = new IntegerTerm(-1);
+ public Term arg1, arg2;
+
+ public PRED_get_code_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_get_code_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "get_code(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (! a2.isVariable()) {
+ if (! a2.isInteger())
+ throw new IllegalTypeException(this, 2, "integer", a2);
+ int n = ((IntegerTerm)a2).intValue();
+ if (n != -1 && ! Character.isDefined(n))
+ throw new RepresentationException(this, 2, "in_character_code");
+ }
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read single character
+ try {
+ int c = ((PushbackReader)stream).read();
+ if (c < 0) { // EOF
+ if (! a2.unify(INT_EOF, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 0, "character");
+ if (! a2.unify(new IntegerTerm(c), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_halt_1.java b/src/builtin/Base/PRED_halt_1.java
new file mode 100644
index 0000000..988f5d9
--- /dev/null
+++ b/src/builtin/Base/PRED_halt_1.java
@@ -0,0 +1,44 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>halt/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_halt_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_halt_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_halt_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "halt(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (! a1.isInteger())
+ throw new IllegalTypeException(this, 1, "integer", a1);
+ engine.exceptionRaised = ((IntegerTerm)a1).intValue();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_hash_clear_1.java b/src/builtin/Base/PRED_hash_clear_1.java
new file mode 100644
index 0000000..28b2497
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_clear_1.java
@@ -0,0 +1,56 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ * <code>hash_clear/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class PRED_hash_clear_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_hash_clear_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_hash_clear_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "hash_clear(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ ((HashtableOfTerm) hash).clear();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_hash_contains_key_2.java b/src/builtin/Base/PRED_hash_contains_key_2.java
new file mode 100644
index 0000000..76060c2
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_contains_key_2.java
@@ -0,0 +1,60 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>hash_contains_key/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_hash_contains_key_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_hash_contains_key_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_hash_contains_key_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "hash_contains_key(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ Object hash = null;
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ if (! ((HashtableOfTerm) hash).containsKey(a2))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_hash_get_3.java b/src/builtin/Base/PRED_hash_get_3.java
new file mode 100644
index 0000000..0657934
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_get_3.java
@@ -0,0 +1,67 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>hash_get/3</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_hash_get_3 extends Predicate {
+ public static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public Term arg1, arg2, arg3;
+
+ public PRED_hash_get_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_hash_get_3(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "hash_get(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ Term elem = ((HashtableOfTerm) hash).get(a2);
+ if (elem == null)
+ elem = SYM_NIL;
+ if (! a3.unify(elem, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_hash_is_empty_1.java b/src/builtin/Base/PRED_hash_is_empty_1.java
new file mode 100644
index 0000000..f46d59c
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_is_empty_1.java
@@ -0,0 +1,57 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>hash_is_empty/1</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_hash_is_empty_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_hash_is_empty_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_hash_is_empty_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "hash_is_empty(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ if (! ((HashtableOfTerm) hash).isEmpty())
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_hash_keys_2.java b/src/builtin/Base/PRED_hash_keys_2.java
new file mode 100644
index 0000000..2ee6189
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_keys_2.java
@@ -0,0 +1,64 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+import java.util.Enumeration;
+/**
+ <code>hash_keys/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_hash_keys_2 extends Predicate {
+ public static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public Term arg1, arg2;
+
+ public PRED_hash_keys_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_hash_keys_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "hash_keys(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ Term keys = SYM_NIL;
+ for (Enumeration<Term> e = ((HashtableOfTerm) hash).keys(); e.hasMoreElements();)
+ keys = new ListTerm(e.nextElement(), keys);
+ if (! a2.unify(keys, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_hash_put_3.java b/src/builtin/Base/PRED_hash_put_3.java
new file mode 100644
index 0000000..4879747
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_put_3.java
@@ -0,0 +1,66 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>hash_put/3</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_hash_put_3 extends Predicate {
+
+ public Term arg1, arg2, arg3;
+
+ public PRED_hash_put_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public PRED_hash_put_3(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "hash_put(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ a3 = a3.dereference();
+ ((HashtableOfTerm) hash).put(a2, a3);
+ return cont;
+ }
+}
+
+
diff --git a/src/builtin/Base/PRED_hash_remove_2.java b/src/builtin/Base/PRED_hash_remove_2.java
new file mode 100644
index 0000000..5a30274
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_remove_2.java
@@ -0,0 +1,60 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>hash_remove/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_hash_remove_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_hash_remove_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_hash_remove_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "hash_remove(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ ((HashtableOfTerm) hash).remove(a2);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_hash_size_2.java b/src/builtin/Base/PRED_hash_size_2.java
new file mode 100644
index 0000000..44d14ea
--- /dev/null
+++ b/src/builtin/Base/PRED_hash_size_2.java
@@ -0,0 +1,63 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Hashtable;
+/**
+ <code>hash_size/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_hash_size_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_hash_size_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_hash_size_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "hash_size(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ Object hash = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getHashManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "hash", a1, "");
+ hash = ((JavaObjectTerm) engine.getHashManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ hash = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "hash_or_alias", a1);
+ }
+ if (! (hash instanceof HashtableOfTerm))
+ throw new InternalException(this + ": Hash is not HashtableOfTerm");
+ a2 = a2.dereference();
+ if (! a2.isVariable() && ! a2.isInteger())
+ throw new IllegalTypeException(this, 1, "integer", a2);
+ if (! a2.unify(new IntegerTerm(((HashtableOfTerm)hash).size()), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_java_constructor0_2.java b/src/builtin/Base/PRED_java_constructor0_2.java
new file mode 100644
index 0000000..3a3c503
--- /dev/null
+++ b/src/builtin/Base/PRED_java_constructor0_2.java
@@ -0,0 +1,112 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_constructor0/2</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_constructor0_2 extends JavaPredicate {
+ Term arg1, arg2;
+
+ public PRED_java_constructor0_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+ public PRED_java_constructor0_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "java_constructor0(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ Class clazz = null;
+ Object instance = null;
+ int arity;
+ Constructor[] constrs = null;
+ Term[] pArgs = null;
+ Object[] jArgs = null;
+ Constructor c = null;
+
+ try {
+ // 2nd. argument (unbound variable)
+ a2 = a2.dereference();
+ if (! a2.isVariable())
+ throw new IllegalTypeException(this, 2, "variable", a2);
+ // 1st. argument (atom or callable term)
+ a1 = a1.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (!a1.isSymbol() && !a1.isStructure())
+ throw new IllegalTypeException(this, 1, "callable", a1);
+ if (a1.isSymbol()) { // No argument constructor
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ instance = clazz.newInstance();
+ if (! a2.unify(toPrologTerm(instance), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ // Parameterized constructor
+ clazz = Class.forName(((StructureTerm)a1).name());
+ arity = ((StructureTerm)a1).arity();
+ constrs = clazz.getConstructors();
+ if (constrs.length == 0)
+ throw new ExistenceException(this, 1, "constructor", a1, "");
+ pArgs = ((StructureTerm)a1).args();
+ jArgs = new Object[arity];
+ for (int i=0; i<arity; i++) {
+ pArgs[i] = pArgs[i].dereference();
+ if (! pArgs[i].isJavaObject())
+ pArgs[i] = new JavaObjectTerm(pArgs[i]);
+ jArgs[i] = pArgs[i].toJava();
+ }
+ for (int i=0; i<constrs.length; i++) {
+ if (checkParameterTypes(constrs[i].getParameterTypes(), pArgs)) {
+ try {
+ c = constrs[i];
+ //c.setAccessible(true);
+ instance = c.newInstance(jArgs);
+ break; // Succeeds to create new instance
+ } catch (Exception e) {
+ c = null; // Back to loop
+ }
+ }
+ }
+ if (c == null)
+ throw new ExistenceException(this, 1, "constructor", a1, "");
+ if (! a2.unify(toPrologTerm(instance), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName(..)
+ throw new JavaException(this, 1, e);
+ } catch (InstantiationException e) { // Class.forName(..) or Constructor.newInstance()
+ throw new JavaException(this, 1, e);
+ } catch (IllegalAccessException e) { // Class.forName(..) or Constructor.newInstance()
+ throw new JavaException(this, 1, e);
+ } catch (SecurityException e) { // Class.getConstructors()
+ throw new JavaException(this, 1, e);
+ } catch (IllegalArgumentException e) { // Constructor.newInstance()
+ throw new JavaException(this, 1, e);
+ }
+ }
+
+ private Term toPrologTerm(Object obj) {
+ if (Term.instanceOfTerm(obj))
+ return (Term)obj;
+ else
+ return new JavaObjectTerm(obj);
+ }
+}
diff --git a/src/builtin/Base/PRED_java_conversion_2.java b/src/builtin/Base/PRED_java_conversion_2.java
new file mode 100644
index 0000000..f92750b
--- /dev/null
+++ b/src/builtin/Base/PRED_java_conversion_2.java
@@ -0,0 +1,80 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Vector;
+/**
+ * <code>java_conversion/2</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_conversion_2 extends Predicate {
+ Term arg1, arg2;
+
+ public PRED_java_conversion_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+ public PRED_java_conversion_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "java_conversion(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+ if (a1.isVariable()) { // a1 = var
+ if (a2.isJavaObject()) { // a1 = var /\ a2 = java
+ ((VariableTerm)a1).bind(inverseConversion(((JavaObjectTerm)a2).object()), engine.trail);
+ } else { // a1 = var /\ a2 = nonjava
+ ((VariableTerm)a1).bind(a2, engine.trail);
+ }
+ } else if (! a2.isVariable()) { // a1 = nonvar /\ a2 = nonvar
+ throw new IllegalTypeException(this, 2, "variable", a2);
+ } else { // a1 = nonvar /\ a2 = var
+ // (a1 = java \/ a1 = str \/ a1 = clo) /\ a2 = var
+ if (a1.isJavaObject() || a1.isStructure() || a1.isClosure()) {
+ ((VariableTerm)a2).bind(a1, engine.trail);
+ } else { // a1 != java /\ a1 != str /\ a1 != clo /\ a2 = var
+ ((VariableTerm)a2).bind(new JavaObjectTerm(a1.toJava()), engine.trail);
+ }
+ }
+ return cont;
+ }
+
+ protected Term inverseConversion(Object o) {
+ if (o == null) {
+ throw new EvaluationException(this, 2, "undefined");
+ } else if (o instanceof Byte ||
+ o instanceof Short ||
+ o instanceof Integer ||
+ o instanceof Long) {
+ return new IntegerTerm(((Number)o).intValue());
+ } else if (o instanceof Float ||
+ o instanceof Double) {
+ return new DoubleTerm(((Number)o).doubleValue());
+ } else if (o instanceof String) {
+ return SymbolTerm.makeSymbol((String) o);
+ } else if (o instanceof Vector) {
+ Vector v = (Vector) o;
+ Term t = Prolog.Nil;
+ for(int i= v.size(); i>0; i--) {
+ t = new ListTerm(inverseConversion(v.elementAt(i-1)), t);
+ }
+ return t;
+ }
+ return new JavaObjectTerm(o);
+ }
+}
diff --git a/src/builtin/Base/PRED_java_declared_constructor0_2.java b/src/builtin/Base/PRED_java_declared_constructor0_2.java
new file mode 100644
index 0000000..2b5c408
--- /dev/null
+++ b/src/builtin/Base/PRED_java_declared_constructor0_2.java
@@ -0,0 +1,120 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_declared_constructor0/2</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_declared_constructor0_2 extends JavaPredicate {
+ Term arg1, arg2;
+
+ public PRED_java_declared_constructor0_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+ public PRED_java_declared_constructor0_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "java_declared_constructor0(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ Class clazz = null;
+ Object instance = null;
+ int arity;
+ Constructor[] constrs = null;
+ Term[] pArgs = null;
+ Object[] jArgs = null;
+ Constructor c = null;
+
+ // 2nd. argument (unbound variable)
+ a2 = a2.dereference();
+ if (! a2.isVariable())
+ throw new IllegalTypeException(this, 2, "variable", a2);
+ // 1st. argument (atom or callable term)
+ try {
+ a1 = a1.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (!a1.isSymbol() && !a1.isStructure())
+ throw new IllegalTypeException(this, 1, "callable", a1);
+ if (a1.isSymbol()) { // No argument constructor
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ c = clazz.getDeclaredConstructor();
+ if (c == null)
+ throw new ExistenceException(this, 1, "constructor", a1, "");
+ c.setAccessible(true);
+ instance = c.newInstance();
+ if (! a2.unify(toPrologTerm(instance), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ // Parameterized constructor
+ clazz = Class.forName(((StructureTerm)a1).name());
+ arity = ((StructureTerm)a1).arity();
+ constrs = clazz.getDeclaredConstructors();
+ if (constrs.length == 0)
+ throw new ExistenceException(this, 1, "constructor", a1, "");
+ pArgs = ((StructureTerm)a1).args();
+ jArgs = new Object[arity];
+ for (int i=0; i<arity; i++) {
+ pArgs[i] = pArgs[i].dereference();
+ if (! pArgs[i].isJavaObject())
+ pArgs[i] = new JavaObjectTerm(pArgs[i]);
+ jArgs[i] = pArgs[i].toJava();
+ }
+ for (int i=0; i<constrs.length; i++) {
+ if (checkParameterTypes(constrs[i].getParameterTypes(), pArgs)) {
+ try {
+ c = constrs[i];
+ c.setAccessible(true);
+ instance = c.newInstance(jArgs);
+ break; // Succeeds to create new instance
+ } catch (Exception e) {
+ c = null; // Back to loop
+ }
+ }
+ }
+ if (c == null)
+ throw new ExistenceException(this, 1, "constructor", a1, "");
+ if (! a2.unify(toPrologTerm(instance), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName(..)
+ throw new JavaException(this, 1, e);
+ } catch (InstantiationException e) { // Class.forName(..) or Constructor.newInstance()
+ throw new JavaException(this, 1, e);
+ } catch (IllegalAccessException e) { // Class.forName(..) or Constructor.newInstance()
+ throw new JavaException(this, 1, e);
+ } catch (NoSuchMethodException e) { // Class.getDeclaredConstructor()
+ throw new JavaException(this, 1, e);
+ } catch (SecurityException e) { // Class.getDeclaredConstructors()
+ throw new JavaException(this, 1, e);
+ } catch (IllegalArgumentException e) { // Constructor.newInstance()
+ throw new JavaException(this, 1, e);
+ } catch (InvocationTargetException e) { // Constructor.newInstance()
+ throw new JavaException(this, 1, e);
+ }
+ }
+
+ private Term toPrologTerm(Object obj) {
+ if (Term.instanceOfTerm(obj))
+ return (Term)obj;
+ else
+ return new JavaObjectTerm(obj);
+ }
+}
diff --git a/src/builtin/Base/PRED_java_declared_method0_3.java b/src/builtin/Base/PRED_java_declared_method0_3.java
new file mode 100644
index 0000000..ba84936
--- /dev/null
+++ b/src/builtin/Base/PRED_java_declared_method0_3.java
@@ -0,0 +1,136 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_declared_method0/3</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_declared_method0_3 extends JavaPredicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_java_declared_method0_3() {}
+ public PRED_java_declared_method0_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "java_declared_method0(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Class clazz = null;
+ Object instance = null;
+ Method[] methods = null;
+ Method m = null;
+ Object value = null;
+ int arity;
+ Term[] pArgs = null;
+ Object[] jArgs = null;
+ String methodName = null;
+
+ // 3rd. argument (unbound variable)
+ a3 = a3.dereference();
+ if (! a3.isVariable())
+ throw new IllegalTypeException(this, 3, "variable", a3);
+ try {
+ // 1st. argument (atom or java term)
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()){ // class
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ } else if (a1.isJavaObject()) { // instance
+ instance = ((JavaObjectTerm)a1).object();
+ clazz = ((JavaObjectTerm)a1).getClazz();
+ } else {
+ throw new IllegalTypeException(this, 1, "atom_or_java", a1);
+ }
+ // 2nd. argument (atom or callable term)
+ a2 = a2.dereference();
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (a2.isSymbol()) { // No argument method
+ m = clazz.getDeclaredMethod(((SymbolTerm)a2).name());
+ m.setAccessible(true);
+ value = m.invoke(instance);
+ } else if (a2.isStructure()) { // Parameterized method
+ methodName = ((StructureTerm)a2).name();
+ arity = ((StructureTerm)a2).arity();
+ methods = clazz.getDeclaredMethods();
+ if (methods.length == 0)
+ throw new ExistenceException(this, 2, "method", a2, "");
+ pArgs = ((StructureTerm)a2).args();
+ jArgs = new Object[arity];
+ for (int i=0; i<arity; i++) {
+ pArgs[i] = pArgs[i].dereference();
+ if (! pArgs[i].isJavaObject())
+ pArgs[i] = new JavaObjectTerm(pArgs[i]);
+ jArgs[i] = pArgs[i].toJava();
+ }
+ for (int i=0; i<methods.length; i++) {
+ if (methods[i].getName().equals(methodName)
+ && checkParameterTypes(methods[i].getParameterTypes(), pArgs)) {
+ try {
+ m = methods[i];
+ m.setAccessible(true);
+ value = m.invoke(instance, jArgs);
+ break; // Succeeds to invoke the method
+ } catch (Exception e) {
+ m = null; // Back to loop
+ }
+ }
+ }
+ if (m == null)
+ throw new ExistenceException(this, 2, "method", a2, "");
+ } else {
+ throw new IllegalTypeException(this, 2, "callable", a2);
+ }
+ if (value == null)
+ return cont;
+ if (! a3.unify(toPrologTerm(value), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName
+ throw new JavaException(this, 1, e);
+ } catch (NoSuchMethodException e) { // Class.getDeclaredMethod
+ throw new JavaException(this, 2, e);
+ } catch (SecurityException e) { // Class.getDeclaredMethods
+ throw new JavaException(this, 2, e);
+ } catch (IllegalAccessException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ } catch (IllegalArgumentException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ } catch (InvocationTargetException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ } catch (NullPointerException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ }
+ }
+
+ private Term toPrologTerm(Object obj) {
+ if (Term.instanceOfTerm(obj))
+ return (Term)obj;
+ else
+ return new JavaObjectTerm(obj);
+ }
+}
diff --git a/src/builtin/Base/PRED_java_get_declared_field0_3.java b/src/builtin/Base/PRED_java_get_declared_field0_3.java
new file mode 100644
index 0000000..8daa832
--- /dev/null
+++ b/src/builtin/Base/PRED_java_get_declared_field0_3.java
@@ -0,0 +1,100 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_get_declared_field0/3</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_get_declared_field0_3 extends JavaPredicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_java_get_declared_field0_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+ public PRED_java_get_declared_field0_3() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "java_get_declared_field0(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Class clazz = null;
+ Object instance = null;
+ Field field = null;
+ Object value = null;
+
+ // 3rd. argument (unbound variable)
+ a3 = a3.dereference();
+ if (! a3.isVariable())
+ throw new IllegalTypeException(this, 3, "variable", a3);
+ try {
+ // 1st. argument (atom or java term)
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()){ // class
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ } else if (a1.isJavaObject()) { // instance
+ instance = ((JavaObjectTerm)a1).object();
+ clazz = ((JavaObjectTerm)a1).getClazz();
+ } else {
+ throw new IllegalTypeException(this, 1, "atom_or_java", a1);
+ }
+ // 2nd. argument (atom)
+ a2 = a2.dereference();
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (! a2.isSymbol()) {
+ throw new IllegalTypeException(this, 2, "atom", a2);
+ }
+ field = clazz.getDeclaredField(((SymbolTerm)a2).name());
+ field.setAccessible(true);
+ value = field.get(instance);
+ // 3rd. argument
+ if (value == null)
+ return cont;
+ if (! a3.unify(toPrologTerm(value), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName
+ throw new JavaException(this, 1, e);
+ } catch (NoSuchFieldException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (SecurityException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (NullPointerException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalAccessException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalArgumentException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ }
+ }
+
+ private Term toPrologTerm(Object obj) {
+ if (Term.instanceOfTerm(obj))
+ return (Term)obj;
+ else
+ return new JavaObjectTerm(obj);
+ }
+}
diff --git a/src/builtin/Base/PRED_java_get_field0_3.java b/src/builtin/Base/PRED_java_get_field0_3.java
new file mode 100644
index 0000000..a549e7f
--- /dev/null
+++ b/src/builtin/Base/PRED_java_get_field0_3.java
@@ -0,0 +1,99 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_get_field0/3</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_get_field0_3 extends JavaPredicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_java_get_field0_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+ public PRED_java_get_field0_3() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "java_get_field0(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Class clazz = null;
+ Object instance = null;
+ Field field = null;
+ Object value = null;
+
+ // 3rd. argument (unbound variable)
+ a3 = a3.dereference();
+ if (! a3.isVariable())
+ throw new IllegalTypeException(this, 3, "variable", a3);
+ try {
+ // 1st. argument (atom or java term)
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()){ // class
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ } else if (a1.isJavaObject()) { // instance
+ instance = ((JavaObjectTerm)a1).object();
+ clazz = ((JavaObjectTerm)a1).getClazz();
+ } else {
+ throw new IllegalTypeException(this, 1, "atom_or_java", a1);
+ }
+ // 2nd. argument (atom)
+ a2 = a2.dereference();
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (! a2.isSymbol()) {
+ throw new IllegalTypeException(this, 2, "atom", a2);
+ }
+ field = clazz.getField(((SymbolTerm)a2).name());
+ value = field.get(instance);
+ // 3rd. argument
+ if (value == null)
+ return cont;
+ if (! a3.unify(toPrologTerm(value), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName
+ throw new JavaException(this, 1, e);
+ } catch (NoSuchFieldException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (SecurityException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (NullPointerException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalAccessException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalArgumentException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ }
+ }
+
+ private Term toPrologTerm(Object obj) {
+ if (Term.instanceOfTerm(obj))
+ return (Term)obj;
+ else
+ return new JavaObjectTerm(obj);
+ }
+}
diff --git a/src/builtin/Base/PRED_java_method0_3.java b/src/builtin/Base/PRED_java_method0_3.java
new file mode 100644
index 0000000..eabbc04
--- /dev/null
+++ b/src/builtin/Base/PRED_java_method0_3.java
@@ -0,0 +1,134 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_method0/3</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_method0_3 extends JavaPredicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_java_method0_3() {}
+ public PRED_java_method0_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() { return "java_method0(" + arg1 + "," + arg2 + "," + arg3 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Class clazz = null;
+ Object instance = null;
+ Method[] methods = null;
+ Method m = null;
+ Object value = null;
+ int arity;
+ Term[] pArgs = null;
+ Object[] jArgs = null;
+ String methodName = null;
+
+ // 3rd. argument (unbound variable)
+ a3 = a3.dereference();
+ if (! a3.isVariable())
+ throw new IllegalTypeException(this, 3, "variable", a3);
+ try {
+ // 1st. argument (atom or java term)
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()){ // class
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ } else if (a1.isJavaObject()) { // instance
+ instance = ((JavaObjectTerm)a1).object();
+ clazz = ((JavaObjectTerm)a1).getClazz();
+ } else {
+ throw new IllegalTypeException(this, 1, "atom_or_java", a1);
+ }
+ // 2nd. argument (atom or callable term)
+ a2 = a2.dereference();
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (a2.isSymbol()) { // No argument method
+ m = clazz.getMethod(((SymbolTerm)a2).name());
+ //m.setAccessible(true);
+ value = m.invoke(instance);
+ } else if (a2.isStructure()) { // Parameterized method
+ methodName = ((StructureTerm)a2).name();
+ arity = ((StructureTerm)a2).arity();
+ methods = clazz.getMethods();
+ if (methods.length == 0)
+ throw new ExistenceException(this, 2, "method", a2, "");
+ pArgs = ((StructureTerm)a2).args();
+ jArgs = new Object[arity];
+ for (int i=0; i<arity; i++) {
+ pArgs[i] = pArgs[i].dereference();
+ if (! pArgs[i].isJavaObject())
+ pArgs[i] = new JavaObjectTerm(pArgs[i]);
+ jArgs[i] = pArgs[i].toJava();
+ }
+ for (int i=0; i<methods.length; i++) {
+ if (methods[i].getName().equals(methodName)
+ && checkParameterTypes(methods[i].getParameterTypes(), pArgs)) {
+ try {
+ m = methods[i];
+ //m.setAccessible(true);
+ value = m.invoke(instance, jArgs);
+ break; // Succeeds to invoke the method
+ } catch (Exception e) {
+ m = null; // Back to loop
+ }
+ }
+ }
+ if (m == null)
+ throw new ExistenceException(this, 2, "method", a2, "");
+ } else {
+ throw new IllegalTypeException(this, 2, "callable", a2);
+ }
+ if (value == null)
+ return cont;
+ if (! a3.unify(toPrologTerm(value), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName
+ throw new JavaException(this, 1, e);
+ } catch (NoSuchMethodException e) { // Class.getDeclaredMethod
+ throw new JavaException(this, 2, e);
+ } catch (SecurityException e) { // Class.getDeclaredMethods
+ throw new JavaException(this, 2, e);
+ } catch (IllegalAccessException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ } catch (IllegalArgumentException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ } catch (InvocationTargetException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ } catch (NullPointerException e) { // Method.invoke
+ throw new JavaException(this, 2, e);
+ }
+ }
+
+ private Term toPrologTerm(Object obj) {
+ if (Term.instanceOfTerm(obj))
+ return (Term)obj;
+ else
+ return new JavaObjectTerm(obj);
+ }
+}
diff --git a/src/builtin/Base/PRED_java_set_declared_field0_3.java b/src/builtin/Base/PRED_java_set_declared_field0_3.java
new file mode 100644
index 0000000..2eea8cf
--- /dev/null
+++ b/src/builtin/Base/PRED_java_set_declared_field0_3.java
@@ -0,0 +1,92 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_set_declared_field0/3</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_set_declared_field0_3 extends JavaPredicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_java_set_declared_field0_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+ public PRED_java_set_declared_field0_3() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "java_set_declared_field0(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Class clazz = null;
+ Object instance = null;
+ Field field = null;
+ Object value = null;
+
+ try {
+ // 1st. argument (atom or java term)
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()){ // class
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ } else if (a1.isJavaObject()) { // instance
+ instance = ((JavaObjectTerm)a1).object();
+ clazz = ((JavaObjectTerm)a1).getClazz();
+ } else {
+ throw new IllegalTypeException(this, 1, "atom_or_java", a1);
+ }
+ // 2nd. argument (atom)
+ a2 = a2.dereference();
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (! a2.isSymbol()) {
+ throw new IllegalTypeException(this, 2, "atom", a2);
+ }
+ field = clazz.getDeclaredField(((SymbolTerm)a2).name());
+ // 3rd. argument (term)
+ a3 = a3.dereference();
+ if (a3.isJavaObject())
+ value = a3.toJava();
+ else
+ value = a3;
+ field.setAccessible(true);
+ field.set(instance, value);
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName
+ throw new JavaException(this, 1, e);
+ } catch (NoSuchFieldException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (SecurityException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (NullPointerException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalAccessException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalArgumentException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ }
+ }
+}
+
+
diff --git a/src/builtin/Base/PRED_java_set_field0_3.java b/src/builtin/Base/PRED_java_set_field0_3.java
new file mode 100644
index 0000000..46976e3
--- /dev/null
+++ b/src/builtin/Base/PRED_java_set_field0_3.java
@@ -0,0 +1,91 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.lang.reflect.*;
+/**
+ * <code>java_set_field0/3</code>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_java_set_field0_3 extends JavaPredicate {
+ Term arg1, arg2, arg3;
+
+ public PRED_java_set_field0_3(Term a1, Term a2, Term a3, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ this.cont = cont;
+ }
+ public PRED_java_set_field0_3() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ this.cont = cont;
+ }
+
+ public int arity() { return 3; }
+
+ public String toString() {
+ return "java_set_field0(" + arg1 + "," + arg2 + "," + arg3 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2, a3;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+
+ Class clazz = null;
+ Object instance = null;
+ Field field = null;
+ Object value = null;
+
+ try {
+ // 1st. argument (atom or java term)
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()){ // class
+ clazz = Class.forName(((SymbolTerm)a1).name());
+ } else if (a1.isJavaObject()) { // instance
+ instance = ((JavaObjectTerm)a1).object();
+ clazz = ((JavaObjectTerm)a1).getClazz();
+ } else {
+ throw new IllegalTypeException(this, 1, "atom_or_java", a1);
+ }
+ // 2nd. argument (atom)
+ a2 = a2.dereference();
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (! a2.isSymbol()) {
+ throw new IllegalTypeException(this, 2, "atom", a2);
+ }
+ field = clazz.getField(((SymbolTerm)a2).name());
+ // 3rd. argument (term)
+ a3 = a3.dereference();
+ if (a3.isJavaObject())
+ value = a3.toJava();
+ else
+ value = a3;
+ field.set(instance, value);
+ return cont;
+ } catch (ClassNotFoundException e) { // Class.forName
+ throw new JavaException(this, 1, e);
+ } catch (NoSuchFieldException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (SecurityException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (NullPointerException e) { // Class.getField(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalAccessException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ } catch (IllegalArgumentException e) { // Field.get(..)
+ throw new JavaException(this, 2, e);
+ }
+ }
+}
+
+
diff --git a/src/builtin/Base/PRED_keysort_2.java b/src/builtin/Base/PRED_keysort_2.java
new file mode 100644
index 0000000..6f9dbf0
--- /dev/null
+++ b/src/builtin/Base/PRED_keysort_2.java
@@ -0,0 +1,92 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Arrays;
+/**
+ * <code>keysort/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_keysort_2 extends Predicate {
+ static SymbolTerm SYM_HYPHEN_2 = SymbolTerm.makeSymbol("-", 2);
+ static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ Term arg1, arg2;
+
+ public PRED_keysort_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_keysort_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString() { return "keysort(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int len;
+ Term tmp, tmp2;
+ Term[] list;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.equals(Nil)) {
+ if (! a2.unify(Nil, engine.trail))
+ return engine.fail();
+ return cont;
+ } else if (! a1.isList()) {
+ throw new IllegalTypeException(this, 1, "list", a1);
+ }
+ len = ((ListTerm)a1).length();
+ list = new Term[len];
+ tmp = a1;
+ for (int i=0; i<len; i++) {
+ if (! tmp.isList())
+ throw new IllegalTypeException(this, 1, "list", a1);
+ list[i] = ((ListTerm)tmp).car().dereference();
+ if (list[i].isVariable())
+ throw new PInstantiationException(this, 1);
+ if (! list[i].isStructure())
+ throw new IllegalTypeException(this, 1, "key_value_pair", a1);
+ if (! ((StructureTerm) list[i]).functor().equals(SYM_HYPHEN_2))
+ throw new IllegalTypeException(this, 1, "key_value_pair", a1);
+ tmp = ((ListTerm)tmp).cdr().dereference();
+ }
+ if (! tmp.equals(Nil))
+ throw new PInstantiationException(this, 1);
+ try {
+ Arrays.sort(list, new KeySortComparator());
+ } catch (BuiltinException e) {
+ e.goal = this; e.argNo = 1; throw e;
+ } catch (ClassCastException e1) {
+ throw new JavaException(this, 1, e1);
+ }
+ tmp = Nil;
+ for (int i=list.length-1; i>=0; i--) {
+ tmp = new ListTerm(list[i], tmp);
+ }
+ if(! a2.unify(tmp, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
+
+class KeySortComparator implements java.util.Comparator<Term> {
+ public int compare(Term t1, Term t2) {
+ Term arg1 = ((StructureTerm)t1).args()[0].dereference();
+ Term arg2 = ((StructureTerm)t2).args()[0].dereference();
+ return arg1.compareTo(arg2);
+ }
+}
diff --git a/src/builtin/Base/PRED_new_hash_2.java b/src/builtin/Base/PRED_new_hash_2.java
new file mode 100644
index 0000000..a260898
--- /dev/null
+++ b/src/builtin/Base/PRED_new_hash_2.java
@@ -0,0 +1,86 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ <code>new_hash/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_new_hash_2 extends Predicate {
+ public static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public static SymbolTerm SYM_ALIAS_1 = SymbolTerm.makeSymbol("alias", 1);
+ public Term arg1, arg2;
+
+ public PRED_new_hash_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_new_hash_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "new_hash(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ if (! a1.isVariable())
+ throw new IllegalTypeException(this, 1, "variable", a1);
+ Term newHash = new JavaObjectTerm(new HashtableOfTerm());
+ a2 = a2.dereference();
+ if (a2.isNil()) {
+ if (! a1.unify(newHash, engine.trail))
+ return engine.fail();
+ return cont;
+ } else if (! a2.isList()) {
+ throw new IllegalTypeException(this, 2, "list", a2);
+ }
+ // a2 is list
+ Term tmp = a2;
+ while (! tmp.isNil()) {
+ if (tmp.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! tmp.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ Term car = ((ListTerm) tmp).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (car.isStructure()) {
+ SymbolTerm functor = ((StructureTerm) car).functor();
+ Term[] args = ((StructureTerm) car).args();
+ if (functor.equals(SYM_ALIAS_1)) {
+ Term alias = args[0].dereference();
+ if (! alias.isSymbol())
+ throw new IllegalDomainException(this, 2, "hash_option", car);
+ else {
+ if (engine.getHashManager().containsKey(alias))
+ throw new PermissionException(this, "new", "hash", car, "");
+ engine.getHashManager().put(alias, newHash);
+ }
+ } else {
+ throw new IllegalDomainException(this, 2, "hash_option", car);
+ }
+ } else {
+ throw new IllegalDomainException(this, 2, "hash_option", car);
+ }
+ tmp = ((ListTerm) tmp).cdr().dereference();
+ }
+ if (! a1.unify(newHash, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_nl_0.java b/src/builtin/Base/PRED_nl_0.java
new file mode 100644
index 0000000..3526fc7
--- /dev/null
+++ b/src/builtin/Base/PRED_nl_0.java
@@ -0,0 +1,28 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>nl/0</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_nl_0 extends Predicate {
+
+ public PRED_nl_0(Predicate cont) {
+ this.cont = cont;
+ }
+ public PRED_nl_0() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ this.cont = cont;
+ }
+
+ public int arity() { return 0; }
+ public String toString() { return "nl"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ engine.getCurrentOutput().println();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_number_chars_2.java b/src/builtin/Base/PRED_number_chars_2.java
new file mode 100644
index 0000000..d38ca8c
--- /dev/null
+++ b/src/builtin/Base/PRED_number_chars_2.java
@@ -0,0 +1,87 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>number_chars/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_number_chars_2 extends Predicate {
+ static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ Term arg1, arg2;
+
+ public PRED_number_chars_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_number_chars_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString() { return "number_chars(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+ if (a2.isNil())
+ throw new SyntaxException(this, 2, "character_code_list", a2, "");
+ if (a1.isVariable()) { // number_chars(-Number, +CharList)
+ if (a2.isVariable()) {
+ throw new PInstantiationException(this, 2);
+ } else if (! a2.isList()) {
+ throw new IllegalTypeException(this, 2, "list", a2);
+ }
+ StringBuffer sb = new StringBuffer();
+ Term x = a2;
+ while(! x.isNil()) {
+ if (x.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! x.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ Term car = ((ListTerm)x).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! car.isSymbol() || ((SymbolTerm)car).name().length() != 1)
+ throw new IllegalTypeException(this, 2, "character", a2);
+ sb.append(((SymbolTerm)car).name());
+ x = ((ListTerm)x).cdr().dereference();
+ }
+ try {
+ if (! a1.unify(new IntegerTerm(Integer.parseInt(sb.toString())), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (NumberFormatException e) {}
+ try {
+ if(! a1.unify(new DoubleTerm(Double.parseDouble(sb.toString())), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (NumberFormatException e) {
+ throw new SyntaxException(this, 2, "character_code_list", a2, "");
+ }
+ } else if (a1.isNumber()) { // number_chars(+Number, ?CharList)
+ String s = a1.toString();
+ Term y = Nil;
+ for (int i=s.length(); i>0; i--) {
+ y = new ListTerm(SymbolTerm.makeSymbol(s.substring(i-1,i)), y);
+ }
+ if (! a2.unify(y, engine.trail) )
+ return engine.fail();
+ return cont;
+ } else {
+ throw new IllegalTypeException(this, 1, "number", a1);
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_number_codes_2.java b/src/builtin/Base/PRED_number_codes_2.java
new file mode 100644
index 0000000..6df928c
--- /dev/null
+++ b/src/builtin/Base/PRED_number_codes_2.java
@@ -0,0 +1,86 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>number_codes/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_number_codes_2 extends Predicate {
+ static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ Term arg1, arg2;
+
+ public PRED_number_codes_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_number_codes_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString() { return "number_codes(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+
+ a1 = a1.dereference();
+ a2 = a2.dereference();
+ if (a2.isNil())
+ throw new SyntaxException(this, 2, "character_code_list", a2, "");
+ if (a1.isVariable()) { // number_codes(-Number, +CharCodeList)
+ StringBuffer sb = new StringBuffer();
+ Term x = a2;
+ while(! x.isNil()) {
+ if (x.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! x.isList())
+ throw new IllegalTypeException(this, 2, "list", a2);
+ Term car = ((ListTerm)x).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! car.isInteger())
+ throw new RepresentationException(this, 2, "character_code");
+ // car is an integer
+ int i = ((IntegerTerm)car).intValue();
+ if (! Character.isDefined((char)i))
+ throw new RepresentationException(this, 2, "character_code");
+ sb.append((char)i);
+ x = ((ListTerm)x).cdr().dereference();
+ }
+ try {
+ if (! a1.unify(new IntegerTerm(Integer.parseInt(sb.toString())), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (NumberFormatException e) {}
+ try {
+ if(! a1.unify(new DoubleTerm(Double.parseDouble(sb.toString())), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (NumberFormatException e) {
+ throw new SyntaxException(this, 2, "character_code_list", a2, "");
+ }
+ } else if (a1.isNumber()) { // number_codes(+Number, ?CharCodeList)
+ char[] chars = a1.toString().toCharArray();
+ Term y = Nil;
+ for (int i=chars.length; i>0; i--) {
+ y = new ListTerm(new IntegerTerm((int)chars[i-1]), y);
+ }
+ if (! a2.unify(y, engine.trail) )
+ return engine.fail();
+ return cont;
+ } else {
+ throw new IllegalTypeException(this, 1, "number", a1);
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_open_4.java b/src/builtin/Base/PRED_open_4.java
new file mode 100644
index 0000000..426eead
--- /dev/null
+++ b/src/builtin/Base/PRED_open_4.java
@@ -0,0 +1,151 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>open/4</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_open_4 extends Predicate {
+ public static SymbolTerm SYM_NIL = SymbolTerm.makeSymbol("[]");
+ public static SymbolTerm SYM_TEXT = SymbolTerm.makeSymbol("text");
+ // public static SymbolTerm SYM_BINARY = SymbolTerm.makeSymbol("binary");
+ public static SymbolTerm SYM_READ = SymbolTerm.makeSymbol("read");
+ public static SymbolTerm SYM_WRITE = SymbolTerm.makeSymbol("write");
+ public static SymbolTerm SYM_APPEND = SymbolTerm.makeSymbol("append");
+ public static SymbolTerm SYM_INPUT = SymbolTerm.makeSymbol("input");
+ public static SymbolTerm SYM_OUTPUT = SymbolTerm.makeSymbol("output");
+ public static SymbolTerm SYM_ALIAS_1 = SymbolTerm.makeSymbol("alias", 1);
+ public static SymbolTerm SYM_MODE_1 = SymbolTerm.makeSymbol("mode", 1);
+ public static SymbolTerm SYM_TYPE_1 = SymbolTerm.makeSymbol("type", 1);
+ public static SymbolTerm SYM_FILE_NAME_1 = SymbolTerm.makeSymbol("file_name", 1);
+
+ public Term arg1, arg2, arg3, arg4;
+
+ public PRED_open_4(Term a1, Term a2, Term a3, Term a4, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ arg3 = a3;
+ arg4 = a4;
+ this.cont = cont;
+ }
+
+ public PRED_open_4(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ arg3 = args[2];
+ arg4 = args[3];
+ this.cont = cont;
+ }
+
+ public int arity() { return 4; }
+
+ public String toString() {
+ return "open(" + arg1 + "," + arg2 + "," + arg3 + "," + arg4 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ File file;
+ Term alias = null;
+ Term opts = SYM_NIL;
+ JavaObjectTerm streamObject;
+ Term a1, a2, a3, a4;
+ a1 = arg1;
+ a2 = arg2;
+ a3 = arg3;
+ a4 = arg4;
+
+ // stream
+ a3 = a3.dereference();
+ if (! a3.isVariable())
+ throw new IllegalTypeException(this, 3, "variable", a3);
+ // source_sink
+ a1 = a1.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ if (! a1.isSymbol())
+ throw new IllegalDomainException(this, 1, "source_sink", a1);
+ file = new File(((SymbolTerm) a1).name());
+ // io_mode
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! a2.isSymbol())
+ throw new IllegalTypeException(this, 2, "atom", a2);
+ try {
+ if (a2.equals(SYM_READ)) {
+ if (! file.exists())
+ throw new ExistenceException(this, 1, "source_sink", a1, "");
+ PushbackReader in =
+ new PushbackReader(new BufferedReader(new FileReader(file)), engine.PUSHBACK_SIZE);
+ streamObject = new JavaObjectTerm(in);
+ opts = new ListTerm(SYM_INPUT, opts);
+ } else if (a2.equals(SYM_WRITE)) {
+ PrintWriter out =
+ new PrintWriter(new BufferedWriter(new FileWriter(file, false)));
+ streamObject = new JavaObjectTerm(out);
+ opts = new ListTerm(SYM_OUTPUT, opts);
+ } else if (a2.equals(SYM_APPEND)) {
+ PrintWriter out =
+ new PrintWriter(new BufferedWriter(new FileWriter(file, true)));
+ streamObject = new JavaObjectTerm(out);
+ opts = new ListTerm(SYM_OUTPUT, opts);
+ } else {
+ throw new IllegalDomainException(this, 2, "io_mode", a2);
+ }
+ } catch (IOException e) {
+ throw new PermissionException(this, "open", "source_sink", a1, "");
+ }
+ if (engine.getStreamManager().containsKey(streamObject))
+ throw new InternalException("stream object is duplicated");
+ // stream_options
+ a4 = a4.dereference();
+ Term tmp = a4;
+ while (! tmp.isNil()) {
+ if (tmp.isVariable())
+ throw new PInstantiationException(this, 4);
+ if (! tmp.isList())
+ throw new IllegalTypeException(this, 4, "list", a4);
+ Term car = ((ListTerm) tmp).car().dereference();
+ if (car.isVariable())
+ throw new PInstantiationException(this, 4);
+ if (car.isStructure()) {
+ SymbolTerm functor = ((StructureTerm) car).functor();
+ Term[] args = ((StructureTerm) car).args();
+ if (functor.equals(SYM_ALIAS_1)) {
+ alias = args[0].dereference();
+ if (! alias.isSymbol())
+ throw new IllegalDomainException(this, 4, "stream_option", car);
+ if (engine.getStreamManager().containsKey(alias))
+ throw new PermissionException(this, "open", "source_sink", car, "");
+ } else {
+ throw new IllegalDomainException(this, 4, "stream_option", car);
+ }
+ } else {
+ throw new IllegalDomainException(this, 4, "stream_option", car);
+ }
+ tmp = ((ListTerm) tmp).cdr().dereference();
+ }
+ Term[] args1 = {SYM_TEXT};
+ Term[] args2 = {a2};
+ Term[] args3 = {SymbolTerm.makeSymbol(file.getAbsolutePath())};
+ opts = new ListTerm(new StructureTerm(SYM_TYPE_1, args1), opts);
+ opts = new ListTerm(new StructureTerm(SYM_MODE_1, args2), opts);
+ opts = new ListTerm(new StructureTerm(SYM_FILE_NAME_1, args3), opts);
+ if (alias != null) {
+ engine.getStreamManager().put(alias, streamObject);
+ Term[] as = {alias};
+ opts = new ListTerm(new StructureTerm(SYM_ALIAS_1, as), opts);
+ }
+ ((VariableTerm)a3).bind(streamObject, engine.trail);
+ engine.getStreamManager().put(streamObject, opts);
+ return cont;
+ }
+}
+
+
+
diff --git a/src/builtin/Base/PRED_peek_byte_2.java b/src/builtin/Base/PRED_peek_byte_2.java
new file mode 100644
index 0000000..50d9c16
--- /dev/null
+++ b/src/builtin/Base/PRED_peek_byte_2.java
@@ -0,0 +1,84 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>peek_byte/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.1
+ @since 1.1
+*/
+public class PRED_peek_byte_2 extends Predicate {
+ public static IntegerTerm INT_EOF = new IntegerTerm(-1);
+ public Term arg1, arg2;
+
+ public PRED_peek_byte_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_peek_byte_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "peek_byte(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // InByte
+ a2 = a2.dereference();
+ if (! a2.isVariable()) {
+ if (! a2.isInteger())
+ throw new IllegalTypeException(this, 2, "in_byte", a2);
+ int n = ((IntegerTerm)a2).intValue();
+ if (n != -1 && (n < 0 || n > 255))
+ throw new RepresentationException(this, 2, "in_byte");
+ }
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read single byte
+ try {
+ int c = ((PushbackReader)stream).read();
+ if (c < 0) { // EOF
+ if (! a2.unify(INT_EOF, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (c > 255)
+ throw new RepresentationException(this, 0, "byte");
+ ((PushbackReader)stream).unread(c);
+ if (! a2.unify(new IntegerTerm(c), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_peek_char_2.java b/src/builtin/Base/PRED_peek_char_2.java
new file mode 100644
index 0000000..ef0a3f2
--- /dev/null
+++ b/src/builtin/Base/PRED_peek_char_2.java
@@ -0,0 +1,86 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>peek_char/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_peek_char_2 extends Predicate {
+ public static SymbolTerm SYM_EOF = SymbolTerm.makeSymbol("end_of_file");
+ public Term arg1, arg2;
+
+ public PRED_peek_char_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_peek_char_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "peek_char(" + arg1 + "," + arg2 + ")";
+ }
+
+ boolean inCharacter(Term t) {
+ if (! t.isSymbol())
+ return false;
+ if (t.equals(SYM_EOF))
+ return true;
+ return ((SymbolTerm)t).name().length() == 1;
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (! a2.isVariable() && ! inCharacter(a2))
+ throw new IllegalTypeException(this, 2, "in_character", a2);
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read single character
+ try {
+ int c = ((PushbackReader)stream).read();
+ if (c < 0) { // EOF
+ if (! a2.unify(SYM_EOF, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 0, "character");
+ ((PushbackReader)stream).unread(c);
+ if (! a2.unify(SymbolTerm.makeSymbol(String.valueOf((char)c)), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_peek_code_2.java b/src/builtin/Base/PRED_peek_code_2.java
new file mode 100644
index 0000000..c60c640
--- /dev/null
+++ b/src/builtin/Base/PRED_peek_code_2.java
@@ -0,0 +1,83 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>peek_code/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_peek_code_2 extends Predicate {
+ public static IntegerTerm INT_EOF = new IntegerTerm(-1);
+ public Term arg1, arg2;
+
+ public PRED_peek_code_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_peek_code_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "peek_code(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (! a2.isVariable()) {
+ if (! a2.isInteger())
+ throw new IllegalTypeException(this, 2, "integer", a2);
+ int n = ((IntegerTerm)a2).intValue();
+ if (n != -1 && ! Character.isDefined(n))
+ throw new RepresentationException(this, 2, "in_character_code");
+ }
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read single character
+ try {
+ int c = ((PushbackReader)stream).read();
+ if (c < 0) { // EOF
+ if (! a2.unify(INT_EOF, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 0, "character");
+ ((PushbackReader)stream).unread(c);
+ if (! a2.unify(new IntegerTerm(c), engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_put_byte_2.java b/src/builtin/Base/PRED_put_byte_2.java
new file mode 100644
index 0000000..48389ea
--- /dev/null
+++ b/src/builtin/Base/PRED_put_byte_2.java
@@ -0,0 +1,71 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>put_byte/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.1
+ @since 1.1
+*/
+public class PRED_put_byte_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_put_byte_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_put_byte_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "put_byte(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int c;
+ Object stream = null;
+
+ // Byte
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! a2.isInteger())
+ throw new IllegalTypeException(this, 2, "byte", a2);
+ c = ((IntegerTerm)a2).intValue();
+ if (c < 0 || c > 255)
+ throw new IllegalTypeException(this, 2, "byte", a2);
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ // print single byte
+ ((PrintWriter) stream).print((char)c);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_put_char_2.java b/src/builtin/Base/PRED_put_char_2.java
new file mode 100644
index 0000000..2605a4f
--- /dev/null
+++ b/src/builtin/Base/PRED_put_char_2.java
@@ -0,0 +1,74 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>put_char/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_put_char_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_put_char_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_put_char_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "put_char(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ String str;
+ char c;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! a2.isSymbol())
+ throw new IllegalTypeException(this, 2, "character", a2);
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ // print single character
+ str = ((SymbolTerm)a2).name();
+ if (str.length() != 1)
+ throw new IllegalTypeException(this, 2, "character", a2);
+ c = str.charAt(0);
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 2, "character");
+ ((PrintWriter) stream).print(c);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_put_code_2.java b/src/builtin/Base/PRED_put_code_2.java
new file mode 100644
index 0000000..123e774
--- /dev/null
+++ b/src/builtin/Base/PRED_put_code_2.java
@@ -0,0 +1,70 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>put_code/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_put_code_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_put_code_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_put_code_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "put_code(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int c;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! a2.isInteger())
+ throw new IllegalTypeException(this, 2, "integer", a2);
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ // print single character
+ c = ((IntegerTerm)a2).intValue();
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 2, "character");
+ ((PrintWriter) stream).print((char)c);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_raise_exception_1.java b/src/builtin/Base/PRED_raise_exception_1.java
new file mode 100644
index 0000000..3c8f97d
--- /dev/null
+++ b/src/builtin/Base/PRED_raise_exception_1.java
@@ -0,0 +1,37 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+/**
+ * <code>raise_exception/1</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PRED_raise_exception_1 extends Predicate {
+ Term arg1;
+
+ public PRED_raise_exception_1() {}
+ public PRED_raise_exception_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() { return "raise_exception(" + arg1 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+
+ a1 = a1.dereference();
+ if (a1.isVariable())
+ throw new PInstantiationException(this, 1);
+ throw new TermException(a1);
+ }
+}
diff --git a/src/builtin/Base/PRED_read_line_2.java b/src/builtin/Base/PRED_read_line_2.java
new file mode 100644
index 0000000..078fb9c
--- /dev/null
+++ b/src/builtin/Base/PRED_read_line_2.java
@@ -0,0 +1,77 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ * <code>read_line/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class PRED_read_line_2 extends Predicate {
+ Term arg1, arg2;
+
+ public PRED_read_line_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+ public PRED_read_line_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() { return "read_line(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ Object stream = null;
+ String line;
+ char[] chars;
+ Term t;
+
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // read line
+ try {
+ line = (new BufferedReader((PushbackReader)stream)).readLine();
+ if (line == null) { // end_of_stream
+ if(! a2.unify(new IntegerTerm(-1), engine.trail))
+ return engine.fail();
+ return cont;
+ }
+ chars = line.toCharArray();
+ t = Prolog.Nil;
+ for (int i=chars.length; i>0; i--) {
+ if (! Character.isDefined((int)chars[i-1]))
+ throw new RepresentationException(this, 0, "character");
+ t = new ListTerm(new IntegerTerm((int)chars[i-1]), t);
+ }
+ if(! a2.unify(t, engine.trail))
+ return engine.fail();
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_set_input_1.java b/src/builtin/Base/PRED_set_input_1.java
new file mode 100644
index 0000000..2f0743b
--- /dev/null
+++ b/src/builtin/Base/PRED_set_input_1.java
@@ -0,0 +1,55 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.PushbackReader;
+/**
+ <code>set_input/1</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_set_input_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_set_input_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_set_input_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "set_input(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+ Object stream = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ engine.setCurrentInput((PushbackReader)stream);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_set_output_1.java b/src/builtin/Base/PRED_set_output_1.java
new file mode 100644
index 0000000..082e0cc
--- /dev/null
+++ b/src/builtin/Base/PRED_set_output_1.java
@@ -0,0 +1,55 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.PrintWriter;
+/**
+ <code>set_output/1</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_set_output_1 extends Predicate {
+
+ public Term arg1;
+
+ public PRED_set_output_1(Term a1, Predicate cont) {
+ arg1 = a1;
+ this.cont = cont;
+ }
+
+ public PRED_set_output_1(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ this.cont = cont;
+ }
+
+ public int arity() { return 1; }
+
+ public String toString() {
+ return "set_output(" + arg1 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1;
+ a1 = arg1;
+ Object stream = null;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ engine.setCurrentOutput((PrintWriter)stream);
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_skip_2.java b/src/builtin/Base/PRED_skip_2.java
new file mode 100644
index 0000000..5646c09
--- /dev/null
+++ b/src/builtin/Base/PRED_skip_2.java
@@ -0,0 +1,89 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>skip/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_skip_2 extends Predicate {
+ public static IntegerTerm INT_EOF = new IntegerTerm(-1);
+ public Term arg1, arg2;
+
+ public PRED_skip_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_skip_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "skip(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int n;
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! a2.isInteger()) {
+ try {
+ a2 = Arithmetic.evaluate(a2);
+ } catch (BuiltinException e) {
+ e.goal = this;
+ e.argNo = 2;
+ throw e;
+ }
+ }
+ n = ((NumberTerm)a2).intValue();
+ if (! Character.isDefined(n))
+ throw new RepresentationException(this, 2, "character_code");
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PushbackReader))
+ throw new PermissionException(this, "input", "stream", a1, "");
+ // skip
+ try {
+ PushbackReader in = (PushbackReader) stream;
+ int c = in.read();
+ while(c != n) {
+ c = in.read();
+ if (c == -1) // EOF
+ return cont;
+ if (! Character.isDefined(c))
+ throw new RepresentationException(this, 0, "character");
+ }
+ return cont;
+ } catch (IOException e) {
+ throw new TermException(new JavaObjectTerm(e));
+ }
+ }
+}
diff --git a/src/builtin/Base/PRED_sort_2.java b/src/builtin/Base/PRED_sort_2.java
new file mode 100644
index 0000000..f6ce369
--- /dev/null
+++ b/src/builtin/Base/PRED_sort_2.java
@@ -0,0 +1,78 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.util.Arrays;
+/**
+ * <code>sort/2</code><br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PRED_sort_2 extends Predicate {
+ static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+ Term arg1, arg2;
+
+ public PRED_sort_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_sort_2() {}
+
+ public void setArgument(Term[] args, Predicate cont){
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2 ; }
+
+ public String toString() { return "sort(" + arg1 + "," + arg2 + ")"; }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int len;
+ Term tmp, tmp2;
+ Term[] list;
+
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.equals(Nil)) {
+ if (! a2.unify(Nil, engine.trail))
+ return engine.fail();
+ return cont;
+ } else if (! a1.isList()) {
+ throw new IllegalTypeException(this, 1, "list", a1);
+ }
+ len = ((ListTerm)a1).length();
+ list = new Term[len];
+ tmp = a1;
+ for (int i=0; i<len; i++) {
+ if (! tmp.isList())
+ throw new IllegalTypeException(this, 1, "list", a1);
+ list[i] = ((ListTerm)tmp).car().dereference();
+ tmp = ((ListTerm)tmp).cdr().dereference();
+ }
+ if (! tmp.equals(Nil))
+ throw new PInstantiationException(this, 1);
+ try {
+ Arrays.sort(list);
+ } catch (ClassCastException e) {
+ throw new JavaException(this, 1, e);
+ }
+ tmp = Nil;
+ tmp2 = null;
+ for (int i=list.length-1; i>=0; i--) {
+ if (! list[i].equals(tmp2))
+ tmp = new ListTerm(list[i], tmp);
+ tmp2 = list[i];
+ }
+ if(! a2.unify(tmp, engine.trail))
+ return engine.fail();
+ return cont;
+ }
+}
diff --git a/src/builtin/Base/PRED_tab_2.java b/src/builtin/Base/PRED_tab_2.java
new file mode 100644
index 0000000..253bdb7
--- /dev/null
+++ b/src/builtin/Base/PRED_tab_2.java
@@ -0,0 +1,78 @@
+package jp.ac.kobe_u.cs.prolog.builtin;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.*;
+/**
+ <code>tab/2</code><br>
+ @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ @version 1.0
+*/
+public class PRED_tab_2 extends Predicate {
+
+ public Term arg1, arg2;
+
+ public PRED_tab_2(Term a1, Term a2, Predicate cont) {
+ arg1 = a1;
+ arg2 = a2;
+ this.cont = cont;
+ }
+
+ public PRED_tab_2(){}
+
+ public void setArgument(Term[] args, Predicate cont) {
+ arg1 = args[0];
+ arg2 = args[1];
+ this.cont = cont;
+ }
+
+ public int arity() { return 2; }
+
+ public String toString() {
+ return "tab(" + arg1 + "," + arg2 + ")";
+ }
+
+ public Predicate exec(Prolog engine) {
+ engine.setB0();
+ Term a1, a2;
+ a1 = arg1;
+ a2 = arg2;
+ int n;
+ String s = "";
+ Object stream = null;
+
+ // Char
+ a2 = a2.dereference();
+ if (a2.isVariable())
+ throw new PInstantiationException(this, 2);
+ if (! a2.isInteger()) {
+ try {
+ a2 = Arithmetic.evaluate(a2);
+ } catch (BuiltinException e) {
+ e.goal = this;
+ e.argNo = 2;
+ throw e;
+ }
+ }
+ n = ((NumberTerm)a2).intValue();
+ // S_or_a
+ a1 = a1.dereference();
+ if (a1.isVariable()) {
+ throw new PInstantiationException(this, 1);
+ } else if (a1.isSymbol()) {
+ if (! engine.getStreamManager().containsKey(a1))
+ throw new ExistenceException(this, 1, "stream", a1, "");
+ stream = ((JavaObjectTerm) engine.getStreamManager().get(a1)).object();
+ } else if (a1.isJavaObject()) {
+ stream = ((JavaObjectTerm) a1).object();
+ } else {
+ throw new IllegalDomainException(this, 1, "stream_or_alias", a1);
+ }
+ if (! (stream instanceof PrintWriter))
+ throw new PermissionException(this, "output", "stream", a1, "");
+ // tab
+ for (int i=0; i<n; i++)
+ s += " ";
+ ((PrintWriter) stream).print(s);
+ return cont;
+ }
+}
diff --git a/src/builtin/Makefile b/src/builtin/Makefile
new file mode 100644
index 0000000..02a7f2a
--- /dev/null
+++ b/src/builtin/Makefile
@@ -0,0 +1,40 @@
+################################################################
+# Makefile for Prolog Cafe
+################################################################
+
+################################################################
+# The following two definitions will be overridden.
+#
+# JAVAC : the command of Java compiler system
+# (ex. javac)
+# JAR : the command of Jar archive system
+# (ex. jar)
+#
+JAVAC = javac
+JAVACOPTS = -d . -Xlint -classpath $$PLCAFEDIR/lang.jar:$$CLASSPATH
+JAR = jar
+JAROPTS = cf
+################################################################
+.SUFFIXES:
+.SUFFIXES: .am .pl $(SUFFIXES)
+
+am_objects = builtins.am \
+ system.am \
+
+.pl.am:
+ pl2am.plc -v -O $< $@
+ -mkdir $*
+ am2j.plc -v -d $* $@
+
+builtin:$(am_objects)
+ $(JAVAC) $(JAVACOPTS) */*.java
+ $(JAR) $(JAROPTS) builtin.jar jp/ac/kobe_u/cs/prolog/builtin/
+
+clean:
+ -rm -f -r builtins
+ -rm -f -r system
+ -rm -f -r jp
+ -rm -f Base/core Base/*~ Base/*.class
+ -rm -f core *~ *.am *.jar *.class
+
+realclean: clean
diff --git a/src/builtin/builtins.pl b/src/builtin/builtins.pl
new file mode 100644
index 0000000..5d40189
--- /dev/null
+++ b/src/builtin/builtins.pl
@@ -0,0 +1,2612 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Builtin Predicates of Prolog Cafe
+%
+% Mutsunori Banbara (banbara@kobe-u.ac.jp)
+% Naoyuki Tamura (tamura@kobe-u.ac.jp)
+% Kobe University
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- op(1150, fx, (package)).
+package(_).
+:- package 'jp.ac.kobe_u.cs.prolog.builtin'.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Control constructs
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public true/0, therwise/0.
+:- public fail/0, false/0.
+%:- public (!)/0, '$get_level'/1, '$neck_cut'/0, '$cut'/1.
+:- public (!)/0.
+:- public (^)/2.
+:- public (',')/2.
+:- public (;)/2.
+:- public (->)/2.
+:- public call/1.
+
+true.
+otherwise.
+
+fail :- fail.
+false :- fail.
+
+!.
+%'$get_level'(X) :- '$get_level'(X).
+%'$neck_cut' :- '$neck_cut'.
+%'$cut'(X) :- '$cut'(X).
+
+(_ ^ G) :- call(G).
+
+(P, Q) :- call(P), call(Q).
+
+(P; _Q) :- P \= (_ -> _), call(P).
+(_P; Q) :- Q \= (_ -> _), call(Q).
+
+(IF -> THEN) :- call(IF), !, call(THEN).
+
+(IF -> THEN; _ELSE) :- call(IF), !, call(THEN).
+(_IF -> _THEN; ELSE) :- call(ELSE).
+
+call(Term) :-
+ %'$get_level'(Cut),
+ '$get_current_B'(Cut),
+ '$meta_call'(Term, user, Cut, 0, interpret).
+
+'$meta_call'(X, _, _, _, _) :- var(X), !, illarg(var, call(X), 1).
+'$meta_call'(X, _, _, _, _) :- closure(X), !, '$call_closure'(X).
+'$meta_call'(true, _, _, _, _) :- !.
+'$meta_call'(trace, _, _, _, _) :- !, trace.
+'$meta_call'(debug, _, _, _, _) :- !, debug.
+'$meta_call'(notrace, _, _, _, _) :- !, notrace.
+'$meta_call'(nodebug, _, _, _, _) :- !, nodebug.
+'$meta_call'(spy(L), _, _, _, _) :- !, spy(L).
+'$meta_call'(nospy(L), _, _, _, _) :- !, nospy(L).
+'$meta_call'(nospyall, _, _, _, _) :- !, nospyall.
+'$meta_call'(leash(L), _, _, _, _) :- !, leash(L).
+'$meta_call'([X|Xs], _, _, _, _) :- !, consult([X|Xs]).
+'$meta_call'(_^X, P, Cut, Depth, Mode) :- !,
+ '$meta_call'(X, P, Cut, Depth, Mode).
+'$meta_call'(P:X, _, Cut, Depth, Mode) :- !,
+ '$meta_call'(X, P, Cut, Depth, Mode).
+'$meta_call'(!, _, no, _, _) :- !, illarg(context(if,cut), !, 0).
+'$meta_call'(!, _, Cut, _, _) :- !, '$cut'(Cut).
+'$meta_call'((X,Y), P, Cut, Depth, Mode) :- !,
+ '$meta_call'(X, P, Cut, Depth, Mode),
+ '$meta_call'(Y, P, Cut, Depth, Mode).
+'$meta_call'((X->Y;Z), P, Cut, Depth, Mode) :- !,
+ ( '$meta_call'(X, P, no, Depth, Mode) -> '$meta_call'(Y, P, Cut, Depth, Mode)
+ ; '$meta_call'(Z, P, Cut, Depth, Mode)
+ ).
+'$meta_call'((X->Y), P, Cut, Depth, Mode) :- !,
+ ( '$meta_call'(X, P, no, Depth, Mode) -> '$meta_call'(Y, P, Cut, Depth, Mode) ).
+'$meta_call'((X;Y), P, Cut, Depth, Mode) :- !,
+ ( '$meta_call'(X, P, Cut, Depth, Mode) ; '$meta_call'(Y, P, Cut, Depth, Mode) ).
+'$meta_call'(\+(X), P, _, Depth, Mode) :- !,
+ \+ '$meta_call'(X, P, no, Depth, Mode).
+'$meta_call'(findall(X,Y,Z), P, Cut, Depth, Mode) :- !,
+ findall(X, '$meta_call'(Y, P, Cut, Depth, Mode), Z).
+'$meta_call'(bagof(X,Y,Z), P, Cut, Depth, Mode) :- !,
+ bagof(X, '$meta_call'(Y, P, Cut, Depth, Mode), Z).
+'$meta_call'(setof(X,Y,Z), P, Cut, Depth, Mode) :- !,
+ setof(X, '$meta_call'(Y, P, Cut, Depth, Mode), Z).
+'$meta_call'(once(X), P, Cut, Depth, Mode) :- !,
+ once('$meta_call'(X, P, Cut, Depth, Mode)).
+'$meta_call'(on_exception(X,Y,Z), P, Cut, Depth, Mode) :- !,
+ on_exception(X, '$meta_call'(Y, P, Cut, Depth, Mode), '$meta_call'(Z, P, Cut, Depth, Mode)).
+'$meta_call'(catch(X,Y,Z), P, Cut, Depth, Mode) :- !,
+ catch('$meta_call'(X, P, Cut, Depth, Mode), Y, '$meta_call'(Z, P, Cut, Depth, Mode)).
+%'$meta_call'(freeze(X,Y), P, Cut, Depth, Mode) :- !, ???
+% freeze(X, '$meta_call'(Y, P, Cut, Depth, Mode)).
+'$meta_call'(synchronized(X,Y), P, Cut, Depth, Mode) :- !,
+ synchronized(X, '$meta_call'(Y, P, Cut, Depth, Mode)).
+'$meta_call'(clause(X, Y), P, _, _, _) :- !, clause(P:X, Y).
+'$meta_call'(assert(X), P, _, _, _) :- !, assertz(P:X).
+'$meta_call'(assertz(X), P, _, _, _) :- !, assertz(P:X).
+'$meta_call'(asserta(X), P, _, _, _) :- !, asserta(P:X).
+'$meta_call'(retract(X), P, _, _, _) :- !, retract(P:X).
+'$meta_call'(abolish(X), P, _, _, _) :- !, abolish(P:X).
+'$meta_call'(retractall(X), P, _, _, _) :- !, retractall(P:X).
+'$meta_call'(X, P, _, Depth, Mode) :- atom(P), callable(X), !,
+ '$meta_call'(Mode, Depth, P, X).
+'$meta_call'(X, P, _, _, _) :-
+ illarg(type(callable), call(P:X), 1).
+
+'$meta_call'(trace, Depth, P, X) :- !,
+ functor(X, F, A),
+ '$trace_goal'(X, P, F/A, Depth).
+'$meta_call'(interpret, Depth, P, X) :-
+ functor(X, F, A),
+ '$call_internal'(X, P, F/A, Depth, interpret).
+
+'$call_internal'(X, P, FA, Depth, Mode) :-
+ '$new_internal_database'(P),
+ hash_contains_key(P, FA),
+ !,
+ %'$get_level'(Cut),
+ '$get_current_B'(Cut),
+ Depth1 is Depth + 1,
+ clause(P:X, Body),
+ '$meta_call'(Body, P, Cut, Depth1, Mode).
+'$call_internal'(X, P, _, _, _) :- '$call'(P, X).
+
+
+:- public catch/3, throw/1.
+:- public on_exception/3.
+%:- public raise_exception/1. (written in Java)
+
+catch(Goal, Catch, Recovery) :-
+ on_exception(Catch, Goal, Recovery).
+
+throw(Msg) :- raise_exception(Msg).
+
+on_exception(Catch, Goal, Recovery) :-
+ callable(Goal),
+ !,
+ '$on_exception'(Catch, Goal, Recovery).
+on_exception(Catch, Goal, Recovery) :-
+ illarg(type(callable), on_exception(Catch,Goal,Recovery), 2).
+
+'$on_exception'(_Catch, Goal, _Recovery) :-
+ '$set_exception'('$none'),
+ '$begin_exception'(L),
+ call(Goal),
+ '$end_exception'(L).
+'$on_exception'(Catch, _Goal, Recovery) :-
+ '$get_exception'(Msg),
+ Msg \== '$none',
+ '$catch_and_throw'(Msg, Catch, Recovery).
+
+'$catch_and_throw'(Msg, Msg, Recovery) :- !,
+ '$set_exception'('$none'),
+ call(Recovery).
+'$catch_and_throw'(Msg, _, _) :-
+ raise_exception(Msg).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Term unification
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public (=)/2, '$unify'/2.
+:- public (\=)/2, '$not_unifiable'/2.
+
+X = Y :- X = Y.
+'$unify'(X, Y) :- '$unify'(X, Y).
+
+X \= Y :- X \= Y.
+'$not_unifiable'(X, Y) :- '$not_unifiable'(X, Y).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Type testing
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public var/1, atom/1, integer/1, float/1, atomic/1, compound/1, nonvar/1, number/1.
+:- public java/1, java/2, closure/1.
+:- public ground/1, callable/1.
+
+var(X) :- var(X).
+
+atom(X) :- atom(X).
+
+integer(X) :- integer(X).
+
+float(X) :- float(X).
+
+atomic(X) :- atomic(X).
+
+nonvar(X) :- nonvar(X).
+
+number(X) :- number(X).
+
+java(X) :- java(X).
+java(X, Y) :- java(X, Y).
+
+closure(X) :- closure(X).
+
+ground(X) :- ground(X).
+
+compound(X) :- nonvar(X), functor(X, _, A), A > 0.
+
+callable(X) :- atom(X), !.
+callable(X) :- compound(X), !.
+callable(X) :- closure(X).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Term comparison
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public (==)/2, '$equality_of_term'/2.
+:- public (\==)/2, '$inequality_of_term'/2.
+:- public (@<)/2, '$before'/2.
+:- public (@>)/2, '$after'/2.
+:- public (@=<)/2, '$not_after'/2.
+:- public (@>=)/2, '$not_before'/2.
+:- public (?=)/2, '$identical_or_cannot_unify'/2.
+:- public compare/3.
+% :- public sort/2. witten in Java
+% :- public keysort/2. witten in Java
+% :- public merge/3.
+
+X == Y :- X == Y.
+'$equality_of_term'(X, Y) :- '$equality_of_term'(X, Y).
+
+X \== Y :- X \== Y.
+'$inequality_of_term'(X, Y) :- '$inequality_of_term'(X, Y).
+
+X @< Y :- X @< Y.
+'$before'(X, Y) :- '$before'(X, Y).
+
+X @> Y :- X @> Y.
+'$after'(X, Y) :- '$after'(X, Y).
+
+X @=< Y :- X @=< Y.
+'$not_after'(X, Y) :- '$not_after'(X, Y).
+
+X @>= Y :- X @>= Y.
+'$not_before'(X, Y) :- '$not_before'(X, Y).
+
+?=(X, Y) :- ?=(X, Y).
+'$identical_or_cannot_unify'(X, Y) :- '$identical_or_cannot_unify'(X, Y).
+
+compare(Op, X, Y) :- '$compare0'(Op0, X, Y), '$map_compare_op'(Op0, Op).
+
+'$compare0'(Op0, X, Y) :-
+ '$INSERT_AM'([deref(a(2),a(2)),deref(a(3),a(3))]),
+ '$INSERT'(['\tif(! a1.unify(new IntegerTerm(a2.compareTo(a3)), engine.trail))',
+ '\t\treturn engine.fail();']).
+
+'$map_compare_op'(Op0, Op) :- Op0 =:= 0, !, Op = (=).
+'$map_compare_op'(Op0, Op) :- Op0 < 0, !, Op = (<).
+'$map_compare_op'(Op0, Op) :- Op0 > 0, !, Op = (>).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Term creation and decomposition
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%:- public arg/3. --> written in Java
+%:- public functor/3. --> written in Java
+:- public (=..)/2.
+:- public copy_term/2.
+
+Term =.. List :- Term =.. List.
+
+copy_term(X, Y) :- copy_term(X, Y).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Arithmetic evaluation
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public (is)/2.
+:- public '$abs'/2, '$asin'/2, '$acos'/2, '$atan'/2.
+:- public '$bitwise_conj'/3, '$bitwise_disj'/3, '$bitwise_exclusive_or'/3, '$bitwise_neg'/2.
+:- public '$ceil'/2, '$cos'/2.
+:- public '$degrees'/2.
+:- public '$exp'/2.
+:- public '$float'/2, '$float_integer_part'/2, '$float_fractional_part'/2, '$float_quotient'/3, '$floor'/2.
+:- public '$int_quotient'/3.
+:- public '$log'/2.
+:- public '$max'/3, '$min'/3, '$minus'/3, '$mod'/3, '$multi'/3.
+:- public '$plus'/3, '$pow'/3.
+:- public '$radians'/2, '$rint'/2, '$round'/2.
+:- public '$shift_left'/3, '$shift_right'/3, '$sign'/2, '$sin'/2, '$sqrt'/2.
+:- public '$tan'/2, '$truncate'/2.
+
+Z is Y :- Z is Y.
+
+'$abs'(X, Y) :- '$abs'(X, Y).
+'$asin'(X, Y) :- '$asin'(X, Y).
+'$acos'(X, Y) :- '$acos'(X, Y).
+'$atan'(X, Y) :- '$atan'(X, Y).
+'$bitwise_conj'(X, Y, Z) :- '$bitwise_conj'(X, Y, Z).
+'$bitwise_disj'(X, Y, Z) :- '$bitwise_disj'(X, Y, Z).
+'$bitwise_exclusive_or'(X, Y, Z) :- '$bitwise_exclusive_or'(X, Y, Z).
+'$bitwise_neg'(X, Y) :- '$bitwise_neg'(X, Y).
+'$ceil'(X, Y) :- '$ceil'(X, Y).
+'$cos'(X, Y) :- '$cos'(X, Y).
+'$degrees'(X, Y) :- '$degrees'(X, Y).
+'$exp'(X, Y) :- '$exp'(X, Y).
+'$float'(X, Y) :- '$float'(X, Y).
+'$float_integer_part'(X, Y) :- '$float_integer_part'(X, Y).
+'$float_fractional_part'(X, Y) :- '$float_fractional_part'(X, Y).
+'$float_quotient'(X, Y, Z) :- '$float_quotient'(X, Y, Z).
+'$floor'(X, Y) :- '$floor'(X, Y).
+'$int_quotient'(X, Y, Z) :- '$int_quotient'(X, Y, Z).
+'$log'(X, Y) :- '$log'(X, Y).
+'$max'(X, Y, Z) :- '$max'(X, Y, Z).
+'$min'(X, Y, Z) :- '$min'(X, Y, Z).
+'$minus'(X, Y, Z) :- '$minus'(X, Y, Z).
+'$mod'(X, Y, Z) :- '$mod'(X, Y, Z).
+'$multi'(X, Y, Z) :- '$multi'(X, Y, Z).
+'$plus'(X,Y,Z) :- '$plus'(X,Y,Z).
+'$pow'(X, Y, Z) :- '$pow'(X, Y, Z).
+'$radians'(X, Y) :- '$radians'(X, Y).
+'$rint'(X, Y) :- '$rint'(X, Y).
+'$round'(X, Y) :- '$round'(X, Y).
+'$shift_left'(X, Y, Z) :- '$shift_left'(X, Y, Z).
+'$shift_right'(X, Y, Z) :- '$shift_right'(X, Y, Z).
+'$sign'(X, Y) :- '$sign'(X, Y).
+'$sin'(X, Y) :- '$sin'(X, Y).
+'$sqrt'(X, Y) :- '$sqrt'(X, Y).
+'$tan'(X, Y) :- '$tan'(X, Y).
+'$truncate'(X, Y) :- '$truncate'(X, Y).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Arithmetic comparison
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public (=:=)/2, '$arith_equal'/2.
+:- public (=\=)/2, '$arith_not_equal'/2.
+:- public (<)/2, '$less_than'/2.
+:- public (=<)/2, '$less_or_equal'/2.
+:- public (>)/2, '$greater_than'/2.
+:- public (>=)/2, '$greater_or_equal'/2.
+
+X =:= Y :- X =:= Y.
+'$arith_equal'(X, Y) :- '$arith_equal'(X, Y).
+
+X =\= Y :- X =\= Y.
+'$arith_not_equal'(X, Y) :- '$arith_not_equal'(X, Y).
+
+X < Y :- X < Y.
+'$less_than'(X, Y) :- '$less_than'(X, Y).
+
+X =< Y :- X =< Y.
+'$less_or_equal'(X, Y) :- '$less_or_equal'(X, Y).
+
+X > Y :- X > Y.
+'$greater_than'(X, Y) :- '$greater_than'(X, Y).
+
+X >= Y :- X >= Y.
+'$greater_or_equal'(X, Y) :- '$greater_or_equal'(X, Y).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Clause retrieval and information
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public clause/2.
+:- public (initialization)/2.
+:- public '$new_indexing_hash'/3.
+
+clause(Head, B) :-
+ '$head_to_term'(Head, H, P:PI, clause(Head,B)),
+ '$new_internal_database'(P),
+ '$check_procedure_permission'(P:PI, access, private_procedure, clause(Head, B)),
+ '$clause_internal'(P, PI, H, Cl, _),
+ %(ground(Cl) -> Cl = (H :- B) ; copy_term(Cl, (H :- B))). ???
+ copy_term(Cl, (H :- B)).
+
+% head --> term
+'$head_to_term'(H, T, Pkg:F/A, Goal) :-
+ '$head_to_term'(H, T, user, Pkg, Goal),
+ functor(T, F, A).
+
+'$head_to_term'(H, _, _, _, Goal) :- var(H), !,
+ illarg(var, Goal, 1).
+'$head_to_term'(P:H, T, _, Pkg, Goal) :- !,
+ '$head_to_term'(H, T, P, Pkg, Goal).
+'$head_to_term'(H, H, Pkg, Pkg, _) :- callable(H), atom(Pkg), !.
+'$head_to_term'(_, _, _, _, Goal) :-
+ illarg(type(callable), Goal, 1).
+
+% creates an internal database for A if no exists.
+'$new_internal_database'(A) :-
+ atom(A),
+ '$get_hash_manager'(HM),
+ '$new_internal_database'(HM, A).
+
+'$new_internal_database'(HM, A) :-
+ hash_contains_key(HM, A),
+ !.
+'$new_internal_database'(_, A) :-
+ new_hash(_, [alias(A)]),
+ '$init_internal_database'(A).
+
+'$init_internal_database'(A) :-
+ '$compiled_predicate'(A, '$init', 0),
+ call(A:'$init'),
+ !.
+'$init_internal_database'(_).
+
+% checks if the internal database of A exists.
+'$defined_internal_database'(A) :-
+ atom(A),
+ '$get_hash_manager'(HM),
+ hash_contains_key(HM, A).
+
+% repeatedly finds dynamic clauses.
+'$clause_internal'(P, PI, H, Cl, Ref) :-
+ hash_contains_key(P, PI),
+ '$get_indices'(P, PI, H, RevRefs),
+ '$get_instances'(RevRefs, Cls_Refs),
+ % ???
+ %length(Cls_Refs,N),
+ %'$fast_write'([clause_internal,N,for,P,PI]),nl,
+ %
+ '$clause_internal0'(Cls_Refs, Cl, Ref).
+
+'$clause_internal0'([], _, _) :- fail.
+'$clause_internal0'([(Cl,Ref)], Cl, Ref) :- !.
+'$clause_internal0'(L, Cl, Ref) :-
+ '$builtin_member'((Cl,Ref), L).
+
+'$get_indices'(P, PI, H, Refs) :-
+ '$new_indexing_hash'(P, PI, IH),
+ '$calc_indexing_key'(H, Key),
+ ( hash_contains_key(IH, Key) -> hash_get(IH, Key, Refs)
+ ;
+ hash_get(IH, var, Refs)
+ ).
+
+% finds the indexing hashtable for P:PI. creates it if no exist.
+'$new_indexing_hash'(P, PI, IH) :-
+ hash_contains_key(P, PI),
+ !,
+ hash_get(P, PI, IH).
+'$new_indexing_hash'(P, PI, IH) :-
+ new_hash(IH),
+ hash_put(IH, all, []),
+ hash_put(IH, var, []),
+ hash_put(IH, lis, []),
+ hash_put(IH, str, []),
+ hash_put(P, PI, IH).
+
+'$calc_indexing_key'(H, all) :- atom(H), !.
+'$calc_indexing_key'(H, Key) :-
+ arg(1, H, A1),
+ '$calc_indexing_key0'(A1, Key).
+
+'$calc_indexing_key0'(A1, all) :- var(A1), !.
+'$calc_indexing_key0'(A1, lis) :- A1 = [_|_], !.
+'$calc_indexing_key0'(A1, str) :- compound(A1), !.
+'$calc_indexing_key0'(A1, Key) :- ground(A1), !, '$term_hash'(A1, Key).
+'$calc_indexing_key0'(A1, Key) :- illarg(type(term), '$calc_indexing_key0'(A1,Key), 1).
+
+% checks the permission of predicate P:F/A.
+'$check_procedure_permission'(P:F/A, _Operation, _ObjType, _Goal) :-
+ hash_contains_key(P, F/A),
+ !.
+'$check_procedure_permission'(P:F/A, Operation, ObjType, Goal) :-
+ '$compiled_predicate_or_builtin'(P, F, A),
+ !,
+ illarg(permission(Operation,ObjType,P:F/A,_), Goal, _).
+'$check_procedure_permission'(_, _, _, _).
+
+% checks if predicate P:F/A is compiled or not.
+'$compiled_predicate'(P, F, A) :-
+ '$INSERT_AM'([deref(a(1),a(1)),deref(a(2),a(2)),deref(a(3),a(3))]),
+ '$INSERT'(['\tif(! engine.pcl.definedPredicate(((SymbolTerm)a1).name(), ((SymbolTerm)a2).name(), ((IntegerTerm)a3).intValue()))',
+ '\t\treturn engine.fail();']).
+
+'$compiled_predicate_or_builtin'(P, F, A) :-
+ '$INSERT_AM'([deref(a(1),a(1)),deref(a(2),a(2)),deref(a(3),a(3))]),
+ '$INSERT'(['\tif(! engine.pcl.definedPredicate(((SymbolTerm)a1).name(), ((SymbolTerm)a2).name(), ((IntegerTerm)a3).intValue()) && ! engine.pcl.definedPredicate("jp.ac.kobe_u.cs.prolog.builtin", ((SymbolTerm)a2).name(), ((IntegerTerm)a3).intValue()))',
+ '\t\treturn engine.fail();']).
+
+% initialize internal databases of given packages.
+%initialization([], Goal) :- !, call(Goal).
+initialization([], Goal) :- !, once(Goal).
+initialization([P|Ps], Goal) :-
+ '$new_internal_database'(P),
+ initialization(Ps, Goal).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Clause creation and destruction
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public assert/1.
+:- public assertz/1.
+:- public asserta/1.
+:- public retract/1.
+:- public abolish/1.
+:- public retractall/1.
+
+assert(T) :-assertz(T).
+
+assertz(T) :-
+ '$term_to_clause'(T, Cl, P:PI, assertz(T)),
+ '$new_internal_database'(P),
+ '$check_procedure_permission'(P:PI, modify, static_procedure, assertz(T)),
+ copy_term(Cl, NewCl),
+ '$insert'(NewCl, Ref),
+ %'$fast_write'([intert,NewCl,Ref]), nl, %???
+ '$update_indexing'(P, PI, Cl, Ref, 'z'),
+ fail.
+assertz(_).
+
+asserta(T) :-
+ '$term_to_clause'(T, Cl, P:PI, asserta(T)),
+ '$new_internal_database'(P),
+ '$check_procedure_permission'(P:PI, modify, static_procedure, asserta(T)),
+ copy_term(Cl, NewCl),
+ '$insert'(NewCl, Ref),
+ %'$fast_write'([insert,NewCl,Ref]), nl, %???
+ '$update_indexing'(P, PI, Cl, Ref, 'a'),
+ fail.
+asserta(_).
+
+abolish(T) :-
+ '$term_to_predicateindicator'(T, P:PI, abolish(T)),
+ '$new_internal_database'(P),
+ '$check_procedure_permission'(P:PI, modify, static_procedure, abolish(T)),
+ '$new_indexing_hash'(P, PI, IH),
+ hash_get(IH, all, Refs),
+ %'$fast_write'([erase_all,Refs]), nl, %???
+ '$erase_all'(Refs),
+ hash_remove(P, PI),
+ fail.
+abolish(_).
+
+retract(Cl) :-
+ '$clause_to_term'(Cl, T, P:PI, retract(Cl)),
+ '$new_internal_database'(P),
+ '$check_procedure_permission'(P:PI, access, static_procedure, retract(Cl)),
+ T = (H :- _),
+ '$clause_internal'(P, PI, H, Cl0, Ref),
+ copy_term(Cl0, T),
+ %'$fast_write'([erase,Cl0,Ref]), nl, %???
+ '$erase'(Ref),
+ '$rehash_indexing'(P, PI, Ref).
+
+retractall(Head) :-
+ '$head_to_term'(Head, H, P:PI, retractall(Head)),
+ '$new_internal_database'(P),
+ '$check_procedure_permission'(P:PI, access, static_procedure, retractall(Head)),
+ '$clause_internal'(P, PI, H, Cl, Ref),
+ copy_term(Cl, (H :- _)),
+ %'$fast_write'([erase,Cl,Ref]), nl, %???
+ '$erase'(Ref),
+ '$rehash_indexing'(P, PI, Ref),
+ fail.
+retractall(_).
+
+% term --> clause (for assert)
+'$term_to_clause'(Cl0, Cl, Pkg:F/A, Goal) :-
+ '$term_to_clause'(Cl0, Cl, user, Pkg, Goal),
+ Cl = (H :- _),
+ functor(H, F, A).
+
+'$term_to_clause'(Cl0, _, _, _, Goal) :- var(Cl0), !,
+ illarg(var, Goal, 1).
+'$term_to_clause'(_, _, Pkg0, _, Goal) :- var(Pkg0), !,
+ illarg(var, Goal, 1).
+'$term_to_clause'(P:Cl0, Cl, _, Pkg, Goal) :- !,
+ '$term_to_clause'(Cl0, Cl, P, Pkg, Goal).
+'$term_to_clause'(_, _, Pkg0, _, Goal) :- \+(atom(Pkg0)), !,
+ illarg(type(atom), Goal, 1).
+'$term_to_clause'((H0 :- B0), (H :- B), Pkg, Pkg, Goal) :- !,
+ '$term_to_head'(H0, H, Pkg, Goal),
+ '$term_to_body'(B0, B, Pkg, Goal).
+'$term_to_clause'(H0, (H :- true), Pkg, Pkg, Goal) :-
+ '$term_to_head'(H0, H, Pkg, Goal).
+
+'$term_to_head'(H, H, _, _) :- atom(H), !.
+'$term_to_head'(H, H, _, _) :- compound(H), !.
+'$term_to_head'(_, _, _, Goal) :-
+ illarg(type(callable), Goal, 1).
+
+'$term_to_body'(B0, B, Pkg, _) :-
+ '$localize_body'(B0, Pkg, B).
+
+'$localize_body'(G, P, G1) :- var(G), !,
+ '$localize_body'(call(G), P, G1).
+'$localize_body'(P:G, _, G1) :- !,
+ '$localize_body'(G, P, G1).
+'$localize_body'((X,Y), P, (X1,Y1)) :- !,
+ '$localize_body'(X, P, X1),
+ '$localize_body'(Y, P, Y1).
+'$localize_body'((X->Y), P, (X1->Y1)) :- !,
+ '$localize_body'(X, P, X1),
+ '$localize_body'(Y, P, Y1).
+'$localize_body'((X;Y), P, (X1;Y1)) :- !,
+ '$localize_body'(X, P, X1),
+ '$localize_body'(Y, P, Y1).
+'$localize_body'(G, P, G1) :-
+ functor(G, F, A),
+ '$builtin_meta_predicates'(F, A, M), %???
+ !,
+ G =.. [F|As],
+ '$localize_args'(M, As, P, As1),
+ G1 =.. [F|As1].
+'$localize_body'(G, P, call(P:G)) :- var(P), !.
+'$localize_body'(G, user, G) :- !.
+'$localize_body'(G, _, G) :- system_predicate(G), !.
+'$localize_body'(G, P, P:G).
+
+'$localize_args'([], [], _, []) :- !.
+'$localize_args'([:|Ms], [A|As], P, [P:A|As1]) :-
+ (var(A) ; A \= _:_),
+ !,
+ '$localize_args'(Ms, As, P, As1).
+'$localize_args'([_|Ms], [A|As], P, [A|As1]) :-
+ '$localize_args'(Ms, As, P, As1).
+
+'$builtin_meta_predicates'((^), 2, [?,:]).
+'$builtin_meta_predicates'(call, 1, [:]).
+'$builtin_meta_predicates'(once, 1, [:]).
+'$builtin_meta_predicates'((\+), 1, [:]).
+'$builtin_meta_predicates'(findall, 3, [?,:,?]).
+'$builtin_meta_predicates'(setof, 3, [?,:,?]).
+'$builtin_meta_predicates'(bagof, 3, [?,:,?]).
+'$builtin_meta_predicates'(on_exception, 3, [?,:,:]).
+'$builtin_meta_predicates'(catch, 3, [:,?,:]).
+'$builtin_meta_predicates'(synchronized, 2, [?,:]).
+'$builtin_meta_predicates'(freeze, 2, [?,:]).
+
+% clause --> term (for retract)
+'$clause_to_term'(Cl, T, Pkg:F/A, Goal) :-
+ '$clause_to_term'(Cl, T, user, Pkg, Goal),
+ T = (H :- _),
+ functor(H, F, A).
+
+'$clause_to_term'(Cl, _, _, _, Goal) :- var(Cl), !,
+ illarg(var, Goal, 1).
+'$clause_to_term'(_, _, Pkg, _, Goal) :- var(Pkg), !,
+ illarg(var, Goal, 1).
+'$clause_to_term'(P:Cl, T, _, Pkg, Goal) :- !,
+ '$clause_to_term'(Cl, T, P, Pkg, Goal).
+'$clause_to_term'(_, _, Pkg, _, Goal) :- \+(atom(Pkg)), !,
+ illarg(type(atom), Goal, 1).
+'$clause_to_term'((H0 :- B), (H :- B), Pkg, Pkg, Goal) :- !,
+ '$head_to_term'(H0, H, _, Goal).
+ %'$body_to_term'(B0, B, Goal).
+'$clause_to_term'(H0, (H :- true), Pkg, Pkg, Goal) :-
+ '$head_to_term'(H0, H, _, Goal).
+
+% term --> predicate indicator (for abolish)
+'$term_to_predicateindicator'(T, Pkg:PI, Goal) :-
+ '$term_to_predicateindicator'(T, PI, user, Pkg, Goal).
+
+'$term_to_predicateindicator'(T, _, _, _, Goal) :- var(T), !,
+ illarg(var, Goal, 1).
+'$term_to_predicateindicator'(_, _, Pkg, _, Goal) :- var(Pkg), !,
+ illarg(var, Goal, 1).
+'$term_to_predicateindicator'(P:T, PI, _, Pkg, Goal) :- !,
+ '$term_to_predicateindicator'(T, PI, P, Pkg, Goal).
+'$term_to_predicateindicator'(T, _, _, _, Goal) :- T \= _/_, !,
+ illarg(type('predicate_indicator'), Goal, 1).
+'$term_to_predicateindicator'(F/_, _, _, _, Goal) :- \+ atom(F), !,
+ illarg(type(atom), Goal, 1).
+'$term_to_predicateindicator'(_/A, _, _, _, Goal) :- \+ integer(A), !,
+ illarg(type(integer), Goal, 1).
+'$term_to_predicateindicator'(T, T, Pkg, Pkg, _).
+
+'$update_indexing'(P, PI, Cl, Ref, A_or_Z) :-
+ '$new_indexing_hash'(P, PI, IH),
+ '$gen_indexing_keys'(Cl, IH, Keys),
+ %'$fast_write'([update_indexing,P,PI,Cl,Ref,Keys]), nl, %???
+ '$update_indexing_hash'(A_or_Z, Keys, IH, Ref).
+
+'$gen_indexing_keys'((H :- _), _, [all]) :- atom(H), !.
+'$gen_indexing_keys'((H :- _), IT, Keys) :-
+ arg(1, H, A1),
+ '$gen_indexing_keys0'(A1, IT, Keys).
+
+'$gen_indexing_keys0'(A1, IT, Keys) :- var(A1), !, hash_keys(IT, Keys).
+'$gen_indexing_keys0'(A1, _, [all,lis]) :- A1 = [_|_], !.
+'$gen_indexing_keys0'(A1, _, [all,str]) :- compound(A1), !.
+'$gen_indexing_keys0'(A1, IT, [all,Key]) :- ground(A1), !,
+ '$term_hash'(A1, Key), % get the hash code of A1
+ ( hash_contains_key(IT, Key) -> true
+ ;
+ hash_get(IT, var, L), hash_put(IT, Key, L)
+ ).
+'$gen_indexing_keys0'(A1, IT, Keys) :-
+ illarg(type(term), '$gen_indexing_keys0'(A1,IT,Keys), 1).
+
+'$update_indexing_hash'(a, Keys, IH, Ref) :- !, '$hash_addz_all'(Keys, IH, Ref).
+'$update_indexing_hash'(z, Keys, IH, Ref) :- !, '$hash_adda_all'(Keys, IH, Ref).
+
+'$hash_adda_all'([], _, _) :- !.
+'$hash_adda_all'([K|Ks], H, X) :-
+ '$hash_adda'(H, K, X),
+ '$hash_adda_all'(Ks, H, X).
+
+'$hash_addz_all'([], _, _) :- !.
+'$hash_addz_all'([K|Ks], H, X) :-
+ '$hash_addz'(H, K, X),
+ '$hash_addz_all'(Ks, H, X).
+
+'$erase_all'([]) :- !.
+'$erase_all'([R|Rs]) :- '$erase'(R), '$erase_all'(Rs).
+
+'$rehash_indexing'(P, PI, Ref) :-
+ '$new_indexing_hash'(P, PI, IH),
+ hash_keys(IH, Keys),
+ %'$fast_write'([rehash_indexing,P,PI,Keys]), nl, %???
+ '$remove_index_all'(Keys, IH, Ref).
+
+'$remove_index_all'([], _, _) :- !.
+'$remove_index_all'([K|Ks], IH, Ref) :-
+ '$hash_remove_first'(IH, K, Ref),
+ '$remove_index_all'(Ks, IH, Ref).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% All solutions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public findall/3.
+:- public bagof/3.
+:- public setof/3.
+
+% findall/3
+findall(Template, Goal, Instances) :- callable(Goal), !,
+ new_hash(H),
+ '$findall'(H, Template, Goal, Instances).
+findall(Template, Goal, Instances) :-
+ illarg(type(callable), findall(Template,Goal,Instances), 2).
+
+'$findall'(H, Template, Goal, _) :-
+ call(Goal),
+ copy_term(Template, CT),
+ '$hash_adda'(H, '$FINDALL', CT),
+ fail.
+'$findall'(H, _, _, Instances) :-
+ hash_get(H, '$FINDALL', Vs),
+ '$builtin_reverse'(Vs, Instances).
+
+% bagof/3 & setof/3
+bagof(Template, Goal, Instances) :- callable(Goal), !,
+ '$bagof'(Template, Goal, Instances).
+bagof(Template, Goal, Instances) :-
+ illarg(type(callable), bagof(Template,Goal,Instances), 2).
+
+setof(Template, Goal, Instances) :- callable(Goal), !,
+ '$bagof'(Template, Goal, Instances0),
+ sort(Instances0, Instances).
+setof(Template, Goal, Instances) :-
+ illarg(type(callable), setof(Template,Goal,Instances), 2).
+
+'$bagof'(Template, Goal, Instances) :-
+ '$free_variables_set'(Goal, Template, FV),
+ %write('Goal = '), write(Goal), nl,
+ %write('Free variables set = '), write(FV), nl,
+ FV \== [],
+ !,
+ Witness =.. ['$witness'|FV],
+ findall(Witness+Template, Goal, S),
+ '$bagof_instances'(S, Witness, Instances0),
+ Instances = Instances0.
+'$bagof'(Template, Goal, Instances) :-
+ findall(Template, Goal, Instances),
+ Instances \== [].
+
+'$bagof_instances'([], _Witness, _Instances) :- fail.
+'$bagof_instances'(S0, Witness, Instances) :-
+ S0 = [W+T|S],
+ '$variants_subset'(S, W, WT_list, T_list, S_next),
+ '$bagof_instances0'(S_next, Witness, Instances, [W+T|WT_list], [T|T_list]).
+
+'$bagof_instances0'(_, Witness, Instances, WT_list, T_list) :-
+ '$unify_witness'(WT_list, Witness),
+ Instances = T_list.
+'$bagof_instances0'(S_next, Witness, Instances, _, _) :-
+ '$bagof_instances'(S_next, Witness, Instances).
+
+'$variants_subset'([], _W, [], [], []) :- !.
+'$variants_subset'([W0+T0|S], W, [W0+T0|WT_list], [T0|T_list], S_next) :-
+ '$term_variant'(W, W0),
+ !,
+ '$variants_subset'(S, W, WT_list, T_list, S_next).
+'$variants_subset'([WT|S], W, WT_list, T_list, [WT|S_next]) :-
+ '$variants_subset'(S, W, WT_list, T_list, S_next).
+
+'$term_variant'(X, Y) :- new_hash(Hash), '$term_variant'(X, Y, Hash).
+
+'$term_variant'(X, Y, Hash) :- var(X), !,
+ ( hash_contains_key(Hash, X) ->
+ hash_get(Hash, X, V), Y == V
+ ;
+ var(Y), hash_put(Hash, X, Y)
+ ).
+'$term_variant'(X, Y, _) :- ground(X), !,
+ X == Y.
+'$term_variant'(_, Y, _) :- var(Y), !,
+ fail.
+'$term_variant'([X|Xs], [Y|Ys], Hash) :- !,
+ '$term_variant'(X, Y, Hash),
+ '$term_variant'(Xs, Ys, Hash).
+'$term_variant'(X, Y, Hash) :-
+ X =.. Xs,
+ Y =.. Ys,
+ '$term_variant'(Xs, Ys, Hash).
+
+'$unify_witness'([], _) :- !.
+'$unify_witness'([W+_|WT_list], W) :-
+ '$unify_witness'(WT_list, W).
+
+% Variable set of a term
+'$variables_set'(X, Vs) :- '$variables_set'(X, [], Vs).
+
+'$variables_set'(X, Vs, Vs ) :- var(X), '$builtin_memq'(X, Vs), !.
+'$variables_set'(X, Vs, [X|Vs] ) :- var(X), !.
+'$variables_set'(X, Vs0, Vs0 ) :- atomic(X), !.
+'$variables_set'([X|Xs], Vs0, Vs) :- !,
+ '$variables_set'(X, Vs0, Vs1),
+ '$variables_set'(Xs, Vs1, Vs).
+'$variables_set'(X, Vs0, Vs ) :-
+ X =.. Xs,
+ '$variables_set'(Xs, Vs0, Vs).
+
+'$builtin_memq'(X, [Y|_]) :- X==Y, !.
+'$builtin_memq'(X, [_|Ys]) :- '$builtin_memq'(X, Ys).
+
+% Existential variables set of a term
+'$existential_variables_set'(X, Vs) :-
+ '$existential_variables_set'(X, [], Vs).
+
+'$existential_variables_set'(X, Vs, Vs) :- var(X), !.
+'$existential_variables_set'(X, Vs, Vs) :- atomic(X), !.
+'$existential_variables_set'(_:X, Vs0, Vs) :- !,
+ '$existential_variables_set'(X, Vs0, Vs).
+%'$existential_variables_set'((X;Y), Vs0, Vs) :- !,
+% '$existential_variables_set'(X, Vs0, Vs1),
+% '$existential_variables_set'(Y, Vs1, Vs).
+%'$existential_variables_set'((X->Y), Vs0, Vs) :- !,
+% '$existential_variables_set'(X, Vs0, Vs1),
+% '$existential_variables_set'(Y, Vs1, Vs).
+%'$existential_variables_set'((X,Y), Vs0, Vs) :- !,
+% '$existential_variables_set'(X, Vs0, Vs1),
+% '$existential_variables_set'(Y, Vs1, Vs).
+'$existential_variables_set'(^(V,G), Vs0, Vs) :- !,
+ '$variables_set'(V, Vs0, Vs1),
+ '$existential_variables_set'(G, Vs1, Vs).
+'$existential_variables_set'('$meta_call'(G,_,_,_,_), Vs0, Vs) :- !, %???
+ '$existential_variables_set'(G, Vs0, Vs).
+'$existential_variables_set'(_, Vs, Vs).
+
+% Free variables set of a term
+'$free_variables_set'(T, V, FV) :-
+ '$variables_set'(T, TV),
+ '$variables_set'(V, VV),
+ '$existential_variables_set'(T, VV, BV),
+ '$builtin_set_diff'(TV, BV, FV),
+ !.
+
+'$builtin_set_diff'(L1, L2, L) :-
+ sort(L1, SL1),
+ sort(L2, SL2),
+ '$builtin_set_diff0'(SL1, SL2, L).
+
+'$builtin_set_diff0'([], _, []) :- !.
+'$builtin_set_diff0'(L1, [], L1) :- !.
+'$builtin_set_diff0'([X|Xs], [Y|Ys], L) :- X == Y, !,
+ '$builtin_set_diff0'(Xs, Ys, L).
+'$builtin_set_diff0'([X|Xs], [Y|Ys], [X|L]) :- X @< Y, !,
+ '$builtin_set_diff0'(Xs, [Y|Ys], L).
+'$builtin_set_diff0'([X|Xs], [Y|Ys], [Y|L]) :-
+ '$builtin_set_diff0'([X|Xs], Ys, [Y|L]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stream selection and control
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%:- public current_input/1 (written in Java)
+%:- public current_output/1 (written in Java)
+%:- public set_input/1, set_output/1. (written in Java)
+%:- public open/4 (written in Java)
+:- public open/3.
+%:- public close/2 (written in Java)
+:- public close/1.
+%:- public flush_output/1.(written in Java)
+:- public flush_output/0.
+:- public stream_property/2.
+
+open(Source_sink, Mode, Stream) :- open(Source_sink, Mode, Stream, []).
+
+close(S_or_a) :- close(S_or_a, []).
+
+flush_output :-
+ current_output(S),
+ flush_output(S).
+
+stream_property(Stream, Stream_property) :-
+ var(Stream_property),
+ !,
+ '$stream_property'(Stream, Stream_property).
+stream_property(Stream, Stream_property) :-
+ '$stream_property_specifier'(Stream_property),
+ !,
+ '$stream_property'(Stream, Stream_property).
+stream_property(Stream, Stream_property) :-
+ illarg(domain(term,stream_proeprty), stream_property(Stream, Stream_property), 2).
+
+'$stream_property'(Stream, Stream_property) :-
+ var(Stream),
+ !,
+ '$get_stream_manager'(SM),
+ hash_map(SM, Map),
+ '$builtin_member'((Stream,Vs), Map),
+ java(Stream),
+ '$builtin_member'(Stream_property, Vs).
+'$stream_property'(Stream, Stream_property) :-
+ java(Stream),
+ !,
+ '$get_stream_manager'(SM),
+ hash_get(SM, Stream, Vs),
+ '$builtin_member'(Stream_property, Vs).
+'$stream_property'(Stream, Stream_property) :-
+ illarg(domain(stream,stream), stream_property(Stream, Stream_property), 1).
+
+'$stream_property_specifier'(input).
+'$stream_property_specifier'(output).
+'$stream_property_specifier'(alias(_)).
+'$stream_property_specifier'(mode(_)).
+'$stream_property_specifier'(type(_)).
+'$stream_property_specifier'(file_name(_)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Character input/output
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%:- public get_char/2, get_code/2. (written in Java)
+%:- public peek_char/2, peek_code/2. (written in Java)
+%:- public put_char/2, put_code/2. (written in Java)
+%:- public nl/0. (written in Java)
+
+:- public get_char/1, get_code/1.
+:- public peek_char/1, peek_code/1.
+:- public put_char/1, put_code/1.
+:- public nl/1.
+
+get_char(Char) :- current_input(S), get_char(S, Char).
+get_code(Code) :- current_input(S), get_code(S, Code).
+
+peek_char(Char) :- current_input(S), peek_char(S, Char).
+peek_code(Code) :- current_input(S), peek_code(S, Code).
+
+put_char(Char) :- current_output(S), put_char(S, Char).
+put_code(Code) :- current_output(S), put_code(S, Code).
+
+nl(S) :- put_char(S, '\n').
+
+:- public get0/1, get0/2.
+:- public get/1.
+%:- public get/2. (written in Java)
+:- public put/1, put/2.
+:- public tab/1.
+%:- public tab/2. (written in Java)
+:- public skip/1.
+%:- public skip/2. (written in Java)
+
+get0(Code) :- current_input(S), get_code(S, Code).
+get0(S_or_a, Code) :- get_code(S_or_a, Code).
+
+get(Code) :- current_input(S), get(S, Code).
+
+put(Exp) :- current_output(S), put(S, Exp).
+put(S_or_a, Exp) :- Code is Exp, put_code(S_or_a, Code).
+
+tab(N) :- current_output(S), tab(S, N).
+
+skip(N) :- current_input(S), skip(S, N).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Byte input/output
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public get_byte/1, peek_byte/1, put_byte/1.
+%:- public get_byte/2. % written in java
+%:- public peek_byte/2. % written in java
+%:- public put_byte/2. % written in java
+
+get_byte(Byte) :-
+ current_input(S),
+ get_byte(S, Byte).
+
+peek_byte(Byte) :-
+ current_input(S),
+ peek_byte(S, Byte).
+
+put_byte(Byte) :-
+ current_output(S),
+ put_byte(S, Byte).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Term input/output (read)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public read/1, read/2.
+:- public read_with_variables/2, read_with_variables/3.
+:- public read_line/1.
+%:- public read_line/2. (written in Java)
+:- dynamic '$tokens'/1.
+
+read(X) :- current_input(S), read(S, X).
+
+read(S_or_a, X) :-
+ read_tokens(S_or_a, Tokens, _),
+ parse_tokens(X, Tokens),
+ !.
+
+read_with_variables(X, Vs) :-
+ current_input(S),
+ read_with_variables(S, X, Vs).
+
+read_with_variables(S_or_a, X, Vs) :-
+ read_tokens(S_or_a, Tokens, Vs),
+ parse_tokens(X, Tokens),
+ !.
+
+read_line(X) :- current_input(S), read_line(S, X).
+
+% read_token(S_or_a, Token) reads one token from the input,
+% and unifies Token with:
+% error(Atom),
+% end_of_file,
+% '.', ' ', '(', ')', '[', ']', '{', '}', ',', '|',
+% number(Integer_or_Float),
+% atom(Atom),
+% var(Atom),
+% string(CharCodeList)
+
+%read_token(Token) :- current_input(S), read_token(S, Token).
+
+read_token(S_or_a, Token) :-
+ '$read_token0'(S_or_a, Type, Token0),
+ '$read_token1'([Type], Token0, Token).
+
+'$read_token1'([-2], T, error(T)) :- !. % error('message')
+'$read_token1'("I", T, number(T)) :- !. % number(intvalue)
+'$read_token1'("D", T, number(T)) :- !. % number(floatvalue)
+'$read_token1'("A", T, atom(T)) :- !. % atom('name')
+'$read_token1'("V", T, var(T)) :- !. % var('name')
+'$read_token1'("S", T, string(T)) :- !. % string("chars")
+'$read_token1'(_, T, T) :- !. % others
+
+% read_tokens(Tokens, Vs) reads tokens from the input
+% until full-stop-mark ('.') or end_of_file,
+% unifies Tokens with a list of tokens.
+% Token for a variable has a form of var(Name,Variable).
+% Vs is a list of Name=Variable pairs.
+
+%read_tokens(Tokens, Vs) :-
+% current_input(Stream),
+% '$read_tokens'(Stream, Tokens, Vs, []),
+% !.
+
+read_tokens(Stream, Tokens, Vs) :-
+ '$read_tokens'(Stream, Tokens, Vs, []),
+ !.
+
+'$read_tokens'(Stream, Tokens, Vs, VI) :-
+ read_token(Stream, Token),
+ '$read_tokens1'(Stream, Token, Tokens, Vs, VI).
+
+'$read_tokens1'(Stream, error(Message), [], _, _) :- !,
+ write('{SYNTAX ERROR}'), nl,
+ write('** '), write(Message), write(' **'), nl,
+ '$read_tokens_until_fullstop'(Stream),
+ fail.
+'$read_tokens1'(_Stream, end_of_file, [end_of_file,'.'], [], _) :- !.
+'$read_tokens1'(_Stream, '.', ['.'], [], _) :- !.
+'$read_tokens1'(Stream, var('_'), [var('_',V)|Tokens], ['_'=V|Vs], VI0) :- !,
+ '$read_tokens'(Stream, Tokens, Vs, ['_'=V|VI0]).
+'$read_tokens1'(Stream, var(Name), [var(Name,V)|Tokens], Vs, VI) :-
+ '$mem_pair'(Name=V, VI), !,
+ '$read_tokens'(Stream, Tokens, Vs, VI).
+'$read_tokens1'(Stream, var(Name), [var(Name,V)|Tokens], [Name=V|Vs], VI0) :- !,
+ '$read_tokens'(Stream, Tokens, Vs, [Name=V|VI0]).
+'$read_tokens1'(Stream, Token, [Token|Tokens], Vs, VI) :-
+ '$read_tokens'(Stream, Tokens, Vs, VI).
+
+'$mem_pair'(X1=V1, [X2=V2|_]) :- X1 == X2, !, V1 = V2.
+'$mem_pair'(X, [_|L]) :- '$mem_pair'(X, L).
+%'$mem_pair'(X, [_|L]) :- member(X, L).
+
+'$read_tokens_until_fullstop'(Stream) :-
+ read_token(Stream, Token),
+ '$read_tokens_until_fullstop'(Stream, Token).
+
+'$read_tokens_until_fullstop'(_Stream, end_of_file) :- !.
+'$read_tokens_until_fullstop'(_Stream, '.') :- !.
+'$read_tokens_until_fullstop'(Stream, _) :-
+ read_token(Stream, Token),
+ '$read_tokens_until_fullstop'(Stream, Token).
+
+parse_tokens(X, Tokens) :-
+ retractall('$tokens'(_)),
+ assertz('$tokens'(Tokens)),
+ '$parse_tokens'(X, 1201, Tokens, ['.']),
+ retract('$tokens'(Tokens)),
+ !.
+
+% '$parse_tokens'(X, Prec) parses the input whose precedecence =< Prec.
+'$parse_tokens'(X, Prec0) -->
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens1'(Prec0, X1, Prec1),
+ !,
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens2'(Prec0, X1, Prec1, X, _Prec),
+ !.
+
+'$parse_tokens1'(Prec0, X1, Prec1) -->
+ '$parse_tokens_peep_next'(Next),
+ {'$parse_tokens_is_starter'(Next)},
+ !,
+ '$parse_tokens_before_op'(Prec0, X1, Prec1).
+'$parse_tokens1'(_, _, _) -->
+ '$parse_tokens_peep_next'(Next),
+ '$parse_tokens_error'([Next,cannot,start,an,expression]).
+
+'$parse_tokens2'(Prec0, X, Prec, X, Prec) -->
+ '$parse_tokens_peep_next'(Next),
+ {'$parse_tokens_is_terminator'(Next)},
+ {Prec =< Prec0},
+ !.
+'$parse_tokens2'(Prec0, X1, Prec1, X, Prec) -->
+ '$parse_tokens_peep_next'(Next),
+ {'$parse_tokens_is_post_in_op'(Next)},
+ !,
+ '$parse_tokens_post_in_ops'(Prec0, X1, Prec1, X, Prec).
+'$parse_tokens2'(_, _, _, _, _) -->
+ '$parse_tokens_error'([operator,expected,after,expression]).
+
+% '$parse_tokens_before_op'(Prec0, X, Prec)
+% parses the input until infix or postfix operator,
+% and returns X and Prec
+'$parse_tokens_before_op'(Prec0, X, Prec) --> [' '], !,
+ '$parse_tokens_before_op'(Prec0, X, Prec).
+'$parse_tokens_before_op'(_, end_of_file, 0) --> [end_of_file], !.
+'$parse_tokens_before_op'(_, N, 0) --> [number(N)], !.
+'$parse_tokens_before_op'(_, N, 0) -->
+ [atom('-')], [number(N0)], !, {N is -N0}.
+'$parse_tokens_before_op'(_, V, 0) --> [var(_,V)], !.
+'$parse_tokens_before_op'(_, S, 0) --> [string(S)], !.
+'$parse_tokens_before_op'(_, X, 0) --> ['('], !,
+ '$parse_tokens'(X, 1201),
+ '$parse_tokens_expect'(')').
+'$parse_tokens_before_op'(_, X, 0) --> ['{'], !,
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_brace'(X).
+'$parse_tokens_before_op'(_, X, 0) --> ['['], !,
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_list'(X).
+'$parse_tokens_before_op'(_, X, 0) -->
+ [atom(F)], ['('],
+ !,
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_args'(Args),
+ {X =.. [F|Args]}.
+'$parse_tokens_before_op'(Prec0, X, PrecOp) -->
+ [atom(F)], {current_op(PrecOp,fx,F)}, {PrecOp =< Prec0},
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_peep_next'(Next),
+ {'$parse_tokens_is_starter'(Next)},
+ {\+ '$parse_tokens_is_post_in_op'(Next)},
+ !,
+ {Prec1 is PrecOp - 1},
+ '$parse_tokens'(Arg, Prec1),
+ {functor(X, F, 1)},
+ {arg(1, X, Arg)}.
+'$parse_tokens_before_op'(Prec0, X, PrecOp) -->
+ [atom(F)], {current_op(PrecOp,fy,F)}, {PrecOp =< Prec0},
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_peep_next'(Next),
+ {'$parse_tokens_is_starter'(Next)},
+ {\+ '$parse_tokens_is_post_in_op'(Next)},
+ !,
+ '$parse_tokens'(Arg, PrecOp),
+ {functor(X, F, 1)},
+ {arg(1, X, Arg)}.
+'$parse_tokens_before_op'(_, A, 0) -->
+ [atom(A)].
+
+'$parse_tokens_brace'('{}') --> ['}'], !.
+'$parse_tokens_brace'(X) -->
+ '$parse_tokens'(X1, 1201),
+ '$parse_tokens_expect'('}'),
+ {X = {X1}}.
+
+'$parse_tokens_list'('[]') --> [']'], !.
+'$parse_tokens_list'([X|Xs]) -->
+ '$parse_tokens'(X, 999),
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_list_rest'(Xs).
+
+'$parse_tokens_list_rest'(Xs) --> ['|'], !,
+ '$parse_tokens'(Xs, 999),
+ '$parse_tokens_expect'(']').
+'$parse_tokens_list_rest'([X|Xs]) --> [','], !,
+ '$parse_tokens'(X, 999),
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_list_rest'(Xs).
+'$parse_tokens_list_rest'('[]') -->
+ '$parse_tokens_expect'(']').
+
+'$parse_tokens_args'('[]') --> [')'], !.
+'$parse_tokens_args'([X|Xs]) -->
+ '$parse_tokens'(X, 999),
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_args_rest'(Xs).
+
+'$parse_tokens_args_rest'([X|Xs]) --> [','], !,
+ '$parse_tokens'(X, 999),
+ '$parse_tokens_skip_spaces',
+ '$parse_tokens_args_rest'(Xs).
+'$parse_tokens_args_rest'('[]') -->
+ '$parse_tokens_expect'(')').
+
+% '$parse_tokens_post_in_op'(Prec0, X1, Prec1, X, Prec)
+% parses the input beginning from infix or postfix operator,
+% and returns X and Prec
+'$parse_tokens_post_in_ops'(Prec0, X1, Prec1, X, Prec) -->
+ '$parse_tokens_skip_spaces',
+ [Op],
+ '$parse_tokens_op'(Op, Prec0, X1, Prec1, X2, Prec2),
+ '$parse_tokens_post_in_ops'(Prec0, X2, Prec2, X, Prec).
+'$parse_tokens_post_in_ops'(Prec0, X, Prec, X, Prec) -->
+ {Prec =< Prec0}.
+
+'$parse_tokens_op'(',', Prec0, X1, Prec1, X, PrecOp) --> !,
+ '$parse_tokens_op'(atom(','), Prec0, X1, Prec1, X, PrecOp).
+'$parse_tokens_op'('|', Prec0, X1, Prec1, X, PrecOp) --> !,
+ '$parse_tokens_op'(atom(';'), Prec0, X1, Prec1, X, PrecOp).
+'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
+ {current_op(PrecOp, xf, Op)}, {PrecOp =< Prec0},
+ {Prec1 < PrecOp},
+ {functor(X, Op, 1)},
+ {arg(1, X, X1)}.
+'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
+ {current_op(PrecOp, yf, Op)}, {PrecOp =< Prec0},
+ {Prec1 =< PrecOp},
+ {functor(X, Op, 1)},
+ {arg(1, X, X1)}.
+'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
+ {current_op(PrecOp, xfx, Op)}, {PrecOp =< Prec0},
+ {Prec1 < PrecOp},
+ {Prec2 is PrecOp - 1},
+ '$parse_tokens'(X2, Prec2),
+ !,
+ {functor(X, Op, 2)},
+ {arg(1, X, X1)},
+ {arg(2, X, X2)}.
+'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
+ {current_op(PrecOp, xfy, Op)}, {PrecOp =< Prec0},
+ {Prec1 < PrecOp},
+ {Prec2 is PrecOp},
+ '$parse_tokens'(X2, Prec2),
+ !,
+ {functor(X, Op, 2)},
+ {arg(1, X, X1)},
+ {arg(2, X, X2)}.
+'$parse_tokens_op'(atom(Op), Prec0, X1, Prec1, X, PrecOp) -->
+ {current_op(PrecOp, yfx, Op)}, {PrecOp =< Prec0},
+ {Prec1 =< PrecOp},
+ {Prec2 is PrecOp - 1},
+ '$parse_tokens'(X2, Prec2),
+ !,
+ {functor(X, Op, 2)},
+ {arg(1, X, X1)},
+ {arg(2, X, X2)}.
+
+'$parse_tokens_is_starter'(end_of_file).
+'$parse_tokens_is_starter'('(').
+'$parse_tokens_is_starter'('[').
+'$parse_tokens_is_starter'('{').
+'$parse_tokens_is_starter'(number(_)).
+'$parse_tokens_is_starter'(atom(_)).
+'$parse_tokens_is_starter'(var(_,_)).
+'$parse_tokens_is_starter'(string(_)).
+
+'$parse_tokens_is_terminator'(')').
+'$parse_tokens_is_terminator'(']').
+'$parse_tokens_is_terminator'('}').
+'$parse_tokens_is_terminator'('.').
+
+'$parse_tokens_is_post_in_op'(',') :- !.
+'$parse_tokens_is_post_in_op'('|') :- !.
+'$parse_tokens_is_post_in_op'(atom(Op)) :-
+ current_op(_, Type, Op),
+ '$parse_tokens_post_in_type'(Type),
+ !.
+
+'$parse_tokens_post_in_type'(xfx).
+'$parse_tokens_post_in_type'(xfy).
+'$parse_tokens_post_in_type'(yfx).
+'$parse_tokens_post_in_type'(xf).
+'$parse_tokens_post_in_type'(yf).
+
+'$parse_tokens_expect'(Token) -->
+ '$parse_tokens_skip_spaces',
+ [Token],
+ !.
+'$parse_tokens_expect'(Token) -->
+ '$parse_tokens_error'([Token,expected]).
+
+'$parse_tokens_skip_spaces' --> [' '], !, '$parse_tokens_skip_spaces'.
+'$parse_tokens_skip_spaces' --> [].
+
+'$parse_tokens_peep_next'(Next, S, S) :- S = [Next|_].
+
+'$parse_tokens_error'(Message, S0, _S) :-
+ write('{SYNTAX ERROR}'), nl, write('** '),
+ '$parse_tokens_write_message'(Message), write(' **'), nl,
+ '$parse_tokens_error1'([], S0),
+ clause('$tokens'(Tokens), _),
+ '$parse_tokens_error1'(Tokens, S0),
+ fail.
+
+'$parse_tokens_error1'([], _) :- !.
+'$parse_tokens_error1'(Tokens, S0) :- Tokens == S0, !,
+ nl, write('** here **'), nl,
+ '$parse_tokens_error1'(Tokens, []), nl.
+'$parse_tokens_error1'([Token|Tokens], S0) :-
+ '$parse_tokens_error2'(Token),
+ '$parse_tokens_error1'(Tokens, S0).
+
+'$parse_tokens_error2'(number(X)) :- !, write(X).
+'$parse_tokens_error2'(atom(X)) :- !, writeq(X).
+'$parse_tokens_error2'(var(X,_)) :- !, write(X).
+'$parse_tokens_error2'(string(X)) :- !,
+ write('"'), '$parse_tokens_write_string'(X), write('"').
+'$parse_tokens_error2'(X) :- write(X).
+
+'$parse_tokens_write_string'([]).
+'$parse_tokens_write_string'([C|Cs]) :- [C] = """", !,
+ put_code(C), put_code(C), '$parse_tokens_write_string'(Cs).
+'$parse_tokens_write_string'([C|Cs]) :-
+ put_code(C), '$parse_tokens_write_string'(Cs).
+
+'$parse_tokens_write_message'([]).
+'$parse_tokens_write_message'([X|Xs]) :-
+ write(X), write(' '), '$parse_tokens_write_message'(Xs).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Term input/output (write)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public write/1, write/2.
+:- public writeq/1, writeq/2.
+:- public write_canonical/1, write_canonical/2.
+:- public write_term/2, write_term/3.
+
+write(Term) :-
+ current_output(S),
+ write_term(S, Term, [numbervars(true)]).
+
+write(S_or_a, Term) :-
+ write_term(S_or_a, Term, [numbervars(true)]).
+
+writeq(Term) :-
+ current_output(S),
+ write_term(S, Term, [quoted(true),numbervars(true)]).
+
+writeq(S_or_a, Term) :-
+ write_term(S_or_a, Term, [quoted(true),numbervars(true)]).
+
+write_canonical(Term) :-
+ current_output(S),
+ write_term(S, Term, [quoted(true),ignore_ops(true)]).
+
+write_canonical(S_or_a, Term) :-
+ write_term(S_or_a, Term, [quoted(true),ignore_ops(true)]).
+
+write_term(Term, Options) :-
+ current_output(S),
+ write_term(S, Term, Options).
+
+write_term(S_or_a, Term, Options) :-
+ '$write_term'(S_or_a, Term, Options),
+ fail.
+write_term(_, _, _).
+
+'$write_term'(S_or_a, Term, Options) :-
+ '$write_term0'(Term, 1200, punct, _, Options, S_or_a),
+ !.
+
+'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :-
+ var(Term),
+ !,
+ '$write_space_if_needed'(Type0, alpha, S_or_a),
+ '$fast_write'(S_or_a, Term).
+'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :-
+ java(Term),
+ !,
+ '$write_space_if_needed'(Type0, alpha, S_or_a),
+ '$fast_write'(S_or_a, Term).
+'$write_term0'(Term, _Prec, Type0, alpha, Style, S_or_a) :-
+ Term = '$VAR'(VN), integer(VN), VN >= 0,
+ '$builtin_member'(numbervars(true), Style),
+ !,
+ '$write_space_if_needed'(Type0, alpha, S_or_a),
+ '$write_VAR'(VN, S_or_a).
+'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :-
+ number(Term), Term < 0,
+ !,
+ '$write_space_if_needed'(Type0, symbol, S_or_a),
+ '$fast_write'(S_or_a, Term).
+'$write_term0'(Term, _Prec, Type0, alpha, _, S_or_a) :-
+ number(Term),
+ !,
+ '$write_space_if_needed'(Type0, alpha, S_or_a),
+ '$fast_write'(S_or_a, Term).
+%'$write_term0'(Term, Prec, Type0, punct, _, S_or_a) :-
+% atom(Term),
+% current_op(PrecOp, OpType, Term),
+% (OpType = fx ; OpType = fy),
+% PrecOp =< Prec,
+% !,
+% '$write_space_if_needed'(Type0, punct, S_or_a),
+% put_char(S_or_a, '('),
+% '$write_atom'(Term, punct, _, _, S_or_a),
+% put_char(S_or_a, ')').
+'$write_term0'(Term, _Prec, Type0, Type, Style, S_or_a) :-
+ atom(Term),
+ !,
+ '$write_atom'(Term, Type0, Type, Style, S_or_a).
+'$write_term0'(Term, Prec, Type0, Type, Style, S_or_a) :-
+ \+ '$builtin_member'(ignore_ops(true), Style),
+ '$write_is_operator'(Term, Op, Args, OpType),
+ !,
+ '$write_term_op'(Op, OpType, Args, Prec, Type0, Type, Style, S_or_a).
+'$write_term0'(Term, _Prec, Type0, punct, Style, S_or_a) :-
+ Term = [_|_],
+ \+ '$builtin_member'(ignore_ops(true), Style),
+ !,
+ '$write_space_if_needed'(Type0, punct, S_or_a),
+ put_char(S_or_a, '['),
+ '$write_term_list_args'(Term, punct, _, Style, S_or_a),
+ put_char(S_or_a, ']').
+'$write_term0'(Term, _Prec, Type0, _Type, Style, S_or_a) :-
+ Term = {Term1},
+ \+ '$builtin_member'(ignore_ops(true), Style),
+ !,
+ '$write_space_if_needed'(Type0, punct, S_or_a),
+ put_char(S_or_a, '{'),
+ '$write_term0'(Term1, 1200, punct, _, Style, S_or_a),
+ put_char(S_or_a, '}').
+'$write_term0'(Term, _Prec, Type0, punct, Style, S_or_a) :-
+ Term =.. [F|Args],
+ '$write_atom'(F, Type0, _, Style, S_or_a),
+ put_char(S_or_a, '('),
+ '$write_term_args'(Args, punct, _, Style, S_or_a),
+ put_char(S_or_a, ')').
+
+'$write_space_if_needed'(punct, _, _ ) :- !.
+'$write_space_if_needed'(X, X, S_or_a) :- !, put_char(S_or_a, ' ').
+'$write_space_if_needed'(other, alpha, S_or_a) :- !, put_char(S_or_a, ' ').
+'$write_space_if_needed'(_, _, _ ).
+
+'$write_VAR'(VN, S_or_a) :- VN < 26, !,
+ Letter is VN mod 26 + "A",
+ put_code(S_or_a, Letter).
+'$write_VAR'(VN, S_or_a) :-
+ Letter is VN mod 26 + "A",
+ put_code(S_or_a, Letter),
+ Rest is VN//26,
+ '$fast_write'(S_or_a, Rest).
+
+'$write_atom'(Atom, Type0, Type, Style, S_or_a) :-
+ '$builtin_member'(quoted(true), Style),
+ !,
+ '$atom_type'(Atom, Type),
+ '$write_space_if_needed'(Type0, Type, S_or_a),
+ '$fast_writeq'(S_or_a, Atom).
+'$write_atom'(Atom, Type0, Type, _, S_or_a) :-
+ '$atom_type'(Atom, Type),
+ '$write_space_if_needed'(Type0, Type, S_or_a),
+ '$fast_write'(S_or_a, Atom).
+
+'$atom_type'(X, alpha ) :- '$atom_type0'(X, 0), !.
+'$atom_type'(X, symbol) :- '$atom_type0'(X, 1), !.
+'$atom_type'(X, punct ) :- '$atom_type0'(X, 2), !.
+'$atom_type'(X, other ) :- '$atom_type0'(X, 3), !.
+
+'$write_is_operator'(Term, Op, Args, OpType) :-
+ functor(Term, Op, Arity),
+ '$write_op_type'(Arity, OpType),
+ current_op(_, OpType, Op),
+ Term =.. [_|Args],
+ !.
+
+'$write_op_type'(1, fx).
+'$write_op_type'(1, fy).
+'$write_op_type'(1, xf).
+'$write_op_type'(1, yf).
+'$write_op_type'(2, xfx).
+'$write_op_type'(2, xfy).
+'$write_op_type'(2, yfx).
+
+'$write_term_op'(Op, OpType, Args, Prec, Type0, punct, Style, S_or_a) :-
+ current_op(PrecOp, OpType, Op),
+ PrecOp > Prec,
+ !,
+ '$write_space_if_needed'(Type0, punct, S_or_a),
+ put_char(S_or_a, '('),
+ '$write_term_op1'(Op, OpType, Args, PrecOp, punct, _, Style, S_or_a),
+ put_char(S_or_a, ')').
+'$write_term_op'(Op, OpType, Args, _Prec, Type0, Type, Style, S_or_a) :-
+ current_op(PrecOp, OpType, Op),
+ '$write_term_op1'(Op, OpType, Args, PrecOp, Type0, Type, Style, S_or_a).
+
+'$write_term_op1'(Op, fx, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
+ '$write_atom'(Op, Type0, Type1, Style, S_or_a),
+ Prec1 is PrecOp - 1,
+ '$write_term0'(A1, Prec1, Type1, Type, Style, S_or_a).
+'$write_term_op1'(Op, fy, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
+ '$write_atom'(Op, Type0, Type1, Style, S_or_a),
+ Prec1 is PrecOp,
+ '$write_term0'(A1, Prec1, Type1, Type, Style, S_or_a).
+'$write_term_op1'(Op, xf, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
+ Prec1 is PrecOp - 1,
+ '$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
+ '$write_atom'(Op, Type1, Type, Style, S_or_a).
+'$write_term_op1'(Op, yf, [A1], PrecOp, Type0, Type, Style, S_or_a) :- !,
+ Prec1 is PrecOp,
+ '$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
+ '$write_atom'(Op, Type1, Type, Style, S_or_a).
+'$write_term_op1'(Op, xfx, [A1,A2], PrecOp, Type0, Type, Style, S_or_a) :- !,
+ Prec1 is PrecOp - 1,
+ Prec2 is PrecOp - 1,
+ '$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
+ '$write_term_infix_op'(Op, Type1, Type2, Style, S_or_a),
+ '$write_term0'(A2, Prec2, Type2, Type, Style, S_or_a).
+'$write_term_op1'(Op, xfy, [A1,A2], PrecOp, Type0, Type, Style, S_or_a) :- !,
+ Prec1 is PrecOp - 1,
+ Prec2 is PrecOp,
+ '$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
+ '$write_term_infix_op'(Op, Type1, Type2, Style, S_or_a),
+ '$write_term0'(A2, Prec2, Type2, Type, Style, S_or_a).
+'$write_term_op1'(Op, yfx, [A1,A2], PrecOp, Type0, Type, Style, S_or_a) :- !,
+ Prec1 is PrecOp,
+ Prec2 is PrecOp - 1,
+ '$write_term0'(A1, Prec1, Type0, Type1, Style, S_or_a),
+ '$write_term_infix_op'(Op, Type1, Type2, Style, S_or_a),
+ '$write_term0'(A2, Prec2, Type2, Type, Style, S_or_a).
+
+'$write_term_infix_op'(',', Type0, punct, _, S_or_a) :- !,
+ '$write_space_if_needed'(Type0, punct, S_or_a),
+ put_char(S_or_a, ',').
+'$write_term_infix_op'(Op, Type0, Type, Style, S_or_a) :-
+ '$write_atom'(Op, Type0, Type, Style, S_or_a).
+
+'$write_term_list_args'([A|As], Type0, Type, Style, S_or_a) :-
+ nonvar(As), As = [_|_],
+ !,
+ '$write_term0'(A, 999, Type0, Type1, Style, S_or_a),
+ '$write_space_if_needed'(Type1, punct, S_or_a),
+ put_char(S_or_a, ','),
+ '$write_term_list_args'(As, punct, Type, Style, S_or_a).
+
+'$write_term_list_args'([A|As], Type0, Type, Style, S_or_a) :-
+ nonvar(As), As = [],
+ !,
+ '$write_term0'(A, 999, Type0, Type, Style, S_or_a).
+
+'$write_term_list_args'([A|As], Type0, Type, Style, S_or_a) :-
+ '$write_term0'(A, 999, Type0, Type1, Style, S_or_a),
+ '$write_space_if_needed'(Type1, punct, S_or_a),
+ put_char(S_or_a, '|'),
+ '$write_term0'(As, 999, punct, Type, Style, S_or_a).
+
+'$write_term_args'([], Type, Type, _, _) :- !.
+'$write_term_args'([A], Type0, Type, Style, S_or_a) :- !,
+ '$write_term0'(A, 999, Type0, Type, Style, S_or_a).
+'$write_term_args'([A|As], Type0, Type, Style, S_or_a) :- !,
+ '$write_term0'(A, 999, Type0, Type1, Style, S_or_a),
+ '$write_space_if_needed'(Type1, punct, S_or_a),
+ put_char(S_or_a, ','),
+ '$write_term_args'(As, punct, Type, Style, S_or_a).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Term input/output (others)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public op/3.
+:- public current_op/3.
+:- dynamic '$current_operator'/3.
+
+op(Priority, Op_specifier, Operator) :-
+ integer(Priority),
+ 0 =<Priority, Priority =<1200,
+ !,
+ '$op1'(Priority, Op_specifier, Operator).
+op(Priority, Op_specifier, Operator) :-
+ illarg(domain(integer,0-1200), op(Priority,Op_specifier,Operator), 1).
+
+'$op1'(Priority, Op_specifier, Operator) :-
+ nonvar(Op_specifier),
+ '$op_specifier'(Op_specifier, _),
+ !,
+ '$op2'(Priority, Op_specifier, Operator).
+'$op1'(Priority, Op_specifier, Operator) :-
+ findall(X, '$op_specifier'(X,_), Domain),
+ illarg(domain(term,Domain), op(Priority,Op_specifier,Operator), 2).
+
+'$op2'(Priority, Op_specifier, Operator) :-
+ atom(Operator),
+ !,
+ '$add_operators'([Operator], Priority, Op_specifier).
+'$op2'(Priority, Op_specifier, Operator) :-
+ '$op_atom_list'(Operator, Atoms),
+ !,
+ '$add_operators'(Atoms, Priority, Op_specifier).
+'$op2'(Priority, Op_specifier, Operator) :-
+ illarg(type(list(atom)), op(Priority,Op_specifier,Operator), 3).
+
+'$add_operators'([], _, _) :- !.
+'$add_operators'([A|As], Priority, Op_specifier) :-
+ '$add_op'(A, Priority, Op_specifier),
+ '$add_operators'(As, Priority, Op_specifier).
+
+'$add_op'(',', Priority, Op_specifier) :- !,
+ illarg(permission(modify,operator,',',_), op(Priority,Op_specifier,','), 3).
+'$add_op'(A, _, Op_specifier) :-
+ clause('$current_operator'(_,Op_specifier0,A), _),
+ '$op_specifier'(Op_specifier, Class),
+ '$op_specifier'(Op_specifier0, Class0),
+ Class = Class0,
+ retract('$current_operator'(_,Op_specifier0,A)),
+ fail.
+'$add_op'(_, 0, _) :- !.
+'$add_op'(A, Priority, Op_specifier) :-
+ assertz('$current_operator'(Priority,Op_specifier,A)).
+
+'$op_specifier'( fx, prefix).
+'$op_specifier'( fy, prefix).
+'$op_specifier'(xfx, infix).
+'$op_specifier'(xfy, infix).
+'$op_specifier'(yfx, infix).
+'$op_specifier'( xf, postfix).
+'$op_specifier'( yf, postfix).
+
+'$op_atom_list'(X, _) :- var(X), !, fail.
+'$op_atom_list'([], []) :- !.
+'$op_atom_list'([X|Xs], [X|As]) :- atom(X), !,
+ '$op_atom_list'(Xs, As).
+
+current_op(Priority, Op_specifier, Operator) :-
+ clause('$current_operator'(Priority,Op_specifier,Operator), _).
+
+'$current_operator'( 1200, xfx, (:-)).
+'$current_operator'( 1200, xfx, (-->)).
+'$current_operator'( 1200, fx, (:-)).
+'$current_operator'( 1200, fx, (?-)).
+'$current_operator'( 1150, fx, (package)).
+'$current_operator'( 1150, fx, (import)).
+'$current_operator'( 1150, fx, (public)).
+'$current_operator'( 1150, fx, (dynamic)).
+'$current_operator'( 1150, fx, (meta_predicate)).
+'$current_operator'( 1150, fx, (mode)).
+'$current_operator'( 1150, fx, (multifile)).
+'$current_operator'( 1150, fx, (block)).
+'$current_operator'( 1100, xfy, (;)).
+'$current_operator'( 1050, xfy, (->)).
+'$current_operator'( 1000, xfy, (',')).
+'$current_operator'( 900, fy, (\+)).
+'$current_operator'( 700, xfx, (=)).
+'$current_operator'( 700, xfx, (\=)).
+'$current_operator'( 700, xfx, (==)).
+'$current_operator'( 700, xfx, (\==)).
+'$current_operator'( 700, xfx, (@<)).
+'$current_operator'( 700, xfx, (@>)).
+'$current_operator'( 700, xfx, (@=<)).
+'$current_operator'( 700, xfx, (@>=)).
+'$current_operator'( 700, xfx, (=..)).
+'$current_operator'( 700, xfx, (is)).
+'$current_operator'( 700, xfx, (=:=)).
+'$current_operator'( 700, xfx, (=\=)).
+'$current_operator'( 700, xfx, (<)).
+'$current_operator'( 700, xfx, (>)).
+'$current_operator'( 700, xfx, (=<)).
+'$current_operator'( 700, xfx, (>=)).
+'$current_operator'( 550, xfy, (:)).
+'$current_operator'( 500, yfx, (+)).
+'$current_operator'( 500, yfx, (-)).
+'$current_operator'( 500, yfx, (#)).
+'$current_operator'( 500, yfx, (/\)).
+'$current_operator'( 500, yfx, (\/)).
+'$current_operator'( 500, fx, (+)).
+'$current_operator'( 400, yfx, (*)).
+'$current_operator'( 400, yfx, (/)).
+'$current_operator'( 400, yfx, (//)).
+'$current_operator'( 400, yfx, (mod)).
+'$current_operator'( 400, yfx, (rem)).
+'$current_operator'( 400, yfx, (<<)).
+'$current_operator'( 400, yfx, (>>)).
+'$current_operator'( 300, xfx, (~)).
+'$current_operator'( 200, xfx, (**)).
+'$current_operator'( 200, xfy, (^)).
+'$current_operator'( 200, fy, (\)).
+'$current_operator'( 200, fy, (-)).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Logic and control
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public (\+)/1.
+:- public once/1.
+:- public repeat/0.
+
+\+(G) :- call(G), !, fail.
+\+(_).
+
+repeat.
+repeat :- repeat.
+
+once(G) :- call(G), !.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Atomic term processing
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%:- public atom_length/2. written in Java
+%:- public atom_concat/3. written in Java
+:- public sub_atom/5.
+%:- public atom_chars/2, atom_codes/2. written in Java
+%:- public char_code/2. written in Java
+%:- public number_chars/2, number_codes/2. written in Java
+:- public name/2.
+
+sub_atom(Atom, Before, Length, After, Sub_atom) :-
+ atom_concat(AtomL, X, Atom),
+ atom_length(AtomL, Before),
+ atom_concat(Sub_atom, AtomR, X),
+ atom_length(Sub_atom, Length),
+ atom_length(AtomR, After).
+
+name(Constant, Chars) :-
+ nonvar(Constant),
+ ( number(Constant) -> number_codes(Constant, Chars)
+ ; atomic(Constant) -> atom_codes(Constant, Chars)
+ ; illarg(type(atomic), name(Constant,Chars), 1)
+ ).
+name(Constant, Chars) :-
+ var(Constant),
+ ( number_codes(Constant0, Chars) -> Constant = Constant0
+ ; atom_codes(Constant0, Chars) -> Constant = Constant0
+ ; illarg(type(list(char)), name(Constant,Chars), 2)
+ ).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Implementation defined hooks
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public set_prolog_flag/2.
+:- public current_prolog_flag/2.
+
+set_prolog_flag(Flag, Value) :- var(Flag), !,
+ illarg(var, set_prolog_flag(Flag,Value), 1).
+set_prolog_flag(Flag, Value) :- var(Value), !,
+ illarg(var, set_prolog_flag(Flag,Value), 2).
+set_prolog_flag(Flag, Value) :- atom(Flag), !,
+ '$set_prolog_flag0'(Flag, Value).
+set_prolog_flag(Flag, Value) :-
+ illarg(type(atom), set_prolog_flag(Flag,Value), 1).
+
+'$set_prolog_flag0'(Flag, Value) :-
+ '$prolog_impl_flag'(Flag, Mode, changeable(YN)),
+ !,
+ '$set_prolog_flag0'(YN, Flag, Value, Mode).
+'$set_prolog_flag0'(Flag, Value) :-
+ illarg(domain(atom,prolog_flag), set_prolog_flag(Flag,Value), 1).
+
+'$set_prolog_flag0'(no, Flag, Value, _) :- !,
+ illarg(permission(modify,flag,Flag,_), set_prolog_flag(Flag,Value), _).
+'$set_prolog_flag0'(_, Flag, Value, Mode) :-
+ '$builtin_member'(Value, Mode),
+ !,
+ '$set_prolog_impl_flag'(Flag, Value).
+'$set_prolog_flag0'(_, Flag, Value, _) :-
+ illarg(domain(atom,flag_value), set_prolog_flag(Flag,Value), 2).
+
+current_prolog_flag(Flag, Term) :- var(Flag), !,
+ '$prolog_impl_flag'(Flag, _, _),
+ '$get_prolog_impl_flag'(Flag, Term).
+current_prolog_flag(Flag, Term) :- atom(Flag), !,
+ ( '$prolog_impl_flag'(Flag, _, _) -> '$get_prolog_impl_flag'(Flag, Term)
+ ; illarg(domain(atom,prolog_flag), current_prolog_flag(Flag,Term), 1)
+ ).
+current_prolog_flag(Flag, Term) :-
+ illarg(type(atom), current_prolog_flag(Flag,Term), 1).
+
+% '$prolog_impl_flag'(bounded, _, changeable(no)).
+'$prolog_impl_flag'(max_integer, _, changeable(no)).
+'$prolog_impl_flag'(min_integer, _, changeable(no)).
+% '$prolog_impl_flag'(integer_rounding_function, [down,toward_zero], changeable(no)).
+% '$prolog_impl_flag'(char_conversion, [on,off], changeable(no)).
+'$prolog_impl_flag'(debug, [on,off], changeable(yes)).
+'$prolog_impl_flag'(max_arity, _, changeable(no)).
+'$prolog_impl_flag'(unknown, [error,fail,warning], changeable(yes)).
+'$prolog_impl_flag'(double_quotes, [chars,codes,atom], changeable(no)).
+'$prolog_impl_flag'(print_stack_trace, [on,off], changeable(yes)).
+
+:- public halt/0.
+%:- public halt/1. (written in Java)
+:- public abort/0.
+
+halt :- halt(1).
+
+abort :- raise_exception('Execution aborted').
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% DCG
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public 'C'/3, expand_term/2.
+
+'C'([X|S], X, S).
+
+expand_term(Dcg, Cl) :- var(Dcg), !, Dcg = Cl.
+expand_term(Dcg, Cl) :- '$dcg_expansion'(Dcg, Cl0), !, Cl0 = Cl.
+expand_term(Dcg, Dcg).
+
+'$dcg_expansion'(Dcg, Cl) :- var(Dcg), !, Dcg = Cl.
+'$dcg_expansion'((Head --> B), (H1 :- G1, G2)) :-
+ nonvar(Head),
+ Head = (H, List),
+ List = [_|_],
+ !,
+ '$dcg_translation_atom'(H, H1, S0, S1),
+ '$dcg_translation'(B, G1, S0, S),
+ '$dcg_translation'(List, G2, S1, S).
+'$dcg_expansion'((H --> B), (H1 :- B1)) :-
+ '$dcg_translation_atom'(H, H1, S0, S),
+ '$dcg_translation'(B, B1, S0, S).
+
+'$dcg_translation_atom'(X, phrase(X,S0,S), S0, S) :-
+ var(X),
+ !.
+'$dcg_translation_atom'(M:X, M:X1, S0, S) :- !,
+ '$dcg_translation_atom'(X, X1, S0, S).
+'$dcg_translation_atom'(X, X1, S0, S) :-
+ X =.. [F|As],
+ '$builtin_append'(As, [S0,S], As1),
+ X1 =.. [F|As1].
+
+'$dcg_translation'(X, Y, S0, S) :-
+ '$dcg_trans'(X, Y0, T, S0, S),
+ '$dcg_trans0'(Y0, Y, T, S0, S).
+
+'$dcg_trans0'(Y, Y, T, S0, T) :- T \== S0, !.
+'$dcg_trans0'(Y0, Y, T, _, S) :- '$dcg_concat'(Y0, S=T, Y).
+
+'$dcg_concat'(X, Y, Z) :- X == true, !, Z = Y.
+'$dcg_concat'(X, Y, Z) :- Y == true, !, Z = X.
+'$dcg_concat'(X, Y, (X,Y)).
+
+'$dcg_trans'(X, X1, S, S0, S) :- var(X), !,
+ '$dcg_translation_atom'(X, X1, S0, S).
+'$dcg_trans'(M:X, M:Y, T, S0, S) :- !,
+ '$dcg_trans'(X, Y, T, S0, S).
+'$dcg_trans'([], true, S0, S0, _) :- !.
+'$dcg_trans'([X|Y], Z, T, S0, S) :- !,
+ '$dcg_trans'(Y, Y1, T, S1, S),
+ '$dcg_concat'('C'(S0,X,S1), Y1, Z).
+'$dcg_trans'(\+X, (X1 -> fail; S=S0), S, S0, S) :- !,
+ '$dcg_trans'(X, X1, S1, S0, S1).
+'$dcg_trans'((X,Y), Z, T, S0, S) :- !,
+ '$dcg_trans'(X, X1, S1, S0, S1),
+ '$dcg_trans'(Y, Y1, T, S1, S),
+ '$dcg_concat'(X1, Y1, Z).
+'$dcg_trans'((X->Y), (X1->Y1), T, S0, S) :- !,
+ '$dcg_trans'(X, X1, S1, S0, S1),
+ '$dcg_trans'(Y, Y1, T, S1, S).
+'$dcg_trans'((X;Y), (X1;Y1), S, S0, S) :- !,
+ '$dcg_translation'(X, X1, S0, S),
+ '$dcg_translation'(Y, Y1, S0, S).
+'$dcg_trans'(!, !, S0, S0, _) :- !.
+'$dcg_trans'({G}, call(G), S0, S0, _) :- var(G), !.
+'$dcg_trans'({G}, G, S0, S0, _) :- !.
+'$dcg_trans'(X, X1, S, S0, S) :-
+ '$dcg_translation_atom'(X, X1, S0, S).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Hash creation and control
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public new_hash/1.
+%:- public new_hash/2. written in Java
+%:- public hash_clear/1. written in Java
+%:- public hash_contains_key/2. written in Java
+%:- public hash_get/3. written in Java
+%:- public hash_is_empty/1. written in Java
+%:- public hash_keys/2. written in Java
+:- public hash_map/2.
+%:- public hash_put/3. written in Java
+%:- public hash_remove/2. written in Java
+%:- public hash_size/2. written in Java
+%:- public '$get_hash_manager'/1. written in Java
+
+new_hash(Hash) :- new_hash(Hash, []).
+
+hash_map(H_or_a, List) :-
+ hash_keys(H_or_a, Ks0),
+ sort(Ks0, Ks),
+ hash_map(Ks, List, H_or_a).
+
+hash_map([], [], _) :- !.
+hash_map([K|Ks], [(K,V)|Ls], H_or_a) :-
+ hash_get(H_or_a, K, V),
+ hash_map(Ks, Ls, H_or_a).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Java interoperation
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%:- public java_constructor0/2. (written in Java)
+%:- public java_declared_constructor0/2. (written in Java)
+%:- public java_method0/3. (written in Java)
+%:- public java_declared_method0/3. (written in Java)
+%:- public java_get_field0/3. (written in Java)
+%:- public java_get_declared_field0/3. (written in Java)
+%:- public java_set_field0/3. (written in Java)
+%:- public java_set_declared_field0/3. (written in Java)
+%:- public java_conversion/2. (written in Java)
+:- public java_constructor/2.
+:- public java_declared_constructor/2.
+:- public java_method/3.
+:- public java_declared_method/3.
+:- public java_get_field/3.
+:- public java_get_declared_field/3.
+:- public java_set_field/3.
+:- public java_set_declared_field/3.
+:- public synchronized/2.
+
+java_constructor(Constr, Instance) :-
+ Constr =.. [F|As],
+ builtin_java_convert_args(As, As1),
+ Constr1 =.. [F|As1],
+ java_constructor0(Constr1, Instance1),
+ Instance = Instance1.
+
+java_declared_constructor(Constr, Instance) :-
+ Constr =.. [F|As],
+ builtin_java_convert_args(As, As1),
+ Constr1 =.. [F|As1],
+ java_declared_constructor0(Constr1, Instance1),
+ Instance = Instance1.
+
+java_method(Class_or_Instance, Method, Value) :-
+ Method =.. [F|As],
+ builtin_java_convert_args(As, As1),
+ Method1 =.. [F|As1],
+ java_method0(Class_or_Instance, Method1, Value1),
+ java_conversion(Value2, Value1),
+ Value = Value2.
+
+java_declared_method(Class_or_Instance, Method, Value) :-
+ Method =.. [F|As],
+ builtin_java_convert_args(As, As1),
+ Method1 =.. [F|As1],
+ java_declared_method0(Class_or_Instance, Method1, Value1),
+ java_conversion(Value2, Value1),
+ Value = Value2.
+
+java_get_field(Class_or_Instance, Field, Value) :-
+ java_get_field0(Class_or_Instance, Field, Value1),
+ java_conversion(Value2, Value1),
+ Value = Value2.
+
+java_get_declared_field(Class_or_Instance, Field, Value) :-
+ java_get_declared_field0(Class_or_Instance, Field, Value1),
+ java_conversion(Value2, Value1),
+ Value = Value2.
+
+java_set_field(Class_or_Instance, Field, Value) :-
+ java_conversion(Value, Value1),
+ java_set_field0(Class_or_Instance, Field, Value1).
+
+java_set_declared_field(Class_or_Instance, Field, Value) :-
+ java_conversion(Value, Value1),
+ java_set_declared_field0(Class_or_Instance, Field, Value1).
+
+builtin_java_convert_args([], []) :- !.
+builtin_java_convert_args([X|Xs], [Y|Ys]) :-
+ java_conversion(X, Y),
+ builtin_java_convert_args(Xs, Ys).
+
+synchronized(Object, Goal) :-
+ '$begin_sync'(Object, Ref),
+ call(Goal),
+ '$end_sync'(Ref).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Prolog interpreter
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- op(1170, xfx, (:-)).
+:- op(1170, xfx, (-->)).
+:- op(1170, fx, (:-)).
+:- op(1170, fx, (?-)).
+
+:- op(1150, fx, (package)).
+:- op(1150, fx, (import)).
+:- op(1150, fx, (public)).
+:- op(1150, fx, (dynamic)).
+:- op(1150, fx, (meta_predicate)).
+:- op(1150, fx, (mode)).
+:- op(1150, fx, (multifile)).
+:- op(1150, fx, (block)).
+
+:- public cafeteria/0.
+:- public consult/1.
+:- public trace/0, notrace/0.
+:- public debug/0, nodebug/0.
+:- public leash/1.
+:- public spy/1, nospy/1, nospyall/0.
+:- public listing/0.
+:- public listing/1.
+
+:- dynamic '$current_leash'/1.
+:- dynamic '$current_spypoint'/3.
+:- dynamic '$leap_flag'/1.
+:- dynamic '$consulted_file'/1.
+:- dynamic '$consulted_package'/1.
+:- dynamic '$consulted_predicate'/3.
+
+%%% Main
+cafeteria :-
+ '$cafeteria_init',
+ repeat,
+ '$toplvel_loop',
+ on_exception(Msg, '$cafeteria'(Goal), print_message(error, Msg)),
+ Goal == end_of_file,
+ !,
+ nl, '$fast_write'(bye), nl.
+
+'$cafeteria_init' :-
+ retractall('$leap_flag'(_)),
+ retractall('$current_leash'(_)),
+ retractall('$current_spypoint'(_,_,_)),
+ retractall('$consulted_file'(_)),
+ retractall('$consulted_package'(_)),
+ retractall('$consulted_predicate'(_,_,_)),
+ assertz('$leap_flag'(no)),
+ assertz('$current_leash'(call)),
+ assertz('$current_leash'(exit)),
+ assertz('$current_leash'(redo)),
+ assertz('$current_leash'(fail)),
+ !.
+
+'$toplvel_loop' :-
+ current_prolog_flag(debug, Mode),
+ (Mode == off -> true ; print_message(info,[debug])),
+ '$fast_write'('| ?- '),
+ flush_output.
+
+'$cafeteria'(Goal) :-
+ read_with_variables(Goal, Vars),
+ '$process_order'(Goal, Vars).
+
+'$process_order'(G, _) :- var(G), !, illarg(var, (?- G), 1).
+'$process_order'(end_of_file, _) :- !.
+'$process_order'([File|Files], _) :- !, consult([File|Files]).
+'$process_order'(G, Vars) :-
+ current_prolog_flag(debug, Mode),
+ ( Mode == off -> call(user:G) ; '$trace_goal'(user:G) ), nl,
+ '$rm_redundant_vars'(Vars, Vars1),
+ '$give_answers_with_prompt'(Vars1),
+ !,
+ '$fast_write'(yes), nl.
+'$process_order'(_, _) :- nl, '$fast_write'(no), nl.
+
+'$rm_redundant_vars'([], []) :- !.
+'$rm_redundant_vars'(['_'=_|Xs], Vs) :- !,
+ '$rm_redundant_vars'(Xs, Vs).
+'$rm_redundant_vars'([X|Xs], [X|Vs]) :-
+ '$rm_redundant_vars'(Xs, Vs).
+
+'$give_answers_with_prompt'([]) :- !.
+'$give_answers_with_prompt'(Vs) :-
+ '$give_an_answer'(Vs),
+ '$fast_write'(' ? '), flush_output,
+ read_line(Str),
+ Str \== ";",
+ nl.
+
+'$give_an_answer'([]) :- !, '$fast_write'(true).
+'$give_an_answer'([X]) :- !, '$print_an answer'(X).
+'$give_an_answer'([X|Xs]) :-
+ '$print_an answer'(X), '$fast_write'(','), nl,
+ '$give_an_answer'(Xs).
+
+'$print_an answer'(N = V) :-
+ write(N), '$fast_write'(' = '), writeq(V).
+
+%%% Read Program
+consult(Files) :- var(Files), !, illarg(var, consult(Files), 1).
+consult([]) :- !.
+consult([File|Files]) :- !, consult(File), consult(Files).
+consult(File) :- atom(File), !, '$consult'(File).
+
+'$consult'(F) :-
+ '$prolog_file_name'(F, PF),
+ open(PF, read, In),
+ stream_property(In, file_name(File)),
+ print_message(info, [consulting,File,'...']),
+ statistics(runtime, _),
+ '$consult_init'(File),
+ repeat,
+ read(In, Cl),
+ '$consult_clause'(Cl),
+ Cl == end_of_file,
+ !,
+ statistics(runtime, [_,T]),
+ print_message(info, [File,'consulted,',T,msec]),
+ close(In).
+
+%'$prolog_file_name'(File, File) :- sub_atom(File, _, 3, 0, '.pl'), !.
+%'$prolog_file_name'(File, File) :- sub_atom(File, _, 4, 0, '.pro'), !.
+'$prolog_file_name'(File, File) :- sub_atom(File, _, _, After, '.'), After > 0, !.
+'$prolog_file_name'(File0, File) :- atom_concat(File0, '.pl', File).
+
+'$consult_init'(File) :-
+ retractall('$consulted_file'(_)),
+ retractall('$consulted_package'(_)),
+ retract('$consulted_predicate'(P,PI,File)),
+ abolish(P:PI),
+ fail.
+'$consult_init'(File) :-
+ assertz('$consulted_file'(File)),
+ assertz('$consulted_package'(user)).
+
+'$consult_clause'(end_of_file ) :- !.
+'$consult_clause'((:- module(P,_)) ) :- !, '$assert_consulted_package'(P).
+'$consult_clause'((:- package P) ) :- !, '$assert_consulted_package'(P).
+'$consult_clause'((:- import _) ) :- !.
+'$consult_clause'((:- dynamic _) ) :- !.
+'$consult_clause'((:- public _) ) :- !.
+'$consult_clause'((:- meta_predicate _)) :- !.
+'$consult_clause'((:- mode _) ) :- !.
+'$consult_clause'((:- multifile _) ) :- !.
+'$consult_clause'((:- block _) ) :- !.
+%'$consult_clause'((:- G) ) :- !, clause('$consulted_package'(P), _), call(P:G).
+'$consult_clause'((:- G) ) :- !, clause('$consulted_package'(P), _), once(P:G).
+'$consult_clause'(Clause0) :-
+ '$consult_preprocess'(Clause0, Clause),
+ '$consult_cls'(Clause).
+
+'$assert_consulted_package'(P) :-
+ clause('$consulted_package'(P), _),
+ !.
+'$assert_consulted_package'(P) :-
+ retractall('$consulted_package'(_)),
+ assertz('$consulted_package'(P)).
+
+'$consult_preprocess'(Clause0, Clause) :-
+ expand_term(Clause0, Clause).
+
+'$consult_cls'((H :- G)) :- !, '$assert_consulted_clause'((H :- G)).
+'$consult_cls'(H) :- '$assert_consulted_clause'((H :- true)).
+
+'$assert_consulted_clause'(Clause) :-
+ Clause = (H :- _),
+ functor(H, F, A),
+ clause('$consulted_file'(File), _),
+ clause('$consulted_package'(P), _),
+ assertz(P:Clause),
+ assertz('$consulted_predicate'(P,F/A,File)),
+ !.
+
+%%% Trace
+trace :- current_prolog_flag(debug, on), !.
+trace :-
+ set_prolog_flag(debug, on),
+ '$trace_init',
+ '$fast_write'('{Small debugger is switch on}'),
+ nl, !.
+
+'$trace_init' :-
+ retractall('$leap_flag'(_)),
+ retractall('$current_leash'(_)),
+ retractall('$current_spypoint'(_,_,_)),
+ assertz('$leap_flag'(no)),
+ assertz('$current_leash'(call)),
+ assertz('$current_leash'(exit)),
+ assertz('$current_leash'(redo)),
+ assertz('$current_leash'(fail)),
+ !.
+
+notrace :- current_prolog_flag(debug, off), !.
+notrace :-
+ set_prolog_flag(debug, off),
+ '$fast_write'('{Small debugger is switch off}'),
+ nl, !.
+
+debug :- trace.
+nodebug :- notrace.
+
+%%% Spy-Points
+spy(T) :-
+ '$term_to_predicateindicator'(T, PI, spy(T)),
+ trace,
+ '$assert_spypoint'(PI),
+ '$set_debug_flag'(leap, yes),
+ !.
+
+'$assert_spypoint'(P:F/A) :-
+ clause('$current_spypoint'(P,F,A), _),
+ print_message(info, [spypoint,P:F/A,is,already,added]),
+ !.
+'$assert_spypoint'(P:F/A) :-
+ clause('$consulted_predicate'(P,F/A,_), _),
+ assertz('$current_spypoint'(P,F,A)),
+ print_message(info, [spypoint,P:F/A,is,added]),
+ !.
+'$assert_spypoint'(P:F/A) :-
+ print_message(warning, [no,matching,predicate,for,spy,P:F/A]).
+
+nospy(T) :-
+ '$term_to_predicateindicator'(T, PI, nospy(T)),
+ '$retract_spypoint'(PI),
+ '$set_debug_flag'(leap, no),
+ !.
+
+'$retract_spypoint'(P:F/A) :-
+ retract('$current_spypoint'(P,F,A)),
+ print_message(info, [spypoint,P:F/A,is,removed]),
+ !.
+'$retract_spypoint'(_).
+
+nospyall :-
+ retractall('$current_spypoint'(_,_,_)),
+ '$set_debug_flag'(leap, no).
+
+%%% Leash
+leash(L) :- nonvar(L), '$leash'(L), !.
+leash(L) :- illarg(type('leash_specifier'), leash(L), 1).
+
+'$leash'([]) :- !,
+ retractall('$current_leash'(_)),
+ print_message(info, [no,leashing]).
+'$leash'(Ms) :-
+ retractall('$current_leash'(_)),
+ '$assert_leash'(Ms),
+ print_message(info,[leashing,stopping,on,Ms]).
+
+'$assert_leash'([]) :- !.
+'$assert_leash'([X|Xs]) :-
+ '$leash_specifier'(X),
+ assertz('$current_leash'(X)),
+ '$assert_leash'(Xs).
+
+'$leash_specifier'(call).
+'$leash_specifier'(exit).
+'$leash_specifier'(redo).
+'$leash_specifier'(fail).
+%'$leash_specifier'(exception).
+
+%%% Trace a Goal
+'$trace_goal'(Term) :-
+ '$set_debug_flag'(leap, no),
+ '$get_level'(Cut),
+ '$meta_call'(Term, user, Cut, 0, trace).
+
+'$trace_goal'(X, P, FA, Depth) :-
+ print_procedure_box(call, X, P, FA, Depth),
+ '$call_internal'(X, P, FA, Depth, trace),
+ print_procedure_box(exit, X, P, FA, Depth),
+ redo_procedure_box(X, P, FA, Depth).
+'$trace_goal'(X, P, FA, Depth) :-
+ print_procedure_box(fail, X, P, FA, Depth),
+ fail.
+
+print_procedure_box(Mode, G, P, F/A, Depth) :-
+ clause('$current_spypoint'(P, F, A), _),
+ !,
+ '$builtin_message'(['+',Depth,Mode,':',P:G]),
+ '$read_blocked'(print_procedure_box(Mode,G,P,F/A,Depth)).
+print_procedure_box(Mode, G, P, FA, Depth) :-
+ clause('$leap_flag'(no), _),
+ !,
+ '$builtin_message'([' ',Depth,Mode,':',P:G]),
+ ( clause('$current_leash'(Mode), _)
+ ->
+ '$read_blocked'(print_procedure_box(Mode,G,P,FA,Depth))
+ ;
+ nl
+ ).
+print_procedure_box(_, _, _, _, _).
+
+redo_procedure_box(_, _, _, _).
+redo_procedure_box(X, P, FA, Depth) :-
+ print_procedure_box(redo, X, P, FA, Depth),
+ fail.
+
+'$read_blocked'(G) :-
+ '$fast_write'(' ? '),
+ flush_output,
+ read_line(C),
+ (C == [] -> DOP = 99 ; C = [DOP|_]),
+ '$debug_option'(DOP, G).
+
+'$debug_option'(97, _) :- !, notrace, abort. % a for abort
+'$debug_option'(99, _) :- !, '$set_debug_flag'(leap, no). % c for creep
+'$debug_option'(108, _) :- !, '$set_debug_flag'(leap, yes). % l for leap
+'$debug_option'(43, print_procedure_box(Mode,G,P,FA,Depth)) :- !, % + for spy this
+ spy(P:FA),
+ call(print_procedure_box(Mode,G,P,FA,Depth)).
+'$debug_option'(45, print_procedure_box(Mode,G,P,FA,Depth)) :- !, % - for nospy this
+ nospy(P:FA),
+ call(print_procedure_box(Mode,G,P,FA,Depth)).
+'$debug_option'(63, G) :- !, '$show_debug_option', call(G).
+'$debug_option'(104, G) :- !, '$show_debug_option', call(G).
+'$debug_option'(_, _).
+
+'$show_debug_option' :-
+ tab(4), '$fast_write'('Debuggin options:'), nl,
+ tab(4), '$fast_write'('a abort'), nl,
+ tab(4), '$fast_write'('RET creep'), nl,
+ tab(4), '$fast_write'('c creep'), nl,
+ tab(4), '$fast_write'('l leap'), nl,
+ tab(4), '$fast_write'('+ spy this'), nl,
+ tab(4), '$fast_write'('- nospy this'), nl,
+ tab(4), '$fast_write'('? help'), nl,
+ tab(4), '$fast_write'('h help'), nl.
+
+'$set_debug_flag'(leap, Flag) :-
+ clause('$leap_flag'(Flag), _),
+ !.
+'$set_debug_flag'(leap, Flag) :-
+ retractall('$leap_flag'(_)),
+ assertz('$leap_flag'(Flag)).
+
+%%% Listing
+listing :- '$listing'(_, user).
+
+listing(T) :- var(T), !, illarg(var, listing(T), 1).
+listing(P) :- atom(P), !, '$listing'(_, P).
+listing(F/A) :- !, '$listing'(F/A, user).
+listing(P:PI) :- atom(P), !, '$listing'(PI, P).
+listing(T) :- illarg(type(predicate_indicator), listing(T), 1).
+
+'$listing'(PI, P) :- var(PI), !,
+ '$listing_dynamic_clause'(P, _).
+'$listing'(F/A, P) :- atom(F), integer(A), !,
+ '$listing_dynamic_clause'(P, F/A).
+'$listing'(PI, P) :- illarg(type(predicate_indicator), listing(P:PI), 1).
+
+'$listing_dynamic_clause'(P, PI) :-
+ '$new_internal_database'(P),
+ hash_keys(P, Keys),
+ '$builtin_member'(PI, Keys),
+ PI = F/A,
+ functor(H, F, A),
+ '$clause_internal'(P, PI, H, Cl, _),
+ '$write_dynamic_clause'(P, Cl),
+ fail.
+'$listing_dynamic_clause'(_, _).
+
+'$write_dynamic_clause'(_, Cl) :- var(Cl), !, fail.
+'$write_dynamic_clause'(P, (H :- true)) :- !,
+ numbervars(H, 0, _),
+ '$write_dynamic_head'(P, H),
+ write('.'), nl.
+'$write_dynamic_clause'(P, (H :- B)) :- !,
+ numbervars((H :- B), 0, _),
+ '$write_dynamic_head'(P, H),
+ write(' :-'), nl,
+ '$write_dynamic_body'(B, 8),
+ write('.'), nl.
+
+'$write_dynamic_head'(user, H) :- !, writeq(H).
+'$write_dynamic_head'(P, H) :-
+ write(P), write(':'), writeq(H).
+
+'$write_dynamic_body'((G1,G2), N) :- !,
+ '$write_dynamic_body'(G1, N), write(','), nl,
+ '$write_dynamic_body'(G2, N).
+'$write_dynamic_body'((G1;G2), N) :- !,
+ N1 is N+4,
+ tab(N), write('('), nl,
+ '$write_dynamic_body'(G1, N1), nl,
+ tab(N), write(';'), nl,
+ '$write_dynamic_body'(G2, N1), nl,
+ tab(N), write(')').
+'$write_dynamic_body'((G1->G2), N) :- !,
+ N1 is N+4,
+ tab(N), write('('), nl,
+ '$write_dynamic_body'(G1, N1), nl,
+ tab(N), write('->'), nl,
+ '$write_dynamic_body'(G2, N1), nl,
+ tab(N), write(')').
+'$write_dynamic_body'(B, N) :-
+ tab(N), writeq(B).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Misc
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+:- public length/2.
+:- public numbervars/3.
+:- public statistics/2.
+
+length(L, N) :- var(N), !, '$length'(L, 0, N).
+length(L, N) :- '$length0'(L, 0, N).
+
+'$length'([], I, I).
+'$length'([_|L], I0, I) :- I1 is I0+1, '$length'(L, I1, I).
+
+'$length0'([], I, I) :- !.
+'$length0'([_|L], I0, I) :- I0 < I, I1 is I0+1, '$length0'(L, I1, I).
+
+numbervars(X, VI, VN) :-
+ integer(VI), VI >= 0,
+ !,
+ '$numbervars'(X, VI, VN).
+
+'$numbervars'(X, VI, VN) :- var(X), !,
+ X = '$VAR'(VI), % This structure is checked in write
+ VN is VI + 1.
+'$numbervars'(X, VI, VI) :- atomic(X), !.
+'$numbervars'(X, VI, VI) :- java(X), !.
+'$numbervars'(X, VI, VN) :-
+ functor(X, _, N),
+ '$numbervars_str'(1, N, X, VI, VN).
+
+'$numbervars_str'(I, I, X, VI, VN) :- !,
+ arg(I, X, A),
+ '$numbervars'(A, VI, VN).
+'$numbervars_str'(I, N, X, VI, VN) :-
+ arg(I, X, A),
+ '$numbervars'(A, VI, VN1),
+ I1 is I + 1,
+ '$numbervars_str'(I1, N, X, VN1, VN).
+
+statistics(Key, Value) :-
+ nonvar(Key),
+ '$statistics_mode'(Key),
+ !,
+ '$statistics'(Key, Value).
+statistics(Key, Value) :-
+ findall(M, '$statistics_mode'(M), Domain),
+ illarg(domain(atom,Domain), statistics(Key,Value), 1).
+
+'$statistics_mode'(runtime).
+'$statistics_mode'(trail).
+'$statistics_mode'(choice).
+
+print_message(Type, Message) :- var(Type), !,
+ illarg(var, print_message(Type,Message), 1).
+print_message(error, Message) :- !,
+ '$error_message'(Message).
+print_message(info, Message) :- !,
+ '$fast_write'('{'),
+ '$builtin_message'(Message),
+ '$fast_write'('}'), nl.
+print_message(warning, Message) :- !,
+ '$fast_write'('{WARNING: '),
+ '$builtin_message'(Message),
+ '$fast_write'('}'), nl.
+
+'$error_message'(instantiation_error(Goal,0)) :- !,
+ '$fast_write'('{INSTANTIATION ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'('}'), nl.
+'$error_message'(instantiation_error(Goal,ArgNo)) :- !,
+ '$fast_write'('{INSTANTIATION ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'('}'), nl.
+'$error_message'(type_error(Goal,ArgNo,Type,Culprit)) :- !,
+ '$fast_write'('{TYPE ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'(': expected '), '$fast_write'(Type),
+ '$fast_write'(', found '), write(Culprit),
+ '$fast_write'('}'), nl.
+'$error_message'(domain_error(Goal,ArgNo,Domain,Culprit)) :- !,
+ '$fast_write'('{DOMAIN ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'(': expected '), '$fast_write'(Domain),
+ '$fast_write'(', found '), write(Culprit),
+ '$fast_write'('}'), nl.
+'$error_message'(existence_error(_Goal,0,ObjType,Culprit,_Message)) :- !,
+ '$fast_write'('{EXISTENCE ERROR: '),
+ '$fast_write'(ObjType), '$fast_write'(' '), write(Culprit), '$fast_write'(' does not exist'),
+ '$fast_write'('}'), nl.
+'$error_message'(existence_error(Goal,ArgNo,ObjType,Culprit,_Message)) :- !,
+ '$fast_write'('{EXISTENCE ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'(': '),
+ '$fast_write'(ObjType), '$fast_write'(' '), write(Culprit), '$fast_write'(' does not exist'),
+ '$fast_write'('}'), nl.
+'$error_message'(permission_error(Goal,Operation,ObjType,Culprit,Message)) :- !,
+ '$fast_write'('{PERMISSION ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - can not '), '$fast_write'(Operation), '$fast_write'(' '),
+ '$fast_write'(ObjType), '$fast_write'(' '), write(Culprit),
+ '$fast_write'(': '), '$fast_write'(Message),
+ '$fast_write'('}'), nl.
+'$error_message'(representation_error(Goal,ArgNo,Flag)) :- !,
+ '$fast_write'('{REPRESENTATION ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'(': limit of '), '$fast_write'(Flag), '$fast_write'(' is breached'),
+ '$fast_write'('}'), nl.
+'$error_message'(evaluation_error(Goal,ArgNo,Type)) :- !,
+ '$fast_write'('{EVALUATION ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'(', found '), '$fast_write'(Type),
+ '$fast_write'('}'), nl.
+'$error_message'(syntax_error(Goal,ArgNo,Type,Culprit,_Message)) :- !,
+ '$fast_write'('{SYNTAX ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'(': expected '), '$fast_write'(Type),
+ '$fast_write'(', found '), write(Culprit),
+ '$fast_write'('}'), nl.
+'$error_message'(system_error(Message)) :- !,
+ '$fast_write'('{SYSTEM ERROR: '), write(Message), '$fast_write'('}'), nl.
+'$error_message'(internal_error(Message)) :- !,
+ '$fast_write'('{INTERNAL ERROR: '), write(Message), '$fast_write'('}'), nl.
+'$error_message'(java_error(Goal,ArgNo,Exception)) :- !,
+ '$fast_write'('{JAVA ERROR: '),
+ '$write_goal'(Goal),
+ '$fast_write'(' - arg '), '$fast_write'(ArgNo),
+ '$fast_write'(', found '), '$write_goal'(Exception),
+ '$fast_write'('}'), nl,
+ '$print_stack_trace'(Exception).
+'$error_message'(Message) :-
+ '$fast_write'('{'), write(Message), '$fast_write'('}'), nl.
+
+'$write_goal'(Goal) :- java(Goal), !,
+ current_output(S), '$write_toString'(S, Goal).
+'$write_goal'(Goal) :- write(Goal).
+
+illarg(Msg, Goal, ArgNo) :- var(Msg), !,
+ illarg(var, Goal, ArgNo).
+illarg(var, Goal, ArgNo) :-
+ raise_exception(instantiation_error(Goal, ArgNo)).
+illarg(type(Type), Goal, ArgNo) :-
+ arg(ArgNo, Goal, Arg),
+ ( nonvar(Arg) ->
+ Error = type_error(Goal,ArgNo,Type,Arg)
+ ; Error = instantiation_error(Goal,ArgNo)
+ ),
+ raise_exception(Error).
+illarg(domain(Type,ExpDomain), Goal, ArgNo) :-
+ arg(ArgNo, Goal, Arg),
+ ( '$match_type'(Type, Arg) ->
+ Error = domain_error(Goal,ArgNo,ExpDomain,Arg)
+ ; nonvar(Arg) ->
+ Error = type_error(Goal,ArgNo,Type,Arg)
+ ; Error = instantiation_error(Goal,ArgNo)
+ ),
+ raise_exception(Error).
+illarg(existence(ObjType,Culprit,Message), Goal, ArgNo) :-
+ raise_exception(existence_error(Goal,ArgNo,ObjType,Culprit,Message)).
+illarg(permission(Operation, ObjType, Culprit, Message), Goal, _) :-
+ raise_exception(permission_error(Goal,Operation,ObjType,Culprit,Message)).
+illarg(representation(Flag), Goal, ArgNo) :-
+ raise_exception(representation_error(Goal,ArgNo,Flag)).
+illarg(evaluation(Type), Goal, ArgNo) :-
+ raise_exception(evaluation_error(Goal,ArgNo,Type)).
+illarg(syntax(Type,Culprit,Message), Goal, ArgNo) :-
+ raise_exception(syntax_error(Goal,ArgNo,Type,Culprit,Message)).
+illarg(system(Message), _, _) :-
+ raise_exception(system_error(Message)).
+illarg(internal(Message), _, _) :-
+ raise_exception(internal_error(Message)).
+illarg(java(Exception), Goal, ArgNo) :-
+ raise_exception(java_error(Goal,ArgNo,Exception)).
+illarg(Msg, _, _) :- raise_exception(Msg).
+
+'$match_type'(term, _).
+'$match_type'(variable, X) :- var(X).
+'$match_type'(atom, X) :- atom(X).
+'$match_type'(atomic, X) :- atomic(X).
+'$match_type'(byte, X) :- integer(X), 0 =< X, X =< 255.
+'$match_type'(in_byte, X) :- integer(X), -1 =< X, X =< 255.
+'$match_type'(character, X) :- atom(X), atom_length(X, 1).
+'$match_type'(in_character, X) :- (X == 'end_of_file' ; '$match_type'(character,X)).
+'$match_type'(number, X) :- number(X).
+'$match_type'(integer, X) :- integer(X).
+'$match_type'(float, X) :- float(X).
+'$match_type'(callable, X) :- callable(X).
+'$match_type'(compound, X) :- compound(X).
+'$match_type'(list, X) :- nonvar(X), (X = [] ; X = [_|_]).
+'$match_type'(java, X) :- java(X).
+'$match_type'(stream, X) :- (java(X, 'java.io.PushbackReader') ; java(X, 'java.io.PrintWriter')).
+'$match_type'(stream_or_alias, X) :- (atom(X) ; '$match_type'(stream, X)).
+'$match_type'(hash, X) :- java(X, 'jp.ac.kobe_u.cs.prolog.lang.HashtableOfTerm').
+'$match_type'(hash_or_alias,X) :- (atom(X) ; '$match_type'(hash, X)).
+'$match_type'(predicate_indicator, X) :-
+ nonvar(X),
+ X = P:F/A,
+ atom(P),
+ atom(F),
+ integer(A).
+%'$match_type'(evaluable, X).
+%'$match_type'('convertible to java', X).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Utilities
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+'$builtin_append'([], Zs, Zs).
+'$builtin_append'([X|Xs], Ys, [X|Zs]) :- '$builtin_append'(Xs, Ys, Zs).
+
+'$builtin_member'(X, [X|_]).
+'$builtin_member'(X, [_|L]) :- '$builtin_member'(X, L).
+
+'$builtin_reverse'(Xs, Zs) :- '$builtin_reverse'(Xs, [], Zs).
+'$builtin_reverse'([], Zs, Zs).
+'$builtin_reverse'([X|Xs], Ys, Zs) :- '$builtin_reverse'(Xs, [X|Ys], Zs).
+
+'$builtin_message'([]) :- !.
+'$builtin_message'([M]) :- !, write(M).
+'$builtin_message'([M|Ms]) :- write(M), '$fast_write'(' '), '$builtin_message'(Ms).
+
+'$member_in_reverse'(X, [_|L]) :- '$member_in_reverse'(X, L).
+'$member_in_reverse'(X, [X|_]).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% END
+
diff --git a/src/builtin/system.pl b/src/builtin/system.pl
new file mode 100644
index 0000000..2a0ca9e
--- /dev/null
+++ b/src/builtin/system.pl
@@ -0,0 +1,268 @@
+%:- op(1150, fx, (package)).
+%package(_).
+:- package 'jp.ac.kobe_u.cs.prolog.builtin'.
+:- public system_predicate/1.
+
+system_predicate(system_predicate(_)).
+% Control constructs
+system_predicate(true).
+system_predicate(therwise).
+system_predicate(fail).
+system_predicate(false).
+system_predicate((!)).
+system_predicate('$get_level'(_)).
+system_predicate('$neck_cut').
+system_predicate('$cut'(_)).
+system_predicate((_ ^ _)).
+system_predicate((_ , _)).
+system_predicate((_ ; _)).
+system_predicate((_ -> _)).
+system_predicate(call(_)).
+system_predicate(catch(_,_,_)).
+system_predicate(throw(_)).
+system_predicate(on_exception(_,_,_)).
+system_predicate(raise_exception(_)).
+% Term unification
+system_predicate((_ = _)).
+system_predicate('$unify'(_,_)).
+system_predicate((_ \= _)).
+system_predicate('$not_unifiable'(_,_)).
+% Type testing
+system_predicate(var(_)).
+system_predicate(atom(_)).
+system_predicate(integer(_)).
+system_predicate(float(_)).
+system_predicate(atomic(_)).
+system_predicate(compound(_)).
+system_predicate(nonvar(_)).
+system_predicate(number(_)).
+system_predicate(java(_)).
+system_predicate(java(_,_)).
+system_predicate(closure(_)).
+system_predicate(ground(_)).
+system_predicate(callable(_)).
+% Term comparison
+system_predicate((_ == _)).
+system_predicate('$equality_of_term'(_,_)).
+system_predicate((_ \== _)).
+system_predicate('$inequality_of_term'(_,_)).
+system_predicate((_ @< _)).
+system_predicate('$before'(_,_)).
+system_predicate((_ @> _)).
+system_predicate('$after'(_,_)).
+system_predicate((_ @=< _)).
+system_predicate('$not_after'(_,_)).
+system_predicate((_ @>= _)).
+system_predicate('$not_before'(_,_)).
+system_predicate(?=(_,_)).
+system_predicate('$identical_or_cannot_unify'(_,_)).
+system_predicate(compare(_,_,_)).
+system_predicate(sort(_,_)).
+system_predicate(keysort(_,_)).
+%system_predicate(merge(_,_,_)).
+% Term creation and decomposition
+system_predicate(arg(_,_,_)).
+system_predicate(functor(_,_,_)).
+system_predicate((_ =.. _)).
+system_predicate('$univ'(_,_)).
+system_predicate(copy_term(_,_)).
+% Arithmetic evaluation
+system_predicate(is(_,_)).
+system_predicate('$abs'(_,_)).
+system_predicate('$asin'(_,_)).
+system_predicate('$acos'(_,_)).
+system_predicate('$atan'(_,_)).
+system_predicate('$bitwise_conj'(_,_,_)).
+system_predicate('$bitwise_disj'(_,_,_)).
+system_predicate('$bitwise_exclusive_or'(_,_,_)).
+system_predicate('$bitwise_neg'(_,_)).
+system_predicate('$ceil'(_,_)).
+system_predicate('$cos'(_,_)).
+system_predicate('$degrees'(_,_)).
+system_predicate('$exp'(_,_)).
+system_predicate('$float'(_,_)).
+system_predicate('$float_integer_part'(_,_)).
+system_predicate('$float_fractional_part'(_,_)).
+system_predicate('$float_quotient'(_,_,_)).
+system_predicate('$floor'(_,_)).
+system_predicate('$int_quotient'(_,_,_)).
+system_predicate('$log'(_,_)).
+system_predicate('$max'(_,_,_)).
+system_predicate('$min'(_,_,_)).
+system_predicate('$minus'(_,_,_)).
+system_predicate('$mod'(_,_,_)).
+system_predicate('$multi'(_,_,_)).
+system_predicate('$plus'(_,_,_)).
+system_predicate('$pow'(_,_,_)).
+system_predicate('$radians'(_,_)).
+system_predicate('$rint'(_,_)).
+system_predicate('$round'(_,_)).
+system_predicate('$shift_left'(_,_,_)).
+system_predicate('$shift_right'(_,_,_)).
+system_predicate('$sign'(_,_)).
+system_predicate('$sin'(_,_)).
+system_predicate('$sqrt'(_,_)).
+system_predicate('$tan'(_,_)).
+system_predicate('$truncate'(_,_)).
+% Arithmetic comparison
+system_predicate((_ =:= _)).
+system_predicate('$arith_equal'(_,_)).
+system_predicate((_ =\= _)).
+system_predicate('$arith_not_equal'(_,_)).
+system_predicate((_ < _)).
+system_predicate('$less_than'(_,_)).
+system_predicate((_ =< _)).
+system_predicate('$less_or_equal'(_,_)).
+system_predicate((_ > _)).
+system_predicate('$greater_than'(_,_)).
+system_predicate((_ >= _)).
+system_predicate('$greater_or_equal'(_,_)).
+% Clause retrieval and information
+system_predicate(clause(_,_)).
+system_predicate(initialization(_,_)).
+system_predicate('$new_indexing_hash'(_,_,_)).
+% Clause creation and destruction
+system_predicate(assert(_)).
+system_predicate(assertz(_)).
+system_predicate(asserta(_)).
+system_predicate(retract(_)).
+system_predicate(abolish(_)).
+system_predicate(retractall(_)).
+% All solutions
+system_predicate(findall(_,_,_)).
+system_predicate(bagof(_,_,_)).
+system_predicate(setof(_,_,_)).
+% Stream selection and control
+system_predicate(current_input(_)).
+system_predicate(current_output(_)).
+system_predicate(set_input(_)).
+system_predicate(set_output(_)).
+system_predicate(open(_,_,_)).
+system_predicate(open(_,_,_,_)).
+system_predicate(close(_)).
+system_predicate(close(_,_)).
+system_predicate(flush_output(_)).
+system_predicate(flush_output).
+system_predicate(stream_property(_,_)).
+% Character input/output
+system_predicate(get_char(_)).
+system_predicate(get_char(_,_)).
+system_predicate(get_code(_)).
+system_predicate(get_code(_,_)).
+system_predicate(peek_char(_)).
+system_predicate(peek_char(_,_)).
+system_predicate(peek_code(_)).
+system_predicate(peek_code(_,_)).
+system_predicate(put_char(_)).
+system_predicate(put_char(_,_)).
+system_predicate(put_code(_)).
+system_predicate(put_code(_,_)).
+system_predicate(nl).
+system_predicate(nl(_)).
+system_predicate(get0(_)).
+system_predicate(get0(_,_)).
+system_predicate(get(_)).
+system_predicate(get(_,_)).
+system_predicate(put(_)).
+system_predicate(put(_,_)).
+system_predicate(tab(_)).
+system_predicate(tab(_,_)).
+system_predicate(skip(_)).
+system_predicate(skip(_,_)).
+% Byte input/output
+system_predicate(get_byte(_)).
+system_predicate(get_byte(_,_)).
+system_predicate(peek_byte(_)).
+system_predicate(peek_byte(_,_)).
+system_predicate(put_byte(_)).
+system_predicate(put_byte(_,_)).
+% Term input/output
+system_predicate(read(_)).
+system_predicate(read(_,_)).
+system_predicate(read_with_variables(_,_)).
+system_predicate(read_with_variables(_,_,_)).
+system_predicate(read_line(_)).
+system_predicate(read_line(_,_)).
+system_predicate(write(_)).
+system_predicate(write(_,_)).
+system_predicate(writeq(_)).
+system_predicate(writeq(_,_)).
+system_predicate(write_canonical(_)).
+system_predicate(write_canonical(_,_)).
+system_predicate(write_term(_,_)).
+system_predicate(write_term(_,_,_)).
+system_predicate(op(_,_,_)).
+system_predicate(current_op(_,_,_)).
+% Logic and control
+system_predicate(\+(_)).
+system_predicate(once(_)).
+system_predicate(repeat).
+% Atomic term processing
+system_predicate(atom_length(_,_)).
+system_predicate(atom_concat(_,_,_)).
+system_predicate(sub_atom(_,_,_,_,_)).
+system_predicate(atom_chars(_,_)).
+system_predicate(atom_codes(_,_)).
+system_predicate(char_code(_,_)).
+system_predicate(number_chars(_,_)).
+system_predicate(number_codes(_,_)).
+system_predicate(name(_,_)).
+% Implementation defined hooks
+system_predicate(set_prolog_flag(_,_)).
+system_predicate(current_prolog_flag(_,_)).
+system_predicate(halt).
+system_predicate(halt(_)).
+system_predicate(abort).
+% DCG
+system_predicate('C'(_,_,_)).
+system_predicate(expand_term(_,_)).
+% Hash creation and control
+system_predicate(new_hash(_)).
+system_predicate(new_hash(_,_)).
+system_predicate(hash_clear(_)).
+system_predicate(hash_contains_key(_,_)).
+system_predicate(hash_get(_,_,_)).
+system_predicate(hash_is_empty(_)).
+system_predicate(hash_keys(_,_)).
+system_predicate(hash_map(_,_)).
+system_predicate(hash_put(_,_,_)).
+system_predicate(hash_remove(_,_)).
+system_predicate(hash_size(_,_)).
+system_predicate('$get_hash_manager'(_)).
+% Java interoperation
+system_predicate(java_constructor0(_,_)).
+system_predicate(java_constructor(_,_)).
+system_predicate(java_declared_constructor0(_,_)).
+system_predicate(java_declared_constructor(_,_)).
+system_predicate(java_method0(_,_,_)).
+system_predicate(java_method(_,_,_)).
+system_predicate(java_declared_method0(_,_,_)).
+system_predicate(java_declared_method(_,_,_)).
+system_predicate(java_get_field0(_,_,_)).
+system_predicate(java_get_field(_,_,_)).
+system_predicate(java_get_declared_field0(_,_,_)).
+system_predicate(java_get_declared_field(_,_,_)).
+system_predicate(java_set_field0(_,_,_)).
+system_predicate(java_set_field(_,_,_)).
+system_predicate(java_set_declared_field0(_,_,_)).
+system_predicate(java_set_declared_field(_,_,_)).
+system_predicate(synchronized(_,_)).
+system_predicate(java_conversion(_,_)).
+% Prolog interpreter
+system_predicate(cafeteria).
+system_predicate(consult(_)).
+system_predicate(trace).
+system_predicate(notrace).
+system_predicate(debug).
+system_predicate(nodebug).
+system_predicate(leash(_)).
+system_predicate(spy(_)).
+system_predicate(nospy(_)).
+system_predicate(nospyall).
+system_predicate(listing).
+system_predicate(listing(_)).
+% Misc
+system_predicate(length(_,_)).
+system_predicate(numbervars(_,_,_)).
+system_predicate(statistics(_,_)).
+% END
diff --git a/src/compiler/Compiler.java b/src/compiler/Compiler.java
new file mode 100644
index 0000000..c06c924
--- /dev/null
+++ b/src/compiler/Compiler.java
@@ -0,0 +1,290 @@
+package jp.ac.kobe_u.cs.prolog.compiler;
+import jp.ac.kobe_u.cs.prolog.lang.*;
+import java.io.File;
+/**
+ * The <code>Compiler</code> class provides methods for
+ * translating Prolog programs into Java programs.
+ *
+ * The <code>Compiler</code> class supports the following compiler options.
+ * All of them are set to <code>true</code> in default setting.
+ * <ul>
+ * <li>Eliminate disjunctions
+ * <li>Arithmetic compilation
+ * <li>Inline expansion
+ * <li>Optimisation of recursive call
+ * <li>2nd. level indexing (<code>switch_on_hash</code>)
+ * </ul>
+ *
+ * Let us show a sample session for translating a Prolog program
+ * <code>$PLCAFEDIR/examples/prolog/list.pl</code> into Java.
+ * The <code>list.pl</code> contains predicates
+ * <code>append/3</code>, <code>nrev/2</code>, and <code>range/3</code>.
+ * <ul>
+ * <li>From Command line<br>
+ * <pre>
+ * % java -cp $PLCAFEDIR/plcafe.jar jp.ac.kobe_u.cs.prolog.compiler.Compiler:$CLASSPATH $PLCAFEDIR/examples/prolog/list.pl
+ * Prolog Cafe X.X.X (YYY)
+ * Copyright(C) 1997-200X M.Banbara and N.Tamura
+ * % ls
+ * PRED_append_3.java PRED_nrev_2.java PRED_range_3.java
+ * </pre>
+ * <li>From Java program<br>
+ * <pre>
+ * import jp.ac.kobe_u.cs.prolog.compiler.Compiler;
+ * public class T {
+ * public static void main(String argv[]) {
+ * Compiler comp = new Compiler();
+ * comp.prologToJava(argv[0], ".");
+ * }
+ * }
+ * </pre>
+ * <pre>
+ * % javac -classpath $PLCAFEDIR/plcafe.jar:$CLASSPATH T.java
+ * % java -classpath $PLCAFEDIR/plcafe.jar:$CLASSPATH T $PLCAFEDIR/examples/prolog/list.pl
+ * % ls
+ * PRED_append_3.java PRED_nrev_2.java PRED_range_3.java
+ * </pre>
+ * </ul>
+ *
+ * It is noted that
+ * our Prolog-to-Java translator is originally witten in Prolog, and then bootstrapped.
+ * Please see the following two Prolog programs in details.
+ * <ul>
+ * <li><code>$PLCAFEDIR/src/compiler/pl2am.pl</code><br>
+ * Translates a Prolog program into a WAM-based intermediate code.
+ * <li><code>$PLCAFEDIR/src/compiler/am2j.pl</code><br>
+ * Translates a WAM-based intermediate code generated by <code>pl2am.pl</code>
+ * into Java programs.
+ * </ul>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2
+ */
+public class Compiler {
+ /** Version information */
+ public static String VERSION = "Prolog Cafe 1.2.5 (mantis)";
+ /** Copyright information */
+ public static String COPYRIGHT = "Copyright(C) 1997-2009 M.Banbara and N.Tamura";
+
+ /** Compiler option for eliminating disjunctions. Its initial value is <code>true</code> */
+ protected boolean eliminateDisjunctions = true;
+ /** Compiler option for arithmetic compilation. Its initial value is <code>true</code> */
+ protected boolean arithmeticCompilation = true;
+ /** Compiler option for inline expansion. Its initial value is <code>true</code> */
+ protected boolean inlineExpansion = true;
+ /** Compiler option for optimising recursive call. Its initial value is <code>true</code> */
+ protected boolean optimiseRecursiveCall = true;
+ /** Compiler option for second-level indexing. Its initial value is <code>true</code> */
+ protected boolean switchOnHash = true;
+ /** Non-standard option. Compiler option for closure generation. Its initial value is <code>false</code> */
+ protected boolean generateClosure = false;
+
+ /**
+ * Translates a Prolog program into a WAM-based intermediate code.
+ *
+ * @param _prolog an input Prolog file
+ * @param _wam an output file for WAM-based intermediate code.
+ * @return <code>true</code> if succeeds, otherwise <code>false</code>.
+ */
+ public boolean prologToWAM(String _prolog, String _wam) {
+ try {
+ if (! fileExists(_prolog)) {
+ System.out.println("**ERROR: file " + _prolog + " does not exist");
+ return false;
+ }
+ if (fileExists(_wam)) {
+ System.out.println("**ERROR: file " + _wam + " already exists");
+ return false;
+ }
+ // Create arguments
+ Term prolog = SymbolTerm.makeSymbol(_prolog);
+ Term wam = SymbolTerm.makeSymbol(_wam);
+ Term op = Prolog.Nil;
+ if (eliminateDisjunctions)
+ op = new ListTerm(SymbolTerm.makeSymbol("ed"), op);
+ if (arithmeticCompilation)
+ op = new ListTerm(SymbolTerm.makeSymbol("ac"), op);
+ if (inlineExpansion)
+ op = new ListTerm(SymbolTerm.makeSymbol("ie"), op);
+ if (optimiseRecursiveCall)
+ op = new ListTerm(SymbolTerm.makeSymbol("rc"), op);
+ if (switchOnHash)
+ op = new ListTerm(SymbolTerm.makeSymbol("idx"), op);
+ if (generateClosure)
+ op = new ListTerm(SymbolTerm.makeSymbol("clo"), op);
+ Term[] args = {new ListTerm(prolog, new ListTerm(wam, new ListTerm(op, Prolog.Nil)))};
+ // Create predicate
+ Class clazz = (new PrologClassLoader()).loadPredicateClass("jp.ac.kobe_u.cs.prolog.compiler.pl2am", "pl2am", 1, true);
+ Predicate code = (Predicate)(clazz.newInstance());
+ // Translate Prolog into WAM
+ PrologControl p = new PrologControl();
+ p.setPredicate(code, args);
+ // System.out.println(code);
+ return p.execute(code, args);
+ } catch (Exception e){
+ e.printStackTrace();
+ }
+ return false;
+ }
+
+ /**
+ * Translates WAM-based intermediate code into Java programs.
+ *
+ * @param _wam an input file for WAM-based intermediate code.
+ * @param _dir a destination directory for java files. The directory must already exist.
+ * @return <code>true</code> if succeeds, otherwise <code>false</code>.
+ * @see #prologToWAM(String, String)
+ */
+ public boolean wamToJava(String _wam, String _dir) {
+ try {
+ if (! fileExists(_wam)) {
+ System.out.println("**ERROR: file " + _wam + " does not exist");
+ return false;
+ }
+ if (! fileExists(_dir)) {
+ System.out.println("**ERROR: directory " + _dir + " does not exist");
+ return false;
+ }
+ // Create arguments
+ Term wam = SymbolTerm.makeSymbol(_wam);
+ Term dir = SymbolTerm.makeSymbol(_dir);
+ Term[] args = {new ListTerm(wam, new ListTerm(dir, Prolog.Nil))};
+ // Create predicate
+ // Class clazz = PredicateEncoder.getClass("jp.ac.kobe_u.cs.prolog.compiler.am2j", "am2j", 1);
+ Class clazz = (new PrologClassLoader()).loadPredicateClass("jp.ac.kobe_u.cs.prolog.compiler.am2j", "am2j", 1, true);
+ Predicate code = (Predicate)(clazz.newInstance());
+ // Translate WAM into Java
+ PrologControl p = new PrologControl();
+ p.setPredicate(code, args);
+ // System.out.println(code);
+ return p.execute(code, args);
+ } catch (Exception e){
+ e.printStackTrace();
+ }
+ return false;
+ }
+
+ /**
+ * Translates a Prolog program into Java programs.
+ *
+ * @param prolog an input Prolog file
+ * @param dir a destination directory for java files. The directory must already exist.
+ * @return <code>true</code> if succeeds, otherwise <code>false</code>.
+ * @see #prologToWAM(String, String)
+ * @see #wamToJava(String, String)
+ */
+ public boolean prologToJava(String prolog, String dir) {
+ String wam = prolog + ".am";
+ if (! prologToWAM(prolog, wam))
+ return false;
+ if (! wamToJava(wam, dir))
+ return false;
+ try {
+ File f = new File(wam);
+ if (f.exists())
+ f.delete();
+ } catch (SecurityException e) {}
+ return true;
+ }
+
+ public static void main(String argv[]) {
+ try {
+ System.err.println("\n" + VERSION);
+ System.err.println(COPYRIGHT);
+ if (argv.length != 1) {
+ usage();
+ System.exit(999);
+ }
+ Compiler comp = new Compiler();
+ if (! comp.prologToJava(argv[0], "."))
+ System.exit(1);
+ System.exit(0);
+ } catch (Exception e){
+ e.printStackTrace();
+ System.exit(1);
+ }
+ }
+
+ protected static boolean fileExists(String _file) {
+ try {
+ File file = new File(_file);
+ return file.exists();
+ } catch (SecurityException e) {}
+ return false;
+ }
+
+ /** Shows usage */
+ protected static void usage() {
+ String s = "Usage:\n";
+ s += "java -cp $PLCAFEDIR/plcafe.jar";
+ s += " jp.ac.kobe_u.cs.prolog.compiler.Compiler prolog_file\n";
+ System.out.println(s);
+ }
+
+ /**
+ * Returns the boolean value of <code>eliminateDisjunctions</code>.
+ * @see #eliminateDisjunctions
+ */
+ public boolean getEliminateDisjunctions() { return eliminateDisjunctions; }
+ /**
+ * The <code>eliminateDisjunctions</code> field is set to <code>b</code>.
+ * @see #eliminateDisjunctions
+ */
+ public void setEliminateDisjunctions(boolean b) { eliminateDisjunctions = b; }
+
+ /**
+ * Returns the boolean value of <code>arithmeticCompilation</code>.
+ * @see #arithmeticCompilation
+ */
+ public boolean getArithmeticCompilation() { return arithmeticCompilation; }
+ /**
+ * The <code>arithmeticCompilation</code> field is set to <code>b</code>.
+ * @see #arithmeticCompilation
+ */
+ public void setArithmeticCompilation(boolean b) { arithmeticCompilation = b; }
+
+ /**
+ * Returns the boolean value of <code>inlineExpansion</code>.
+ * @see #inlineExpansion
+ */
+ public boolean getInlineExpansion() { return inlineExpansion; }
+ /**
+ * The <code>inlineExpansion</code> field is set to <code>b</code>.
+ * @see #inlineExpansion
+ */
+ public void setInlineExpansion(boolean b) { inlineExpansion = b; }
+
+ /**
+ * Returns the boolean value of <code>optimiseRecursiveCall</code>.
+ * @see #optimiseRecursiveCall
+ */
+ public boolean getOptimiseRecursiveCall() { return optimiseRecursiveCall; }
+ /**
+ * The <code>optimiseRecursiveCall</code> field is set to <code>b</code>.
+ * @see #optimiseRecursiveCall
+ */
+ public void setOptimiseRecursiveCall(boolean b) { optimiseRecursiveCall = b; }
+
+ /**
+ * Returns the boolean value of <code>switchOnHash</code>.
+ * @see #switchOnHash
+ */
+ public boolean getSwitchOnHash() { return switchOnHash; }
+ /**
+ * The <code>switchOnHash</code> field is set to <code>b</code>.
+ * @see #switchOnHash
+ */
+ public void setSwitchOnHash(boolean b) { switchOnHash = b; }
+
+ /**
+ * Returns the boolean value of <code>generateClosure</code>.
+ * @see #generateClosure
+ */
+ public boolean getGenerateClosure() { return generateClosure; }
+ /**
+ * The <code>generateClosure</code> field is set to <code>b</code>.
+ * @see #generateClosure
+ */
+ public void setGenerateClosure(boolean b) { generateClosure = b; }
+}
diff --git a/src/compiler/Makefile b/src/compiler/Makefile
new file mode 100644
index 0000000..fcc6854
--- /dev/null
+++ b/src/compiler/Makefile
@@ -0,0 +1,58 @@
+################################################################
+# Makefile for Prolog Cafe
+################################################################
+
+################################################################
+# The following two definitions will be overridden.
+#
+# PROLOG : the command of Prolog system
+# (ex. sicstus, swipl, or prolog)
+# PSYSTEM: the type of Prolog system
+# (ex. 'SICStus', 'SWI-Prolog' or others)
+#
+PROLOG = sicstus
+PSYSTEM = 'SICStus'
+#PROLOG = swipl
+#PSYSTEM = 'SWI-Prolog'
+
+# JAVAC : the command of Java compiler system (ex. javac)
+# JAR : the command of Jar archive system (ex. jar)
+JAVAC = javac
+JAVACOPTS = -d . -Xlint -classpath $$PLCAFEDIR/lang.jar:$$PLCAFEDIR/builtin.jar:$$CLASSPATH
+JAR = jar
+JAROPTS = cvf
+# JAVA : the command of Java Virtual Machine (ex. java)
+JAVA = java
+################################################################
+.SUFFIXES:
+.SUFFIXES: .plj .txt .am .plc .pl $(SUFFIXES)
+
+.pl.plc:
+ cp ../builtin/system.pl .
+ ./comp_pl -v `pwd`/$*.pl `pwd`/$*.plc $(PROLOG) $(PSYSTEM)
+
+.pl.am:
+ pl2am.plc -v -O $< $@
+ -mkdir $*
+ am2j.plc -v -d $* $@
+
+.txt.plj:
+ ./comp_pl -v `pwd`/$*.pl `pwd`/$*.plj $(JAVA) 'PrologCafe'
+
+plc: pl2am.plc am2j.plc
+
+compiler:pl2am.am am2j.am
+ $(JAVAC) $(JAVACOPTS) pl2am/*.java am2j/*.java Compiler.java
+ $(JAR) $(JAROPTS) compiler.jar jp/ac/kobe_u/cs/prolog/compiler
+
+plj: pl2am.plj am2j.plj
+
+clean:
+ -rm -f -r am2j
+ -rm -f -r pl2am
+ -rm -f -r jp
+ -rm -f core *~ *.ql *.sav *.plc *.qlf *.qsav *.am *.plj *.jar system.pl
+
+realclean: clean
+
+
diff --git a/src/compiler/am2j.pl b/src/compiler/am2j.pl
new file mode 100644
index 0000000..124b1cf
--- /dev/null
+++ b/src/compiler/am2j.pl
@@ -0,0 +1,1255 @@
+/*****************************************************************
+Time-stamp: <2008-10-29 10:42:42 banbara>
+
+NAME
+ am2j: Translating WAM-based Intermediate Code into Java
+
+USAGE
+ # sicstus
+ ?- [am2j].
+ ?- am2j([File]).
+
+ # sicstus
+ ?- [am2j].
+ ?- am2j([File, Dir]).
+
+PARAMETERS
+ File is an input WAM-based Intermediate file name.
+
+DESCRIPTION
+ This program translates WAM-based intermediate codes into Java.
+ For each predicate p/n, the file named "PRED_p_n.java" is generated.
+ Generated files can be compiled and executed by usual
+ java utilities (ex. javac) with the Prolog Cafe runtime system.
+
+COPYRIGHT
+ am2j (Translating WAM-based Intermediate Code into Java)
+ Copyright (C) 1997-2008 by
+ Mutsunori Banbara (banbara@kobe-u.ac.jp) and
+ Naoyuki Tamura (tamura@kobe-u.ac.jp)
+
+SEE ALSO
+ http://kaminari.istc.kobe-u.ac.jp/PrologCafe/
+*****************************************************************/
+
+/*****************************************************************
+ Declarations
+*****************************************************************/
+:- op(1170, xfx, (:-)).
+:- op(1170, xfx, (-->)).
+:- op(1170, fx, (:-)).
+:- op(1170, fx, (?-)).
+:- op(1150, fx, (public)).
+:- op(1150, fx, (package)). % Prolog Cafe specific
+
+:- dynamic dest_dir/1.
+
+% :- module('jp.ac.kobe_u.cs.prolog.compiler.am2j', [main/0,am2j/1]).
+package(_).
+:- package 'jp.ac.kobe_u.cs.prolog.compiler.am2j'.
+:- public main/0, am2j/1.
+/*****************************************************************
+ Main
+*****************************************************************/
+main :-
+ read(X),
+ am2j(X).
+
+am2j([File]) :- !, am2j([File, '.']).
+am2j([File,Dir]) :-
+ retractall(dest_dir(_)),
+ assert(dest_dir(Dir)),
+ open(File, read, In),
+ repeat,
+ read(In, X),
+ write_java(X, In),
+ X == end_of_file,
+ !,
+ close(In).
+
+write_java(X, _) :- var(X), !,
+ am2j_error([unbound,variable,is,found]),
+ fail.
+write_java(end_of_file, _) :- !.
+write_java((:- G), _) :- !, call(G).
+write_java(begin_predicate(FA), In) :-
+ clause(dest_dir(Dir), _),
+ FA = F/A,
+ predicate_encoding(F, F1),
+ list_to_string([Dir, '/PRED',F1,'_',A,'.java'], File),
+ open(File, write, Out),
+ repeat,
+ read(In, X),
+ write_java0(X, In, Out),
+ X == end_predicate(FA),
+ close(Out),
+ !.
+write_java(X, _) :-
+ am2j_error([X,is,an,invalid,argument,in,write_java/2]),
+ fail.
+
+/*****************************************************************
+ Write Java
+*****************************************************************/
+write_java0(X, _, _) :- var(X), !,
+ am2j_error([unbound,variable,is,found]),
+ fail.
+write_java0([], _, _) :- !.
+write_java0([X|Xs], In, Out) :- !,
+ write_java0(X, In, Out),
+ write_java0(Xs, In, Out).
+write_java0(end_predicate(_), _, Out) :- !,
+ tab(Out, 4),
+ write(Out, '}'), nl(Out),
+ write(Out, '}'), nl(Out).
+write_java0(comment(Comment), _, Out) :- !,
+ numbervars(Comment, 0, _),
+ tab(Out, 4),
+ write(Out, '// '),
+ writeq(Out, Comment), nl(Out).
+write_java0(debug(Comment), _, Out) :- !,
+ numbervars(Comment, 0, _),
+ write(Out, '// '),
+ writeq(Out, Comment), nl(Out).
+write_java0(info([FA,File|_]), _, Out) :- !,
+ write(Out, '/*'), nl(Out),
+ write(Out, ' This file is generated by Prolog Cafe.'), nl(Out),
+ write(Out, ' PLEASE DO NOT EDIT!'), nl(Out),
+ write(Out, '*/'), nl(Out),
+ write(Out, '/**'), nl(Out),
+ write(Out, ' <code>'), writeq(Out, FA), write(Out, '</code>'),
+ write(Out, ' defined in '), write(Out, File), write(Out, '<br>'), nl(Out),
+ write(Out, ' @author Mutsunori Banbara (banbara@kobe-u.ac.jp)'), nl(Out),
+ write(Out, ' @author Naoyuki Tamura (tamura@kobe-u.ac.jp)'), nl(Out),
+ write(Out, ' @version 1.0'), nl(Out),
+ write(Out, '*/'), nl(Out).
+write_java0(package_name(user), _, _) :- !.
+write_java0(package_name(P), _, Out) :- !,
+ write(Out, 'package '),
+ write_package(P, Out),
+ write(Out, ';'), nl(Out).
+write_java0(import_package(P), _, Out) :- !,
+ write(Out, 'import '),
+ write_package(P, Out),
+ write(Out, '.*;'), nl(Out).
+write_java0(import_package(P,FA), _, Out) :- !,
+ write(Out, 'import '),
+ write_package(P, Out),
+ write(Out, '.'),
+ (FA = _/_ ->
+ write_class_name(FA, Out)
+ ;
+ write_package(FA, Out)
+ ),
+ write(Out, ';'), nl(Out).
+write_java0((Label: Instruction), In, Out) :- !,
+ write_label(Label, Out),
+ write_java0(Instruction, In, Out).
+write_java0(label(L), _, Out) :- !,
+ tab(Out, 4),
+ write(Out, 'static Predicate '),
+ write_index(L, Out),
+ write(Out, ' = new '),
+ write_class_name(L, Out),
+ write(Out, '();'), nl(Out).
+write_java0(goto(L), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'return '),
+ write_index(L, Out),
+ write(Out, ';'), nl(Out).
+write_java0(setB0, _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'engine.setB0();'), nl(Out).
+write_java0(deref(_,void), _, _) :- !.
+write_java0(deref(Ri,Rj), _, Out) :- !,
+ tab(Out, 8),
+ write_reg(Rj, Out),
+ write(Out, ' = '),
+ write_reg(Ri, Out),
+ write(Out, '.dereference();'), nl(Out).
+write_java0(set(_,void), _, _) :- !.
+write_java0(set(Ri,Rj), _, Out) :- !,
+ tab(Out, 8),
+ write_reg(Rj, Out),
+ write(Out, ' = '),
+ write_reg(Ri, Out),
+ write(Out, ';'), nl(Out).
+write_java0(decl_term_vars([]), _, _) :- !.
+write_java0(decl_term_vars(L), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'Term '),
+ write_reg_args(L, Out),
+ write(Out, ';'), nl(Out).
+write_java0(decl_pred_vars([]), _, _) :- !.
+write_java0(decl_pred_vars(L), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'Predicate '),
+ write_reg_args(L, Out),
+ write(Out, ';'), nl(Out).
+write_java0(put_cont(BinG,C), _, Out) :- !,
+ (BinG = P:G -> true ; BinG = G),
+ functor(G, F, A0),
+ A is A0-1,
+ G =.. [F|Args],
+ tab(Out, 8),
+ write_reg(C, Out),
+ write(Out, ' = new '),
+ (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true),
+ write_class_name(F/A, Out),
+ write(Out, '('),
+ write_reg_args(Args, Out),
+ write(Out, ');'), nl(Out).
+write_java0(execute(cont), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'return cont;'), nl(Out).
+write_java0(execute(BinG), _, Out) :- !,
+ (BinG = P:G -> true ; BinG = G),
+ functor(G, F, A0),
+ A is A0-1,
+ G =.. [F|Args],
+ tab(Out, 8),
+ write(Out, 'return new '),
+ (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true),
+ write_class_name(F/A, Out),
+ write(Out, '('),
+ write_reg_args(Args, Out),
+ write(Out, ');'), nl(Out).
+write_java0(inline(G), In, Out) :-
+ write_inline(G, In, Out),
+ !.
+write_java0('$INSERT'(X), In, Out) :-
+ write_insert(X, In, Out),
+ !.
+write_java0(new_hash(Tag,I), _, Out) :- !,
+ tab(Out, 4),
+ write(Out, 'static java.util.Hashtable<Term, Predicate> '),
+ (Tag == int -> write(Out, 'Int') ; write(Out, Tag)),
+ write(Out, ' = new java.util.Hashtable<Term, Predicate>('),
+ write(Out, I),
+ write(Out, ');'), nl(Out).
+write_java0(put_hash(X,L,Tag), _, Out) :- !,
+ tab(Out, 8),
+ (Tag == int -> write(Out, 'Int') ; write(Out, Tag)),
+ write(Out, '.put('),
+ write_reg(X, Out),
+ write(Out, ', '),
+ write_index(L, Out),
+ write(Out, ');'), nl(Out).
+write_java0(static(Instrs), In, Out) :- !,
+ tab(Out, 4),
+ write(Out, 'static {'), nl(Out),
+ write_java0(Instrs, In, Out),
+ tab(Out, 4),
+ write(Out, '}'), nl(Out).
+%%% Put Instructions
+write_java0(put_var(X), _, Out) :- !,
+ tab(Out, 8),
+ write_reg(X, Out),
+ write(Out, ' = new VariableTerm(engine);'), nl(Out).
+write_java0(put_int(I,X), _, Out) :- !,
+ tab(Out, 4),
+ write(Out, 'static IntegerTerm '),
+ write_reg(X, Out),
+ write(Out, ' = new IntegerTerm('),
+ (java_integer(I) -> true; write(Out, 'new java.math.BigInteger("')),
+ write(Out, I),
+ (java_integer(I) -> true; write(Out, '")')),
+ write(Out, ');'), nl(Out).
+write_java0(put_float(F,X), _, Out) :- !,
+ tab(Out, 4),
+ write(Out, 'static DoubleTerm '),
+ write_reg(X, Out),
+ write(Out, ' = new DoubleTerm('),
+ write(Out, F),
+ write(Out, ');'), nl(Out).
+write_java0(put_con(C,X), _, Out) :- !,
+ tab(Out, 4),
+ write(Out, 'static SymbolTerm '),
+ write_reg(X, Out),
+ write(Out, ' = SymbolTerm.makeSymbol("'),
+ (C = F/A ->
+ write_constant(F, Out), write(Out, '", '), write(Out, A), write(Out, ');')
+ ;
+ write_constant(C, Out), write(Out, '");')
+ ),
+ nl(Out).
+write_java0(put_list(Xi,Xj,Xk), _, Out) :- !,
+ (Xk = s(_) ->
+ tab(Out, 4), write(Out, 'static ListTerm ')
+ ;
+ tab(Out, 8)
+ ),
+ write_reg(Xk, Out),
+ write(Out, ' = new ListTerm('),
+ write_reg(Xi, Out),
+ write(Out, ', '),
+ write_reg(Xj, Out),
+ write(Out, ');'), nl(Out).
+write_java0(put_str(Xi,Y,Xj), _, Out) :- !,
+ (Xj = s(_) ->
+ tab(Out, 4), write(Out, 'static StructureTerm ')
+ ;
+ tab(Out, 8)
+ ),
+ write_reg(Xj, Out),
+ write(Out, ' = new StructureTerm('),
+ write_reg(Xi, Out),
+ write(Out, ', '),
+ write_reg(Y, Out),
+ write(Out, ');'), nl(Out).
+write_java0(put_str_args(Xs,Y), _, Out) :- !,
+ (Y = s(_) ->
+ tab(Out, 4), write(Out, 'static ')
+ ;
+ tab(Out, 8)
+ ),
+ write(Out, 'Term[] '),
+ write_reg(Y, Out),
+ write(Out, ' = {'),
+ write_reg_args(Xs, Out),
+ write(Out, '};'), nl(Out).
+write_java0(put_clo(G0, X), _, Out) :- !,
+ (G0 = P:G -> true ; G0 = G),
+ functor(G, F, A),
+ G =.. [F|Args0],
+ am2j_append(Args0, ['null'], Args),
+ tab(Out, 8),
+ write_reg(X, Out),
+ write(Out, ' = new ClosureTerm(new '),
+ (nonvar(P) -> write_package(P, Out), write(Out, '.') ; true),
+ write_class_name(F/A, Out),
+ write(Out, '('),
+ write_reg_args(Args, Out),
+ write(Out, '));'), nl(Out).
+%%% Get Instructions
+write_java0(get_val(Xi,Xj), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'if (! '), write_reg(Xi, Out), write(Out, '.unify('),
+ write_reg(Xj, Out), write(Out, ', engine.trail))'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'return engine.fail();'), nl(Out).
+%write_java0(get_int(_,Xi,Xj), In, Out) :- !,
+% write_java0(get_val(Xi, Xj), In, Out).
+write_java0(get_int(N,Xi,Xj), In, Out) :- !,
+ write_java0(deref(Xj,Xj), In, Out),
+ % read mode
+ tab(Out, 8),
+ write(Out, 'if ('), write_reg(Xj, Out), write(Out, '.isInteger()){'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'if (((IntegerTerm) '), write_reg(Xj, Out), write(Out, ').intValue() != '),
+ write(Out, N), write(Out, ')'), nl(Out),
+ tab(Out, 16),
+ write(Out, 'return engine.fail();'), nl(Out),
+ % write mode
+ tab(Out, 8),
+ write(Out, '} else if ('), write_reg(Xj, Out), write(Out, '.isVariable()){'), nl(Out),
+ tab(Out, 12),
+ write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('),
+ write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out),
+ tab(Out, 8),
+ % otherwise fail
+ write(Out, '} else {'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'return engine.fail();'), nl(Out),
+ tab(Out, 8),
+ write(Out, '}'), nl(Out).
+%write_java0(get_float(_,Xi,Xj), In, Out) :- !,
+% write_java0(get_val(Xi, Xj), In, Out).
+write_java0(get_float(N,Xi,Xj), In, Out) :- !,
+ write_java0(deref(Xj,Xj), In, Out),
+ % read mode
+ tab(Out, 8),
+ write(Out, 'if ('), write_reg(Xj, Out), write(Out, '.isDouble()){'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'if (((DoubleTerm) '), write_reg(Xj, Out), write(Out, ').doubleValue() != '),
+ write(Out, N), write(Out, ')'), nl(Out),
+ tab(Out, 16),
+ write(Out, 'return engine.fail();'), nl(Out),
+ % write mode
+ tab(Out, 8),
+ write(Out, '} else if ('), write_reg(Xj, Out), write(Out, '.isVariable()){'), nl(Out),
+ tab(Out, 12),
+ write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('),
+ write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out),
+ tab(Out, 8),
+ % otherwise fail
+ write(Out, '} else {'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'return engine.fail();'), nl(Out),
+ tab(Out, 8),
+ write(Out, '}'), nl(Out).
+%write_java0(get_con(_,Xi,Xj), In, Out) :- !,
+% write_java0(get_val(Xi, Xj), In, Out).
+write_java0(get_con(_,Xi,Xj), In, Out) :- !,
+ write_java0(deref(Xj,Xj), In, Out),
+ % read mode
+ tab(Out, 8),
+ write(Out, 'if ('), write_reg(Xj, Out), write(Out, '.isSymbol()){'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'if (! '),
+ write_reg(Xj, Out), write(Out, '.equals('), write_reg(Xi, Out),
+ write(Out, '))'), nl(Out),
+ tab(Out, 16),
+ write(Out, 'return engine.fail();'), nl(Out),
+ % write mode
+ tab(Out, 8),
+ write(Out, '} else if ('), write_reg(Xj, Out), write(Out, '.isVariable()){'), nl(Out),
+ tab(Out, 12),
+ write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind('),
+ write_reg(Xi, Out), write(Out, ', engine.trail);'), nl(Out),
+ tab(Out, 8),
+ % otherwise fail
+ write(Out, '} else {'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'return engine.fail();'), nl(Out),
+ tab(Out, 8),
+ write(Out, '}'), nl(Out).
+write_java0(get_ground(_,Xi,Xj), In, Out) :- !,
+ write_java0(get_val(Xi, Xj), In, Out).
+write_java0(get_list(X), In, Out) :- !,
+ write_java0(deref(X,X), In, Out),
+ read_instructions(2, In, Us),
+ % read mode
+ tab(Out, 8),
+ write(Out, 'if ('), write_reg(X, Out), write(Out, '.isList()){'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'Term[] args = {((ListTerm)'),
+ write_reg(X, Out), write(Out, ').car(), ((ListTerm)'),
+ write_reg(X, Out), write(Out, ').cdr()};'), nl(Out),
+ write_unify_read(Us, 0, Out),
+ % write mode
+ tab(Out, 8),
+ write(Out, '} else if ('), write_reg(X, Out), write(Out, '.isVariable()){'), nl(Out),
+ write_unify_write(Us, Rs, Out),
+ tab(Out, 12),
+ write(Out, '((VariableTerm) '), write_reg(X, Out), write(Out, ').bind(new ListTerm('),
+ write_reg_args(Rs, Out), write(Out, '), engine.trail);'), nl(Out),
+ % otherwise fail
+ tab(Out, 8),
+ write(Out, '} else {'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'return engine.fail();'), nl(Out),
+ tab(Out, 8),
+ write(Out, '}'), nl(Out).
+write_java0(get_str(_F/A,Xi,Xj), In, Out) :- !,
+ write_java0(deref(Xj,Xj), In, Out),
+ read_instructions(A, In, Us),
+ % read mode
+ tab(Out, 8),
+ write(Out, 'if ('), write_reg(Xj, Out), write(Out, '.isStructure()){'), nl(Out), %??? == F
+ tab(Out, 12),
+ write(Out, 'if (! '), write_reg(Xi, Out),
+ write(Out, '.equals(((StructureTerm)'), write_reg(Xj, Out),
+ write(Out, ').functor()))'), nl(Out),
+ tab(Out, 16),
+ write(Out, 'return engine.fail();'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'Term[] args = ((StructureTerm)'),
+ write_reg(Xj, Out), write(Out, ').args();'), nl(Out),
+ write_unify_read(Us, 0, Out),
+ % write mode
+ tab(Out, 8),
+ write(Out, '} else if ('), write_reg(Xj, Out), write(Out, '.isVariable()){'), nl(Out),
+ write_unify_write(Us, Rs, Out),
+ tab(Out, 12),
+ write(Out, 'Term[] args = {'), write_reg_args(Rs, Out), write(Out, '};'), nl(Out),
+ tab(Out, 12),
+ write(Out, '((VariableTerm) '), write_reg(Xj, Out), write(Out, ').bind(new StructureTerm('),
+ write_reg(Xi, Out), write(Out, ', args), engine.trail);'), nl(Out),
+ % otherwise fail
+ tab(Out, 8),
+ write(Out, '} else {'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'return engine.fail();'), nl(Out),
+ tab(Out, 8),
+ write(Out, '}'), nl(Out).
+%%% Choice Instructions
+write_java0(try(Li,Lj), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'return engine.jtry('),
+ write_index(Li, Out),
+ write(Out, ', '),
+ write_index(Lj, Out),
+ write(Out, ');'), nl(Out).
+write_java0(retry(Li,Lj), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'return engine.retry('),
+ write_index(Li, Out),
+ write(Out, ', '),
+ write_index(Lj, Out),
+ write(Out, ');'), nl(Out).
+write_java0(trust(L), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'return engine.trust('),
+ write_index(L, Out),
+ write(Out, ');'), nl(Out).
+%%% Indexing Instructions
+write_java0(switch_on_term(Lv,Li,Lf,Lc,Ls,Ll), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'return engine.switch_on_term('),
+ write_index(Lv, Out), write(Out, ', '),
+ write_index(Li, Out), write(Out, ', '),
+ write_index(Lf, Out), write(Out, ', '),
+ write_index(Lc, Out), write(Out, ', '),
+ write_index(Ls, Out), write(Out, ', '),
+ write_index(Ll, Out), write(Out, ');'), nl(Out).
+write_java0(switch_on_hash(Tag,_,L, _), _, Out) :- !,
+ tab(Out, 8),
+ write(Out, 'return engine.switch_on_hash('),
+ (Tag == int -> write(Out, 'Int') ; write(Out, Tag)),
+ write(Out, ', '),
+ write_index(L, Out), write(Out, ');'), nl(Out).
+write_java0(Instruction, _, _) :-
+ am2j_error([Instruction,is,an,invalid,instruction]),
+ fail.
+
+/*****************************************************************
+ Write Label
+*****************************************************************/
+write_label(main(F/A, Modifier), Out) :- !,
+ (Modifier == (public) -> write(Out, 'public ') ; true),
+ write(Out, 'class '),
+ write_class_name(F/A, Out),
+ write(Out, ' extends Predicate {'), nl(Out).
+write_label(F/A, Out) :- !,
+ % instance variable declaration
+ (A > 0 ->
+ nl(Out),
+ write_enum('public Term ', arg, 1, A, ', ', ';', 4, Out), nl(Out)
+ ;
+ true
+ ),
+ % decl cont; ???
+ % constructor
+ nl(Out),
+ write_constructor(F/A, Out), nl(Out),
+ % arity method
+ nl(Out),
+ tab(Out, 4),
+ write(Out, 'public int arity() { return '),
+ write(Out, A),
+ write(Out, '; }'), nl(Out),
+ % toString method
+ nl(Out),
+ tab(Out, 4),
+ write(Out, 'public String toString() {'), nl(Out),
+ tab(Out, 8),
+ write(Out, 'return "'), write_constant(F, Out),
+ (A > 0 ->
+ write_enum('(" + ', arg, 1, A, ' + "," + ', ' + ")',0, Out)
+ ;
+ true
+ ),
+ write(Out, '";'), nl(Out),
+ tab(Out, 4),
+ write(Out, '}'), nl(Out),
+ % exec method
+ nl(Out),
+ tab(Out, 4),
+ write(Out, 'public Predicate exec(Prolog engine) {'), nl(Out).
+write_label(L, Out) :-
+ tab(Out, 4),
+ write(Out, '}'), nl(Out),
+ write(Out, '}'), nl(Out),
+ nl(Out),
+ % class for control instructions and clauses
+ write(Out, 'class '),
+ write_class_name(L, Out),
+ write(Out, ' extends '),
+ write_superclass_name(L, Out),
+ write(Out, ' {'), nl(Out),
+ tab(Out, 4),
+ write(Out, 'public Predicate exec(Prolog engine) {'), nl(Out), !.
+write_label(Instruction, _, _) :-
+ am2j_error([Instruction,is,an,invalid,instruction]),
+ fail.
+
+/*****************************************************************
+ Write Constructor
+*****************************************************************/
+write_constructor(F/A, Out) :-
+ tab(Out, 4), write(Out, 'public '),
+ write_class_name(F/A, Out), write(Out, '('),
+ (A > 0 ->
+ write_enum('', 'Term a', 1, A, ', ', ', ', 0, Out)
+ ;
+ true
+ ),
+ write(Out, 'Predicate cont) {'), nl(Out),
+ A > 0,
+ for(I, 1, A),
+ tab(Out, 8),
+ write(Out, arg), write(Out, I),
+ write(Out, ' = '),
+ write(Out, a), write(Out, I),
+ write(Out, ';'), nl(Out),
+ fail.
+write_constructor(F/A, Out) :-
+ tab(Out, 8),
+ write(Out, 'this.cont = cont;'), nl(Out),
+ tab(Out, 4),
+ write(Out, '}'), nl(Out),
+ % 0-arg constructor
+ nl(Out),
+ tab(Out, 4),
+ write(Out, 'public '),
+ write_class_name(F/A, Out),
+ write(Out, '(){}'), nl(Out),
+ % setArgument method
+ nl(Out),
+ tab(Out, 4),
+ write(Out, 'public void setArgument(Term[] args, Predicate cont) {'), nl(Out),
+ A > 0,
+ for(I, 1, A),
+ I1 is I-1,
+ tab(Out, 8),
+ write(Out, arg), write(Out, I),
+ write(Out, ' = '),
+ write(Out, 'args['), write(Out, I1), write(Out, '];'),
+ nl(Out),
+ fail.
+write_constructor(_, Out) :-
+ tab(Out, 8),
+ write(Out, 'this.cont = cont;'), nl(Out),
+ tab(Out, 4),
+ write(Out, '}').
+
+write_enum(Head, Sym, SN, EN, Delim, _, Tab, Out) :-
+ SN =< EN,
+ tab(Out, Tab),
+ write(Out, Head),
+ for(I, SN, EN),
+ write(Out, Sym),
+ write(Out, I),
+ (I < EN -> write(Out, Delim) ; true),
+ fail.
+write_enum(_, _, SN, EN, _, Tail, _, Out) :-
+ SN =< EN,
+ write(Out, Tail).
+
+/*****************************************************************
+ Write Unify Instructions
+*****************************************************************/
+%%% Read Mode
+write_unify_read([], _, _) :- !.
+write_unify_read([unify_void(I)|Xs], N, Out) :- !,
+ N1 is N+I,
+ write_unify_read(Xs, N1, Out).
+write_unify_read([X|Xs], N, Out) :-
+ write_unify_r(X, N, Out),
+ N1 is N+1,
+ write_unify_read(Xs, N1, Out).
+
+write_unify_r(X, _, _) :- var(X), !,
+ am2j_error([unbound,variable,is,found]),
+ fail.
+write_unify_r(unify_var(X), N, Out) :- !,
+ tab(Out, 12),
+ write_reg(X, Out),
+ write(Out, ' = '),
+ write_reg(args(N), Out),
+ write(Out, ';'), nl(Out).
+write_unify_r(unify_val(X), N, Out) :- !,
+ tab(Out, 12),
+ write(Out, 'if (! '),
+ write_reg(X, Out),
+ write(Out, '.unify('),
+ write_reg(args(N), Out),
+ write(Out, ', engine.trail))'), nl(Out),
+ tab(Out, 16),
+ write(Out, 'return engine.fail();'), nl(Out).
+write_unify_r(unify_int(_,X), N, Out) :- !, %???
+ write_unify_r(unify_val(X), N, Out).
+write_unify_r(unify_float(_,X), N, Out) :- !, %???
+ write_unify_r(unify_val(X), N, Out).
+write_unify_r(unify_con(_,X), N, Out) :- !, %???
+ write_unify_r(unify_val(X), N, Out).
+write_unify_r(unify_ground(_,X), N, Out) :- !,
+ write_unify_r(unify_val(X), N, Out).
+write_unify_r(X, _, _) :-
+ am2j_error([X,is,an,invalid,instruction]),
+ fail.
+
+%%% Write Mode
+write_unify_write([], [], _) :- !.
+write_unify_write([unify_void(0)|Xs], Rs, Out) :- !,
+ write_unify_write(Xs, Rs, Out).
+write_unify_write([unify_void(I)|Xs], [void|Rs], Out) :-
+ I > 0,
+ !,
+ I1 is I-1,
+ write_unify_write([unify_void(I1)|Xs], Rs, Out).
+write_unify_write([X|Xs], [R|Rs], Out) :-
+ write_unify_w(X, R, Out),
+ write_unify_write(Xs, Rs, Out).
+
+write_unify_w(X, _, _) :- var(X), !,
+ am2j_error([unbound,variable,is,found]),
+ fail.
+write_unify_w(unify_var(X), X, Out) :- !,
+ tab(Out, 12),
+ write_reg(X, Out),
+ write(Out, ' = new VariableTerm(engine);'), nl(Out).
+write_unify_w(unify_val(X), X, _) :- !.
+write_unify_w(unify_int(_,X), X, _) :- !.
+write_unify_w(unify_float(_,X), X, _) :- !.
+write_unify_w(unify_con(_,X), X, _) :- !.
+write_unify_w(unify_ground(_,X), X, _) :- !.
+write_unify_w(X, _, _) :-
+ am2j_error([X,is,an,invalid,instruction]),
+ fail.
+
+/*****************************************************************
+ Write Inline
+*****************************************************************/
+write_inline(X, In, Out) :-
+ write_inline_start(X, Out),
+ write_inline0(X, In, Out),
+ write_inline_end(Out).
+
+write_inline_start(Goal, Out) :-
+ tab(Out, 8),
+ write(Out, '//START inline expansion of '), write(Out, Goal), nl(Out).
+write_inline_end(Out) :-
+ tab(Out, 8),
+ write(Out, '//END inline expansion'), nl(Out).
+
+% Control constructs
+write_inline0(fail, _, Out) :- !,
+ tab(Out, 8), write(Out, 'return engine.fail();'), nl(Out).
+write_inline0('$get_level'(X), _, Out) :- !,
+ write_if_fail(op('!', unify(X,#('new IntegerTerm'('engine.B0')))), [], 8, Out).
+write_inline0('$neck_cut', _, Out) :- !,
+ tab(Out, 8), write(Out, 'engine.neckCut();'), nl(Out).
+write_inline0('$cut'(X), _, Out) :- !,
+ write_deref_args([X], Out),
+ tab(Out, 8),
+ write(Out, 'if (! '), write_reg(X, Out), write(Out, '.isInteger()) {'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'throw new IllegalTypeException("integer", '),
+ write_reg(X, Out), write(Out, ');'), nl(Out),
+ tab(Out, 8),
+ write(Out, '} else {'), nl(Out),
+ tab(Out, 12),
+ write(Out, 'engine.cut(((IntegerTerm) '), write_reg(X, Out),
+ write(Out, ').intValue());'), nl(Out),
+ tab(Out, 8),
+ write(Out, '}'), nl(Out).
+% Term unification
+write_inline0('$unify'(X,Y), _, Out) :- !, write_if_fail(op('!', unify(X,Y)), [], 8, Out).
+write_inline0('$not_unifiable'(X,Y), _, Out) :- !, write_if_fail(unify(X,Y), [], 8, Out).
+% Type testing
+write_inline0(var(X), _, Out) :- !, write_if_fail(op('!', @('isVariable'(X))), [X], 8, Out).
+write_inline0(atom(X), _, Out) :- !, write_if_fail(op('!', @('isSymbol'(X))), [X], 8, Out).
+write_inline0(integer(X), _, Out) :- !, write_if_fail(op('!', @('isInteger'(X))), [X], 8, Out).
+write_inline0(float(X), _, Out) :- !, write_if_fail(op('!', @('isDouble'(X))), [X], 8, Out).
+write_inline0(nonvar(X), _, Out) :- !, write_if_fail(@('isVariable'(X)), [X], 8, Out).
+write_inline0(number(X), _, Out) :- !, write_if_fail(op('!', @('isNumber'(X))), [X], 8, Out).
+write_inline0(java(X), _, Out) :- !, write_if_fail(op('!', @('isJavaObject'(X))), [X], 8, Out).
+write_inline0(closure(X), _, Out) :- !, write_if_fail(op('!', @('isClosure'(X))), [X], 8, Out).
+write_inline0(atomic(X), _, Out) :- !,
+ write_if_fail(op('&&',op('!',@('isSymbol'(X))), op('!',@('isNumber'(X)))), [X], 8, Out).
+write_inline0(java(X,Y), _, Out) :- !,
+ write_if_fail(op('!', @('isJavaObject'(X))), [X], 8, Out),
+ EXP = #('SymbolTerm.makeSymbol'(@(getName(@(getClass(@(object(cast('JavaObjectTerm',X))))))))),
+ write_if_fail(op('!', unify(Y,EXP)), [], 8, Out).
+write_inline0(ground(X), _, Out) :- !, write_if_fail(op('!', @('isGround'(X))), [X], 8, Out).
+% Term comparison
+write_inline0('$equality_of_term'(X,Y), _, Out) :- !, write_if_fail(op('!',@('equals'(X,Y))), [X,Y], 8, Out).
+write_inline0('$inequality_of_term'(X,Y), _, Out) :- !, write_if_fail(@('equals'(X,Y)), [X,Y], 8, Out).
+write_inline0('$after'(X,Y), _, Out) :- !, write_if_fail(op('<=',@('compareTo'(X,Y)),0), [X,Y], 8, Out).
+write_inline0('$before'(X,Y), _, Out) :- !, write_if_fail(op('>=',@('compareTo'(X,Y)),0), [X,Y], 8, Out).
+write_inline0('$not_after'(X,Y), _, Out) :- !, write_if_fail(op('>', @('compareTo'(X,Y)),0), [X,Y], 8, Out).
+write_inline0('$not_before'(X,Y), _, Out) :- !, write_if_fail(op('<', @('compareTo'(X,Y)),0), [X,Y], 8, Out).
+write_inline0('$identical_or_cannot_unify'(X,Y), _, Out) :- !,
+ write_if_fail(op('&&', op('!',@('equals'(X,Y))), unify(X,Y)), [X,Y], 8, Out).
+% Term creation and decomposition
+write_inline0(copy_term(X,Y), _, Out) :- nonvar(X), nonvar(Y), !,
+ write_if_fail(op('!', unify(Y, #('engine.copy'(X)))), [X], 8, Out).
+% Arithmetic evaluation
+write_inline0(is(X,Y), _, Out) :- !, write_arith(_, Y, X, 8, Out).
+write_inline0('$abs'(X,Y), _, Out) :- !, write_arith('abs', X, Y, 8, Out).
+write_inline0('$asin'(X,Y), _, Out) :- !, write_arith('asin', X, Y, 8, Out).
+write_inline0('$acos'(X,Y), _, Out) :- !, write_arith('acos', X, Y, 8, Out).
+write_inline0('$atan'(X,Y), _, Out) :- !, write_arith('atan', X, Y, 8, Out).
+write_inline0('$bitwise_conj'(X,Y,Z), _, Out) :- !, write_arith('and', X, Y, Z, 8, Out).
+write_inline0('$bitwise_disj'(X,Y,Z), _, Out) :- !, write_arith('or', X, Y, Z, 8, Out).
+write_inline0('$bitwise_exclusive_or'(X,Y,Z), _, Out) :- !, write_arith('xor', X, Y, Z, 8, Out).
+write_inline0('$bitwise_neg'(X,Y), _, Out) :- !, write_arith('not', X, Y, 8, Out).
+write_inline0('$ceil'(X,Y), _, Out) :- !, write_arith('ceil', X, Y, 8, Out).
+write_inline0('$cos'(X,Y), _, Out) :- !, write_arith('cos', X, Y, 8, Out).
+write_inline0('$degrees'(X,Y), _, Out) :- !, write_arith('toDegrees', X, Y, 8, Out).
+write_inline0('$exp'(X,Y), _, Out) :- !, write_arith('exp', X, Y, 8, Out).
+write_inline0('$float'(X,Y), _, Out) :- !, write_arith('toFloat', X, Y, 8, Out).
+write_inline0('$float_integer_part'(X,Y), _, Out) :- !, write_arith('floatIntPart', X, Y, 8, Out).
+write_inline0('$float_fractional_part'(X,Y), _, Out) :- !, write_arith('floatFractPart', X, Y, 8, Out).
+write_inline0('$float_quotient'(X,Y,Z), _, Out) :- !, write_arith('divide', X, Y, Z, 8, Out).
+write_inline0('$floor'(X,Y), _, Out) :- !, write_arith('floor', X, Y, 8, Out).
+write_inline0('$int_quotient'(X,Y,Z), _, Out) :- !, write_arith('intDivide', X, Y, Z, 8, Out).
+write_inline0('$log'(X,Y), _, Out) :- !, write_arith('log', X, Y, 8, Out).
+write_inline0('$max'(X,Y,Z), _, Out) :- !, write_arith('max', X, Y, Z, 8, Out).
+write_inline0('$min'(X,Y,Z), _, Out) :- !, write_arith('min', X, Y, Z, 8, Out).
+write_inline0('$minus'(X,Y,Z), _, Out) :- !, write_arith('subtract', X, Y, Z, 8, Out).
+write_inline0('$mod'(X,Y,Z), _, Out) :- !, write_arith('mod', X, Y, Z, 8, Out).
+write_inline0('$multi'(X,Y,Z), _, Out) :- !, write_arith('multiply', X, Y, Z, 8, Out).
+write_inline0('$plus'(X,Y,Z), _, Out) :- !, write_arith('add', X, Y, Z, 8, Out).
+write_inline0('$pow'(X,Y,Z), _, Out) :- !, write_arith('pow', X, Y, Z, 8, Out).
+write_inline0('$radians'(X,Y), _, Out) :- !, write_arith('toRadians', X, Y, 8, Out).
+write_inline0('$rint'(X,Y), _, Out) :- !, write_arith('rint', X, Y, 8, Out).
+write_inline0('$round'(X,Y), _, Out) :- !, write_arith('round', X, Y, 8, Out).
+write_inline0('$shift_left'(X,Y,Z), _, Out) :- !, write_arith('shiftLeft', X, Y, Z, 8, Out).
+write_inline0('$shift_right'(X,Y,Z), _, Out) :- !, write_arith('shiftRight', X, Y, Z, 8, Out).
+write_inline0('$sign'(X,Y), _, Out) :- !, write_arith('signum', X, Y, 8, Out).
+write_inline0('$sin'(X,Y), _, Out) :- !, write_arith('sin', X, Y, 8, Out).
+write_inline0('$sqrt'(X,Y), _, Out) :- !, write_arith('sqrt', X, Y, 8, Out).
+write_inline0('$tan'(X,Y), _, Out) :- !, write_arith('tan', X, Y, 8, Out).
+write_inline0('$truncate'(X,Y), _, Out) :- !, write_arith('truncate', X, Y, 8, Out).
+% Arithmetic comparison
+write_inline0('$arith_equal'(X,Y), _, Out) :- !, write_arith_compare('!=', X, Y, 8, Out).
+write_inline0('$arith_not_equal'(X,Y), _, Out) :- !, write_arith_compare('==', X, Y, 8, Out).
+write_inline0('$greater_or_equal'(X,Y), _, Out) :- !, write_arith_compare('<', X, Y, 8, Out).
+write_inline0('$greater_than'(X,Y), _, Out) :- !, write_arith_compare('<=', X, Y, 8, Out).
+write_inline0('$less_or_equal'(X,Y), _, Out) :- !, write_arith_compare('>', X, Y, 8, Out).
+write_inline0('$less_than'(X,Y), _, Out) :- !, write_arith_compare('>=', X, Y, 8, Out).
+
+write_deref_args([], _) :- !.
+write_deref_args([s(_)|Xs], Out) :- !,
+ write_deref_args(Xs, Out).
+write_deref_args([si(_)|Xs], Out) :- !, % ???
+ write_deref_args(Xs, Out).
+write_deref_args([sf(_)|Xs], Out) :- !, % ???
+ write_deref_args(Xs, Out).
+write_deref_args([X|Xs], Out) :-
+ write_java0(deref(X,X), _, Out),
+ write_deref_args(Xs, Out).
+
+write_if_fail(Cond, Args, Tab, Out) :- nonvar(Cond), ground(Args), !,
+ EXP = if_then(Cond, 'return engine.fail()'),
+ write_deref_args(Args, Out),
+ write_inline_java(EXP, Tab, Out).
+
+make_arith_arg(E, _) :- var(E), !, fail.
+make_arith_arg(E, E) :- E = si(_), !.
+make_arith_arg(E, E) :- E = sf(_), !.
+%make_arith_arg(E, cast('NumberTerm',E)) :- E = a(_), !. %???
+make_arith_arg(E, #('Arithmetic.evaluate'(E))).
+
+write_arith(M, E, V, Tab, Out) :-
+ make_arith_arg(E, A1),
+ nonvar(V),
+ ( nonvar(M) -> A0 =.. [M,A1], A = @(A0)
+ ; A = A1
+ ),
+ EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']),
+ SENT = if_then(op('!', unify(V,A)), 'return engine.fail()'),
+ %write_deref_args([E], Out),
+ write_inline_java(EXP, Tab, Out).
+
+write_arith(M, E1, E2, V, Tab, Out) :-
+ nonvar(M),
+ make_arith_arg(E1, A1),
+ make_arith_arg(E2, A2),
+ nonvar(V),
+ A0 =.. [M,A1,A2],
+ A = @(A0),
+ EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']),
+ SENT = if_then(op('!', unify(V,A)), 'return engine.fail()'),
+ %write_deref_args([E1,E2], Out),
+ write_inline_java(EXP, Tab, Out).
+
+write_arith_compare(M, E1, E2, Tab, Out) :-
+ nonvar(M),
+ make_arith_arg(E1, A1),
+ make_arith_arg(E2, A2),
+ A0 =.. ['arithCompareTo',A1,A2],
+ A = @(A0),
+ EXP = try_catch(SENT, 'BuiltinException', ['e.goal = this','throw e']),
+ SENT = if_then(op(M, A, 0), 'return engine.fail()'),
+ %write_deref_args([E1,E2], Out),
+ write_inline_java(EXP, Tab, Out).
+
+write_inline_java(X, _, _) :- var(X), !, fail.
+write_inline_java([], _, _) :- !.
+write_inline_java([X|Xs], Tab, Out) :- !,
+ write_inline_java(X, Tab, Out),
+ write_inline_java(Xs, Tab, Out).
+write_inline_java(try_catch(TRY,EXCEPT,CATCH), Tab, Out) :- !,
+ tab(Out, Tab),
+ write(Out, 'try {'), nl(Out),
+ Tab1 is Tab + 4,
+ write_inline_java(TRY, Tab1, Out),
+ tab(Out, Tab),
+ write(Out, '} catch ('), write(Out, EXCEPT), write(Out, ' e) {'), nl(Out),
+ write_inline_java(CATCH, Tab1, Out),
+ tab(Out, Tab),
+ write(Out, '}'), nl(Out).
+write_inline_java(if_then(IF, THEN), Tab, Out) :- !,
+ tab(Out, Tab),
+ write(Out, 'if ('), write_inline_exp(IF, 0, Out), write(Out, ') {'), nl(Out),
+ Tab1 is Tab + 4,
+ write_inline_java(THEN, Tab1, Out),
+ tab(Out, Tab),
+ write(Out, '}'), nl(Out).
+write_inline_java(if_then_else(IF, THEN, ELSE), Tab, Out) :- !,
+ tab(Out, Tab),
+ write(Out, 'if ('), write_inline_exp(IF, 0, Out), write(Out, ') {'), nl(Out),
+ Tab1 is Tab + 4,
+ write_inline_java(THEN, Tab1, Out),
+ tab(Out, Tab),
+ write(Out, '} else {'), nl(Out),
+ write_inline_java(ELSE, Tab1, Out),
+ tab(Out, Tab),
+ write(Out, '}'), nl(Out).
+write_inline_java(X, Tab, Out) :-
+ tab(Out, Tab),
+ write(Out, X), write(Out, ';'), nl(Out).
+
+write_inline_exp(X, _, _) :- var(X), !, fail.
+write_inline_exp([], _, _) :- !.
+write_inline_exp([X], Tab, Out) :- !,
+ write_inline_exp(X, Tab, Out).
+write_inline_exp([X|Xs], Tab, Out) :- !,
+ write_inline_exp(X, Tab, Out),
+ write(Out, ','),
+ write_inline_exp(Xs, 0, Out).
+write_inline_exp(bracket(Exp), Tab, Out) :- !,
+ tab(Out, Tab),
+ write(Out, '('),
+ write_inline_exp(Exp, 0, Out),
+ write(Out, ')').
+write_inline_exp(op(Op, Exp), Tab, Out) :- !,
+ tab(Out, Tab),
+ write(Out, Op), write(Out, ' '), write_inline_exp(Exp, 0, Out).
+write_inline_exp(op(Op, Exp1, Exp2), Tab, Out) :- !,
+ tab(Out, Tab),
+ write_inline_exp(Exp1, 0, Out),
+ write(Out, ' '),
+ write(Out, Op),
+ write(Out, ' '),
+ write_inline_exp(Exp2, 0, Out).
+write_inline_exp(cast(Class,Exp), Tab, Out) :- !,
+ tab(Out, Tab),
+ write(Out, '(('), write(Out, Class), write(Out, ') '),
+ write_inline_exp(Exp, 0, Out), write(Out, ')').
+write_inline_exp(unify(X,Y), Tab, Out) :- !,
+ tab(Out, Tab),
+ write_inline_exp(X, 0, Out),
+ write(Out, '.unify('),
+ write_inline_exp(Y, 0, Out),
+ write(Out, ', engine.trail)').
+write_inline_exp(#(X), Tab, Out) :- !,
+ X =.. [F|As],
+ tab(Out, Tab),
+ write(Out, F), write(Out, '('),
+ write_inline_exp(As, 0, Out),
+ write(Out, ')').
+write_inline_exp(@(X), Tab, Out) :- !,
+ X =.. [F|As],
+ write_inline_method(F, As, Tab, Out).
+write_inline_exp(X, Tab, Out) :- X = s(_), !,
+ tab(Out, Tab), write_reg(X, Out).
+write_inline_exp(X, Tab, Out) :- X = si(_), !, % ???
+ tab(Out, Tab), write_reg(X, Out).
+write_inline_exp(X, Tab, Out) :- X = sf(_), !, % ???
+ tab(Out, Tab), write_reg(X, Out).
+write_inline_exp(X, Tab, Out) :- X = a(_), !,
+ tab(Out, Tab), write_reg(X, Out).
+write_inline_exp(X, Tab, Out) :- X == void, !, % ???
+ tab(Out, Tab), write_reg(X, Out).
+write_inline_exp(X, Tab, Out) :-
+ tab(Out, Tab), write(Out, X).
+
+write_inline_method(F, _, _, _) :- var(F), !, fail.
+write_inline_method(_, A, _, _) :- var(A), !, fail.
+write_inline_method(F, [A], Tab, Out) :- !,
+ tab(Out, Tab),
+ write_inline_exp(A, 0, Out),
+ write(Out, '.'), write(Out, F), write(Out, '()').
+write_inline_method(F, [A,B], Tab, Out) :-
+ tab(Out, Tab),
+ write_inline_exp(A, 0, Out),
+ write(Out, '.'), write(Out, F), write(Out, '('),
+ write_inline_exp(B, 0, Out), write(Out, ')').
+
+
+/*****************************************************************
+ Write Insert
+*****************************************************************/
+write_insert(X, _, _) :- var(X), !, fail.
+write_insert([], _, _) :- !.
+write_insert([X|Xs], _, Out) :-
+ atom(X),
+ write(Out, X), nl(Out),
+ write_insert(Xs, _, Out).
+
+/*****************************************************************
+ Auxiliaries
+*****************************************************************/
+% int
+java_integer(X) :- integer(X), -2147483648 =< X, X =< 2147483647.
+
+% Read Instructions
+read_instructions(0, _, []) :- !.
+read_instructions(N, In, [X|Xs]) :-
+ N > 0,
+ read(In, X),
+ N1 is N-1,
+ read_instructions(N1, In, Xs).
+
+% Write package name
+write_package(P, Out) :- !,
+ write(Out, P).
+
+% Write class name
+write_superclass_name(F/A, Out) :- !,
+ write(Out, 'PRED'), write_pred_spec(F/A, Out).
+write_superclass_name(L+_, Out) :-
+ write_superclass_name(L, Out).
+
+write_class_name(L, Out) :-
+ write(Out, 'PRED'), write_index(L, Out).
+
+% Write label
+write_index(F/A, Out) :- !,
+ write_pred_spec(F/A, Out).
+write_index(L+I, Out) :-
+ write_index(L, Out), write(Out, '_'), write(Out, I).
+
+% Write constant name
+write_constant(X, Out) :-
+ constant_encoding(X, Y),
+ write(Out, Y).
+
+% Write predicate specification
+write_pred_spec(F/A, Out) :-
+ predicate_encoding(F, F1),
+ write(Out, F1), write(Out, '_'), write(Out, A).
+
+% Predicate Encoding
+predicate_encoding(X, Y) :-
+ atom_codes(X, Chs0),
+ pred_encoding(Chs0, Chs, []),
+ atom_codes(Y, [95|Chs]).
+
+pred_encoding([]) --> !.
+pred_encoding([X|Xs]) -->
+ pred_encoding_char(X),
+ pred_encoding(Xs).
+
+pred_encoding_char(X) --> {97 =< X, X =< 122}, !, [X]. % a..z
+pred_encoding_char(X) --> {65 =< X, X =< 90}, !, [X]. % A..Z
+pred_encoding_char(X) --> {48 =< X, X =< 57}, !, [X]. % 0..9
+pred_encoding_char(95) --> !, [95]. % '_'
+pred_encoding_char(36) --> !, [36]. % '$' ???
+pred_encoding_char(X) --> {0 =< X, X =< 65535}, !,
+ [36], % '$'
+ pred_encoding_hex(X).
+pred_encoding_char(X) -->
+ {am2j_error([X,is,an,invalid,character,code]), fail}.
+
+pred_encoding_hex(X) -->
+ {int_to_hex(X, [], H)},
+ pred_encoding_hex_char(H).
+
+pred_encoding_hex_char([]) --> !, [48,48,48,48]. % 0000
+pred_encoding_hex_char([X]) --> !, [48,48,48, X]. % 000X
+pred_encoding_hex_char([X,Y]) --> !, [48,48, X, Y]. % 00XY
+pred_encoding_hex_char([X,Y,Z]) --> !, [48, X, Y, Z]. % 0XYZ
+pred_encoding_hex_char([X,Y,Z,W]) --> !, [ X, Y, Z, W]. % XYZW
+
+int_to_hex(0, H, H) :- !.
+int_to_hex(D, H0, H) :-
+ R is D mod 16,
+ D1 is D//16,
+ hex_map(R, R1),
+ int_to_hex(D1, [R1|H0], H).
+
+hex_map(10, 65) :- !. % 'A'
+hex_map(11, 66) :- !. % 'B'
+hex_map(12, 67) :- !. % 'C'
+hex_map(13, 68) :- !. % 'D'
+hex_map(14, 69) :- !. % 'E'
+hex_map(15, 70) :- !. % 'F'
+hex_map(X, Y) :- 0 =< X, X =< 9, number_codes(X, [Y]).
+
+% Constant Encoding (especially, escape sequence)
+constant_encoding(X, Y) :-
+ atom_codes(X, Chs0),
+ con_encoding(Chs0, Chs), %???
+ atom_codes(Y, Chs).
+
+con_encoding([], []) :- !.
+con_encoding([ 7|Xs], [92, 97|Ys]):- !, con_encoding(Xs, Ys). % \a
+con_encoding([ 8|Xs], [92, 98|Ys]):- !, con_encoding(Xs, Ys). % \b
+con_encoding([ 9|Xs], [92,116|Ys]):- !, con_encoding(Xs, Ys). % \t
+con_encoding([10|Xs], [92,110|Ys]):- !, con_encoding(Xs, Ys). % \n
+con_encoding([11|Xs], [92,118|Ys]):- !, con_encoding(Xs, Ys). % \v
+con_encoding([12|Xs], [92,102|Ys]):- !, con_encoding(Xs, Ys). % \f
+con_encoding([13|Xs], [92,114|Ys]):- !, con_encoding(Xs, Ys). % \r
+con_encoding([34|Xs], [92, 34|Ys]):- !, con_encoding(Xs, Ys). % \"
+con_encoding([39|Xs], [92, 39|Ys]):- !, con_encoding(Xs, Ys). % \'
+con_encoding([92|Xs], [92, 92|Ys]):- !, con_encoding(Xs, Ys). % \\
+con_encoding([X|Xs], [X|Ys]):- con_encoding(Xs, Ys).
+
+% Write Register name
+write_reg(X, _) :- var(X), !,
+ am2j_error([register,expression,must,not,be,unbound,variable]),
+ fail.
+write_reg(void, Out) :- !, write(Out, 'new VariableTerm(engine)').
+write_reg(ea(X), Out) :- !, write(Out, 'engine.aregs['), write(Out, X), write(Out, ']').
+write_reg(econt, Out) :- !, write(Out, 'engine.cont').
+write_reg(arg(X), Out) :- !, write(Out, arg), write(Out, X).
+write_reg(a(X), Out) :- !, write(Out, a), write(Out, X).
+write_reg(s(X), Out) :- !, write(Out, s), write(Out, X).
+write_reg(si(X), Out) :- !, write(Out, si), write(Out, X). % ???
+write_reg(sf(X), Out) :- !, write(Out, sf), write(Out, X). % ???
+write_reg(y(X), Out) :- !, write(Out, y), write(Out, X).
+write_reg(p(X), Out) :- !, write(Out, p), write(Out, X).
+write_reg(cont, Out) :- !, write(Out, cont).
+write_reg(null, Out) :- !, write(Out, null).
+% am2j only
+write_reg(args(X),Out) :- !, write(Out, 'args['), write(Out, X), write(Out, ']').
+write_reg(X, _) :-
+ am2j_error([X,is,an,invalid,register,expression]),
+ fail.
+
+write_reg_args([], _) :- !.
+write_reg_args([X], Out) :- !,
+ write_reg(X, Out).
+write_reg_args([X|Xs], Out) :-
+ write_reg(X, Out),
+ write(Out, ', '),
+ write_reg_args(Xs, Out).
+
+/*****************************************************************
+ WAM-BASED INTERMEDIATE INSTRUCTIONS
+
+Put Instructions
+================
++ put_var(X)
++ put_int(i, X)
++ put_float(f, X)
++ put_con(f/n, X)
++ put_con(c, X),
++ put_list(Xi, Xj, Xk)
++ put_str(Xi, Y, Xj)
++ put_str_args([Xi,..,Xn], Y)
++ put_clo(p:G, X)
+
+Get Instructions
+================
++ get_val(Xi, Xj)
++ get_int(i, Xi, Xj)
++ get_float(f, Xi, Xj)
++ get_con(c, Xi, Xj)
++ get_ground(g, Xi, Xj)
++ get_list(X)
++ get_str(f/n, Xi, Xj)
+
+Unify Instructions
+==================
++ unify_var(X)
++ unify_val(X)
++ unify_int(i, X)
++ unify_float(f, X)
++ unify_con(c, X)
++ unify_ground(g, X)
++ unify_void(i)
+
+Choice Instructions
+===================
++ try(Li, Lj)
++ retry(Li, Lj)
++ trust(L)
+
+Indexing Instructions
+=====================
++ switch_on_term(Lv, Li, Lf, Lc, Ls, Ll)
++ switch_on_hash(TAG, i, L, hashtable)
+
+Other Instructions
+==================
++ comment(Message)
++ debug(Message)
+
++ begin_predicate(f/n)
++ end_predicate(f/n)
+
++ package_name(p)
++ import_package(p)
++ import_package(p, f/n)
+
++ main(f/n, public): [Instructions]
++ main(f/n, non-public): [Instructions]
++ L: [Instructions]
+
++ label(L)
++ setB0
++ goto(L)
++ deref(Ri, Rj)
++ set(Ri, Rj)
+
++ decl_term_vars([R1,...,Rn])
++ decl_pred_vars([R1,...,Rn])
+
++ put_cont(p:BinG, C)
++ put_cont(BinG, C)
++ execute(p:BinG)
++ execute(BinG)
++ inline(G)
+
++ new_hash(TAG, i)
++ put_hash(X, L, TAG)
+
++ static([Instructions])
+
+Notation
+********
+ X ::= a(i) | S
+ Y ::= y(i) | S
+ S ::= s(i) | si(i) | sf(i)
+ L ::= f/n | f/n+i | f/n+TAG | f/n+TAG+i | f/n+TAG+i+i
+ TAG ::= var | int | flo | con | str | lis | top | sub | nil
+ BinG ::= C | f(A1,..,An, C)
+ G ::= f(A1,..,An)
+ A ::= void | X
+ C ::= cont | p(N)
+ R ::= cont | econt | a(i) | arg(i) | ea(i)
+
+*****************************************************************/
+
+/*****************************************************************
+ Utilities
+*****************************************************************/
+for(M, M, N) :- M =< N.
+for(I, M, N) :- M =< N, M1 is M + 1, for(I, M1, N).
+
+%%% print
+am2j_error(M) :- am2j_message(['***','AM2JAVA','ERROR'|M]).
+
+am2j_message([]) :- nl, flush_output(user_output).
+am2j_message([M|Ms]) :- write(M), write(' '), am2j_message(Ms).
+
+%%% list
+am2j_append([], Zs, Zs).
+am2j_append([X|Xs], Ys, [X|Zs]) :- am2j_append(Xs, Ys, Zs).
+
+flatten_list([]) --> !.
+flatten_list([L1|L2]) --> !, flatten_list(L1), flatten_list(L2).
+flatten_list(L) --> [L].
+
+list_to_string(List, String) :-
+ list_to_chars(List, Chars0),
+ flatten_list(Chars0, Chars, []),
+ atom_codes(String, Chars).
+
+list_to_chars([], []) :- !.
+list_to_chars([L|Ls], [C|Cs]) :- atom(L), !,
+ atom_codes(L, C),
+ list_to_chars(Ls, Cs).
+list_to_chars([L|Ls], [C|Cs]) :- number(L), !,
+ number_codes(L, C),
+ list_to_chars(Ls, Cs).
+
+% END
+% written by SICStus Prolog 3.12.8
diff --git a/src/compiler/am2j.txt b/src/compiler/am2j.txt
new file mode 100644
index 0000000..c028444
--- /dev/null
+++ b/src/compiler/am2j.txt
@@ -0,0 +1,117 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use strict;
+use Getopt::Long;
+
+# options
+my @optlist = ("h|help!","v|verbose!","d=s","J=s");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v, $opt_d, $opt_J);
+
+# -h option || check the number of arguments
+if ($opt_h || @ARGV != 1 ) {
+ usage();
+ exit 1;
+}
+
+# local variables
+my $echo = "/bin/echo";
+my $am_file = $ARGV[0];
+
+my %env;
+&init();
+
+# -d option
+if ($opt_d && (! -d $opt_d)) {
+ &error("directory $opt_d does not exist.");
+}
+
+# -J option
+if ($opt_J) {
+ if ($opt_J =~ /(-cp|-classpath)\s+/) {
+ &error("can not use $1 in -J option");
+ }
+ $env{"system_opts"} .= " $opt_J";
+}
+
+# main
+if (! -e $am_file) {
+ &error("file $am_file does not exist.");
+}
+
+my $arg;
+if ($env{"goal"}) {
+ $arg .= $env{"goal"} . " ";
+}
+$arg .= "[\'$am_file\'";
+if ($opt_d) { # check -d option
+ $arg .= ", \'$opt_d\'";
+}
+$arg .= "].";
+
+my $cmd = "$echo \"$arg\" | " . $env{"system"};
+if ($env{"system_opts"}) {
+ $cmd .= " " . $env{"system_opts"};
+}
+if ($env{"system_args"}) {
+ $cmd .= " " . $env{"system_args"};
+}
+if (! $opt_v) {# check -v option
+ $cmd .= " 2> /dev/null";
+}
+
+&message("{START translating $am_file --> Java}");
+&message($cmd);
+system($cmd) && error("translation fails");
+&message("{END translating $am_file --> Java}\n");
+
+exit 0;
+
+# sub
+sub usage {
+ print "\nUsage: $0 [-options] am_file\n";
+ print "\n where options include:\n";
+ print "\t-h -help : print this help message\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\t-d directory : set the destination directory for am_file.\n";
+ print "\t : The destination directory must already exist\n";
+ print "\t-J option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Virtual Machine\n";
+ print "\t : (ex. -J '-Xmx100m -verbose:gc')\n";
+ print "\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x: $0\n";
+ exit 1;
+}
+
+#sub init {
+# %env = (
+# "goal", "",
+# "system", "/Users/banbara/prog/plcafe/PrologCafe095/src/compiler/am2j.sav",
+# "system_opts", "",
+# "system_args", "",
+# );
+# %env = (
+# "goal", "load('/Users/banbara/prog/plcafe/PrologCafe095/src/compiler/pl2am.ql'), main. ",
+# "system", "sicstus",
+# "system_opts", "",
+# "system_args", "",
+# );
+# %env = (
+# "goal", "",
+# "system", "java",
+# "system_opts", "-cp \$PLCAFEDIR/plcafe.jar:\$CLASSPATH",
+# "system_args", "jp.ac.kobe_u.cs.prolog.lang.PrologMain jp.ac.kobe_u.cs.prolog.compiler.pl2am:main",
+# );
+#}
+
diff --git a/src/compiler/comp_pl b/src/compiler/comp_pl
new file mode 100755
index 0000000..38fbd2f
--- /dev/null
+++ b/src/compiler/comp_pl
@@ -0,0 +1,155 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use strict;
+use Getopt::Long;
+use File::Copy;
+
+# options
+my @optlist = ("h|help!","v|verbose!");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v);
+
+# -h option || check the number of arguments
+if ($opt_h || @ARGV < 2 || @ARGV > 4) {
+ usage();
+ exit 1;
+}
+
+# get arguments
+my $prolog_file = $ARGV[0];
+my $command_file = $ARGV[1];
+my $prolog = $ARGV[2];
+my $prolog_system = $ARGV[3];
+
+# check arguments
+if (! -e $prolog_file) {
+ &error("File $prolog_file does not exist");
+}
+
+if (! $prolog) {
+ $prolog = "prolog";
+}
+
+if (! $prolog_system) {
+ $prolog_system = "Unknown";
+}
+
+# main
+my $nosuffix = $prolog_file;
+$nosuffix =~ s/.pl$//g;
+my $cmd_temp = $nosuffix . ".txt";
+
+if ($prolog_system eq "SICStus" || $prolog_system eq "SWI-Prolog") { # SICStus or SWI-Prolog
+ my $wam;
+ my $dump;
+ my $goal;
+ my $goal2;
+ if ($prolog_system eq "SICStus") {
+ $wam = $nosuffix . ".ql";
+ $dump = $nosuffix . ".sav";
+ #$goal = "\"[operators], fcompile(\'$prolog_file\'), load(\'$wam\'), save_program(\'$dump\', main), halt.\"";
+ $goal = "\"[operators], fcompile([\'$prolog_file\',system]), load(\'$wam\'), load(system), save_program(\'$dump\', main), halt.\"";
+ $goal2 = "load(\'$wam\'), main.";
+ }
+ if ($prolog_system eq "SWI-Prolog") {
+ $wam = $nosuffix . ".qlf";
+ $dump = $nosuffix . ".qsav";
+# $goal = "\"[operators], qcompile(\'$prolog_file\'), load_files(\'$wam\'), qsave_program(\'$dump\', [goal=main]), halt.\"";
+ $goal = "\"[operators], qcompile([\'$prolog_file\',system]), load_files(\'$wam\'), load_files(system),qsave_program(\'$dump\', [goal=main]), halt.\"";
+ $goal2 = "load_files(\'$wam\'), main.";
+ }
+ &message("unlink $wam, $dump");
+ unlink $wam, $dump;
+ my $cmd = "echo $goal | $prolog";
+ if (! $opt_v) {# check -v option
+ $cmd .= " 2> /dev/null";
+ }
+ &message("making $wam, $dump");
+ &message($cmd);
+ system($cmd);
+ if (-e $dump) { # saving program succeeds
+ unlink $wam;
+ &message("making $command_file");
+ &mk_command($command_file, $cmd_temp, undef, $dump, undef, undef);
+ chmod 0755, $command_file;
+ exit 0;
+ } elsif (-e $wam) { # compilation succeeds, but saving program fails
+ &message("making $command_file");
+ &mk_command($command_file, $cmd_temp, $goal2, $prolog, undef, undef);
+ chmod 0755, $command_file;
+ exit 0;
+ } else {
+ &error("$0 fails");
+ }
+} elsif ($prolog_system eq "PrologCafe") {
+ my $file;
+ my $system_opts;
+ my $system_args;
+ # set $system_opts
+ #$system_opts = "-cp \\\$PLCAFEDIR/lang.jar:\\\$PLCAFEDIR/builtin.jar:\\\$PLCAFEDIR/compiler.jar";
+ $system_opts = "-cp \\\$PLCAFEDIR/plcafe.jar";
+ if ($prolog_file =~ m|.*/(.*).pl$|i) {
+ $file = $1;
+ } else {
+ &error("invalid prolog file found, $prolog_file");
+ }
+ # set $system_args
+ $system_args = "jp.ac.kobe_u.cs.prolog.lang.PrologMain jp.ac.kobe_u.cs.prolog.compiler.$file:main";
+ &message("making $command_file");
+ &mk_command($command_file, $cmd_temp, undef, $prolog, $system_opts, $system_args);
+ chmod 0755, $command_file;
+ exit 0;
+} else {
+ my $goal3 = "[\'$prolog_file\',system], main.";
+# my $goal3 = "[\'$prolog_file\'], main.";
+ &message("making $command_file");
+ &mk_command($command_file, $cmd_temp, $goal3, $prolog, undef, undef);
+ chmod 0755, $command_file;
+ exit 0;
+}
+
+exit 0;
+
+# sub
+sub usage {
+ print "\nUsage: $0 [-options] prolog_file command_file [prolog] [prolog_system]\n";
+ print "\n where options include:\n";
+ print "\t-h -help : print this help message\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\n where prolog is the command of Prolog system:\n";
+ print "\t(ex.) sicstus, pl, swipl, prolog...\n";
+ print "\n where prolog_system include:\n";
+ print "\tSICStus\n";
+ print "\tSWI-Prolog\n\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x\n";
+ exit(1);
+}
+
+sub mk_command {
+ my ($command_file, $command_temp, @val) = @_;
+ my @key = ("goal", "system", "system_opts", "system_args");
+ copy($command_temp, $command_file) || &error("can not copy $command_temp to $command_file");
+ open(OUT, ">>$command_file") || &error("can not open $command_file");
+ print OUT "sub init {\n";
+ print OUT "\t%env = (\n";
+ for (my $i=0; $i < scalar(@key); $i++) {
+ next if (! $val[$i]);
+ print OUT "\t\t\"$key[$i]\", \"$val[$i]\",\n";
+ }
+ print OUT "\t)\n";
+ print OUT "}\n";
+ close(OUT) || &error("can not close $command_file");
+}
+
+
diff --git a/src/compiler/operators.pl b/src/compiler/operators.pl
new file mode 100644
index 0000000..7c445d8
--- /dev/null
+++ b/src/compiler/operators.pl
@@ -0,0 +1,15 @@
+:- op(1170, xfx, (:-)).
+:- op(1170, xfx, (-->)).
+:- op(1170, fx, (:-)).
+:- op(1170, fx, (?-)).
+:- op( 500, yfx, (#)).
+:- op(1150, fx, (dynamic)).
+:- op(1150, fx, (meta_predicate)).
+:- op(1150, fx, (package)).
+:- op(1150, fx, (public)).
+:- op(1150, fx, (import)).
+:- op(1150, fx, (mode)).
+:- op(1150, fx, (multifile)).
+:- op(1150, fx, (block)).
+
+
diff --git a/src/compiler/package.html b/src/compiler/package.html
new file mode 100644
index 0000000..e4d7ae0
--- /dev/null
+++ b/src/compiler/package.html
@@ -0,0 +1,10 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP">
+<title></title>
+</head>
+<body bgcolor="#ffffff">
+Provides classes for translating Prolog files into Java files.
+</body>
+</html>
diff --git a/src/compiler/pl2am.pl b/src/compiler/pl2am.pl
new file mode 100644
index 0000000..24dc866
--- /dev/null
+++ b/src/compiler/pl2am.pl
@@ -0,0 +1,1800 @@
+/*****************************************************************
+Time-stamp: <2008-10-29 10:41:19 banbara>
+
+NAME
+ pl2am: Translating Prolog into WAM-based Intermediate Code
+
+USAGE
+ # sicstus
+ ?- [pl2am].
+ ?- pl2am([File1, File2, [Op1,..,OpN]]).
+
+PARAMETERS
+ File1 is an input prolog file name.
+ File2 is an output file name.
+ Op ::= ed | ac | ie | rc | idx | clo
+ ed : eliminate disjunctions
+ ac : arithmetic compilation
+ ie : inline expansion
+ rc : optimise recursive call
+ idx: switch_on_hash (2nd. level indexing)
+ clo: generate closure for meta predicates
+
+DESCRIPTION
+ This program translates Prolog program into WAM-based intermediate codes.
+ Generated codes can be translated into Java program by using am2j.pl,
+ and then compiled and executed by usual java utilities
+ with the Prolog Cafe runtime system.
+
+COPYRIGHT
+ pl2am (Translating Prolog into WAM-based Intermediate Code)
+ Copyright (C) 1997-2008 by
+ Mutsunori Banbara (banbara@kobe-u.ac.jp) and
+ Naoyuki Tamura (tamura@kobe-u.ac.jp)
+
+SEE ALSO
+ http://kaminari.istc.kobe-u.ac.jp/PrologCafe/
+*****************************************************************/
+
+/*****************************************************************
+ WAM-BASED INTERMEDIATE INSTRUCTIONS
+
+Put Instructions
+================
+ put_var(X)
+ put_int(i, X)
+ put_float(f, X)
+ put_con(f/n, X)
+ put_con(c, X),
+ put_list(Xi, Xj, Xk)
+ put_str(Xi, Y, Xj)
+ put_str_args([Xi,..,Xn], Y)
+ put_clo(p:G, X)
+ put_cont(p:BinG, C)
+ put_cont(BinG, C)
+
+Get Instructions
+================
+ get_val(Xi, Xj)
+ get_int(i, Xi, Xj)
+ get_float(f, Xi, Xj)
+ get_con(c, Xi, Xj)
+ get_ground(g, Xi, Xj)
+ get_list(X)
+ get_str(f/n, Xi, Xj)
+
+Unify Instructions
+==================
+ unify_var(X)
+ unify_val(X)
+ unify_int(i, X)
+ unify_float(f, X)
+ unify_con(c, X)
+ unify_ground(g, X)
+ unify_void(i)
+
+Choice Instructions
+===================
+ try(Li, Lj)
+ retry(Li, Lj)
+ trust(L)
+
+Indexing Instructions
+=====================
+ switch_on_term(Lv, Li, Lf, Lc, Ls, Ll)
+ switch_on_hash(TAG, i, L, hashtable)
+
+Control Instructions
+====================
+ execute(p:BinG)
+ execute(BinG)
+ inline(G)
+ '$INSERT'(ListOfAtom)
+
+Other Instructions
+==================
+ (:- G)
+
+ comment(Message)
+ debug(Message)
+ info(Message)
+
+ begin_predicate(f/n)
+ end_predicate(f/n)
+
+ package_name(p)
+ import_package(p)
+ import_package(p, f/n)
+
+ main(f/n, public): [Instructions]
+ main(f/n, non-public): [Instructions]
+ L: [Instructions]
+
+ label(L)
+ deref(Ri, Rj)
+ set(Ri, Rj)
+ setB0
+ goto(L)
+
+ decl_term_vars([R1,...,Rn])
+ decl_pred_vars([R1,...,Rn])
+
+ new_hash(TAG, i)
+ put_hash(X, L, TAG)
+
+ static([Instructions])
+
+Notation
+********
+ X ::= a(i) | S
+ Y ::= y(i) | S
+ S ::= s(i) | si(i) | sf(i)
+ L ::= f/n | f/n+i | f/n+TAG | f/n+TAG+i | f/n+TAG+i+i
+ TAG ::= var | int | flo | con | str | lis | top | sub | nil
+ BinG ::= C | f(A1,..,An, C)
+ G ::= f(A1,..,An)
+ A ::= void | X
+ C ::= cont | p(N)
+ R ::= cont | econt | a(i) | arg(i) | ea(i)
+
+*****************************************************************/
+
+/*****************************************************************
+ Declarations
+*****************************************************************/
+:- op(1170, xfx, (:-)).
+:- op(1170, xfx, (-->)).
+:- op(1170, fx, (:-)).
+:- op(1170, fx, (?-)).
+:- op( 500, yfx, (#)).
+
+:- op(1150, fx, (dynamic)).
+:- op(1150, fx, (meta_predicate)).
+:- op(1150, fx, (package)). % Prolog Cafe specific
+:- op(1150, fx, (public)).
+:- op(1150, fx, (import)). % Prolog Cafe specific
+:- op(1150, fx, (mode)).
+:- op(1150, fx, (multifile)).
+:- op(1150, fx, (block)).
+
+:- dynamic internal_clause/2.
+:- dynamic internal_predicates/2.
+:- dynamic dynamic_predicates/2.
+:- dynamic meta_predicates/3.
+:- dynamic package_name/1.
+:- dynamic public_predicates/2.
+:- dynamic import_package/2.
+:- dynamic internal_declarations/1.
+:- dynamic file_name/1.
+:- dynamic dummy_clause_counter/1.
+:- dynamic pl2am_flag/1.
+:- dynamic fail_flag/0. % used for generating label(fail/0) or not
+
+% :- module('jp.ac.kobe_u.cs.prolog.compiler.pl2am', [main/0,pl2am/1]).
+package(_).
+:- package 'jp.ac.kobe_u.cs.prolog.compiler.pl2am'.
+
+:- public main/0, pl2am/1.
+/*****************************************************************
+ Main
+*****************************************************************/
+main :-
+ read(X),
+ pl2am(X).
+
+pl2am([PrologFile, AsmFile, Opts]) :-
+ read_in_program(PrologFile, Opts),
+ open(AsmFile, write, Out),
+ compile_all_predicates(Out),
+ close(Out).
+pl2am(_).
+
+/*****************************************************************
+ Read in Program
+*****************************************************************/
+read_in_program(File, Opts) :-
+ pl2am_preread(File, Opts),
+ open(File, read, In),
+ repeat,
+ read(In, X),
+ assert_clause(X),
+ X == end_of_file,
+ !,
+ close(In),
+ pl2am_postread.
+
+%%% Pre-init
+pl2am_preread(File, Opts) :-
+ retractall(internal_clause(_,_)),
+ retractall(internal_predicates(_,_)),
+ retractall(dynamic_predicates(_,_)),
+ retractall(meta_predicates(_,_,_)),
+ retractall(package_name(_)),
+ retractall(public_predicates(_,_)),
+ retractall(import_package(_,_)),
+ retractall(internal_declarations(_)),
+ retractall(file_name(_)),
+ retractall(dummy_clause_counter(_)),
+ retractall(pl2am_flag(_)),
+ retractall(fail_flag),
+ assert(file_name(File)),
+ assert(dummy_clause_counter(0)),
+ assert_compile_opts(Opts),
+ assert_default_decls.
+
+assert_default_decls :-
+ builtin_meta_predicates(Pred, Arity, Mode),
+ assert(meta_predicates(Pred, Arity, Mode)),
+ fail.
+assert_default_decls.
+
+assert_compile_opts([]) :- !.
+assert_compile_opts([O|Os]) :-
+ assert_copts(O),
+ assert_compile_opts(Os).
+
+assert_copts(O) :-
+ clause(pl2am_flag(O), _),
+ !.
+assert_copts(O) :-
+ copt_expr(O),
+ !,
+ assert(pl2am_flag(O)).
+assert_copts(O) :-
+ pl2am_error([O,is,an,invalid,option,for,pl2am]),
+ fail.
+
+copt_expr(ed).
+copt_expr(ac).
+copt_expr(ie).
+copt_expr(rc).
+copt_expr(rc(_,_)).
+copt_expr(idx).
+copt_expr(clo).
+
+%%% Post-init
+pl2am_postread :-
+ assert_import('jp.ac.kobe_u.cs.prolog.lang'),
+ assert_import('jp.ac.kobe_u.cs.prolog.builtin'),
+ assert_dummy_package,
+ assert_dummy_public.
+
+assert_dummy_package :-
+ clause(package_name(_), _),
+ !.
+assert_dummy_package :-
+ assert(package_name(user)).
+
+assert_dummy_public :-
+ clause(public_predicates(_,_), _),
+ !.
+assert_dummy_public :-
+ assert(public_predicates(_,_)).
+
+%%% Assert Clauses
+assert_clause(end_of_file) :- !.
+assert_clause((:- dynamic G)) :- !,
+ conj_to_list(G, G1),
+ assert_dynamic_predicates(G1).
+assert_clause((:- module(M, PList))) :- !,
+ assert_package(M),
+ assert_public_predicates(PList).
+assert_clause((:- meta_predicate G)) :- !,
+ conj_to_list(G, G1),
+ assert_meta_predicates(G1).
+assert_clause((:- package G)) :- !,
+ assert_package(G).
+assert_clause((:- public G)) :- !,
+ conj_to_list(G, G1),
+ assert_public_predicates(G1).
+assert_clause((:- import G)) :- !,
+ assert_import(G).
+assert_clause((:- mode _G)) :- !,
+ pl2am_message(['*** WARNING',mode,declaration,is,not,supported,yet]).
+assert_clause((:- multifile _G)) :- !,
+ pl2am_message(['*** WARNING',multifile,declaration,is,not,supported,yet]).
+assert_clause((:- block _G)) :- !,
+ pl2am_message(['*** WARNING',block,declaration,is,not,supported,yet]).
+assert_clause((:- G)) :- !,
+ call(G),
+ assert_declarations(G).
+assert_clause(Clause) :-
+ preprocess(Clause, Cl),
+ assert_cls(Cl).
+
+%%% Dynamic Declaration
+assert_dynamic_predicates([]) :- !.
+assert_dynamic_predicates([G|Gs]) :-
+ assert_dynamic(G),
+ assert_dynamic_predicates(Gs).
+
+assert_dynamic(G) :-
+ \+ clause(package_name('jp.ac.kobe_u.cs.prolog.builtin'), _),
+ G = F/A,
+ functor(Head, F, A),
+ system_predicate(Head),
+ !,
+ pl2am_error([can,not,redefine,builtin,predicate,F/A]),
+ fail.
+assert_dynamic(G) :-
+ G = F/A,
+ clause(dynamic_predicates(F,A), _), !.
+assert_dynamic(G) :-
+ G = F/A,
+ assert(dynamic_predicates(F,A)), !.
+assert_dynamic(G) :-
+ pl2am_error([G,is,an,invalid,dynamic,declaration]),
+ fail.
+
+%%% Meta Predicates Declaration
+assert_meta_predicates([]) :- !.
+assert_meta_predicates([G|Gs]) :-
+ assert_meta(G),
+ assert_meta_predicates(Gs).
+
+assert_meta(G) :-
+ functor(G, F, A),
+ clause(meta_predicates(F, A, _), _),
+ !.
+assert_meta(G) :-
+ functor(G, F, A),
+ G =.. [_|M],
+ mode_expr(M),
+ !,
+ assert(meta_predicates(F, A, M)).
+assert_meta(G) :-
+ pl2am_error([G,is,an,invalid,meta_predicate,declaration]),
+ fail.
+
+%%% Package Declaration
+assert_package(G) :-
+ clause(package_name(G1), _),
+ G \== G1,
+ !,
+ pl2am_error([duplicate,package,declarations,:,G1,and,G]),
+ fail.
+assert_package(G) :-
+ atom(G),
+ !,
+ assert(package_name(G)),
+ retractall(import_package(G, _)).
+assert_package(G) :-
+ pl2am_error([G,is,invalid,package,declaration]),
+ fail.
+
+%%% Public Declaration
+assert_public_predicates([]) :- !.
+assert_public_predicates([G|Gs]) :-
+ assert_public(G),
+ assert_public_predicates(Gs).
+
+assert_public(F/A) :-
+ predspec_expr(F/A),
+ clause(public_predicates(F, A), _),
+ !.
+assert_public(F/A) :-
+ predspec_expr(F/A),
+ assert(public_predicates(F, A)).
+
+%%% Import Declaration
+assert_import(G) :-
+ atom(G),
+ !,
+ assert_impt(G, (*)).
+assert_import(M:P) :-
+ atom(M),
+ (predspec_expr(P) ; atom(P)),
+ !,
+ assert_impt(M, P).
+assert_import(G) :-
+ pl2am_error([G,is,invalid,import,declaration]),
+ fail.
+
+assert_impt(M, _P) :-
+ clause(package_name(M), _),
+ !.
+assert_impt(M, P) :-
+ clause(import_package(M, P0), _),
+ (P0 == (*) ; P0 == P),
+ !.
+assert_impt(M, P) :-
+ assert(import_package(M, P)).
+
+%%% Assert Declaration (:- G)
+assert_declarations(G) :-
+ clause(internal_declarations(G), _),
+ !.
+assert_declarations(G) :-
+ assert(internal_declarations(G)).
+
+%%% Assert Cluase
+assert_cls((Head :- Body)) :- !,
+ assert_predicate(Head),
+ assert(internal_clause(Head, Body)).
+assert_cls(Head) :- !,
+ assert_predicate(Head),
+ assert(internal_clause(Head, true)).
+
+assert_predicate(Head) :-
+ \+ clause(package_name('jp.ac.kobe_u.cs.prolog.builtin'), _),
+ system_predicate(Head),
+ !,
+ functor(Head, Functor, Arity),
+ pl2am_error([can,not,redefine,builtin,predicate,Functor/Arity]),
+ fail.
+assert_predicate(Head) :-
+ functor(Head, Functor, Arity),
+ clause(internal_predicates(Functor, Arity), _),
+ !.
+assert_predicate(Head) :-
+ functor(Head, Functor, Arity),
+ assert(internal_predicates(Functor, Arity)).
+
+%%% Preprocess
+preprocess(Cl0, Cl) :-
+ clause(pl2am_flag(ed), _),
+ !,
+ expand_term(Cl0, Cl1),
+ eliminate_disjunction(Cl1, Cl).
+preprocess(Cl0, Cl) :-
+ expand_term(Cl0, Cl).
+
+eliminate_disjunction(Cl0, Cl) :-
+ eliminate_disj(Cl0, Cl, DummyCls),
+ assert_dummy_clauses(DummyCls).
+
+assert_dummy_clauses([]) :- !.
+assert_dummy_clauses([C|Cs]) :-
+ assert_clause(C),
+ assert_dummy_clauses(Cs).
+
+/*****************************************************************
+ Compile Prolog Program
+*****************************************************************/
+compile_all_predicates(Out) :- % output declarations (ex. op/3)
+ clause(internal_declarations(G), _),
+ writeq(Out, (:- G)), write(Out, '.'), nl(Out),
+ fail.
+compile_all_predicates(_) :- % treat dynamic declaration
+ findall(Functor/Arity, dynamic_predicates(Functor, Arity), PredSpecs),
+ assert_init_clauses(PredSpecs),
+ fail.
+compile_all_predicates(Out) :- % compile predicate
+ clause(internal_predicates(Functor, Arity), _),
+ compile_predicate(Functor, Arity, Instructions, []),
+ write_asm(Out, Instructions),
+ nl(Out),
+ fail.
+compile_all_predicates(Out):- nl(Out).
+
+write_asm(_, []) :- !.
+write_asm(Out, [Instruction|Instructions]) :- !,
+ write_asm(Out, Instruction),
+ write_asm(Out, Instructions).
+write_asm(Out, begin_predicate(FA)) :- !,
+ writeq(Out, begin_predicate(FA)), write(Out, '.'), nl(Out).
+write_asm(Out, end_predicate(FA)) :- !,
+ writeq(Out, end_predicate(FA)), write(Out, '.'), nl(Out).
+write_asm(Out, comment(Comment0)) :- !,
+ copy_term(Comment0, Comment),
+ numbervars(Comment, 0, _),
+ tab(Out, 8), writeq(Out, comment(Comment)), write(Out, '.'), nl(Out).
+write_asm(Out, (Label: Instruction)) :- !,
+ writeq(Out, Label), write(Out, ' :'), nl(Out),
+ write_asm(Out, Instruction).
+write_asm(Out, Instruction) :-
+ tab(Out, 8), writeq(Out, Instruction), write(Out, '.'), nl(Out).
+
+/****************************************************************
+ Treat Dynamic Declaration
+****************************************************************/
+assert_init_clauses([]) :- !.
+assert_init_clauses(PredSpecs) :-
+ collect_init_cls(PredSpecs, Cls),
+ assert_init_cls(Cls),
+ !.
+
+collect_init_cls([], []) :- !.
+collect_init_cls([F/A|FAs], [Cls|Cls1]) :-
+ clause(internal_predicates(F,A), _),
+ !,
+ functor(Head, F, A),
+ findall(assertz((Head :- Body)), internal_clause(Head, Body), Cls),
+ retractall(internal_predicates(F,A)),
+ retractall(internal_clause(Head, _)),
+ collect_init_cls(FAs, Cls1).
+%collect_init_cls([FA|FAs], [hash_put(P,FA,[])|Cls]) :-
+collect_init_cls([FA|FAs], ['$new_indexing_hash'(P,FA,_)|Cls]) :-
+ clause(package_name(P), _),
+ !,
+ collect_init_cls(FAs, Cls).
+
+assert_init_cls([]) :- !.
+assert_init_cls(Cls) :-
+ list_to_conj(Cls, Body),
+ assert_clause(('$init' :- Body)).
+
+/****************************************************************
+ Compile Predicate
+****************************************************************/
+compile_predicate(Functor, Arity) -->
+ {functor(Head, Functor, Arity)},
+ {findall((Head :- Body), internal_clause(Head, Body), Clauses)},
+ [begin_predicate(Functor/Arity)],
+ generate_package,
+ generate_import,
+ generate_info(Functor, Arity),
+ compile_pred(Clauses, Functor/Arity),
+ [end_predicate(Functor/Arity)].
+
+%%% Program Code
+compile_pred([], _) --> [], !.
+compile_pred([Clause], FA) --> !,
+ {check_modifier(FA, MF)}, % checks public or non-public
+ [main(FA, MF): []],
+ [PutGroundTerm], % generates put instructions of ground terms
+ [FA: []],
+ [comment(Clause)],
+ [setB0], % set B0 register for cut
+ [DeclLocalVars], % generates the declarations of local variables
+ {FA = _/A},
+ set_arguments(1, A, arg, a, set), % set arg(N) to a(N).
+ {GTI0 = [1,[],[]]}, % GTI0 = [SN,SAlloc,PutGroundTerm]
+ compile_clause(Clause, GTI0, GTI, LTI),
+ {GTI = [_,_,PutGroundTerm0], pl2am_rev(PutGroundTerm0, PutGroundTerm)},
+ {LTI = [XN,_,PN|_], generate_var_decl([1,1], [XN,PN], DeclLocalVars, [])}.
+compile_pred(Clauses, FA) -->
+ {check_modifier(FA, MF)}, % checks public or non-public
+ [main(FA,MF): []],
+ [PutGroundTerm], % generates ground terms
+ [OPT1],
+ [PutLabel], % generates label declarations
+ [NewHash], % generates new_hash
+ [PutHash], % generates pub_hash
+ %
+ [FA: []],
+ {FA = Functor/Arity},
+ set_arguments(1, Arity, arg, ea, set), % set arg(N) to engine.areg(N)
+ [set(cont, econt)], % set cont to engine.cont
+ [OPT2],
+ [OPT3],
+ [setB0], % set B0 register for cut
+ generate_switch(Clauses, FA, GLI), % generates control and indexing instructions.
+ {GTI0 = [1,[],[]]}, % GTI0 = [SN,SAlloc,PutGroundTerm]
+ compile_pred2(Clauses, FA, 1, GTI0, GTI),
+ %
+ {GTI = [_,SAlloc,PutGroundTerm0], pl2am_rev(PutGroundTerm0, PutGroundTerm)},
+ {GLI = [PutLabel, Hash0]},
+ % replace the hash key with s(i), si(i), or sf(i)
+ {replace_hash_keys(Hash0, SAlloc, NewHash, PutHash0)},
+ {PutHash0 == [] -> PutHash = [] ; PutHash = static(PutHash0)},
+ % generate code for the recursize call optimization
+ {clause(pl2am_flag(rc(Functor,Arity)), _) ->
+ OPT1 = label(FA+top), OPT2 = goto(FA+top), OPT3 = FA+top: []
+ ;
+ OPT1 = [], OPT2 = [], OPT3 = []
+ }.
+
+compile_pred2([], _, _, GTI, GTI) --> !.
+compile_pred2([Clause|Clauses], FA, N, GTI0, GTI) -->
+ [FA+N: []],
+ [comment(Clause)],
+ [DeclLocalVars], % generates the declarations of local variables
+ [decl_pred_vars([cont])],
+ {FA = _/Arity},
+ set_arguments(1, Arity, ea, a, set), % set engine.areg(N) to a(N).
+ [set(econt, cont)], % set engine.cont to cont
+ compile_clause(Clause, GTI0, GTI1, LTI),
+ {N1 is N + 1},
+ compile_pred2(Clauses, FA, N1, GTI1, GTI),
+ {LTI = [XN,_,PN|_], generate_var_decl([1,1], [XN,PN], DeclLocalVars, [])}.
+
+%%% Control and Indexing instructions
+generate_switch(Clauses, FA, [Label, Hash]) -->
+ % generates try, retry, trust, switch_on_term, and switch_on_hash
+ {generate_switch0(Clauses, FA, Instrs, [])},
+ % generates sub-labels for BP
+ generate_bp_label(Instrs, FA+sub, 1, Ls0, SWTs),
+ % generates fail label (fail_flag may be asserted by generate_switch0/4)
+ {(retract(fail_flag) -> Ls1 = [label(fail/0)|Ls0] ; Ls1 = Ls0)},
+ % generates labels for clauses
+ {length(Clauses, N)},
+ {generate_cl_label(FA, 1, N, Ls2)},
+ {pl2am_append(Ls1, Ls2, Label)},
+ % generates new_hash and put_hash instructions for switch_on_hash
+ {gen_hash(SWTs, Hash, [])}.
+
+generate_switch0(Clauses, FA) -->
+ {get_indices(Clauses, FA, 1, Is)},
+ generate_switch1(Is, FA).
+
+%%% 1st. Indexing
+generate_switch1(Is, FA) -->
+ {FA = _/0},
+ !,
+ generate_tries(Is).
+generate_switch1(Is, _) -->
+ {all_variable_indices(Is)},
+ !,
+ generate_tries(Is).
+generate_switch1(Is, FA) -->
+ [switch_on_term(LV,LI,LF,LC,LS,LL)],
+ generate_sw(Is, FA, var, LV, [], PIs0),
+ generate_sw(Is, FA, int, LI, PIs0, PIs1),
+ generate_sw(Is, FA, flo, LF, PIs1, PIs2),
+ generate_sw(Is, FA, con, LC, PIs2, PIs3),
+ generate_sw(Is, FA, str, LS, PIs3, PIs4),
+ generate_sw(Is, FA, lis, LL, PIs4, _).
+
+generate_sw(Is, FA, Tag, L, PIs0, PIs) -->
+ {select_indices(Is, Tag, Is1)},
+ generate_sw1(Is1, FA, Tag, L, PIs0, PIs).
+
+%%% 2nd. Indexing
+generate_sw1([], _, _, fail/0, PIs, PIs) --> !, {assert_fail}.
+generate_sw1([I], _, _, L, PIs, PIs) --> !, {I = [L|_]}.
+generate_sw1(Is, FA, Tag, L, PIs0, PIs) -->
+ {no_switch_on_hash(Is, Tag)},
+ !,
+ generate_sw2(Is, FA, Tag, L, PIs0, PIs).
+generate_sw1(Is, FA, Tag, FA+Tag, PIs0, PIs) -->
+ generate_sw(Is, FA, nil, L, PIs0, PIs),
+ {count_unique_hash(Is, Size, Keys)},
+ [FA+Tag: switch_on_hash(Tag, Size, L, HT)],
+ {generate_hash_table(Keys, Is, LIs)},
+ generate_hash_tries(LIs, FA+Tag, 0, HT).
+
+no_switch_on_hash(Is, Tag) :-
+ clause(pl2am_flag(idx), _),
+ !,
+ (Tag = var ; Tag = lis ; Tag = nil ; count_unique_hash(Is, C, _), C < 2).
+no_switch_on_hash(_, _).
+
+generate_sw2(Is, _, _, L, PIs, PIs) -->
+ {pl2am_member((L,Is), PIs)},
+ !.
+generate_sw2(Is, FA, Tag, FA+Tag, PIs0, [(FA+Tag,Is)|PIs0]) -->
+ [FA+Tag: []],
+ generate_tries(Is).
+
+generate_hash_tries([], _, _, []) --> !.
+generate_hash_tries([K:[]|LIs], L0, N, [K:fail/0|Ls]) --> !,
+ {assert_fail},
+ generate_hash_tries(LIs, L0, N, Ls).
+generate_hash_tries([K:[I]|LIs], L0, N, [K:L|Ls]) --> !,
+ {I = [L|_]},
+ generate_hash_tries(LIs, L0, N, Ls).
+generate_hash_tries([K:Is|LIs], L0, N, [K:L0+N|Ls]) -->
+ [L0+N: []],
+ generate_tries(Is),
+ {N1 is N + 1},
+ generate_hash_tries(LIs, L0, N1, Ls).
+
+generate_hash_table([], _, []) :- !.
+generate_hash_table([K|Ks], Is0, [K:Is|LIs]) :-
+ select_hash(Is0, K, Is),
+ generate_hash_table(Ks, Is0, LIs).
+
+select_hash([], _, []).
+select_hash([I|Is0], K, [I|Is]) :-
+ I = [_,_,Tag,Hash],
+ (Tag = var ; K = Hash),
+ !,
+ select_hash(Is0, K, Is).
+select_hash([_|Is0], K, Is) :-
+ select_hash(Is0, K, Is).
+
+%%% Choice Point (try, retry, trust)
+generate_tries([I|Is]) -->
+ {I = [L|_]},
+ [try(L)],
+ generate_tries1(Is).
+
+generate_tries1([I]) --> !,
+ {I = [L|_]},
+ [trust(L)].
+generate_tries1([I|Is]) -->
+ {I = [L|_]},
+ [retry(L)],
+ generate_tries1(Is).
+
+get_indices([], _, _, []).
+get_indices([_|Clauses], FA, N, [[FA+N]|Is]) :-
+ FA = _/0,
+ !,
+ N1 is N + 1,
+ get_indices(Clauses, FA, N1, Is).
+get_indices([Clause|Clauses], FA, N, [[FA+N,A1,Tag,Hash]|Is]) :-
+ Clause = (Head :- _),
+ arg(1, Head, A1),
+ get_hash(A1, Tag, Hash),
+ N1 is N + 1,
+ get_indices(Clauses, FA, N1, Is).
+
+get_hash(X, var, 0) :- var(X), !.
+get_hash(X, int, X) :- integer(X), !.
+get_hash(X, flo, X) :- float(X), !.
+get_hash(X, con, X) :- atom(X), !.
+get_hash(X, lis, '.'/2) :- X = [_|_], !.
+get_hash(X, str, F/A) :- functor(X, F, A), !.
+
+all_variable_indices([]).
+all_variable_indices([[_,_,var,_]|Is]) :-
+ all_variable_indices(Is).
+
+count_unique_hash([], 0, []).
+count_unique_hash([I|Is], C, K) :-
+ count_unique_hash(Is, C0, K0),
+ I = [_,_,Tag,Hash],
+ ((Tag = var ; pl2am_member([_,_,_,Hash], Is)) ->
+ C = C0, K = K0
+ ;
+ C is C0 + 1, K = [Hash|K0]
+ ).
+
+select_indices([], _, []).
+select_indices([I|Is0], Tag, [I|Is]) :-
+ I = [_,_,T|_],
+ (Tag = var ; Tag = T ; T = var),
+ !,
+ select_indices(Is0, Tag, Is).
+select_indices([_|Is0], Tag, Is) :-
+ select_indices(Is0, Tag, Is).
+
+%%% Assert Fail Flag
+assert_fail:- clause(fail_flag, _), !.
+assert_fail:- assert(fail_flag).
+
+%%% Generate Labels for Backtrack Point
+generate_bp_label([], _, _, [], []) --> !.
+generate_bp_label([X|Xs], CL, N, Ls, [X|Hs]) -->
+ {X = switch_on_hash(_,_,_,_)},
+ !,
+ [X],
+ generate_bp_label(Xs, CL, N, Ls, Hs).
+generate_bp_label([try(L)|Xs], CL, N, [label(CL+N)|Ls], Hs) --> !,
+ [try(L, CL+N)],
+ [CL+N: []],
+ {N1 is N+1},
+ generate_bp_label(Xs, CL, N1, Ls, Hs).
+generate_bp_label([retry(L)|Xs], CL, N, [label(CL+N)|Ls], Hs) --> !,
+ [retry(L, CL+N)],
+ [CL+N: []],
+ {N1 is N+1},
+ generate_bp_label(Xs, CL, N1, Ls, Hs).
+generate_bp_label([(L:X)|Xs], _, _, [label(L)|Ls], Hs) --> !,
+ [L: []],
+ generate_bp_label([X|Xs], L, 1, Ls, Hs).
+generate_bp_label([X|Xs], CL, N, Ls, Hs) -->
+ [X],
+ generate_bp_label(Xs, CL, N, Ls, Hs).
+
+generate_cl_label(_, I, N, []) :-
+ I > N,
+ !.
+generate_cl_label(FA, I, N, [label(FA+I)|Ls]) :-
+ I1 is I+1,
+ generate_cl_label(FA, I1, N, Ls).
+
+%%% Generate Hash instructions for switch_on_hash
+gen_hash([]) --> !.
+gen_hash([switch_on_hash(T,S,_,H)|Xs]) --> !,
+ [new_hash(T,S)],
+ gen_put_hash(H, T),
+ gen_hash(Xs).
+
+gen_put_hash([], _) --> !.
+gen_put_hash([K:V|Xs], T) -->
+ [put_hash(K, V, T)],
+ gen_put_hash(Xs, T).
+
+replace_hash_keys([], _, [], []) :- !.
+replace_hash_keys([put_hash(K,L,H)|Xs], SA, NHs, [put_hash(X,L,H)|PHs]) :- !,
+ replace_key(K, SA, X),
+ replace_hash_keys(Xs, SA, NHs, PHs).
+replace_hash_keys([X|Xs], SA, [X|NHs], PHs) :-
+ replace_hash_keys(Xs, SA, NHs, PHs).
+
+replace_key(K, Alloc, X) :-
+ integer(K),
+ allocated(Alloc, K:int, [X,yes]),
+ !.
+replace_key(K, Alloc, X) :-
+ float(K),
+ allocated(Alloc, K:flo, [X,yes]),
+ !.
+replace_key(K, Alloc, X) :-
+ atom(K),
+ allocated(Alloc, K:con, [X,yes]),
+ !.
+replace_key(K, Alloc, X) :-
+ nonvar(K),
+ K = F/A,
+ atom(F),
+ integer(A),
+ allocated(Alloc, K:con, [X,yes]),
+ !.
+replace_key(K, _, _) :-
+ pl2am_error([replacement,of,hash,key,K,failed]),
+ fail.
+
+%%% Package and Import Declarations
+generate_package -->
+ {clause(package_name(P), _)},
+ [package_name(P)].
+
+generate_import -->
+ {findall((P,C), import_package(P, C), X)},
+ gen_import(X).
+
+gen_import([]) --> !.
+gen_import([(P,'*')|Xs]) --> !,
+ [import_package(P)],
+ gen_import(Xs).
+gen_import([(P,C)|Xs]) -->
+ [import_package(P, C)],
+ gen_import(Xs).
+
+%%% Information
+generate_info(Functor, Arity) -->
+ {clause(file_name(File), _)},
+ [info([Functor/Arity, File])].
+
+%%% Check the Modifier of Predicate F/A.
+check_modifier('$init'/0, public) :- !.
+check_modifier(F/A, public) :-
+ clause(public_predicates(F, A), _),
+ !.
+check_modifier(_, non-public).
+
+%%% generate a list of registers with given range.
+range_reg(I, N, _, []) :- I > N, !.
+range_reg(I, N, A, [R|Rs]) :-
+ I =< N,
+ I1 is I+1,
+ R =.. [A, I],
+ range_reg(I1, N, A, Rs).
+
+%%% generate set instructions
+gen_set([], []) --> !.
+gen_set([X|Xs], [Y|Ys]) --> [set(X, Y)], gen_set(Xs, Ys).
+
+%%% generate deref instructions
+gen_deref([], []) --> !.
+gen_deref([X|Xs], [Y|Ys]) --> [deref(X, Y)], gen_deref(Xs, Ys).
+
+%%% generate set and deref instructions
+set_arguments(SN, EN, R1, R2, Flag) -->
+ {range_reg(SN, EN, R1, L1)},
+ {range_reg(SN, EN, R2, L2)},
+ gen_set_arg(Flag, L1, L2).
+
+gen_set_arg(set, L1, L2) --> gen_set(L1, L2).
+gen_set_arg(deref, L1, L2) --> gen_deref(L1, L2).
+
+%%% generate decl_var instructions
+generate_var_decl([X0,P0], [XN,PN]) -->
+ {X1 is XN-1, P1 is PN-1},
+ {range_reg(X0, X1, a, XL)},
+ {range_reg(P0, P1, p, PL)},
+ gen_decl_term_vars(XL),
+ gen_decl_pred_vars(PL).
+
+gen_decl_term_vars([]) --> !.
+gen_decl_term_vars(XL) --> [decl_term_vars(XL)].
+
+gen_decl_pred_vars([]) --> !.
+gen_decl_pred_vars(PL) --> [decl_pred_vars(PL)].
+
+/****************************************************************
+ Compile Clause
+****************************************************************/
+compile_clause((Head :- Body), GTI0, GTI, LTI) -->
+ {pretreat_body(Body, Goals0)}, % cut, rename, compile aith exp.
+ {localize_meta(Goals0, Goals)}, % add package name for meta predicates
+ {precompile(Head, Goals, Instrs)}, % generate get, put, put_clo, put_cont, inline
+ [comment((Head :- Goals))], % output precompiled clause
+ compile_chunks(Instrs, GTI0, GTI, LTI),
+ !.
+compile_clause(Clause, _, _, _) -->
+ {pl2am_error([compilation,of,Clause,failed])},
+ {fail}.
+
+%%%%%%%%%% Pretreat Body and Compile Arithmetic Expressions
+pretreat_body(Body, Goals) :-
+ pretreat_body0(Body, Cut, Goals0, []),
+ pretreat_cut(Cut, Goals0, Goals).
+
+pretreat_cut(Cut, Gs, Gs) :- var(Cut), !.
+pretreat_cut('$cut'(Level), ['$cut'(Level)|Gs], ['$neck_cut'|Gs]) :- !.
+pretreat_cut('$cut'(Level), Gs, ['$get_level'(Level)|Gs]).
+
+pretreat_body0(G, _) --> {var(G)}, !, [call(G)].
+pretreat_body0(!, Cut) --> !, {Cut = '$cut'(Level)}, ['$cut'(Level)].
+pretreat_body0(otherwise, _) --> !.
+pretreat_body0(true, _) --> !.
+pretreat_body0(fail, _) --> !, [fail].
+pretreat_body0(false, _) --> !, [fail].
+pretreat_body0(halt, _) --> !, [halt].
+pretreat_body0(abort, _) --> !, [abort].
+pretreat_body0((G1,G2), Cut) --> !, pretreat_body0(G1, Cut), pretreat_body0(G2, Cut).
+pretreat_body0(G, _) --> pretreat_builtin(G), !.
+pretreat_body0(G, _) --> {functor(G, F, A), clause(dynamic_predicates(F, A), _)}, !, [call(G)].
+pretreat_body0(G, _) --> [G].
+
+%%% rename builtins
+pretreat_builtin(X = Y) --> !, ['$unify'(X, Y)].
+pretreat_builtin(X \= Y) --> !, ['$not_unifiable'(X, Y)].
+pretreat_builtin(X == Y) --> !, ['$equality_of_term'(X, Y)].
+pretreat_builtin(X \== Y) --> !, ['$inequality_of_term'(X, Y)].
+pretreat_builtin(?=(X, Y)) --> !, ['$identical_or_cannot_unify'(X, Y)].
+pretreat_builtin(X @< Y) --> !, ['$before'(X, Y)].
+pretreat_builtin(X @> Y) --> !, ['$after'(X, Y)].
+pretreat_builtin(X @=< Y) --> !, ['$not_after'(X, Y)].
+pretreat_builtin(X @>= Y) --> !, ['$not_before'(X, Y)].
+pretreat_builtin(compare(Op,X,Y)) --> {Op == (=)}, !, ['$equality_of_term'(X, Y)].
+pretreat_builtin(compare(Op,X,Y)) --> {Op == (<)}, !, ['$before'(X, Y)].
+pretreat_builtin(compare(Op,X,Y)) --> {Op == (>)}, !, ['$after'(X, Y)].
+pretreat_builtin(X =.. Y) --> !, ['$univ'(X, Y)].
+pretreat_builtin(X =:= Y) --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$arith_equal'(U, V)].
+pretreat_builtin(X =\= Y) --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$arith_not_equal'(U, V)].
+pretreat_builtin(X > Y) --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$greater_than'(U, V)].
+pretreat_builtin(X >= Y) --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$greater_or_equal'(U, V)].
+pretreat_builtin(X < Y) --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$less_than'(U, V)].
+pretreat_builtin(X =< Y) --> !, pretreat_is(U, X), pretreat_is(V, Y), ['$less_or_equal'(U, V)].
+pretreat_builtin(Z is X) --> !, pretreat_is0(Z, X).
+
+pretreat_is(Z, X) --> {var(X)}, !, {X = Z}.
+pretreat_is(Z, X) --> pretreat_is0(Z, X).
+
+pretreat_is0(Z, X) --> {clause(pl2am_flag(ac), _)}, !, precompile_is(X, Z).
+pretreat_is0(Z, X) --> [is(Z, X)].
+
+%%% compile aithmetic expressions
+precompile_is(X, A) --> {var(X)}, !, [is(A, X)].
+precompile_is(X, A) --> {number(X)}, !, {X = A}.
+precompile_is(X, A) --> {builtin_arith_constant(X)}, !, {X = A}.
+precompile_is(+(X), A) --> !, precomp_is(X, A).
+precompile_is(-(X), A) --> !, precompile_is(-1*X, A).
+precompile_is(X+Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$plus'(U, V, A)].
+precompile_is(X-Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$minus'(U, V, A)].
+precompile_is(X*Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$multi'(U, V, A)].
+precompile_is(X/Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$float_quotient'(U, V, A)].
+precompile_is(X//Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$int_quotient'(U, V, A)].
+precompile_is(X mod Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$mod'(U, V, A)].
+precompile_is(X rem Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$mod'(U, V, A)].
+precompile_is(X/\Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$bitwise_conj'(U, V, A)].
+precompile_is(X\/Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$bitwise_disj'(U, V, A)].
+precompile_is(X#Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$bitwise_exclusive_or'(U, V, A)].
+precompile_is(\(X), A) --> !, precomp_is(X, U), ['$bitwise_neg'(U, A)].
+precompile_is(X<<Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$shift_left'(U, V, A)].
+precompile_is(X>>Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$shift_right'(U, V, A)].
+precompile_is([X], A) --> !, precomp_is(X, A).
+precompile_is(abs(X), A) --> !, precomp_is(X, U), ['$abs'(U, A)].
+precompile_is(min(X,Y), A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$min'(U, V, A)].
+precompile_is(max(X,Y), A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$max'(U, V, A)].
+precompile_is(round(X), A) --> !, precomp_is(X, U), ['$round'(U, A)].
+precompile_is(floor(X), A) --> !, precomp_is(X, U), ['$floor'(U, A)].
+precompile_is(ceiling(X), A) --> !, precomp_is(X, U), ['$ceil'(U, A)].
+precompile_is(sin(X), A) --> !, precomp_is(X, U), ['$sin'(U, A)].
+precompile_is(cos(X), A) --> !, precomp_is(X, U), ['$cos'(U, A)].
+precompile_is(tan(X), A) --> !, precomp_is(X, U), ['$tan'(U, A)].
+precompile_is(asin(X), A) --> !, precomp_is(X, U), ['$asin'(U, A)].
+precompile_is(acos(X), A) --> !, precomp_is(X, U), ['$acos'(U, A)].
+precompile_is(atan(X), A) --> !, precomp_is(X, U), ['$atan'(U, A)].
+precompile_is(sqrt(X), A) --> !, precomp_is(X, U), ['$sqrt'(U, A)].
+precompile_is(log(X), A) --> !, precomp_is(X, U), ['$log'(U, A)].
+precompile_is(exp(X), A) --> !, precomp_is(X, U), ['$exp'(U, A)].
+precompile_is(X**Y, A) --> !, precomp_is(X, U), precomp_is(Y, V), ['$pow'(U, V, A)].
+precompile_is(degrees(X), A) --> !, precomp_is(X, U), ['$degrees'(U, A)].
+precompile_is(radians(X), A) --> !, precomp_is(X, U), ['$radians'(U, A)].
+precompile_is(rint(X), A) --> !, precomp_is(X, U), ['$rint'(U, A)].
+precompile_is(float(X), A) --> !, precomp_is(X, U), ['$float'(U, A)].
+precompile_is(float_integer_part(X), A) --> !, precomp_is(X, U), ['$float_integer_part'(U, A)].
+precompile_is(float_fractional_part(X), A) --> !, precomp_is(X, U), ['$float_fractional_part'(U, A)].
+precompile_is(truncate(X),A) --> !, precomp_is(X, U), ['$truncate'(U, A)].
+precompile_is(sign(X), A) --> !, precomp_is(X, U), ['$sign'(U, A)].
+precompile_is(X, _) -->
+ {pl2am_error([unknown,arithemetic,expression,X])},
+ {fail}.
+
+precomp_is(X, A) --> {var(X)}, {var(A)}, !, {X = A}.
+precomp_is(X, A) --> precompile_is(X, A).
+
+%%%%%%%%%% Add Pacakge (module) name to meta predicates
+localize_meta(G0, G) :-
+ clause(package_name(P), _),
+ localize_meta(G0, P, G),
+ !.
+
+localize_meta([], _, []) :- !.
+localize_meta([G|Gs], P, [G1|Gs1]) :-
+ localize_meta_goal(G, P, X),
+ (X = P:Y -> G1 = Y ; G1 = X),
+ localize_meta(Gs, P, Gs1).
+
+localize_meta_goal(G, P, G1) :- var(G), !,
+ localize_meta_goal(call(G), P, G1).
+localize_meta_goal(P:G, _, G1) :- !,
+ localize_meta_goal(G, P, G1).
+localize_meta_goal((X,Y), P, (X1,Y1)) :- !,
+ localize_meta_goal(X, P, X1),
+ localize_meta_goal(Y, P, Y1).
+localize_meta_goal((X->Y), P, (X1->Y1)) :- !,
+ localize_meta_goal(X, P, X1),
+ localize_meta_goal(Y, P, Y1).
+localize_meta_goal((X;Y), P, (X1;Y1)) :- !,
+ localize_meta_goal(X, P, X1),
+ localize_meta_goal(Y, P, Y1).
+localize_meta_goal(G, P, G1) :-
+ functor(G, F, A),
+ (clause(meta_predicates(F, A, M), _) ; builtin_local_predicates(F, A, M)),
+ !,
+ G =.. [F|As],
+ localize_meta_args(M, As, P, As1),
+ G1 =.. [F|As1].
+localize_meta_goal(G, P, call(P:G)) :- var(P), !.
+localize_meta_goal(G, _, G) :- system_predicate(G), !.
+localize_meta_goal(G, P, P:G).
+
+localize_meta_args([], [], _, []) :- !.
+localize_meta_args([:|Ms], [A|As], P, [P:A|As1]) :-
+ (var(A) ; A \= _:_),
+ !,
+ localize_meta_args(Ms, As, P, As1).
+localize_meta_args([_|Ms], [A|As], P, [A|As1]) :-
+ localize_meta_args(Ms, As, P, As1).
+
+%%%%%%%%%% Precompile Clause and Optimize Recursive Call
+precompile(Head, Goals, Instrs) :-
+ precompile_head(Head, Instrs0, Bs),
+ precompile_body(Goals, Bs, []),
+ optimize_recursive_call(Head, Instrs0, Instrs).
+
+%%% Precompile head (generates get instructions)
+precompile_head(Head) -->
+ {Head =.. [_|Args]},
+ precomp_head(Args, 1).
+
+precomp_head([], _) --> !.
+precomp_head([A|As], I) -->
+ [get(A, a(I))],
+ {I1 is I + 1},
+ precomp_head(As, I1).
+
+%%% Precompile body
+%%% (generates put, put_clo, put_cont, and inline instructions)
+precompile_body(Goals) -->
+ {clause(pl2am_flag(ie), _)},
+ !,
+ {pickup_inline_goals(Goals, IGs, Gs)},
+ precomp_inline(IGs, Gs).
+precompile_body(Goals) -->
+ precomp_body(Goals).
+
+precomp_body([]) --> !, [execute(cont)].
+precomp_body(['$INSERT_AM'(Code)|_]) --> !,
+ {pl2am_error([invalid,instruction,'$INSERT_AM'(Code)])},
+ {fail}.
+precomp_body(['$INSERT'(Code)|_]) --> !,
+ {pl2am_error([invalid,instruction,'$INSERT'(Code)])},
+ {fail}.
+precomp_body([M:G|Cont]) --> !,
+ binarize_body(G, Cont, G1),
+ [execute(M:G1)].
+precomp_body([G|Cont]) -->
+ binarize_body(G, Cont, G1),
+ [execute(G1)].
+
+/*---------------------------------------------------------------
+ Binarization technique was developed by P.Tarau and M.Boyer,
+ please see:
+ * "Elementary Logic Programs"
+ P.Tarau and M.Boyer
+ Programming Language Implementation and Logic Programming,
+ pp.159--173, LNCS 456, Springer Verlag, 1990
+----------------------------------------------------------------*/
+binarize_body(G, Cont, G1) -->
+ {G =.. [F|Args]},
+ {functor(G, F, A)},
+ precomp_call(Args, Us, F, A),
+ %precomp_call(Args, Us), % for no closure
+ precomp_cont(Cont, V),
+ {pl2am_append(Us, [V], Ws)},
+ {G1 =.. [F|Ws]}.
+
+precomp_call([], []) --> !.
+precomp_call([A|As], [U|Us]) -->
+ [put(A, U)],
+ precomp_call(As, Us).
+
+precomp_cont([], cont) --> !.
+precomp_cont([M:G|Cont], V) --> !,
+ binarize_body(G, Cont, G1),
+ [put_cont(M:G1, V)].
+precomp_cont([G|Cont], V) -->
+ binarize_body(G, Cont, G1),
+ [put_cont(G1, V)].
+
+precomp_inline([], Gs1) --> !, precomp_body(Gs1).
+precomp_inline([fail|_], _) --> !, [inline(fail)].
+precomp_inline(['$INSERT_AM'(Code)|Gs], Gs1) --> !,
+ [Code], precomp_inline(Gs, Gs1).
+precomp_inline(['$INSERT'(Code)|Gs], Gs1) --> !,
+ ['$INSERT'(Code)], precomp_inline(Gs, Gs1).
+precomp_inline([G|Gs], Gs1) -->
+ {G =.. [F|Args]},
+ {functor(G, F, A)},
+ precomp_call(Args, Us, F, A),
+ %precomp_call(Args, Us),
+ {G1 =.. [F|Us]},
+ [inline(G1)],
+ precomp_inline(Gs, Gs1).
+
+pickup_inline_goals([], [], []) :- !.
+pickup_inline_goals([G|Gs], [G|IGs], BGs) :-
+ builtin_inline_predicates(G),
+ !,
+ pickup_inline_goals(Gs, IGs, BGs).
+pickup_inline_goals(Gs, [], Gs).
+
+%%% Generate Closure
+precomp_call(As, Us, Functor, Arity) -->
+ {clause(pl2am_flag(clo), _)},
+ {clause(meta_predicates(Functor, Arity, Mode), _)},
+ !,
+ {clause(package_name(P), _)},
+ precomp_closure(Mode, As, P, Us).
+precomp_call(As, Us, _, _) --> precomp_call(As, Us).
+
+precomp_closure([], [], _, []) --> !.
+precomp_closure([:|Ms], [A|As], P, [U|Us]) -->
+ {get_closure(A, P, C)},
+ !,
+ [put_clo(C, U)],
+ precomp_closure(Ms, As, P, Us).
+precomp_closure([_|Ms], [A|As], P, [U|Us]) -->
+ [put(A, U)],
+ precomp_closure(Ms, As, P, Us).
+
+get_closure(G, _, _) :- var(G), !, fail.
+get_closure(_, P, _) :- var(P), !, fail.
+get_closure(P:G, _, Clo) :- !, get_closure(G, P, Clo).
+get_closure(G, P, P:G) :- % ???
+ atom(P),
+ callable(G),
+ functor(G, F, A),
+ \+ clause(dynamic_predicates(F,A), _),
+ !.
+
+%%% Optimize Recursive Call
+optimize_recursive_call(Head, Instrs0, Instrs) :-
+ clause(pl2am_flag(rc), _),
+ !,
+ optimize_rc(Instrs0, Head, Instrs, []).
+optimize_recursive_call(_, Instrs, Instrs).
+
+optimize_rc([], _) --> !.
+optimize_rc([execute(Goal)|Xs], Head) -->
+ {functor(Head, F, A)},
+ {functor(Goal, F, A1)},
+ {A+1 =:= A1},
+ !,
+ {assert_copts(rc(F, A))},
+ {Goal =.. [F|Args]},
+ {range_reg(1, A, ea, Rs0)},
+ {pl2am_append(Rs0, [econt], Rs)},
+ gen_set(Args, Rs),
+ [goto(F/A+top)],
+ optimize_rc(Xs, Head).
+optimize_rc([X|Xs], Head) -->
+ [X],
+ optimize_rc(Xs, Head).
+
+%%%%%%%%%% Compile Clause
+compile_chunks(Chunk, GTI0, GTI, LTI) -->
+ {alloc_voids(Chunk, [], Alloc)}, % check void variables
+ compile_chunk(Chunk, Alloc, GTI0, GTI, LTI).
+
+compile_chunk([], _, GTI, GTI, []) --> !.
+compile_chunk(Chunk, Alloc, GTI0, GTI, LTI) -->
+ {free_x_reg(Chunk, 1, XN), YN = 1, PN = 1},
+ {LTI0 = [XN, YN, PN, Alloc]},
+ comp_chunk(Chunk, LTI0, LTI, GTI0, GTI).
+
+comp_chunk([], LTI, LTI, GTI, GTI) --> !.
+comp_chunk([(L:[])|Cs], LTI0, LTI, GTI0, GTI) --> !,
+ [L:[]],
+ comp_chunk(Cs, LTI0, LTI, GTI0, GTI).
+comp_chunk([(L:C)|Cs], LTI0, LTI, GTI0, GTI) --> !,
+ [L:[]],
+ comp_chunk([C|Cs], LTI0, LTI, GTI0, GTI).
+comp_chunk([C|Cs], LTI0, LTI, GTI0, GTI) --> !,
+ comp_instr(C, LTI0, LTI1, GTI0, GTI1),
+ comp_chunk(Cs, LTI1, LTI, GTI1, GTI).
+
+%%% finds an available number A-register
+free_x_reg([], XN, XN).
+free_x_reg([get(_,V)|Cs], XN0, XN) :- nonvar(V), V = a(N), !,
+ XN1 is max(N+1, XN0),
+ free_x_reg(Cs, XN1, XN).
+free_x_reg([put(_,V)|Cs], XN0, XN) :- nonvar(V), V = a(N), !,
+ XN1 is max(N+1, XN0),
+ free_x_reg(Cs, XN1, XN).
+free_x_reg([_|Cs], XN0, XN) :-
+ free_x_reg(Cs, XN0, XN).
+
+%%% finds void variables and allocates them in Alloc.
+alloc_voids(Chunks, Alloc0, Alloc) :-
+ variables(Chunks, Vars),
+ alloc_voids1(Vars, Chunks, Alloc0, Alloc).
+
+alloc_voids1([], _, Alloc, Alloc).
+alloc_voids1([V|Vars], Chunks, Alloc0, Alloc) :-
+ count_variable(V, Chunks, 1),
+ !,
+ Alloc1 = [[V,void,_Seen]|Alloc0],
+ alloc_voids1(Vars, Chunks, Alloc1, Alloc).
+alloc_voids1([_|Vars], Chunks, Alloc0, Alloc) :-
+ alloc_voids1(Vars, Chunks, Alloc0, Alloc).
+
+%%%%%%%%%% Compile Precompiled Instructions: get, put, put_clo, and put_cont
+/*
+ comp_instr(+Instr, +LTI0, ?LTI, +GTI0, ?GTI)
+ Instr : Intermediate instruction
+ LTI : [XN, YN, PN, Alloc]
+ XN : The register a(XN) is available for "Term".
+ YN : The register y(YN) is available for "Term[]".
+ PN : The register p(PN) is available for "Predicate".
+ Alloc : [[VarTerm, Register, Seen],...]
+ GTI : [SN, SAlloc, SInstrs]
+ SN : The registers s(SN), si(SN), or sf(SN) are available for static "Term".
+ SAlloc : [[NonVarTerm:Type, Register, Seen],...]
+ SInstrs : list of instructions for static terms.
+ Seen : Unbound variable | yes | void
+ Type : int | flo | con | str | lis | arr
+*/
+comp_instr(get(X, A), LTI0, LTI, GTI0, GTI) --> !,
+ gen_get(X, A, LTI0, LTI, GTI0, GTI).
+comp_instr(put(X, V), LTI0, LTI, GTI0, GTI) --> !,
+ gen_put(X, V, LTI0, LTI, GTI0, GTI).
+comp_instr(put_clo(X, V), LTI0, LTI, GTI0, GTI) --> !,
+ gen_put_clo(X, V, LTI0, LTI, GTI0, GTI).
+comp_instr(put_cont(X, V), LTI0, LTI, GTI0, GTI) --> !,
+ gen_put_cont(X, V, LTI0, LTI, GTI0, GTI).
+comp_instr(Instr, LTI, LTI, GTI, GTI) -->
+ [Instr].
+
+%%%%%%%%%% put instructions
+gen_put(_, A, _, _, _, _) --> {nonvar(A)}, !,
+ {pl2am_error([A,should,be,an,unbound,variable])},
+ {fail}.
+gen_put(X, A, LTI0, LTI, GTI, GTI) --> {var(X)}, !,
+ {assign_reg(X, R, Seen, LTI0, LTI)},
+ gen_put_var(R, Seen, A).
+gen_put(X, A, LTI, LTI, GTI0, GTI) --> {integer(X)}, !,
+ {assign_sreg(X:int, R, Seen, GTI0, GTI1)},
+ gen_put_int(X, R, Seen, A, GTI1, GTI).
+gen_put(X, A, LTI, LTI, GTI0, GTI) --> {float(X)}, !,
+ {assign_sreg(X:flo, R, Seen, GTI0, GTI1)},
+ gen_put_float(X, R, Seen, A, GTI1, GTI).
+gen_put(X, A, LTI, LTI, GTI0, GTI) --> {atom(X)}, !,
+ {assign_sreg(X:con, R, Seen, GTI0, GTI1)},
+ gen_put_con(X, R, Seen, A, GTI1, GTI).
+gen_put(X, A, LTI0, LTI, GTI0, GTI) -->
+ {ground(X), X = [X1|X2]},
+ !,
+ gen_put_args([X1,X2], [R1,R2], LTI0, LTI, GTI0, GTI1),
+ {assign_sreg(X:lis, R, Seen, GTI1, GTI2)},
+ gen_put_list([R1,R2], R, Seen, A, GTI2, GTI).
+gen_put(X, A, LTI0, LTI, GTI0, GTI) -->
+ {ground(X), X =..[_|Args], functor(X,F,N)},
+ !,
+ {assign_sreg(F/N:con, R0, Seen0, GTI0, GTI1)},
+ gen_put_con(F/N, R0, Seen0, _, GTI1, GTI2),
+ gen_put_args(Args, Regs, LTI0, LTI, GTI2, GTI3),
+ {assign_sreg(Args:arr, R1, Seen1, GTI3, GTI4)},
+ gen_put_str_args(Regs, R1, Seen1, _, GTI4, GTI5),
+ {assign_sreg(X:str, R, Seen, GTI5, GTI6)},
+ gen_put_str([R0,R1], R, Seen, A, GTI6, GTI).
+gen_put(X, A, LTI0, LTI, GTI0, GTI) -->
+ {X = [X1|X2]},
+ !,
+ gen_put_args([X1,X2], [R1,R2], LTI0, LTI1, GTI0, GTI),
+ {assign_reg(_, R, Seen, LTI1, LTI)},
+ {Seen = yes, R = A},
+ [put_list(R1, R2, R)].
+gen_put(X, A, LTI0, LTI, GTI0, GTI) -->
+ {X =..[_|Args], functor(X,F,N)},
+ !,
+ {assign_sreg(F/N:con, R0, Seen0, GTI0, GTI1)},
+ gen_put_con(F/N, R0, Seen0, _, GTI1, GTI2),
+ gen_put_args(Args, Regs, LTI0, LTI1, GTI2, GTI),
+ {inc_YN(R1, LTI1, LTI2)},
+ {assign_reg(_, R, Seen, LTI2, LTI)},
+ {Seen = yes, R = A},
+ [put_str_args(Regs, R1)],
+ [put_str(R0, R1, R)].
+
+gen_put_var(void, _, A) --> !, {A = void}. % void is a special constant.
+gen_put_var(R, Seen, A) --> {var(Seen)}, !,
+ {Seen = yes, R = A},
+ [put_var(R)].
+gen_put_var(R, _, A) --> {R = A}.
+
+gen_put_int(X, R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
+ {Seen = yes, R = A},
+ {add_instr(put_int(X, R), GTI0, GTI)}.
+gen_put_int(_, R, _, A, GTI, GTI) --> {R = A}.
+
+gen_put_float(X, R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
+ {Seen = yes, R = A},
+ {add_instr(put_float(X, R), GTI0, GTI)}.
+gen_put_float(_, R, _, A, GTI, GTI) --> {R = A}.
+
+gen_put_con(X, R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
+ {Seen = yes, R = A},
+ {add_instr(put_con(X, R), GTI0, GTI)}.
+gen_put_con(_, R, _, A, GTI, GTI) --> {R = A}.
+
+gen_put_list([R1,R2], R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
+ {Seen = yes, R = A},
+ {add_instr(put_list(R1, R2, R), GTI0, GTI)}.
+gen_put_list(_, R, _, A, GTI, GTI) --> {R = A}.
+
+gen_put_str_args(Regs, R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
+ {Seen = yes, R = A},
+ {add_instr(put_str_args(Regs, R), GTI0, GTI)}.
+gen_put_str_args(_, R, _, A, GTI, GTI) --> {R = A}.
+
+gen_put_str([R0,R1], R, Seen, A, GTI0, GTI) --> {var(Seen)}, !,
+ {Seen = yes, R = A},
+ {add_instr(put_str(R0, R1, R), GTI0, GTI)}.
+gen_put_str(_, R, _, A, GTI, GTI) --> {R = A}.
+
+gen_put_args([], [], LTI, LTI, GTI, GTI) --> !.
+gen_put_args([X|Xs], [R|Rs], LTI0, LTI, GTI0, GTI) -->
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ gen_put_args(Xs, Rs, LTI1, LTI, GTI1, GTI).
+
+gen_put_clo(P:X, A, LTI0, LTI, GTI0, GTI) -->
+ {X =..[F|Args]},
+ !,
+ gen_put_args(Args, Regs, LTI0, LTI1, GTI0, GTI),
+ {assign_reg(_, R, Seen, LTI1, LTI)},
+ {Seen = yes, R = A},
+ {X1 =..[F|Regs]},
+ {(clause(package_name(P), _) -> CLO = X1 ; CLO = P:X1)},
+ [put_clo(CLO, R)].
+
+%%%%%%%%%% get instructions
+gen_get(X, A, LTI0, LTI, GTI0, GTI) -->
+ gen_get([A=X], LTI0, LTI, GTI0, GTI).
+
+gen_get([], LTI, LTI, GTI, GTI) --> !.
+gen_get([A=X|_], LTI, LTI, GTI, GTI) -->
+ {var(A)},
+ !,
+ {pl2am_error([A,must,not,be,a,variable,in,get(X,A)])},
+ {fail}.
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {var(X)},
+ {assign_reg(X, R, Seen, LTI0, LTI1)},
+ {nonvar(Seen)},
+ !,
+ gen_get_var(R, Seen, A),
+ gen_get(Instrs, LTI1, LTI, GTI0, GTI).
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {var(X)},
+ !,
+ {add_alloc([X,A,yes], LTI0, LTI1)},
+ gen_get(Instrs, LTI1, LTI, GTI0, GTI).
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {integer(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [get_int(X, R, A)],
+ gen_get(Instrs, LTI1, LTI, GTI1, GTI).
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {float(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [get_float(X, R, A)],
+ gen_get(Instrs, LTI1, LTI, GTI1, GTI).
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {atom(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [get_con(X, R, A)],
+ gen_get(Instrs, LTI1, LTI, GTI1, GTI).
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {ground(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [get_ground(X, R, A)],
+ gen_get(Instrs, LTI1, LTI, GTI1, GTI).
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {X = [X1|X2]},
+ !,
+ [get_list(A)],
+ gen_unify([X1,X2], Instrs1, LTI0, LTI1, GTI0, GTI1),
+ gen_get(Instrs1, LTI1, LTI2, GTI1, GTI2),
+ gen_get(Instrs, LTI2, LTI, GTI2, GTI).
+gen_get([A=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {X =.. [F|Args], functor(X, F, N)},
+ {assign_sreg(F/N:con, R, Seen, GTI0, GTI1)},
+ gen_put_con(F/N, R, Seen, _, GTI1, GTI2),
+ [get_str(F/N, R, A)],
+ gen_unify(Args, Instrs1, LTI0, LTI1, GTI2, GTI3),
+ gen_get(Instrs1, LTI1, LTI2, GTI3, GTI4),
+ gen_get(Instrs, LTI2, LTI, GTI4, GTI).
+
+gen_get_var(void, _, _) --> !.
+gen_get_var(R, _, A) --> [get_val(R, A)].
+
+%%%%%%%%%% unify instructions
+gen_unify([], [], LTI, LTI, GTI, GTI) --> !.
+gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) -->
+ {var(X)},
+ !,
+ {assign_reg(X, R, Seen, LTI0, LTI1)},
+ gen_unify_var(R, Seen),
+ gen_unify(Xs, Instrs, LTI1, LTI, GTI0, GTI).
+gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) -->
+ {integer(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [unify_int(X, R)],
+ gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
+gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) -->
+ {float(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [unify_float(X, R)],
+ gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
+gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) -->
+ {atom(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [unify_con(X, R)],
+ gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
+gen_unify([X|Xs], Instrs, LTI0, LTI, GTI0, GTI) -->
+ {ground(X)},
+ !,
+ gen_put(X, R, LTI0, LTI1, GTI0, GTI1),
+ [unify_ground(X, R)],
+ gen_unify(Xs, Instrs, LTI1, LTI, GTI1, GTI).
+gen_unify([X|Xs], [R=X|Instrs], LTI0, LTI, GTI0, GTI) -->
+ {assign_reg(_, R, Seen, LTI0, LTI1)},
+ gen_unify_var(R, Seen),
+ gen_unify(Xs, Instrs, LTI1, LTI, GTI0, GTI).
+
+%%% unify_void, unify_variable, unify_value
+gen_unify_var(void, _) --> !, [unify_void(1)].
+gen_unify_var(R, Seen) --> {var(Seen)}, !,
+ {Seen = yes},
+ [unify_var(R)].
+gen_unify_var(R, _) --> [unify_val(R)].
+
+%%%%%%%%%% generate continuation goal
+gen_put_cont(X, R, LTI0, LTI, GTI, GTI) -->
+ {inc_PN(R, LTI0, LTI)},
+ [put_cont(X, R)].
+
+%%% A register
+assign_reg(X, Reg, Seen, LTI0, LTI) :- nonvar(X), !,
+ pl2am_error([X,must,be,unbound,variable,in,assign_reg(X,Reg,Seen,LTI0,LTI)]),
+ fail.
+assign_reg(X, Reg, Seen, [XN,YN,PN,Alloc], [XN,YN,PN,Alloc]) :-
+ allocated(Alloc, X, [Reg,Seen]),
+ !.
+assign_reg(X, Reg, Seen, [XN,YN,PN,Alloc], [XN1,YN,PN,Alloc1]) :-
+ Reg = a(XN),
+ XN1 is XN + 1,
+ Alloc1 = [[X,Reg,Seen]|Alloc].
+
+allocated([[V|X]|_], V0, X) :- V == V0, !.
+allocated([_|Alloc], V0, X) :- allocated(Alloc, V0, X).
+
+%%% S register
+assign_sreg(X, Reg, Seen, GTI0, GTI) :- \+ ground(X), !,
+ pl2am_error([X,must,be,ground,term,in,assign_sreg(X,Reg,Seen,GTI0,GTI)]),
+ fail.
+assign_sreg(X, Reg, Seen, [SN,SAlloc,SInstrs], [SN,SAlloc,SInstrs]) :-
+ allocated(SAlloc, X, [Reg,Seen]),
+ !.
+assign_sreg(X:T, Reg, Seen, [SN,SAlloc,SInstrs], [SN1,SAlloc1,SInstrs]) :-
+ assign_sreg0(T, SN, Reg),
+ SN1 is SN+1,
+ SAlloc1 = [[X:T,Reg,Seen]|SAlloc].
+
+assign_sreg0(int, SN, si(SN)) :- !.
+assign_sreg0(flo, SN, sf(SN)) :- !.
+assign_sreg0(_, SN, s(SN)) :- !.
+%assign_sreg0(con, SN, sc(SN)) :- !.
+%assign_sreg0(str, SN, ss(SN)) :- !.
+%assign_sreg0(lis, SN, sl(SN)) :- !.
+%assign_sreg0(arr, SN, sa(SN)) :- !.
+
+%%% incriment YN
+inc_YN(y(YN), [XN,YN|Zs], [XN,YN1|Zs]) :- YN1 is YN+1.
+
+%%% incriment PN
+inc_PN(p(PN), [XN,YN,PN|Zs], [XN,YN,PN1|Zs]) :- PN1 is PN+1.
+
+%%% add an instruction to GTI
+add_instr(Instr, [SN,SAlloc,SInstrs0], [SN,SAlloc,[Instr|SInstrs0]]).
+
+%%% add an allocation to LTI
+add_alloc(E, [XN,YN,PN,Alloc0], [XN,YN,PN,[E|Alloc0]]).
+
+/*****************************************************************
+ Built-in Predicates and Constants
+*****************************************************************/
+builtin_meta_predicates((^), 2, [?,:]).
+builtin_meta_predicates(call, 1, [:]).
+builtin_meta_predicates(once, 1, [:]).
+builtin_meta_predicates((\+), 1, [:]).
+builtin_meta_predicates(findall, 3, [?,:,?]).
+builtin_meta_predicates(bagof, 3, [?,:,?]).
+builtin_meta_predicates(setof, 3, [?,:,?]).
+builtin_meta_predicates(on_exception, 3, [?,:,:]).
+builtin_meta_predicates(catch, 3, [:,?,:]).
+builtin_meta_predicates(synchronized, 2, [?,:]).
+builtin_meta_predicates(freeze, 2, [?,:]).
+
+builtin_local_predicates(assert, 1, [:]).
+builtin_local_predicates(asserta, 1, [:]).
+builtin_local_predicates(assertz, 1, [:]).
+builtin_local_predicates(retract, 1, [:]).
+builtin_local_predicates(retractall, 1, [:]).
+builtin_local_predicates(clause, 2, [:,?]).
+builtin_local_predicates(abolish, 1, [:]).
+
+% Control constructs
+builtin_inline_predicates(fail).
+builtin_inline_predicates('$get_level'(_)).
+builtin_inline_predicates('$neck_cut').
+builtin_inline_predicates('$cut'(_)).
+% Term unification
+builtin_inline_predicates('$unify'(_,_)).
+builtin_inline_predicates('$not_unifiable'(_,_)).
+% Type testing
+builtin_inline_predicates(var(_)).
+builtin_inline_predicates(atom(_)).
+builtin_inline_predicates(integer(_)).
+builtin_inline_predicates(float(_)).
+builtin_inline_predicates(atomic(_)).
+builtin_inline_predicates(nonvar(_)).
+builtin_inline_predicates(number(_)).
+builtin_inline_predicates(java(_)).
+builtin_inline_predicates(java(_,_)).
+builtin_inline_predicates(closure(_)).
+builtin_inline_predicates(ground(_)).
+% Term comparison
+builtin_inline_predicates('$equality_of_term'(_,_)).
+builtin_inline_predicates('$inequality_of_term'(_,_)).
+builtin_inline_predicates('$after'(_,_)).
+builtin_inline_predicates('$before'(_,_)).
+builtin_inline_predicates('$not_after'(_,_)).
+builtin_inline_predicates('$not_before'(_,_)).
+builtin_inline_predicates('$identical_or_cannot_unify'(_,_)).
+% Term creation and decomposition
+builtin_inline_predicates(copy_term(_,_)).
+% Arithmetic evaluation
+builtin_inline_predicates(is(_,_)).
+builtin_inline_predicates('$abs'(_,_)).
+builtin_inline_predicates('$asin'(_,_)).
+builtin_inline_predicates('$acos'(_,_)).
+builtin_inline_predicates('$atan'(_,_)).
+builtin_inline_predicates('$bitwise_conj'(_,_,_)).
+builtin_inline_predicates('$bitwise_disj'(_,_,_)).
+builtin_inline_predicates('$bitwise_exclusive_or'(_,_,_)).
+builtin_inline_predicates('$bitwise_neg'(_,_)).
+builtin_inline_predicates('$ceil'(_,_)).
+builtin_inline_predicates('$cos'(_,_)).
+builtin_inline_predicates('$degrees'(_,_)).
+builtin_inline_predicates('$exp'(_,_)).
+builtin_inline_predicates('$float_quotient'(_,_,_)).
+builtin_inline_predicates('$floor'(_,_)).
+builtin_inline_predicates('$int_quotient'(_,_,_)).
+builtin_inline_predicates('$log'(_,_)).
+builtin_inline_predicates('$max'(_,_,_)).
+builtin_inline_predicates('$min'(_,_,_)).
+builtin_inline_predicates('$minus'(_,_,_)).
+builtin_inline_predicates('$mod'(_,_,_)).
+builtin_inline_predicates('$multi'(_,_,_)).
+builtin_inline_predicates('$plus'(_,_,_)).
+builtin_inline_predicates('$pow'(_,_,_)).
+builtin_inline_predicates('$radians'(_,_)).
+builtin_inline_predicates('$rint'(_,_)).
+builtin_inline_predicates('$round'(_,_)).
+builtin_inline_predicates('$shift_left'(_,_,_)).
+builtin_inline_predicates('$shift_right'(_,_,_)).
+builtin_inline_predicates('$sin'(_,_)).
+builtin_inline_predicates('$sqrt'(_,_)).
+builtin_inline_predicates('$tan'(_,_)).
+builtin_inline_predicates('$float'(_,_)).
+builtin_inline_predicates('$float_integer_part'(_,_)).
+builtin_inline_predicates('$float_fractional_part'(_,_)).
+builtin_inline_predicates('$truncate'(_,_)).
+builtin_inline_predicates('$sign'(_,_)).
+% Arithmetic comparison
+builtin_inline_predicates('$arith_equal'(_,_)).
+builtin_inline_predicates('$arith_not_equal'(_,_)).
+builtin_inline_predicates('$greater_or_equal'(_,_)).
+builtin_inline_predicates('$greater_than'(_,_)).
+builtin_inline_predicates('$less_or_equal'(_,_)).
+builtin_inline_predicates('$less_than'(_,_)).
+% Prolog Cafe Specific
+builtin_inline_predicates('$INSERT_AM'(_)).
+builtin_inline_predicates('$INSERT'(_)).
+
+builtin_arith_constant(random).
+builtin_arith_constant(pi).
+builtin_arith_constant(e).
+
+/*****************************************************************
+ Eliminate disjunctions
+*****************************************************************/
+% The clause a :- b;c is converted into a :- b. and a :- c.
+% In addition,
+% (C1 -> C2) is converted into ((C1,!,C2) ; fail).
+% ((C1 -> C2) ; C3) is converted into ((C1,!,C2) ; C3).
+% not(C) is converted into ((C,!,fail) ; true).
+% \+(C) is converted into ((C,!,fail) ; true).
+% And then all of disjunctions are eliminated.
+%
+% Note: this is based on flatten.pl in holmer's benchmark.
+
+eliminate_disj(Cl, NewCl, DummyCls) :-
+ extract_disj(Cl, NewCl, Disjs, []),
+ treat_disj(Disjs, DummyCls, []).
+
+extract_disj(Cl, Cl) --> {var(Cl)}, !.
+extract_disj(Cl, (H :- NewB)) --> {Cl = (H :- B)}, !,
+ extract_disj(B, NewB, Cl).
+extract_disj(Cl, Cl) --> !.
+
+extract_disj(G, G, _) --> {var(G)}, !.
+extract_disj((G1, G2), (NewG1, NewG2), Cl) --> !,
+ extract_disj(G1, NewG1, Cl),
+ extract_disj(G2, NewG2, Cl).
+extract_disj(G, NewG, Cl) --> {is_disj(G, DisjG)}, !,
+ {retract(dummy_clause_counter(N))},
+ [disj(DisjG, N, NewG, Cl)],
+ {N1 is N+1},
+ {assert(dummy_clause_counter(N1))}.
+extract_disj(G, G, _) --> !.
+
+is_disj((C1->C2), ((C1,!,C2);fail)) :- !.
+is_disj(((C1->C2);C3), ((C1,!,C2);C3)) :- !.
+is_disj((C1;C2), (C1;C2)) :- !.
+is_disj(not(C),((C,!,fail);true)) :- !.
+is_disj(\+(C),((C,!,fail);true)).
+
+treat_disj([]) --> !.
+treat_disj([disj((A;B),N,X,C)|Disjs]) -->
+ {variables((A;B), Vars)},
+ {variables(C, CVars)},
+ {intersect_vars(Vars, CVars, Args)},
+ {clause(file_name(File), _)},
+ {list_to_string(['$dummy_', N, '_', File], Name)},
+ {X =.. [Name|Args]},
+ {copy_term((X :- A), DummyCla)},
+ {copy_term((X :- B), DummyClb)},
+ [DummyCla],
+ [DummyClb],
+ treat_disj(Disjs).
+
+intersect_vars(V1, V2, Out) :-
+ sort(V1, Sorted1),
+ sort(V2, Sorted2),
+ intersect_sorted_vars(Sorted1, Sorted2, Out).
+
+intersect_sorted_vars([], _, []) :- !.
+intersect_sorted_vars(_, [], []).
+intersect_sorted_vars([X|Xs], [Y|Ys], [X|Rs]) :- X == Y, !,
+ intersect_sorted_vars(Xs, Ys, Rs).
+intersect_sorted_vars([X|Xs], [Y|Ys], Rs) :- X @< Y, !,
+ intersect_sorted_vars(Xs,[Y|Ys],Rs).
+intersect_sorted_vars([X|Xs], [Y|Ys], Rs) :- X @> Y, !,
+ intersect_sorted_vars([X|Xs],Ys,Rs).
+
+/*****************************************************************
+ Utilities
+*****************************************************************/
+%%% print
+pl2am_error(M) :- pl2am_message(['***','PL2ASM','ERROR'|M]).
+
+pl2am_message([]) :- nl, flush_output(user_output).
+pl2am_message([M|Ms]) :- write(M), write(' '), pl2am_message(Ms).
+
+%%% format
+mode_expr([]).
+mode_expr([M|Ms]) :- nonvar(M), pl2am_member(M, [:,+,-,?]), !, mode_expr(Ms).
+
+predspec_expr(F/A) :- atom(F), integer(A).
+
+%%% list
+pl2am_append([], Zs, Zs).
+pl2am_append([X|Xs], Ys, [X|Zs]) :- pl2am_append(Xs, Ys, Zs).
+
+pl2am_rev(L, R) :- pl2am_rev(L, [], R).
+pl2am_rev([], R, R).
+pl2am_rev([X|L], Y, R) :- pl2am_rev(L, [X|Y], R).
+
+pl2am_member(X, [X|_]).
+pl2am_member(X, [_|Ys]) :- pl2am_member(X, Ys).
+
+pl2am_memq(X, [Y|_]) :- X==Y, !.
+pl2am_memq(X, [_|Ys]) :- pl2am_memq(X, Ys).
+
+flatten_list([]) --> !.
+flatten_list([L1|L2]) --> !, flatten_list(L1), flatten_list(L2).
+flatten_list(L) --> [L].
+
+flatten_code([]) --> !.
+flatten_code([(L: C)|Code]) --> !,
+ [L: []],
+ flatten_code([C|Code]).
+flatten_code([Code1|Code2]) --> !,
+ flatten_code(Code1),
+ flatten_code(Code2).
+flatten_code(Code) --> [Code].
+
+%%% transform
+conj_to_list(X, _) :- var(X), !,
+ pl2am_error([variable,X,can,not,be,converted,to,'[A|B]',expression]),
+ fail.
+conj_to_list(((X1,X2),Xs), Y) :- !, conj_to_list((X1,(X2,Xs)), Y).
+conj_to_list((X,Xs), [X|Zs]) :- !, conj_to_list(Xs, Zs).
+conj_to_list((X), [X]).
+
+list_to_string(List, String) :-
+ list_to_chars(List, Chars0),
+ flatten_list(Chars0, Chars, []),
+ atom_codes(String, Chars).
+
+list_to_chars([], []) :- !.
+list_to_chars([L|Ls], [C|Cs]) :- atom(L), !,
+ atom_codes(L, C),
+ list_to_chars(Ls, Cs).
+list_to_chars([L|Ls], [C|Cs]) :- number(L), !,
+ number_codes(L, C),
+ list_to_chars(Ls, Cs).
+
+list_to_conj(X, Y) :-
+ flatten_list(X, L, []),
+ list_to_conj0(L, Y).
+
+list_to_conj0(X, _) :- var(X), !,
+ pl2am_error([variable,X,can,not,be,converted,to,'(A,B)',expression]),
+ fail.
+list_to_conj0([X], (X)).
+list_to_conj0([X|Xs], (X,Ys)) :- !, list_to_conj0(Xs, Ys).
+
+%%% misc
+variables(X, Vs) :- variables(X, [], Vs).
+
+variables(X, Vs, Vs) :- var(X), pl2am_memq(X, Vs), !.
+variables(X, Vs, [X|Vs]) :- var(X), !.
+variables(X, Vs0, Vs0) :- atomic(X), !.
+variables([X|Xs], Vs0, Vs) :- !, variables(X, Vs0, Vs1), variables(Xs, Vs1, Vs).
+variables(X, Vs0, Vs) :- X =.. Xs, variables(Xs, Vs0, Vs).
+
+count_variable(V, X, 1) :- V == X, !.
+count_variable(_, X, 0) :- var(X), !.
+count_variable(_, X, 0) :- atomic(X), !.
+count_variable(V, [X|Y], N) :- !,
+ count_variable(V, X, N1),
+ count_variable(V, Y, N2),
+ N is N1 + N2.
+count_variable(V, X, N) :-
+ X =.. Xs,
+ count_variable(V, Xs, N).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% END
+% written by SICStus Prolog 3.12.8
diff --git a/src/compiler/pl2am.txt b/src/compiler/pl2am.txt
new file mode 100644
index 0000000..06faee6
--- /dev/null
+++ b/src/compiler/pl2am.txt
@@ -0,0 +1,138 @@
+#! /usr/bin/perl
+require 'getopts.pl';
+use strict;
+use Getopt::Long;
+
+# options
+my @optlist = ("h|help!","v|verbose!","copts=s","O!","J=s");
+my $result = GetOptions @optlist;
+our ($opt_h, $opt_v, $opt_copts, $opt_O, $opt_J);
+
+# -h option || check the number of arguments
+if ($opt_h || @ARGV != 2 ) {
+ usage();
+ exit 1;
+}
+
+# local variables
+my $echo = "/bin/echo";
+my $copts = "[]";
+my $prolog_file = $ARGV[0];
+my $am_file = $ARGV[1];
+
+my %env;
+&init();
+
+# -copts option
+if ($opt_copts) {
+ my @x = split(":", $opt_copts);
+ foreach (@x) {
+ s/^\s+//;
+ s/\s+$//;
+ }
+ foreach my $op (@x) {
+ if ($op !~ /^ed|ac|ie|rc|idx|clo$/) {
+ &error("invalid option found, $op.");
+ }
+ }
+ $copts = "[" . join(",", @x) . "]";
+}
+
+# -O option
+if ($opt_O) {
+# $copts = "[ed,ac,ie,rc,idx,clo]";
+ $copts = "[ed,ac,ie,rc,idx]";
+# $copts = "[ed,ac,ie,rc]";
+}
+
+# -J option
+if ($opt_J) {
+ if ($opt_J =~ /(-cp|-classpath)\s+/) {
+ &error("can not use $1 in -J option");
+ }
+ $env{"system_opts"} .= " $opt_J";
+}
+
+# main
+if (! -e $prolog_file) {
+ &error("file $prolog_file does not exist.");
+}
+
+my $arg;
+if ($env{"goal"}) {
+ $arg .= $env{"goal"} . " ";
+}
+$arg .= "[\'$prolog_file\', \'$am_file\', $copts].";
+my $cmd = "$echo \"$arg\" | " . $env{"system"};
+if ($env{"system_opts"}) {
+ $cmd .= " " . $env{"system_opts"};
+}
+if ($env{"system_args"}) {
+ $cmd .= " " . $env{"system_args"};
+}
+if (! $opt_v) {# check -v option
+ $cmd .= " 2> /dev/null";
+}
+
+&message("{START translating $prolog_file --> $am_file}");
+&message($cmd);
+system($cmd) && error("translation fails");
+&message("{END translating $prolog_file --> $am_file}\n");
+
+exit 0;
+
+# sub
+sub usage {
+ print "\nUsage: $0 [-options] prolog_file am_file\n";
+ print "\n where options include:\n";
+ print "\t-h -help : print this help message\n";
+ print "\t-v -verbose : enable verbose output\n";
+ print "\t-copts[:ed|ac|rc|ie|idx|clo]\n";
+ print "\t : enable each optimised compilation\n";
+ print "\t : ed = eliminate disjunctions\n";
+ print "\t : ac = arithmetic compilation\n";
+ print "\t : rc = optimise recursive call\n";
+ print "\t : ie = inline expansion\n";
+ print "\t : idx = switch_on_hash (2nd. level indexing) \n";
+ print "\t : clo = generate closure for meta predicates\n";
+ print "\t-O : enable all optimised compilation\n";
+ print "\t-J option : option must be enclosed by '.\n";
+ print "\t : pass option to the Java Virtual Machine\n";
+ print "\t : (ex. -J '-Xmx100m -verbose:gc')\n";
+ print "\n";
+}
+
+sub message {
+ my ($x) = @_;
+ if ($opt_v) { # check -v option
+ print "\% $x\n";
+ }
+}
+
+sub error {
+ my ($x) = @_;
+ print "\% ERROR: $x: $0\n";
+ exit 1;
+}
+
+#sub init {
+# %env = (
+# "goal", "",
+# "system", "/Users/banbara/prog/plcafe/PrologCafe095/src/compiler/pl2am.sav",
+# "system_opts", "",
+# "system_args", "",
+# );
+# %env = (
+# "goal", "load('/Users/banbara/prog/plcafe/PrologCafe095/src/compiler/pl2am.ql'), main.",
+# "system", "sicstus",
+# "system_opts", "",
+# "system_args", "",
+# );
+# %env = (
+# "goal", "",
+# "system", "java",
+# "system_opts", "-cp \$PLCAFEDIR/plcafe.jar:\$CLASSPATH",
+# "system_args", "jp.ac.kobe_u.cs.prolog.lang.PrologMain jp.ac.kobe_u.cs.prolog.compiler.pl2am:main",
+# );
+#}
+
diff --git a/src/lang/Arithmetic.java b/src/lang/Arithmetic.java
new file mode 100644
index 0000000..54295ef
--- /dev/null
+++ b/src/lang/Arithmetic.java
@@ -0,0 +1,167 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * The <code>Arithmetic</code> class contains a method
+ * for evaluating arithmetic expressions.<br>
+ * This class is mainly used by the builtin predicate <code>is/2</code>.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class Arithmetic {
+ static SymbolTerm SYM_RANDOM = SymbolTerm.makeSymbol("random");
+ static SymbolTerm SYM_PI = SymbolTerm.makeSymbol("pi");
+ static SymbolTerm SYM_E = SymbolTerm.makeSymbol("e");
+ static SymbolTerm SYM_ADD_1 = SymbolTerm.makeSymbol("+", 1);
+ static SymbolTerm SYM_NEGATE_1 = SymbolTerm.makeSymbol("-", 1);
+ static SymbolTerm SYM_ADD_2 = SymbolTerm.makeSymbol("+", 2);
+ static SymbolTerm SYM_SUBTRACT_2 = SymbolTerm.makeSymbol("-", 2);
+ static SymbolTerm SYM_MULTIPLY_2 = SymbolTerm.makeSymbol("*", 2);
+ static SymbolTerm SYM_DIVIDE_2 = SymbolTerm.makeSymbol("/", 2);
+ static SymbolTerm SYM_INTDIVIDE_2 = SymbolTerm.makeSymbol("//", 2);
+ static SymbolTerm SYM_MOD_2 = SymbolTerm.makeSymbol("mod", 2);
+ static SymbolTerm SYM_SHIFTLEFT_2 = SymbolTerm.makeSymbol("<<", 2);
+ static SymbolTerm SYM_SHIFTRIGHT_2 = SymbolTerm.makeSymbol(">>", 2);
+ static SymbolTerm SYM_NOT_1 = SymbolTerm.makeSymbol("\\", 1);
+ static SymbolTerm SYM_AND_2 = SymbolTerm.makeSymbol("/\\", 2);
+ static SymbolTerm SYM_OR_2 = SymbolTerm.makeSymbol("\\/", 2);
+ static SymbolTerm SYM_XOR_2 = SymbolTerm.makeSymbol("#", 2);
+ static SymbolTerm SYM_POW_2 = SymbolTerm.makeSymbol("**", 2);
+ static SymbolTerm SYM_ABS_1 = SymbolTerm.makeSymbol("abs", 1);
+ static SymbolTerm SYM_ACOS_1 = SymbolTerm.makeSymbol("acos", 1);
+ static SymbolTerm SYM_ASIN_1 = SymbolTerm.makeSymbol("asin", 1);
+ static SymbolTerm SYM_ATAN_1 = SymbolTerm.makeSymbol("atan", 1);
+ static SymbolTerm SYM_CEIL_1 = SymbolTerm.makeSymbol("ceiling", 1);
+ static SymbolTerm SYM_COS_1 = SymbolTerm.makeSymbol("cos", 1);
+ static SymbolTerm SYM_DEGREES_1 = SymbolTerm.makeSymbol("degrees", 1);
+ static SymbolTerm SYM_EXP_1 = SymbolTerm.makeSymbol("exp", 1);
+ static SymbolTerm SYM_FLOOR_1 = SymbolTerm.makeSymbol("floor", 1);
+ static SymbolTerm SYM_LOG_1 = SymbolTerm.makeSymbol("log", 1);
+ static SymbolTerm SYM_MAX_2 = SymbolTerm.makeSymbol("max", 2);
+ static SymbolTerm SYM_MIN_2 = SymbolTerm.makeSymbol("min", 2);
+ static SymbolTerm SYM_RADIANS_1 = SymbolTerm.makeSymbol("radians", 1);
+ static SymbolTerm SYM_RINT_1 = SymbolTerm.makeSymbol("rint", 1);
+ static SymbolTerm SYM_ROUND_1 = SymbolTerm.makeSymbol("round", 1);
+ static SymbolTerm SYM_SIN_1 = SymbolTerm.makeSymbol("sin", 1);
+ static SymbolTerm SYM_SQRT_1 = SymbolTerm.makeSymbol("sqrt", 1);
+ static SymbolTerm SYM_TAN_1 = SymbolTerm.makeSymbol("tan", 1);
+ static SymbolTerm SYM_REM_2 = SymbolTerm.makeSymbol("rem", 2);
+ static SymbolTerm SYM_SIGN_1 = SymbolTerm.makeSymbol("sign", 1);
+ static SymbolTerm SYM_FLOAT_1 = SymbolTerm.makeSymbol("float", 1);
+ static SymbolTerm SYM_INTPART_1 = SymbolTerm.makeSymbol("float_integer_part", 1);
+ static SymbolTerm SYM_FRACTPART_1 = SymbolTerm.makeSymbol("float_fractional_part", 1);
+ static SymbolTerm SYM_TRUNCATE_1 = SymbolTerm.makeSymbol("truncate", 1);
+
+ /**
+ * Evaluates <code>_t</code> as an arithmetic expression,
+ * and returns the resulting number as <code>NumberTerm</code>.
+ *
+ * @exception PInstantiationException if <code>_t</code> contains unbound variables.
+ * @exception IllegalDomainException if <code>_t</code> is not an arithmetic expression.
+ */
+ public static NumberTerm evaluate(Term _t)
+ throws PInstantiationException,IllegalDomainException {
+ Term t = _t.dereference();
+
+ if (t.isVariable())
+ throw new PInstantiationException();
+ else if (t.isInteger())
+ return (IntegerTerm)t;
+ else if (t.isDouble())
+ return (DoubleTerm)t;
+ else if (t.equals(SYM_RANDOM))
+ return new DoubleTerm(Math.random());
+ else if (t.equals(SYM_PI))
+ return new DoubleTerm(Math.PI);
+ else if (t.equals(SYM_E))
+ return new DoubleTerm(Math.E);
+ else if (t.isList())
+ return evaluate(((ListTerm)t).car());
+ else if (! t.isStructure())
+ throw new IllegalDomainException("arithmetic expression", t);
+
+ SymbolTerm func = ((StructureTerm)t).functor();
+ Term[] args = ((StructureTerm)t).args();
+
+ if (func.equals(SYM_ADD_1))
+ return evaluate(args[0]);
+ else if (func.equals(SYM_NEGATE_1))
+ return evaluate(args[0]).negate();
+ else if (func.equals(SYM_ADD_2))
+ return evaluate(args[0]).add(evaluate(args[1]));
+ else if (func.equals(SYM_SUBTRACT_2))
+ return evaluate(args[0]).subtract(evaluate(args[1]));
+ else if (func.equals(SYM_MULTIPLY_2))
+ return evaluate(args[0]).multiply(evaluate(args[1]));
+ else if (func.equals(SYM_INTDIVIDE_2))
+ return evaluate(args[0]).intDivide(evaluate(args[1]));
+ else if (func.equals(SYM_DIVIDE_2))
+ return evaluate(args[0]).divide(evaluate(args[1]));
+ else if (func.equals(SYM_MOD_2))
+ return evaluate(args[0]).mod(evaluate(args[1]));
+ else if (func.equals(SYM_REM_2))
+ return evaluate(args[0]).mod(evaluate(args[1]));
+ else if (func.equals(SYM_AND_2))
+ return evaluate(args[0]).and(evaluate(args[1]));
+ else if (func.equals(SYM_OR_2))
+ return evaluate(args[0]).or(evaluate(args[1]));
+ else if (func.equals(SYM_XOR_2))
+ return evaluate(args[0]).xor(evaluate(args[1]));
+ else if (func.equals(SYM_NOT_1))
+ return evaluate(args[0]).not();
+ else if (func.equals(SYM_SHIFTLEFT_2))
+ return evaluate(args[0]).shiftLeft(evaluate(args[1]));
+ else if (func.equals(SYM_SHIFTRIGHT_2))
+ return evaluate(args[0]).shiftRight(evaluate(args[1]));
+ else if (func.equals(SYM_ABS_1))
+ return evaluate(args[0]).abs();
+ else if (func.equals(SYM_MIN_2))
+ return evaluate(args[0]).min(evaluate(args[1]));
+ else if (func.equals(SYM_MAX_2))
+ return evaluate(args[0]).max(evaluate(args[1]));
+ else if (func.equals(SYM_RINT_1))
+ return evaluate(args[0]).rint();
+ else if (func.equals(SYM_ROUND_1))
+ return evaluate(args[0]).round();
+ else if (func.equals(SYM_FLOOR_1))
+ return evaluate(args[0]).floor();
+ else if (func.equals(SYM_CEIL_1))
+ return evaluate(args[0]).ceil();
+ else if (func.equals(SYM_SIN_1))
+ return evaluate(args[0]).sin();
+ else if (func.equals(SYM_COS_1))
+ return evaluate(args[0]).cos();
+ else if (func.equals(SYM_TAN_1))
+ return evaluate(args[0]).tan();
+ else if (func.equals(SYM_ASIN_1))
+ return evaluate(args[0]).asin();
+ else if (func.equals(SYM_ACOS_1))
+ return evaluate(args[0]).acos();
+ else if (func.equals(SYM_ATAN_1))
+ return evaluate(args[0]).atan();
+ else if (func.equals(SYM_SQRT_1))
+ return evaluate(args[0]).sqrt();
+ else if (func.equals(SYM_LOG_1))
+ return evaluate(args[0]).log();
+ else if (func.equals(SYM_EXP_1))
+ return evaluate(args[0]).exp();
+ else if (func.equals(SYM_POW_2))
+ return evaluate(args[0]).pow(evaluate(args[1]));
+ else if (func.equals(SYM_DEGREES_1))
+ return evaluate(args[0]).toDegrees();
+ else if (func.equals(SYM_RADIANS_1))
+ return evaluate(args[0]).toRadians();
+ else if (func.equals(SYM_SIGN_1))
+ return evaluate(args[0]).signum();
+ else if (func.equals(SYM_FLOAT_1))
+ return evaluate(args[0]).toFloat();
+ else if (func.equals(SYM_INTPART_1))
+ return evaluate(args[0]).floatIntPart();
+ else if (func.equals(SYM_FRACTPART_1))
+ return evaluate(args[0]).floatFractPart();
+ else if (func.equals(SYM_TRUNCATE_1))
+ return evaluate(args[0]).truncate();
+ else
+ throw new IllegalDomainException("arithmetic expression", t);
+ }
+}
diff --git a/src/lang/BlockPredicate.java b/src/lang/BlockPredicate.java
new file mode 100644
index 0000000..37696eb
--- /dev/null
+++ b/src/lang/BlockPredicate.java
@@ -0,0 +1,22 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * The <code>BlockPredicate</code> class is used to implement
+ * builtin-predicates. For example,
+ * <ul>
+ * <li><code>catch/3</code>
+ * <li><code>synchronized/2</code> (Prolog Cafe specific)
+ * </ul>
+ * <font color="red">This document is under construction.</font>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public abstract class BlockPredicate extends Predicate {
+ public boolean outOfScope = false;
+ public boolean outOfLoop = false;
+}
+
+
+
+
diff --git a/src/lang/BuiltinException.java b/src/lang/BuiltinException.java
new file mode 100644
index 0000000..72fe860
--- /dev/null
+++ b/src/lang/BuiltinException.java
@@ -0,0 +1,30 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Builtin exception.<br>
+ *
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class BuiltinException extends PrologException {
+ Term message;
+
+ /** Holds the goal in which this exception occurs. */
+ public Predicate goal = null;
+
+ /** Holds the arity of goal in which this exception occurs. */
+ public int argNo = 0;
+
+ /** Constructs a new <code>BuiltinException</code>. */
+ public BuiltinException(){}
+
+ /** Constructs a new <code>BuiltinException</code> with a given message term. */
+ public BuiltinException(Term _message){
+ message = _message;
+ }
+
+ public Term getMessageTerm() {
+ return message;
+ }
+}
diff --git a/src/lang/CPFStack.java b/src/lang/CPFStack.java
new file mode 100644
index 0000000..aee3299
--- /dev/null
+++ b/src/lang/CPFStack.java
@@ -0,0 +1,174 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * Choice point frame.<br>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+class CPFEntry implements Serializable {
+ public long timeStamp;
+ public Term[] args; // argument register
+ public Predicate cont; // continuation goal
+ public Predicate bp; // next cluase
+ public int tr; // trail pointer
+ public int b0; // cut point
+
+ protected CPFEntry(Term[] args, Predicate cont){
+ this.args = args;
+ this.cont = cont;
+ }
+
+ public String toString() {
+ String t = " time:" + timeStamp + "\n" ;
+ t = t + "args:";
+ for (int i=0; i<args.length; i++) {
+ t = t + args[i] + " ";
+ }
+ t = t + "\n";
+ t = t + " cont:" + cont + "\n";
+ t = t + " bp:" + bp + "\n";
+ t = t + " tr:" + tr + "\n";
+ t = t + " b0:" + b0 + "\n";
+ return t;
+ }
+}
+
+/**
+ * Choice point frame stack.<br>
+ * The <code>CPFStack</code> class represents a stack
+ * of choice point frames.<br>
+ * Each choice point frame has the following fields:
+ * <ul>
+ * <li><em>arguments</em>
+ * <li><em>continuation goal</em>
+ * <li><em>next clause</em>
+ * <li><em>trail pointer</em>
+ * <li><em>cut point</em>
+ * <li><em>time stamp</em>
+ * </ul>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class CPFStack implements Serializable {
+ /** Maximum size of enties. Initial size is <code>20000</code>. */
+ protected int maxContents = 20000;
+
+ /** An array of choice point frames. */
+ protected CPFEntry[] buffer;
+
+ /** the top index of this <code>CPFStack</code>. */
+ protected int top;
+
+ /** Holds the Prolog engine that this <code>CPFStack</code> belongs to. */
+ protected Prolog engine;
+
+ /** Constructs a new choice point frame stack. */
+ public CPFStack(Prolog _engine) {
+ engine = _engine;
+ buffer = new CPFEntry[maxContents];
+ top = -1;
+ }
+
+ /** Constructs a new choice point frame stack with the given size. */
+ public CPFStack(Prolog _engine, int n) {
+ engine = _engine;
+ maxContents = n;
+ buffer = new CPFEntry[maxContents];
+ top = -1;
+ }
+
+ /** Create a new choice point frame.
+ * @param args <em>arguments</em>
+ * @param p a <em>continuation goal</em>
+ */
+ public void create(Term[] args, Predicate p){
+ try {
+ buffer[++top] = new CPFEntry(args, p);
+ } catch (ArrayIndexOutOfBoundsException e) {
+ System.out.println("{expanding choice point stack...}");
+ int len = buffer.length;
+ CPFEntry[] new_buffer = new CPFEntry[len+10000];
+ for(int i=0; i<len; i++) {
+ new_buffer[i] = buffer[i];
+ }
+ buffer = new_buffer;
+ buffer[top] = new CPFEntry(args, p);
+ maxContents = len+10000;
+ }
+ }
+
+ /** Discards all choice points. */
+ public void deleteAll() {
+ while (! empty()) {
+ buffer[top--] = null;
+ }
+ }
+
+ /** Discards all choice points after the value of <code>i</code>. */
+ public void cut(int i) {
+ while (top > i) {
+ buffer[top--] = null;
+ }
+ }
+
+ /** Discards the top of choice points. */
+ public void delete() { buffer[top--] = null; }
+
+ /** Discards all choice points. */
+ public void init() { deleteAll(); }
+
+ /** Tests if this stack has no entry. */
+ public boolean empty() { return top == -1; }
+
+ /** Returns the value of <code>top</code>.
+ * @see #top
+ */
+ public int top() { return top; }
+
+ /** Returns the value of <code>maxContents</code>.
+ * @see #maxContents
+ */
+ public int max() { return maxContents; }
+
+ /** Returns the <em>arguments</em> of current choice point frame. */
+ public Term[] getArgs() { return buffer[top].args; }
+
+ /** Returns the <em>continuation goal</em> of current choice point frame. */
+ public Predicate getCont() { return buffer[top].cont; }
+
+ /** Returns the <em>time stamp</em> of current choice point frame. */
+ public long getTimeStamp() { return buffer[top].timeStamp; }
+ /** Sets the <em>time stamp</em> of current choice point frame. */
+ public void setTimeStamp(long t) { buffer[top].timeStamp = t; }
+
+ /** Returns the <em>next clause</em> of current choice point frame. */
+ public Predicate getBP() { return buffer[top].bp; }
+ /** Sets the <em>next clause</em> of current choice point frame. */
+ public void setBP(Predicate p) { buffer[top].bp = p; }
+
+ /** Returns the <em>trail pointer</em> of current choice point frame. */
+ public int getTR() { return buffer[top].tr; }
+ /** Sets the <em>trail pointer</em> of current choice point frame. */
+ public void setTR(int i) { buffer[top].tr = i; }
+
+ /** Returns the <em>cut point</em> of current choice point frame. */
+ public int getB0() { return buffer[top].b0; }
+ /** Sets the <em>cut point</em> of current choice point frame. */
+ public void setB0(int i) { buffer[top].b0 = i; }
+
+ /** Shows the contents of this <code>CPFStack</code>. */
+ public void show() {
+ if (empty()) {
+ System.out.println("{choice point stack is empty!}");
+ return;
+ }
+ for (int i=0; i<=top; i++) {
+ System.out.print("stack[" + i + "]: ");
+ System.out.println(buffer[i]);
+ }
+ }
+}
diff --git a/src/lang/ClosureTerm.java b/src/lang/ClosureTerm.java
new file mode 100644
index 0000000..1829aa5
--- /dev/null
+++ b/src/lang/ClosureTerm.java
@@ -0,0 +1,76 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.*;
+/**
+ * Closure.<br>
+ * The class <code>ClosureTerm</code> represents a closure structure.<br>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class ClosureTerm extends Term {
+ /** Holds a <code>Predicate</code> object that represents a Prolog goal. */
+ protected Predicate code;
+
+ /** Constructs a new closure structure for the given Prolog goal. */
+ public ClosureTerm(Predicate _code) { code = _code; }
+
+ /** Returns the Prolog goal of this <code>ClosureTerm</code>. */
+ public Predicate getCode() { return code; }
+
+ /* Term */
+ public boolean unify(Term t, Trail trail) {
+ // t = t.dereference();
+ if (t.isVariable())
+ return ((VariableTerm)t).unify(this, trail);
+ if (! t.isClosure())
+ return false;
+ return code.equals(((ClosureTerm)t).code);
+ }
+
+ public String toQuotedString() { return toString(); }
+
+ /* Object */
+ /**
+ * Checks <em>term equality</em> of two terms.
+ * The result is <code>true</code> if and only if the argument is an instance of
+ * <code>ClosureTerm</code>, and
+ * the pairs of goals in the two closures are <em>equal</em>.
+ * @param obj the object to compare with. This must be dereferenced.
+ * @return <code>true</code> if the given object represents a closure
+ * equivalent to this <code>ClosureTerm</code>, false otherwise.
+ * @see #compareTo
+ */
+ public boolean equals(Object obj) { // obj must be dereferenced
+ if (! (obj instanceof ClosureTerm))
+ return false;
+ return code.equals(((ClosureTerm)obj).code);
+ }
+
+ public int hashCode() {
+ return code.hashCode();
+ }
+
+ /** Returns a string representation of this <code>ClosureTerm</code>. */
+ public String toString() {
+ return "closure[" + code.toString() + "]";
+ }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compared with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced
+ if (! anotherTerm.isClosure())
+ return AFTER;
+ if (code.equals(((ClosureTerm) anotherTerm).code))
+ return EQUAL;
+ return code.hashCode() - ((ClosureTerm) anotherTerm).code.hashCode(); //???
+ }
+}
diff --git a/src/lang/DoubleTerm.java b/src/lang/DoubleTerm.java
new file mode 100644
index 0000000..a58adf2
--- /dev/null
+++ b/src/lang/DoubleTerm.java
@@ -0,0 +1,253 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Floating point number.
+ * The class <code>DoubleTerm</code> wraps a value of
+ * primitive type <code>double</code>.
+ *
+ * <pre>
+ * Term t = new DoubleTerm(3.3333);
+ * double d = ((DoubleTerm)t).doubleValue();
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+*/
+public class DoubleTerm extends NumberTerm {
+ /** Holds a <code>double</code> value that this <code>DoubleTerm</code> represents. */
+ protected double val;
+
+ /**
+ * Constructs a new Prolog floating point number
+ * that represents the specified <code>double</code> value.
+ */
+ public DoubleTerm(double i) { val = i; }
+
+ /**
+ * Returns the value of <code>val</code>.
+ * @see #val
+ */
+ public double value() { return val; }
+
+ /* Term */
+ public boolean unify(Term t, Trail trail) {
+ if (t.isVariable())
+ return ((VariableTerm)t).unify(this, trail);
+ if (! t.isDouble())
+ return false;
+ return this.val == ((DoubleTerm)t).value();
+ }
+
+ /**
+ * @return the <code>boolean</code> whose value is
+ * <code>convertible(Double.class, type)</code>.
+ * @see Term#convertible(Class, Class)
+ */
+ public boolean convertible(Class type) { return convertible(Double.class, type); }
+
+ // protected Term copy(Prolog engine) { return new DoubleTerm(val); }
+
+ /**
+ * Returns a <code>java.lang.Double</code> corresponds to this <code>DoubleTerm</code>
+ * according to <em>Prolog Cafe interoperability with Java</em>.
+ * @return a <code>java.lang.Double</code> object equivalent to
+ * this <code>DoubleTerm</code>.
+ */
+ public Object toJava() { return new Double(this.val); }
+
+ /* Object */
+ /** Returns a string representation of this <code>DoubleTerm</code>. */
+ public String toString() { return Double.toString(this.val); }
+
+ /**
+ * Checks <em>term equality</em> of two terms.
+ * The result is <code>true</code> if and only if the argument is an instance of
+ * <code>DoubleTerm</code> and has the same <code>double</code> value as this object.
+ * @param obj the object to compare with. This must be dereferenced.
+ * @return <code>true</code> if the given object represents a Prolog floating
+ * point number equivalent to this <code>DoubleTerm</code>, false otherwise.
+ * @see #compareTo
+ */
+ public boolean equals(Object obj) {
+ if (! (obj instanceof DoubleTerm))
+ return false;
+ return Double.doubleToLongBits(this.val) == Double.doubleToLongBits(((DoubleTerm)obj).val);
+ }
+
+ public int hashCode() {
+ long bits = Double.doubleToLongBits(this.val);
+ return (int)(bits ^ (bits >>> 32));
+ }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compared with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced
+ if (anotherTerm.isVariable())
+ return AFTER;
+ if (! anotherTerm.isDouble())
+ return BEFORE;
+ return Double.compare(this.val, ((DoubleTerm)anotherTerm).value());
+ }
+
+ /* NumberTerm */
+ public int intValue() { return (int)val; }
+
+ public long longValue() { return (long)val; }
+
+ public double doubleValue() { return val; }
+
+ public int arithCompareTo(NumberTerm t) {
+ return Double.compare(this.val, t.doubleValue());
+ }
+
+ public NumberTerm abs() { return new DoubleTerm(Math.abs(this.val)); }
+
+ public NumberTerm acos() { return new DoubleTerm(Math.acos(this.val)); }
+
+ public NumberTerm add(NumberTerm t) { return new DoubleTerm(this.val + t.doubleValue()); }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm and(NumberTerm t) { throw new IllegalTypeException("integer", this); }
+ // public NumberTerm and(NumberTerm t) { return new IntegerTerm(this.intValue() & t.intValue()); }
+
+ public NumberTerm asin() { return new DoubleTerm(Math.asin(this.val)); }
+
+ public NumberTerm atan() { return new DoubleTerm(Math.atan(this.val)); }
+
+ public NumberTerm ceil() { return new IntegerTerm((int) Math.ceil(this.val)); }
+
+ public NumberTerm cos() { return new DoubleTerm(Math.cos(this.val)); }
+
+ /**
+ * @exception EvaluationException if the given argument
+ * <code>NumberTerm</code> represents <coe>0</code>.
+ */
+ public NumberTerm divide(NumberTerm t) {
+ if (t.doubleValue() == 0)
+ throw new EvaluationException("zero_divisor");
+ return new DoubleTerm(this.val / t.doubleValue());
+ }
+
+ public NumberTerm exp() { return new DoubleTerm(Math.exp(this.val)); }
+
+ public NumberTerm floatIntPart() {
+ return new DoubleTerm(Math.signum(this.val) * Math.floor(Math.abs(this.val)));
+ }
+
+ public NumberTerm floatFractPart() {
+ return new DoubleTerm(this.val - Math.signum(this.val) * Math.floor(Math.abs(this.val)));
+ }
+
+ public NumberTerm floor() { return new IntegerTerm((int) Math.floor(this.val)); }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm intDivide(NumberTerm t) { throw new IllegalTypeException("integer", this); }
+ // public NumberTerm intDivide(NumberTerm t) { return new IntegerTerm((int)(this.intValue() / t.intValue())); }
+
+ /**
+ * @exception EvaluationException if this object represents <coe>0</code>.
+ */
+ public NumberTerm log() {
+ if (this.val == 0)
+ throw new EvaluationException("undefined");
+ return new DoubleTerm(Math.log(this.val));
+ }
+
+ public NumberTerm max(NumberTerm t) { return new DoubleTerm(Math.max(this.val, t.doubleValue())); }
+
+ public NumberTerm min(NumberTerm t) { return new DoubleTerm(Math.min(this.val, t.doubleValue())); }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm mod(NumberTerm t) { throw new IllegalTypeException("integer", this); }
+ // public NumberTerm mod(NumberTerm t) { return new IntegerTerm(this.intValue() % t.intValue()); }
+
+ public NumberTerm multiply(NumberTerm t) { return new DoubleTerm(this.val * t.doubleValue()); }
+
+ public NumberTerm negate() { return new DoubleTerm(- this.val); }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm not() { throw new IllegalTypeException("integer", this); }
+ // public NumberTerm not() { return new IntegerTerm(~ this.intValue()); }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm or(NumberTerm t) { throw new IllegalTypeException("integer", this); }
+ // public NumberTerm or(NumberTerm t) { return new IntegerTerm(this.intValue() | t.intValue()); }
+
+ public NumberTerm pow(NumberTerm t) { return new DoubleTerm(Math.pow(this.val, t.doubleValue())); }
+
+ public NumberTerm rint() { return new DoubleTerm(Math.rint(this.val)); }
+
+ public NumberTerm round() { return new IntegerTerm((int) Math.round(this.val)); }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm shiftLeft(NumberTerm t) { throw new IllegalTypeException("integer", this); }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm shiftRight(NumberTerm t) { throw new IllegalTypeException("integer", this); }
+
+ public NumberTerm signum() {return new DoubleTerm(Math.signum(this.val)); }
+
+ public NumberTerm sin() { return new DoubleTerm(Math.sin(this.val)); }
+
+ /**
+ * @exception EvaluationException if this object represents
+ * a floating point number less than <coe>0</code>.
+ */
+ public NumberTerm sqrt() {
+ if (this.val < 0)
+ throw new EvaluationException("undefined");
+ return new DoubleTerm(Math.sqrt(this.val));
+ }
+
+ public NumberTerm subtract(NumberTerm t) { return new DoubleTerm(this.val - t.doubleValue()); }
+
+ public NumberTerm tan() { return new DoubleTerm(Math.tan(this.val)); }
+
+ public NumberTerm toDegrees() { return new DoubleTerm(Math.toDegrees(this.val)); }
+
+ public NumberTerm toFloat() { return this; }
+
+ public NumberTerm toRadians() { return new DoubleTerm(Math.toRadians(this.val)); }
+
+ public NumberTerm truncate() {
+ if (this.val >= 0)
+ return new IntegerTerm((int) Math.floor(this.val));
+ else
+ return new IntegerTerm((int) (-1 * Math.floor(Math.abs(this.val))));
+ }
+
+ /**
+ * Throws a <code>type_error</code>.
+ * @exception IllegalTypeException
+ */
+ public NumberTerm xor(NumberTerm t) { throw new IllegalTypeException("integer", this); }
+}
diff --git a/src/lang/EvaluationException.java b/src/lang/EvaluationException.java
new file mode 100644
index 0000000..b8324c2
--- /dev/null
+++ b/src/lang/EvaluationException.java
@@ -0,0 +1,52 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Evaluation error.<br>
+ * There will be an evaluation error when the operands
+ * of an evaluable functor are such that the operation
+ * has an exceptional value.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class EvaluationException extends BuiltinException {
+ /** A functor symbol of <code>evaluation_error/3</code>. */
+ public static SymbolTerm EVALUATION_ERROR = SymbolTerm.makeSymbol("evaluation_error", 3);
+
+ /* errorType ::= float_overflow | int_overflow | undefined | underflow | zero_devisor */
+ /** Holds a string representation of error type. */
+ public String errorType;
+
+ /** Constructs a new <code>EvaluationException</code> with an error type. */
+ public EvaluationException(String _errorType) {
+ errorType = _errorType;
+ }
+
+ /** Constructs a new <code>EvaluationException</code> with the given arguments. */
+ public EvaluationException(Predicate _goal, int _argNo, String _errorType) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ errorType = _errorType;
+ }
+
+ /** Returns a term representation of this <code>EvaluationException</code>:
+ * <code>evaluation_error(goal,argNo,errorType)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ new IntegerTerm(argNo),
+ SymbolTerm.makeSymbol(errorType)};
+ return new StructureTerm(EVALUATION_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>EvaluationException</code>. */
+ public String toString() {
+ String s = "{EVALUATION ERROR: " + goal.toString();
+ if (argNo > 0)
+ s += " - arg " + argNo;
+ s += ", found " + errorType;
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/ExistenceException.java b/src/lang/ExistenceException.java
new file mode 100644
index 0000000..faaef07
--- /dev/null
+++ b/src/lang/ExistenceException.java
@@ -0,0 +1,65 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Existence error.<br>
+ * There will be an existence error when the object
+ * on which an operation is to be performed does not exist.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class ExistenceException extends BuiltinException {
+ /** A functor symbol of <code>existence_error/5</code>. */
+ public static SymbolTerm EXISTENCE_ERROR = SymbolTerm.makeSymbol("existence_error", 5);
+
+ /* objType ::= procedure | source_sink | stream | hash */
+ /** Holds a string representation of object type. */
+ public String objType;
+
+ /** Holds the argument or one of its components which caused the error. */
+ public Term culprit;
+
+ /** Holds a string representation of detail message. */
+ public String message;
+
+ /** Constructs a new <code>ExistenceException</code>
+ * with a object type, its culprit, and message. */
+ public ExistenceException(String _objType, Term _culprit, String _message) {
+ objType = _objType;
+ culprit = _culprit;
+ message = _message;
+ }
+
+ /** Constructs a new <code>ExistenceException</code>
+ * with the given arguments. */
+ public ExistenceException(Predicate _goal, int _argNo, String _objType, Term _culprit, String _message) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ objType = _objType;
+ culprit = _culprit;
+ message = _message;
+ }
+
+ /** Returns a term representation of this <code>ExistenceException</code>:
+ * <code>existence_error(goal,argNo,objType,culprit,message)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ new IntegerTerm(argNo),
+ SymbolTerm.makeSymbol(objType),
+ culprit,
+ SymbolTerm.makeSymbol(message)};
+ return new StructureTerm(EXISTENCE_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>ExistenceException</code>. */
+ public String toString() {
+ String s = "{EXISTENCE ERROR:";
+ if (argNo > 0)
+ s += " " + goal.toString() + " - arg " + argNo + ":";
+ s += objType + " " + culprit.toString() + " does not exist";
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/Failure.java b/src/lang/Failure.java
new file mode 100644
index 0000000..7f8d8fc
--- /dev/null
+++ b/src/lang/Failure.java
@@ -0,0 +1,33 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Initial backtrak point.<br>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2
+ */
+public class Failure extends Predicate {
+ /** Prolog thread that this <code>Failure</code> belongs to. */
+ public PrologControl c;
+
+ /** Constructs a new initial backtrak point. */
+ public Failure(){}
+
+ /** Constructs a new initial backtrak point with given Prolog thread. */
+ public Failure(PrologControl c) {
+ this.c = c;
+ }
+
+ public Predicate exec(Prolog engine) {
+ c.fail();
+ engine.exceptionRaised = 1; // halt
+ return null;
+ }
+
+ /** Returns a string representation of this <code>Failure</code>. */
+ public String toString(){ return "Failure"; }
+
+ /** Returns <code>0</code>. */
+ public int arity() { return 0; }
+}
+
diff --git a/src/lang/HashtableOfTerm.java b/src/lang/HashtableOfTerm.java
new file mode 100644
index 0000000..7726b14
--- /dev/null
+++ b/src/lang/HashtableOfTerm.java
@@ -0,0 +1,21 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.Hashtable;
+/**
+ * <code>Hashtable<Term,Term></code>.<br>
+ * <font color="red">This document is under construction.</font>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class HashtableOfTerm extends Hashtable<Term,Term> {
+ public HashtableOfTerm() {
+ super();
+ }
+ public HashtableOfTerm(int initialCapacity) {
+ super(initialCapacity);
+ }
+ public HashtableOfTerm(int initialCapacity, float loadFactor) {
+ super(initialCapacity, loadFactor);
+ }
+}
\ No newline at end of file
diff --git a/src/lang/IllegalDomainException.java b/src/lang/IllegalDomainException.java
new file mode 100644
index 0000000..2d2fd5e
--- /dev/null
+++ b/src/lang/IllegalDomainException.java
@@ -0,0 +1,68 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Domain error.<br>
+ * There will be a domain error when the type of an argument
+ * is correct, but the value is outside the domain for which
+ * the procedure is defined.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class IllegalDomainException extends BuiltinException {
+ /** A functor symbol of <code>domain_error/4</code>. */
+ public static SymbolTerm DOMAIN_ERROR = SymbolTerm.makeSymbol("domain_error", 4);
+
+ /*
+ domain ::= character_code_list | close_option | flag_value | io_mode |
+ non_empty_list | not_less_than_zero | operator_priority |
+ operator_specifier | prolog_flag | read_option | source_sink |
+ stream | steam_option | stream_or_alias | stream_position |
+ stream_property | write_option |
+ hash_or_alias| hash_option | 'arithmetic expression'
+ */
+ /** Holds a string representation of valid domain. */
+ public String domain;
+
+ /** Holds the argument or one of its components which caused the error. */
+ public Term culprit;
+
+ /** Constructs a new <code>IllegalDomainException</code>
+ * with a valid domain and its culprit. */
+ public IllegalDomainException(String _domain, Term _culprit) {
+ domain = _domain;
+ culprit = _culprit;
+ }
+
+ /** Constructs a new <code>IllegalDomainException</code>
+ * with the given arguments. */
+ public IllegalDomainException(Predicate _goal, int _argNo, String _domain, Term _culprit) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ domain = _domain;
+ culprit = _culprit;
+ }
+
+ /** Returns a term representation of this <code>IllegalDomainException</code>:
+ * <code>domain_error(goal,argNo,type,culprit)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ new IntegerTerm(argNo),
+ SymbolTerm.makeSymbol(domain),
+ culprit};
+ return new StructureTerm(DOMAIN_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>IllegalDomainException</code>. */
+ public String toString() {
+ String s = "{DOMAIN ERROR: " + goal.toString();
+ if (argNo > 0)
+ s += " - arg " + argNo;
+ s += ": expected " + domain;
+ s += ", found " + culprit.toString();
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/IllegalTypeException.java b/src/lang/IllegalTypeException.java
new file mode 100644
index 0000000..7e04fc7
--- /dev/null
+++ b/src/lang/IllegalTypeException.java
@@ -0,0 +1,65 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Type error.<br>
+ * There will be a type error when the type of an argument or
+ * one of its components is incorrect, but not a variable.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class IllegalTypeException extends BuiltinException {
+ /** A functor symbol of <code>type_error/4</code>. */
+ public static SymbolTerm TYPE_ERROR = SymbolTerm.makeSymbol("type_error", 4);
+
+ /*
+ type ::= atom | atomic | byte | callable | character | compound | evaluable |
+ in_byte | in_character | integer | list | number |
+ predicate_indicator | variable |
+ flaot | java
+ */
+ /** Holds a string representation of valid type. */
+ public String type;
+
+ /** Holds the argument or one of its components which caused the error. */
+ public Term culprit;
+
+ /** Constructs a new <code>IllegalTypeException</code>
+ * with a valid type and its culprit. */
+ public IllegalTypeException(String _type, Term _culprit) {
+ type = _type;
+ culprit = _culprit;
+ }
+
+ /** Constructs a new <code>IllegalTypeException</code>
+ * with the given arguments. */
+ public IllegalTypeException(Predicate _goal, int _argNo, String _type, Term _culprit) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ type = _type;
+ culprit = _culprit;
+ }
+
+ /** Returns a term representation of this <code>IllegalTypeException</code>:
+ * <code>type_error(goal,argNo,type,culprit)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ new IntegerTerm(argNo),
+ SymbolTerm.makeSymbol(type),
+ culprit};
+ return new StructureTerm(TYPE_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>IllegalTypeException</code>. */
+ public String toString() {
+ String s = "{TYPE ERROR: " + goal.toString();
+ if (argNo > 0)
+ s += " - arg " + argNo;
+ s += ": expected " + type;
+ s += ", found " + culprit.toString();
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/IntegerTerm.java b/src/lang/IntegerTerm.java
new file mode 100644
index 0000000..f0cf875
--- /dev/null
+++ b/src/lang/IntegerTerm.java
@@ -0,0 +1,311 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Integer.<br>
+ * The class <code>IntegerTerm</code> wraps a value of primitive type
+ * <code>int</code>.
+ * <pre>
+ * Term t = new IntegerTerm(100);
+ * int i = ((IntegerTerm)t).intValue();
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class IntegerTerm extends NumberTerm {
+ /** Holds an <code>int</code> value that this <code>IntegerTerm</code> represents. */
+ protected int val;
+
+ /** Constructs a new Prolog integer that represents the specified <code>int</code> value. */
+ public IntegerTerm(int i) { val = i; }
+
+ /**
+ * Constructs a new Prolog integer that represents integer value
+ * of specified <code>String</code> parameter.
+ * @exception NumberFormatException
+ * if the <code>String</code> does not contain a parsable integer.
+ */
+ public IntegerTerm(String i) {
+ try {
+ val = Integer.parseInt(i);
+ } catch (NumberFormatException e) {
+ throw e;
+ }
+ }
+
+ /**
+ * Returns the value of <code>val</code>.
+ * @see #val
+ */
+ public int value() { return val; }
+
+ /* Term */
+ public boolean unify(Term t, Trail trail) {
+ if (t.isVariable())
+ return ((VariableTerm)t).unify(this, trail);
+ if (! t.isInteger())
+ return false;
+ else
+ return this.val == ((IntegerTerm)t).value();
+ }
+
+ /**
+ * @return the <code>boolean</code> whose value is
+ * <code>convertible(Integer.class, type)</code>.
+ * @see Term#convertible(Class, Class)
+ */
+ public boolean convertible(Class type) { return convertible(Integer.class, type); }
+
+ // protected Term copy(Prolog engine) { return new IntegerTerm(val); }
+
+ /**
+ * Returns a <code>java.lang.Integer</code> corresponds to this <code>IntegerTerm</code>
+ * according to <em>Prolog Cafe interoperability with Java</em>.
+ * @return a <code>java.lang.Integer</code> object equivalent to
+ * this <code>IntegerTerm</code>.
+ */
+ public Object toJava() { return new Integer(this.val); }
+
+ /* Object */
+ /** Returns a string representation of this <code>IntegerTerm</code>. */
+ public String toString() { return Integer.toString(this.val); }
+
+ /**
+ * Checks <em>term equality</em> of two terms.
+ * The result is <code>true</code> if and only if the argument is an instance of
+ * <code>IntegerTerm</code> and has the same <code>int</code> value as this object.
+ * @param obj the object to compare with. This must be dereferenced.
+ * @return <code>true</code> if the given object represents a Prolog integer
+ * equivalent to this <code>IntegerTerm</code>, false otherwise.
+ * @see #compareTo
+ */
+ public boolean equals(Object obj) {
+ if (! (obj instanceof IntegerTerm))
+ return false;
+ return this.val == ((IntegerTerm)obj).value();
+ }
+
+ public int hashCode() { return this.val; }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compared with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced.
+ if (anotherTerm.isVariable() || anotherTerm.isDouble())
+ return AFTER;
+ if (! anotherTerm.isInteger())
+ return BEFORE;
+ int v = ((IntegerTerm)anotherTerm).value();
+ if (this.val == v)
+ return EQUAL;
+ if (this.val > v)
+ return AFTER;
+ return BEFORE;
+ }
+
+ /* NumberTerm */
+ public int intValue() { return this.val; }
+
+ public long longValue() { return (long)(this.val); }
+
+ public double doubleValue() { return (double)(this.val); }
+
+ public int arithCompareTo(NumberTerm t) {
+ if (t.isDouble())
+ return - (t.arithCompareTo(this));
+ int v = t.intValue();
+ if (this.val == v)
+ return EQUAL;
+ if (this.val > v)
+ return AFTER;
+ return BEFORE;
+ }
+
+ public NumberTerm abs() { return new IntegerTerm(Math.abs(this.val)); }
+
+ public NumberTerm acos() { return new DoubleTerm(Math.acos(this.doubleValue())); }
+
+ public NumberTerm add(NumberTerm t) {
+ if (t.isDouble())
+ return t.add(this);
+ return new IntegerTerm(this.val + t.intValue());
+ }
+
+ /**
+ * @exception IllegalTypeException if the given argument
+ * <code>NumberTerm</code> is a floating point number.
+ */
+ public NumberTerm and(NumberTerm t) {
+ if (t.isDouble())
+ throw new IllegalTypeException("integer", t);
+ return new IntegerTerm(this.val & t.intValue());
+ }
+
+ public NumberTerm asin() { return new DoubleTerm(Math.asin(this.doubleValue())); }
+
+ public NumberTerm atan() { return new DoubleTerm(Math.atan(this.doubleValue())); }
+
+ public NumberTerm ceil() { return this; }
+
+ public NumberTerm cos() { return new DoubleTerm(Math.cos(this.doubleValue())); }
+
+ /**
+ * @exception EvaluationException if the given argument
+ * <code>NumberTerm</code> represents <coe>0</code>.
+ */
+ public NumberTerm divide(NumberTerm t) {
+ if (t.doubleValue() == 0)
+ throw new EvaluationException("zero_divisor");
+ return new DoubleTerm(this.doubleValue() / t.doubleValue());
+ }
+
+ public NumberTerm exp() { return new DoubleTerm(Math.exp(this.doubleValue())); }
+
+ public NumberTerm floatIntPart() { throw new IllegalTypeException("float", this); }
+
+ public NumberTerm floatFractPart() { throw new IllegalTypeException("float", this); }
+
+ public NumberTerm floor() { return this; }
+
+ /**
+ * @exception IllegalTypeException if the given argument
+ * <code>NumberTerm</code> is a floating point number.
+ * @exception EvaluationException if the given argument
+ * <code>NumberTerm</code> represents <coe>0</code>.
+ */
+ public NumberTerm intDivide(NumberTerm t) {
+ if (t.isDouble())
+ throw new IllegalTypeException("integer", t);
+ if (t.intValue() == 0)
+ throw new EvaluationException("zero_divisor");
+ return new IntegerTerm((int) (this.val / t.intValue()));
+ }
+
+ /**
+ * @exception EvaluationException if this object represents <coe>0</code>.
+ */
+ public NumberTerm log() {
+ if (this.val == 0)
+ throw new EvaluationException("undefined");
+ return new DoubleTerm(Math.log(this.doubleValue()));
+ }
+
+ public NumberTerm max(NumberTerm t) {
+ if (t.isDouble())
+ return t.max(this);
+ return new IntegerTerm(Math.max(this.val, t.intValue()));
+ }
+
+ public NumberTerm min(NumberTerm t) {
+ if (t.isDouble())
+ return t.min(this);
+ return new IntegerTerm(Math.min(this.val, t.intValue()));
+ }
+
+ /**
+ * @exception IllegalTypeException if the given argument
+ * <code>NumberTerm</code> is a floating point number.
+ * @exception EvaluationException if the given argument
+ * <code>NumberTerm</code> represents <coe>0</code>.
+ */
+ public NumberTerm mod(NumberTerm t) {
+ if (t.isDouble())
+ throw new IllegalTypeException("integer", t);
+ if (t.intValue() == 0)
+ throw new EvaluationException("zero_divisor");
+ return new IntegerTerm(this.val % t.intValue());
+ }
+
+ public NumberTerm multiply(NumberTerm t) {
+ if (t.isDouble())
+ return t.multiply(this);
+ return new IntegerTerm(this.val * t.intValue());
+ }
+
+ public NumberTerm negate() { return new IntegerTerm(- this.val); }
+
+ public NumberTerm not() { return new IntegerTerm(~ this.val); }
+
+ /**
+ * @exception IllegalTypeException if the given argument
+ * <code>NumberTerm</code> is a floating point number.
+ */
+ public NumberTerm or(NumberTerm t) {
+ if (t.isDouble())
+ throw new IllegalTypeException("integer", t);
+ return new IntegerTerm(this.val | t.intValue());
+ }
+
+ public NumberTerm pow(NumberTerm t) { return new DoubleTerm(Math.pow(this.doubleValue(), t.doubleValue())); }
+
+ public NumberTerm rint() { return new DoubleTerm(this.doubleValue()); }
+
+ public NumberTerm round() { return this; }
+
+ /**
+ * @exception IllegalTypeException if the given argument
+ * <code>NumberTerm</code> is a floating point number.
+ */
+ public NumberTerm shiftLeft(NumberTerm t) {
+ if (t.isDouble())
+ throw new IllegalTypeException("integer", t);
+ return new IntegerTerm(this.val << t.intValue());
+ }
+
+ /**
+ * @exception IllegalTypeException if the given argument
+ * <code>NumberTerm</code> is a floating point number.
+ */
+ public NumberTerm shiftRight(NumberTerm t) {
+ if (t.isDouble())
+ throw new IllegalTypeException("integer", t);
+ return new IntegerTerm(this.val >> t.intValue());
+ }
+
+ public NumberTerm signum() {return new IntegerTerm((int) Math.signum((double) this.val)); }
+
+ public NumberTerm sin() { return new DoubleTerm(Math.sin(this.doubleValue())); }
+
+ /**
+ * @exception EvaluationException if this object represents
+ * an integer less than <coe>0</code>.
+ */
+ public NumberTerm sqrt() {
+ if (this.val < 0)
+ throw new EvaluationException("undefined");
+ return new DoubleTerm(Math.sqrt(this.doubleValue()));
+ }
+
+ public NumberTerm subtract(NumberTerm t) {
+ if (t.isDouble())
+ return new DoubleTerm(this.doubleValue() - t.doubleValue());
+ return new IntegerTerm(this.val - t.intValue());
+ }
+
+ public NumberTerm tan() { return new DoubleTerm(Math.tan(this.doubleValue())); }
+
+ public NumberTerm toDegrees() { return new DoubleTerm(Math.toDegrees(this.doubleValue())); }
+
+ public NumberTerm toFloat() { return new DoubleTerm((double) this.val); }
+
+ public NumberTerm toRadians() { return new DoubleTerm(Math.toRadians(this.doubleValue())); }
+
+ public NumberTerm truncate() { return this; }
+
+ /**
+ * @exception IllegalTypeException if the given argument
+ * <code>NumberTerm</code> is a floating point number.
+ */
+ public NumberTerm xor(NumberTerm t) {
+ if (t.isDouble())
+ throw new IllegalTypeException("integer", t);
+ return new IntegerTerm(this.val ^ t.intValue());
+ }
+}
diff --git a/src/lang/InternalDatabase.java b/src/lang/InternalDatabase.java
new file mode 100644
index 0000000..a70862a
--- /dev/null
+++ b/src/lang/InternalDatabase.java
@@ -0,0 +1,108 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+import java.util.LinkedList;
+/**
+ * Internal database for dynamic predicates.<br>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class InternalDatabase implements Serializable {
+ /** Maximum size of enties. Initial size is <code>100000</code>. */
+ protected int maxContents = 100000;
+
+ /** An array of <code>Term</code> entries. */
+ protected Term[] buffer;
+
+ /* For GC */
+ /** A list of reusable entry indices. */
+ protected LinkedList<Integer> reusableIndices = new LinkedList<Integer>();
+
+ /** the top index of this <code>InternalDatabase</code>. */
+ protected int top;
+
+ /** Constructs a new internal dababase. */
+ public InternalDatabase() {
+ buffer = new Term[maxContents];
+ top = -1;
+ }
+
+ /** Constructs a new internal dababase with the given size. */
+ public InternalDatabase(int n) {
+ maxContents = n;
+ buffer = new Term[maxContents];
+ top = -1;
+ }
+
+ /** Discards all entries. */
+ public void init() { eraseAll(); }
+
+ /** Inserts an entry to this <code>InternalDatabase</code>. */
+ public int insert(Term t) {
+ try {
+ if (reusableIndices.isEmpty()) {
+ buffer[++top] = t;
+ return top;
+ } else {
+ int i = reusableIndices.remove();
+ // System.out.println("Reuse " + i);
+ buffer[i] = t;
+ return i;
+ }
+ } catch (ArrayIndexOutOfBoundsException e) {
+ System.out.println("{expanding internal database...}");
+ int len = buffer.length;
+ Term[] new_buffer = new Term[len+10000];
+ for(int i=0; i<len; i++){
+ new_buffer[i] = buffer[i];
+ }
+ buffer = new_buffer;
+ buffer[top] = t;
+ maxContents = len+20000;
+ return top;
+ }
+ }
+
+ /** Returns an entry with the given index from this <code>InternalDatabase</code>. */
+ public Term get(int i) {
+ return buffer[i];
+ }
+
+ /** Erases an entry with the given index from this <code>InternalDatabase</code>. */
+ public Term erase(int i) {
+ Term t = buffer[i];
+ buffer[i] = null;
+ // System.out.println("add Reuse index" + i);
+ reusableIndices.add(i);
+ return t;
+ }
+
+ /** Discards all entries. */
+ protected void eraseAll() {
+ while (! empty()) {
+ buffer[top--] = null;
+ }
+ }
+
+ /** Tests if this has no entry. */
+ public boolean empty() {
+ return top == -1;
+ }
+
+ /** Returns the value of <code>top</code>.
+ * @see #top
+ */
+ public int top() { return top; }
+
+ /** Shows the contents of this <code>InternalDatabase</code>. */
+ public void show() {
+ if (empty())
+ System.out.println("{internal database is empty!}");
+ System.out.println("{reusable indices: " + reusableIndices.toString() + "}");
+ for (int i=0; i<=top; i++) {
+ System.out.print("internal database[" + i + "]: ");
+ System.out.println(buffer[i]);
+ }
+ }
+}
diff --git a/src/lang/InternalException.java b/src/lang/InternalException.java
new file mode 100644
index 0000000..33b8ba6
--- /dev/null
+++ b/src/lang/InternalException.java
@@ -0,0 +1,35 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Internal error.<br>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class InternalException extends PrologException {
+ /** A functor symbol of <code>internal_error/1</code>. */
+ public static SymbolTerm INTERNAL_ERROR = SymbolTerm.makeSymbol("internal_error", 1);
+
+ /** Holds a message. */
+ public String message;
+
+ /** Constructs a new <code>InternalException</code> with a message. */
+ public InternalException(String _message) {
+ message = _message;
+ }
+
+ /** Returns a term representation of this <code>InternalException</code>:
+ * <code>internal_error(message)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {SymbolTerm.makeSymbol(message)};
+ return new StructureTerm(INTERNAL_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>InternalException</code>. */
+ public String toString() {
+ String s = "{INTERNAL ERROR: " + message;
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/JavaException.java b/src/lang/JavaException.java
new file mode 100644
index 0000000..6c0b366
--- /dev/null
+++ b/src/lang/JavaException.java
@@ -0,0 +1,56 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Java error.<br>
+ * There will be a Java error when
+ * a Java exception is threw during interoperating with Java in Prolog Cafe.
+ * The class <code>JavaException</code> wraps a subclass of <code>java.lang.Exception</code>.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class JavaException extends BuiltinException {
+ /** A functor symbol of <code>java_error/3</code>. */
+ public static SymbolTerm JAVA_ERROR = SymbolTerm.makeSymbol("java_error", 3);
+
+ /** Holds a Java exception. */
+ public Exception e;
+
+ /** Constructs a new <code>JavaException</code> with a Java exception. */
+ public JavaException(Exception _e) {
+ e = _e;
+ }
+
+ /** Constructs a new <code>JavaException</code> with the given arguments. */
+ public JavaException(Predicate _goal, int _argNo, Exception _e) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ e = _e;
+ }
+
+ /** Returns a term representation of this <code>JavaException</code>:
+ * <code>java_error(goal,argNo,exception)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ new IntegerTerm(argNo),
+ new JavaObjectTerm(e)};
+ return new StructureTerm(JAVA_ERROR, args);
+ }
+
+ /** Returns a underlying Java exception. */
+ public Exception getException() {
+ return e;
+ }
+
+ /** Returns a string representation of this <code>JavaException</code>. */
+ public String toString() {
+ String s = "{JAVA ERROR: " + goal.toString();
+ if (argNo > 0)
+ s += " - arg " + argNo;
+ s += ", occurs " + e.toString();
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/JavaObjectTerm.java b/src/lang/JavaObjectTerm.java
new file mode 100644
index 0000000..be6abd3
--- /dev/null
+++ b/src/lang/JavaObjectTerm.java
@@ -0,0 +1,118 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Java-term.<br>
+ * The <code>JavaObjectTerm</code> class wraps a java object.<br>
+ *
+ * <pre>
+ * import java.util.Hashtable;
+ * Term t = new JavaObjectTerm(new Hashtable());
+ * Hashtable hash = (Hashtable)(((JavaObjectTerm)t).object());
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class JavaObjectTerm extends Term {
+ /** Holds a java object that this <code>JavaObjectTerm</code> wraps. */
+ protected Object obj = null;
+
+ /** Holds a <code>java.lang.Class</code> of object wrapped by this <code>JavaObjectTerm</code>. */
+ protected Class clazz = null;
+
+ /** Constructs a new Prolog java-term that wraps the argument object. */
+ public JavaObjectTerm(Object _obj) {
+ if (_obj != null)
+ setObject(_obj);
+ }
+
+ /** Sets the argument object to this <code>JavaObjectTerm</code>. */
+ public void setObject(Object _obj) {
+ obj = _obj;
+ clazz = _obj.getClass();
+ }
+
+ /** Returns the object wrapped by this <code>JavaObjectTerm</code>. */
+ public Object object() { return obj; }
+
+ /** Returns a <code>java.lang.Class</code> of object wrapped by this <code>JavaObjectTerm</code>. */
+ public Class getClazz() { return clazz; }
+
+ public String toQuotedString() { return toString(); }
+
+ /* Term */
+ public boolean unify(Term t, Trail trail) {
+ if (t.isVariable())
+ return ((VariableTerm)t).unify(this, trail);
+ if (! t.isJavaObject())
+ return false;
+ return obj.equals(((JavaObjectTerm)t).obj);
+ }
+
+ /**
+ * Check whether the wrapped object is convertible with the given Java class type.
+ * @return the <code>boolean</code> whose value is
+ * <code>convertible(clazz, type)</code>.
+ * @see #clazz
+ * @see Term#convertible(Class, Class)
+ */
+ public boolean convertible(Class type) { return convertible(clazz, type); }
+
+ /**
+ * Returns the object wrapped by this <code>JavaObjectTerm</code>.
+ * @return the value of <code>obj</code>.
+ * @see #obj
+ */
+ public Object toJava() { return obj; }
+
+ /* Object */
+ /**
+ * Checks <em>term equality</em> of two terms.
+ * The result is <code>true</code> if and only if the argument is an instance of
+ * <code>JavaObjectTerm</code>, and
+ * the pairs of wrapped objects in the two java-term are <em>equal</em>
+ * by <code>obj.equals(((JavaObjectTerm)o).obj)</code>.
+ * @param o the object to compare with. This must be dereferenced.
+ * @return <code>true</code> if the given object represents a java-term
+ * equivalent to this <code>JavaObjectTerm</code>, false otherwise.
+ * @see #compareTo
+ */
+ public boolean equals(Object o) {
+ if (! (o instanceof JavaObjectTerm))
+ return false;
+ return obj.equals(((JavaObjectTerm)o).obj);
+ }
+
+ public int hashCode() {
+ return obj.hashCode();
+ }
+
+ /** Returns a string representation of this <code>JavaObjectTerm</code>. */
+ public String toString() {
+ return clazz.getName() + "(" + hashCode() + ")";
+ }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compared with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced.
+ if (anotherTerm.isVariable()
+ || anotherTerm.isNumber()
+ || anotherTerm.isSymbol()
+ || anotherTerm.isList()
+ || anotherTerm.isStructure())
+ return AFTER;
+ if (! anotherTerm.isJavaObject())
+ return BEFORE;
+ if (obj.equals(((JavaObjectTerm) anotherTerm).obj))
+ return EQUAL;
+ return obj.hashCode() - ((JavaObjectTerm) anotherTerm).obj.hashCode(); //???
+ }
+}
diff --git a/src/lang/JavaPredicate.java b/src/lang/JavaPredicate.java
new file mode 100644
index 0000000..88a1ffd
--- /dev/null
+++ b/src/lang/JavaPredicate.java
@@ -0,0 +1,37 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.ArrayList;
+/**
+ * The abstract class <code>JavaPredicate</code> contains methods
+ * for interoperating with Java</em>.<br>
+ * For example, the following builtin predicates extends this <code>JavaPredicate</code>.
+ * <ul>
+ * <li><code>java_constructor</code>
+ * <li><code>java_method</code>.
+ * </ul>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public abstract class JavaPredicate extends Predicate {
+ /**
+ * Checks whether all terms in <code>args</code> are convertible
+ * to the corresponding Java types in <code>paraTypes</code>.
+ * @return <code>true</code>
+ * if <code>args[i].convertible(paraTypes[i])</code> succeeds for all <code>i</code>,
+ * otherwise <code>false</code>.
+ * @see Term#convertible(Class)
+ */
+ protected boolean checkParameterTypes(Class[] paraTypes, Term[] args) {
+ int arity;
+ arity = paraTypes.length;
+ if (arity != args.length)
+ return false;
+ for (int i=0; i<arity; i++) {
+ if (! args[i].convertible(paraTypes[i])) {
+ return false;
+ }
+ }
+ return true;
+ }
+}
diff --git a/src/lang/ListTerm.java b/src/lang/ListTerm.java
new file mode 100644
index 0000000..9a2a458
--- /dev/null
+++ b/src/lang/ListTerm.java
@@ -0,0 +1,237 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.Vector;
+/**
+ * List.<br>
+ * The class <code>ListTerm</code> represents a list structure.<br>
+ *
+ * <pre>
+ * % [1,2]
+ * Term Nil = SymbolTerm.makeSymbol("[]");
+ * Term n1 = IntegerTerm(1);
+ * Term n2 = IntegerTerm(2);
+ * Term t = new ListTerm(n1, new ListTerm(n2, Nil));
+ *
+ * Term car = ((ListTerm)t).car();
+ * Term cdr = ((ListTerm)t).cdr();
+ * </pre>
+ *
+ * Here is sample program for creating a list from <code>1</code> to <code>n</code>.
+ * <pre>
+ * public static Term makeList(int n) {
+ * Term t = SymbolTerm.makeSymbol("[]");
+ * for (int i=n; i>0; i--) {
+ * t = new ListTerm(new IntegerTerm(i), t);
+ * }
+ * return t;
+ * }
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class ListTerm extends Term {
+ /** A functor <code>'.' /2</code>. */
+ protected static SymbolTerm SYM_DOT = SymbolTerm.makeSymbol(".", 2);
+
+ /** Holds the first element of this <code>ListTerm</code>. */
+ protected Term car;
+
+ /**
+ * Holds the list consisting of all the rest of the elements of
+ * this <code>ListTerm</code> but the first one.
+ */
+ protected Term cdr;
+
+ /**
+ * Constructs a new Prolog list structure
+ * such that <code>_car</code> is the first element of this list, and
+ * <code>_cdr</code> is the list consisting of all the rest of the
+ * elements of this list but the first one.
+ */
+ public ListTerm(Term _car, Term _cdr) {
+ car = _car;
+ cdr = _cdr;
+ }
+
+ /** Returns the value of <code>car</code>.
+ * @see #car
+ */
+ public Term car() { return car; }
+
+ /** Returns the value of <code>cdr</code>.
+ * @see #cdr
+ */
+ public Term cdr() { return cdr; }
+
+ /** Sets the value to <code>car</code>.
+ * @see #car
+ */
+ public void setCar(Term t) { car = t; }
+
+ /** Sets the value to <code>cdr</code>.
+ * @see #cdr
+ */
+ public void setCdr(Term t) { cdr = t; }
+
+ /* Term */
+ public boolean unify(Term t, Trail trail) {
+ t = t.dereference();
+ if (t.isVariable()) {
+ ((VariableTerm) t).bind(this, trail);
+ return true;
+ }
+ if (! t.isList())
+ return false;
+ return car.unify(((ListTerm)t).car(), trail)
+ && cdr.unify(((ListTerm)t).cdr(), trail);
+ }
+
+ /**
+ * @return the <code>boolean</code> whose value is
+ * <code>convertible(Vector.class, type)</code>.
+ * @see Term#convertible(Class, Class)
+ */
+ public boolean convertible(Class type) {
+ return convertible(Vector.class, type);
+ }
+
+ protected Term copy(Prolog engine) {
+ return new ListTerm(car.copy(engine), cdr.copy(engine));
+ }
+
+ public boolean isGround() {
+ if (! car.isGround())
+ return false;
+ if (! cdr.isGround())
+ return false;
+ return true;
+ }
+
+ /** Returns the length of this <code>ListTerm</code>. */
+ public int length() {
+ int count = 0;
+ Term t = this;
+ while(t.isList()) {
+ count++;
+ t = ((ListTerm)t).cdr().dereference();
+ }
+ return count;
+ }
+
+ /**
+ * Returns a <code>java.util.Vector</code> corresponds to this <code>ListTerm</code>
+ * according to <em>Prolog Cafe interoperability with Java</em>.
+ * @return a <code>java.util.Vector</code> object equivalent to
+ * this <code>IntegerTerm</code>.
+ */
+ public Object toJava() {
+ Vector<Object> vec = new Vector<Object>();
+ Term t = this;
+ while(t.isList()) {
+ vec.addElement(((ListTerm)t).car().dereference().toJava());
+ t = ((ListTerm)t).cdr().dereference();
+ }
+ return vec;
+ }
+
+ public String toQuotedString() {
+ Term x = this;
+ String s = "[";
+ for (;;) {
+ s += ((ListTerm)x).car.dereference().toQuotedString();
+ x = ((ListTerm)x).cdr.dereference();
+ if (! x.isList())
+ break;
+ s += ",";
+ }
+ if (! x.isNil())
+ s += "|" + x.toQuotedString();
+ s += "]";
+ return s;
+ }
+
+ /* Object */
+ /**
+ * Checks <em>term equality</em> of two terms.
+ * The result is <code>true</code> if and only if the argument is an instance of
+ * <code>ListTerm</code>, and
+ * all corresponding pairs of elements in the two lists are <em>term-equal</em>.
+ * @param obj the object to compare with. This must be dereferenced.
+ * @return <code>true</code> if the given object represents a Prolog list
+ * equivalent to this <code>ListTerm</code>, false otherwise.
+ * @see #compareTo
+ */
+ public boolean equals(Object obj) {
+ if (! (obj instanceof ListTerm))
+ return false;
+ return car.equals(((ListTerm)obj).car().dereference())
+ && cdr.equals(((ListTerm)obj).cdr().dereference());
+ }
+
+ public int hashCode() {
+ int h = 1;
+ h = 31*h + SYM_DOT.hashCode();
+ h = 31*h + car.dereference().hashCode();
+ h = 31*h + cdr.dereference().hashCode();
+ return h;
+ }
+
+ /** Returns a string representation of this <code>ListTerm</code>. */
+ public String toString() {
+ Term x = this;
+ String s = "[";
+ for (;;) {
+ s += ((ListTerm)x).car.dereference().toString();
+ x = ((ListTerm)x).cdr.dereference();
+ if (! x.isList())
+ break;
+ s += ",";
+ }
+ if (! x.isNil())
+ s += "|" + x.toString();
+ s += "]";
+ return s;
+ }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compared with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced.
+ if (anotherTerm.isVariable() || anotherTerm.isNumber() || anotherTerm.isSymbol())
+ return AFTER;
+ if (anotherTerm.isStructure()) {
+ int arity = ((StructureTerm)anotherTerm).arity();
+ if (2 != arity)
+ return (2 - arity);
+ SymbolTerm functor = ((StructureTerm)anotherTerm).functor();
+ if (! SYM_DOT.equals(functor))
+ return SYM_DOT.compareTo(functor);
+ }
+ Term[] args = new Term[2];
+ if (anotherTerm.isList()) {
+ args[0] = ((ListTerm)anotherTerm).car();
+ args[1] = ((ListTerm)anotherTerm).cdr();
+ } else if (anotherTerm.isStructure()) {
+ args = ((StructureTerm)anotherTerm).args();
+ } else {
+ return BEFORE;
+ }
+ Term tmp = car;
+ int rc;
+ for (int i=0; i<2; i++) {
+ rc = tmp.compareTo(args[i].dereference());
+ if (rc != EQUAL)
+ return rc;
+ tmp = cdr;
+ }
+ return EQUAL;
+ }
+}
diff --git a/src/lang/Makefile b/src/lang/Makefile
new file mode 100644
index 0000000..212f827
--- /dev/null
+++ b/src/lang/Makefile
@@ -0,0 +1,28 @@
+################################################################
+# Makefile for Prolog Cafe
+################################################################
+
+################################################################
+# The following two definitions will be overridden.
+#
+# JAVAC : the command of Java compiler system
+# (ex. javac)
+# JAR : the command of Jar archive system
+# (ex. jar)
+#
+JAVAC = javac
+JAVACOPTS = -d . -Xlint
+JAR = jar
+JAROPTS = cvf
+################################################################
+lang:
+ $(JAVAC) $(JAVACOPTS) *.java
+ $(JAR) $(JAROPTS) lang.jar jp/ac/kobe_u/cs/prolog/lang/
+
+clean:
+ -rm -f -r jp
+ -rm -f core *~ *.class *.jar
+
+realclean: clean
+
+
diff --git a/src/lang/NumberTerm.java b/src/lang/NumberTerm.java
new file mode 100644
index 0000000..f37e602
--- /dev/null
+++ b/src/lang/NumberTerm.java
@@ -0,0 +1,103 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * The superclass of classes for integers and floating point numbers.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public abstract class NumberTerm extends Term {
+ /** Returns the numeric value represented by this object after conversion to type <code>int</code>. */
+ abstract public int intValue();
+ /** Returns the numeric value represented by this object after conversion to type <code>long</code>. */
+ abstract public long longValue();
+ /** Returns the numeric value represented by this object after conversion to type <code>double</code>. */
+ abstract public double doubleValue();
+
+ /**
+ * Compares two <code>NumberTerm</code> objects numerically.
+ * @param t the <code>NumberTerm</code> to compare with.
+ * @return the value <code>0</code>
+ * if this object is numerically equal to the argument <code>NumberTerm</code>;
+ * a value less than <code>0</code>
+ * if this object is numerically less than the argument <code>NumberTerm</code>; and
+ * a value greater than <code>0</code>
+ * if this object is numerically greater than the argument <code>NumberTerm</code>.
+ */
+ abstract public int arithCompareTo(NumberTerm t);
+
+ /** Returns a <code>NumberTerm</code> whose value is <code>abs(this)</code>. */
+ abstract public NumberTerm abs();
+ /** Returns a <code>NumberTerm</code> whose value is <code>acos(this)</code>. */
+ abstract public NumberTerm acos();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this + t)</code>. */
+ abstract public NumberTerm add(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this & t)</code>. */
+ abstract public NumberTerm and(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>asin(this)</code>. */
+ abstract public NumberTerm asin();
+ /** Returns a <code>NumberTerm</code> whose value is <code>tan(this)</code>. */
+ abstract public NumberTerm atan();
+ /** Returns a <code>NumberTerm</code> whose value is <code>ceil(this)</code>. */
+ abstract public NumberTerm ceil();
+ /** Returns a <code>NumberTerm</code> whose value is <code>cos(this)</code>. */
+ abstract public NumberTerm cos();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this / t)</code>. */
+ abstract public NumberTerm divide(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>exp(this)</code>. */
+ abstract public NumberTerm exp();
+ /** Returns a <code>NumberTerm</code> whose value is the float-integer-part of <code>this</code>. */
+ abstract public NumberTerm floatIntPart();
+ /** Returns a <code>NumberTerm</code> whose value is the float-fractional-part of <code>this</code>. */
+ abstract public NumberTerm floatFractPart();
+ /** Returns a <code>NumberTerm</code> whose value is <code>floor(this)</code>. */
+ abstract public NumberTerm floor();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(int)(this / t)</code>. */
+ abstract public NumberTerm intDivide(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>log(this)</code>. */
+ abstract public NumberTerm log();
+ /** Returns a <code>NumberTerm</code> whose value is <code>max(this, t)</code>. */
+ abstract public NumberTerm max(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>min(this, t)</code>. */
+ abstract public NumberTerm min(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this mod t)</code>. */
+ abstract public NumberTerm mod(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this * t)</code>. */
+ abstract public NumberTerm multiply(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>(- this)</code>. */
+ abstract public NumberTerm negate();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(~ this)</code>. */
+ abstract public NumberTerm not();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this | t)</code>. */
+ abstract public NumberTerm or(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this<sup>t</sup>)</code>. */
+ abstract public NumberTerm pow(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>rint(this)</code>. */
+ abstract public NumberTerm rint();
+ /** Returns a <code>NumberTerm</code> whose value is <code>round(this)</code>. */
+ abstract public NumberTerm round();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this << t)</code>. */
+ abstract public NumberTerm shiftLeft(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this >> t)</code>. */
+ abstract public NumberTerm shiftRight(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>signum(this)</code>. */
+ abstract public NumberTerm signum();
+ /** Returns a <code>NumberTerm</code> whose value is <code>sin(this)</code>. */
+ abstract public NumberTerm sin();
+ /** Returns a <code>NumberTerm</code> whose value is <code>sqrt(this)</code>. */
+ abstract public NumberTerm sqrt();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this - t)</code>. */
+ abstract public NumberTerm subtract(NumberTerm t);
+ /** Returns a <code>NumberTerm</code> whose value is <code>tan(this)</code>. */
+ abstract public NumberTerm tan();
+ /** Returns a <code>NumberTerm</code> whose value is <code>toDegrees(this)</code>. */
+ abstract public NumberTerm toDegrees();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(double)(this)</code>. */
+ abstract public NumberTerm toFloat();
+ /** Returns a <code>NumberTerm</code> whose value is <code>toRadians(this)</code>. */
+ abstract public NumberTerm toRadians();
+ /** Returns a <code>NumberTerm</code> whose value is the truncate of <code>this</code>. */
+ abstract public NumberTerm truncate();
+ /** Returns a <code>NumberTerm</code> whose value is <code>(this ^ t)</code>. */
+ abstract public NumberTerm xor(NumberTerm t);
+}
diff --git a/src/lang/OutOfLoop.java b/src/lang/OutOfLoop.java
new file mode 100644
index 0000000..a543f97
--- /dev/null
+++ b/src/lang/OutOfLoop.java
@@ -0,0 +1,24 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * A trail entry for out-of-loop flag.<br>
+ * This <code>OutOfLoop</code> class is used in
+ * subclasses of <code>BlockPredicate</code>.<br>
+ * <font color="red">This document is under construction.</font>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class OutOfLoop implements Serializable,Undoable {
+ BlockPredicate p;
+
+ public OutOfLoop(BlockPredicate _p) {
+ p = _p;
+ }
+
+ public void undo() {
+ p.outOfLoop = true;
+ }
+}
+
diff --git a/src/lang/OutOfScope.java b/src/lang/OutOfScope.java
new file mode 100644
index 0000000..838efd6
--- /dev/null
+++ b/src/lang/OutOfScope.java
@@ -0,0 +1,23 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * A trail entry for out-of-scope flag.<br>
+ * This <code>OutOfScope</code> class is used in
+ * subclasses of <code>BlockPredicate</code>.<br>
+ * <font color="red">This document is under construction.</font>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class OutOfScope implements Serializable,Undoable {
+ BlockPredicate p;
+
+ public OutOfScope(BlockPredicate _p) {
+ p = _p;
+ }
+
+ public void undo() {
+ p.outOfScope = false;
+ }
+}
diff --git a/src/lang/PInstantiationException.java b/src/lang/PInstantiationException.java
new file mode 100644
index 0000000..7da1137
--- /dev/null
+++ b/src/lang/PInstantiationException.java
@@ -0,0 +1,42 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Instantiation error.<br>
+ * There will be an instantiation error
+ * when an argument of one of its components is a variable,
+ * and an instantiated argument or component is required.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PInstantiationException extends BuiltinException {
+ /** A functor symbol of <code>instantiation/2</code>. */
+ public static SymbolTerm INSTANTIATION_ERROR = SymbolTerm.makeSymbol("instantiation_error", 2);
+
+ /** Constructs a new <code>PInstantiationException</code>. */
+ public PInstantiationException(){}
+
+ /** Constructs a new <code>PInstantiationException</code>
+ * with the given arguments. */
+ public PInstantiationException(Predicate _goal, int _argNo) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ }
+
+ /** Returns a term representation of this <code>PInstantiationException</code>:
+ * <code>instantiation_error(goal,argNo)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {new JavaObjectTerm(goal), new IntegerTerm(argNo)};
+ return new StructureTerm(INSTANTIATION_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>PInstantiationException</code>. */
+ public String toString() {
+ String s = "{INSTANTIATION ERROR: " + goal.toString();
+ if (argNo > 0)
+ s += " - arg " + argNo;
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/PermissionException.java b/src/lang/PermissionException.java
new file mode 100644
index 0000000..0d6c7f2
--- /dev/null
+++ b/src/lang/PermissionException.java
@@ -0,0 +1,68 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Permission error.<br>
+ * There will be a permission error when it is not permitted
+ * to perform a specific operation.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PermissionException extends BuiltinException {
+ /** A functor symbol of <code>permission_error/5</code>. */
+ public static SymbolTerm PERMISSION_ERROR = SymbolTerm.makeSymbol("permission_error", 5);
+
+ /* operation ::= access | create | input | modify | open | output | reposition | new */
+ /** Holds a string representation of operation. */
+ public String operation;
+
+ /*
+ permissionType ::= binary_stream | flag | operator | past_end_of_stream
+ private_procedure | static_procedure | source_sink
+ stream | text_stream
+ */
+ /** Holds a string representation of permission type. */
+ public String permissionType;
+
+ /** Holds the argument or one of its components which caused the error. */
+ public Term culprit;
+
+ /** Holds a string representation of detail message. */
+ public String message;
+
+ /** Constructs a new <code>PermissionException</code>
+ * with the given arguments. */
+ public PermissionException(Predicate _goal,
+ String _operation,
+ String _permissionType,
+ Term _culprit,
+ String _message) {
+ this.goal = _goal;
+ operation = _operation;
+ permissionType = _permissionType;
+ culprit = _culprit;
+ message = _message;
+ }
+
+ /** Returns a term representation of this <code>PermissionException</code>:
+ * <code>permission_error(goal,argNo,operation,permissionType,culprit,message)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ SymbolTerm.makeSymbol(operation),
+ SymbolTerm.makeSymbol(permissionType),
+ culprit,
+ SymbolTerm.makeSymbol(message)};
+ return new StructureTerm(PERMISSION_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>PermissionException</code>. */
+ public String toString() {
+ String s = "{PERMISSION ERROR: " + goal.toString();
+ s += " - can not " + operation + " " + permissionType + " " + culprit.toString();
+ s += ": " + message;
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/Predicate.java b/src/lang/Predicate.java
new file mode 100644
index 0000000..9d5827c
--- /dev/null
+++ b/src/lang/Predicate.java
@@ -0,0 +1,29 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * The superclass of classes for predicates.
+ * The subclasses of <code>Predicate</code> must override
+ * the <code>exec</code> and <code>arity</code> methods.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public abstract class Predicate implements Serializable {
+ /** Holds a continuation goal */
+ public Predicate cont = null;
+
+ /**
+ * Executes this predicate and returns a continuation goal.
+ * @param engine current Prolog engine
+ * @exception PrologException if a Prolog exception is raised.
+ * @see Prolog
+ */
+ public abstract Predicate exec(Prolog engine) throws PrologException;
+
+ /** Returns the arity of this predicate. */
+ public abstract int arity();
+
+ /** Sets the specified arguments and continuation goal. */
+ public void setArgument(Term[] args, Predicate cont){}
+}
diff --git a/src/lang/PredicateEncoder.java b/src/lang/PredicateEncoder.java
new file mode 100644
index 0000000..6562098
--- /dev/null
+++ b/src/lang/PredicateEncoder.java
@@ -0,0 +1,102 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.regex.Pattern;
+import java.util.regex.Matcher;
+/**
+ * The <code>PredicateEncoder</code> class contains static methods for encoding predicate names.<br>
+ * The predicate with <code>hoge:f/n</code> is encoded to <code>hoge.PRED_f_n</code>, where
+ * <code>hoge</code> is package name,
+ * <code>f</code> is predicate name, and
+ * <code>n</code> is arity.<br>
+ *
+ * When encoding a predicate name, we apply the following rules:<br>
+ *<ul>
+ *<li>The alphanumeric characters
+ * “<code>a</code>” through “<code>z</code>”,
+ * “<code>A</code>” through “<code>Z</code>” and
+ * “<code>0</code>” through “<code>9</code>” remain the same.
+ *<li>The special characters “<code>_</code>” and “<code>$</code>” remain the same.
+ *<li>All other characters are first converted into a list of character codes.
+ * Then each character code is represented by the 5-character string “<code>$XYZW</code>”,
+ * where <code>XYZW</code> is the four-digit hexadecimal representation of the character code.
+ *</ul>
+ *
+ * For example,
+ * a predicate with <code>hoge:(=..)/2</code> is encoded to <code>hoge.PRED_$003D$002E$002E_2</code>.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PredicateEncoder {
+
+ /**
+ * Returns a string representation of class for
+ * the predicate with the given arguments.
+ * @param pkg package name
+ * @param functor predicate name
+ * @param arity predicate arity
+ * @return a string representation of class for
+ * the predicate that corresponds to <code>pkg:functor/arity</code>.
+ */
+ public static String encode(String pkg, String functor, int arity) {
+ String x = functor;
+ Pattern p = Pattern.compile("([^a-zA-Z0-9_'$'])");
+ Matcher m = p.matcher(x);
+ StringBuffer sb = new StringBuffer();
+ boolean result = m.find();
+ while (result) {
+ // m.appendReplacement(sb, String.format("\\$%2X", (int)(m.group().charAt(0))));
+ m.appendReplacement(sb, String.format("\\$%04X", (int)(m.group().charAt(0))));
+ result = m.find();
+ }
+ m.appendTail(sb);
+ x = sb.toString();
+ if (pkg.equals("user"))
+ return "PRED_" + x + "_" + arity;
+ else
+ return pkg + ".PRED_" + x + "_" + arity;
+ }
+
+ /**
+ * Returns a <code>java.lang.Class</code> object associated with the predicate
+ * class with the given arguments.
+ * @param pkg package name
+ * @param functor predicate name
+ * @param arity predicate arity
+ * @return a <code>java.lang.Class</code> object associated with the predicate
+ * class that corresponds to <code>pkg:functor/arity</code>
+ * if exists, otherwise <code>null</code>.
+ * @deprecated As of Prolog Cafe 1.1, replaced by {@link PrologClassLoader#loadPredicateClass(String,String,int,boolean)};
+ */
+ public static Class getClass(String pkg, String functor, int arity) {
+ String className = PredicateEncoder.encode(pkg, functor, arity);
+ Class clazz = null;
+ try {
+ clazz = Class.forName(className);
+ } catch (ClassNotFoundException e) {}
+ return clazz;
+ }
+
+ /**
+ * Check whether the predicate class for the given arguments is defined.
+ * @param pkg package name
+ * @param functor predicate name
+ * @param arity predicate arity
+ * @return <code>true</code> if the predicate <code>pkg:functor/arity</code>
+ * is defined, otherwise <code>false</code>.
+ * @deprecated As of Prolog Cafe 1.1, replaced by {@link PrologClassLoader#definedPredicate(String,String,int)};
+ */
+ public static boolean defined(String pkg, String functor, int arity) {
+ Class clazz = PredicateEncoder.getClass(pkg, functor, arity);
+ return clazz != null;
+ }
+
+ public static void main(String argv[]) {
+ String p = argv[0];
+ String f = argv[1];
+ int n = (Integer.valueOf(argv[2])).intValue();
+ System.out.println(p + ":" + f + "/" + n);
+ System.out.println(PredicateEncoder.encode(p,f,n));
+ System.out.println(PredicateEncoder.defined(p,f,n));
+ }
+}
diff --git a/src/lang/Prolog.java b/src/lang/Prolog.java
new file mode 100644
index 0000000..4165447
--- /dev/null
+++ b/src/lang/Prolog.java
@@ -0,0 +1,461 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.Hashtable;
+import java.io.*;
+/**
+ * Prolog engine.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2
+*/
+public class Prolog implements Serializable {
+ /** Prolog thread */
+ public PrologControl control;
+ /** Argument registers */
+ public Term[] aregs;
+ /** Continuation goal register */
+ public Predicate cont;
+ /** Choice point frame stack */
+ public CPFStack stack;
+ /** Trail stack */
+ public Trail trail;
+ /* Push down list */
+ // public PushDownList pdl;
+ /** Cut pointer */
+ public int B0;
+ /** Class loader */
+ public PrologClassLoader pcl;
+ /** Internal Database */
+ public InternalDatabase internalDB;
+
+ /** Current time stamp of choice point frame */
+ protected long CPFTimeStamp;
+
+ /**
+ * Exception level of continuation passing loop:
+ * <li><code>0</code> for no exception,
+ * <li><code>1</code> for <code>halt/0</code>,
+ * <li><code>2</code> for <code>freeze/2</code> (not supported yet)
+ * </ul>
+ */
+ public int exceptionRaised;
+
+ /** <font color="red">Not supported yet</font>. Prolog implementation flag: <code>bounded</code>. */
+ protected boolean bounded = false;
+ /** Prolog implementation flag: <code>max_integer</code>. */
+ protected int maxInteger = Integer.MAX_VALUE;
+ /** Prolog implementation flag: <code>min_integer</code>. */
+ protected int minInteger = Integer.MIN_VALUE;
+ /** Prolog implementation flag: <code>integer_rounding_function</code>. */
+ protected String integerRoundingFunction = "down";
+ /** <font color="red">Not supported yet</font>. Prolog implementation flag: <code>char_conversion</code>. */
+ protected String charConversion;
+ /** Prolog implementation flag: <code>debug</code>. */
+ protected String debug;
+ /** Prolog implementation flag: <code>max_arity</code>. */
+ protected int maxArity = 255;
+ /** Prolog implementation flag: <code>unknown</code>. */
+ protected String unknown;
+ /** <font color="red">Not supported yet</font>. Prolog implementation flag: <code>double_quotes</code>. */
+ protected String doubleQuotes;
+ /** Prolog implementation flag: <code>print_stack_trace</code>. */
+ protected String printStackTrace;
+
+ /** Holds a list of frozen goals for <code>freeze/2</code> (not implemented yet). */
+ protected Term pendingGoals;
+ /** Holds an exception term for <code>catch/3</code> and <code>throw/1</code>. */
+ protected Term exception;
+
+ /** Holds the start time as <code>long</code> for <code>statistics/2</code>. */
+ protected long startRuntime;
+ /** Holds the previous time as <code>long</code> for <code>statistics/2</code>. */
+ protected long previousRuntime;
+
+ /** Hashtable for creating a copy of term. */
+ protected Hashtable<VariableTerm,VariableTerm> copyHash;
+
+ /** The size of the pushback buffer used for creating input streams. */
+ public static int PUSHBACK_SIZE = 3;
+ // public static int PUSHBACK_SIZE = 2;
+
+ /** Standard input stream. */
+ protected transient PushbackReader userInput;
+ /** Standard output stream. */
+ protected transient PrintWriter userOutput;
+ /** Standard error stream. */
+ protected transient PrintWriter userError;
+ /** Current input stream. */
+ protected transient PushbackReader currentInput;
+ /** Current output stream. */
+ protected transient PrintWriter currentOutput;
+ /** Hashtable for managing input and output streams. */
+ protected HashtableOfTerm streamManager;
+
+ /** Hashtable for managing internal databases. */
+ protected HashtableOfTerm hashManager;
+
+ /** Holds an atom <code>[]<code> (empty list). */
+ public static SymbolTerm Nil = SymbolTerm.makeSymbol("[]");
+
+ /* Some symbols for stream options */
+ static SymbolTerm SYM_MODE_1 = SymbolTerm.makeSymbol("mode", 1);
+ static SymbolTerm SYM_ALIAS_1 = SymbolTerm.makeSymbol("alias", 1);
+ static SymbolTerm SYM_TYPE_1 = SymbolTerm.makeSymbol("type", 1);
+ static SymbolTerm SYM_READ = SymbolTerm.makeSymbol("read");
+ static SymbolTerm SYM_APPEND = SymbolTerm.makeSymbol("append");
+ static SymbolTerm SYM_INPUT = SymbolTerm.makeSymbol("input");
+ static SymbolTerm SYM_OUTPUT = SymbolTerm.makeSymbol("output");
+ static SymbolTerm SYM_TEXT = SymbolTerm.makeSymbol("text");
+ static SymbolTerm SYM_USERINPUT = SymbolTerm.makeSymbol("user_input");
+ static SymbolTerm SYM_USEROUTPUT = SymbolTerm.makeSymbol("user_output");
+ static SymbolTerm SYM_USERERROR = SymbolTerm.makeSymbol("user_error");
+
+ /** Constructs new Prolog engine. */
+ public Prolog(PrologControl c) {
+ control = c;
+ aregs = new Term[maxArity];
+ cont = null;
+ stack = new CPFStack(this);
+ trail = new Trail(this);
+ // pdl = new PushDownList();
+ pcl = new PrologClassLoader();
+ internalDB = new InternalDatabase();
+ initOnce();
+ }
+
+ /**
+ * Initializes some local instances only once.
+ * This <code>initOnce</code> method is invoked in the constructor
+ * and initializes the following instances:
+ * <ul>
+ * <li><code>userInput</code>
+ * <li><code>userOutput</code>
+ * <li><code>userError</code>
+ * <li><code>copyHash</code>
+ * <li><code>hashManager</code>
+ * <li><code>streamManager</code>
+ * </ul>
+ */
+ protected void initOnce() {
+ userInput = new PushbackReader(new BufferedReader(new InputStreamReader(System.in)), PUSHBACK_SIZE);
+ userOutput = new PrintWriter(new BufferedWriter(new OutputStreamWriter(System.out)), true);
+ userError = new PrintWriter(new BufferedWriter(new OutputStreamWriter(System.err)), true);
+
+ copyHash = new Hashtable<VariableTerm,VariableTerm>();
+ hashManager = new HashtableOfTerm();
+ streamManager = new HashtableOfTerm();
+
+ streamManager.put(SYM_USERINPUT, new JavaObjectTerm(userInput));
+ streamManager.put(new JavaObjectTerm(userInput),
+ makeStreamProperty(SYM_READ, SYM_INPUT, SYM_USERINPUT, SYM_TEXT));
+ streamManager.put(SYM_USEROUTPUT, new JavaObjectTerm(userOutput));
+ streamManager.put(new JavaObjectTerm(userOutput),
+ makeStreamProperty(SYM_APPEND, SYM_OUTPUT, SYM_USEROUTPUT, SYM_TEXT));
+ streamManager.put(SYM_USERERROR, new JavaObjectTerm(userError));
+ streamManager.put(new JavaObjectTerm(userError),
+ makeStreamProperty(SYM_APPEND, SYM_OUTPUT, SYM_USERERROR, SYM_TEXT));
+ }
+
+ /** Initializes this Prolog engine. */
+ public void init() {
+ stack.init();
+ trail.init();
+ // pdl.init();
+ B0 = stack.top();
+ CPFTimeStamp = Long.MIN_VALUE;
+
+ // Creates an initial choice point frame.
+ Term[] noarg = {};
+ stack.create(noarg, null);
+ stack.setTR(trail.top());
+ stack.setTimeStamp(++CPFTimeStamp);
+ stack.setBP(new Failure(control));
+ stack.setB0(B0);
+
+ exceptionRaised = 0;
+
+ charConversion = "off";
+ debug = "off";
+ unknown = "error";
+ doubleQuotes = "codes";
+ printStackTrace = "off";
+
+ pendingGoals = Nil;
+ exception = SymbolTerm.makeSymbol("$none");
+ startRuntime = System.currentTimeMillis();
+ previousRuntime = 0;
+
+ userOutput.flush();
+ userError.flush();
+ currentInput = userInput;
+ currentOutput = userOutput;
+ }
+
+ /** Sets the top of choice porint stack to <code>B0</code> (cut pointer). */
+ public void setB0() { B0 = stack.top(); }
+
+ /** Discards all choice points after the value of <code>i</code>. */
+ public void cut(int i) { stack.cut(i); }
+
+ /** Discards all choice points after the value of <code>B0</code>. */
+ public void neckCut() { stack.cut(B0); }
+
+ /**
+ * Returns a copy of term <code>t</code>.
+ * @param t a term to be copied. It must be dereferenced.
+ */
+ public Term copy(Term t) {
+ copyHash.clear();
+ return t.copy(this);
+ }
+
+ /*
+ public boolean unify(Term a1, Term a2) {
+ Term d1, d2;
+ pdl.init();
+ pdl.push(a1);
+ pdl.push(a2);
+ while (! pdl.empty()) {
+ d1 = pdl.pop().dereference();
+ d2 = pdl.pop().dereference();
+ if (d1 != d2) {
+ if (d1.isVariable()) {
+ ((VariableTerm)d1).bind(d2, trail);
+ } else if (d2.isVariable()) {
+ ((VariableTerm)d2).bind(d1, trail);
+ } else if (d2.isList()) {
+ if (! d1.isList())
+ return false;
+ pdl.push(((ListTerm)d1).cdr());
+ pdl.push(((ListTerm)d2).cdr());
+ pdl.push(((ListTerm)d1).car());
+ pdl.push(((ListTerm)d2).car());
+ } else if (d2.isStructure()) {
+ if (! d1.isStructure())
+ return false;
+ if (! ((StructureTerm)d1).functor.equals(((StructureTerm)d2).functor))
+ return false;
+ for (int i=0; i<((StructureTerm)d1).arity; i++) {
+ pdl.push(((StructureTerm)d1).args[i]);
+ pdl.push(((StructureTerm)d2).args[i]);
+ }
+ } else if (! d1.equals(d2)) {
+ return false;
+ }
+ }
+ }
+ return true;
+ }
+ */
+
+ /**
+ * Do backtrak.
+ * This method restores the value of <code>B0</code>
+ * and returns the backtrak point in current choice point.
+ */
+ public Predicate fail() {
+ B0 = stack.getB0(); // restore B0
+ return stack.getBP(); // execute next clause
+ }
+
+ /**
+ * Returns the <code>Predicate</code> object refered, respectively,
+ * <code>var</code>, <code>Int</code>, <code>flo</code>,
+ * <code>con</code>, <code>str</code>, or <code>lis</code>,
+ * depending on whether the dereferenced value of argument
+ * register <code>areg[1]</code> is a
+ * variable, integer, float,
+ * atom, compound term, or non-empty list, respectively.
+ */
+ public Predicate switch_on_term(Predicate var,
+ Predicate Int,
+ Predicate flo,
+ Predicate con,
+ Predicate str,
+ Predicate lis) {
+ Term arg1 = aregs[1].dereference();
+ if (arg1.isVariable())
+ return var;
+ if (arg1.isInteger())
+ return Int;
+ if (arg1.isDouble())
+ return flo;
+ if (arg1.isSymbol())
+ return con;
+ if (arg1.isStructure())
+ return str;
+ if (arg1.isList())
+ return lis;
+ return var;
+ }
+
+ /**
+ * If the dereferenced value of arugment register <code>areg[1]</code>
+ * is an integer, float, atom, or compound term (except for non-empty list),
+ * this returns the <code>Predicate</code> object to which its key is mapped
+ * in hashtable <code>hash</code>.
+ *
+ * The key is calculated as follows:
+ * <ul>
+ * <li>integer - itself
+ * <li>float - itself
+ * <li>atom - itself
+ * <li>compound term - functor/arity
+ * </ul>
+ *
+ * If there is no mapping for the key of <code>areg[1]</code>,
+ * this returns <code>otherwise</code>.
+ */
+ public Predicate switch_on_hash(Hashtable<Term,Predicate> hash, Predicate otherwise) {
+ Term arg1 = aregs[1].dereference();
+ Term key;
+ if (arg1.isInteger() || arg1.isDouble() || arg1.isSymbol()) {
+ key = arg1;
+ } else if (arg1.isStructure()) {
+ key = ((StructureTerm) arg1).functor();
+ } else {
+ throw new SystemException("Invalid argument in switch_on_hash");
+ }
+ Predicate p = hash.get(key);
+ if (p != null)
+ return p;
+ else
+ return otherwise;
+ }
+
+ /** Restores the argument registers and continuation goal register from the current choice point frame. */
+ public void restore() {
+ Term[] args = stack.getArgs();
+ int i = args.length;
+ System.arraycopy(args, 0, aregs, 1, i);
+ cont = stack.getCont();
+ }
+
+ /** Creates a new choice point frame. */
+ public Predicate jtry(Predicate p, Predicate next) {
+ int i = p.arity();
+ Term[] args = new Term[i];
+ System.arraycopy(aregs, 1, args, 0, i);
+ stack.create(args, cont);
+ stack.setTR(trail.top());
+ stack.setTimeStamp(++CPFTimeStamp);
+ stack.setBP(next);
+ stack.setB0(B0);
+ return p;
+ }
+
+ /**
+ * Resets all necessary information from the current choice point frame,
+ * updates its next clause field to <code>next</code>,
+ * and then returns <code>p</code>.
+ */
+ public Predicate retry(Predicate p, Predicate next) {
+ restore();
+ trail.unwind(stack.getTR());
+ stack.setBP(next);
+ return p;
+ }
+
+ /**
+ * Resets all necessary information from the current choice point frame,
+ * discard it, and then returns <code>p</code>.
+ */
+ public Predicate trust(Predicate p) {
+ restore();
+ trail.unwind(stack.getTR());
+ stack.delete();
+ return p;
+ }
+
+ Term makeStreamProperty(SymbolTerm _mode, SymbolTerm io, SymbolTerm _alias, SymbolTerm _type) {
+ Term[] mode = {_mode};
+ Term[] alias = {_alias};
+ Term[] type = {_type};
+
+ Term t = Nil;
+ t = new ListTerm(new StructureTerm(SYM_MODE_1, mode ), t);
+ t = new ListTerm(io, t);
+ t = new ListTerm(new StructureTerm(SYM_ALIAS_1, alias), t);
+ t = new ListTerm(new StructureTerm(SYM_TYPE_1, type ), t);
+ return t;
+ }
+
+ /** Returns the current time stamp of choice point frame. */
+ public long getCPFTimeStamp() { return CPFTimeStamp; }
+
+ /** Returns the value of Prolog implementation flag: <code>bounded</code>. */
+ public boolean isBounded() { return bounded; }
+
+ /** Returns the value of Prolog implementation flag: <code>max_integer</code>. */
+ public int getMaxInteger() { return maxInteger; }
+
+ /** Returns the value of Prolog implementation flag: <code>min_integer</code>. */
+ public int getMinInteger() { return minInteger; }
+
+ /** Returns the value of Prolog implementation flag: <code>integer_rounding_function</code>. */
+ public String getIntegerRoundingFunction() { return integerRoundingFunction; }
+
+ /** Returns the value of Prolog implementation flag: <code>char_conversion</code>. */
+ public String getCharConversion() { return charConversion; }
+ /** Sets the value of Prolog implementation flag: <code>char_conversion</code>. */
+ public void setCharConversion(String mode) { charConversion = mode;}
+
+ /** Returns the value of Prolog implementation flag: <code>debug</code>. */
+ public String getDebug() { return debug; }
+ /** Sets the value of Prolog implementation flag: <code>debug</code>. */
+ public void setDebug(String mode) { debug = mode;}
+
+ /** Returns the value of Prolog implementation flag: <code>max_arity</code>. */
+ public int getMaxArity() { return maxArity; }
+
+ /** Returns the value of Prolog implementation flag: <code>unknown</code>. */
+ public String getUnknown() { return unknown; }
+ /** Sets the value of Prolog implementation flag: <code>unknown</code>. */
+ public void setUnknown(String mode) { unknown = mode;}
+
+ /** Returns the value of Prolog implementation flag: <code>double_quotes</code>. */
+ public String getDoubleQuotes() { return doubleQuotes; }
+ /** Sets the value of Prolog implementation flag: <code>double_quotes</code>. */
+ public void setDoubleQuotes(String mode) { doubleQuotes = mode;}
+
+ /** Returns the value of Prolog implementation flag: <code>print_stack_trace</code>. */
+ public String getPrintStackTrace() { return printStackTrace; }
+ /** Sets the value of Prolog implementation flag: <code>print_stack_trace</code>. */
+ public void setPrintStackTrace(String mode) { printStackTrace = mode;}
+
+ /** Returns the value of <code>exception</code>. This is used in <code>catch/3</code>. */
+ public Term getException() { return exception; }
+ /** Sets the value of <code>exception</code>. This is used in <code>throw/1</code>. */
+ public void setException(Term t) { exception = t;}
+
+ /** Returns the value of <code>startRuntime</code>. This is used in <code>statistics/2</code>. */
+ public long getStartRuntime() { return startRuntime; }
+
+ /** Returns the value of <code>previousRuntime</code>. This is used in <code>statistics/2</code>. */
+ public long getPreviousRuntime() { return previousRuntime; }
+ /** Sets the value of <code>previousRuntime</code>. This is used in <code>statistics/2</code>. */
+ public void setPreviousRuntime(long t) { previousRuntime = t; }
+
+ /** Returns the standard input stream. */
+ public PushbackReader getUserInput() { return userInput; }
+ /** Returns the standard output stream. */
+ public PrintWriter getUserOutput() { return userOutput; }
+ /** Returns the standard error stream. */
+ public PrintWriter getUserError() { return userError; }
+
+ /** Returns the current input stream. */
+ public PushbackReader getCurrentInput() { return currentInput; }
+ /** Sets the current input stream to <code>in</code>. */
+ public void setCurrentInput(PushbackReader in) { currentInput = in; }
+
+ /** Returns the current output stream. */
+ public PrintWriter getCurrentOutput() { return currentOutput; }
+ /** Sets the current output stream to <code>out</code>. */
+ public void setCurrentOutput(PrintWriter out) { currentOutput = out; }
+
+ /** Returns the stream manager. */
+ public HashtableOfTerm getStreamManager() { return streamManager; }
+
+ /** Returns the hash manager. */
+ public HashtableOfTerm getHashManager() { return hashManager; }
+}
diff --git a/src/lang/PrologClassLoader.java b/src/lang/PrologClassLoader.java
new file mode 100644
index 0000000..2d5e0a7
--- /dev/null
+++ b/src/lang/PrologClassLoader.java
@@ -0,0 +1,51 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * Prolog class loader.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PrologClassLoader extends ClassLoader implements Serializable {
+
+ /**
+ * Returns a <code>java.lang.Class</code> object associated with the predicate
+ * class with the given arguments.
+ * @param pkg package name
+ * @param functor predicate name
+ * @param arity predicate arity
+ * @param resolve If <code>true</code> then resolve the class
+ * @return a <code>java.lang.Class</code> object associated with the predicate
+ * class that corresponds to <code>pkg:functor/arity</code>
+ * if exists, otherwise throws <code>ClassNotFoundException</code>.
+ * @exception ClassNotFoundException
+ */
+ public Class loadPredicateClass(String pkg,
+ String functor,
+ int arity,
+ boolean resolve) throws ClassNotFoundException {
+ return loadClass(PredicateEncoder.encode(pkg, functor, arity), resolve);
+ }
+
+ /**
+ * Check whether the predicate class for the given arguments is defined.
+ * @param pkg package name
+ * @param functor predicate name
+ * @param arity predicate arity
+ * @return <code>true</code> if the predicate <code>pkg:functor/arity</code>
+ * is defined, otherwise <code>false</code>.
+ */
+ public boolean definedPredicate(String pkg,
+ String functor,
+ int arity) {
+ String cname = PredicateEncoder.encode(pkg, functor, arity);
+ cname = cname.replace('.', '/') + ".class";
+ java.net.URL url = getResource(cname);
+ return url != null;
+ }
+
+ public Class findClass(String name) throws ClassNotFoundException {
+ throw new ClassNotFoundException();
+ }
+}
diff --git a/src/lang/PrologControl.java b/src/lang/PrologControl.java
new file mode 100644
index 0000000..18d0691
--- /dev/null
+++ b/src/lang/PrologControl.java
@@ -0,0 +1,408 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * Prolog thread.<br>
+ * The <code>PrologControl</code> class is an implementation of
+ * <em>Prolog Box Control Flow Model</em>.<br>
+ * This <code>PrologControl</code> provides methods
+ * for both sequential and parallel execution.
+ *
+ * <pre>
+ * // An example of sequential execution
+ * // calls a goal <code>father(abraham, X)</code> and get all solutions.
+ * PrologControl p = new PrologControl();
+ * Predicate code = new PRED_father_2();
+ * Term a1 = SymbolTerm.makeSymbol("abraham");
+ * Term a2 = new VariableTerm();
+ * Term[] args = {a1, a2};
+ * p.setPredicate(code, args);
+ * for (boolean r = p.call(); r; r = p.redo()) {
+ * System.out.println(a2.toString());
+ * }
+ * </pre>
+ *
+ * <pre>
+ * // To get only one solution.
+ * PrologControl p = new PrologControl();
+ * Predicate code = new PRED_father_2();
+ * Term a1 = SymbolTerm.makeSymbol("abraham");
+ * Term a2 = new VariableTerm();
+ * Term[] args = {a1, a2};
+ * if (p.execute(code, args))
+ * System.out.println(a2.toString());
+ * else
+ * System.out.println("fail");
+ * </pre>
+ *
+ * <pre>
+ * // An example of parallel execution
+ * // calls <code>queens(4,X)</code> and <code>queens(8,Y)</code> in parallel.
+ * // Usage:
+ * // % plcafe -cp queens.jar T
+ * //
+ * import jp.ac.kobe_u.cs.prolog.lang.*;
+ * public class T {
+ * public static void main(String args[]) {
+ * long t = System.currentTimeMillis();
+ * boolean r1 = true;
+ * boolean r2 = true;
+ * Term a1[] = {new IntegerTerm(4), new VariableTerm()};
+ * Term a2[] = {new IntegerTerm(8), new VariableTerm()};
+ *
+ * PrologControl e1 = new PrologControl();
+ * PrologControl e2 = new PrologControl();
+ * Term v1 = new VariableTerm();
+ * Term v2 = new VariableTerm();
+ * e1.setPredicate(new PRED_queens_2(), a1);
+ * e2.setPredicate(new PRED_queens_2(), a2);
+ * System.out.println("Start");
+ * e1.start();
+ * e2.start();
+ * while (r1 || r2) {
+ * try {
+ * Thread.sleep(10);
+ * } catch (InterruptedException e) {}
+ * if (r1 && e1.ready()) {
+ * r1 = e1.next();
+ * if (r1) {
+ * System.out.println("Success1 = " + a1[1]);
+ * e1.cont();
+ * } else {
+ * System.out.println("Fail1");
+ * }
+ * } else if (r2 && e2.ready()) {
+ * r2 = e2.next();
+ * if (r2) {
+ * System.out.println("Success2 = " + a2[1]);
+ * e2.cont();
+ * } else {
+ * System.out.println("Fail2");
+ * }
+ * } else {
+ * System.out.println("Waiting");
+ * try {
+ * Thread.sleep(100);
+ * } catch (InterruptedException e) {}
+ * }
+ * }
+ * System.out.println("End");
+ * long t1 = System.currentTimeMillis();
+ * long t2 = t1 - t;
+ * System.out.println("time = " + t2 + "msec.");
+ * }
+ * }
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2
+ */
+public class PrologControl implements Runnable, Serializable {
+ /** A volatile instance variable holding a thread. */
+ public volatile Thread thread;
+
+ /** Holds a Prolog engine. */
+ public Prolog engine;
+
+ /** Holds a Prolog goal to be executed. */
+ public Predicate code;
+
+ /** A flag that indicates whether the result of goal is <code>true</code> or <code>false</code>. */
+ public boolean result;
+
+ /** A flag that indicates whether the result of goal is ready or not. */
+ public boolean resultReady;
+
+ /** Constructs a new <code>PrologControl</code>. */
+ public PrologControl() {
+ thread = null;
+ engine = new Prolog(this);
+ code = null;
+ result = false;
+ resultReady = false;
+ }
+
+ /** Sets a goal and its arguments to this Prolog thread.
+ * An initial continuation goal (a <code>Success</code> object)
+ * is set to the <code>cont</code> field of goal <code>p</code> as continuation.
+ */
+ public void setPredicate(Predicate p, Term[] args) {
+ code = p;
+ code.setArgument(args, new Success(this));
+ }
+
+ /** Sets a goal <code>call(t)</code> to this Prolog thread.
+ * An initial continuation goal (a <code>Success</code> object)
+ * is set to the <code>cont</code> field of <code>call(t)</code> as continuation.
+ */
+ public void setPredicate(Term t) {
+ try {
+ Class clazz = engine.pcl.loadPredicateClass("jp.ac.kobe_u.cs.prolog.builtin", "call", 1, true);
+ Term[] args = {engine.copy(t)};
+ code = (Predicate)(clazz.newInstance());
+ code.setArgument(args, new Success(this));
+ } catch (Exception e){
+ e.printStackTrace();
+ }
+ }
+
+ /**
+ * Returns <code>true</code> if the system succeeds to find a first solution
+ * of the given goal, <code>false</code> otherwise.<br>
+ *
+ * This method is useful to find only one solution.<br>
+ *
+ * This method first initilizes the Prolog engine by invoking <code>engine.init()</code>,
+ * allocates a new <code>Thread</code> object, and start the execution of the given goal.
+ * And then it stops the thread and returns <code>true</code>
+ * if the goal succeeds, <code>false</code> otherwise.
+ * @see #run
+ */
+ public synchronized boolean execute(Predicate p, Term[] args) {
+ engine.init();
+ code = p;
+ code.setArgument(args, new Success(this));
+ thread = new Thread(this);
+ thread.start(); // execute run() in new thread.
+ try {
+ wait(); // wait caller's thread.
+ } catch (InterruptedException e) {}
+ stop();
+ return result;
+ }
+
+ /**
+ * Returns <code>true</code> if the system succeeds to find a first solution
+ * of the goal, <code>false</code> otherwise.<br>
+ *
+ * This method first invokes the <code>start()</code> method that
+ * initilizes the Prolog engine, allocates a new <code>Thread</code> object,
+ * and start the execution.
+ * And then it returns the <code>boolean</code> whose value is <code>next()</code>.
+ * @see #start
+ * @see #next
+ */
+ public synchronized boolean call() {
+ start();
+ return next();
+ }
+
+ /**
+ * Returns <code>true</code> if the system succeeds to find a next solution
+ * of the goal, <code>false</code> otherwise.<br>
+ *
+ * This method first invokes the <code>cont()</code> method that
+ * sets the <code>resultReady</code> to <code>false</code>
+ * and wakes up all threads that are waiting on this object's monitor.
+ * And then it returns the <code>boolean</code> whose value is <code>next()</code>.
+ * @see #cont
+ * @see #next
+ */
+ public synchronized boolean redo() {
+ cont();
+ return next();
+ }
+
+ /**
+ * Is invoked when the system succeeds to find a solution.<br>
+ *
+ * This method is invoked from the initial continuation goal
+ * (a <code>Success</code> object).<br>
+ *
+ * This method first sets the <code>resultReady</code> and <code>result</code> to <code>true</code>.
+ * And then it wakes up all threads that are waiting by <code>notifyAll()</code>.
+ * Finally, while the <code>thread</code> is not <code>null</code> and
+ * the <code>resultReady</code> is <code>true</code>,
+ * it waits until another thread invokes the <code>notify()</code> method
+ * or the <code>notifyAll()</code> method for this object.
+ * @see #resultReady
+ * @see #result
+ * @see #thread
+ */
+ protected synchronized void success() {
+ resultReady = true;
+ result = true;
+ notifyAll();
+ while (thread != null && resultReady) {
+ try {
+ wait();
+ } catch (InterruptedException e) {}
+ }
+ }
+
+ /**
+ * Is invoked after failure of all trials.<br>
+ *
+ * This method is invoked from the <code>run</code> method.<br>
+ *
+ * This method first sets the <code>resultReady</code> and <code>result</code>
+ * to <code>true</code> and <code>false</code> respectively.
+ * And then it wakes up all threads that are waiting by <code>notifyAll()</code>.
+ * Finally, while the <code>thread</code> is not <code>null</code> and
+ * the <code>resultReady</code> is <code>true</code>,
+ * it waits until another thread invokes the <code>notify()</code> method
+ * or the <code>notifyAll()</code> method for this object.
+ * @see #resultReady
+ * @see #result
+ * @see #thread
+ */
+ protected synchronized void fail() {
+ resultReady = true;
+ result = false;
+ notifyAll();
+ while (thread != null && resultReady) {
+ try {
+ wait();
+ } catch (InterruptedException e) {}
+ }
+ }
+
+ /** Waits for this thread to die. */
+ public synchronized void join() {
+ while (thread != null && ! resultReady) {
+ try {
+ wait();
+ } catch (InterruptedException e) {}
+ }
+ stop();
+ }
+
+ /**
+ * Forces the thread to stop.<br>
+ *
+ * This method first sets the <code>resultReady</code> and <code>thread</code>
+ * to <code>false</code> and <code>null</code> respectively.
+ * And then it wakes up all threads that are waiting by <code>notifyAll()</code>.
+ * @see #resultReady
+ * @see #thread
+ */
+ public synchronized void stop() {
+ resultReady = false;
+ thread = null;
+ notifyAll();
+ }
+
+ /**
+ * Forces the thread to start the execution.<br>
+ *
+ * This method initilizes the Prolog engine by invoking <code>engine.init()</code>,
+ * allocates a new <code>Thread</code> object, and start the execution.
+ * The Java Virtual Machine calls the <code>run</code> method of this thread.
+ * @see #run
+ */
+ public synchronized void start() {
+ resultReady = false;
+ engine.init();
+ thread = new Thread(this);
+ thread.start();
+ }
+
+ /**
+ * Forces the thread to continue the execution.<br>
+ *
+ * This method sets the <code>resultReady</code> to <code>false</code>,
+ * and then wakes up all threads that are waiting by <code>notifyAll()</code>.
+ * @see #resultReady
+ */
+ public synchronized void cont() {
+ resultReady = false;
+ notifyAll();
+ }
+
+ /**
+ * Returns <code>true</code> if the result of goal is ready,
+ * <code>false</code> otherwise.
+ * @return a <code>boolean</code> whose value is <code>resultReady</code>.
+ * @see #resultReady
+ */
+ public synchronized boolean ready() {
+ return resultReady;
+ }
+
+ /**
+ * Returns <code>true</code> if the result of goal is ready and true, otherwise <code>false</code>.
+ * @return a <code>boolean</code> whose value is <code>(ready() && result)</code>.
+ * @see #ready
+ * @see #result
+ */
+ public synchronized boolean in_success() {
+ return ready() && result;
+ }
+
+ /**
+ * Returns <code>true</code> if the result of goal is ready and false, otherwise <code>false</code>.
+ * @return a <code>boolean</code> whose value is <code>(ready() && !result)</code>.
+ * @see #ready
+ * @see #result
+ */
+ public synchronized boolean in_failure() {
+ return ready() && ! result;
+ }
+
+ /**
+ * Wait until the system finds a next solution,
+ * and then returns the result as <code>boolean</code>.<br>
+ *
+ * This method first waits until another thread invokes the <code>notify()</code>
+ * method or the <code>notifyAll()</code> method for this object,
+ * while the <code>thread</code> is not <code>null</code> and
+ * the <code>resultReady</code> is <code>false</code>.
+ * And then invokes the <code>stop()</code> if the <code>result</code> is <code>false</code>.
+ * Finally, returns the <code>result</code>.
+ * @see #resultReady
+ * @see #result
+ * @see #thread
+ */
+ public synchronized boolean next() {
+ while (thread != null && ! resultReady) {
+ try {
+ wait();
+ } catch (InterruptedException e) {}
+ }
+ if (! result) {
+ stop();
+ }
+ return result;
+ }
+
+ /**
+ * Executes the goal.<br>
+ *
+ * Every time finding a solution, the <code>success</code> method is invoked.
+ * And then the <code>fail</code> method is invoked after failure of all trials.
+ * Finally, the <code>stop</code> method is invoked at the end of this <code>run</code>.
+ * @see #success
+ * @see #fail
+ * @see #stop
+ */
+ public void run() {
+ try {
+ main_loop:while(true) {
+ while (engine.exceptionRaised == 0) {
+ if (thread == null)
+ break main_loop;
+ code = code.exec(engine);
+ }
+ switch (engine.exceptionRaised) {
+ case 1: // halt/0
+ break main_loop;
+ case 2: // freeze/2
+ throw new SystemException("freeze/2 is not supported yet");
+ // Do something here
+ // engine.exceptionRaised = 0 ;
+ // break;
+ default:
+ throw new SystemException("Invalid value of exceptionRaised");
+ }
+ }
+ } catch (PrologException e){
+ if (engine.getPrintStackTrace().equals("on"))
+ e.printStackTrace();
+ else
+ System.out.println(e.toString());
+ } catch (Exception e){
+ e.printStackTrace();
+ }
+ stop();
+ }
+}
diff --git a/src/lang/PrologException.java b/src/lang/PrologException.java
new file mode 100644
index 0000000..c8cab89
--- /dev/null
+++ b/src/lang/PrologException.java
@@ -0,0 +1,17 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * The superclass of classes for Prolog exceptions.<br>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public abstract class PrologException extends RuntimeException implements Serializable {
+
+ /** Constructs a new Prolog exception. */
+ public PrologException() {}
+
+ /** Returns the message term of this object. */
+ abstract public Term getMessageTerm();
+}
diff --git a/src/lang/PrologMain.java b/src/lang/PrologMain.java
new file mode 100644
index 0000000..711c6d9
--- /dev/null
+++ b/src/lang/PrologMain.java
@@ -0,0 +1,114 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.StringTokenizer;
+/**
+ * Prolog Cafe launcher.
+ * The <code>PrologMain</code> class launchs the Prolog Cafe system.<br>
+ * The usage is as follows, where
+ * <code>package</code> is a package name, and
+ * <code>predicate</code> is a predicate name (only atom).
+ * <pre>
+ * % java -cp $PLCAFEDIR/plcafe.jar jp.ac.kobe_u.cs.prolog.lang.PrologMain package:predicate
+ * % java -cp $PLCAFEDIR/plcafe.jar jp.ac.kobe_u.cs.prolog.lang.PrologMain predicate
+ * </pre>
+ * Let us show a sample session for launching a small Prolog interpreter:
+ * <code>jp.ac.kobe_u.cs.prolog.builtin:cafeteria/0</code>.<br>
+ * <pre>
+ * % java -cp $PLCAFEDIR/plcafe.jar:$CLASSPATH jp.ac.kobe_u.cs.prolog.lang.PrologMain jp.ac.kobe_u.cs.prolog.builtin:cafeteria
+ * Prolog Cafe X.X.X (YYY)
+ * Copyright(C) 1997-200X M.Banbara and N.Tamura
+ * | ?-
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class PrologMain {
+ /** Version information */
+ public static String VERSION = "Prolog Cafe 1.2.5 (mantis)";
+ /** Copyright information */
+ public static String COPYRIGHT = "Copyright(C) 1997-2009 M.Banbara and N.Tamura";
+
+ public static void main(String argv[]) {
+ PrologControl p;
+ Predicate code;
+ String goal;
+ Class clazz;
+ try {
+ System.err.println("\n" + VERSION);
+ System.err.println(COPYRIGHT);
+ if (argv.length != 1) {
+ usage();
+ System.exit(999);
+ }
+ clazz = (new PrologClassLoader()).loadPredicateClass("jp.ac.kobe_u.cs.prolog.builtin",
+ "initialization",
+ 2,
+ true);
+ Term arg1 = Prolog.Nil;
+ arg1 = new ListTerm(SymbolTerm.makeSymbol("user"), arg1);
+ arg1 = new ListTerm(SymbolTerm.makeSymbol("jp.ac.kobe_u.cs.prolog.builtin"), arg1);
+ // arg1 = new ListTerm(SymbolTerm.makeSymbol("jp.ac.kobe_u.cs.prolog.compiler.pl2am"), arg1);
+ // arg1 = new ListTerm(SymbolTerm.makeSymbol("jp.ac.kobe_u.cs.prolog.compiler.am2j"), arg1);
+ Term arg2 = parseAtomicGoal(argv[0]);
+ if (arg2 == null) {
+ usage();
+ System.exit(1);
+ }
+ Term[] args = {arg1, arg2};
+ code = (Predicate)(clazz.newInstance());
+ p = new PrologControl();
+ p.setPredicate(code, args);
+ for (boolean r = p.call(); r; r = p.redo()) {}
+ System.exit(0);
+ } catch (Exception e){
+ e.printStackTrace();
+ System.exit(1);
+ }
+ }
+
+ /** Returns a term for given string representation of atom goal, or
+ * <code>null</code> if parsing fails.
+ * @param s a string representation of initial goal (ex. foge:main).
+ * @return a term which corresponds to a given string,
+ * or <code>null</code> if parsing fails.
+ */
+ protected static Term parseAtomicGoal(String s) {
+ StringTokenizer st = new StringTokenizer(s, ":");
+ int i = st.countTokens();
+ if (i == 1) {
+ Term[] args = {SymbolTerm.makeSymbol("user"),
+ SymbolTerm.makeSymbol(st.nextToken())};
+ return new StructureTerm(SymbolTerm.makeSymbol(":", 2), args);
+ } else if (i == 2) {
+ Term[] args = {SymbolTerm.makeSymbol(st.nextToken()),
+ SymbolTerm.makeSymbol(st.nextToken())};
+ return new StructureTerm(SymbolTerm.makeSymbol(":", 2), args);
+ } else {
+ return null;
+ }
+ }
+
+ /** Shows usage */
+ protected static void usage() {
+ String s = "Usage:\n";
+ s += "java -cp $PLCAFEDIR/plcafe.jar";
+ s += " jp.ac.kobe_u.cs.prolog.lang.PrologMain package:predicate\n";
+ s += "java -cp $PLCAFEDIR/plcafe.jar";
+ s += " jp.ac.kobe_u.cs.prolog.lang.PrologMain predicate\n";
+ s += " package: package name\n";
+ s += " predicate: predicate name (only atom)";
+ System.out.println(s);
+ }
+
+ /*
+ public static Term makeList(int n){
+ Term t = SymbolTerm.makeSymbol("[]");
+ for (int i=n; i>0; i--){
+ t = new ListTerm(new IntegerTerm(i), t);
+ }
+ return t;
+ }
+ */
+}
+
diff --git a/src/lang/PushDownList.java b/src/lang/PushDownList.java
new file mode 100644
index 0000000..f07741f
--- /dev/null
+++ b/src/lang/PushDownList.java
@@ -0,0 +1,94 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * Push down List.<br>
+ * The class <code>PushDownList</code> represents a push down list.<br>
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.1
+ */
+public class PushDownList implements Serializable {
+ /** Maximum size of enties. Initial size is <code>10000</code>. */
+ protected int maxContents = 1000;
+
+ /** An array of <code>Term</code> entries. */
+ protected Term[] buffer;
+
+ /** the top index of this <code>PushDownList</code>. */
+ protected int top;
+
+ /** Constructs a new pdl. */
+ public PushDownList() {
+ buffer = new Term[maxContents];
+ top = -1;
+ }
+
+ /** Constructs a new pdl with the given size. */
+ public PushDownList(int n) {
+ maxContents = n;
+ buffer = new Term[maxContents];
+ top = -1;
+ }
+
+ /** Discards all entries. */
+ public void init() { deleteAll(); }
+
+ /** Pushs an entry to this <code>PushDownList</code>. */
+ public void push(Term t) {
+ try {
+ buffer[++top] = t;
+ } catch (ArrayIndexOutOfBoundsException e) {
+ System.out.println("{expanding pdl...}");
+ int len = buffer.length;
+ Term[] new_buffer = new Term[len+10000];
+ for(int i=0; i<len; i++){
+ new_buffer[i] = buffer[i];
+ }
+ buffer = new_buffer;
+ buffer[top] = t;
+ maxContents = len+10000;
+ }
+ }
+
+ /** Pops an entry from this <code>PushDownList</code>. */
+ public Term pop() {
+ Term t = buffer[top];
+ buffer[top--] = null;
+ return t;
+ }
+
+ /** Discards all entries. */
+ protected void deleteAll() {
+ while (! empty()) {
+ buffer[top--] = null;
+ }
+ }
+
+ /** Tests if this pdl has no entry. */
+ public boolean empty() {
+ return top == -1;
+ }
+
+ /** Returns the value of <code>maxContents</code>.
+ * @see #maxContents
+ */
+ public int max() { return maxContents; }
+
+ /** Returns the value of <code>top</code>.
+ * @see #top
+ */
+ public int top() { return top; }
+
+ /** Shows the contents of this <code>PushDownList</code>. */
+ public void show() {
+ if (empty()) {
+ System.out.println("{pdl is empty!}");
+ return;
+ }
+ for (int i=0; i<=top; i++) {
+ System.out.print("pdl[" + i + "]: ");
+ System.out.println(buffer[i]);
+ }
+ }
+}
+
diff --git a/src/lang/RepresentationException.java b/src/lang/RepresentationException.java
new file mode 100644
index 0000000..7f32b22
--- /dev/null
+++ b/src/lang/RepresentationException.java
@@ -0,0 +1,54 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Representation error.<br>
+ * There will be a representation error when an implementation
+ * defined limit has been breached.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class RepresentationException extends BuiltinException {
+ /** A functor symbol of <code>representation_error/3</code>. */
+ public static SymbolTerm REPRESENTATION_ERROR = SymbolTerm.makeSymbol("representation_error", 3);
+
+ /*
+ flag ::= character | character_code | in_character_code |
+ max_arity | max_integer | min_integer
+ */
+ /** Holds a string representation of flag. */
+ public String flag;
+
+ /** Constructs a new <code>RepresentationException</code> with a flag. */
+ public RepresentationException(String _flag) {
+ flag = _flag;
+ }
+
+ /** Constructs a new <code>RepresentationException</code> with the given arguments. */
+ public RepresentationException(Predicate _goal, int _argNo, String _flag) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ flag = _flag;
+ }
+
+ /** Returns a term representation of this <code>RepresentationException</code>:
+ * <code>representation_error(goal,argNo,flag)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ new IntegerTerm(argNo),
+ SymbolTerm.makeSymbol(flag)};
+ return new StructureTerm(REPRESENTATION_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>RepresentationException</code>. */
+ public String toString() {
+ String s = "{REPRESENTATION ERROR: " + goal.toString();
+ if (argNo > 0)
+ s += " - arg " + argNo;
+ s += ": limit of " + flag + " is breached";
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/StructureTerm.java b/src/lang/StructureTerm.java
new file mode 100644
index 0000000..6a45a07
--- /dev/null
+++ b/src/lang/StructureTerm.java
@@ -0,0 +1,219 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Compound term. <br>
+ * The <code>StructureTerm</code> class represents a compound term but list.<br>
+ *
+ * <pre>
+ * % father(abraham, X)
+ * Term a1 = SymbolTerm.makeSymbol("abraham");
+ * Term a2 = new VariableTerm();
+ * Term[] a3 = {a1, a2};
+ * Term a4 = SymbolTerm.makeSymbol("father", 2);
+ * Term t = new StructureTerm(a4, a3);
+ *
+ * Term functor = ((StructureTerm)t).functor();
+ * Term[] args = ((StructureTerm)t).args();
+ * int arity = ((StructureTerm)t).arity();
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class StructureTerm extends Term {
+ /** Holds the functor symbol of this <code>StructureTerm</code>. */
+ protected SymbolTerm functor;
+
+ /** Holds the argument terms of this <code>StructureTerm</code>. */
+ protected Term[] args;
+
+ /** Holds the arity of this <code>StructureTerm</code>. */
+ protected int arity;
+
+ /**
+ * Constructs a new Prolog compound term
+ * such that <code>_functor</code> is the functor symbol, and
+ * <code>_args</code> is the argument terms respectively.
+ */
+ public StructureTerm(SymbolTerm _functor, Term[] _args){
+ functor = _functor;
+ arity = functor.arity();
+ args = _args;
+ if (arity != args.length)
+ throw new InternalException("Invalid argument length in StructureTerm");
+ }
+
+ /** Returns the functor symbol of this <code>StructureTerm</code>.
+ * @return the value of <code>functor</code>.
+ * @see #functor
+ */
+ public SymbolTerm functor(){ return functor; }
+
+ /** Returns the arity of this <code>StructureTerm</code>.
+ * @return the value of <code>arity</code>.
+ * @see #arity
+ */
+ public int arity(){ return arity; }
+
+ /** Returns the argument terms of this <code>StructureTerm</code>.
+ * @return the value of <code>args</code>.
+ * @see #args
+ */
+ public Term[] args(){ return args; }
+
+ /** Returns the string representation of functor symbol of this <code>StructureTerm</code>.
+ * @return a <code>String</code> whose value is <code>functor.name()</code>.
+ * @see #functor
+ * @see SymbolTerm#name
+ */
+ public String name(){ return functor.name(); }
+
+ /* Term
+ public boolean unify(Term t, Trail trail) {
+ if (t.isVariable())
+ return t.unify(this, trail);
+ if (! t.isStructure())
+ return false;
+ if (! functor.equals(((StructureTerm)t).functor()))
+ return false;
+ for (int i=0; i<arity; i++) {
+ if (! args[i].unify(((StructureTerm)t).args[i], trail))
+ return false;
+ }
+ return true;
+ } */
+
+
+ public boolean unify(Term t, Trail trail) {
+ t = t.dereference();
+ if (t.isVariable()) {
+ ((VariableTerm) t).bind(this, trail);
+ return true;
+ }
+ if (! t.isStructure())
+ return false;
+ if (! functor.equals(((StructureTerm)t).functor()))
+ return false;
+ for (int i=0; i<arity; i++) {
+ if (! args[i].unify(((StructureTerm)t).args[i], trail))
+ return false;
+ }
+ return true;
+ }
+
+ // public boolean unify(Term t, Trail trail) {
+ // return trail.engine.unify(this, t);
+ // }
+
+
+ protected Term copy(Prolog engine) {
+ Term[] a = new Term[arity];
+ for (int i=0; i<arity; i++)
+ a[i] = args[i].copy(engine);
+ return new StructureTerm(functor, a);
+ }
+
+ public boolean isGround() {
+ for (int i=0; i<arity; i++) {
+ if (! args[i].isGround())
+ return false;
+ }
+ return true;
+ }
+
+ public String toQuotedString() {
+ String delim = "";
+ String s = functor.toQuotedString() + "(";
+ for (int i=0; i<arity; i++) {
+ s += delim + args[i].toQuotedString();
+ delim = ",";
+ }
+ s += ")";
+ return s;
+ }
+
+ /* Object */
+ /**
+ * Checks <em>term equality</em> of two terms.
+ * The result is <code>true</code> if and only if the argument is an instance of
+ * <code>StructureTerm</code>, has the same functor symbol and arity, and
+ * all corresponding pairs of arguments in the two compound terms are <em>term-equal</em>.
+ * @param obj the object to compare with. This must be dereferenced.
+ * @return <code>true</code> if the given object represents a Prolog compound term
+ * equivalent to this <code>StructureTerm</code>, false otherwise.
+ * @see #compareTo
+ */
+ public boolean equals(Object obj) {
+ if (! (obj instanceof StructureTerm))
+ return false;
+ if (! functor.equals(((StructureTerm)obj).functor()))
+ return false;
+ for (int i=0; i<arity; i++) {
+ if (! args[i].equals(((StructureTerm)obj).args[i].dereference()))
+ return false;
+ }
+ return true;
+ }
+
+ public int hashCode() {
+ int h = 1;
+ h = 31*h + functor.hashCode();
+ for(int i=0; i<arity; i++)
+ h = 31*h + args[i].dereference().hashCode();
+ return h;
+ }
+
+ /** Returns a string representation of this <code>StructureTerm</code>. */
+ public String toString() {
+ String delim = "";
+ String s = functor.toString() + "(";
+ for (int i=0; i<arity; i++) {
+ s += delim + args[i].toString();
+ delim = ",";
+ }
+ s += ")";
+ return s;
+ }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compared with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced.
+ SymbolTerm functor2;
+ Term[] args2;
+ int arity2, rc;
+
+ if (anotherTerm.isVariable() || anotherTerm.isNumber() || anotherTerm.isSymbol())
+ return AFTER;
+ if (anotherTerm.isList()) {
+ functor2 = ListTerm.SYM_DOT;
+ args2 = new Term[2];
+ args2[0] = ((ListTerm)anotherTerm).car();
+ args2[1] = ((ListTerm)anotherTerm).cdr();
+ arity2 = 2;
+ } else if (anotherTerm.isStructure()) {
+ functor2 = ((StructureTerm)anotherTerm).functor();
+ args2 = ((StructureTerm)anotherTerm).args();
+ arity2 = ((StructureTerm)anotherTerm).arity();
+ } else {
+ return BEFORE;
+ }
+ if (arity != arity2)
+ return (arity - arity2);
+ if (! functor.equals(functor2))
+ return functor.compareTo(functor2);
+ for (int i=0; i<arity; i++) {
+ rc = args[i].compareTo(args2[i].dereference());
+ if (rc != EQUAL)
+ return rc;
+ }
+ return EQUAL;
+ }
+}
diff --git a/src/lang/Success.java b/src/lang/Success.java
new file mode 100644
index 0000000..26385cc
--- /dev/null
+++ b/src/lang/Success.java
@@ -0,0 +1,40 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Initial continuation goal.<br>
+ * That is to say, this <code>Success</code> will be executed
+ * every time the Prolog Cafe system finds an answer.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class Success extends Predicate {
+ /** Prolog thread that this <code>Success</code> belongs to. */
+ public PrologControl c;
+
+ /** Constructs a new initial continuation goal. */
+ public Success(){}
+
+ /** Constructs a new initial continuation goal with given Prolog thread. */
+ public Success(PrologControl c) {
+ this.c = c;
+ }
+
+ /**
+ * Backtracks and returns a next clause
+ * after invoking the <code>PrologControl.success()</code>.
+ * @param engine Prolog engine
+ * @see PrologControl#success
+ */
+ public Predicate exec(Prolog engine) {
+ c.success();
+ return engine.fail();
+ }
+
+ /** Returns a string representation of this <code>Success</code>. */
+ public String toString(){ return "Success"; }
+
+ /** Returns <code>0</code>. */
+ public int arity() { return 0; }
+}
+
diff --git a/src/lang/SymbolTerm.java b/src/lang/SymbolTerm.java
new file mode 100644
index 0000000..cafd8fe
--- /dev/null
+++ b/src/lang/SymbolTerm.java
@@ -0,0 +1,121 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.Hashtable;
+/**
+ * Atom.<br>
+ * The <code>SymbolTerm</code> class represents a Prolog atom.<br>
+ *
+ * <pre>
+ * Term t = SymbolTerm.makeSymbol("kobe");
+ * String name = ((SymbolTerm)t).name();
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class SymbolTerm extends Term {
+
+ /** Symbol table. */
+ protected static Hashtable<String,SymbolTerm> SYMBOL_TABLE = new Hashtable<String,SymbolTerm>();
+
+ /** Holds a string representation of this <code>SymbolTerm</code>. */
+ protected String name;
+
+ /** Holds the arity of this <code>SymbolTerm</code>. */
+ protected int arity;
+
+ /** Returns a Prolog atom for the given name. */
+ public static SymbolTerm makeSymbol(String _name) {
+ return makeSymbol(_name, 0);
+ }
+
+ /** Returns a Prolog functor for the given name and arity. */
+ public static SymbolTerm makeSymbol(String _name, int _arity) {
+ String key = _name + "/" + _arity;
+ SymbolTerm sym;
+
+ synchronized (SYMBOL_TABLE) {
+ sym = SYMBOL_TABLE.get(key);
+ if (sym == null) {
+ sym = new SymbolTerm(_name, _arity);
+ SYMBOL_TABLE.put(key, sym);
+ }
+ }
+ return sym;
+ }
+
+ /** Constructs a new Prolog atom (or functor) with the given symbol name and arity. */
+ protected SymbolTerm(String _name, int _arity) {
+ name = _name;
+ arity = _arity;
+ }
+
+ /** Returns the arity of this <code>SymbolTerm</code>.
+ * @return the value of <code>arity</code>.
+ * @see #arity
+ */
+ public int arity() { return arity; }
+
+ /** Returns the string representation of this <code>SymbolTerm</code>.
+ * @return the value of <code>name</code>.
+ * @see #name
+ */
+ public String name() { return name; }
+
+ /* Term */
+ public boolean unify(Term t, Trail trail) {
+ t = t.dereference();
+ if (t.isVariable()) {
+ ((VariableTerm) t).bind(this, trail);
+ return true;
+ }
+ return this == t;
+ // return name.equals(((SymbolTerm)t).name());
+ }
+
+ /**
+ * @return the <code>boolean</code> whose value is
+ * <code>convertible(String.class, type)</code>.
+ * @see Term#convertible(Class, Class)
+ */
+ public boolean convertible(Class type) { return convertible(String.class, type); }
+
+ /**
+ * Returns a <code>java.lang.String</code> corresponds to this <code>SymbolTerm</code>
+ * according to <em>Prolog Cafe interoperability with Java</em>.
+ * @return a <code>java.lang.String</code> object equivalent to
+ * this <code>SymbolTerm</code>.
+ */
+ public Object toJava() { return name; }
+
+ public String toQuotedString() { return Token.toQuotedString(name); }
+
+ /** Returns a string representation of this <code>SymbolTerm</code>. */
+ public String toString() { return name; }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compared with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced.
+ if (anotherTerm.isVariable() || anotherTerm.isNumber())
+ return AFTER;
+ if (! anotherTerm.isSymbol())
+ return BEFORE;
+ if (this == anotherTerm)
+ return EQUAL;
+ int x = name.compareTo(((SymbolTerm)anotherTerm).name());
+ if (x != 0)
+ return x;
+ int y = this.arity - ((SymbolTerm)anotherTerm).arity();
+ if (y != 0)
+ return y;
+ throw new InternalException("SymbolTerm is not unique");
+ }
+}
diff --git a/src/lang/SyntaxException.java b/src/lang/SyntaxException.java
new file mode 100644
index 0000000..29f9a2f
--- /dev/null
+++ b/src/lang/SyntaxException.java
@@ -0,0 +1,64 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Syntax error.<br>
+ * There will be a syntax error when a sequence of characters
+ * which are being input as read-term do not conform to the syntax.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class SyntaxException extends BuiltinException {
+ /** A functor symbol of <code>syntax_error/5</code>. */
+ public static SymbolTerm SYNTAX_ERROR = SymbolTerm.makeSymbol("syntax_error", 5);
+
+ /** Holds a string representation of valid type. */
+ public String type;
+
+ /** Holds the argument or one of its components which caused the error. */
+ public Term culprit;
+
+ /** Holds a string representation of detail message. */
+ public String message;
+
+ /** Constructs a new <code>SyntaxException</code>
+ * with a valid type, its culprit, and message. */
+ public SyntaxException(String _type, Term _culprit, String _message) {
+ type = _type;
+ culprit = _culprit;
+ message = _message;
+ }
+
+ /** Constructs a new <code>SyntaxException</code> with the given arguments. */
+ public SyntaxException(Predicate _goal, int _argNo, String _type, Term _culprit, String _message) {
+ this.goal = _goal;
+ this.argNo = _argNo;
+ type = _type;
+ culprit = _culprit;
+ message = _message;
+ }
+
+ /** Returns a term representation of this <code>SyntaxException</code>:
+ * <code>syntax_error(goal,argNo,type,culprit,message)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {
+ new JavaObjectTerm(goal),
+ new IntegerTerm(argNo),
+ SymbolTerm.makeSymbol(type),
+ culprit,
+ SymbolTerm.makeSymbol(message) };
+ return new StructureTerm(SYNTAX_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>SyntaxException</code>. */
+ public String toString() {
+ String s = "{SYNTAX ERROR: " + goal.toString();
+ if (argNo > 0)
+ s += " - arg " + argNo;
+ s += ": expected " + type;
+ s += ", found " + culprit.toString();
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/SystemException.java b/src/lang/SystemException.java
new file mode 100644
index 0000000..63a6e25
--- /dev/null
+++ b/src/lang/SystemException.java
@@ -0,0 +1,35 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * System error.<br>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class SystemException extends PrologException {
+ /** A functor symbol of <code>system_error/1</code>. */
+ public static SymbolTerm SYSTEM_ERROR = SymbolTerm.makeSymbol("system_error", 1);
+
+ /** Holds a message. */
+ public String message;
+
+ /** Constructs a new <code>SystemException</code> with a message. */
+ public SystemException(String _message) {
+ message = _message;
+ }
+
+ /** Returns a term representation of this <code>SystemException</code>:
+ * <code>system_error(message)</code>.
+ */
+ public Term getMessageTerm() {
+ Term[] args = {SymbolTerm.makeSymbol(message)};
+ return new StructureTerm(SYSTEM_ERROR, args);
+ }
+
+ /** Returns a string representation of this <code>SystemException</code>. */
+ public String toString() {
+ String s = "{SYSTEM ERROR: " + message;
+ s += "}";
+ return s;
+ }
+}
diff --git a/src/lang/Term.java b/src/lang/Term.java
new file mode 100644
index 0000000..aa56b2d
--- /dev/null
+++ b/src/lang/Term.java
@@ -0,0 +1,200 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * The superclass of classes for term structures.
+ * The subclasses of <code>Term</code> must override
+ * the <code>unify</code> method.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public abstract class Term implements Serializable,Comparable<Term> {
+
+ /** Holds an integer value <code>0</code>. */
+ public static int EQUAL = 0;
+ /** Holds an integer value <code>1</code>. */
+ public static int AFTER = 1;
+ /** Holds an integer value <code>-1</code>. */
+ public static int BEFORE = -1;
+
+ /**
+ * Checks whether the argument term is unified with this one.
+ * @param t the term to be unified with.
+ * @param trail Trail Stack.
+ * @return <code>true</code> if succeeds, otherwise <code>false</code>.
+ */
+ abstract public boolean unify(Term t, Trail trail);
+
+ /**
+ * Check whether this term is a logical variable.
+ * @return <code>true</code> if <code>this instanceof VariableTerm</code>,
+ * otherwise <code>false</code>.
+ * @see VariableTerm
+ */
+ public boolean isVariable() { return this instanceof VariableTerm; }
+
+ /**
+ * Check whether this term is an integer.
+ * @return <code>true</code> if <code>this instanceof IntegerTerm</code>,
+ * otherwise <code>false</code>.
+ * @see IntegerTerm
+ */
+ public boolean isInteger() { return this instanceof IntegerTerm; }
+
+ /**
+ * Check whether this term is a float.
+ * @return <code>true</code> if <code>this instanceof DoubleTerm</code>,
+ * otherwise <code>false</code>.
+ * @see DoubleTerm
+ */
+ public boolean isDouble() { return this instanceof DoubleTerm; }
+
+ /**
+ * Check whether this term is a number.
+ * @return <code>true</code> if <code>this instanceof IntegerTerm || this instanceof DoubleTerm</code>,
+ * otherwise <code>false</code>.
+ * @see IntegerTerm
+ * @see DoubleTerm
+ */
+ public boolean isNumber() { return ((this instanceof IntegerTerm) || (this instanceof DoubleTerm)); }
+
+ /**
+ * Check whether this term is an atom.
+ * @return <code>true</code> if <code>this instanceof SymbolTerm</code>,
+ * otherwise <code>false</code>.
+ * @see SymbolTerm
+ */
+ public boolean isSymbol() { return this instanceof SymbolTerm; }
+
+ /** Check whether this term is an empty list. */
+ public boolean isNil() { return Prolog.Nil.equals(this); }
+
+ /**
+ * Check whether this term is a list structure.
+ * @return <code>true</code> if <code>this instanceof ListTerm</code>,
+ * otherwise <code>false</code>.
+ * @see ListTerm
+ */
+ public boolean isList() { return this instanceof ListTerm; }
+
+ /**
+ * Check whether this term is a compound term.
+ * @return <code>true</code> if <code>this instanceof StructureTerm</code>,
+ * otherwise <code>false</code>.
+ * @see StructureTerm
+ */
+ public boolean isStructure() { return this instanceof StructureTerm; }
+
+ /**
+ * Check whether this term is a java term.
+ * @return <code>true</code> if <code>this instanceof JavaObjectTerm</code>,
+ * otherwise <code>false</code>.
+ * @see JavaObjectTerm
+ */
+ public boolean isJavaObject() { return this instanceof JavaObjectTerm; }
+
+ /**
+ * Check whether this term is a closure term.
+ * @return <code>true</code> if <code>this instanceof ClosureTerm</code>,
+ * otherwise <code>false</code>.
+ * @see ClosureTerm
+ */
+ public boolean isClosure() { return this instanceof ClosureTerm; }
+
+ /**
+ * Check whether this object is convertible with the given Java class type.
+ * @param type the Java class type to compare with.
+ * @return <code>true</code> if this is convertible with
+ * <code>type</code>. Otherwise <code>false</code>.
+ * @see #convertible(Class, Class)
+ */
+ public boolean convertible(Class type) { return convertible(getClass(), type); }
+
+ /** Returns a copy of this object. */
+ protected Term copy(Prolog engine) { return this; }
+
+ /** Returns the dereference value of this term. */
+ public Term dereference() { return this; }
+
+ /**
+ * Check whether this term is a ground term.
+ * @return <code>true</code> if ground, otherwise <code>false</code>.
+ */
+ public boolean isGround() { return true; }
+
+ /**
+ * Returns a Java object that corresponds to this term
+ * if defined in <em>Prolog Cafe interoperability with Java</em>.
+ * Otherwise, returns <code>this</code>.
+ * @return a Java object if defined in <em>Prolog Cafe interoperability with Java</em>,
+ * otherwise <code>this</code>.
+ */
+ public Object toJava() {
+ return this;
+ }
+
+ /** Returns a quoted string representation of this term. */
+ public String toQuotedString() { return this.toString(); }
+
+ /**
+ * Check whether there is a widening conversion from <code>from</code> to <code>to</code>.
+ */
+ protected static boolean convertible(Class from, Class<?> to) {
+ if (from == null)
+ return ! to.isPrimitive();
+ if (to.isAssignableFrom(from)) {
+ return true;
+ } else if (to.isPrimitive()) {
+ if (from.equals(Boolean.class)) {
+ return to.equals(Boolean.TYPE);
+ } else if (from.equals(Byte.class)) {
+ return to.equals(Byte.TYPE)
+ || to.equals(Short.TYPE)
+ || to.equals(Integer.TYPE)
+ || to.equals(Long.TYPE)
+ || to.equals(Float.TYPE)
+ || to.equals(Double.TYPE);
+ } else if (from.equals(Short.class)) {
+ return to.equals(Short.TYPE)
+ || to.equals(Integer.TYPE)
+ || to.equals(Long.TYPE)
+ || to.equals(Float.TYPE)
+ || to.equals(Double.TYPE);
+ } else if (from.equals(Character.class)) {
+ return to.equals(Character.TYPE)
+ || to.equals(Integer.TYPE)
+ || to.equals(Long.TYPE)
+ || to.equals(Float.TYPE)
+ || to.equals(Double.TYPE);
+ } else if (from.equals(Integer.class)) {
+ return to.equals(Integer.TYPE)
+ || to.equals(Long.TYPE)
+ || to.equals(Float.TYPE)
+ || to.equals(Double.TYPE);
+ } else if (from.equals(Long.class)) {
+ return to.equals(Long.TYPE)
+ || to.equals(Float.TYPE)
+ || to.equals(Double.TYPE);
+ } else if (from.equals(Float.class)) {
+ return to.equals(Float.TYPE)
+ || to.equals(Double.TYPE);
+ } else if (from.equals(Double.class)) {
+ return to.equals(Double.TYPE);
+ }
+ }
+ return false;
+ }
+
+ /** Checks whether a given object is an instance of Prolog term. */
+ public static boolean instanceOfTerm(Object obj) {
+ return obj instanceof VariableTerm ||
+ obj instanceof IntegerTerm ||
+ obj instanceof DoubleTerm ||
+ obj instanceof SymbolTerm ||
+ obj instanceof ListTerm ||
+ obj instanceof StructureTerm ||
+ obj instanceof JavaObjectTerm ||
+ obj instanceof ClosureTerm;
+ }
+}
diff --git a/src/lang/TermException.java b/src/lang/TermException.java
new file mode 100644
index 0000000..6b82eca
--- /dev/null
+++ b/src/lang/TermException.java
@@ -0,0 +1,27 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * User-defined exception.<br>
+ *
+ * This <code>TermException</code> is used to implement
+ * built-in predicate <code>throw/1</code>.
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class TermException extends PrologException {
+ /** Message as term. */
+ Term message;
+
+ /** Constructs a new <code>TermException</code>. */
+ public TermException(){}
+
+ /** Constructs a new <code>TermException</code> with a given message term. */
+ public TermException(Term _message){
+ message = _message;
+ }
+
+ public Term getMessageTerm() {
+ return message;
+ }
+}
diff --git a/src/lang/Token.java b/src/lang/Token.java
new file mode 100644
index 0000000..aa06d17
--- /dev/null
+++ b/src/lang/Token.java
@@ -0,0 +1,446 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.*;
+import java.io.*;
+/**
+ * The <code>Token</code> class contains methods
+ * for character input/output.<br>
+ * <font color="red">This document is under construction.</font>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2.5
+ */
+public class Token implements Serializable {
+
+ public static boolean isSolo(int c) {
+ return (c =='!' || c ==';');
+ }
+
+ public static boolean isSymbol(int c) {
+ switch (c) {
+ case '+':
+ case '-':
+ case '*':
+ case '/':
+ case '\\':
+ case '^':
+ case '<':
+ case '>':
+ case '=':
+ case '`':
+ case '~':
+ case ':':
+ case '.':
+ case '?':
+ case '@':
+ case '#':
+ case '$':
+ case '&':
+ return true;
+ default:
+ return false;
+ }
+ }
+
+ /*
+ public static int read_token(StringBuffer s, PushbackReader in)
+
+ This method reads one token from the input "in", sets the string,
+ and returns the token type.
+
+ Type String
+ -2 "error message"
+ -1 "end_of_file"
+ '.' "." full stop
+ ' ' " " space or comment or unknown chars
+ ',' ","
+ '(' "("
+ ')' ")"
+ '[' "["
+ ']' "]"
+ '{' "{"
+ '}' "}"
+ ',' ","
+ '|' "|"
+ 'I' "decimal" positive integer
+ 'D' "decimal" positive double
+ 'A' "atom name"
+ 'V' "variable name"
+ 'S' "string"
+ */
+ public static int read_token(StringBuffer s, PushbackReader in)
+ throws IOException {
+
+ int c, c1;
+ int rc;
+
+ c = in.read(); // get 1st. char
+ if(c == -1) {
+ s.append("end_of_file");
+ return -1;
+ }
+ if (Character.isDigit((char)c)) {
+ rc = read_number(c, s, in);
+ if (rc == 1)
+ rc = 'I';
+ else if (rc == 2)
+ rc = 'D';
+ return rc;
+ }
+ if (Character.isLowerCase((char)c)) {
+ rc = read_word(c, s, in);
+ if (rc > 0)
+ rc = 'A';
+ return rc;
+ }
+ if (Character.isUpperCase((char) c) || c == '_') {
+ rc = read_word(c, s, in);
+ if (rc > 0)
+ rc = 'V';
+ return rc;
+ }
+ switch (c) {
+ case '(':
+ case ')':
+ case '[':
+ case ']':
+ case '{':
+ case '}':
+ case ',':
+ case '|':
+ s.append((char)c);
+ return c;
+ case '.': /* full stop or symbol */
+ c1 = in.read();
+ if (c1 == -1 || c1 <= ' ') {
+ s.append(".");
+ return '.';
+ }
+ in.unread(c1);
+ break;
+ case '%': /* one line comment */
+ s.append(" ");
+ while ((c1 = in.read()) != '\n') {
+ if (c1 == -1)
+ return ' ';
+ }
+ return ' ';
+ case '/': /* start of comment or symbol */
+ if ((c1 = in.read()) == '*') {
+ s.append(" ");
+ while (true) {
+ while ((c1 = in.read()) != '*') {
+ if(c1 == -1) {
+ s.append("unexpected end_of_file");
+ return -2;
+ }
+ }
+ if ((c1 = in.read()) == '/')
+ return ' ';
+ in.unread(c1);
+ }
+ }
+ in.unread(c1);
+ break;
+ case '\'':
+ rc = read_quoted(c, s, in);
+ if (rc > 0)
+ rc = 'A';
+ return rc;
+ case '"':
+ rc = read_quoted(c, s, in);
+ if (rc > 0)
+ rc = 'S';
+ return rc;
+ default:
+ break;
+ }
+ if (isSolo(c)) {
+ s.append((char)c);
+ return 'A';
+ }
+ if (isSymbol(c)) {
+ rc = read_symbol(c, s, in);
+ if (rc > 0)
+ rc = 'A';
+ return rc;
+ }
+ s.append(" ");
+ return ' ';
+ }
+
+ public static int read_number(int c, StringBuffer s, PushbackReader in)
+ throws IOException {
+
+ int c1, c2, c3;
+ in.unread(c);
+ for (;;) {
+ c1 = in.read();
+ if (! Character.isDigit((char)c1))
+ break;
+ s.append((char) c1);
+ }
+ if (c1 != '.'){
+ in.unread(c1);
+ return 1;
+ }
+ c2 = in.read();
+ if (! Character.isDigit((char)c2)){
+ in.unread(c2);
+ in.unread(c1);
+ return 1;
+ }
+ s.append((char)c1);
+ in.unread(c2);
+ for (;;) {
+ c1 = in.read();
+ if (! Character.isDigit((char) c1))
+ break;
+ s.append((char) c1);
+ }
+ // in.unread(c1);
+ // return 2;
+ if (c1 != 'E' && c1 != 'e'){
+ in.unread(c1);
+ return 2;
+ }
+ c2 = in.read();
+ if (c2 == '-' || c2 == '+') {
+ c3 = in.read();
+ if (! Character.isDigit((char)c3)){
+ in.unread(c3);
+ in.unread(c2);
+ in.unread(c1);
+ return 2;
+ }
+ s.append((char)c1);
+ s.append((char)c2);
+ in.unread(c3);
+ } else if (Character.isDigit((char)c2)){
+ s.append((char)c1);
+ in.unread(c2);
+ } else {
+ in.unread(c2);
+ in.unread(c1);
+ return 2;
+ }
+ for (;;) {
+ c1 = in.read();
+ if (! Character.isDigit((char) c1))
+ break;
+ s.append((char) c1);
+ }
+ in.unread(c1);
+ return 2;
+ }
+
+ public static int read_word(int c, StringBuffer s, PushbackReader in)
+ throws IOException {
+ int c1;
+
+ in.unread(c);
+ for (;;) {
+ c1 = in.read();
+ if (! Character.isLetterOrDigit((char)c1) && c1 != '_')
+ break;
+ s.append((char)c1);
+ }
+ in.unread(c1);
+ return 1;
+ }
+
+ public static int read_quoted(int quote, StringBuffer s, PushbackReader in)
+ throws IOException {
+ int rc;
+ int c1;
+
+ for (;;) {
+ c1 = in.read();
+ if (c1 == -1 || c1 == '\n') {
+ in.unread(c1);
+ return -2;
+ } else if (c1 == quote){
+ c1 = in.read();
+ if (c1 != quote) {
+ in.unread(c1);
+ return 1;
+ }
+ c1 = quote;
+ }
+ else if (c1 == '\\') {
+ rc = escapeSequences(c1, s, in);
+ if (rc > 0)
+ continue;
+ else
+ return -2;
+ }
+ s.append((char)c1);
+ }
+ }
+
+ public static int escapeSequences(int backslash, StringBuffer s, PushbackReader in)
+ throws IOException {
+
+ int c;
+ c = in.read();
+ switch (c) {
+ case 'b': // backspace
+ s.append((char) 8); break;
+ case 't': // horizontal tab
+ s.append((char) 9); break;
+ case 'n': // newline
+ s.append((char)10); break;
+ case 'v': // vertical tab
+ s.append((char)11); break;
+ case 'f': // form feed
+ s.append((char)12); break;
+ case 'r': // carriage return
+ s.append((char)13); break;
+ case 'e': // escape
+ s.append((char)27); break;
+ case 'd': // delete
+ s.append((char)127); break;
+ case 'a': // alarm
+ s.append((char)7); break;
+ default:
+ s.append((char)c);
+ return 2;
+ }
+ return 1;
+ }
+
+
+ public static int read_symbol(int c, StringBuffer s, PushbackReader in)
+ throws IOException {
+ int c1;
+ s.append((char)c);
+ // in.unread(c);
+ for (;;) {
+ c1 = in.read();
+ if (! isSymbol(c1))
+ break;
+ s.append((char)c1);
+ }
+ in.unread(c1);
+ return 1;
+ }
+
+
+ /* Write */
+ public static void write_string(String s, PrintWriter out) {
+ out.print(s);
+ }
+
+ public static void writeq_string(String s, PrintWriter out) {
+ char[] ch;
+
+ ch = s.toCharArray();
+ if ((getStringType(s) == 3)){
+ out.print("\'");
+ for (int i=0; i<ch.length; i++) {
+ if (ch[i] == '\'')
+ out.print("\\\'");
+ else if (ch[i] == '\\')
+ out.print("\\\\");
+ else if (ch[i] == 8) // backspace
+ out.print("\\b");
+ else if (ch[i] == 9) // horizontal tab
+ out.print("\\t");
+ else if (ch[i] == 10) // newline
+ out.print("\\n");
+ else if (ch[i] == 11) // vertical tab
+ out.print("\\v");
+ else if (ch[i] == 12) // form feed
+ out.print("\\f");
+ else if (ch[i] == 13) // carriage return
+ out.print("\\r");
+ else if (ch[i] == 27) // escape
+ out.print("\\e");
+ else if (ch[i] == 127) // delete
+ out.print("\\d");
+ else if (ch[i] == 7) // alarm
+ out.print("\\a");
+ else
+ out.print(ch[i]);
+ }
+ out.print("\'");
+ } else {
+ write_string(s, out);
+ }
+ }
+
+ public static String toQuotedString(String s) {
+ StringBuffer quoted = new StringBuffer(s.length() * 2);
+ char[] ch;
+
+ ch = s.toCharArray();
+ if ((getStringType(s) == 3)){
+ quoted.append("\'");
+ for (int i=0; i<ch.length; i++) {
+ if (ch[i] == '\'')
+ quoted.append("\\\'");
+ else if (ch[i] == '\\')
+ quoted.append("\\\\");
+ else if (ch[i] == 8) // backspace
+ quoted.append("\\b");
+ else if (ch[i] == 9) // horizontal tab
+ quoted.append("\\t");
+ else if (ch[i] == 10) // newline
+ quoted.append("\\n");
+ else if (ch[i] == 11) // vertical tab
+ quoted.append("\\v");
+ else if (ch[i] == 12) // form feed
+ quoted.append("\\f");
+ else if (ch[i] == 13) // carriage return
+ quoted.append("\\r");
+ else if (ch[i] == 27) // escape
+ quoted.append("\\e");
+ else if (ch[i] == 127) // delete
+ quoted.append("\\d");
+ else if (ch[i] == 7) // alarm
+ quoted.append("\\a");
+ else
+ quoted.append(ch[i]);
+ }
+ quoted.append("\'");
+ return quoted.toString();
+ } else {
+ return s;
+ }
+ }
+
+
+ /*
+ * return value:
+ * 0 : if string is a lower case alphnum
+ * 1 : if string is a symbol
+ * 2 : if string is a solo
+ * 3 : others
+ */
+ public static int getStringType(String s) {
+ char[] p;
+
+ if (s.equals("[]") || s.equals("{}"))
+ return 0;
+ if (s.equals("") || s.equals("."))
+ return 3;
+ if (s.equals("!") || s.equals(";"))
+ return 2;
+ p = s.toCharArray(); // string --> chars[]
+ if (Character.isLowerCase(p[0])){
+ for (int i=1; i<p.length; i++){
+ if (! Character.isLetterOrDigit(p[i]) && ((int)p[i]) != '_')
+ return 3;
+ }
+ return 0;
+ }
+ if (isSymbol((int) p[0])){
+ for (int i=1; i<p.length; i++){
+ if (! isSymbol((int) p[i]))
+ return 3;
+ }
+ return 1;
+ }
+ return 3;
+ }
+}
diff --git a/src/lang/Token.java.bak b/src/lang/Token.java.bak
new file mode 100644
index 0000000..620a755
--- /dev/null
+++ b/src/lang/Token.java.bak
@@ -0,0 +1,414 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.util.*;
+import java.io.*;
+/**
+ * The <code>Token</code> class contains methods
+ * for character input/output.<br>
+ * <font color="red">This document is under construction.</font>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.2
+ */
+public class Token implements Serializable {
+
+ public static boolean isSolo(int c) {
+ return (c =='!' || c ==';');
+ }
+
+ public static boolean isSymbol(int c) {
+ switch (c) {
+ case '+':
+ case '-':
+ case '*':
+ case '/':
+ case '\\':
+ case '^':
+ case '<':
+ case '>':
+ case '=':
+ case '`':
+ case '~':
+ case ':':
+ case '.':
+ case '?':
+ case '@':
+ case '#':
+ case '$':
+ case '&':
+ return true;
+ default:
+ return false;
+ }
+ }
+
+ /*
+ public static int read_token(StringBuffer s, PushbackReader in)
+
+ This method reads one token from the input "in", sets the string,
+ and returns the token type.
+
+ Type String
+ -2 "error message"
+ -1 "end_of_file"
+ '.' "." full stop
+ ' ' " " space or comment or unknown chars
+ ',' ","
+ '(' "("
+ ')' ")"
+ '[' "["
+ ']' "]"
+ '{' "{"
+ '}' "}"
+ ',' ","
+ '|' "|"
+ 'I' "decimal" positive integer
+ 'D' "decimal" positive double
+ 'A' "atom name"
+ 'V' "variable name"
+ 'S' "string"
+ */
+ public static int read_token(StringBuffer s, PushbackReader in)
+ throws IOException {
+
+ int c, c1;
+ int rc;
+
+ c = in.read(); // get 1st. char
+ if(c == -1) {
+ s.append("end_of_file");
+ return -1;
+ }
+ if (Character.isDigit((char)c)) {
+ rc = read_number(c, s, in);
+ if (rc == 1)
+ rc = 'I';
+ else if (rc == 2)
+ rc = 'D';
+ return rc;
+ }
+ if (Character.isLowerCase((char)c)) {
+ rc = read_word(c, s, in);
+ if (rc > 0)
+ rc = 'A';
+ return rc;
+ }
+ if (Character.isUpperCase((char) c) || c == '_') {
+ rc = read_word(c, s, in);
+ if (rc > 0)
+ rc = 'V';
+ return rc;
+ }
+ switch (c) {
+ case '(':
+ case ')':
+ case '[':
+ case ']':
+ case '{':
+ case '}':
+ case ',':
+ case '|':
+ s.append((char)c);
+ return c;
+ case '.': /* full stop or symbol */
+ c1 = in.read();
+ if (c1 == -1 || c1 <= ' ') {
+ s.append(".");
+ return '.';
+ }
+ in.unread(c1);
+ break;
+ case '%': /* one line comment */
+ s.append(" ");
+ while ((c1 = in.read()) != '\n') {
+ if (c1 == -1)
+ return ' ';
+ }
+ return ' ';
+ case '/': /* start of comment or symbol */
+ if ((c1 = in.read()) == '*') {
+ s.append(" ");
+ while (true) {
+ while ((c1 = in.read()) != '*') {
+ if(c1 == -1) {
+ s.append("unexpected end_of_file");
+ return -2;
+ }
+ }
+ if ((c1 = in.read()) == '/')
+ return ' ';
+ in.unread(c1);
+ }
+ }
+ in.unread(c1);
+ break;
+ case '\'':
+ rc = read_quoted(c, s, in);
+ if (rc > 0)
+ rc = 'A';
+ return rc;
+ case '"':
+ rc = read_quoted(c, s, in);
+ if (rc > 0)
+ rc = 'S';
+ return rc;
+ default:
+ break;
+ }
+ if (isSolo(c)) {
+ s.append((char)c);
+ return 'A';
+ }
+ if (isSymbol(c)) {
+ rc = read_symbol(c, s, in);
+ if (rc > 0)
+ rc = 'A';
+ return rc;
+ }
+ s.append(" ");
+ return ' ';
+ }
+
+ public static int read_number(int c, StringBuffer s, PushbackReader in)
+ throws IOException {
+
+ int c1, c2;
+ in.unread(c);
+ for (;;) {
+ c1 = in.read();
+ if (! Character.isDigit((char)c1))
+ break;
+ s.append((char) c1);
+ }
+ if (c1 != '.'){
+ in.unread(c1);
+ return 1;
+ }
+ c2 = in.read();
+ if (! Character.isDigit((char)c2)){
+ in.unread(c2);
+ in.unread(c1);
+ return 1;
+ }
+ s.append((char)c1);
+ in.unread(c2);
+ for (;;) {
+ c1 = in.read();
+ if (! Character.isDigit((char) c1))
+ break;
+ s.append((char) c1);
+ }
+ in.unread(c1);
+ return 2;
+ }
+
+ public static int read_word(int c, StringBuffer s, PushbackReader in)
+ throws IOException {
+ int c1;
+
+ in.unread(c);
+ for (;;) {
+ c1 = in.read();
+ if (! Character.isLetterOrDigit((char)c1) && c1 != '_')
+ break;
+ s.append((char)c1);
+ }
+ in.unread(c1);
+ return 1;
+ }
+
+ public static int read_quoted(int quote, StringBuffer s, PushbackReader in)
+ throws IOException {
+ int rc;
+ int c1;
+
+ for (;;) {
+ c1 = in.read();
+ if (c1 == -1 || c1 == '\n') {
+ in.unread(c1);
+ return -2;
+ } else if (c1 == quote){
+ c1 = in.read();
+ if (c1 != quote) {
+ in.unread(c1);
+ return 1;
+ }
+ c1 = quote;
+ }
+ else if (c1 == '\\') {
+ rc = escapeSequences(c1, s, in);
+ if (rc > 0)
+ continue;
+ else
+ return -2;
+ }
+ s.append((char)c1);
+ }
+ }
+
+ public static int escapeSequences(int backslash, StringBuffer s, PushbackReader in)
+ throws IOException {
+
+ int c;
+ c = in.read();
+ switch (c) {
+ case 'b': // backspace
+ s.append((char) 8); break;
+ case 't': // horizontal tab
+ s.append((char) 9); break;
+ case 'n': // newline
+ s.append((char)10); break;
+ case 'v': // vertical tab
+ s.append((char)11); break;
+ case 'f': // form feed
+ s.append((char)12); break;
+ case 'r': // carriage return
+ s.append((char)13); break;
+ case 'e': // escape
+ s.append((char)27); break;
+ case 'd': // delete
+ s.append((char)127); break;
+ case 'a': // alarm
+ s.append((char)7); break;
+ default:
+ s.append((char)c);
+ return 2;
+ }
+ return 1;
+ }
+
+
+ public static int read_symbol(int c, StringBuffer s, PushbackReader in)
+ throws IOException {
+ int c1;
+ s.append((char)c);
+ // in.unread(c);
+ for (;;) {
+ c1 = in.read();
+ if (! isSymbol(c1))
+ break;
+ s.append((char)c1);
+ }
+ in.unread(c1);
+ return 1;
+ }
+
+
+ /* Write */
+ public static void write_string(String s, PrintWriter out) {
+ out.print(s);
+ }
+
+ public static void writeq_string(String s, PrintWriter out) {
+ char[] ch;
+
+ ch = s.toCharArray();
+ if ((getStringType(s) == 3)){
+ out.print("\'");
+ for (int i=0; i<ch.length; i++) {
+ if (ch[i] == '\'')
+ out.print("\\\'");
+ else if (ch[i] == '\\')
+ out.print("\\\\");
+ else if (ch[i] == 8) // backspace
+ out.print("\\b");
+ else if (ch[i] == 9) // horizontal tab
+ out.print("\\t");
+ else if (ch[i] == 10) // newline
+ out.print("\\n");
+ else if (ch[i] == 11) // vertical tab
+ out.print("\\v");
+ else if (ch[i] == 12) // form feed
+ out.print("\\f");
+ else if (ch[i] == 13) // carriage return
+ out.print("\\r");
+ else if (ch[i] == 27) // escape
+ out.print("\\e");
+ else if (ch[i] == 127) // delete
+ out.print("\\d");
+ else if (ch[i] == 7) // alarm
+ out.print("\\a");
+ else
+ out.print(ch[i]);
+ }
+ out.print("\'");
+ } else {
+ write_string(s, out);
+ }
+ }
+
+ public static String toQuotedString(String s) {
+ StringBuffer quoted = new StringBuffer(s.length() * 2);
+ char[] ch;
+
+ ch = s.toCharArray();
+ if ((getStringType(s) == 3)){
+ quoted.append("\'");
+ for (int i=0; i<ch.length; i++) {
+ if (ch[i] == '\'')
+ quoted.append("\\\'");
+ else if (ch[i] == '\\')
+ quoted.append("\\\\");
+ else if (ch[i] == 8) // backspace
+ quoted.append("\\b");
+ else if (ch[i] == 9) // horizontal tab
+ quoted.append("\\t");
+ else if (ch[i] == 10) // newline
+ quoted.append("\\n");
+ else if (ch[i] == 11) // vertical tab
+ quoted.append("\\v");
+ else if (ch[i] == 12) // form feed
+ quoted.append("\\f");
+ else if (ch[i] == 13) // carriage return
+ quoted.append("\\r");
+ else if (ch[i] == 27) // escape
+ quoted.append("\\e");
+ else if (ch[i] == 127) // delete
+ quoted.append("\\d");
+ else if (ch[i] == 7) // alarm
+ quoted.append("\\a");
+ else
+ quoted.append(ch[i]);
+ }
+ quoted.append("\'");
+ return quoted.toString();
+ } else {
+ return s;
+ }
+ }
+
+
+ /*
+ * return value:
+ * 0 : if string is a lower case alphnum
+ * 1 : if string is a symbol
+ * 2 : if string is a solo
+ * 3 : others
+ */
+ public static int getStringType(String s) {
+ char[] p;
+
+ if (s.equals("[]") || s.equals("{}"))
+ return 0;
+ if (s.equals("") || s.equals("."))
+ return 3;
+ if (s.equals("!") || s.equals(";"))
+ return 2;
+ p = s.toCharArray(); // string --> chars[]
+ if (Character.isLowerCase(p[0])){
+ for (int i=1; i<p.length; i++){
+ if (! Character.isLetterOrDigit(p[i]) && ((int)p[i]) != '_')
+ return 3;
+ }
+ return 0;
+ }
+ if (isSymbol((int) p[0])){
+ for (int i=1; i<p.length; i++){
+ if (! isSymbol((int) p[i]))
+ return 3;
+ }
+ return 1;
+ }
+ return 3;
+ }
+}
diff --git a/src/lang/Trail.java b/src/lang/Trail.java
new file mode 100644
index 0000000..fd111dc
--- /dev/null
+++ b/src/lang/Trail.java
@@ -0,0 +1,111 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+import java.io.Serializable;
+/**
+ * Trail stack.<br>
+ * The class <code>Trail</code> represents a trail stack.<br>
+ * Entries pushed to this trail stack must implement
+ * the <code>Undoable</code> interface.
+ * @see Undoable
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class Trail implements Serializable {
+ /** Maximum size of enties. Initial size is <code>20000</code>. */
+ protected int maxContents = 20000;
+
+ /** An array of <code>Undoable</code> entries. */
+ protected Undoable[] buffer;
+
+ /** the top index of this <code>Trail</code>. */
+ protected int top;
+
+ /** Holds the Prolog engine that this <code>Trail</code> belongs to. */
+ protected Prolog engine;
+
+ /** Constructs a new trail stack. */
+ public Trail(Prolog _engine) {
+ engine = _engine;
+ buffer = new Undoable[maxContents];
+ top = -1;
+ }
+
+ /** Constructs a new trail stack with the given size. */
+ public Trail(Prolog _engine, int n) {
+ engine = _engine;
+ maxContents = n;
+ buffer = new Undoable[maxContents];
+ top = -1;
+ }
+
+ /** Discards all entries. */
+ public void init() { deleteAll(); }
+
+ /** Pushs an entry to this <code>Trail</code>. */
+ public void push(Undoable t) {
+ try {
+ buffer[++top] = t;
+ } catch (ArrayIndexOutOfBoundsException e) {
+ System.out.println("{expanding trail...}");
+ int len = buffer.length;
+ Undoable[] new_buffer = new Undoable[len+20000];
+ for(int i=0; i<len; i++){
+ new_buffer[i] = buffer[i];
+ }
+ buffer = new_buffer;
+ buffer[top] = t;
+ maxContents = len+20000;
+ }
+ }
+
+ /** Pops an entry from this <code>Trail</code>. */
+ public Undoable pop() {
+ Undoable t = buffer[top];
+ buffer[top--] = null;
+ return t;
+ }
+
+ /** Discards all entries. */
+ protected void deleteAll() {
+ while (! empty()) {
+ buffer[top--] = null;
+ }
+ }
+
+ /** Tests if this stack has no entry. */
+ public boolean empty() {
+ return top == -1;
+ }
+
+ /** Returns the value of <code>maxContents</code>.
+ * @see #maxContents
+ */
+ public int max() { return maxContents; }
+
+ /** Returns the value of <code>top</code>.
+ * @see #top
+ */
+ public int top() { return top; }
+
+ /** Unwinds all entries after the value of <code>i</code>. */
+ public void unwind(int i) {
+ Undoable t;
+ while (top > i) {
+ t = pop();
+ t.undo();
+ }
+ }
+
+ /** Shows the contents of this <code>Trail</code>. */
+ public void show() {
+ if (empty()) {
+ System.out.println("{trail stack is empty!}");
+ return;
+ }
+ for (int i=0; i<=top; i++) {
+ System.out.print("trail[" + i + "]: ");
+ System.out.println(buffer[i]);
+ }
+ }
+}
+
diff --git a/src/lang/Undoable.java b/src/lang/Undoable.java
new file mode 100644
index 0000000..a28b77f
--- /dev/null
+++ b/src/lang/Undoable.java
@@ -0,0 +1,20 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Implementing this interface allows an object to be pushed to trail stack.<br>
+ * @see Trail
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public interface Undoable {
+ /**
+ * Undoes this object.<br>
+ * @see Trail#unwind(int)
+ */
+ public void undo();
+}
+
+
+
+
+
diff --git a/src/lang/VariableTerm.java b/src/lang/VariableTerm.java
new file mode 100644
index 0000000..490858e
--- /dev/null
+++ b/src/lang/VariableTerm.java
@@ -0,0 +1,217 @@
+package jp.ac.kobe_u.cs.prolog.lang;
+/**
+ * Variable.<br>
+ * The <code>VariableTerm</code> class represents a logical variable.<br>
+ * For example,
+ * <pre>
+ * Term t = new VariableTerm();
+ * </pre>
+ *
+ * @author Mutsunori Banbara (banbara@kobe-u.ac.jp)
+ * @author Naoyuki Tamura (tamura@kobe-u.ac.jp)
+ * @version 1.0
+ */
+public class VariableTerm extends Term implements Undoable {
+ /** Holds a term to which this variable is bound. Initial value is <code>this</code> (self-reference). */
+ protected Term val;
+ /** A CPF time stamp when this object is newly constructed. */
+ protected long timeStamp;
+
+ /** Constructs a new logical variable so that
+ * the <code>timeStamp</code> field is set to <code>Long.MIN_VALUE</code>.
+ */
+ public VariableTerm() {
+ val = this;
+ timeStamp = Long.MIN_VALUE;
+ }
+
+ /** Constructs a new logical variable so that
+ * the <code>timeStamp</code> field is set to the current value of
+ * <code>CPFTimeStamp</code> of the specified Prolog engine.
+ * @param engine Current Prolog engine.
+ * @see Prolog#getCPFTimeStamp
+ */
+ public VariableTerm(Prolog engine) {
+ val = this;
+ timeStamp = engine.getCPFTimeStamp();
+ }
+
+ /**
+ * Returns the value of <code>timeStamp</code>.
+ * @see #timeStamp
+ */
+ public long timeStamp() { return timeStamp; }
+
+ /** Returns a string representation of this object.*/
+ protected String name() { return "_" + Integer.toHexString(hashCode()).toUpperCase(); }
+
+ /* Term */
+ /**
+ * Checks whether the argument term is unified with this one.
+ * If this is an unbound variable, the <code>unify</code> method binds this to
+ * the dereferenced value of argument term: <code>bind(t.dereference(), trail)</code>,
+ * and returns <code>true</code>.
+ * Otherwise, it returns a <code>boolean</code> whose value is <code>val.unify(t, trail)</code>.
+ * @param t the term to be unified with.
+ * @param trail Trail Stack.
+ * @return <code>true</code> if succeeds, otherwise <code>false</code>.
+ * @see #val
+ * @see #bind(Term,Trail)
+ * @see Trail
+ */
+ public boolean unify(Term t, Trail trail) {
+ if (val != this)
+ return val.unify(t, trail);
+ t = t.dereference();
+ if (this != t)
+ bind(t, trail);
+ return true;
+ }
+
+ /**
+ * Binds this variable to a given term.
+ * And pushs this variable to trail stack if necessary.
+ * @param t a term to be bound.
+ * @param trail Trail Stack
+ * @see Trail
+ */
+ public void bind(Term t, Trail trail) {
+ if (t.isVariable() && ((VariableTerm)t).timeStamp() >= this.timeStamp) {
+ ((VariableTerm)t).val = this;
+ if (((VariableTerm)t).timeStamp() < trail.engine.stack.getTimeStamp())
+ trail.push((VariableTerm)t);
+ } else {
+ this.val = t;
+ if (this.timeStamp() < trail.engine.stack.getTimeStamp())
+ trail.push(this);
+ }
+ }
+
+ /**
+ * Checks whether this object is convertible with the given Java class type
+ * if this variable is unbound.
+ * Otherwise, returns the value of <code>val.convertible(type)</code>.
+ * @param type the Java class type to compare with.
+ * @return <code>true</code> if this (or dereferenced term) is
+ * convertible with <code>type</code>. Otherwise <code>false</code>.
+ * @see #val
+ */
+ public boolean convertible(Class type) {
+ if (val != this)
+ return val.convertible(type);
+ return convertible(this.getClass(), type);
+ }
+
+ /**
+ * Returns a copy of this object if unbound variable.
+ * Otherwise, returns the value of <code>val.copy(engine)</code>.
+ * @see #val
+ */
+ protected Term copy(Prolog engine) {
+ VariableTerm co;
+ if (val != this)
+ return val.copy(engine);
+ co = engine.copyHash.get(this);
+ if (co == null) {
+ // co = new VariableTerm(engine);
+ co = new VariableTerm();
+ engine.copyHash.put(this, co);
+ }
+ return co;
+ }
+
+ public Term dereference() {
+ if (val == this)
+ return this;
+ return val.dereference();
+ }
+
+ public boolean isGround() {
+ if (val != this)
+ return val.isGround();
+ return false;
+ }
+
+ /**
+ * Returns <code>this</code> if this variable is unbound.
+ * Otherwise, returns a Java object that corresponds to the dereferenced term:
+ * <code>val.toJava()</code>.
+ * @return a Java object defined in <em>Prolog Cafe interoperability with Java</em>.
+ * @see #val
+ */
+ public Object toJava() {
+ if (val != this)
+ return val.toJava();
+ return this;
+ }
+
+ /**
+ * Returns a quoted string representation of this term if unbound.
+ * Otherwise, returns the value of dereferenced term:
+ * <code>val.toQuotedString()</code>
+ * @see #val
+ */
+ public String toQuotedString() {
+ if (val != this)
+ return val.toQuotedString();
+ return name();
+ }
+
+ /* Object */
+ /**
+ * Checks <em>term equality</em> of two terms.
+ * This method returns a <code>boolean</code> whose value is
+ * (<code>this == obj</code>) if this variable is unbound.
+ * Otherwise, it returns the value of <code>val.equals(obj)</code>.
+ * @param obj the object to compare with. This must be dereferenced.
+ * @return <code>true</code> if this (or dereferenced term) is the same as the argument;
+ * <code>false</code> otherwise.
+ * @see #val
+ * @see #compareTo
+ */
+ public boolean equals(Object obj) {
+ if(val != this)
+ return val.equals(obj);
+ if (! (obj instanceof VariableTerm)) // ???
+ return false; //???
+ return this == obj;
+ }
+
+ /**
+ * Returns a string representation of this term if unbound.
+ * Otherwise, returns the value of dereferenced term:
+ * <code>val.toString()</code>
+ * @see #val
+ */
+ public String toString() {
+ if (val != this)
+ return val.toString();
+ return name();
+ }
+
+ /* Undoable */
+ public void undo() { val = this; }
+
+ /* Comparable */
+ /**
+ * Compares two terms in <em>Prolog standard order of terms</em>.<br>
+ * It is noted that <code>t1.compareTo(t2) == 0</code> has the same
+ * <code>boolean</code> value as <code>t1.equals(t2)</code>.
+ * @param anotherTerm the term to compare with. It must be dereferenced.
+ * @return the value <code>0</code> if two terms are identical;
+ * a value less than <code>0</code> if this term is <em>before</em> the <code>anotherTerm</code>;
+ * and a value greater than <code>0</code> if this term is <em>after</em> the <code>anotherTerm</code>.
+ */
+ public int compareTo(Term anotherTerm) { // anotherTerm must be dereferenced.
+ if(val != this)
+ return val.compareTo(anotherTerm);
+ if (! anotherTerm.isVariable())
+ return BEFORE;
+ if (this == anotherTerm)
+ return EQUAL;
+ int x = this.hashCode() - ((VariableTerm)anotherTerm).hashCode();
+ if (x != 0)
+ return x;
+ throw new InternalException("VariableTerm is not unique");
+ }
+}
diff --git a/src/lang/package.html b/src/lang/package.html
new file mode 100644
index 0000000..8f9fee2
--- /dev/null
+++ b/src/lang/package.html
@@ -0,0 +1,12 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=EUC-JP">
+<title></title>
+</head>
+<body bgcolor="#ffffff">
+Provides classes that are fundamental to the design of the Prolog Cafe
+system.<br>
+All of the source code is located <code>$PLCAFEDIR/src/lang</code>.
+</body>
+</html>
