diff options
author | Prolog Cafe Authors <nobody@kaminari.scitec.kobe-u.ac.jp> | 2009-06-24 00:00:00 -0700 |
---|---|---|
committer | Shawn O. Pearce <sop@google.com> | 2011-05-31 12:34:05 -0700 |
commit | 73b5ce4f5fbef086a22de3292a53e1ffe2947fab (patch) | |
tree | caf9cb7f6d9ec4801399290e114c03400acd5307 | |
download | prolog-cafe-vendor.tar.gz |
Prolog Cafe 1.2.5vendor
Homepage: http://kaminari.scitec.kobe-u.ac.jp/PrologCafe/
Download: http://kaminari.scitec.kobe-u.ac.jp/PrologCafe/archives/PrologCafe1.2.5.tgz
306 files changed, 34256 insertions, 0 deletions
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 @@ -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> |