gprolog-1.4.5/ 0000755 0001750 0001750 00000000000 13021361131 011311 5 ustar spa spa gprolog-1.4.5/COPYING 0000644 0001750 0001750 00000064707 13021324543 012370 0 ustar spa spa GNU PROLOG LICENSE CONDITIONS
GNU Prolog is free software. Since version 1.4.0, GNU Prolog distributed
under a dual license: LGPL or GPL. So, you can redistribute it and/or modify
it under the terms of either:
* the GNU Lesser General Public License (LGPL) as published by the Free
Software Foundation; either version 3 of the License, or (at your option)
any later version.
or
* the GNU General Public License (GPL) as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any
later version.
or both in parallel (as here).
GNU Prolog is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received copies of the GNU General Public License and the GNU
Lesser General Public License along with this program. If not, see
http://www.gnu.org/licenses/.
Remark: versions of GNU Prolog prior to 1.4.0 were entirely released under
the GNU General Public License (GPL).
The rest of this file contains LGPL v3 and GPL v2
---------------------------------------------------------------------------
GNU LESSER GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
This version of the GNU Lesser General Public License incorporates
the terms and conditions of version 3 of the GNU General Public
License, supplemented by the additional permissions listed below.
0. Additional Definitions.
As used herein, "this License" refers to version 3 of the GNU Lesser
General Public License, and the "GNU GPL" refers to version 3 of the GNU
General Public License.
"The Library" refers to a covered work governed by this License,
other than an Application or a Combined Work as defined below.
An "Application" is any work that makes use of an interface provided
by the Library, but which is not otherwise based on the Library.
Defining a subclass of a class defined by the Library is deemed a mode
of using an interface provided by the Library.
A "Combined Work" is a work produced by combining or linking an
Application with the Library. The particular version of the Library
with which the Combined Work was made is also called the "Linked
Version".
The "Minimal Corresponding Source" for a Combined Work means the
Corresponding Source for the Combined Work, excluding any source code
for portions of the Combined Work that, considered in isolation, are
based on the Application, and not on the Linked Version.
The "Corresponding Application Code" for a Combined Work means the
object code and/or source code for the Application, including any data
and utility programs needed for reproducing the Combined Work from the
Application, but excluding the System Libraries of the Combined Work.
1. Exception to Section 3 of the GNU GPL.
You may convey a covered work under sections 3 and 4 of this License
without being bound by section 3 of the GNU GPL.
2. Conveying Modified Versions.
If you modify a copy of the Library, and, in your modifications, a
facility refers to a function or data to be supplied by an Application
that uses the facility (other than as an argument passed when the
facility is invoked), then you may convey a copy of the modified
version:
a) under this License, provided that you make a good faith effort to
ensure that, in the event an Application does not supply the
function or data, the facility still operates, and performs
whatever part of its purpose remains meaningful, or
b) under the GNU GPL, with none of the additional permissions of
this License applicable to that copy.
3. Object Code Incorporating Material from Library Header Files.
The object code form of an Application may incorporate material from
a header file that is part of the Library. You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:
a) Give prominent notice with each copy of the object code that the
Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the object code with a copy of the GNU GPL and this license
document.
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
b) Accompany the Combined Work with a copy of the GNU GPL and this license
document.
c) For a Combined Work that displays copyright notices during
execution, include the copyright notice for the Library among
these notices, as well as a reference directing the user to the
copies of the GNU GPL and this license document.
d) Do one of the following:
0) Convey the Minimal Corresponding Source under the terms of this
License, and the Corresponding Application Code in a form
suitable for, and under terms that permit, the user to
recombine or relink the Application with a modified version of
the Linked Version to produce a modified Combined Work, in the
manner specified by section 6 of the GNU GPL for conveying
Corresponding Source.
1) Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (a) uses at run time
a copy of the Library already present on the user's computer
system, and (b) will operate properly with a modified version
of the Library that is interface-compatible with the Linked
Version.
e) Provide Installation Information, but only if you would otherwise
be required to provide such information under section 6 of the
GNU GPL, and only to the extent that such information is
necessary to install and execute a modified version of the
Combined Work produced by recombining or relinking the
Application with a modified version of the Linked Version. (If
you use option 4d0, the Installation Information must accompany
the Minimal Corresponding Source and Corresponding Application
Code. If you use option 4d1, you must provide the Installation
Information in the manner specified by section 6 of the GNU GPL
for conveying Corresponding Source.)
5. Combined Libraries.
You may place library facilities that are a work based on the
Library side by side in a single library together with other library
facilities that are not Applications and are not covered by this
License, and convey such a combined library under terms of your
choice, if you do both of the following:
a) Accompany the combined library with a copy of the same work based
on the Library, uncombined with any other library facilities,
conveyed under the terms of this License.
b) Give prominent notice with the combined library that part of it
is a work based on the Library, and explaining where to find the
accompanying uncombined form of the same work.
6. Revised Versions of the GNU Lesser General Public License.
The Free Software Foundation may publish revised and/or new versions
of the GNU Lesser General Public License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the
Library as you received it specifies that a certain numbered version
of the GNU Lesser General Public License "or any later version"
applies to it, you have the option of following the terms and
conditions either of that published version or of any later version
published by the Free Software Foundation. If the Library as you
received it does not specify a version number of the GNU Lesser
General Public License, you may choose any version of the GNU Lesser
General Public License ever published by the Free Software Foundation.
If the Library as you received it specifies that a proxy can decide
whether future versions of the GNU Lesser General Public License shall
apply, that proxy's public statement of acceptance of any version is
permanent authorization for you to choose that version for the
Library.
---------------------------------------------------------------------------
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Lesser General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License.
gprolog-1.4.5/ChangeLog 0000644 0001750 0001750 00000102332 13021324543 013072 0 ustar spa spa Fri Apr 3 10:01:02 CEST 2015
* fix a bug in findall/4
Tue Feb 17 11:39:11 CET 2015
* fix a bug in select/5 under Windows
Fri Jan 16 19:25:51 CET 2015
* fix a bug in the compiler
Thu Dec 18 08:59:45 CET 2014
* fix a bug in read/1
* fix large address awarenes under cygwin32 (configure.in)
Thu Dec 11 17:18:09 CET 2014
* improve memory limitation of acyclic_term/1
Tue Dec 9 10:40:18 CET 2014
* improve term output (write/1 and friends)
Fri Dec 5 02:55:30 CET 2014
* improve error handling for options (e.g. in write_term/3)
Thu Dec 4 15:47:06 CET 2014
* fix bug with cut in the if-part of if-then(-else)
* fix port to x86_64/OpenBSD
(machine kindly provided by Duncan Patton a Campbell)
Wed Dec 3 17:56:54 CET 2014
* fix a bug with Apple/Yosemite gcc = LLVM version 6.0 (clang-600.0.56) on x86_64
Fri Aug 22 15:10:18 CEST 2014
* allow to define more atoms with MAX_ATOM env var on 64 bits machines
Wed Aug 13 11:25:18 CEST 2014
* fix a bug in bagof/3 when used as findall/3
Fri Jul 11 17:27:36 CEST 2014
* port to sparc64/OpenBSD
(machine kindly provided by Duncan Patton a Campbell)
Tue May 6 10:43:33 CEST 2014
* add built-in predicate findall/4
Thu Mar 6 16:19:36 CET 2014
* fix a bug with linedit when environment variable LINEDIT=no
Wed Feb 5 15:16:37 CET 2014
* fix bugs in the FD solver
Fri Nov 22 19:47:45 CET 2013
* set socket option SO_REUSEADDR at socket creation
Thu Nov 21 16:29:57 CET 2013
* support for alternate Prolog file extension .prolog
Mon Nov 18 18:32:44 CET 2013
* fix a bug in atoms for 1-char atom '\0' (now acts as the empty atom)
Tue Nov 12 10:17:10 CET 2013
* fix problems with Apple/Mavericks gcc = LLVM version 5.0 (clang-500.2.79) on x86_64
* remove clang warnings (uninitialized variables)
* fix bugs in the lexer of the form 0bop 2 when bop is an infix op
Tue Oct 1 09:40:31 CEST 2013
* fix terminal ANSI sequence handling in linedit
Wed Sep 18 09:25:06 CEST 2013
* increase internal compiler data sizes
Thu Jul 4 13:17:07 CEST 2013
* fix bug in gprolog.h (invalid 64 bits PL_MAX_INTEGER)
Fri Apr 12 17:17:50 CEST 2013
* add Prolog flags c_cc_version_data
* fix a regression bug in linedit
* fix a little bug in the debugger
* add subtract/3 built-in predicate
Wed Mar 27 16:35:02 CET 2013
* add new C foreign interface functions converting term to/from C strings
Tue Mar 26 10:23:05 CET 2013
* modify top-level banner to show 32/64 bits, compile date, C compiler name
* modify Linedit: fix Prolog prompt when Linedit is not activated
* modify linedit: accept gui=silent in env var LINEDIT
(does not warn if the windows gui DLL is not found)
* fixes for Windows 8 (i686 and x86_64) with MSVS 2012, mingw64 gcc > 4.5.3
* add Prolog flags address_bits, compiled_at, c_cc, c_cflags, c_ldflags
Thu Mar 14 12:46:35 CET 2013
* fix a bug in the FD solver (option backtracks in fd_labeling)
* improve the FD solver (better propagation for reified constraints at labeling)
* improve the FD solver (add labeling option: value_method(bisect))
Mon Mar 11 15:42:31 CET 2013
* improve the FD solver (avoid some cases of C stack overflow, improved fd_domain/3)
* fix another bug in the FD solver (regression bug in 1.4.2)
* add PlULong to gprolog.h and PlThrow(ball) to C foreign interface
Mon Feb 25 13:57:51 CET 2013
* fix a bug in the FD solver (regression bug in 1.4.2)
Wed Nov 28 17:04:46 CET 2012
* fix a bug in the compiler for byte-code with op/3 directive
Thu Nov 22 16:20:23 CET 2012
* fix a bug in the debugger
* modify decompose_file_name/4 (fix problems under windows)
* add built-in is_absolute_file_name/1 and is_relative_file_name/1
* modify the compiler include/1 directive handling
(if the file to include is not found, search in directories of parent includers)
Thu Nov 15 16:15:50 CET 2012
* modify atom table management (its size can be defined via env. var MAX_ATOM)
* fix a bug with soft-call inside a meta-call
* implement term_hash/2 and term_hash/4. Backward incompatibility:
new_atom/3 and and atom_hash/2 no longer exists.
* fix some little bugs with 64 bits (e.g. stream id)
Tue Oct 30 16:27:21 CET 2012
* modify the FD solver to handle very long computations
Mon Sep 24 15:03:11 CEST 2012
* fix a bug in the compiler (unification with fresh vars in the body)
* fix a bug with *-> containing ! in the test part (! was not local to the test)
* fix a bug to configure with sigaction on old Linux kernels
* fix some problems/bugs on 64 bits machine
Fri Jun 15 13:34:45 CEST 2012
* improve signal handling
Thu May 31 15:36:46 CEST 2012
* add an option --wam-comment to gplc and pl2wam
* fix multifile directive (works now with an empty predicate as required by ISO)
* fix absolute_file_name to expand ~ using HOMEDRIVE and HOMEPATH under windows
if HOME is not defined
Tue May 15 11:56:00 CEST 2012
* improve listing/0-1 output
Fri May 11 18:09:19 CEST 2012
* add soft cut control construct and its associated operator *->
Thu May 3 16:42:00 CEST 2012
* improve the top-level results in case of cyclic terms
Mon Apr 30 17:52:46 CEST 2012
* fix arithmetic evaluable functor ^/2 to work with floats
* increase maximum number of variables in a term
Thu Apr 26 11:29:44 CEST 2012
* add write_term option variable_names
* add built-in predicates between/3 and succ/2
* fix bug in the DCG expander
* fix bug in member/2
* recognize escape sequence \s (space) and \e (escape) if strict_iso is off
* add error detection in length/2 if given length is negative
Tue Mar 13 10:24:24 CET 2012
* add built-in predicates maplist/2-9
Mon Feb 20 19:12:04 CET 2012
* fix a regression bug in the FD solver about sparse domains
Thu Feb 16 19:49:02 CET 2012
* increase size of FD internal stacks and fix memory leak
Tue Jan 10 18:23:09 CET 2012
* port to x86_64/Darwin (Mac OS X) - many thanks to
Ozaki Kiichi
* fix a bug in x86_64 with --disable-regs
* fix a bug when consulting a file under Win XP/Vista 32 bits
* fix a bug when consulting a file using '$VAR'(N) or '$VARNAME'(A)
* fix a bug in new_atom/1-2 which returned duplicates
* fix a bug in write/1 when an empty atom is passed
* improve portray_clause (numbervars and space before final dot)
Fri Jun 10 15:59:42 CEST 2011
* GNU Prolog is now licensed under a dual license LGPL or GPL
* port to x86_64/MinGW64 - many thanks to
Jasper Taylor (see src/WINDOWS64)
* port to x86_64/MSVC (see src/WINDOWS64)
* add a configure option to control Windows HtmlHelp
--disable-htmlhelp or --enable-htmlhelp[=static/dynamic]
* improve a lot (and fix some bugs in) the Windows GUI Console
* change location of gprologvars.bat under Windows (in install directory)
* increase default stack sizes (32Mb for heap, 16Mb for others)
* change the default setting for flag strict_iso: it is on now
* add control constructs to the predicate table
* modify predicate_property/2 (built_in_fd ==> built_in, add control_construct)
only accepts a Head (a callable) (no longer a predicate indicator)
* fix a bug in the compiler (bad unification with singleton variable)
* fix a bug with strict_iso flag (was not passed to consult)
* add shebang support using #!/usr/bin/gprolog --consult-file
* modify the mangling scheme for future module support (see hexgplc)
* fix write_term default options (now numbervars(false) and namevars(false))
* fix read/1: tab and newlines are not accepted inside single/back/double quoted tokens
* add additional errors to compare/3 and keysort/2
* accept space under the top-level (same as ;)
* modify portray_clause/1-2 to add a newline at the end of the output
* add acyclic_term/1 (compatibility only since GNU Prolog does not handle cyclic terms)
* fix write/1 to treat '$VARNAME'(Atom) as a var name only if Atom is a valid var name
Mon Nov 29 15:48:25 CET 2010
* rename evaluable functor atan/2 as atan2/2 and >< as xor
* add evaluable functor div/2
* detect op/3 error cases for | [] {}
* replace type_error(variable, X) by uninstantiation_error(X) (e.g. open/3-4)
Fri Nov 26 12:00:32 CEST 2010
* add built-in term_variables/2-3 and subsumes_term/2
Mon Nov 22 17:12:58 CEST 2010
* add some type tests on chars and codes (in number_chars/2, number_codes/2,..)
Wed Nov 17 15:43:38 CEST 2010
* fix some little bugs in the parser
* add meta_predicate property to predicate_property/2
Mon Oct 25 10:39:51 CEST 2010
* fix a memory leak in atom_concat/3 (in case of failure)
Tue Jul 13 16:19:42 CEST 2010
* add infix operator '|' (and allow it to be unquoted in read/write)
* improve top-level variables display adding () when needed
Fri Jun 25 11:10:43 CEST 2010
* fix a bug in length/2 (length(L,L) now loops)
Thu Jun 24 10:17:04 CEST 2010
* support the ISO multifile/1 directive
* add built-ins false/0 and forall/2
* detect an instantiation_error in phrase/2-3
Fri Mar 31 15:52:42 CEST 2010
* GNU Prolog is now licensed under LGPL
Tue Mar 16 11:35:32 CET 2010
* allow rounding functions to accept an integer if strict_iso is off
Tue Dec 1 14:11:10 CET 2009
* group all examples under a new directory 'examples'
Fri Nov 20 16:34:36 CET 2009
* fix a bug in read_from_codes/2 and number_codes/2
* improve speed of built-in predicates on list (append, member, reverse,...).
Mon Nov 16 14:30:33 CET 2009
* improve CTRL+C handling under the top-level
Thu Oct 22 11:11:02 CEST 2009
* add is_list/1 (same as list/1)
Wed Oct 21 12:02:15 CEST 2009
* add Prolog flags: dialect, home, host_os, host_vendor, host_cpu,
host, arch, version, version_data, unix, argv
Tue Oct 20 13:15:44 CEST 2009
* add preprocessor directives if/1 else/0 elif/1 endif/0
Mon Oct 12 17:30:11 CEST 2009
* fix a bug on large ints in the byte-code for 64-bits machine
* fix a bug with call/2-N
* change listing/0-1 printing stream: now it is current_output
* add a new stream alias: user_error associated to stderr
Fri Oct 9 14:40:11 CEST 2009
* add evaluable functors: (a)sinh/1, (a)cosh/1, (a)tanh/1
* add evaluable functors: epsilon/0, lsb/1, msb/1, popcount/1
Thu Oct 8 17:26:36 CEST 2009
* fix compilation problem under Mac OS X Snow Leopard (force 32-bits mode)
Wed Oct 7 16:14:16 CEST 2009
* add evaluable functors: log/2, gcd/2, tan/1, atan2/2, pi/0, e/0
* add built-in ground/1
* rename built-in sort0 as msort
* add new error detection for keysort
Tue Oct 6 12:47:32 CEST 2009
* accept (but ignore) directive encoding/1
* add xor/2 operator (bitwise XOR) ^/2 becomes integer exponentiation
* improve randomize/0 (more different values on consecutive calls)
* relax the lexer to also accept 0'' (ISO requires 0''' or 0'\') if strict_iso is off
Tue Mar 10 17:14:36 CET 2009
* fix a bug with top-level options --entry-goal and --query-goal
Fri Feb 6 11:02:57 CET 2009
* add working sigaction detection to detect fault addr (e.g. Mac OS X)
Fri Jan 23 12:16:18 CET 2009
* add gplc option --no-mult-warn
* add prolog flags suspicious_warning, multifile_warning
Mon Nov 3 14:54:25 CEST 2008
* detect integer underflow/overflow in the parser
* fix a memory leak in catch/3
Mon Oct 20 16:53:37 CEST 2008
* increase limits (MAX_VAR_NAME_LENGTH=1024 and MAX_VAR_IN_TERM=10240)
* add PL_INT_LOWEST_VALUE and PL_INT_GREATEST_VALUE to gprolog.h
Fri Oct 17 12:09:37 CEST 2008
* prefix all global symbols, constants and types with Pl_ PL_ Pl
* fix a bug in the byte-code due to new max number of atoms
* provide a minimal gprolog.h
* detect if struct sigcontext needs asm/sigcontext.h on Linux
Wed Oct 1 15:48:45 CEST 2008
* modify gplc: --c-compiler also sets linker and --linker added
Tue Sep 30 15:12:00 CEST 2008
* port to x86_64/BSD - many thanks to
David Holland
* fix problem using ebx as global reg (bug in gcc 4.3.2)
* fix a bug in is/2 with [X] (X should only be an integer)
* fix a bug with atoms '/*' '*/' and '%' (were not quoted)
* increase maximum number of atoms to 1048576 (2^20)
* increase default stack sizes (16Mb for heap, 8Mb for others)
Fri May 18 13:06:58 CEST 2007
* fix stack alignment for x86_64/Solaris
Wed Mar 28 15:12:58 CEST 2007
* include patch from Paul Eggert for sparc/solaris8
Fri Mar 9 10:31:53 CET 2007
* port to x86_64/Solaris - many thanks to
Scott L. Burson
Thu Mar 8 14:12:50 CET 2007
* fix a bug in the FD solver (under 64 bits machines)
* fix a bug in arithmetics (mod)
Thu Jan 4 11:17:12 CET 2007
* change error messages emitted by the compiler to follow GNU standards
Fri Dec 22 14:21:26 CET 2006
* modify doc (mainly rename manual.xxx to gprolog.xxx)
* add DESTDIR variable support in main Makefile for staged installs
Fri Dec 15 17:48:30 CET 2006
* fix a bug with Prolog floats in x86_64/Linux (bad stack alignment)
* port for ix86/Darwin (Mac OS X)
Fri Dec 8 16:59:49 CET 2006
* add check target to main Makefile
Thu Dec 7 14:59:46 CET 2006
* improve Win32 ports (Cygwin, MinGW, MSVC 6.0 and 2005 Express Edition)
(MSVC port uses MinGW as.exe instead of nasm.exe - named mingw-as.exe
provided in the setup.exe)
Mon Nov 27 18:38:09 CET 2006
* rename call/2 to call_det/2
* implement call/2-11 as will be defined in the next standard
Fri Nov 24 18:38:25 CET 2006
* fix various problems when compiling with gcc 4 (gcc 4.1.1)
* emit .note.GNU-stack to mark the stack as no executable
in x86_any.c, x86_64_any.c and powerpc_any.c
* change the way objects are found (obj_chain.c) using gcc ctors
* use Doug Lea malloc for OpenBSD (problem with malloc using mmap)
* fix problems in various ports:
alpha/Linux, powerpc/Darwin (Mac OS X), sparc/solaris, ix86/OpenBSD
Mon Jun 13 15:46:49 CEST 2005
* fix 2 bugs in global variables
Mon Jun 7 15:22:44 CEST 2004
* fix problem when compiling with gcc 3.4.0
Fri Jun 4 15:16:30 CEST 2004
* fix bug in term comparison involving negative integers
Thu Mar 11 16:58:43 CET 2004
* add consult, ... and fix minor bugs in the Win32 GUI console menu
Tue Mar 2 15:54:37 CET 2004
* fix the stack overflow detection under Cygwin
* port to ix86/MinGW - many thanks to
Cesar Rabak
Mon Feb 9 14:38:43 CET 2004
* fix a bug in the port to sparc/solaris
Mon Nov 3 11:13:14 CET 2003
* fix a problem in the port to x86/OpenBSD
Tue Sep 23 11:10:09 CEST 2003
* port to sparc/NetBSD and powerpc/NetBSD - many thanks to
Jason Beegan
Wed Apr 23 13:19:58 CEST 2003
* fix a bug in =../2 involving FD variables
Fri Mar 21 14:09:26 CET 2003
* fix a bug in arithmetics (in float_{integer/fractional}_part)
Thu Mar 6 09:28:20 CET 2003
* fix a bug in FD solver (wrong union with a singleton)
Tue Feb 25 16:48:12 CET 2003
* fix a bug with the foreign C interface
Wed Feb 19 18:10:22 CET 2003
* change configure.in: by default ebp is not used
Mon Feb 17 13:45:05 CET 2003
* fix a but with CTRL+C handler not reinstalled
Wed Jan 8 15:22:09 CET 2003
* fix a bug with _XXX (re)displayed under the top-level
Mon Dec 16 13:00:42 CET 2002
* port to x86_64/Linux - many thanks to
Gwenole Beauchesne
Mon Sep 30 22:08:41 CEST 2002
* fix bug in predicate_property/2
Wed Sep 25 13:41:46 CEST 2002
* add new built-in fork_prolog/1 and create_pipe/2
Tue Sep 24 19:30:35 CEST 2002
* fix a bug in atom_concat/3
Thu Sep 19 12:53:45 CEST 2002
* fix bug when detecting if a stream can be repositioned
Thu Sep 12 18:45:10 CEST 2002
* fix bug in output to constant terms (e.g. write_to_atom/2)
* include another additional patch for sockets under win32 - due to
Brent Fulgham
* fix bug in bagof/3 with FD variables
* fix bug with randomize/0
Fri Jun 21 18:32:06 CEST 2002
* added min/max to Prolog arithmetics
Thu Jun 20 15:20:43 CEST 2002
* fix bugs in current_predicate and predicate_property
Mon Jun 10 14:25:52 CEST 2002
* port to powerpc/Darwin (Mac OS X) - many thanks to
Lindsey Spratt
* fix bug in Win32 GUI console (deal with edit control text limit)
* fix bug with in-place installation procedure
Wed Apr 24 19:00:03 CEST 2002
* fix problem with portray_clause/2 using $VARNAME and $VAR
now portray_clause((p(Z):-p('$VARNAME'('A'),Z))) is OK
Tue Apr 23 13:13:18 CEST 2002
* fix bug with stream buffering (open/4 and set_stream_buffering/2)
Sat Apr 21 13:09:54 CEST 2002
* add stream mirror facility (see add_stream_mirror/2)
Fri Apr 19 15:20:51 CEST 2002
* improve global vars (arg. selector, automatic array, new built-ins)
Sun Apr 14 16:35:10 CEST 2002
* fix two bugs with Ctrl+C reentrancy under the top-level
Thu Apr 11 20:30:16 CEST 2002
* added priority/1 option to write_term to specify starting priority
* now under the top-level, _XXX variables are not displayed
Wed Apr 10 15:04:23 CEST 2002
* fix bug in decompose_file_name/4 (tried to modify read-only string)
* now open/4 better detects if a stream can be repositioned
Mon Apr 8 20:08:29 CEST 2002
* add source reader facility (built-in) - not yet documented
* fix current_predicate bug, now current_predicate(nl/0) fails
Fri Apr 5 12:32:26 CEST 2002
* fix linedit bug in tab pasting and add Esc-Tab function
* now linedit goes to EOL at CR to fix bug with multi-line inputs
* now linedit avoids to put in history 2 same consecutive lines
* remove max_stream limitation (the Prolog flag no longer exists)
* the template of get_print_stream/1 is now ?stream
Thu Mar 28 00:35:59 CEST 2002
* patch to allow more than 64Mb for the stacks under ix86/Linux
Mon Mar 25 13:34:52 CEST 2002
* fix a bug in wam2ma (hexa name creation overflowed malloc buffer)
Fri Mar 22 11:31:52 CEST 2002
* fix a problem under sparc/solaris using mmap (adding MAP_FIXED)
Tue Mar 19 18:51:50 CEST 2002
* fix a problem with gcc 3.0.x which always uses ebp in main()
* use -march=xxx gcc option instead of -mxxx for ix86
Tue Jan 15 19:26:26 CEST 2002
* gplc now passes -L option to ld in the order of apparition
* gplc accepts meta-characters %p, %d,... in output file names
Tue Jan 8 16:51:48 CEST 2002
* include additional patch for sockets under win32 - due to
Brent Fulgham
Thu Dec 20 16:17:00 CEST 2001
* re-write Windows GUI Console in pure Win32 (no more MFC)
* adapt configure.in to work with autoconf 2.52
Thu Dec 13 12:09:36 CEST 2001
* add Prolog flag back_quotes and values {atom,chars,codes}_no_escape
* use a terminal recursion in FD arithmetic normalization
Wed Dec 12 11:04:57 CEST 2001
* fix bug in bind_variables/2, reported by:
Bowie Owens
Tue Dec 11 18:25:19 CEST 2001
* modify Ma2Asm mappers to use Y_OFFSET (from ENVIR_STATIC_SIZE)
* fix some bugs in the Wam debugger
Fri Dec 7 19:01:02 CEST 2001
* add several options to the top-level to execute goals
* add an environment variable LINEDIT to control linedit options
* fix bug in linedit on \b in start of line (using ANSI ESC sequences)
Tue Dec 4 20:29:00 CEST 2001
* simplify linedit: only apply to stdin
* now linedit is reentrant
* now linedit works with XFree keyboard encoding
* rename built-in get_code_no_echo/1-2 by get_key_no_echo/1-2
* add built-in get_key/1-2
* use get_key/1-2 in the top_level + debugger (thus with echo)
* improve the top-level Ctrl+C manager
Mon Dec 3 18:13:16 CEST 2001
* fix bug on Linux configured with --disable-regs
* add pipe to pl2wam stdin when called by consult/1
Mon Nov 5 10:25:29 CEST 2001
* fix bug in FD: forall is now recognized in .fd files
* fix bug in DCG: expand_term((a --> X), Y) is OK
Wed Oct 31 20:31:04 CEST 2001
* fix X paste problem in linedit
Tue Oct 3O 17:31:04 CEST 2001
* simplify top_comp.c to better control include dirs in devel. mode
Sun Oct 14 17:12:32 CEST 2001
* specialized functions for create/update/delete choice points
Tue Oct 9 12:11:44 CEST 2001
* fix a bug in wam2ma (hexa name creation overflowed malloc buffer)
Mon Oct 8 12:33:02 CEST 2001
* include patch to support basic sockets under win32 - due to
Brent Fulgham
* arithmetic functions and inlined built-ins use fast call
* specialized functions for switch_on_term_xxx
* modify pl2wam to generalize '$call_c' (add options)
Mon Oct 8 11:33:02 CEST 2001
* fix bug - delete file created by mkstemp(2), patch from:
Salvador Abreu
Fri Sep 28 17:09:35 CEST 2001
* space_args(true) now displays a space inside {}/1
* space_args(true) now displays a space after a comma (','/2)
Sat Sep 15 12:49:19 CET 2001
* add a --foreign-only option to pl2wam
* foreign/2 directives are ignored in byte-code mode (no fatal error)
Fri Sep 7 09:58:36 CET 2001
* space_args(true) now displays space between operators and arguments
* add CVS Id to prolog files
* fix bug in pl2wam to include break/0, trace/0,... in bip_list.pl
Thu Jul 12 16:03:30 CET 2001
* get rid of mktemp and tempnam calls (use mkstemp if available)
Thu Jun 7 20:34:13 CET 2001
* fix a bug in fd_element_var/3 constraint
Thu Feb 8 11:25:30 CET 2001
* fix bug in fd headers (fd_to_c.h not installed)
Thu Jan 25 21:12:06 CET 2001
* fix a bug with unify_with_occurs_check/2
* fix bug on ix86 using ebp (add -fomit-frame-pointer in CFLAGS_MACHINE)
Mon Jan 22 12:41:26 CET 2001
* fix a bug with ! in dynamic code
* fix a bug in arithmetics
Tue Dec 19 16:32:39 CET 20000
* big modification (1 month) to optimize the execution speed
Thu Nov 9 19:06:06 CEST 2000
* implement fast call (mainly for WAM functions)
Tue Nov 7 15:12:11 CEST 2000
* modify C->Prolog foreign interface to recover arguments space
Mon Nov 6 14:58:07 CEST 2000
* improve dynamic clause management and fix a bug (memory leak)
Fri Nov 3 09:17:19 CEST 2000
* fix _ symbol prefix problem for Free BSD
Fri Oct 13 17:46:38 CEST 2000
* no longer use dl_malloc on Linux but prevent MMAP using mallopt
Tue Sep 12 15:42:48 CEST 2000
* full re-indentation of the sources for CVS
Thu Sep 7 18:04:15 CEST 2000
* added acos/asin to Prolog arithmetics
Wed Sep 6 20:04:15 CEST 2000
* port to alpha/Linux - many thanks to
Alexander Diemand
* port to alpha/OSF1
* port to mips/irix - many thanks to
Alexander Diemand
* fix a bug in stty.c (use standard termios if present)
Mon Jul 31 11:42:44 CEST 2000
* fix a bug in stty.c (use termio by default and else termios)
Thu Jul 6 11:38:58 CEST 2000
* more customizable configuration/installation procedure
Mon Jun 3 19:57:20 CEST 2000
* port for ix86/NetBSD - many thanks to
Brook Milligan
Wed Jun 28 11:38:37 CEST 2000
* rename configuration file config.h by gp_config.h
Mon Jun 19 14:24:44 CEST 2000
* avoid to establish a connection at start to get the hostname
Tue Jun 6 16:51:48 CEST 2000
* fix a bug in the compiler about \\ inside quoted atoms
Thu May 4 17:39:53 CEST 2000
* fix a bug in dynamic clause retraction (memory leak)
Tue Apr 25 16:32:09 CEST 2000
* fix a bug in atom management (existing atoms eat mallocated space)
Tue Apr 18 13:23:02 CEST 2000
* added creation/1 and last_access/1 property to file_property/2
Wed Mar 1 14:23:45 CEST 2000
* start of native Win32 port
Mon Feb 14 14:00:46 CET 2000
* port for ix86/FreeBSD - many thanks to
Nicolas Ollinger
Tue Jan 18 17:30:25 CET 2000
* fix a bug in the byte-code loader (bad realloc computation)
* fix a bug in the malloc (used MMAP under Linux)
Fri Dec 17 15:54:51 CET 1999
* port for ix86/SCO - many thanks to
Clive Cox and
Edmund Grimley Evans
* port for ix86/solaris - many thanks to
Andreas Stolcke
Thu Dec 16 18:23:13 CET 1999
* fix a bug in the FD solver for X#\=C (if C is max(X))
Thu Dec 2 17:31:31 CET 1999
* fix a bug with directory_files/2 (too many open files)
Thu Nov 25 14:27:11 CET 1999
* fix a bug in the compiler about \t in quoted atoms
Fri Oct 22 14:59:47 CEST 1999
* fix a bug in the scanner about 0'
Mon Oct 18 12:46:59 CEST 1999
* fix bug with popen/3
* update machine.c for struct sigcontext under Linux
Fri Oct 8 19:36:59 CEST 1999
* fix a bug in the output of some extended characters in native-compilation
Tue Sep 28 18:00:44 CEST 1999
* implementation of call_with_args
Mon Sep 27 16:18:55 CEST 1999
* fix a bug in sign/1 for arithmetic evaluation
Fri Jul 16 13:26:31 CEST 1999
* fix a bug in foreign C calling Prolog on sparc
Thu Jul 15 12:04:38 CEST 1999
* fix a bug in sparc compilation
* fix a bug in foreign code under sparc
* update pl_config.c to show which version is installed
Tue Jul 6 14:47:51 CEST 1999
* add linedit test to avoid to re-echo an already buffered full-line
* fix bugs is sort/1
Fri Jun 25 10:04:03 CEST 1999
* fix bug in sleep/1 (incorrect behavior with a float)
* finish preliminary port to Cygwin (see file src/PROBLEMS)
Wed Jun 23 13:49:07 MEST 1999
* fix bug in FD solver (too much trail allocated due to bad vec_size)
* fix labeling first-fail to correspond to clp(FD)
Fri Jun 18 12:29:03 CEST 1999
* fix message from consult when pl2wam cannot be found
Thu Jun 17 16:12:53 MEST 1999
* fix precision bug on floating constants
Sun Jun 6 12:05:32 CEST 1999
* initial port for ix86/Cygwin (Win32) (to finish)
Fri Jun 4 11:05:37 CEST 1999
* fix bug in throw_c.c (foreign code catch exception)
* improve Ma2Asm check.c and FromC/ utilities
* port for PowerPC / GNU/Linux (see file src/PROBLEMS)
Mon May 31 10:45:35 CEST 1999
* fix bug using egcs-1.1.2 (RedHat 6.0) (add a Stop_Prolog() fct)
Fri May 21 15:56:50 MEST 1999
* removed Configure directory (clashes with ./configure under WinXX)
* fix Linedit/Makefile.in (CFLAGS added)
Fri May 21 11:54:31 MEST 1999
* add ensure_linked directive
* fix bug in gplc help (-C/-A/-L instead of --C/--A/--L)
* fix bug in gplc (with too long command-lines)
* fix bug in M_Absolute_Path_Name() (/.automount gave /automount)
Wed Apr 21 09:53:00 MEST 1999
* work release 1.0.1
* fix bug --disable-regs works now for solaris
Mon Apr 19 19:46:07 MEST 1999
* optimize FD equations (math_supp.c) avoid qsort sometimes
* fix bug in installation procedure (Html doc installation)
Fri Apr 16 15:49:34 MEST 1999
* rewrite in C DCG translation:
optimize unifications, no more ill-balanced conjunctions
* fix bug in bc_supp.c to avoid aux pred name for unknown predicate
* fix bug in pl2wam (:- set_prolog_flag(singleton_warning,off))
Thu Apr 8 19:09:40 MEST 1999
* current_prolog/1 conforms to ISO thanks to strict_iso flag
* fix bug (type_list instead of instantiation error for Options)
* fix bug setof (not sorted when comes down to findall)
Tue Apr 6 20:48:32 MEST 1999
* add Prolog flag strict_iso (to relax predicate indicators)
* fix number_chars and friends non ISO conforming behavior
* modify wam2ma to avoid static arrays (use dynamic allocation)
Sun Apr 4 15:28:12 MET 1999
* add in-place installation (modify configure.in and Makefile.in)
Wed Mar 31 16:26:10 MET 1999
* add copyright headers in source files
Thu Mar 30 17:20:10 MET 1999
* rewrite all solutions built-in predicates (in C)
* add in-place sorts
Wed Mar 24 10:12:02 MET 1999
* rewrite DCG translations
Mon Mar 22 19:42:12 MET 1999
* fix compiler bug in wam2ma (atom using \xHH\ not correctly handled)
Fri Mar 19 19:42:12 MET 1999
* rewrite sorts built-in predicates (in C)
Mon Mar 15 10:12:02 MET 1999
* Calypso (beta 7) becomes GNU Prolog 0.9.0
change command names (calypso -> gprolog, plcc -> gplc,...)
copyright messages (--version),...
Fri Mar 12 09:38:24 MET 1999
* fail/0 caused an existence_error under the debugger
Wed Mar 10 11:57:25 MET 1999
* user/built_in/built_in_fd not recognized by load/1
Mon Mar 8 20:39:25 MET 1999
* Calypso version 1.0-beta7 ready for internal use
gprolog-1.4.5/VERSION 0000644 0001750 0001750 00000000016 13021356406 012367 0 ustar spa spa gprolog-1.4.5
gprolog-1.4.5/examples/ 0000755 0001750 0001750 00000000000 13021324543 013135 5 ustar spa spa gprolog-1.4.5/examples/ExamplesFD/ 0000755 0001750 0001750 00000000000 13021324543 015125 5 ustar spa spa gprolog-1.4.5/examples/ExamplesFD/bdonald.pl 0000644 0001750 0001750 00000007605 13021324543 017075 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Boolean) */
/* */
/* Name : bdonald.pl */
/* Title : crypt-arithmetic */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : January 1993 */
/* */
/* Solve the operation: */
/* */
/* D O N A L D */
/* + G E R A L D */
/* -------------- */
/* = R O B E R T */
/* */
/* (resolution by column) */
/* The digit of each letter is coded in binary on 4 bits (dcb). The order */
/* for labeling is very relevant for efficiency. */
/* */
/* Solution: */
/* [D,O,N,A,L,G,E,R,B,T] */
/* [5,2,6,4,8,1,9,7,3,0] */
/* [[0,1,0,1],[0,0,1,0],[0,1,1,0],[0,1,0,0],[1,0,0,0],[0,0,0,1],[1,0,0,1],*/
/* [0,1,1,1],[0,0,1,1],[0,0,0,0]] */
/* ie: */
/* [5,2,6,4,8,1,9,7,3,0] */
/*-------------------------------------------------------------------------*/
q :-
statistics(runtime, _),
( bdonald(A),
write(A),
nl,
fail
; write('No more solutions'),
nl
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
bdonald(Ar) :-
Ar = [D, O, N, A, L, G, E, R, B, T],
dcb_digit(D),
dcb_digit(O),
dcb_digit(N),
dcb_digit(A),
dcb_digit(L),
dcb_digit(G),
dcb_digit(E),
dcb_digit(R),
dcb_digit(B),
dcb_digit(T),
diff0(D),
diff0(G),
all_dcb_digit_diff(Ar),
LC = [C1, C2, C3, C4, C5],
dcb_add(0, D, D, T, C1),
dcb_add(C1, L, L, R, C2),
dcb_add(C2, A, A, E, C3),
dcb_add(C3, N, R, B, C4),
dcb_add(C4, O, E, O, C5),
dcb_add(C5, D, G, R, 0), !,
array_labeling([D, A, L, O, N, E, G, R, B, T]),
fd_labeling(LC).
dcb_digit(D) :-
D = [B3, B2, B1, _],
B3 #==> #\ B2 #/\ #\ B1.
diff0([B3, B2, B1, B0]) :-
B3 #\/ B2 #\/ B1 #\/ B0.
all_dcb_digit_diff([]).
all_dcb_digit_diff([X|L]) :-
diff_of(L, X),
all_dcb_digit_diff(L).
diff_of([], _).
diff_of([Y|L], X) :-
dcb_digit_diff(X, Y),
diff_of(L, X).
dcb_digit_diff([X3, X2, X1, X0], [Y3, Y2, Y1, Y0]) :-
#\ ((X3 #<=> Y3) #/\ (X2 #<=> Y2) #/\ (X1 #<=> Y1) #/\ (X0 #<=> Y0)).
dcb_add(CI, [X3, X2, X1, X0], [Y3, Y2, Y1, Y0], [Z3, Z2, Z1, Z0], CO) :-
full_add(CI, X0, Y0, Z0, C1),
full_add(C1, X1, Y1, I1, C2),
full_add(C2, X2, Y2, I2, C3),
full_add(C3, X3, Y3, I3, C4),
I2 #\/ I1 #<=> I12,
I3 #/\ I12 #<=> I123,
C4 #\/ I123 #<=> Hex,
half_add(I1, Hex, Z1, D2),
full_add(D2, I2, Hex, Z2, D3),
half_add(D3, I3, Z3, D4),
C4 #\/ D4 #<=> CO.
full_add(CI, X, Y, Z, CO) :-
half_add(X, Y, Z1, C1),
half_add(CI, Z1, Z, C2),
C1 #\/ C2 #<=> CO.
half_add(X, Y, Z, CO) :-
X #/\ Y #<=> CO,
X ## Y #<=> Z.
:- include(array).
% interface with for_each_... procedures
array_prog(_, _).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/bsend.pl 0000644 0001750 0001750 00000007444 13021324543 016566 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Boolean) */
/* */
/* Name : bsend.pl */
/* Title : crypt-arithmetic */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : January 1993 */
/* */
/* Solve the operation: */
/* */
/* S E N D */
/* + M O R E */
/* ----------- */
/* = M O N E Y */
/* */
/* (resolution by column) */
/* The digit of each letter is coded in binary on 4 bits (dcb). The order */
/* for labeling is very relevant for efficiency. */
/* */
/* Solution: */
/* [S,E,N,D,M,O,R,Y] */
/* [[1,0,0,1],[0,1,0,1],[0,1,1,0],[0,1,1,1],[0,0,0,1],[0,0,0,0],[1,0,0,0],*/
/* [0,0,1,0]] */
/* ie: */
/* [9,5,6,7,1,0,8,2] */
/*-------------------------------------------------------------------------*/
q :-
statistics(runtime, _),
( bsend(A),
write(A),
nl %,
% fail
; write('No more solutions'),
nl
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
bsend(A) :-
A = [S, E, N, D, M, O, R, Y],
dcb_digit(S),
dcb_digit(E),
dcb_digit(N),
dcb_digit(D),
dcb_digit(M),
dcb_digit(O),
dcb_digit(R),
dcb_digit(Y),
diff0(S),
diff0(M),
all_dcb_digit_diff(A),
LC = [C1, C2, C3, C4],
Z = [0, 0, 0, 0],
dcb_add(0, D, E, Y, C1),
dcb_add(C1, N, R, E, C2),
dcb_add(C2, E, O, N, C3),
dcb_add(C3, S, M, O, C4),
dcb_add(C4, Z, Z, M, 0), !,
array_labeling(A),
fd_labeling(LC).
dcb_digit(D) :-
D = [B3, B2, B1, _],
B3 #==> #\ B2 #/\ #\ B1.
diff0([B3, B2, B1, B0]) :-
B3 #\/ B2 #\/ B1 #\/ B0.
all_dcb_digit_diff([]).
all_dcb_digit_diff([X|L]) :-
diff_of(L, X),
all_dcb_digit_diff(L).
diff_of([], _).
diff_of([Y|L], X) :-
dcb_digit_diff(X, Y),
diff_of(L, X).
dcb_digit_diff([X3, X2, X1, X0], [Y3, Y2, Y1, Y0]) :-
#\ ((X3 #<=> Y3) #/\ (X2 #<=> Y2) #/\ (X1 #<=> Y1) #/\ (X0 #<=> Y0)).
dcb_add(CI, [X3, X2, X1, X0], [Y3, Y2, Y1, Y0], [Z3, Z2, Z1, Z0], CO) :-
full_add(CI, X0, Y0, Z0, C1),
full_add(C1, X1, Y1, I1, C2),
full_add(C2, X2, Y2, I2, C3),
full_add(C3, X3, Y3, I3, C4),
I2 #\/ I1 #<=> I12,
I3 #/\ I12 #<=> I123,
C4 #\/ I123 #<=> Hex,
half_add(I1, Hex, Z1, D2),
full_add(D2, I2, Hex, Z2, D3),
half_add(D3, I3, Z3, D4),
C4 #\/ D4 #<=> CO.
full_add(CI, X, Y, Z, CO) :-
half_add(X, Y, Z1, C1),
half_add(CI, Z1, Z, C2),
C1 #\/ C2 #<=> CO.
half_add(X, Y, Z, CO) :-
X #/\ Y #<=> CO,
X ## Y #<=> Z.
:- include(array).
% interface with for_each_... procedures
array_prog(_, _).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/qg5.pl 0000644 0001750 0001750 00000005233 13021324543 016161 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : qg5.pl */
/* Title : Quasi-group problem QG5 */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : July 1998, modified 2009 */
/* */
/* Find a semigroup table so that: ((xy)x)x=y under idempotency hypothesis.*/
/* */
/* Solution: */
/* N = 5 [[1,5,4,2,3],[3,2,5,1,4],[2,4,3,5,1],[5,3,1,4,2],[4,1,2,3,5]] */
/* */
/* table (x.y is at col x, row y) */
/* 1 5 4 2 3 */
/* 3 2 5 1 4 */
/* 2 4 3 5 1 */
/* 5 3 1 4 2 */
/* 4 1 2 3 5 */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
qg5(N, A),
statistics(runtime, [_, Y]),
write(A),
nl,
write_array(A, '%3d', 0),
write('time : '),
write(Y),
nl.
qg5(N, A) :-
fd_set_vector_max(N),
create_array(N, N, A),
array_values(A, L),
fd_domain(L, 1, N),
for_each_line(A, alldiff),
for_each_column(A, alldiff),
last(A, Last),
isomorphic_cstr(Last, 0),
axioms_cstr(1, N, A),
fd_labelingff(L).
array_prog(alldiff, L) :-
fd_all_different(L).
isomorphic_cstr([], _).
isomorphic_cstr([X|L], K) :-
X #>= K,
K1 is K + 1,
isomorphic_cstr(L, K1).
axioms_cstr(I, N, A) :-
I =< N, !,
nth(I, A, L),
axioms_cstr1(1, N, I, L, A),
I1 is I + 1,
axioms_cstr(I1, N, A).
axioms_cstr(_, _, _).
axioms_cstr1(J, N, I, L, A) :-
J =< N, !,
array_elem(A, J, I, V1),
( I = J ->
V1 = I % idempotency
; fd_element_var(V1, L, V2),
fd_element_var(V2, L, J)
),
J1 is J + 1,
axioms_cstr1(J1, N, I, L, A).
axioms_cstr1(_, _, _, _, _).
:- include(array).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/partit.pl 0000644 0001750 0001750 00000022245 13021324543 016772 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : partit.pl */
/* Title : integer partitionning */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1993 (modified March 1997, feb 2010) */
/* */
/* Partition numbers 1,2,...,N into two groups A and B such that: */
/* a) A and B have the same length, */
/* b) sum of numbers in A = sum of numbers in B, */
/* c) sum of squares of numbers in A = sum of squares of numbers in B. */
/* */
/* It seems there is a solution if N >= 8 and N is a multiple of 4. */
/* */
/* Two redundant constraints are used: */
/* */
/* - in order to avoid duplicate solutions (permutations) we impose */
/* A1 X,
ascending_order(L, Y).
cstr_pow(P, N, A, B) :-
sum_power(P, N, S),
compute_and_check_half_sum(N, P, S, HS),
cstr_pow(A, P, HS),
cstr_pow(B, P, HS).
cstr_pow([], _, 0).
cstr_pow([X|L], P, S) :-
X ** P #= XP,
S #= XP + S1,
cstr_pow(L, P, S1).
/* Known sums of powers
* sum of n first integers: s1(n) = n * (n+1) / 2
* sum of n first squares : s2(n) = n * (n+1) * (2*n+1)/ 6
* sum of n first cubes : s3(n) = n^2 * (n+1)^2 / 4 = s1(n)^2
* sum of n fisrt pow 4 : s4(n) = n * (n+1) * (6*n^3 + 9*n^2 + n - 1 ) / 30
*/
sum_power(1, N, S) :-
S is N * (N + 1) // 2.
sum_power(2, N, S) :-
S is N * (N + 1) * (2 * N + 1) // 6.
sum_power(3, N, S) :-
sum_power(1, N, S2),
S is S2 * S2.
sum_power(4, N, S) :-
S is N * (N+1) * (6*N^3 + 9*N^2 + N - 1) // 30.
/* The labeling heuristics consists in placing the biggest missing value (from N to 1) */
enum_all(1, _, _) :-
!.
enum_all(N, [N|A], B) :-
N1 is N - 1,
enum_all(N1, A, B).
enum_all(N, A, [N|B]) :-
N1 is N - 1,
enum_all(N1, A, B).
/* If only one solution is wanted, it is better to first try to put the biggest missing value
* in the group which has the smallest sum (of already placed values). */
enum_one(1, _, _, _, _) :-
!.
enum_one(N, SumA, SumB, A, B) :-
SumA > SumB, !,
enum_one(N, SumB, SumA, B, A).
enum_one(N, SumA, SumB, [N|A], B) :- % in A first (which has the smallest sum) then...
SumA1 is SumA + N,
N1 is N - 1,
enum_one(N1, SumA1, SumB, A, B).
enum_one(N, SumA, SumB, A, [N|B]) :- % in B at backtracking
SumB1 is SumB + N,
N1 is N - 1,
enum_one(N1, SumA, SumB1, A, B).
:- initialization(q).
%%% to compute the number of solutions
all(N) :-
g_assign(nb,0),
user_time(T0),
all(N, T0).
all(N, T0) :-
partit(N, _, _),
g_inc(nb, NB),
NB mod 100000 =:= 0, % adapt this to have more or less displayed lines
show_time(NB, T0),
fail.
all(N, T0) :-
g_read(nb, NB),
format('\nfinal for partit ~d:\n\n', [N]),
show_time(NB, T0).
show_time(NB, T0) :-
user_time(T1),
T is (T1 - T0),
format('%10d solutions in ', [NB]),
disp_time(T),
TA is T / NB,
write('\n average '),
disp_time(TA),
write(' / sol\n').
disp_time(T) :-
T1 is T / 1000,
format('%20.6f secs =', [T1]),
disp_time([86400000-d,3600000-h,60000-m,1000-s,1-ms],
T, nothing_yet_displayed).
disp_time([], T, nothing_yet_displayed) :-
!,
format(' %.3f ms', [T]).
disp_time([], _, _).
disp_time([M-_|LM], T, nothing_yet_displayed) :-
T < M, !,
disp_time(LM, T, nothing_yet_displayed).
disp_time([M-U|LM], T, _) :-
N is truncate(T / M),
T1 is T - (N * M),
format(' ~d~a', [N, U]),
disp_time(LM, T1, something_is_displayed).
gprolog-1.4.5/examples/ExamplesFD/square.pl 0000644 0001750 0001750 00000012334 13021324543 016765 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : square.pl */
/* Title : perfect square */
/* Original Source: Pascal Van Hentenryck ([VHSD93]) */
/* Adapted by : Gregory Sidebottom (Nicolog) and Daniel Diaz (clp(FD)) */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : June 1994 */
/* */
/* This program solves the perfect square packing problem (SPP): find a way*/
/* to pack all the given squares (i.e. known sizes) into a master rectangle*/
/* so that none overlap and there is no wasted space. */
/* There are 4 instances of the problem (P=3 corresponds to [VSHD93]). */
/* */
/* Solution: */
/* 1 x([ 0, 0,18,22,23,15,15,18,22]) 2 x([ 0,41,42, 0,22,25,25,36,36,22]) */
/* y([ 0,18, 0,14,24,25,18,14,24]) y([ 0,23, 0,25,28, 0,17,17,23,25]) */
/* s([18,15,14,10, 9, 8, 7, 4, 1]) s([25,24,23,22,19,17,11, 6, 5, 3]) */
/* */
/* 3 x([ 0,70,75, 0,79,50 ,0,50,46,27,52,35,59,35,35,50,27,52,46,75,50]) */
/* y([ 0,70,33,50, 0, 0,85,29,88,93,70,65,54,50,82,54,85,63,82,29,63]) */
/* s([50,42,37,35,33,29,27,25,24,19,18,17,16,15,11, 9, 8, 7, 6, 4, 2]) */
/* */
/* 4 x([ 0,111, 0, 56, 81,132, 72, 0,140,142,111,81,111, 38, 38, 56, 58,*/
/* 63,132, 58, 59, 56,140, 58]) */
/* y([ 0,111, 81, 81, 0, 0,136,137, 43, 78, 80,51, 51,155,137,136,161,*/
/* 152, 43,156,152,152, 78,155]) */
/* s([ 81, 64, 56, 55, 51, 43, 39, 38, 35, 33, 31,30, 29, 20, 18, 16, 14,*/
/* 9, 8, 5, 4, 3, 2, 1]) */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
square(N, Xs, Ys, Ss),
statistics(runtime, [_, Y]),
write(x(Xs)),
nl,
write(y(Ys)),
nl,
write(s(Ss)),
nl,
write('time : '),
write(Y),
nl.
problem(1, 32, 33, [18, 15, 14, 10, 9, 8, 7, 4, 1]).
problem(2, 65, 47, [25, 24, 23, 22, 19, 17, 11, 6, 5, 3]).
problem(3, 112, 112, [50, 42, 37, 35, 33, 29, 27, 25, 24, 19, 18, 17, 16, 15, 11, 9, 8, 7, 6, 4, 2]).
problem(4, 175, 175, [81, 64, 56, 55, 51, 43, 39, 38, 35, 33, 31, 30, 29, 20, 18, 16, 14, 9, 8, 5, 4, 3, 2, 1]).
problem(5, 479, 479, [175, 174, 164, 160, 155, 150, 140, 130, 86, 77, 68, 60, 52, 44, 43, 35, 29, 28, 26, 24, 23, 17, 6, 5]).
problem(6, 655, 655, [288, 246, 216, 215, 194, 193, 173, 152, 151, 86, 84, 83, 65, 57, 54, 53, 51, 40, 31, 26, 25, 21, 15, 14, 10]).
% adaptive search examples
problem(-1, 112, 112, [50, 42, 37, 35, 33, 29, 27, 25, 24, 19, 18, 17, 16, 15, 11, 9, 8, 7, 6, 4, 2]).
problem(-4, 479, 479, [175,174,164,160,155,150,140,130,86,77,68,60,52,44,43,35,29,28,26,24,23,17,6,5]).
problem(-5, 524, 524, [220,164,163,159,145,141,135,132,125,101,98,90,87,62,61,55,54,39,37,35,33,21,20,12,9]).
square(P, Xs, Ys, Ss) :-
gen(P, Xs, Ys, Ss, SX, SY),
( SX >= SY ->
MaxS = SX
; MaxS = SY
),
fd_set_vector_max(MaxS),
no_overlap(Xs, Ys, Ss),
cap(Xs, Ss, SX, SY),
cap(Ys, Ss, SY, SX),
label(Xs),
label(Ys).
gen(P, Xs, Ys, Ss, SX, SY) :-
problem(P, SX, SY, Ss),
gen_coords(Ss, Xs, Ys, SX, SY).
gen_coords([], [], [], _, _).
gen_coords([S|Ss], [X|Xs], [Y|Ys], SX, SY) :-
X #=< SX - S,
Y #=< SY - S,
gen_coords(Ss, Xs, Ys, SX, SY).
no_overlap([], [], []).
no_overlap([X|Xs], [Y|Ys], [S|Ss]) :-
no_overlap1(Xs, Ys, Ss, X, Y, S),
no_overlap(Xs, Ys, Ss).
no_overlap1([], [], [], _, _, _).
no_overlap1([X2|Xs], [Y2|Ys], [S2|Ss], X1, Y1, S1) :-
X1 + S1 #=< X2 #\/ X1 #>= X2 + S2 #\/ Y1 + S1 #=< Y2 #\/ Y1 #>= Y2 + S2,
no_overlap1(Xs, Ys, Ss, X1, Y1, S1).
cap(Xs, Ss, SX, SY) :-
cap1(0, SX, SY, Xs, Ss).
cap1(P, SX, SY, Xs, Ss) :-
( P < SX ->
sum_of_squares_with(Xs, Ss, P, SY),
P1 is P + 1,
cap1(P1, SX, SY, Xs, Ss)
; true
).
sum_of_squares_with([], [], _, 0).
sum_of_squares_with([X|Xs], [S|Ss], P, Sum) :-
point_used_by_square_iff_b(P, X, S, B),
Sum #= S * B + Sum1,
sum_of_squares_with(Xs, Ss, P, Sum1).
% X<=P B P and S are ground
point_used_by_square_iff_b(P, X, S, B) :-
B #<=> X #=< P #/\ P #< X + S.
label([]).
label([X|Xs]) :-
list_min([X|Xs], Min),
select_square([X|Xs], Min, Rest),
label(Rest).
list_min([X|Xs], Min) :-
fd_min(X, Min1),
list_min1(Xs, Min1, Min).
list_min1([], M, M).
list_min1([X|Xs], M1, M) :-
fd_min(X, M2),
( M1 =< M2 ->
M3 = M1
; M3 = M2
),
list_min1(Xs, M3, M).
select_square([X|Xs], X, Xs).
select_square([X|Xs], Min, [X|Rest]) :-
X #> Min,
select_square(Xs, Min, Rest).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/bschur.pl 0000644 0001750 0001750 00000005045 13021324543 016754 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Boolean) */
/* */
/* Name : bschur.pl */
/* Title : Schur's lemma */
/* Original Source: Giovanna Dore - Italy */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : January 1993 */
/* */
/* Color the integers 1,2...,N with 3 colors so that there is no monochrome*/
/* triplets (x,y,z) where x+y=z. Solution iff N<=13. */
/* The solution is a list [ [Int11,Int12,Int13],..., [IntN1,IntN2,IntN3] ] */
/* where Intij is 1 if the integer i is colored with the color j. */
/* */
/* Solution: */
/* N=4 [[0,0,1],[0,1,0],[0,0,1],[1,0,0]] */
/* [[0,0,1],[0,1,0],[0,1,0],[0,0,1]] */
/* ... */
/* N=13 [[0,0,1],[0,1,0],[0,1,0],[0,0,1],[1,0,0],[1,0,0],[0,0,1],[1,0,0], */
/* [1,0,0],[0,0,1],[0,1,0],[0,1,0],[0,0,1]] (first solution) */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
( schur(N, A),
write(A),
nl,
fail
; write('No more solutions'),
nl
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
schur(N, A) :-
create_array(N, 3, A),
for_each_line(A, only1),
pair_constraints(A, A), !,
array_labeling(A).
pair_constraints([], _) :-
!.
pair_constraints([_], _) :-
!.
pair_constraints([_, [K1, K2, K3]|A2], [[I1, I2, I3]|A1]) :-
#\ (I1 #/\ K1),
#\ (I2 #/\ K2),
#\ (I3 #/\ K3),
triplet_constraints(A2, A1, [I1, I2, I3]),
pair_constraints(A2, A1).
triplet_constraints([], _, _).
triplet_constraints([[K1, K2, K3]|A2], [[J1, J2, J3]|A1], [I1, I2, I3]) :-
#\ (I1 #/\ J1 #/\ K1),
#\ (I2 #/\ J2 #/\ K2),
#\ (I3 #/\ J3 #/\ K3),
triplet_constraints(A2, A1, [I1, I2, I3]).
:- include(array).
% interface with for_each_... procedures
array_prog(only1, L) :-
fd_only_one(L).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/crypta.pl 0000644 0001750 0001750 00000005421 13021324543 016766 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : crypta.pl */
/* Title : crypt-arithmetic */
/* Original Source: P. Van Hentenryck's book */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1992 */
/* */
/* Solve the operation: */
/* */
/* B A I J J A J I I A H F C F E B B J E A */
/* + D H F G A B C D I D B I F F A G F E J E */
/* ----------------------------------------- */
/* = G J E G A C D D H F A F J B F I H E E F */
/* */
/* Solution: */
/* [A,B,C,D,E,F,G,H,I,J] */
/* [1,2,3,4,5,6,7,8,9,0] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
crypta(Lab, LD),
statistics(runtime, [_, Y]),
write(LD),
nl,
write('time : '),
write(Y),
nl.
crypta(Lab, LD) :-
fd_set_vector_max(9),
LD = [A, B, C, D, E, F, G, H, I, J],
fd_domain(LD, 0, 9),
fd_domain([Sr1, Sr2], 0, 1),
fd_domain([B, D, G], 1, 9),
fd_all_different(LD),
A + 10 * E + 100 * J + 1000 * B + 10000 * B + 100000 * E + 1000000 * F + E + 10 * J + 100 * E + 1000 * F + 10000 * G + 100000 * A + 1000000 * F #= F + 10 * E + 100 * E + 1000 * H + 10000 * I + 100000 * F + 1000000 * B + 10000000 * Sr1,
C + 10 * F + 100 * H + 1000 * A + 10000 * I + 100000 * I + 1000000 * J + F + 10 * I + 100 * B + 1000 * D + 10000 * I + 100000 * D + 1000000 * C + Sr1 #= J + 10 * F + 100 * A + 1000 * F + 10000 * H + 100000 * D + 1000000 * D + 10000000 * Sr2,
A + 10 * J + 100 * J + 1000 * I + 10000 * A + 100000 * B + B + 10 * A + 100 * G + 1000 * F + 10000 * H + 100000 * D + Sr2 #= C + 10 * A + 100 * G + 1000 * E + 10000 * J + 100000 * G,
lab(Lab, LD).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/eq20.pl 0000644 0001750 0001750 00000007253 13021324543 016240 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : eq20.pl */
/* Title : linear equations */
/* Original Source: Thomson LCR */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1992 */
/* */
/* A system involving 7 variables and 20 equations */
/* */
/* Solution: */
/* [X1,X2,X3,X4,X5,X6,X7] */
/* [ 1, 4, 6, 6, 6, 3, 1] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
eq20(LD, Lab),
statistics(runtime, [_, Y]),
write(LD),
nl,
write('time : '),
write(Y),
nl.
eq20(LD, Lab) :-
LD = [X1, X2, X3, X4, X5, X6, X7],
fd_domain(LD, 0, 10),
876370 + 16105 * X1 + 6704 * X3 + 68610 * X6 #= 0 + 62397 * X2 + 43340 * X4 + 95100 * X5 + 58301 * X7,
533909 + 96722 * X5 #= 0 + 51637 * X1 + 67761 * X2 + 95951 * X3 + 3834 * X4 + 59190 * X6 + 15280 * X7,
915683 + 34121 * X2 + 33488 * X7 #= 0 + 1671 * X1 + 10763 * X3 + 80609 * X4 + 42532 * X5 + 93520 * X6,
129768 + 11119 * X2 + 38875 * X4 + 14413 * X5 + 29234 * X6 #= 0 + 71202 * X1 + 73017 * X3 + 72370 * X7,
752447 + 58412 * X2 #= 0 + 8874 * X1 + 73947 * X3 + 17147 * X4 + 62335 * X5 + 16005 * X6 + 8632 * X7,
90614 + 18810 * X3 + 48219 * X4 + 79785 * X7 #= 0 + 85268 * X1 + 54180 * X2 + 6013 * X5 + 78169 * X6,
1198280 + 45086 * X1 + 4578 * X3 #= 0 + 51830 * X2 + 96120 * X4 + 21231 * X5 + 97919 * X6 + 65651 * X7,
18465 + 64919 * X1 + 59624 * X4 + 75542 * X5 + 47935 * X7 #= 0 + 80460 * X2 + 90840 * X3 + 25145 * X6,
0 + 43525 * X2 + 92298 * X3 + 58630 * X4 + 92590 * X5 #= 1503588 + 43277 * X1 + 9372 * X6 + 60227 * X7,
0 + 47385 * X2 + 97715 * X3 + 69028 * X5 + 76212 * X6 #= 1244857 + 16835 * X1 + 12640 * X4 + 81102 * X7,
0 + 31227 * X2 + 93951 * X3 + 73889 * X4 + 81526 * X5 + 68026 * X7 #= 1410723 + 60301 * X1 + 72702 * X6,
0 + 94016 * X1 + 35961 * X3 + 66597 * X4 #= 25334 + 82071 * X2 + 30705 * X5 + 44404 * X6 + 38304 * X7,
0 + 84750 * X2 + 21239 * X4 + 81675 * X5 #= 277271 + 67456 * X1 + 51553 * X3 + 99395 * X6 + 4254 * X7,
0 + 29958 * X2 + 57308 * X3 + 48789 * X4 + 4657 * X6 + 34539 * X7 #= 249912 + 85698 * X1 + 78219 * X5,
0 + 85176 * X1 + 57898 * X4 + 15883 * X5 + 50547 * X6 + 83287 * X7 #= 373854 + 95332 * X2 + 1268 * X3,
0 + 87758 * X2 + 19346 * X4 + 70072 * X5 + 44529 * X7 #= 740061 + 10343 * X1 + 11782 * X3 + 36991 * X6,
0 + 49149 * X1 + 52871 * X2 + 56728 * X4 #= 146074 + 7132 * X3 + 33576 * X5 + 49530 * X6 + 62089 * X7,
0 + 29475 * X2 + 34421 * X3 + 62646 * X5 + 29278 * X6 #= 251591 + 60113 * X1 + 76870 * X4 + 15212 * X7,
22167 + 29101 * X2 + 5513 * X3 + 21219 * X4 #= 0 + 87059 * X1 + 22128 * X5 + 7276 * X6 + 57308 * X7,
821228 + 76706 * X1 + 48614 * X6 + 41906 * X7 #= 0 + 98205 * X2 + 23445 * X3 + 67921 * X4 + 24111 * X5,
lab(Lab, LD).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/Makefile 0000644 0001750 0001750 00000004240 13021324543 016565 0 ustar spa spa GPLC = gplc
GPLCFLAGS= --min-size
BENCH_FD=alpha bridge cars crypta digit8 donald eq10 eq20 five gardner magic\
multipl partit queens send square send srq magsq qg5 langford interval
BENCH_BOOL=bdiag bdonald bpigeon bqueens bramsey bschur bsend
.SUFFIXES:
.SUFFIXES: .pl $(SUFFIXES)
all: fd bool
clean: rm-fd rm-bool
rm -f *.exe
fd: $(BENCH_FD)
rm-fd:
rm -f $(BENCH_FD)
alpha: alpha.pl
$(GPLC) $(GPLCFLAGS) -o alpha alpha.pl
bridge: bridge.pl
$(GPLC) $(GPLCFLAGS) -o bridge bridge.pl
cars: cars.pl
$(GPLC) $(GPLCFLAGS) -o cars cars.pl
crypta: crypta.pl
$(GPLC) $(GPLCFLAGS) -o crypta crypta.pl
digit8: digit8.pl
$(GPLC) $(GPLCFLAGS) -o digit8 digit8.pl
donald: donald.pl
$(GPLC) $(GPLCFLAGS) -o donald donald.pl
eq10: eq10.pl
$(GPLC) $(GPLCFLAGS) -o eq10 eq10.pl
eq20: eq20.pl
$(GPLC) $(GPLCFLAGS) -o eq20 eq20.pl
five: five.pl
$(GPLC) $(GPLCFLAGS) -o five five.pl
gardner: gardner.pl
$(GPLC) $(GPLCFLAGS) -o gardner gardner.pl
partit: partit.pl
$(GPLC) $(GPLCFLAGS) -o partit partit.pl
magic: magic.pl
$(GPLC) $(GPLCFLAGS) -o magic magic.pl
multipl: multipl.pl
$(GPLC) $(GPLCFLAGS) -o multipl multipl.pl
queens: queens.pl queens_fd.fd
$(GPLC) $(GPLCFLAGS) -o queens queens.pl queens_fd.fd
send: send.pl
$(GPLC) $(GPLCFLAGS) -o send send.pl
square: square.pl
$(GPLC) $(GPLCFLAGS) -o square square.pl
srq: srq.pl
$(GPLC) $(GPLCFLAGS) -o srq srq.pl
magsq: magsq.pl
$(GPLC) $(GPLCFLAGS) -o magsq magsq.pl
qg5: qg5.pl
$(GPLC) $(GPLCFLAGS) -o qg5 qg5.pl
langford: langford.pl
$(GPLC) $(GPLCFLAGS) -o langford langford.pl
interval: interval.pl
$(GPLC) $(GPLCFLAGS) -o interval interval.pl
bool: $(BENCH_BOOL)
rm-bool:
rm -f $(BENCH_BOOL)
bdiag: bdiag.pl array.pl
$(GPLC) $(GPLCFLAGS) -o bdiag bdiag.pl
bdonald: bdonald.pl array.pl
$(GPLC) $(GPLCFLAGS) -o bdonald bdonald.pl
bpigeon: bpigeon.pl array.pl
$(GPLC) $(GPLCFLAGS) -o bpigeon bpigeon.pl
bqueens: bqueens.pl array.pl
$(GPLC) $(GPLCFLAGS) -o bqueens bqueens.pl
bramsey: bramsey.pl array.pl
$(GPLC) $(GPLCFLAGS) -o bramsey bramsey.pl
bschur: bschur.pl array.pl
$(GPLC) $(GPLCFLAGS) -o bschur bschur.pl
bsend: bsend.pl array.pl
$(GPLC) $(GPLCFLAGS) -o bsend bsend.pl
gprolog-1.4.5/examples/ExamplesFD/alpha.pl 0000644 0001750 0001750 00000006145 13021324543 016555 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : alpha.pl */
/* Title : alphacipher */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : January 1993 */
/* */
/* This problem comes from the news group rec.puzzle. */
/* The numbers 1 - 26 have been randomly assigned to the letters of the */
/* alphabet. The numbers beside each word are the total of the values */
/* assigned to the letters in the word. e.g for LYRE L,Y,R,E might equal */
/* 5,9,20 and 13 respectively or any other combination that add up to 47. */
/* Find the value of each letter under the equations: */
/* */
/* BALLET 45 GLEE 66 POLKA 59 SONG 61 */
/* CELLO 43 JAZZ 58 QUARTET 50 SOPRANO 82 */
/* CONCERT 74 LYRE 47 SAXOPHONE 134 THEME 72 */
/* FLUTE 30 OBOE 53 SCALE 51 VIOLIN 100 */
/* FUGUE 50 OPERA 65 SOLO 37 WALTZ 34 */
/* */
/* Solution: */
/* [A, B,C, D, E,F, G, H, I, J, K,L,M, N, O, P,Q, R, S,T,U, V,W, X, Y, Z] */
/* [5,13,9,16,20,4,24,21,25,17,23,2,8,12,10,19,7,11,15,3,1,26,6,22,14,18] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
alpha(LD, Lab),
statistics(runtime, [_, Y]),
write(LD),
nl,
write('time : '),
write(Y),
nl.
alpha(LD, Lab) :-
fd_set_vector_max(26),
LD = [A, B, C, _D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z],
fd_all_different(LD),
fd_domain(LD, 1, 26),
B + A + L + L + E + T #= 45,
C + E + L + L + O #= 43,
C + O + N + C + E + R + T #= 74,
F + L + U + T + E #= 30,
F + U + G + U + E #= 50,
G + L + E + E #= 66,
J + A + Z + Z #= 58,
L + Y + R + E #= 47,
O + B + O + E #= 53,
O + P + E + R + A #= 65,
P + O + L + K + A #= 59,
Q + U + A + R + T + E + T #= 50,
S + A + X + O + P + H + O + N + E #= 134,
S + C + A + L + E #= 51,
S + O + L + O #= 37,
S + O + N + G #= 61,
S + O + P + R + A + N + O #= 82,
T + H + E + M + E #= 72,
V + I + O + L + I + N #= 100,
W + A + L + T + Z #= 34,
lab(Lab, LD).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/bramsey.pl 0000644 0001750 0001750 00000010754 13021324543 017133 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Boolean) */
/* */
/* Name : bramsey.pl */
/* Title : ramsey problem */
/* Original Source: Daniel Diaz - INRIA France */
/* Greg Sidebottom - University of Vancouver Canada */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1993 */
/* */
/* Find a 3-colouring of a complete graph with N vertices such that there */
/* is no monochrome triangles. */
/* */
/* The graph is a half-matrix of edges. Example N=5: */
/* Graph=m(v(e12), */
/* v(e13, e23), */
/* v(e14, e24, e34), */
/* v(e15, e25, e35, e45)) an edge eij is 3 colors [C3,C2,C1] */
/* (resolution by line) */
/* */
/* There is a solution up to N=16, none for N>=17. */
/* Solution: */
/* N=5 */
/* m(v([0,0,1]), */
/* v([0,1,0],[0,0,1]), */
/* v([0,1,0],[0,0,1],[1,0,0]), */
/* v([1,0,0],[0,0,1],[0,1,0],[0,1,0])) */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
ramsey(N, Graph),
statistics(runtime, [_, Y]),
write(Graph),
nl,
write('time : '),
write(Y),
nl.
ramsey(N, Mat) :-
adj(N, Mat),
triangles(N, Mat, Tris),
label(Tris).
triangles(N, Mat, Ts) :-
trianglesI(0, N, Mat, Ts, []).
trianglesI(I1, N, Mat, Ts1, Ts) :-
I1 < N, !,
I is I1 + 1,
trianglesJI(I, I, N, Mat, Ts1, Ts2),
trianglesI(I, N, Mat, Ts2, Ts).
trianglesI(N, N, _Mat, Ts, Ts).
trianglesJI(J1, I, N, Mat, Ts1, Ts) :-
J1 < N, !,
J is J1 + 1,
trianglesKJI(J, J, I, N, Mat, Ts1, Ts2),
trianglesJI(J, I, N, Mat, Ts2, Ts).
trianglesJI(N, _I, N, _Mat, Ts, Ts).
trianglesKJI(K1, J, I, N, Mat, [EIJ, EJK, EKI|Ts1], Ts) :-
K1 < N, !,
K is K1 + 1,
edge(I, J, Mat, EIJ),
edge(J, K, Mat, EJK),
edge(I, K, Mat, EKI),
polychrom(EIJ, EJK, EKI),
trianglesKJI(K, J, I, N, Mat, Ts1, Ts).
trianglesKJI(N, _J, _I, N, _Mat, Ts, Ts).
polychrom([C13, C12, C11], [C23, C22, C21], [C33, C32, C31]) :-
#\ (C13 #/\ C23 #/\ C33),
#\ (C12 #/\ C22 #/\ C32),
#\ (C11 #/\ C21 #/\ C31).
% these interface to the tmat routines, the essentially map the matrix
% so the diagonal can be used
adj(N, Mat) :-
N1 is N - 1,
tmat(N1, Mat).
% edge must be called with I < J
% could make more general so it swaps arguments if I > J
edge(I, J, Mat, EIJ) :-
J1 is J - 1,
tmatRef(J1, I, Mat, EIJ),
( var(EIJ) ->
cstr_edge(EIJ)
; true
).
tmat(N, Mat) :-
functor(Mat, m, N),
tvecs(N, Mat).
tvecs(0, _Mat) :-
!.
tvecs(J, Mat) :-
arg(J, Mat, Vec),
functor(Vec, v, J),
J1 is J - 1,
tvecs(J1, Mat).
% tmatRef must be called with I > J
% could make more general so it swaps arguments if I < J
tmatRef(I, J, Mat, MatIJ) :-
arg(I, Mat, MatI),
arg(J, MatI, MatIJ).
label([]).
label([A, B, C|L]) :-
labeltri(A, B, C),
label(L).
labeltri(A, B, C) :-
same_edge(A, B),
fd_labeling(A),
fd_labeling(C).
labeltri(A, B, C) :-
same_edge(A, C),
fd_labeling(A),
fd_labeling(B).
labeltri(A, B, C) :-
same_edge(B, C),
fd_labeling(B),
fd_labeling(A).
labeltri(A, B, C) :-
fd_labeling(C),
diff_edge(A, C),
diff_edge(B, C),
fd_labeling(B),
diff_edge(A, B).
same_edge(Edge, Edge).
diff_edge([C13, C12, C11], [C23, C22, C21]) :-
#\ (C13 #/\ C23),
#\ (C12 #/\ C22),
#\ (C11 #/\ C21).
cstr_edge(E) :-
E = [_, _, _],
fd_only_one(E).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/queens.pl 0000644 0001750 0001750 00000004315 13021324543 016765 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : queens.pl */
/* Title : N-queens problem */
/* Original Source: P. Van Hentenryck's book */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : January 1993 */
/* */
/* Put N queens on an NxN chessboard so that there is no couple of queens */
/* threatening each other. */
/* */
/* Solution: */
/* N=4 [2,4,1,3] */
/* N=8 [1,5,8,6,3,7,2,4] */
/* N=16 [1,3,5,2,13,9,14,12,15,6,16,7,4,11,8,10] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
write('N ?'),
read_integer(N),
statistics(runtime, _),
queens(N, L, Lab),
statistics(runtime, [_, Y]),
write(L),
nl,
write('time : '),
write(Y),
nl.
queens(N, L, Lab) :-
fd_set_vector_max(N),
length(L, N),
fd_domain(L, 1, N),
safe(L),
lab(Lab, L).
safe([]).
safe([X|L]) :-
noattack(L, X, 1),
safe(L).
noattack([], _, _).
noattack([Y|L],X,I):-
I1 is I+1,
noattack(L,X,I1),
diff(X,Y,I).
/*
% slower version (term. rec) (original PVH's version)
noattack([Y|L], X, I) :-
diff(X, Y, I),
I1 is I + 1,
noattack(L, X, I1).
*/
diff(X, Y, I) :-
fd_tell(diff(X, Y, I)).
/*
diff(X,Y,I):-
X#\=Y,
X#\=Y+I,
X+I#\=Y.
*/
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/magsq.pl 0000644 0001750 0001750 00000005047 13021324543 016600 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : magsq.pl */
/* Title : Magic square problem */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : July 1998 */
/* */
/* Fill square NxN with integers 1,2...N*N so that each line, each column */
/* and each diagonal has the same sum. */
/* threatening each other. */
/* */
/* Solution: */
/* N=3 [[4,9,2],[3,5,7],[8,1,6]] */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
magsq(N, A),
statistics(runtime, [_, Y]),
write(A),
nl,
write_array(A, '%5d', 0),
write('time : '),
write(Y),
nl.
magsq(N, A) :-
create_array(N, N, A),
N2 is N * N,
fd_set_vector_max(N2),
S is N * (N2 + 1) // 2,
g_assign(s, S),
g_assign(n, N),
g_assign(n2, N2),
array_values(A, Values),
fd_all_different(Values),
for_each_line(A, dom),
for_each_line(A, sum),
for_each_column(A, sum),
for_each_big_diagonal(A, N, sum),
array_elem(A, 1, 1, X11),
array_elem(A, 1, N, X1N),
array_elem(A, N, 1, XN1),
array_elem(A, N, N, XNN),
X11 #< X1N, % 4 symmetry breaking constraints
X11 #< XN1,
X11 #< XNN,
XN1 #> X1N,
for_each_big_diagonal(A, N, lab),
% for_each_line(A,lab).
fd_labeling(Values, [variable_method(ff), value_method(max)]).
% in practice this random is better than max
% fd_labeling(Values, [variable_method(ff), value_method(random)]).
array_prog(dom, L) :-
g_read(n2, N2),
fd_domain(L, 1, N2).
array_prog(sum, L) :-
g_read(s, S),
sum(L, S).
array_prog(lab, L) :-
fd_labeling(L, [value_method(middle)]).
/*
reorder(L,L1):-
g_read(n,N),
fd_domain(X,1,N),
findall(V,(fd_labeling(X,[value_method(middle)]),nth(X,L,V)),L1).
*/
sum([], 0).
sum([X|Xs], S) :-
S #= X + S1,
sum(Xs, S1).
:- include(array).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/langford.pl 0000644 0001750 0001750 00000006523 13021324543 017264 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : langford.pl */
/* Title : Langford's problem */
/* Original Source: Daniel Diaz */
/* Date : February 2003 */
/* */
/* The problem L(K,N) is to arrange K sets of numbers 1 to N, so that each */
/* appearance of the number M is M numbers on from the last. We here solve */
/* L(2,N). The problem admits a solution if N is of the form 4k or 4k-1. */
/* */
/* Solution: */
/* N=4 [2,3,4,2,1,3,1,4] */
/* N=8 [1,5,1,6,4,7,8,5,3,4,6,2,3,7,2,8] */
/* N=11 [5,1,2,1,9,2,5,8,10,11,4,6,7,3,9,4,8,3,6,10,7,11] */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
langford(N, L),
statistics(runtime, [_, Y]),
write(L),
nl,
write('time : '),
write(Y),
nl.
/*
* Find an assignment of [X1, X2, ..., Xn] (Xi is the position of the first occurrence of i).
* For each Xi the constraints are:
*
* Xi in 1..(N+N-1-i)
* if each pair Xi, Xj (i < j) the following holds:
* Xj != Xi
* Xj != Xi + i + 1
* Xj != Xi - j - 1
* Xj != Xi + i - j
*
* This can be achieved using #=# in set_cstr (but slower at the end)
*
* Here we keep the list of positions Ui (resp. Vi) is the position of the first (resp. second) occurrence of i
* It is possible to only keep one list (i.e. Ui) but seems slower (see file LANGFORD.pl)
*/
langford(N, LD) :-
( N mod 4 =:= 0
; N mod 4 =:= 3
), !,
length(U, N),
length(V, N),
append(U, V, L),
N2 is N * 2,
fd_set_vector_max(N2),
fd_domain(L, 1, N2),
fd_all_different(L),
set_cstr(U, V, 1),
symetric(N, N2, L),
% fd_labeling(U, [variable_method(random), value_method(random)]), % sometimes much better
fd_labeling(U, [variable_method(ff), value_method(max)]),
decode(U, N2, LD).
/*
* Find an assignment of [X1, X2, ..., Xn] (Xi is the position of the first occurrence of i).
* For each Xi the constraints are:
*
* Xi in 1..(N+N-1-i)
* if each pair Xi, Xj (i < j) the following holds:
* Xi != Xj
* Xj != Xi + i + 1
* Xi != Xj + j + 1
* Xi + i + 1 != Xj + j + 1
*
* This can be achieved using #=# in set_cstr (but slower at the end)
*/
set_cstr([], [], _).
set_cstr([X|U], [Y|V], I) :-
I1 is I + 1,
Y #= X + I1, % also avoid some symetries since enforces X < Y
% Y #=# X + I1, % better pruning but slower for big values
set_cstr(U, V, I1).
symetric(N, N2, UV) :-
fd_element_var(I1, UV, 1),
fd_element_var(I2, UV, N2),
I1 #=< I2 - N.
decode(L, N2, LD) :-
length(LD, N2),
decode1(L, 1, LD).
decode1([], _, _).
decode1([X|L], I, LD) :-
nth(X, LD, I),
Y is X + I + 1,
nth(Y, LD, I),
I1 is I + 1,
decode1(L, I1, LD).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/gardner.pl 0000644 0001750 0001750 00000011231 13021324543 017102 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : gardner.pl */
/* Title : Gardner's prime puzzle problem */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : February 1997 - modified May 2007 */
/* */
/* Solve the operation: */
/* */
/* mP where tP is a string of t prime digits (2,3,5 or 7) */
/* x nP */
/* -------- */
/* = (m+n)P */
/* */
/* Solution: */
/* */
/* M=1 N=1 */
/* [5,5,25] */
/* [5,7,35] */
/* [7,5,35] */
/* */
/* M=4 N=3 */
/* [3235,735,2377725] */
/* [3323,775,2575325] */
/* [3535,773,2732555] */
/* [3553,775,2753575] */
/* [3555,725,2577375] */
/* [3575,777,2777775] */
/* [3735,733,2737755] */
/* [3755,725,2722375] */
/* [5225,527,2753575] */
/* [7225,727,5252575] */
/* [7253,325,2357225] */
/* [7255,355,2575525] */
/* [7273,375,2727375] */
/* [7275,733,5332575] */
/* [7325,373,2732225] */
/* [7325,727,5325275] */
/* [7335,753,5523255] */
/* [7353,375,2757375] */
/* [7355,725,5332375] */
/* [7375,753,5553375] */
/* [7533,335,2523555] */
/* [7575,337,2552775] */
/* [7735,333,2575755] */
/* [7757,355,2753735] */
/* [7777,325,2527525] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
write('M ?'),
read_integer(M),
write('N ?'),
read_integer(N),
statistics(runtime, _),
( gardner(M, N, L, Lab),
write(L),
nl,
fail
; true
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
gardner(M, N, L, Lab) :-
MN is M + N,
length(LX, M),
length(LY, N),
length(LZ, MN),
nb(LX, X),
nb(LY, Y),
nb(LZ, Z),
X * Y #= Z,
L = [X, Y, Z],
append(LX, LY, LXY),
append(LXY, LZ, LXYZ),
lab(Lab, LXYZ).
nb(LX, X) :-
fd_domain(LX, [2, 3, 5, 7]),
nb(LX, 0, X).
nb([], N, N).
nb([X|L], I, N) :-
I1 #= X + I * 10,
nb(L, I1, N).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/cars.pl 0000644 0001750 0001750 00000012262 13021324543 016415 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : cars.pl */
/* Title : car sequencing problem */
/* Original Source: Dincbas, Simonis and Van Hentenryck */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1992 */
/* */
/* Car sequencing problem with 10 cars */
/* Solution: */
/* [1,2,6,3,5,4,4,5,3,6] */
/* [1,3,6,2,5,4,3,5,4,6] */
/* [1,3,6,2,6,4,5,3,4,5] */
/* [5,4,3,5,4,6,2,6,3,1] */
/* [6,3,5,4,4,5,3,6,2,1] */
/* [6,4,5,3,4,5,2,6,3,1] */
/* */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
( cars(L, Lab),
write(L),
nl,
fail
; true
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
cars(X, Lab) :-
fd_set_vector_max(6),
X = [X1, X2, X3, X4, X5, X6, X7, X8, X9, X10],
Y = [O11, O12, O13, O14, O15, O21, O22, O23, O24, O25, O31, O32, O33, O34, O35, O41, O42, O43, O44, O45, O51, O52, O53, O54, O55, O61, O62, O63, O64, O65, O71, O72, O73, O74, O75, O81, O82, O83, O84, O85, O91, O92, O93, O94, O95, O101, O102, O103, O104, O105],
L1 = [1, 0, 0, 0, 1, 1],
L2 = [0, 0, 1, 1, 0, 1],
L3 = [1, 0, 0, 0, 1, 0],
L4 = [1, 1, 0, 1, 0, 0],
L5 = [0, 0, 1, 0, 0, 0],
fd_domain(Y, 0, 1),
fd_domain(X, 1, 6),
fd_atmost(1, X, 1),
fd_atmost(1, X, 2),
fd_atmost(2, X, 3),
fd_atmost(2, X, 4),
fd_atmost(2, X, 5),
fd_atmost(2, X, 6),
fd_element(X1, L1, O11),
fd_element(X1, L2, O12),
fd_element(X1, L3, O13),
fd_element(X1, L4, O14),
fd_element(X1, L5, O15),
fd_element(X2, L1, O21),
fd_element(X2, L2, O22),
fd_element(X2, L3, O23),
fd_element(X2, L4, O24),
fd_element(X2, L5, O25),
fd_element(X3, L1, O31),
fd_element(X3, L2, O32),
fd_element(X3, L3, O33),
fd_element(X3, L4, O34),
fd_element(X3, L5, O35),
fd_element(X4, L1, O41),
fd_element(X4, L2, O42),
fd_element(X4, L3, O43),
fd_element(X4, L4, O44),
fd_element(X4, L5, O45),
fd_element(X5, L1, O51),
fd_element(X5, L2, O52),
fd_element(X5, L3, O53),
fd_element(X5, L4, O54),
fd_element(X5, L5, O55),
fd_element(X6, L1, O61),
fd_element(X6, L2, O62),
fd_element(X6, L3, O63),
fd_element(X6, L4, O64),
fd_element(X6, L5, O65),
fd_element(X7, L1, O71),
fd_element(X7, L2, O72),
fd_element(X7, L3, O73),
fd_element(X7, L4, O74),
fd_element(X7, L5, O75),
fd_element(X8, L1, O81),
fd_element(X8, L2, O82),
fd_element(X8, L3, O83),
fd_element(X8, L4, O84),
fd_element(X8, L5, O85),
fd_element(X9, L1, O91),
fd_element(X9, L2, O92),
fd_element(X9, L3, O93),
fd_element(X9, L4, O94),
fd_element(X9, L5, O95),
fd_element(X10, L1, O101),
fd_element(X10, L2, O102),
fd_element(X10, L3, O103),
fd_element(X10, L4, O104),
fd_element(X10, L5, O105),
1 #>= O11 + O21,
1 #>= O21 + O31,
1 #>= O31 + O41,
1 #>= O41 + O51,
1 #>= O51 + O61,
1 #>= O61 + O71,
1 #>= O71 + O81,
1 #>= O81 + O91,
1 #>= O91 + O101,
2 #>= O12 + O22 + O32,
2 #>= O22 + O32 + O42,
2 #>= O32 + O42 + O52,
2 #>= O42 + O52 + O62,
2 #>= O52 + O62 + O72,
2 #>= O62 + O72 + O82,
2 #>= O72 + O82 + O92,
2 #>= O82 + O92 + O102,
1 #>= O13 + O23 + O33,
1 #>= O23 + O33 + O43,
1 #>= O33 + O43 + O53,
1 #>= O43 + O53 + O63,
1 #>= O53 + O63 + O73,
1 #>= O63 + O73 + O83,
1 #>= O73 + O83 + O93,
1 #>= O83 + O93 + O103,
2 #>= O14 + O24 + O34 + O44 + O54,
2 #>= O24 + O34 + O44 + O54 + O64,
2 #>= O34 + O44 + O54 + O64 + O74,
2 #>= O44 + O54 + O64 + O74 + O84,
2 #>= O54 + O64 + O74 + O84 + O94,
2 #>= O64 + O74 + O84 + O94 + O104,
1 #>= O15 + O25 + O35 + O45 + O55,
1 #>= O25 + O35 + O45 + O55 + O65,
1 #>= O35 + O45 + O55 + O65 + O75,
1 #>= O45 + O55 + O65 + O75 + O85,
1 #>= O55 + O65 + O75 + O85 + O95,
1 #>= O65 + O75 + O85 + O95 + O105,
% redundant constraints
O11 + O21 + O31 + O41 + O51 + O61 + O71 + O81 #>= 4,
O11 + O21 + O31 + O41 + O51 + O61 #>= 3,
O11 + O21 + O31 + O41 #>= 2,
O11 + O21 #>= 1,
O12 + O22 + O32 + O42 + O52 + O62 + O72 #>= 4,
O12 + O22 + O32 + O42 #>= 2,
O12 #>= 0,
O13 + O23 + O33 + O43 + O53 + O63 + O73 #>= 2,
O13 + O23 + O33 + O43 #>= 1,
O13 #>= 0,
O14 + O24 + O34 + O44 + O54 #>= 2,
O15 + O25 + O35 + O45 + O55 #>= 1,
lab(Lab, X).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/array.pl 0000644 0001750 0001750 00000010566 13021324543 016610 0 ustar spa spa /* Array procedures */
/*---------------------------------------------------------*
* An array NL x NC elements is represented as follows : *
* A = [L_1, ..., L_NL] with L_i = [X_i_1, ..., X_i_NC] *
* Hence : *
* A = [ [X_1_1,..., X_1_NC], ..., [X_NL_1,..., X_NL_NC] ] *
*---------------------------------------------------------*/
% create_array(+NL, +NC, ?A): creates an array (with unbound variables)
% NL: nb of lines NC:nb of columns A:array
create_array(NL, NC, A) :-
create_array1(0, NL, NC, A), !.
create_array1(NL, NL, _, []).
create_array1(I, NL, NC, [L|A]) :-
create_one_line(0, NC, L),
I1 is I + 1,
create_array1(I1, NL, NC, A).
create_one_line(NC, NC, []).
create_one_line(J, NC, [_|L]) :-
J1 is J + 1,
create_one_line(J1, NC, L).
% array_elem(+A, +I, +J, ?X): returns an element
% A:array I: line no J: column no X: the element
array_elem(A, I, J, X) :-
nth1(I, A, L),
nth1(J, L, X).
% array_values(+A, ?Values): returns all elements
% A: array Values: list of elements
array_values([], []).
array_values([L|A], Values) :-
array_values(A, V),
append(L, V, Values).
% array_line(+A, +I, ?C): returns the Ith line
% A:array I: line no L: the line
array_line(A, I, L) :-
nth1(I, A, L).
% array_column(+A, +J, ?C): returns the Jth column
% A:array J: column no C: the column
array_column([], _, []).
array_column([L|A], J, [X|C]) :-
nth1(J, L, X),
array_column(A, J, C).
% for_each_line(+A, +P): invokes a user procedure for each line
% A:array P: program term
% calls: array_prog(P, L) for each line L (L is a list)
for_each_line([], _).
for_each_line([L|A], P) :-
array_prog(P, L),
for_each_line(A, P).
% for_each_column(+A, +P): invokes a user procedure for each column
% A:array P: program term
% calls: array_prog(P, L) for each column L (L is a list)
for_each_column([[]|_], _) :-
!.
for_each_column(A, P) :-
create_column(A, C, A1),
array_prog(P, C),
for_each_column(A1, P).
create_column([], [], []).
create_column([[X|L]|A], [X|C], [L|A1]) :-
create_column(A, C, A1).
% for_each_diagonal(+A, +NL, +NC, +P): invokes a user procedure for each diagonal
% A:array NL: nb of lines
% NC:nb of columns P: program term
% calls: array_prog(P, D) for each diagonal D (D is a list)
for_each_diagonal(A, NL, NC, P) :-
NbDiag is 2 * (NL + NC - 1), % numbered from 0 to NbDiag-1
create_lst_diagonal(0, NbDiag, LD),
fill_lst_diagonal(A, 0, NL, NC, LD, LD1), !,
for_each_line(LD1, P).
create_lst_diagonal(NbDiag, NbDiag, []).
create_lst_diagonal(I, NbDiag, [[]|LD]) :-
I1 is I + 1,
create_lst_diagonal(I1, NbDiag, LD).
fill_lst_diagonal([], _, _, _, LD, LD).
fill_lst_diagonal([L|A], I, NL, NC, LD, LD2) :-
I1 is I + 1,
fill_lst_diagonal(A, I1, NL, NC, LD, LD1),
one_list(L, I, NL, 0, NC, LD1, LD2).
one_list([], _, _, _, _, LD, LD).
one_list([X|L], I, NL, J, NC, LD, LD3) :-
J1 is J + 1,
one_list(L, I, NL, J1, NC, LD, LD1),
NoDiag1 is I + J,
NoDiag2 is I + NC - J + NL + NC - 2,
add_in_lst_diagonal(0, NoDiag1, X, LD1, LD2),
add_in_lst_diagonal(0, NoDiag2, X, LD2, LD3).
add_in_lst_diagonal(NoDiag, NoDiag, X, [D|LD], [[X|D]|LD]).
add_in_lst_diagonal(K, NoDiag, X, [D|LD], [D|LD1]) :-
K1 is K + 1,
add_in_lst_diagonal(K1, NoDiag, X, LD, LD1).
% for_each_big_diagonal(+A, +N, +P): invokes a user procedure for each major diagonal
% A:array N: nb of lines/columns (must be a square)
% P: program term
% calls: array_prog(P, D) for each diagonal D (D is a list)
for_each_big_diagonal(A, N, P) :-
big_diags(A, 0, N, D1, D2),
array_prog(P, D1),
array_prog(P, D2).
big_diags([], _, _, [], []).
big_diags([L|A], I, J, [X|D1], [Y|D2]) :-
I1 is I + 1,
J1 is J - 1,
nth1(I1, L, X),
nth1(J, L, Y),
big_diags(A, I1, J1, D1, D2).
% write_array(+A, +Format, +Sep): writes an array
% A:array Format: format for element writing
% Sep: nb of spaces between 2 elements of a line
write_array([], _, _).
write_array([L|A], Format, Sep) :-
write_array_line(L, Format, Sep),
nl,
write_array(A, Format, Sep).
write_array_line([], _, _).
write_array_line([X|L], Format, Sep) :-
format(Format, [X]),
tab(Sep),
write_array_line(L, Format, Sep).
% array_labeling(+A): call fd_labeling line by line
% A:array
array_labeling([]).
array_labeling([L|A]) :-
fd_labeling(L),
array_labeling(A).
gprolog-1.4.5/examples/ExamplesFD/digit8.pl 0000644 0001750 0001750 00000004171 13021324543 016655 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : digit8.pl */
/* Title : particular 8 digit number */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : October 1993 */
/* */
/* Find the 8 digit number N such that: */
/* */
/* - N is a square */
/* - if we put a 1 in front of the decimal notation of N then it is */
/* still a square */
/* */
/* Solution: */
/* [N,X,M,Y] */
/* [23765625,4875,123765625,11125] */
/* [56250000,7500,156250000,12500] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
( digit8(L, Lab),
write(L),
nl,
fail
; write('No more solutions'),
nl
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
digit8(L, Lab) :-
L = [N, X, M, Y],
N #>= 10000000,
N #=< 99999999,
X ** 2 #= N,
100000000 + N #= M,
Y ** 2 #= M,
lab(Lab, L).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/magic.pl 0000644 0001750 0001750 00000006620 13021324543 016546 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : magic.pl */
/* Title : magic series */
/* Original Source: W.J. Older and F. Benhamou - Programming in CLP(BNR) */
/* (in Position Papers of PPCP'93) */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : May 1993 */
/* */
/* A magic serie is a sequence x0, x1, ..., xN-1 such that each xi is the */
/* number of occurences of i in the serie. */
/* N-1 */
/* ie xi = Sum (xj=i) where (xj=i) is 1 if x=y and 0 if x<>y */
/* i=0 */
/* */
/* two redundant constraints are used: */
/* N-1 N-1 */
/* Sum i = N and Sum i*xi = N */
/* i=0 i=0 */
/* */
/* Note: in the Pascal's original version the length of a magic serie is */
/* N+1 (x0, x1, ..., XN) instead of N (x0, x1, ..., xN-1). Finding such a */
/* serie (for N) only corresponds to find a serie for N+1 in this version. */
/* Also the original version only used one redundant constraint. */
/* */
/* Solution: */
/* N=1,2,3 and 6 none */
/* N=4 [1,2,1,0] and [2,0,2,0] */
/* N=5 [2,1,2,0,0] */
/* N=7 [3,2,1,1,0,0,0] (for N>=7 [N-4,2,1,,1,0,0,0]) */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
write('N ?'),
read_integer(N),
statistics(runtime, _),
magic(N, L, Lab),
statistics(runtime, [_, Y]),
write(L),
nl,
write('time : '),
write(Y),
nl.
magic(N, L, Lab) :-
fd_set_vector_max(N),
length(L, N),
fd_domain(L, 0, N),
constraints(L, L, 0, N, N),
lab(Lab, L).
constraints([], _, _, 0, 0).
constraints([X|Xs], L, I, S, S2) :-
sum(L, I, X),
I1 is I + 1,
S1 + X #= S, % redundant constraint 1
( I = 0 ->
S3 = S2
; I * X + S3 #= S2
), % redundant constraint 2
constraints(Xs, L, I1, S1, S3).
sum([], _, 0).
sum([X|Xs], I, S) :-
sum(Xs, I, S1),
X #= I #<=> B,
S #= B + S1.
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/.gitignore 0000644 0001750 0001750 00000000426 13021324543 017117 0 ustar spa spa TO_DO
BENCHING
RES_C*
COMPARE_BENCH*
BENCH_NAMES*
LANGFORD.PL
SUDOKU.PL
GOLOMB.PL
CHECK.sh
alpha
bdiag
bdonald
bpigeon
bqueens
bramsey
bridge
bschur
bsend
cars
crypta
digit8
donald
eq10
eq20
five
gardner
interval
langford
magic
magsq
multipl
partit
qg5
queens
send
square
srq
gprolog-1.4.5/examples/ExamplesFD/bqueens.pl 0000644 0001750 0001750 00000005521 13021324543 017127 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Boolean) */
/* */
/* Name : bqueens.pl */
/* Title : N-queens problem */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : January 1993 */
/* */
/* Put N queens on an NxN chessboard so that there is no couple of queens */
/* threatening each other. */
/* The solution is a list [ [Que11,...,Que1N], ... ,[QueN1,...,QueNN] ] */
/* where Queij is 1 if the the is a queen on the ith line an jth row. */
/* */
/* Solution: */
/* N=4 [[0,0,1,0], [[0,1,0,0], */
/* [1,0,0,0], [0,0,0,1], */
/* [0,0,0,1], and [1,0,0,0], */
/* [0,1,0,0]] [0,0,1,0]] */
/* */
/* N=8 [[0,0,0,0,0,0,0,1], (first solution) */
/* [0,0,0,1,0,0,0,0], */
/* [1,0,0,0,0,0,0,0], */
/* [0,0,1,0,0,0,0,0], */
/* [0,0,0,0,0,1,0,0], */
/* [0,1,0,0,0,0,0,0], */
/* [0,0,0,0,0,0,1,0], */
/* [0,0,0,0,1,0,0,0]] */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
( bqueens(N, A),
write(A),
nl %,
% fail
; write('No more solutions'),
nl
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
bqueens(N, A) :-
create_array(N, N, A),
for_each_line(A, only1),
for_each_column(A, only1),
for_each_diagonal(A, N, N, atmost1), !,
array_labeling(A).
:- include(array).
% interface with for_each_... procedures
array_prog(only1, L) :-
fd_only_one(L).
array_prog(atmost1, L) :-
fd_at_most_one(L).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/donald.pl 0000644 0001750 0001750 00000004646 13021324543 016735 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : donald.pl */
/* Title : crypt-arithmetic */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1992 */
/* */
/* Solve the operation: */
/* */
/* D O N A L D */
/* + G E R A L D */
/* -------------- */
/* = R O B E R T */
/* */
/* (resolution by line) */
/* */
/* Solution: */
/* [D,O,N,A,L,G,E,R,B,T] */
/* [5,2,6,4,8,1,9,7,3,0] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
donald(LD, Lab),
statistics(runtime, [_, Y]),
write(LD),
nl,
write('time : '),
write(Y),
nl.
donald(LD, Lab) :-
fd_set_vector_max(9),
LD = [D, O, N, A, L, G, E, R, B, T],
fd_all_different(LD),
fd_domain(LD, 0, 9),
fd_domain([D, G], 1, 9),
100000 * D + 10000 * O + 1000 * N + 100 * A + 10 * L + D + 100000 * G + 10000 * E + 1000 * R + 100 * A + 10 * L + D #= 100000 * R + 10000 * O + 1000 * B + 100 * E + 10 * R + T,
lab(Lab, LD).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/interval.pl 0000644 0001750 0001750 00000005006 13021324543 017307 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : all-interval.pl */
/* Title : all-interval series problem */
/* Original Source: */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : May 2009 */
/* */
/* Find sequence of N different values in 0 .. N-1 such that the distance */
/* between 2 consecutive values are all distinct. */
/* */
/* NB: there is an obvious solution: 0 N-1 1 N-2 N N-3 */
/* this solution is found without backtracking with a labeling on distances*/
/* enumerating variables from their max to the min (see labeling on LD) */
/* For other solutions, remove this labeling. */
/* */
/* Solution: */
/* N=8 [1,7,0,5,2,6,4,3] */
/* N=14 [1,13,0,11,2,12,4,10,3,8,5,9,7,6] */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
statistics(runtime, _),
interval(N, L),
statistics(runtime, [_, Y]),
write(L),
nl,
write('time : '),
write(Y),
nl.
interval(N, L) :-
N1 is N - 1,
fd_set_vector_max(N),
length(L, N),
fd_domain(L, 0, N1),
L = [X|L1],
mk_dist(L1, X, LD),
fd_domain(LD, 1, N1),
fd_all_different(L),
fd_all_different(LD),
% avoid mirror symmetry
L = [X, Y|_],
X #< Y,
X #> 0,
% avoid dual solution (symmetry)
LD = [D1|_],
last(LD, D2),
D1 #> D2,
% the labeling of LD speeds up a lot if just the first solution is wanted (else remove it)
fd_labeling(LD, [value_method(max), backtracks(_B)]),
%write(_B), nl,
% the labeling (useless if only the first solution is wanted, labeling of LD is enough)
fd_labeling(L, [variable_method(ff), value_method(middle)]).
mk_dist([], _, []).
mk_dist([Y|L], X, [D|LD]) :-
D #= dist(X, Y),
mk_dist(L, Y, LD).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/bpigeon.pl 0000644 0001750 0001750 00000004357 13021324543 017116 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Boolean) */
/* */
/* Name : bpigeon.pl */
/* Title : pigeon-hole problem */
/* Originated from: */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : January 1993 */
/* */
/* Put N pigeons in M pigeon-holes. Solution iff N<=M. */
/* The solution is a list [ [Pig11,...,Pig1m], ... ,[Pign1,...,Pignm] ] */
/* where Pigij = 1 if the pigeon i is in the pigeon-hole j */
/* */
/* Solution: */
/* N=2 M=3 [[0,0,1],[0,1,0]] */
/* [[0,0,1],[1,0,0]] */
/* [[0,1,0],[0,0,1]] */
/* [[0,1,0],[1,0,0]] */
/* [[1,0,0],[0,0,1]] */
/* [[1,0,0],[0,1,0]] */
/*-------------------------------------------------------------------------*/
q :-
write('N ?'),
read_integer(N),
write('M ?'),
read_integer(M),
statistics(runtime, _),
g_assign(count, 0),
( bpigeon(N, M, _A),
% write(_A), nl,
g_inc(count),
fail
;
g_read(count, Count),
format('Number of solutions ~d~n', [Count])
),
statistics(runtime, [_, Y]),
write('time : '),
write(Y),
nl.
bpigeon(N, M, A) :-
create_array(N, M, A),
for_each_line(A, only1),
for_each_column(A, atmost1), !,
array_labeling(A).
:- include(array).
% interface with for_each_... procedures
array_prog(only1, L) :-
fd_only_one(L).
array_prog(atmost1, L) :-
fd_at_most_one(L).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/eq10.pl 0000644 0001750 0001750 00000005243 13021324543 016234 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : eq10.pl */
/* Title : linear equations */
/* Original Source: Thomson LCR */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1992 */
/* */
/* A system involving 7 variables and 10 equations */
/* */
/* Solution: */
/* [X1,X2,X3,X4,X5,X6,X7] */
/* [ 6, 0, 8, 4, 9, 3, 9] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
eq10(LD, Lab),
statistics(runtime, [_, Y]),
write(LD),
nl,
write('time : '),
write(Y),
nl.
eq10(LD, Lab) :-
LD = [X1, X2, X3, X4, X5, X6, X7],
fd_domain(LD, 0, 10),
0 + 98527 * X1 + 34588 * X2 + 5872 * X3 + 59422 * X5 + 65159 * X7 #= 1547604 + 30704 * X4 + 29649 * X6,
0 + 98957 * X2 + 83634 * X3 + 69966 * X4 + 62038 * X5 + 37164 * X6 + 85413 * X7 #= 1823553 + 93989 * X1,
900032 + 10949 * X1 + 77761 * X2 + 67052 * X5 #= 0 + 80197 * X3 + 61944 * X4 + 92964 * X6 + 44550 * X7,
0 + 73947 * X1 + 84391 * X3 + 81310 * X5 #= 1164380 + 96253 * X2 + 44247 * X4 + 70582 * X6 + 33054 * X7,
0 + 13057 * X3 + 42253 * X4 + 77527 * X5 + 96552 * X7 #= 1185471 + 60152 * X1 + 21103 * X2 + 97932 * X6,
1394152 + 66920 * X1 + 55679 * X4 #= 0 + 64234 * X2 + 65337 * X3 + 45581 * X5 + 67707 * X6 + 98038 * X7,
0 + 68550 * X1 + 27886 * X2 + 31716 * X3 + 73597 * X4 + 38835 * X7 #= 279091 + 88963 * X5 + 76391 * X6,
0 + 76132 * X2 + 71860 * X3 + 22770 * X4 + 68211 * X5 + 78587 * X6 #= 480923 + 48224 * X1 + 82817 * X7,
519878 + 94198 * X2 + 87234 * X3 + 37498 * X4 #= 0 + 71583 * X1 + 25728 * X5 + 25495 * X6 + 70023 * X7,
361921 + 78693 * X1 + 38592 * X5 + 38478 * X6 #= 0 + 94129 * X2 + 43188 * X3 + 82528 * X4 + 69025 * X7,
lab(Lab, LD).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/five.pl 0000644 0001750 0001750 00000005165 13021324543 016422 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : five.pl */
/* Title : five house puzzle */
/* Original Source: P. Van Hentenryck's book */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1992 */
/* */
/* A logic puzzle */
/* */
/* Solution: */
/* [N1,N2,N3,N4,N5, [3,4,5,2,1, */
/* C1,C2,C3,C4,C5, 5,3,1,2,4, */
/* P1,P2,P3,P4,P5, 5,1,4,2,3, */
/* A1,A2,A3,A4,A5, 4,5,1,3,2, */
/* D1,D2,D3,D4,D5] 4,1,2,5,3] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
five_house(L, Lab),
statistics(runtime, [_, Y]),
write(L),
nl,
write('time : '),
write(Y),
nl.
five_house(L, Lab) :-
fd_set_vector_max(5),
L = [N1, N2, N3, N4, N5, C1, C2, C3, C4, C5, P1, P2, P3, P4, P5, A1, A2, A3, A4, A5, D1, D2, D3, D4, D5],
fd_domain(L, 1, 5),
N5 #= 1,
D5 #= 3,
fd_all_different([C1, C2, C3, C4, C5]),
fd_all_different([P1, P2, P3, P4, P5]),
fd_all_different([N1, N2, N3, N4, N5]),
fd_all_different([A1, A2, A3, A4, A5]),
fd_all_different([D1, D2, D3, D4, D5]),
N1 #= C2,
N2 #= A1,
N3 #= P1,
N4 #= D3,
P3 #= D1,
C1 #= D4,
P5 #= A4,
P2 #= C3,
C1 #= C5 + 1,
plus_or_minus(A3, P4, 1),
plus_or_minus(A5, P2, 1),
plus_or_minus(N5, C4, 1),
% lab(Lab,L). % faster than lab(Lab,[C1,...,D5])
lab(Lab, [C1, C2, C3, C4, C5, P1, P2, P3, P4, P5, N1, N2, N3, N4, N5, A1, A2, A3, A4, A5, D1, D2, D3, D4, D5]).
% partial lookahead
plus_or_minus(X, Y, C) :-
X #= Y + C.
plus_or_minus(X, Y, C) :-
X + C #= Y.
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/srq.pl 0000644 0001750 0001750 00000014410 13021324543 016267 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) INRIA Rocquencourt - ChLoE Project */
/* */
/* Name : srq.pl */
/* Title : Self-Referential Quiz puzzle */
/* Original Source: M. Henz */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : February 1997 */
/* */
/* */
/* Q1 : the first question whose answer is A is */
/* (A) 4 (B) 3 (C) 2 (D) 1 (E) none of the above */
/* Q2 : the only two consecutive questions with identical answers are */
/* (A) 3 and 4 (B) 4 and 5 (C) 5 and 6 (D) 6 and 7 (E) 7 and 8*/
/* Q3 : the next question with answer A is */
/* (A) 4 (B) 5 (C) 6 (D) 7 (E) 8 */
/* Q4 : the first even numbered question with answer B is */
/* (A) 2 (B) 4 (C) 6 (D) 8 (E) 10 */
/* Q5 : the only odd numbered question with answer C is */
/* (A) 1 (B) 3 (C) 5 (D) 7 (E) 9 */
/* Q6 : a question with answer D */
/* (A) comes before this one but not after this one */
/* (B) comes after this one but not before this one */
/* (C) comes before and after this one */
/* (D) does not occur at all */
/* (E) none of the above */
/* Q7 : the last question whose answer is E is */
/* (A) 5 (B) 6 (C) 7 (D) 8 (E) 9 */
/* Q8 : the number of questions whose answers are conconants is */
/* (A) 7 (B) 6 (C) 5 (D) 4 (E) 3 */
/* Q9 : the number of questions whose answers are vowels is */
/* (A) 0 (B) 1 (C) 2 (D) 3 (E) 4 */
/* Q10: the answer of this question is */
/* (A) A (B) B (C) C (D) D (E) E */
/* */
/* Solution: */
/* [3,1,2,2,1,2,5,2,5,4] */
/* C,A,B,B,A,B,E,B,E,D */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
srq(L, Lab),
statistics(runtime, [_, Y]),
write(L),
nl,
write('time : '),
write(Y),
nl.
srq(L, Lab) :-
L = [Q1, Q2, Q3, Q4, Q5, Q6, Q7, Q8, Q9, Q10],
fd_domain(L, 1, 5),
Q1 #= 1 #<=> Q4 #= 1 #/\ Q1 #\= 1 #/\ Q2 #\= 1 #/\ Q3 #\= 1,
Q1 #= 2 #<=> Q3 #= 1 #/\ Q1 #\= 1 #/\ Q2 #\= 1,
Q1 #= 3 #<=> Q2 #= 1 #/\ Q1 #\= 1,
Q1 #= 4 #<=> Q1 #= 1,
% Q1#=5 #<=> Q1#\=1 #/\ Q2#\=1 #/\ Q3#\=1 #/\ Q4#\=1,
Q2 #= 1 #<=> Q3 #= Q4,
Q2 #= 2 #<=> Q4 #= Q5,
Q2 #= 3 #<=> Q5 #= Q6,
Q2 #= 4 #<=> Q6 #= Q7,
Q2 #= 5 #<=> Q7 #= Q8,
Q3 #= 1 #<=> Q4 #= 1,
Q3 #= 2 #<=> Q5 #= 1 #/\ Q4 #\= 1,
Q3 #= 3 #<=> Q6 #= 1 #/\ Q4 #\= 1 #/\ Q5 #\= 1,
Q3 #= 4 #<=> Q7 #= 1 #/\ Q4 #\= 1 #/\ Q5 #\= 1 #/\ Q6 #\= 1,
Q3 #= 5 #<=> Q8 #= 1 #/\ Q4 #\= 1 #/\ Q5 #\= 1 #/\ Q6 #\= 1 #/\ Q7 #\= 1,
Q4 #= 1 #<=> Q2 #= 2,
Q4 #= 2 #<=> Q4 #= 2 #/\ Q2 #\= 2,
Q4 #= 3 #<=> Q6 #= 2 #/\ Q2 #\= 2 #/\ Q4 #\= 2,
Q4 #= 4 #<=> Q8 #= 2 #/\ Q2 #\= 2 #/\ Q4 #\= 2 #/\ Q6 #\= 2,
Q4 #= 5 #<=> Q10 #= 2 #/\ Q2 #\= 2 #/\ Q4 #\= 2 #/\ Q6 #\= 2 #/\ Q8 #\= 2,
Q5 #= 1 #<=> Q1 #= 3 #/\ Q3 #\= 3 #/\ Q5 #\= 3 #/\ Q7 #\= 3 #/\ Q9 #\= 3,
Q5 #= 2 #<=> Q3 #= 3 #/\ Q1 #\= 3 #/\ Q5 #\= 3 #/\ Q7 #\= 3 #/\ Q9 #\= 3,
Q5 #= 3 #<=> Q5 #= 3 #/\ Q1 #\= 3 #/\ Q3 #\= 3 #/\ Q7 #\= 3 #/\ Q9 #\= 3,
Q5 #= 4 #<=> Q7 #= 3 #/\ Q1 #\= 3 #/\ Q2 #\= 3 #/\ Q5 #\= 3 #/\ Q9 #\= 3,
Q5 #= 5 #<=> Q9 #= 3 #/\ Q1 #\= 3 #/\ Q3 #\= 3 #/\ Q5 #\= 3 #/\ Q7 #\= 3,
BeforeQ4 #<=> Q1 #= 4 #\/ Q2 #= 4 #\/ Q3 #= 4 #\/ Q4 #= 4 #\/ Q5 #= 4,
AfterQ4 #<=> Q7 #= 4 #\/ Q8 #= 4 #\/ Q9 #= 4 #\/ Q10 #= 4,
Q6 #= 1 #<=> BeforeQ4 #/\ #\ AfterQ4,
Q6 #= 2 #<=> #\ BeforeQ4 #/\ AfterQ4,
Q6 #= 3 #<=> BeforeQ4 #/\ AfterQ4,
Q6 #= 4 #<=> Q1 #\= 4 #/\ Q2 #\= 4 #/\ Q3 #\= 4 #/\ Q4 #\= 4 #/\ Q5 #\= 4 #/\ Q6 #\= 4 #/\ Q7 #\= 4 #/\ Q8 #\= 4 #/\ Q9 #\= 4 #/\ Q10 #\= 4,
% Q6#=5 #<=> Q6#=4,
Q7 #= 1 #<=> Q5 #= 5 #/\ Q6 #\= 5 #/\ Q7 #\= 5 #/\ Q8 #\= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5,
Q7 #= 2 #<=> Q6 #= 5 #/\ Q7 #\= 5 #/\ Q8 #\= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5,
Q7 #= 3 #<=> Q7 #= 5 #/\ Q8 #\= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5,
Q7 #= 4 #<=> Q8 #= 5 #/\ Q9 #\= 5 #/\ Q10 #\= 5,
Q7 #= 5 #<=> Q9 #= 5 #/\ Q10 #\= 5,
BCD1 #<=> Q1 #>= 2 #/\ Q1 #=< 4,
AE1 #<=> #\ BCD1,
BCD2 #<=> Q2 #>= 2 #/\ Q2 #=< 4,
AE2 #<=> #\ BCD2,
BCD3 #<=> Q3 #>= 2 #/\ Q3 #=< 4,
AE3 #<=> #\ BCD3,
BCD4 #<=> Q4 #>= 2 #/\ Q4 #=< 4,
AE4 #<=> #\ BCD4,
BCD5 #<=> Q5 #>= 2 #/\ Q5 #=< 4,
AE5 #<=> #\ BCD5,
BCD6 #<=> Q6 #>= 2 #/\ Q6 #=< 4,
AE6 #<=> #\ BCD6,
BCD7 #<=> Q7 #>= 2 #/\ Q7 #=< 4,
AE7 #<=> #\ BCD7,
BCD8 #<=> Q8 #>= 2 #/\ Q8 #=< 4,
AE8 #<=> #\ BCD8,
BCD9 #<=> Q9 #>= 2 #/\ Q9 #=< 4,
AE9 #<=> #\ BCD9,
BCD10 #<=> Q10 #>= 2 #/\ Q10 #=< 4,
AE10 #<=> #\ BCD10,
BCD #= BCD1 + BCD2 + BCD3 + BCD4 + BCD5 + BCD6 + BCD7 + BCD8 + BCD9 + BCD10,
AE #= AE1 + AE2 + AE3 + AE4 + AE5 + AE6 + AE7 + AE8 + AE9 + AE10,
Q8 #= 1 #<=> BCD #= 7,
Q8 #= 2 #<=> BCD #= 6,
Q8 #= 3 #<=> BCD #= 5,
Q8 #= 4 #<=> BCD #= 4,
Q8 #= 5 #<=> BCD #= 3,
Q9 #= 1 #<=> AE #= 0,
Q9 #= 2 #<=> AE #= 1,
Q9 #= 3 #<=> AE #= 2,
Q9 #= 4 #<=> AE #= 3,
Q9 #= 5 #<=> AE #= 4,
lab(Lab, L).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/bdiag.pl 0000644 0001750 0001750 00000010072 13021324543 016530 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Boolean) */
/* */
/* Name : bdiag.pl */
/* Title : N adder diagnostic */
/* Original Source: Greg Sidebottom - University of Vancouver Canada */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1993 */
/* */
/* The circuit diagnosis problem is as follows: */
/* */
/*Given: */
/* 1. a description of a digital circuit with a set of components C */
/* 2. a function f computed by the circuit */
/* 3. a symptom consisting of an input output pair (i,o) such that */
/* f(i) <> o */
/* Find: */
/* a diagnosis D. D is a subset of C which, if not working correctly, */
/* could result in the circuit computing o given i. */
/* */
/* The specific circuit used for this benchmark is an N bit adder with */
/* forward carry propagation. However, any combinatorial circuit diagnosis*/
/* problem could easily formulated from it's network description. */
/* This example was constructed based on an example from an article about */
/* Prolog III in CACM July 1990. */
/* The problem consists in finding the minimum number of broken components */
/* in a N bit adder that thinks 0+0=2^N-1 (the answer is always N). */
/* Each adder consists of 5 gates (2 'and', 2 'xor' and 1 'or'). */
/* A boolean (Di) is associated to each gate and it is true (1) if the */
/* gate is broken. The solution is a list of Di. F is the number of broken */
/* components. To minimize F we label it (indomain) first (since there is */
/* no choice point it is correct). */
/* */
/* Solution: */
/* N=1 [0,0,0,0,1] */
/* N=2 [0,0,0,0,1,0,0,0,0,1] */
/* N=3 [0,0,0,0,1,0,0,0,0,1,0,0,0,0,1] */
/*-------------------------------------------------------------------------*/
q :-
statistics(runtime, _),
write('N ?'),
read_integer(N),
Z is 1 << N - 1,
bdiag(N, 0, 0, Z, 0, 0, Ds, F),
statistics(runtime, [_, Y]),
write(s(F, Ds)),
nl,
write('time : '),
write(Y),
nl.
bdiag(N, X, Y, Z, C1, C, Ds, F) :-
N5 is N * 5,
F #=< N5,
nadder(N, X, Y, Z, C1, C, Ds),
TN is 1 << N,
X + Y + C1 #\= Z + TN * C,
sum(Ds, F),
fd_minimize(fd_labeling(Ds), F).
% fd_labeling([F|Ds]).
sum([], 0).
sum([X|Xs], S) :-
S #= X + S1,
sum(Xs, S1).
nadder(N, X, Y, Z, C1, C, Ds) :-
bits(N, X, Xs),
bits(N, Y, Ys),
bits(N, Z, Zs),
adder(Xs, Ys, Zs, C1, C, Ds).
bits(N, X, Xs) :-
length(Xs, N),
bits1(Xs, 0, N, X).
bits1([], N, N, 0).
bits1([Xi|Xs1], I, N, X) :-
I < N,
X #= Xi * 2 ** I + X1,
I1 is I + 1,
bits1(Xs1, I1, N, X1).
adder([], [], [], C, C, []).
adder([X|Xs], [Y|Ys], [Z|Zs], C1, C, [D0, D1, D2, D3, D4|Ds]) :-
fullAdder(X, Y, C1, Z, C2, D0, D1, D2, D3, D4),
adder(Xs, Ys, Zs, C2, C, Ds).
fullAdder(X, Y, C1, Z, C, D0, D1, D2, D3, D4) :-
#\ D0 #==> (U1 #<=> X #/\ Y),
#\ D1 #==> (U2 #<=> U3 #/\ C1),
#\ D2 #==> (C #<=> U1 #\/ U2),
#\ D3 #==> (U3 #<=> X ## Y),
#\ D4 #==> (Z #<=> U3 ## C1).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/multipl.pl 0000644 0001750 0001750 00000006505 13021324543 017156 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : multipl.pl */
/* Title : unknown multiplication */
/* Original Source: Daniel Diaz - INRIA France */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : June 1995 */
/* */
/* Find the value of each digit verifying the following multiplication and */
/* such that each digit (0,1,...,9) appears excatly twice: */
/* */
/* X1 X2 X3 */
/* * X4 X5 X6 */
/* ----------- */
/* X7 X8 X9 */
/* + X10 X11 X12 */
/* + X13 X14 X15 */
/* = ------------------- */
/* X16 X17 X18 X19 X20 */
/* */
/* Solution: */
/* [X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16,X17,X18,X19,X20]*/
/* [ 1, 7, 9, 2, 2, 4, 7, 1, 6, 3, 5, 8, 3, 5, 8, 4, 0, 0, 9, 6]*/
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
mult(Lab, LD),
statistics(runtime, [_, Y]),
write(LD),
nl,
write('time : '),
write(Y),
nl.
mult(Lab, LD) :-
fd_set_vector_max(9),
LD = [X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, X13, X14, X15, X16, X17, X18, X19, X20],
fd_domain(LD, 0, 9),
fd_atmost(2, LD, 0),
fd_atmost(2, LD, 1),
fd_atmost(2, LD, 2),
fd_atmost(2, LD, 3),
fd_atmost(2, LD, 4),
fd_atmost(2, LD, 5),
fd_atmost(2, LD, 6),
fd_atmost(2, LD, 7),
fd_atmost(2, LD, 8),
fd_atmost(2, LD, 9),
/* This is much slower...
fd_exactly(2,LD,0),
fd_exactly(2,LD,1),
fd_exactly(2,LD,2),
fd_exactly(2,LD,3),
fd_exactly(2,LD,4),
fd_exactly(2,LD,5),
fd_exactly(2,LD,6),
fd_exactly(2,LD,7),
fd_exactly(2,LD,8),
fd_exactly(2,LD,9),
*/
Y #= 100 * X1 + 10 * X2 + X3,
Z1 #= 100 * X7 + 10 * X8 + X9,
Z2 #= 100 * X10 + 10 * X11 + X12,
Z3 #= 100 * X13 + 10 * X14 + X15,
X6 * Y #= Z1,
X5 * Y #= Z2,
X4 * Y #= Z3,
100 * X7 + 10 * X8 + X9 + 1000 * X10 + 100 * X11 + 10 * X12 + 10000 * X13 + 1000 * X14 + 100 * X15 #= 10000 * X16 + 1000 * X17 + 100 * X18 + 10 * X19 + X20,
lab(Lab, LD).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/bridge.pl 0000644 0001750 0001750 00000015144 13021324543 016723 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : bridge.pl */
/* Title : bridge scheduling problem */
/* Original Source: P. Van Hentenryck's book and */
/* COSYTEC (version used in "Overview of a CHIP Compiler")*/
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : October 1994 */
/* */
/* Find a scheduling that minimizes the time to build a 5-segment bridge. */
/* */
/* Solution: */
/* */
/* Optimal (End=104) */
/* */
/* [[start,0,0],[a1,4,3],[a2,2,13],[a3,2,7],[a4,2,15],[a5,2,1],[a6,5,38], */
/* [p1,20,9],[p2,13,29],[ue,10,0],[s1,8,10],[s2,4,18],[s3,4,29],[s4,4,42],*/
/* [s5,4,6],[s6,10,46],[b1,1,18],[b2,1,22],[b3,1,33],[b4,1,46],[b5,1,10], */
/* [b6,1,56],[ab1,1,19],[ab2,1,23],[ab3,1,34],[ab4,1,47],[ab5,1,11], */
/* [ab6,1,57],[m1,16,20],[m2,8,36],[m3,8,44],[m4,8,52],[m5,8,12], */
/* [m6,20,60],[l1,2,30],[t1,12,44],[t2,12,56],[t3,12,68],[t4,12,92], */
/* [t5,12,80],[ua,10,78],[v1,15,56],[v2,10,92],[k1,0,42],[k2,0,80], */
/* [stop,0,104]] */
/*-------------------------------------------------------------------------*/
q :-
statistics(runtime, _),
bridge(Ld, End),
statistics(runtime, [_, Y]),
write(Ld),
nl,
write(End),
nl,
write('time : '),
write(Y),
nl.
bridge(K, Ende) :-
setup(K, Ende, Disj),
fd_minimize(choice(Disj, K), Ende).
setup(K, Ende, Disj) :-
jobs(L),
make_vars(L, K),
member([stop, _, Ende], K),
precedence(M),
make_precedence(M, K),
max_nf(M1),
make_max_nf(M1, K),
max_ef(M2),
make_max_ef(M2, K),
min_af(M3),
make_min_af(M3, K),
min_sf(M4),
make_min_sf(M4, K),
min_nf(M5),
make_min_nf(M5, K),
resources(R),
make_disj(R, K, [], Disj1),
reverse(Disj1, Disj).
choice(Disj, K) :-
disjunct(Disj),
label(K).
make_vars([], []).
make_vars([H|T], [[H, D, A]|R]) :-
duration(H, D),
fd_domain(A, 0, 200),
make_vars(T, R).
make_precedence([], _).
make_precedence([[A, B]|R], L) :-
member([A, Ad, Aa], L),
member([B, _Bd, Ba], L),
Ba #>= Aa + Ad,
make_precedence(R, L).
make_max_nf([], _).
make_max_nf([[A, B, C]|R], L) :-
member([A, Ad, Aa], L),
member([B, _Bd, Ba], L),
C1 is C + Ad,
Ba #=< Aa + C1,
make_max_nf(R, L).
make_max_ef([], _).
make_max_ef([[A, B, C]|R], L) :-
member([A, Ad, Aa], L),
member([B, Bd, Ba], L),
C1 is Ad + C - Bd,
Ba #=< Aa + C1,
make_max_ef(R, L).
make_min_af([], _).
make_min_af([[A, B, C]|R], L) :-
member([A, _Ad, Aa], L),
member([B, _Bd, Ba], L),
Ba #>= Aa + C,
make_min_af(R, L).
make_min_sf([], _).
make_min_sf([[A, B, C]|R], L) :-
member([A, _Ad, Aa], L),
member([B, Bd, Ba], L),
C1 is C - Bd,
Ba #=< Aa + C1,
make_min_sf(R, L).
make_min_nf([], _).
make_min_nf([[A, B, C]|R], L) :-
member([A, Ad, _Aa], L),
member([B, _Bd, Ba], L),
C1 is C + Ad,
Ba #>= Ad + C1,
make_min_nf(R, L).
make_disj([], _R, D, D).
make_disj([[_H, R]|T], K, Din, Dout) :-
el_list(R, K, R1),
make_disj1(R1, Din, D1),
make_disj(T, K, D1, Dout).
make_disj1([], D, D).
make_disj1([H|T], Din, Dout) :-
make_disj2(H, T, Din, D1),
make_disj1(T, D1, Dout).
make_disj2(_H, [], D, D).
make_disj2([A, B], [[C, D]|S], Din, Dout) :-
make_disj2([A, B], S, [[A, B, C, D]|Din], Dout).
el_list([], _, []).
el_list([H|T], L, [[A, D]|S]) :-
member([H, D, A], L),
el_list(T, L, S).
disjunct([]).
disjunct([[A, B, C, D]|R]) :-
disj(A, B, C, D),
disjunct(R).
disj(Aa, Ad, Ba, _Bd) :-
Ba #>= Aa + Ad.
disj(Aa, _Ad, Ba, Bd) :-
Aa #>= Ba + Bd.
label([]).
label([[_A, _Ad, Aa]|R]) :-
fd_labeling(Aa),
label(R).
/*
DATA
*/
jobs([start, a1, a2, a3, a4, a5, a6, p1, p2, ue, s1, s2, s3, s4, s5, s6, b1, b2, b3, b4, b5, b6, ab1, ab2, ab3, ab4, ab5, ab6, m1, m2, m3, m4, m5, m6, l1, t1, t2, t3, t4, t5, ua, v1, v2, k1, k2, stop]).
duration(start, 0).
duration(a1, 4).
duration(a2, 2).
duration(a3, 2).
duration(a4, 2).
duration(a5, 2).
duration(a6, 5).
duration(p1, 20).
duration(p2, 13).
duration(ue, 10).
duration(s1, 8).
duration(s2, 4).
duration(s3, 4).
duration(s4, 4).
duration(s5, 4).
duration(s6, 10).
duration(b1, 1).
duration(b2, 1).
duration(b3, 1).
duration(b4, 1).
duration(b5, 1).
duration(b6, 1).
duration(ab1, 1).
duration(ab2, 1).
duration(ab3, 1).
duration(ab4, 1).
duration(ab5, 1).
duration(ab6, 1).
duration(m1, 16).
duration(m2, 8).
duration(m3, 8).
duration(m4, 8).
duration(m5, 8).
duration(m6, 20).
duration(l1, 2).
duration(t1, 12).
duration(t2, 12).
duration(t3, 12).
duration(t4, 12).
duration(t5, 12).
duration(ua, 10).
duration(v1, 15).
duration(v2, 10).
duration(k1, 0).
duration(k2, 0).
duration(stop, 0).
precedence([[start, a1], [start, a2], [start, a3], [start, a4], [start, a5], [start, a6], [start, ue], [a1, s1], [a2, s2], [a5, s5], [a6, s6], [a3, p1], [a4, p2], [p1, s3], [p2, s4], [p1, k1], [p2, k1], [s1, b1], [s2, b2], [s3, b3], [s4, b4], [s5, b5], [s6, b6], [b1, ab1], [b2, ab2], [b3, ab3], [b4, ab4], [b5, ab5], [b6, ab6], [ab1, m1], [ab2, m2], [ab3, m3], [ab4, m4], [ab5, m5], [ab6, m6], [m1, t1], [m2, t1], [m2, t2], [m3, t2], [m3, t3], [m4, t3], [m4, t4], [m5, t4], [m5, t5], [m6, t5], [m1, k2], [m2, k2], [m3, k2], [m4, k2], [m5, k2], [m6, k2], [l1, t1], [l1, t2], [l1, t3], [l1, t4], [l1, t5], [t1, v1], [t5, v2], [t2, stop], [t3, stop], [t4, stop], [v1, stop], [v2, stop], [ua, stop], [k1, stop], [k2, stop]]).
max_nf([[start, l1, 30], [a1, s1, 3], [a2, s2, 3], [a5, s5, 3], [a6, s6, 3], [p1, s3, 3], [p2, s4, 3]]).
min_sf([[ua, m1, 2], [ua, m2, 2], [ua, m3, 2], [ua, m4, 2], [ua, m5, 2], [ua, m6, 2]]).
max_ef([[s1, b1, 4], [s2, b2, 4], [s3, b3, 4], [s4, b4, 4], [s5, b5, 4], [s6, b6, 4]]).
min_nf([[start, l1, 30]]).
min_af([[ue, s1, 6], [ue, s2, 6], [ue, s3, 6], [ue, s4, 6], [ue, s5, 6], [ue, s6, 6]]).
resources([[crane, [l1, t1, t2, t3, t4, t5]], [bricklaying, [m1, m2, m3, m4, m5, m6]], [schal, [s1, s2, s3, s4, s5, s6]], [excavator, [a1, a2, a3, a4, a5, a6]], [ram, [p1, p2]], [pump, [b1, b2, b3, b4, b5, b6]], [caterpillar, [v1, v2]]]).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/send.pl 0000644 0001750 0001750 00000004506 13021324543 016420 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : send.pl */
/* Title : crypt-arithmetic */
/* Original Source: P. Van Hentenryck's book */
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : September 1992 */
/* */
/* Solve the operation: */
/* */
/* S E N D */
/* + M O R E */
/* ----------- */
/* = M O N E Y */
/* */
/* (resolution by line) */
/* */
/* Solution: */
/* [S,E,N,D,M,O,R,Y] */
/* [9,5,6,7,1,0,8,2] */
/*-------------------------------------------------------------------------*/
q :-
get_fd_labeling(Lab),
statistics(runtime, _),
send(LD, Lab),
statistics(runtime, [_, Y]),
write(LD),
nl,
write('time : '),
write(Y),
nl.
send(LD, Lab) :-
LD = [S, E, N, D, M, O, R, Y],
fd_all_different(LD),
fd_domain(LD, 0, 9),
fd_domain([S, M], 1, 9),
1000 * S + 100 * E + 10 * N + D + 1000 * M + 100 * O + 10 * R + E #= 10000 * M + 1000 * O + 100 * N + 10 * E + Y,
lab(Lab, LD).
lab(normal, L) :-
fd_labeling(L).
lab(ff, L) :-
fd_labelingff(L).
get_fd_labeling(Lab) :-
argument_counter(C),
get_labeling1(C, Lab).
get_labeling1(1, normal).
get_labeling1(2, Lab) :-
argument_value(1, Lab).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/bridge1.pl 0000644 0001750 0001750 00000016323 13021324543 017004 0 ustar spa spa /*-------------------------------------------------------------------------*/
/* Benchmark (Finite Domain) */
/* */
/* Name : bridge.pl */
/* Title : bridge scheduling problem */
/* Original Source: P. Van Hentenryck's book and */
/* COSYTEC (version used in "Overview of a CHIP Compiler")*/
/* Adapted by : Daniel Diaz for GNU Prolog */
/* Date : October 1994 */
/* */
/* Find a scheduling that minimizes the time to build a 5-segment bridge. */
/* */
/* Solution: */
/* */
/* Optimal (End=104) */
/* */
/* [[start,0,0],[a1,4,3],[a2,2,13],[a3,2,7],[a4,2,15],[a5,2,1],[a6,5,38], */
/* [p1,20,9],[p2,13,29],[ue,10,0],[s1,8,10],[s2,4,18],[s3,4,29],[s4,4,42],*/
/* [s5,4,6],[s6,10,46],[b1,1,18],[b2,1,22],[b3,1,33],[b4,1,46],[b5,1,10], */
/* [b6,1,56],[ab1,1,19],[ab2,1,23],[ab3,1,34],[ab4,1,47],[ab5,1,11], */
/* [ab6,1,57],[m1,16,20],[m2,8,36],[m3,8,44],[m4,8,52],[m5,8,12], */
/* [m6,20,60],[l1,2,30],[t1,12,44],[t2,12,56],[t3,12,68],[t4,12,92], */
/* [t5,12,80],[ua,10,78],[v1,15,56],[v2,10,92],[k1,0,42],[k2,0,80], */
/* [stop,0,104]] */
/*-------------------------------------------------------------------------*/
/* constraint definitions */
smallereqc(X, Y, C) :-
% X #=< Y+C.
fd_tell(x_plus_c_gte_y(Y, C, X)).
greatereqc(X, Y, C) :-
% X #>= Y+C.
fd_tell(x_plus_c_lte_y(Y, C, X)).
q :-
statistics(runtime, _),
bridge(Ld, End),
statistics(runtime, [_, Y]),
write(Ld),
nl,
write(End),
nl,
write('time : '),
write(Y),
nl.
bridge(K, Ende) :-
setup(K, Ende, Disj),
fd_minimize(choice(Disj, K), Ende).
setup(K, Ende, Disj) :-
jobs(L),
make_vars(L, K),
member([stop, _, Ende], K),
precedence(M),
make_precedence(M, K),
max_nf(M1),
make_max_nf(M1, K),
max_ef(M2),
make_max_ef(M2, K),
min_af(M3),
make_min_af(M3, K),
min_sf(M4),
make_min_sf(M4, K),
min_nf(M5),
make_min_nf(M5, K),
resources(R),
make_disj(R, K, [], Disj1),
reverse(Disj1, Disj).
choice(Disj, K) :-
disjunct(Disj),
label(K).
make_vars([], []).
make_vars([H|T], [[H, D, A]|R]) :-
duration(H, D),
fd_domain(A, 0, 200),
make_vars(T, R).
make_precedence([], _).
make_precedence([[A, B]|R], L) :-
member([A, Ad, Aa], L),
member([B, _Bd, Ba], L),
greatereqc(Ba, Aa, Ad), % Ba #>= Aa+Ad,
make_precedence(R, L).
make_max_nf([], _).
make_max_nf([[A, B, C]|R], L) :-
member([A, Ad, Aa], L),
member([B, _Bd, Ba], L),
C1 is C + Ad,
smallereqc(Ba, Aa, C1), % Ba #=< Aa+C1,
make_max_nf(R, L).
make_max_ef([], _).
make_max_ef([[A, B, C]|R], L) :-
member([A, Ad, Aa], L),
member([B, Bd, Ba], L),
C1 is Ad + C - Bd,
smallereqc(Ba, Aa, C1), % Ba #=< Aa+C1,
make_max_ef(R, L).
make_min_af([], _).
make_min_af([[A, B, C]|R], L) :-
member([A, _Ad, Aa], L),
member([B, _Bd, Ba], L),
greatereqc(Ba, Aa, C), % Ba #>= Aa+C,
make_min_af(R, L).
make_min_sf([], _).
make_min_sf([[A, B, C]|R], L) :-
member([A, _Ad, Aa], L),
member([B, Bd, Ba], L),
C1 is C - Bd,
smallereqc(Ba, Aa, C1), % Ba #=< Aa+C1,
make_min_sf(R, L).
make_min_nf([], _).
make_min_nf([[A, B, C]|R], L) :-
member([A, Ad, _Aa], L),
member([B, _Bd, Ba], L),
C1 is C + Ad,
greatereqc(Ba, Ad, C1), % Ba #>= Ad+C1,
make_min_nf(R, L).
make_disj([], _R, D, D).
make_disj([[_H, R]|T], K, Din, Dout) :-
el_list(R, K, R1),
make_disj1(R1, Din, D1),
make_disj(T, K, D1, Dout).
make_disj1([], D, D).
make_disj1([H|T], Din, Dout) :-
make_disj2(H, T, Din, D1),
make_disj1(T, D1, Dout).
make_disj2(_H, [], D, D).
make_disj2([A, B], [[C, D]|S], Din, Dout) :-
make_disj2([A, B], S, [[A, B, C, D]|Din], Dout).
el_list([], _, []).
el_list([H|T], L, [[A, D]|S]) :-
member([H, D, A], L),
el_list(T, L, S).
disjunct([]).
disjunct([[A, B, C, D]|R]) :-
disj(A, B, C, D),
disjunct(R).
disj(Aa, Ad, Ba, _Bd) :-
greatereqc(Ba, Aa, Ad). % Ba #>= Aa+Ad.
disj(Aa, _Ad, Ba, Bd) :-
greatereqc(Aa, Ba, Bd). % Aa #>= Ba+Bd.
label([]).
label([[_A, _Ad, Aa]|R]) :-
fd_labeling(Aa),
label(R).
/*
DATA
*/
jobs([start, a1, a2, a3, a4, a5, a6, p1, p2, ue, s1, s2, s3, s4, s5, s6, b1, b2, b3, b4, b5, b6, ab1, ab2, ab3, ab4, ab5, ab6, m1, m2, m3, m4, m5, m6, l1, t1, t2, t3, t4, t5, ua, v1, v2, k1, k2, stop]).
duration(start, 0).
duration(a1, 4).
duration(a2, 2).
duration(a3, 2).
duration(a4, 2).
duration(a5, 2).
duration(a6, 5).
duration(p1, 20).
duration(p2, 13).
duration(ue, 10).
duration(s1, 8).
duration(s2, 4).
duration(s3, 4).
duration(s4, 4).
duration(s5, 4).
duration(s6, 10).
duration(b1, 1).
duration(b2, 1).
duration(b3, 1).
duration(b4, 1).
duration(b5, 1).
duration(b6, 1).
duration(ab1, 1).
duration(ab2, 1).
duration(ab3, 1).
duration(ab4, 1).
duration(ab5, 1).
duration(ab6, 1).
duration(m1, 16).
duration(m2, 8).
duration(m3, 8).
duration(m4, 8).
duration(m5, 8).
duration(m6, 20).
duration(l1, 2).
duration(t1, 12).
duration(t2, 12).
duration(t3, 12).
duration(t4, 12).
duration(t5, 12).
duration(ua, 10).
duration(v1, 15).
duration(v2, 10).
duration(k1, 0).
duration(k2, 0).
duration(stop, 0).
precedence([[start, a1], [start, a2], [start, a3], [start, a4], [start, a5], [start, a6], [start, ue], [a1, s1], [a2, s2], [a5, s5], [a6, s6], [a3, p1], [a4, p2], [p1, s3], [p2, s4], [p1, k1], [p2, k1], [s1, b1], [s2, b2], [s3, b3], [s4, b4], [s5, b5], [s6, b6], [b1, ab1], [b2, ab2], [b3, ab3], [b4, ab4], [b5, ab5], [b6, ab6], [ab1, m1], [ab2, m2], [ab3, m3], [ab4, m4], [ab5, m5], [ab6, m6], [m1, t1], [m2, t1], [m2, t2], [m3, t2], [m3, t3], [m4, t3], [m4, t4], [m5, t4], [m5, t5], [m6, t5], [m1, k2], [m2, k2], [m3, k2], [m4, k2], [m5, k2], [m6, k2], [l1, t1], [l1, t2], [l1, t3], [l1, t4], [l1, t5], [t1, v1], [t5, v2], [t2, stop], [t3, stop], [t4, stop], [v1, stop], [v2, stop], [ua, stop], [k2, stop]]).
max_nf([[start, l1, 30], [a1, s1, 3], [a2, s2, 3], [a5, s5, 3], [a6, s6, 3], [p1, s3, 3], [p2, s4, 3]]).
min_sf([[ua, m1, 2], [ua, m2, 2], [ua, m3, 2], [ua, m4, 2], [ua, m5, 2], [ua, m6, 2]]).
max_ef([[s1, b1, 4], [s2, b2, 4], [s3, b3, 4], [s4, b4, 4], [s5, b5, 4], [s6, b6, 4]]).
min_nf([[start, l1, 30]]).
min_af([[ue, s1, 6], [ue, s2, 6], [ue, s3, 6], [ue, s4, 6], [ue, s5, 6], [ue, s6, 6]]).
resources([[crane, [l1, t1, t2, t3, t4, t5]], [bricklaying, [m1, m2, m3, m4, m5, m6]], [schal, [s1, s2, s3, s4, s5, s6]], [excavator, [a1, a2, a3, a4, a5, a6]], [ram, [p1, p2]], [pump, [b1, b2, b3, b4, b5, b6]], [caterpillar, [v1, v2]]]).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesFD/queens_fd.fd 0000644 0001750 0001750 00000000155 13021324543 017412 0 ustar spa spa diff(fdv X,fdv Y,int I)
{
start X in ~{val(Y),val(Y)+I,val(Y)-I}
start Y in ~{val(X),val(X)+I,val(X)-I}
}
gprolog-1.4.5/examples/ExamplesPl/ 0000755 0001750 0001750 00000000000 13021324543 015207 5 ustar spa spa gprolog-1.4.5/examples/ExamplesPl/hook.pl 0000644 0001750 0001750 00000000355 13021324543 016507 0 ustar spa spa % hook file for GNU Prolog
% Count is passed on the command line as the 1st argument
get_count(Count) :-
argument_value(1, ACount),
number_atom(Count, ACount).
get_cpu_time(T) :-
statistics(runtime, [T, _]).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesPl/reducer.pl 0000644 0001750 0001750 00000026647 13021324543 017214 0 ustar spa spa %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 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.
reducer(ShowResult) :-
try(fac(3), _ans1),
(ShowResult = true ->
write(_ans1), nl
; true),
try(quick([3,1,2]), _ans2),
(ShowResult = true ->
write(_ans2), nl
; true).
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', A, B) :- A>B.
relop( '=<', A, B) :- A==', 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=, A, S1, _, S2, S) :- intersectv_2(S2, A, S1, S).
intersectv_list([], []).
intersectv_list([InS|Sets], OutS) :- intersectv_list(Sets, InS, OutS).
/* without DCG */
intersectv_list([], A, A).
intersectv_list([A|B], C, D) :-
intersectv(A, C, E),
intersectv_list(B, E, D).
/* PB to compile DCG with CIAO in our general environment
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).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% benchmark interface
benchmark(ShowResult) :-
reducer(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/CIAO/ 0000755 0001750 0001750 00000000000 13021324543 015722 5 ustar spa spa gprolog-1.4.5/examples/ExamplesPl/CIAO/HOOK.pl 0000644 0001750 0001750 00000000536 13021324543 017023 0 ustar spa spa % hook file for CIAO Prolog
:- use_module(library(prolog_sys), [statistics/2]).
% Count is passed as first argument
get_count(Count) :-
current_prolog_flag(argv, L),
L = [ACount|_],
atom_codes(ACount, LCodes),
number_codes(Count, LCodes).
get_cpu_time(T) :-
statistics(runtime, [T, _]).
% main/0 needed by ciaoc
main.
:- initialization(q).
gprolog-1.4.5/examples/ExamplesPl/CIAO/MAKE_CLEAN 0000755 0001750 0001750 00000000027 13021324543 017266 0 ustar spa spa #!/bin/sh
rm -f [a-z]*
gprolog-1.4.5/examples/ExamplesPl/CIAO/MAKE_PROGS 0000755 0001750 0001750 00000000470 13021324543 017340 0 ustar spa spa #!/bin/sh
BENCH_PL=`cat ../PROGS`
p=`(cd ..;pwd)`
p1=`pwd`;
for i in ${*:-$BENCH_PL}
do
echo $i
f=$p1/$i.pl
sed -e 's/^:- include(common)\.//' $p/$i.pl >$f
sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f
cat $p1/HOOK.pl >>$f
ciaoc $f
rm -f $i.itf $i.po
done
gprolog-1.4.5/examples/ExamplesPl/queensn.pl 0000644 0001750 0001750 00000001321 13021324543 017217 0 ustar spa spa % naive queens
queensn(ShowResult) :-
q10(R),
( ShowResult = true ->
write(R), nl
; true).
q8(R) :-
q([1,2,3,4,5,6,7,8], R).
q10(R) :-
q([1,2,3,4,5,6,7,8,9,10], R).
q(L,C):-
perm(L,P),
pair(L,P,C),
safe([],C).
perm([],[]).
perm(Xs,[Z|Zs]):-
sel(Z,Xs,Ys),
perm(Ys,Zs).
sel(X,[X|Xs],Xs).
sel(X,[Y|Ys],[Y|Zs]):-
sel(X,Ys,Zs).
pair([],[],[]).
pair([X|Y],[U|V],[p(X,U)|W]):-
pair(Y,V,W).
safe(_X,[]).
safe(X,[Q|R]):-
test(X,Q),
safe([Q|X],R).
test([],_X).
test([R|S],Q):-
test(S,Q),
nd(R,Q).
nd(p(C1,R1),p(C2,R2)):-
C is C1-C2,
R is R1-R2, C=\=R,
NR is R2-R1, C=\=NR.
% benchmark interface
benchmark(ShowResult) :-
queensn(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/Makefile 0000644 0001750 0001750 00000003530 13021324543 016650 0 ustar spa spa GPLC = gplc
GPLCFLAGS= --fast-math --min-bips
BENCH_PL = boyer browse cal chat_parser crypt ham meta_qsort nand nrev \
poly_10 qsort queens queensn query reducer sdda sendmore \
tak tak_gvar zebra
.SUFFIXES:
.SUFFIXES: .pl $(SUFFIXES)
all: $(BENCH_PL)
clean:
rm -f $(BENCH_PL) *.exe
boyer: boyer.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o boyer boyer.pl
browse: browse.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o browse browse.pl
cal: cal.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o cal cal.pl
chat_parser: chat_parser.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o chat_parser chat_parser.pl
crypt: crypt.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o crypt crypt.pl
ham: ham.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o ham ham.pl
meta_qsort: meta_qsort.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o meta_qsort meta_qsort.pl
nand: nand.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o nand nand.pl
nrev: nrev.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o nrev nrev.pl
poly_10: poly_10.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o poly_10 poly_10.pl
qsort: qsort.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o qsort qsort.pl
queens: queens.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o queens queens.pl
queensn: queensn.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o queensn queensn.pl
query: query.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o query query.pl
reducer: reducer.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o reducer reducer.pl
sdda: sdda.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o sdda sdda.pl
sendmore: sendmore.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o sendmore sendmore.pl
tak: tak.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o tak tak.pl
tak_gvar: tak_gvar.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o tak_gvar tak_gvar.pl
zebra: zebra.pl common.pl hook.pl
$(GPLC) $(GPLCFLAGS) -o zebra zebra.pl
gprolog-1.4.5/examples/ExamplesPl/chat_parser.pl 0000644 0001750 0001750 00000060112 13021324543 020037 0 ustar spa spa % generated: 19 November 1989
% option(s):
%
% chat_parser
%
% Fernando C. N. Pereira and David H. D. Warren
chat_parser(_) :-
chat_parser1.
chat_parser1 :- string(X),
determinate_say(X,_),
fail.
chat_parser1.
% query set
string([what,rivers,are,there,?]).
string([does,afghanistan,border,china,?]).
string([what,is,the,capital,of,upper_volta,?]).
string([where,is,the,largest,country,?]).
string([which,country,'`',s,capital,is,london,?]).
string([which,countries,are,european,?]).
string([how,large,is,the,smallest,american,country,?]).
string([what,is,the,ocean,that,borders,african,countries,
and,that,borders,asian,countries,?]).
string([what,are,the,capitals,of,the,countries,bordering,the,baltic,?]).
string([which,countries,are,bordered,by,two,seas,?]).
string([how,many,countries,does,the,danube,flow,through,?]).
string([what,is,the,total,area,of,countries,south,of,the,equator,
and,not,in,australasia,?]).
string([what,is,the,average,area,of,the,countries,in,each,continent,?]).
string([is,there,more,than,one,country,in,each,continent,?]).
string([is,there,some,ocean,that,does,not,border,any,country,?]).
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_tracee(#(_,_,1,_)).
is_adv(#(_,_,_,1)).
tracee(#(_,_,1,_),#(0,0,0,0)).
tracee(#(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_tracee(#(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),
tracee(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),
tracee(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),
tracee(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),
tracee(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),
tracee(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_tracee(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) :-
openn(F,J,H,K),
variable(B,C,J,L,K,M),
s(D,N,L,O,M,P),
tracee(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),
tracee(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),
tracee(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),
tracee(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) :-
openn(F,J,H,K),
reduced_wh(B,C,J,L,K,M),
s(D,N,L,O,M,P),
tracee(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),
tracee(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),
tracee(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),
tracee(L,M),
tracee(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).
openn(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).
% benchmark interface
benchmark(ShowResult) :-
chat_parser(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/boyer.pl 0000644 0001750 0001750 00000025173 13021324543 016674 0 ustar spa spa % generated: 20 November 1989
% option(s):
%
% boyer
%
% Evan Tick (from Lisp version by R. P. Gabriel)
%
% November 1985
%
% prove arithmetic theorem
boyer(ShowResult) :-
wff(Wff),
( ShowResult = true ->
write('rewriting...'), nl
; true),
rewrite(Wff,NewWff),
( ShowResult = true ->
write('proving...'), nl
; true),
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,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) :- mymemberchk(Wff,Tlist).
falsep(f,_) :- !.
falsep(Wff,Flist) :- mymemberchk(Wff,Flist).
mymemberchk(X,[X|_]) :- !.
mymemberchk(X,[_|T]) :- mymemberchk(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
) :- n_th(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
) :- 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))).
n_th(zero,_,zero).
n_th([],I,if(zerop(I),[],zero)).
n_th(append(A,B),I,append(nth(A,I),nth(B,difference(I,length(A))))).
plus(plus(X,Y),Z,
plus(X,plus(Y,Z))) :- !.
plus(remainder(X,Y),
times(Y,quotient(X,Y)),
fix(X)) :- !.
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)) ).
% benchmark interface
benchmark(ShowResult) :-
boyer(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/queens.pl 0000644 0001750 0001750 00000003262 13021324543 017047 0 ustar spa spa % generated: 10 November 1989
% option(s):
%
% (queens) queens_8
%
% from Sterling and Shapiro, "The Art of Prolog," page 211.
%
% 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(ShowResult) :-
queens(16, R),
( ShowResult = true ->
write(R), nl
; true).
queens(N,Qs):-
range(1,N,Ns),
queens(Ns,[],Qs).
queens([],Qs,Qs).
queens(UnplacedQs,SafeQs,Qs):-
sel(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).
sel([X|Xs],Xs,X).
sel([Y|Ys],[Y|Zs],X):-
sel(Ys,Zs,X).
range(N,N,[N]):- !.
range(M,N,[M|Ns]):-
M < N,
M1 is M+1,
range(M1,N,Ns).
% benchmark interface
benchmark(ShowResult) :-
queens(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/qsort.pl 0000644 0001750 0001750 00000001226 13021324543 016715 0 ustar spa spa % qsort
%
% David H. D. Warren
%
% quicksort a list of 50 integers
qsort(ShowResult) :-
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], R, []),
( ShowResult = true ->
write(R), nl
; true).
qsort([], R, R).
qsort([X|L], R, R0) :-
partition(L, X, L1, L2),
qsort(L2, R1, R0),
qsort(L1, R, [X|R1]).
partition([],_,[],[]).
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).
% benchmark interface
benchmark(ShowResult) :-
qsort(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/browse.pl 0000644 0001750 0001750 00000005247 13021324543 017055 0 ustar spa spa % generated: 19 June 1990
% option(s):
%
% browse
%
% Tep Dobry (from Lisp version by R. P. Gabriel)
%
% (modified January 1987 by Herve' Touati)
browse(_) :-
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(_),_,_]
]).
my_length(L, N) :-
my_length1(L, 0, N).
my_length1([], N, N).
my_length1([_|L], M, N) :-
M1 is M+1,
my_length1(L, M1, N).
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) :-
my_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. /* do not 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).
% benchmark interface
benchmark(ShowResult) :-
browse(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/README 0000644 0001750 0001750 00000004015 13021324543 016067 0 ustar spa spa GNU PROLOG Benchmarks
=====================
This directory contains a set of Prolog benchmarks
To compile them with GNU Prolog:
make
Each benchmark accepts a count (nb of iteration) as command-line argument, e.g:
zebra 10
house(yellow,norwegian,fox,water,kools)
house(blue,ukrainian,horse,tea,chesterfields)
house(red,english,snails,milk,winstons)
house(ivory,spanish,dog,orange_juice,lucky_strikes)
house(green,japanese,zebra,coffee,parliaments)
17 msec per iter, 10 iters, total time : 170 msec
NB: only the last iteration displays the solution.
Each bench includes the Prolog file common.pl (part recovering the counter
from the command-line and ierating the bench). This file includes itself the
Prolog source hook.pl defining the predicats get_count/1 (recover the count
form the command-line) and get_cpu_time/1 (user time in msec).
This makes it possible to run the benchmarks with different systems (defining
a hook.pl file for each system).
If present, each sub-directorie (YAP, WAMCC, SICSTUS, CIAO, BINPROLOG, XSB, SWI) contains
3 files:
MAKE_PROGS: a shell-script building the benchmarks
MAKE_CLEAN: a shell-script removing build benchmarks
HOOK.pl: the hook file needed for the corresponding system
To compile the benchmarks with a given system use MAKE_PROGS in the
associated directory (e.g. YAP):
cd YAP
MAKE_PROGS (or MAKE_PROGS BENCH_NAME...)
MAKE_PROGS build the list of benchmarks passed as argument. In none, it
builds all benchmarks described in the file ../PROGS. Be sure to be in the
sub-directory (cd) before doing MAKE_PROGS. NB: under SICSTUS, the
compilation mode is byte-code (compactcode), to activate native code
(fastcode) define the environment variable NATIVE.
The build benchmark act like under GNU Prolog, accepting a count as
command-line argument. It is not mandatory to be in sub-directory for the
execution. e.g.:
~/...blabla.../ExamplesPl/YAP/zebra 10
To clean the benchmarks with a given system use MAKE_CLEAN in the
associated directory (e.g. YAP):
cd YAP
MAKE_CLEAN
gprolog-1.4.5/examples/ExamplesPl/sdda.pl 0000644 0001750 0001750 00000026526 13021324543 016472 0 ustar spa spa % 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
sdda(ShowResult):-
do_sdda(test,_A,_B,_C, ShowResult).
% 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, ShowResult) :-
%%see(FileName),
read_procedures(Procs, ExitModes, Entries), % collect all procedures
%%seen,
( ShowResult = true ->
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
; true).
%%% !!! 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
my_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).
my_length(L, N) :-
my_length1(L, 0, N).
my_length1([], N, N).
my_length1([_|L], M, N) :-
M1 is M+1,
my_length1(L, M1, N).
% 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
fail. % DD: I have put fail since unify/3 does not exist
/*
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).
/*
% Membership relation for standard nil-tail lists
member(X, [X|_]).
member(X, [_|T]) :- member(X, T).
*/
% Equiv membership relation for standard nil-tail lists
eqmember(X, [Y|_]) :- equiv(X, Y).
eqmember(X, [_|T]) :- eqmember(X, T).
% 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),
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).
% benchmark interface
benchmark(ShowResult) :-
sdda(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/common.pl 0000644 0001750 0001750 00000001322 13021324543 017032 0 ustar spa spa % A generic benchmark interface
q :-
( get_count(Count)
; Count = 1
),
!,
do_bench(Count).
do_bench(Count) :-
get_cpu_time(T1),
iterate_bench(Count),
get_cpu_time(T2),
Time is T2-T1,
TimeIt is Time // Count,
write(TimeIt),
write(' msec per iter, '),
write(Count),
write(' iters, total time : '),
write(Time),
write(' msec'),
nl.
iterate_bench(Count) :-
rep(Count, Last),
ShowResult = Last,
exec_bench(ShowResult),
Last = true.
exec_bench(ShowResult) :-
benchmark(ShowResult),
!.
rep(1, true):-
!.
rep(_, false).
rep(N, Last) :-
N1 is N - 1,
rep(N1, Last).
/*
* this file should define:
* get_count/1
* get_cpu_time/1
* and launch q/0
*/
:- include(hook).
gprolog-1.4.5/examples/ExamplesPl/nand.pl 0000644 0001750 0001750 00000047767 13021324543 016511 0 ustar spa spa %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
nand(ShowResult) :- nand_main(0, ShowResult).
nand_main(N, ShowResult) :-
init_state(N, NumVars, NumGs, Gs),
add_necessary_functions(NumVars, NumGs, Gs, NumGs2, Gs2),
test_bounds(NumVars, NumGs2, Gs2),
search(NumVars, NumGs2, Gs2, ShowResult).
nand_main(_, ShowResult) :-
( ShowResult = true ->
write('Search completed'), nl
; true).
% 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, _).
/* commented for XSB, compiler complexity too high on big lists
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, ShowResult) :-
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, ShowResult).
search(NumVars, NumGs, Gs, ShowResult) :-
( ShowResult = true ->
output_results(NumVars, NumGs, Gs)
; true),
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, _), !,
\+ unif(Type, cov),
\+ unif(Type, nf).
unif(X, X).
% 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) :-
\+ unif2(Type, exp, var),
function_number(Gj1, J1), function_number(Gj2, J2),
J1 < J2, !.
best_vector(Gj1, _, Type, _, Gj2, V2, Type, N2, Gj2, V2, Type, N2) :-
\+ unif2(Type, exp, 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), !.
unif2(X, X, _).
unif2(X, _, X).
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
/* Original source
set(N, A) :-
(recorded(N, _, Ref) -> erase(Ref) ; true),
recorda(N, A, _).
access(N, A) :-
recorded(N, A, _).
*/
/* bet for GNU Prolog
set(N, A) :-
g_assign(N, A).
access(N, A) :-
g_read(N, A).
*/
/* ISO version */
set(N, A) :-
( access(N, _) ->
retract(store_value(N, _))
; true),
asserta(store_value(N, A)).
access(N, A) :-
clause(store_value(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).
% benchmark interface
benchmark(ShowResult) :-
nand(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/tak.pl 0000644 0001750 0001750 00000001143 13021324543 016322 0 ustar spa spa % 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(ShowResult) :-
tak(18,12,6,R),
( ShowResult = true ->
write(tak(18,12,6)=R), nl
; true).
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).
% benchmark interface
benchmark(ShowResult) :-
tak(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/crypt.pl 0000644 0001750 0001750 00000004022 13021324543 016703 0 ustar spa spa % crypt
%
% 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
crypt(ShowResult) :-
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),
sum2([I, H, G, F], [0, L, K, J], [P, O, N, M | Z]),
odd(M), odd(N), even(O), even(P), zero(Z),
( ShowResult = true ->
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
; true).
% In the usual source this predicate is named sum. However, sum is a
% language construct in NU-Prolog, and cannot be defined as a predicate.
% If you try, nc comes up with an obscure error message.
sum2(AL, BL, CL) :-
sum2(AL, BL, 0, CL).
sum2([A | AL], [B | BL], Carry, [C | CL]) :- !,
X is (A + B + Carry),
C is X mod 10,
NewCarry is X // 10,
sum2(AL, BL, NewCarry, CL).
sum2([], BL, 0, BL) :- !.
sum2(AL, [], 0, AL) :- !.
sum2([], [B | BL], Carry, [C | CL]) :- !,
X is B + Carry,
NewCarry is X // 10,
C is X mod 10,
sum2([], BL, NewCarry, CL).
sum2([A | AL], [], Carry, [C | CL]) :- !,
X is A + Carry,
NewCarry is X // 10,
C is X mod 10,
sum2([], AL, NewCarry, CL).
sum2([], [], Carry, [Carry]).
mult(AL, D, BL) :- mult(AL, D, 0, BL).
mult([], _, Carry, [C, Cend]) :-
C is Carry mod 10,
Cend is Carry // 10.
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).
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).
% benchmark interface
benchmark(ShowResult) :-
crypt(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/sendmore.pl 0000644 0001750 0001750 00000002245 13021324543 017363 0 ustar spa spa
% Cryptoaddition:
% Find the unique answer to:
% SEND
% +MORE
% -----
% MONEY
% where each letter is a distinct digit.
sendmore(ShowResult) :-
digit(D), digit(E), D=\=E,
sumdigit(0, D, E, Y, C1),
digit(N), N=\=Y, N=\=E, N=\=D,
digit(R), R=\=N, R=\=Y, R=\=E, R=\=D,
sumdigit(C1,N, R, E, C2),
digit(O), O=\=R, O=\=N, O=\=Y, O=\=E, O=\=D,
sumdigit(C2,E, O, N, C3),
leftdigit(S), S=\=O, S=\=R, S=\=N, S=\=Y, S=\=E, S=\=D,
leftdigit(M), M=\=S, M=\=O, M=\=R, M=\=N, M=\=Y, M=\=E, M=\=D,
sumdigit(C3,S, M, O, M),
( ShowResult = true ->
write(' '),write(S),write(E),write(N),write(D),nl,
write('+'),write(M),write(O),write(R),write(E),nl,
write('-----'),nl,
write(M),write(O),write(N),write(E),write(Y),nl,nl
; true),
fail.
sendmore(_).
sumdigit(C, A, B, S, D) :-
X is (C+A+B),
(X<10
-> S=X, D=0
; S is X-10, D=1
).
digit(0).
digit(1).
digit(2).
digit(3).
digit(4).
digit(5).
digit(6).
digit(7).
digit(8).
digit(9).
leftdigit(1).
leftdigit(2).
leftdigit(3).
leftdigit(4).
leftdigit(5).
leftdigit(6).
leftdigit(7).
leftdigit(8).
leftdigit(9).
% benchmark interface
benchmark(ShowResult) :-
sendmore(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/SWI/ 0000755 0001750 0001750 00000000000 13021324543 015651 5 ustar spa spa gprolog-1.4.5/examples/ExamplesPl/SWI/HOOK.pl 0000644 0001750 0001750 00000000662 13021324543 016752 0 ustar spa spa % hook file for SWI Prolog
% Count is passed on the command line as the last argument (1st is 'pl')
get_count(Count) :-
unix(argv(L)),
get_last(L, ACount),
atom_codes(ACount, LCodes),
number_codes(Count, LCodes).
get_last([Count], Count):-
!,
sub_atom(Count, 0, 1, _, X),
X @>= '0',
X @=< '9'.
get_last([_|L], Count):-
get_last(L, Count).
get_cpu_time(T) :-
statistics(cputime, X),
T is X*1000.
:- initialization(q).
gprolog-1.4.5/examples/ExamplesPl/SWI/MAKE_CLEAN 0000755 0001750 0001750 00000000027 13021324543 017215 0 ustar spa spa #!/bin/sh
rm -f [a-z]*
gprolog-1.4.5/examples/ExamplesPl/SWI/MAKE_PROGS 0000755 0001750 0001750 00000000713 13021324543 017267 0 ustar spa spa #!/bin/sh
BENCH_PL=`cat ../PROGS`
p=`(cd ..;pwd)`
p1=`pwd`;
for i in ${*:-$BENCH_PL}
do
echo $i
f=$p1/$i.pl
echo "#!/bin/sh" >$i
echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i
echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i
echo "cat $p1/HOOK.pl >>$f" >>$i
echo "pl -L6000 -G6000 -T6000 -f none -g \"load_files(['$f'],[silent(true)])\" -t halt \$*" >>$i
chmod a+x $i
done
gprolog-1.4.5/examples/ExamplesPl/.gitignore 0000644 0001750 0001750 00000000307 13021324543 017177 0 ustar spa spa TO_DO
BENCHING
RES_C*
COMPARE_BENCH
BENCH_NAMES
CHECK.sh
STAT*
boyer
browse
cal
chat_parser
crypt
ham
meta_qsort
nand
nrev
poly_10
qsort
queens
queensn
query
reducer
sdda
sendmore
tak
tak_gvar
zebra
gprolog-1.4.5/examples/ExamplesPl/YAP/ 0000755 0001750 0001750 00000000000 13021324543 015640 5 ustar spa spa gprolog-1.4.5/examples/ExamplesPl/YAP/HOOK.pl 0000644 0001750 0001750 00000000447 13021324543 016742 0 ustar spa spa :- use_module(library(lists)).
% hook file for YAP Prolog
% Count is passed on the command line as -- Count
get_count(Count) :-
unix(argv(L)),
L = [ACount|_],
atom_codes(ACount, LCodes),
number_codes(Count, LCodes).
get_cpu_time(T) :-
statistics(runtime, [T, _]).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesPl/YAP/MAKE_CLEAN 0000755 0001750 0001750 00000000027 13021324543 017204 0 ustar spa spa #!/bin/sh
rm -f [a-z]*
gprolog-1.4.5/examples/ExamplesPl/YAP/MAKE_PROGS 0000755 0001750 0001750 00000000641 13021324543 017256 0 ustar spa spa #!/bin/sh
BENCH_PL=`cat ../PROGS`
p=`(cd ..;pwd)`
p1=`pwd`;
for i in ${*:-$BENCH_PL}
do
echo $i
f=$p1/$i.pl
echo "#!/bin/sh" >$i
echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i
echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i
echo "cat $p1/HOOK.pl >>$f" >>$i
echo "echo \"compile('$f'). \" | yap -- \$* 2>/dev/null" >>$i
chmod a+x $i
done
gprolog-1.4.5/examples/ExamplesPl/tak_gvar.pl 0000644 0001750 0001750 00000001620 13021324543 017341 0 ustar spa spa % generated: 17 November 1989
% option(s): SOURCE_TRANSFORM_1
%
% tak
%
% Evan Tick (from Lisp version by R. P. Gabriel)
%
% (almost) Takeuchi function (recursive arithmetic)
% uses global variables to tabulate results
tak_gvar(ShowResult) :-
init_tak_array,
tak(18,12,6,R),
( ShowResult = true ->
write(tak(18,12,6)=R), nl
; true).
init_tak_array:-
g_assign(tak,g_array_auto(20,g_array_auto(20,g_array_auto(20,null)))).
tak(X,Y,Z,A):-
g_read(tak(X,Y,Z),A1),
(integer(A1) -> A=A1
; tak1(X,Y,Z,A),
g_assign(tak(X,Y,Z),A)).
tak1(X,Y,Z,A):-
X =< Y,
Z = A.
tak1(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).
% benchmark interface
benchmark(ShowResult) :-
tak_gvar(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/BINPROLOG/ 0000755 0001750 0001750 00000000000 13021324543 016542 5 ustar spa spa gprolog-1.4.5/examples/ExamplesPl/BINPROLOG/HOOK.pl 0000644 0001750 0001750 00000000350 13021324543 017635 0 ustar spa spa % hook file for BinProlog
% Count is passed as a fact at the end of the source
get_count(Count) :-
count(Count).
get_cpu_time(T) :-
statistics(runtime,[_,T]).
% no initialization, script executes q/0 after consult
main :-
q.
gprolog-1.4.5/examples/ExamplesPl/BINPROLOG/MAKE_CLEAN 0000755 0001750 0001750 00000000027 13021324543 020106 0 ustar spa spa #!/bin/sh
rm -f [a-z]*
gprolog-1.4.5/examples/ExamplesPl/BINPROLOG/MAKE_PROGS 0000755 0001750 0001750 00000000737 13021324543 020166 0 ustar spa spa #!/bin/sh
BENCH_PL=`cat ../PROGS`
p=`(cd ..;pwd)`
p1=`pwd`;
for i in ${*:-$BENCH_PL}
do
echo $i
f=$p1/$i.pl
echo "#!/bin/sh" >$i
echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i
echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i
echo "cat $p1/HOOK.pl >>$f" >>$i
echo "echo \"count(\${1:-1}). \" >>$f" >>$i
echo "echo \"['$f']. \" | bp -h 6000 -t 6000 -s 6000 2>/dev/null" >>$i
chmod a+x $i
done
gprolog-1.4.5/examples/ExamplesPl/SICSTUS/ 0000755 0001750 0001750 00000000000 13021324543 016344 5 ustar spa spa gprolog-1.4.5/examples/ExamplesPl/SICSTUS/HOOK.pl 0000644 0001750 0001750 00000000432 13021324543 017440 0 ustar spa spa % hook file for SICStus Prolog
% Count is passed on the command line as -a Count
get_count(Count) :-
current_prolog_flag(argv, L),
L = [ACount|_],
atom_codes(ACount, LCodes),
number_codes(Count, LCodes).
get_cpu_time(T) :-
statistics(runtime, [T, _]).
:- initialization(q).
gprolog-1.4.5/examples/ExamplesPl/SICSTUS/MAKE_CLEAN 0000755 0001750 0001750 00000000027 13021324543 017710 0 ustar spa spa #!/bin/sh
rm -f [a-z]*
gprolog-1.4.5/examples/ExamplesPl/SICSTUS/MAKE_PROGS 0000755 0001750 0001750 00000001022 13021324543 017754 0 ustar spa spa #!/bin/sh
BENCH_PL=`cat ../PROGS`
p=`(cd ..;pwd)`
p1=`pwd`;
if test "$NATIVE" = ""; then
mode=compactcode
else
mode=fastcode
fi
for i in ${*:-$BENCH_PL}
do
echo $i
f=$p1/$i.pl
echo "#!/bin/sh" >$i
echo "sed -e 's/^:- include(common)\.//' $p/$i.pl >$f" >>$i
echo "sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f" >>$i
echo "cat $p1/HOOK.pl >>$f" >>$i
echo "echo \"prolog_flag(compiling,_,$mode), compile('$f'). \" | sicstus -a \$* 2>/dev/null" >>$i
chmod a+x $i
done
gprolog-1.4.5/examples/ExamplesPl/query.pl 0000644 0001750 0001750 00000003413 13021324543 016712 0 ustar spa spa % query
%
% David H. D. Warren
%
% query population and area database to find countries
% of approximately equal population density
query(true) :-
query_show, fail ; true.
query(fail) :-
query_silent, fail ; true.
query_show :-
query1(C1, D1, C2, D2),
write([C1-D1, C2-D2]), nl.
query_silent :-
query1(_C1, _D1, _C2, _D2).
query1(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 100000s
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 1000s 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).
% benchmark interface
benchmark(ShowResult) :-
query(ShowResult).
:- include(common).
gprolog-1.4.5/examples/ExamplesPl/PROGS 0000644 0001750 0001750 00000000164 13021324543 016025 0 ustar spa spa boyer
browse
cal
chat_parser
crypt
ham
meta_qsort
nand
nrev
poly_10
queens
queensn
reducer
#sdda
sendmore
tak
zebra
gprolog-1.4.5/examples/ExamplesPl/WAMCC/ 0000755 0001750 0001750 00000000000 13021324543 016041 5 ustar spa spa gprolog-1.4.5/examples/ExamplesPl/WAMCC/HOOK.pl 0000644 0001750 0001750 00000000352 13021324543 017136 0 ustar spa spa % hook file for Wamcc
% Count is passed as the first argument
get_count(Count) :-
unix(argv(L)),
L = [ACount|_],
name(ACount, LCodes),
name(Count, LCodes).
get_cpu_time(T) :-
statistics(runtime, [T, _]).
:- main.
:- q, halt.
gprolog-1.4.5/examples/ExamplesPl/WAMCC/MAKE_CLEAN 0000755 0001750 0001750 00000000027 13021324543 017405 0 ustar spa spa #!/bin/sh
rm -f [a-z]*
gprolog-1.4.5/examples/ExamplesPl/WAMCC/MAKE_PROGS 0000755 0001750 0001750 00000000512 13021324543 017454 0 ustar spa spa #!/bin/sh
BENCH_PL=`cat ../PROGS`
p=`(cd ..;pwd)`
p1=`pwd`;
for i in ${*:-$BENCH_PL}
do
echo $i
f=$i.pl
sed -e 's/^:- include(common)\.//' $p/$i.pl >$f
sed -e 's/^:- include(hook)\.//' $p/common.pl >>$f
cat HOOK.pl >>$f
wamcc $f
w_gcc -s -o $i $i.c -lwamcc
rm -f $i.c $i.h $i.usr
done
gprolog-1.4.5/examples/ExamplesPl/meta_qsort.pl 0000644 0001750 0001750 00000005573 13021324543 017734 0 ustar spa spa % 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(ShowResult) :-
interpret(qsort(R)),
( ShowResult = true ->
write(R), nl
; true).
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, _):-
integer(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(_=<_).
is_built_in(write(_)).
interpret_built_in(true).
interpret_built_in(X=