--- /dev/null
+To find out what should go in this file, see "Information For
+Maintainers of GNU Software" (maintain.texi), the section called
+"Recording Changes".
+
+Matt Birkholz The conversion to a plugin.
+The MIT/GNU Scheme Team The original (runtime postgresql) package.
--- /dev/null
+ GNU LIBRARY GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+[This is the first released version of the library GPL. It is
+ numbered 2 because it goes with version 2 of the ordinary GPL.]
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+Licenses are intended to guarantee your freedom to share and change
+free software--to make sure the software is free for all its users.
+
+ This license, the Library General Public License, applies to some
+specially designated Free Software Foundation software, and to any
+other libraries whose authors decide to use it. You can use it for
+your libraries, 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 library, or if you modify it.
+
+ For example, if you distribute copies of the library, whether gratis
+or for a fee, you must give the recipients all the rights that we gave
+you. You must make sure that they, too, receive or can get the source
+code. If you link a program with the library, you must provide
+complete object files to the recipients so that they can relink them
+with the library, after making changes to the library and recompiling
+it. And you must show them these terms so they know their rights.
+
+ Our method of protecting your rights has two steps: (1) copyright
+the library, and (2) offer you this license which gives you legal
+permission to copy, distribute and/or modify the library.
+
+ Also, for each distributor's protection, we want to make certain
+that everyone understands that there is no warranty for this free
+library. If the library is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original
+version, so that any problems introduced by others will not reflect on
+the original authors' reputations.
+\f
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that companies distributing free
+software will individually obtain patent licenses, thus in effect
+transforming the program into proprietary software. To prevent this,
+we have made it clear that any patent must be licensed for everyone's
+free use or not licensed at all.
+
+ Most GNU software, including some libraries, is covered by the ordinary
+GNU General Public License, which was designed for utility programs. This
+license, the GNU Library General Public License, applies to certain
+designated libraries. This license is quite different from the ordinary
+one; be sure to read it in full, and don't assume that anything in it is
+the same as in the ordinary license.
+
+ The reason we have a separate public license for some libraries is that
+they blur the distinction we usually make between modifying or adding to a
+program and simply using it. Linking a program with a library, without
+changing the library, is in some sense simply using the library, and is
+analogous to running a utility program or application program. However, in
+a textual and legal sense, the linked executable is a combined work, a
+derivative of the original library, and the ordinary General Public License
+treats it as such.
+
+ Because of this blurred distinction, using the ordinary General
+Public License for libraries did not effectively promote software
+sharing, because most developers did not use the libraries. We
+concluded that weaker conditions might promote sharing better.
+
+ However, unrestricted linking of non-free programs would deprive the
+users of those programs of all benefit from the free status of the
+libraries themselves. This Library General Public License is intended to
+permit developers of non-free programs to use free libraries, while
+preserving your freedom as a user of such programs to change the free
+libraries that are incorporated in them. (We have not seen how to achieve
+this as regards changes in header files, but we have achieved it as regards
+changes in the actual functions of the Library.) The hope is that this
+will lead to faster development of free libraries.
+
+ The precise terms and conditions for copying, distribution and
+modification follow. Pay close attention to the difference between a
+"work based on the library" and a "work that uses the library". The
+former contains code derived from the library, while the latter only
+works together with the library.
+
+ Note that it is possible for a library to be covered by the ordinary
+General Public License rather than by this special one.
+\f
+ GNU LIBRARY GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any software library which
+contains a notice placed by the copyright holder or other authorized
+party saying it may be distributed under the terms of this Library
+General Public License (also called "this License"). Each licensee is
+addressed as "you".
+
+ A "library" means a collection of software functions and/or data
+prepared so as to be conveniently linked with application programs
+(which use some of those functions and data) to form executables.
+
+ The "Library", below, refers to any such software library or work
+which has been distributed under these terms. A "work based on the
+Library" means either the Library or any derivative work under
+copyright law: that is to say, a work containing the Library or a
+portion of it, either verbatim or with modifications and/or translated
+straightforwardly into another language. (Hereinafter, translation is
+included without limitation in the term "modification".)
+
+ "Source code" for a work means the preferred form of the work for
+making modifications to it. For a library, 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 library.
+
+ Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running a program using the Library is not restricted, and output from
+such a program is covered only if its contents constitute a work based
+on the Library (independent of the use of the Library in a tool for
+writing it). Whether that is true depends on what the Library does
+and what the program that uses the Library does.
+
+ 1. You may copy and distribute verbatim copies of the Library's
+complete 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 distribute a copy of this License along with the
+Library.
+
+ 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.
+\f
+ 2. You may modify your copy or copies of the Library or any portion
+of it, thus forming a work based on the Library, 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) The modified work must itself be a software library.
+
+ b) You must cause the files modified to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ c) You must cause the whole of the work to be licensed at no
+ charge to all third parties under the terms of this License.
+
+ d) If a facility in the modified Library refers to a function or a
+ table of data to be supplied by an application program that uses
+ the facility, other than as an argument passed when the facility
+ is invoked, then you must make a good faith effort to ensure that,
+ in the event an application does not supply such function or
+ table, the facility still operates, and performs whatever part of
+ its purpose remains meaningful.
+
+ (For example, a function in a library to compute square roots has
+ a purpose that is entirely well-defined independent of the
+ application. Therefore, Subsection 2d requires that any
+ application-supplied function or table used by this function must
+ be optional: if the application does not supply it, the square
+ root function must still compute square roots.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Library,
+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 Library, 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 Library.
+
+In addition, mere aggregation of another work not based on the Library
+with the Library (or with a work based on the Library) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may opt to apply the terms of the ordinary GNU General Public
+License instead of this License to a given copy of the Library. To do
+this, you must alter all the notices that refer to this License, so
+that they refer to the ordinary GNU General Public License, version 2,
+instead of to this License. (If a newer version than version 2 of the
+ordinary GNU General Public License has appeared, then you can specify
+that version instead if you wish.) Do not make any other change in
+these notices.
+\f
+ Once this change is made in a given copy, it is irreversible for
+that copy, so the ordinary GNU General Public License applies to all
+subsequent copies and derivative works made from that copy.
+
+ This option is useful when you wish to copy part of the code of
+the Library into a program that is not a library.
+
+ 4. You may copy and distribute the Library (or a portion or
+derivative of it, under Section 2) in object code or executable form
+under the terms of Sections 1 and 2 above provided that you 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.
+
+ If distribution of 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 satisfies the requirement to
+distribute the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 5. A program that contains no derivative of any portion of the
+Library, but is designed to work with the Library by being compiled or
+linked with it, is called a "work that uses the Library". Such a
+work, in isolation, is not a derivative work of the Library, and
+therefore falls outside the scope of this License.
+
+ However, linking a "work that uses the Library" with the Library
+creates an executable that is a derivative of the Library (because it
+contains portions of the Library), rather than a "work that uses the
+library". The executable is therefore covered by this License.
+Section 6 states terms for distribution of such executables.
+
+ When a "work that uses the Library" uses material from a header file
+that is part of the Library, the object code for the work may be a
+derivative work of the Library even though the source code is not.
+Whether this is true is especially significant if the work can be
+linked without the Library, or if the work is itself a library. The
+threshold for this to be true is not precisely defined by law.
+
+ If such an object file uses only numerical parameters, data
+structure layouts and accessors, and small macros and small inline
+functions (ten lines or less in length), then the use of the object
+file is unrestricted, regardless of whether it is legally a derivative
+work. (Executables containing this object code plus portions of the
+Library will still fall under Section 6.)
+
+ Otherwise, if the work is a derivative of the Library, you may
+distribute the object code for the work under the terms of Section 6.
+Any executables containing that work also fall under Section 6,
+whether or not they are linked directly with the Library itself.
+\f
+ 6. As an exception to the Sections above, you may also compile or
+link a "work that uses the Library" with the Library to produce a
+work containing portions of the Library, and distribute that work
+under terms of your choice, provided that the terms permit
+modification of the work for the customer's own use and reverse
+engineering for debugging such modifications.
+
+ You must give prominent notice with each copy of the work that the
+Library is used in it and that the Library and its use are covered by
+this License. You must supply a copy of this License. If the work
+during execution displays copyright notices, you must include the
+copyright notice for the Library among them, as well as a reference
+directing the user to the copy of this License. Also, you must do one
+of these things:
+
+ a) Accompany the work with the complete corresponding
+ machine-readable source code for the Library including whatever
+ changes were used in the work (which must be distributed under
+ Sections 1 and 2 above); and, if the work is an executable linked
+ with the Library, with the complete machine-readable "work that
+ uses the Library", as object code and/or source code, so that the
+ user can modify the Library and then relink to produce a modified
+ executable containing the modified Library. (It is understood
+ that the user who changes the contents of definitions files in the
+ Library will not necessarily be able to recompile the application
+ to use the modified definitions.)
+
+ b) Accompany the work with a written offer, valid for at
+ least three years, to give the same user the materials
+ specified in Subsection 6a, above, for a charge no more
+ than the cost of performing this distribution.
+
+ c) If distribution of the work is made by offering access to copy
+ from a designated place, offer equivalent access to copy the above
+ specified materials from the same place.
+
+ d) Verify that the user has already received a copy of these
+ materials or that you have already sent this user a copy.
+
+ For an executable, the required form of the "work that uses the
+Library" must include any data and utility programs needed for
+reproducing the executable from it. 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.
+
+ It may happen that this requirement contradicts the license
+restrictions of other proprietary libraries that do not normally
+accompany the operating system. Such a contradiction means you cannot
+use both them and the Library together in an executable that you
+distribute.
+\f
+ 7. 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 not covered by this License, and distribute such a combined
+library, provided that the separate distribution of the work based on
+the Library and of the other library facilities is otherwise
+permitted, and provided that you do these two things:
+
+ a) Accompany the combined library with a copy of the same work
+ based on the Library, uncombined with any other library
+ facilities. This must be distributed under the terms of the
+ Sections above.
+
+ b) Give prominent notice with the combined library of the fact
+ that part of it is a work based on the Library, and explaining
+ where to find the accompanying uncombined form of the same work.
+
+ 8. You may not copy, modify, sublicense, link with, or distribute
+the Library except as expressly provided under this License. Any
+attempt otherwise to copy, modify, sublicense, link with, or
+distribute the Library 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.
+
+ 9. 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 Library or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Library (or any work based on the
+Library), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Library or works based on it.
+
+ 10. Each time you redistribute the Library (or any work based on the
+Library), the recipient automatically receives a license from the
+original licensor to copy, distribute, link with or modify the Library
+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.
+\f
+ 11. 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 Library at all. For example, if a patent
+license would not permit royalty-free redistribution of the Library 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 Library.
+
+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.
+
+ 12. If the distribution and/or use of the Library is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Library 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.
+
+ 13. The Free Software Foundation may publish revised and/or new
+versions of the Library 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
+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 Library does not specify a
+license version number, you may choose any version ever published by
+the Free Software Foundation.
+\f
+ 14. If you wish to incorporate parts of the Library into other free
+programs whose distribution conditions are incompatible with these,
+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
+
+ 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
+OTHER PARTIES PROVIDE THE LIBRARY "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
+LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. 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 LIBRARY 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
+LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Libraries
+
+ If you develop a new library, and you want it to be of the greatest
+possible use to the public, we recommend making it free software that
+everyone can redistribute and change. You can do so by permitting
+redistribution under these terms (or, alternatively, under the terms of the
+ordinary General Public License).
+
+ To apply these terms, attach the following notices to the library. 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.
+
+ <one line to give the library's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Library General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This library 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
+ Library General Public License for more details.
+
+ You should have received a copy of the GNU Library General Public
+ License along with this library; if not, write to the
+ Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307 USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the library, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ library `Frob' (a library for tweaking knobs) written by James Random Hacker.
+
+ <signature of Ty Coon>, 1 April 1990
+ Ty Coon, President of Vice
+
+That's all there is to it!
--- /dev/null
+-*-Text-*-
+
+Please see the git commit log:
+
+$ git log origin/master -- src/pgsql/ | more
--- /dev/null
+## Process this file with automake to produce Makefile.in
+##
+## Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+## 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+## 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014,
+## 2015, 2016, 2017 Massachusetts Institute of Technology
+##
+## This file is part of MIT/GNU Scheme.
+##
+## MIT/GNU Scheme 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.
+##
+## MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+## Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+## USA.
+
+ACLOCAL_AMFLAGS = -I m4
+EXTRA_DIST = autogen.sh
+
+MIT_SCHEME_EXE = @MIT_SCHEME_EXE@
+scmlibdir = @MIT_SCHEME_LIBDIR@
+scmlib_subdir = $(scmlibdir)pgsql
+scmdocdir = $(datarootdir)/doc/@MIT_SCHEME_PROJECT@
+#scminfodir = $(scmdocdir)/info
+
+scmlib_LTLIBRARIES = pgsql-shim.la
+scmlib_DATA = pgsql-types.bin pgsql-const.bin
+
+sources = @MIT_SCHEME_SCMs@
+cdecls = pgsql.cdecl
+
+binaries = @MIT_SCHEME_BCIs@ @MIT_SCHEME_COMs@
+
+scmlib_sub_DATA = $(sources) $(binaries)
+scmlib_sub_DATA += make.scm @MIT_SCHEME_PKD@
+
+#scminfo_DATA = pgsql.info
+#AM_MAKEINFOHTMLFLAGS = --no-split
+
+AM_CPPFLAGS = -I@MIT_SCHEME_INCLUDEDIR@
+AM_CFLAGS = @MIT_CFLAGS@ `pkg-config --cflags libpq`
+LIBS = `pkg-config --libs libpq`
+
+pgsql_shim_la_LDFLAGS = -module -avoid-version -shared
+
+noinst_PROGRAMS = pgsql-const
+pgsql_const_SOURCES = pgsql-const.c pgsql-shim.h
+
+pgsql-shim.c: stamp-shim
+pgsql-const.c: stamp-shim
+pgsql-types.bin: stamp-shim
+stamp-shim: pgsql-shim.h $(cdecls)
+ touch stamp-shim
+ echo '(generate-shim "pgsql" "#include \"pgsql-shim.h\"")' \
+ | $(MIT_SCHEME_EXE) --batch-mode \
+ || rm stamp-shim
+
+pgsql-const.bin: pgsql-const.scm
+ echo '(sf "pgsql-const")' | $(MIT_SCHEME_EXE) --batch-mode
+
+pgsql-const.scm: pgsql-const
+ ./pgsql-const
+
+@MIT_SCHEME_DEPS@
+stamp-scheme: stamp-shim $(sources) pgsql.pkg
+ touch stamp-scheme
+ if ! echo '(load "compile.scm")' \
+ | $(MIT_SCHEME_EXE) --prepend-library . --batch-mode; then \
+ rm stamp-scheme; exit 1; fi
+
+CLEANFILES = pgsql-const* pgsql-shim.c
+CLEANFILES += *.bin *.ext *.com *.bci *.moc *.fni *.crf *.fre *.pkd
+CLEANFILES += stamp-shim stamp-scheme
+CLEANFILES += @MIT_SCHEME_CLEAN@
+
+TESTS = pgsql-check.sh
+CLEANFILES += pgsql-check.db
+
+tags: tags-am
+ ./tags-fix.sh pgsql
+
+all_sources = $(sources)
+ETAGS_ARGS = $(all_sources) -r '/^([^iI].*/' $(cdecls)
+TAGS_DEPENDENCIES = $(all_sources) $(cdecls)
+
+EXTRA_DIST += $(all_sources) $(cdecls) compile.scm pgsql.pkg
+EXTRA_DIST += pgsql-check.scm pgsql-check.sh
+EXTRA_DIST += make.scm optiondb.scm tags-fix.sh debian
+
+install-data-hook:
+ ( echo '(add-plugin "pgsql" "@MIT_SCHEME_PROJECT@"'; \
+ echo ' ""'; \
+ echo ' "$(DESTDIR)$(scmlibdir)"'; \
+ echo ' "$(DESTDIR)$(scmdocdir)")' ) \
+ | $(MIT_SCHEME_EXE) --batch-mode
+
+install-html: install-html-am
+ ( echo '(add-plugin "pgsql" "@MIT_SCHEME_PROJECT@"'; \
+ echo ' ""'; \
+ echo ' "$(DESTDIR)$(scmlibdir)"'; \
+ echo ' "$(DESTDIR)$(scmdocdir)")' ) \
+ | $(MIT_SCHEME_EXE) --batch-mode
+
+install-info-am:
+
+uninstall-info-am:
+
+uninstall-hook:
+ ( echo '(remove-plugin "pgsql" "@MIT_SCHEME_PROJECT@"'; \
+ echo ' ""'; \
+ echo ' "$(DESTDIR)$(scmlibdir)"'; \
+ echo ' "$(DESTDIR)$(scmdocdir)")' ) \
+ | $(MIT_SCHEME_EXE) --batch-mode
+ [ -d "$(DESTDIR)$(scmlib_subdir)" ] \
+ && rmdir "$(DESTDIR)$(scmlib_subdir)"
--- /dev/null
+mit-scheme-pgsql NEWS -- history of user-visible changes.
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+mit-scheme-pgsql 0.1 - Matt Birkholz, 2017-07-02
+================================================
+
+Now a plugin using libtool and automake.
--- /dev/null
+The POSTGRES option.
+
+This plugin creates a (pgsql) package, a drop-in replacement for the
+microcode module based (runtime postgresql) package. It is built in the
+customary GNU way:
+
+ ./configure ...
+ make all check install
+
+To use:
+
+ (load-option 'pgsql)
+ (import-pgsql)
+
+Import-pgsql will modify the REPL's current environment by adding
+bindings linked to the plugin's exports. They are not exported to the
+global environment because they would conflict with the exports from
+(runtime postgresql).
+
+To import into a CREF package set, add this to your .pkg file:
+
+ (global-definitions pgsql/)
+
+ (define-package (your package name)
+ (parent (your package parent))
+ (import (pgsql)
+ call-with-pgsql-conn
+ ...))
--- /dev/null
+#!/bin/sh
+
+set -e
+rm -rf m4
+mkdir m4
+autoreconf --force --install -I m4
--- /dev/null
+#| -*-Scheme-*- |#
+
+;;;; Compile the PGSQL option.
+
+(load-option 'CREF)
+(load-option 'FFI)
+(compile-file "pgsql" '() (->environment '()))
+(cref/generate-constructors "pgsql")
\ No newline at end of file
--- /dev/null
+dnl Process this file with autoconf to produce a configure script.
+
+AC_PREREQ([2.69])
+AC_INIT([MIT/GNU Scheme pgsql plugin],
+ [0.1],
+ [bug-mit-scheme@gnu.org],
+ [mit-scheme-pgsql])
+AC_CONFIG_SRCDIR([pgsql.pkg])
+AC_CONFIG_HEADERS([config.h])
+AC_CONFIG_MACRO_DIR([m4])
+
+AC_COPYRIGHT(
+[Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+])
+
+AH_TOP([/*
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+*/])
+
+AM_INIT_AUTOMAKE
+
+LT_PREREQ([2.2.6])
+LT_INIT([dlopen])
+
+AC_PROG_CC
+AC_PROG_CPP
+AC_PROG_INSTALL
+
+if test ${GCC} = yes; then
+
+ MIT_CFLAGS="-Wall -Wundef -Wpointer-arith -Winline"
+ MIT_CFLAGS="${MIT_CFLAGS} -Wstrict-prototypes -Wnested-externs"
+ MIT_CFLAGS="${MIT_CFLAGS} -Wredundant-decls"
+
+ AC_MSG_CHECKING([for GCC>=4])
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[
+ #if __GNUC__ >= 4
+ ;
+ #else
+ #error "gcc too old"
+ #endif
+ ]],
+ [[]]
+ )],
+ [
+ AC_MSG_RESULT([yes])
+ MIT_CFLAGS="${MIT_CFLAGS} -Wextra -Wno-sign-compare"
+ MIT_CFLAGS="${MIT_CFLAGS} -Wno-unused-parameter"
+ MIT_CFLAGS="${MIT_CFLAGS} -Wold-style-definition"
+ # The generated shim code violates this big-time.
+ # MIT_CFLAGS="${MIT_CFLAGS} -Wmissing-prototypes"
+ MIT_CFLAGS="${MIT_CFLAGS} -Wunreachable-code"
+ MIT_CFLAGS="${MIT_CFLAGS} -Wwrite-strings"
+ ],
+ [AC_MSG_RESULT([no])])
+fi
+
+AC_CHECK_PROG([PKG_CONFIG], [pkg-config], [yes])
+
+if ! pkg-config --exists libpq 2>/dev/null; then
+ AC_MSG_ERROR([PostgreSQL not found.])
+fi
+
+AC_DEFINE([HAVE_LIBPQ_FE_H], [1],
+ [Define to 1 if you have the <libpq-fe.h> header file.])
+
+MIT_SCHEME_PROJECT=mit-scheme
+: ${MIT_SCHEME_EXE=mit-scheme}
+MIT_SCHEME_LIBDIR=`( echo "(display (->namestring" ;\
+ echo " (system-library-directory-pathname)))" ) \
+ | ${MIT_SCHEME_EXE} --batch-mode`
+MIT_SCHEME_INCLUDEDIR=`( echo "(display (->namestring" ;\
+ echo " (directory-pathname" ;\
+ echo " (system-library-pathname" ;\
+ echo ' "mit-scheme.h"))))' ) \
+ | ${MIT_SCHEME_EXE} --batch-mode`
+
+cc_type=`echo "(display microcode-id/compiled-code-type)" \
+ | ${MIT_SCHEME_EXE} --batch-mode`
+os_suffix=`echo "(display (microcode-id/operating-system-suffix))" \
+ | ${MIT_SCHEME_EXE} --batch-mode`
+
+MIT_SCHEME_PKD="pgsql-${os_suffix}.pkd"
+
+for f in pgsql; do
+ MIT_SCHEME_SCMs="${MIT_SCHEME_SCMs} ${f}.scm"
+ MIT_SCHEME_BCIs="${MIT_SCHEME_BCIs} ${f}.bci"
+ MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
+${f}.bci: stamp-scheme"
+ if test "$cc_type" = "c"; then
+ MIT_SCHEME_COMs="${MIT_SCHEME_COMs} ${f}.so"
+ MIT_SCHEME_CLEAN="${MIT_SCHEME_CLEAN} ${f}.c"
+ MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
+${f}.so: stamp-scheme"
+ else
+ MIT_SCHEME_COMs="${MIT_SCHEME_COMs} ${f}.com"
+ MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
+${f}.com: stamp-scheme"
+ fi
+done
+MIT_SCHEME_DEPS="${MIT_SCHEME_DEPS}
+${MIT_SCHEME_PKD}: stamp-scheme"
+
+AC_SUBST([MIT_SCHEME_PROJECT])
+AC_SUBST([MIT_CFLAGS])
+AC_SUBST([MIT_SCHEME_EXE])
+AC_SUBST([MIT_SCHEME_LIBDIR])
+AC_SUBST([MIT_SCHEME_INCLUDEDIR])
+AC_SUBST([MIT_SCHEME_PKD])
+AC_SUBST([MIT_SCHEME_SCMs])
+AC_SUBST([MIT_SCHEME_BCIs])
+AC_SUBST([MIT_SCHEME_COMs])
+AC_SUBST([MIT_SCHEME_CLEAN])
+AC_SUBST([MIT_SCHEME_DEPS])
+AM_SUBST_NOTMAKE([MIT_SCHEME_DEPS])
+AC_CONFIG_FILES([Makefile])
+AC_OUTPUT
--- /dev/null
+#| -*-Scheme-*- |#
+
+;;;; Load the PGSQL option.
+
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+ (lambda ()
+ (load-package-set "pgsql")))
+
+(add-subsystem-identification! "PGSQL" '(0 1))
\ No newline at end of file
--- /dev/null
+#| -*-Scheme-*- |#
+
+(define-load-option 'PGSQL
+ (standard-system-loader "."))
+
+(further-load-options
+ (named-lambda (system-load-options)
+ (merge-pathnames "optiondb"
+ (cadr (access library-directory-path
+ (->environment '(runtime pathname)))))))
\ No newline at end of file
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; Test the PGSQL option.
+
+(let ((conn (open-pgsql-conn "")))
+
+ (define (query . strings)
+ (let ((query (string-append* strings)))
+ (exec-pgsql-query conn query)))
+
+ (define (cmd . strings)
+ (let ((result (apply query strings)))
+ (let ((status (pgsql-cmd-status result)))
+ (pgsql-clear result)
+ status)))
+
+ (if (not (pgsql-conn-open? conn))
+ (error "could not connect:" conn))
+ (ignore-errors (lambda ()
+ (cmd "DROP TABLE monkey_business;")))
+ (cmd "CREATE TABLE monkey_business ( name varchar (10) PRIMARY KEY );")
+ (cmd "INSERT INTO monkey_business (name) VALUES ('apple');")
+ (cmd "INSERT INTO monkey_business (name) VALUES ('banana');")
+ (cmd "INSERT INTO monkey_business (name) VALUES ('cherry');")
+ (let* ((result (query "SELECT * FROM monkey_business;"))
+ (n (pgsql-n-tuples result))
+ (fruits
+ (do ((i 0 (+ i 1))
+ (fruits '()
+ (cons (pgsql-get-value result i 0) fruits)))
+ ((= i n)
+ (pgsql-clear result)
+ (reverse! fruits)))))
+ (if (not (equal? fruits '("apple" "banana" "cherry")))
+ (error "wrong fruits")))
+ (close-pgsql-conn conn)
+ (if (pgsql-conn-open? conn)
+ (error "could not pgsql close:" conn))
+ (if (not (condition?
+ (ignore-errors
+ (lambda ()
+ (exec-pgsql-query conn "SELECT * FROM monkey_business;")))))
+ (error "not signaling an error when closed:" conn))
+ (let* ((sample " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~")
+ (escaped (escape-pgsql-string sample))
+ (expected " !\"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"))
+ (if (not (equal? escaped expected))
+ (error "not escaped properly:" escaped))))
\ No newline at end of file
--- /dev/null
+#!/bin/sh
+#
+# Test the PostgreSQL option.
+
+set -e
+${MIT_SCHEME_EXE} --prepend-library . <<\EOF
+(load-option 'PGSQL)
+(load "pgsql-check" (->environment '(pgsql)))
+EOF
--- /dev/null
+/* -*-C-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+*/
+
+/* Interface to the pgsql database library */
+
+#include "config.h"
+
+#ifdef HAVE_LIBPQ_FE_H
+# include <libpq-fe.h>
+#endif
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; C declarations for pgsql-shim.so.
+\f
+
+(typedef ConnStatusType
+ (enum (CONNECTION_OK)
+ (CONNECTION_BAD)
+ (CONNECTION_STARTED)
+ (CONNECTION_MADE)
+ (CONNECTION_AWAITING_RESPONSE)
+ (CONNECTION_AUTH_OK)
+ (CONNECTION_SETENV)
+ (CONNECTION_SSL_STARTUP)
+ (CONNECTION_NEEDED)))
+
+(typedef ExecStatusType
+ (enum (PGRES_EMPTY_QUERY)
+ (PGRES_COMMAND_OK)
+ (PGRES_TUPLES_OK)
+ (PGRES_COPY_OUT)
+ (PGRES_COPY_IN)
+ (PGRES_BAD_RESPONSE)
+ (PGRES_NONFATAL_ERROR)
+ (PGRES_FATAL_ERROR)
+ (PGRES_COPY_BOTH)
+ (PGRES_SINGLE_TUPLE)))
+
+(typedef PostgresPollingStatusType
+ (enum (PGRES_POLLING_FAILED) ; = 0
+ (PGRES_POLLING_READING) ; These two indicate that one may
+ (PGRES_POLLING_WRITING) ; use select before polling again.
+ (PGRES_POLLING_OK)
+ (PGRES_POLLING_ACTIVE))) ; unused
+
+(typedef size_t uint)
+
+(extern void PQclear (res (* PGresult)))
+
+(extern (* char) PQcmdStatus (res (* PGresult)))
+
+(extern (* char) PQcmdTuples (res (* PGresult)))
+
+(extern (* PGconn) PQconnectdb (conninfo (* (const char))))
+
+(extern uint PQconnectPoll (conn (* PGconn)))
+
+(extern (* PGconn) PQconnectStart (conninfo (* (const char))))
+
+(extern (* char) PQdb (conn (* (const PGconn))))
+
+(extern int PQendcopy (conn (* PGconn)))
+
+(extern (* char) PQerrorMessage (conn (* (const PGconn))))
+
+(extern (* uchar) PQescapeBytea
+ (from (* (const uchar)))
+ (from_length size_t)
+ (to_length (* size_t)))
+
+(extern size_t PQescapeString
+ (to (* char))
+ (from (* (const char)))
+ (length size_t))
+
+(extern (* PGresult) PQexec (conn (* PGconn))
+ (query (* (const char))))
+
+(extern void PQfinish (conn (* PGconn)))
+
+(extern (* char) PQfname
+ (res (* (const PGresult)))
+ (column_number int))
+
+(extern int PQgetisnull
+ (res (* (const PGresult)))
+ (tup_num int)
+ (field_num int))
+
+(extern int PQgetline
+ (conn (* PGconn))
+ (buffer (* char))
+ (length int))
+
+(extern void PQfreemem
+ (ptr (* void)))
+
+(extern (* char) PQgetvalue
+ (res (* (const PGresult)))
+ (tup_num int)
+ (field_num int))
+
+(extern (* char) PQhost (conn (* (const PGconn))))
+
+(extern (* (const PGresult))
+ PQmakeEmptyPGresult
+ (conn (* PGconn))
+ (status ExecStatusType))
+
+(extern int PQnfields (res (* (const PGresult))))
+
+(extern int PQntuples (res (* (const PGresult))))
+
+(extern (* char) PQoptions (conn (* (const PGconn))))
+
+(extern (* char) PQpass (conn (* (const PGconn))))
+
+(extern (* char) PQport (conn (* (const PGconn))))
+
+(extern int PQputline
+ (conn (* PGconn))
+ (string (* (const char))))
+
+(extern void PQreset (conn (* PGconn)))
+
+(extern PostgresPollingStatusType
+ PQresetPoll (conn (* PGconn)))
+
+(extern int PQresetStart (conn (* PGconn)))
+
+(extern (* char) PQresStatus (status ExecStatusType))
+
+(extern (* char) PQresultErrorMessage (res (* (const PGresult))))
+
+(extern ExecStatusType
+ PQresultStatus (res (* (const PGresult))))
+
+(extern ConnStatusType
+ PQstatus (res (* (const PGconn))))
+
+(extern (* char) PQtty (conn (* (const PGconn))))
+
+(extern (* uchar) PQunescapeBytea
+ (from (* (const uchar)))
+ (to_length (* size_t)))
+
+(extern (* char) PQuser (conn (* (const PGconn))))
\ No newline at end of file
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+(global-definitions runtime/)
+
+(define-package (pgsql)
+ (files "pgsql")
+ (parent ())
+ (initialization (initialize-package!))
+ (import (runtime ustring)
+ cp1-ref
+ ustring-cp-size
+ ustring?)
+ (export ()
+ import-pgsql)
+ (export (pgsql global)
+ call-with-pgsql-conn
+ close-pgsql-conn
+ condition-type:pgsql-connection-error
+ condition-type:pgsql-error
+ condition-type:pgsql-query-error
+ decode-pgsql-bytea
+ encode-pgsql-bytea
+ escape-pgsql-string
+ exec-pgsql-query
+; guarantee-pgsql-available
+ make-empty-pgsql-result
+ open-pgsql-conn
+; pgsql-available?
+ pgsql-bad-response
+ pgsql-clear
+ pgsql-cmd-status
+ pgsql-cmd-tuples
+ pgsql-command-ok
+ pgsql-conn-db
+ pgsql-conn-error-message
+ pgsql-conn-host
+ pgsql-conn-open?
+ pgsql-conn-options
+ pgsql-conn-pass
+ pgsql-conn-port
+ pgsql-conn-reset
+ pgsql-conn-reset-start
+ pgsql-conn-status
+ pgsql-conn-tty
+ pgsql-conn-user
+ pgsql-connection-auth-ok
+ pgsql-connection-awaiting-response
+ pgsql-connection-bad
+ pgsql-connection-made
+ pgsql-connection-ok
+ pgsql-connection-setenv
+ pgsql-connection-started
+ pgsql-copy-in
+ pgsql-copy-out
+ pgsql-empty-query
+ pgsql-fatal-error
+ pgsql-field-name
+ pgsql-get-is-null?
+ pgsql-get-line
+ pgsql-get-value
+ pgsql-n-fields
+ pgsql-n-tuples
+ pgsql-nonfatal-error
+ pgsql-polling-active
+ pgsql-polling-failed
+ pgsql-polling-ok
+ pgsql-polling-reading
+ pgsql-polling-writing
+ pgsql-put-line
+ pgsql-result-error-message
+ pgsql-result-status
+ pgsql-tuples-ok
+ poll-pgsql-conn
+ poll-pgsql-reset))
+
+(define-package (pgsql global)
+ ;; Just to get cref to analyze whether all exports are defined.
+ )
\ No newline at end of file
--- /dev/null
+#| -*-Scheme-*-
+
+Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
+ 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016,
+ 2017 Massachusetts Institute of Technology
+
+This file is part of MIT/GNU Scheme.
+
+MIT/GNU Scheme 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.
+
+MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
+Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
+USA.
+
+|#
+
+;;;; PostgreSQL Interface
+;;; package: (pgsql)
+
+(declare (usual-integrations))
+\f
+(define (import-pgsql)
+ (let ((target-environment (nearest-repl/environment))
+ (source-environment (->environment '(pgsql))))
+ (for-each (lambda (name)
+ (link-variables target-environment name
+ source-environment name))
+ '(
+ call-with-pgsql-conn
+ close-pgsql-conn
+ condition-type:pgsql-connection-error
+ condition-type:pgsql-error
+ condition-type:pgsql-query-error
+ decode-pgsql-bytea
+ encode-pgsql-bytea
+ escape-pgsql-string
+ exec-pgsql-query
+ ;; guarantee-pgsql-available
+ make-empty-pgsql-result
+ open-pgsql-conn
+ ;; pgsql-available?
+ pgsql-bad-response
+ pgsql-clear
+ pgsql-cmd-status
+ pgsql-cmd-tuples
+ pgsql-command-ok
+ pgsql-conn-db
+ pgsql-conn-error-message
+ pgsql-conn-host
+ pgsql-conn-open?
+ pgsql-conn-options
+ pgsql-conn-pass
+ pgsql-conn-port
+ pgsql-conn-reset
+ pgsql-conn-reset-start
+ pgsql-conn-status
+ pgsql-conn-tty
+ pgsql-conn-user
+ pgsql-connection-auth-ok
+ pgsql-connection-awaiting-response
+ pgsql-connection-bad
+ pgsql-connection-made
+ pgsql-connection-ok
+ pgsql-connection-setenv
+ pgsql-connection-started
+ pgsql-copy-in
+ pgsql-copy-out
+ pgsql-empty-query
+ pgsql-fatal-error
+ pgsql-field-name
+ pgsql-get-is-null?
+ pgsql-get-line
+ pgsql-get-value
+ pgsql-n-fields
+ pgsql-n-tuples
+ pgsql-nonfatal-error
+ pgsql-polling-active
+ pgsql-polling-failed
+ pgsql-polling-ok
+ pgsql-polling-reading
+ pgsql-polling-writing
+ pgsql-put-line
+ pgsql-result-error-message
+ pgsql-result-status
+ pgsql-tuples-ok
+ poll-pgsql-conn
+ poll-pgsql-reset
+ ))))
+
+(C-include "pgsql")
+
+(define-integrable (every-loop proc ref string start end)
+ (let loop ((i start))
+ (if (fix:< i end)
+ (and (proc (ref string i))
+ (loop (fix:+ i 1)))
+ #t)))
+
+(define (->bytes string)
+ (if (and (or (bytevector? string)
+ (and (ustring? string)
+ (fix:= 1 (ustring-cp-size string))))
+ (let ((end (string-length string)))
+ (every-loop (lambda (cp) (fix:< cp #x80))
+ cp1-ref string 0 end)))
+ string
+ (string->utf8 string)))
+
+(declare (integrate-operator bytes-length))
+(define (bytes-length bytes)
+ (if (bytevector? bytes)
+ (bytevector-length bytes)
+ (string-length bytes)))
+
+;(define-primitives
+; (pq-clear 1)
+
+(define-integrable (pq-clear handle)
+ (C-call "PQclear" handle))
+
+(define-integrable (peek-cstring alien)
+ (let ((bv (c-peek-cstring alien)))
+ (if (bytevector? bv)
+ (utf8->string bv)
+ bv)))
+
+; (pq-cmd-status 1)
+
+(define-integrable (pq-cmd-status handle)
+ (peek-cstring (C-call "PQcmdStatus" (make-alien 'char) handle)))
+
+; (pq-cmd-tuples 1)
+
+(define-integrable (pq-cmd-tuples handle)
+ (peek-cstring (C-call "PQcmdTuples" (make-alien 'char) handle)))
+
+; (pq-connect-db 2)
+
+(define-integrable (pq-connect-db conninfo weak-pair)
+ (weak-set-cdr! weak-pair
+ (C-call "PQconnectdb" (make-alien '|PGconn|) conninfo)))
+
+; (pq-connect-poll 1)
+
+(define-integrable (pq-connect-poll handle)
+ (C-call "PQconnectPoll" handle))
+
+; (pq-connect-start 2)
+
+(define-integrable (pq-connect-start conninfo weak-pair)
+ (weak-set-cdr! weak-pair
+ (C-call "PQconnectStart" (make-alien '|PGconn|) conninfo)))
+
+; (pq-db 1)
+
+(define-integrable (pq-db handle)
+ (peek-cstring (C-call "PQdb" handle)))
+
+; (pq-end-copy 1)
+
+(define-integrable (pq-end-copy handle)
+ (C-call "PQendcopy" handle))
+
+; (pq-error-message 1)
+
+(define-integrable (pq-error-message conn)
+ (peek-cstring (C-call "PQerrorMessage" (make-alien 'char) conn)))
+
+; (pq-escape-bytea 1)
+
+(define (pq-escape-bytea string)
+ (peek-memory string
+ (lambda (memory bytes length)
+ (C-call "PQescapeBytea" (memory-alien memory)
+ bytes (bytes-length bytes) length))))
+
+(define (peek-memory string callout)
+ (let ((bytes (->bytes string))
+ (memory (create-memory))
+ (length (malloc (c-sizeof "size_t") '|size_t|)))
+ (callout memory bytes length)
+ (if (alien-null? (memory-alien memory))
+ (error "insufficient memory")
+ (let* ((nbytes (C-> length "size_t")) ;includes terminating #\null
+ (bv (make-bytevector nbytes)))
+ (c-peek-bytes (memory-alien memory) 0 nbytes bv 0)
+ (free length)
+ (free-memory memory)
+ bv))))
+
+(define (free-memory memory)
+ (remove-from-gc-finalizer! memories memory))
+
+(define (create-memory)
+ (make-gc-finalized-object
+ memories
+ (lambda (p)
+ (weak-set-cdr! p (make-alien 'uchar)))
+ (lambda (alien)
+ (make-memory alien))))
+
+; (pq-escape-string 2)
+
+(declare (integrate-operator pq-escape-string))
+(define (pq-escape-string bytes escaped)
+ (C-call "PQescapeString" escaped bytes (bytes-length bytes)))
+
+; (pq-exec 3)
+
+(define-integrable (pq-exec handle query weak-pair)
+ (weak-set-cdr! weak-pair
+ (C-call "PQexec" (make-alien '|PQresult|) handle query)))
+
+; (pq-field-name 2)
+
+(define-integrable (pq-field-name handle index)
+ (peek-cstring (C-call "PQfname" (make-alien 'char) handle index)))
+
+; (pq-finish 1)
+
+(define-integrable (pq-finish handle)
+ (C-call "PQfinish" handle))
+
+(define-integrable (pq-freemem handle)
+ (if (not (alien-null? handle))
+ (without-interruption
+ (lambda ()
+ (C-call "PQfreemem" handle)
+ (alien-null! handle)))))
+
+; (pq-get-is-null? 3)
+
+(define-integrable (pq-get-is-null? result tup-num field-num)
+ (= 1 (C-call "PQgetisnull" result tup-num field-num)))
+
+; (pq-get-line 2)
+
+(define-integrable (pq-get-line conn buffer length)
+ (C-call "PQgetline" conn buffer length))
+
+; (pq-get-value 3)
+
+(define-integrable (pq-get-value handle tup-num field-num)
+ (peek-cstring (C-call "PQgetvalue" (make-alien 'char)
+ handle tup-num field-num)))
+
+; (pq-host 1)
+
+(define-integrable (pq-host handle)
+ (peek-cstring (C-call "PQhost" handle)))
+
+; (pq-make-empty-pg-result 3)
+
+(define-integrable (pq-make-empty-pg-result handle status weak-pair)
+ (weak-set-cdr! weak-pair
+ (C-call "PQmakeEmptyPGresult" (make-alien '|PQresult|)
+ handle status)))
+
+; (pq-n-fields 1)
+
+(define-integrable (pq-n-fields handle)
+ (C-call "PQnfields" handle))
+
+; (pq-n-tuples 1)
+
+(define-integrable (pq-n-tuples handle)
+ (C-call "PQntuples" handle))
+
+; (pq-options 1)
+
+(define-integrable (pq-options handle)
+ (peek-cstring (C-call "PQoptions" (make-alien 'char) handle)))
+
+; (pq-pass 1)
+
+(define-integrable (pq-pass handle)
+ (peek-cstring (C-call "PQpass" (make-alien 'char) handle)))
+
+; (pq-port 1)
+
+(define-integrable (pq-port handle)
+ (peek-cstring (C-call "PQport" (make-alien 'char) handle)))
+
+; (pq-put-line 2)
+
+(define-integrable (pq-put-line handle buffer)
+ (C-call "PQputline" handle buffer))
+
+; (pq-res-status 1)
+
+(define-integrable (pq-res-status status)
+ (peek-cstring (C-call "PQresStatus" (make-alien 'char) status)))
+
+; (pq-reset 1)
+
+(define-integrable (pq-reset handle)
+ (C-call "PQreset" handle))
+
+; (pq-reset-poll 1)
+
+(define-integrable (pq-reset-poll handle)
+ (C-call "PQresetPoll" handle))
+
+; (pq-reset-start 1)
+
+(define-integrable (pq-reset-start handle)
+ (C-call "PQresetStart" handle))
+
+; (pq-result-error-message 1)
+
+(define-integrable (pq-result-error-message handle)
+ (peek-cstring (C-call "PQresultErrorMessage" (make-alien 'char) handle)))
+
+; (pq-result-status 1)
+
+(define-integrable (pq-result-status handle)
+ (C-call "PQresultStatus" handle))
+
+; (pq-status 1)
+
+(define-integrable (pq-status handle)
+ (C-call "PQstatus" handle))
+
+; (pq-tty 1)
+
+(define-integrable (pq-tty handle)
+ (peek-cstring (C-call "PQtty" (make-alien 'char) handle)))
+
+; (pq-unescape-bytea 1)
+
+(define (pq-unescape-bytea string)
+ (peek-memory string
+ (lambda (memory bytes length)
+ (C-call "PQunescapeBytea" (memory-alien memory)
+ bytes length))))
+
+; (pq-user 1))
+
+(define-integrable (pq-user handle)
+ (peek-cstring (C-call "PQuser" (make-alien 'char) handle)))
+\f
+(define-syntax define-enum
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(IDENTIFIER * IDENTIFIER) (cdr form))
+ `(BEGIN
+ ,@(let loop ((names (cddr form)) (index 0))
+ (if (pair? names)
+ `((DEFINE ,(car names) ,index)
+ ,@(loop (cdr names) (+ index 1)))
+ '()))
+ (DEFINE ,(cadr form) '#(,@(cddr form))))
+ (ill-formed-syntax form)))))
+
+(define (index->name index enum)
+ (guarantee index-fixnum? index 'INDEX->NAME)
+ (if (not (fix:< index (vector-length enum)))
+ (error:bad-range-argument index 'INDEX->NAME))
+ (vector-ref enum index))
+
+(define-enum connection-status
+ PGSQL-CONNECTION-OK
+ PGSQL-CONNECTION-BAD
+ PGSQL-CONNECTION-STARTED
+ PGSQL-CONNECTION-MADE
+ PGSQL-CONNECTION-AWAITING-RESPONSE
+ PGSQL-CONNECTION-AUTH-OK
+ PGSQL-CONNECTION-SETENV)
+
+(define-enum postgres-polling-status
+ PGSQL-POLLING-FAILED
+ PGSQL-POLLING-READING
+ PGSQL-POLLING-WRITING
+ PGSQL-POLLING-OK
+ PGSQL-POLLING-ACTIVE)
+
+(define-enum exec-status
+ PGSQL-EMPTY-QUERY
+ PGSQL-COMMAND-OK
+ PGSQL-TUPLES-OK
+ PGSQL-COPY-OUT
+ PGSQL-COPY-IN
+ PGSQL-BAD-RESPONSE
+ PGSQL-NONFATAL-ERROR
+ PGSQL-FATAL-ERROR)
+\f
+(define pgsql-initialized? #f)
+(define connections)
+(define results)
+(define memories)
+
+(define-structure connection handle)
+(define-structure result handle)
+(define-structure memory alien)
+
+(define-syntax define-guarantee
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form))
+ (let ((type (cadr form)))
+ (let ((type? (symbol type '?))
+ (guarantee-type (symbol 'GUARANTEE- type))
+ (error:not-type (symbol 'ERROR:NOT- type))
+ (guarantee-valid-type (symbol 'GUARANTEE-VALID- type))
+ (type-handle (symbol type '-HANDLE)))
+ `(BEGIN
+ (DEFINE-INTEGRABLE (,guarantee-type OBJECT CALLER)
+ (IF (NOT (,type? OBJECT))
+ (,error:not-type OBJECT CALLER)))
+ (DEFINE (,error:not-type OBJECT CALLER)
+ (ERROR:WRONG-TYPE-ARGUMENT OBJECT ,(caddr form) CALLER))
+ (DEFINE-INTEGRABLE (,guarantee-valid-type OBJECT CALLER)
+ (IF (AND (,type? OBJECT) (,type-handle OBJECT))
+ (,type-handle OBJECT)
+ (,error:not-type OBJECT CALLER))))))
+ (ill-formed-syntax form)))))
+
+(define-guarantee connection "PostgreSQL connection")
+(define-guarantee result "PostgreSQL query result")
+
+(define (initialize-package!)
+ (if (not pgsql-initialized?)
+ (begin
+ (set! connections
+ (make-gc-finalizer pq-finish
+ connection?
+ connection-handle
+ set-connection-handle!))
+ (set! results
+ (make-gc-finalizer pq-clear
+ result?
+ result-handle
+ set-result-handle!))
+ (set! memories
+ (make-gc-finalizer pq-freemem
+ memory?
+ memory-alien
+ set-memory-alien!))
+ (set! pgsql-initialized? #t))))
+
+#;(define (guarantee-pgsql-available)
+ (if (not (pgsql-available?))
+ (error "This Scheme system was built without PostgreSQL support.")))
+\f
+(define condition-type:pgsql-error
+ (make-condition-type 'PGSQL-ERROR condition-type:error '()
+ (lambda (condition port)
+ condition
+ (write-string "Unknown PostgreSQL error." port))))
+
+(define condition-type:pgsql-connection-error
+ (make-condition-type 'PGSQL-CONNECTION-ERROR condition-type:pgsql-error
+ '(MESSAGE)
+ (lambda (condition port)
+ (write-string "Unable to connect to PostgreSQL server" port)
+ (write-message (access-condition condition 'MESSAGE) port))))
+
+(define error:pgsql-connection
+ (condition-signaller condition-type:pgsql-connection-error
+ '(MESSAGE)
+ standard-error-handler))
+
+(define condition-type:pgsql-query-error
+ (make-condition-type 'PGSQL-QUERY-ERROR condition-type:pgsql-error
+ '(QUERY RESULT)
+ (lambda (condition port)
+ (write-string "PostgreSQL query error" port)
+ (write-message
+ (pgsql-result-error-message (access-condition condition 'RESULT))
+ port))))
+
+(define error:pgsql-query
+ (condition-signaller condition-type:pgsql-query-error
+ '(QUERY RESULT)
+ standard-error-handler))
+
+(define (write-message string port)
+ (if string
+ (begin
+ (write-string ": " port)
+ (write-string
+ (let ((result (regsexp-match-string error-regsexp string)))
+ (if result
+ (cdr (assv 'message (cddr result)))
+ string))
+ port))
+ (write-string "." port)))
+
+(define error-regsexp
+ (compile-regsexp
+ '(seq (string-start)
+ (* (char-in whitespace))
+ (? (string-ci "error:"))
+ (* (char-in whitespace))
+ (group message (* (any-char)))
+ (* (char-in whitespace))
+ (string-end))))
+\f
+(define (open-pgsql-conn parameters #!optional wait?)
+ #;(guarantee-pgsql-available)
+ (let ((wait? (if (default-object? wait?) #t wait?)))
+ (make-gc-finalized-object
+ connections
+ (lambda (p)
+ (if wait?
+ (pq-connect-db parameters p)
+ (pq-connect-start parameters p)))
+ (lambda (handle)
+ (cond ((alien-null? handle)
+ (error:pgsql-connection #f))
+ ((= PGSQL-CONNECTION-BAD (pq-status handle))
+ (let ((msg (pq-error-message handle)))
+ (pq-finish handle)
+ (error:pgsql-connection msg))))
+ (make-connection handle)))))
+
+(define (close-pgsql-conn connection)
+ (remove-from-gc-finalizer! connections connection))
+
+(define (call-with-pgsql-conn parameters procedure)
+ (let ((conn))
+ (dynamic-wind (lambda ()
+ (set! conn (open-pgsql-conn parameters))
+ unspecific)
+ (lambda ()
+ (procedure conn))
+ (lambda ()
+ (close-pgsql-conn conn)
+ (set! conn)
+ unspecific))))
+
+(define (pgsql-conn-open? connection)
+ (guarantee-connection connection 'PGSQL-CONN-OPEN?)
+ (if (connection-handle connection) #t #f))
+
+(define-integrable (connection->handle connection)
+ (guarantee-valid-connection connection 'CONNECTION->HANDLE))
+
+(define (poll-pgsql-conn connection)
+ (index->name (pq-connect-poll (connection->handle connection))
+ postgres-polling-status))
+
+(define (poll-pgsql-reset connection)
+ (index->name (pq-reset-poll (connection->handle connection))
+ postgres-polling-status))
+\f
+(define-syntax define-connection-accessor
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(SYMBOL) (cdr form))
+ (let ((field (cadr form)))
+ `(DEFINE (,(symbol 'PGSQL-CONN- field) OBJECT)
+ (,(symbol 'PQ- field) (CONNECTION->HANDLE OBJECT))))
+ (ill-formed-syntax form)))))
+
+(define-connection-accessor db)
+(define-connection-accessor user)
+(define-connection-accessor pass)
+(define-connection-accessor host)
+(define-connection-accessor port)
+(define-connection-accessor tty)
+(define-connection-accessor options)
+(define-connection-accessor reset)
+(define-connection-accessor reset-start)
+(define-connection-accessor error-message)
+
+(define (pgsql-conn-status connection)
+ (index->name (pq-status (connection->handle connection)) connection-status))
+
+(define (pgsql-get-line connection buffer)
+ (pq-get-line (connection->handle connection)
+ buffer (bytevector-length buffer)))
+
+(define (pgsql-put-line connection buffer)
+ (pq-put-line (connection->handle connection) buffer))
+
+(define (pgsql-end-copy connection)
+ (pq-end-copy (connection->handle connection)))
+
+(define (escape-pgsql-string string)
+ ;;(guarantee-pgsql-available)
+ (let* ((bytes (->bytes string))
+ (length (bytes-length bytes))
+ (escaped-bytes (malloc (fix:1+ (fix:* 2 length)) 'char))
+ (escaped-string (begin
+ (pq-escape-string bytes escaped-bytes)
+ (peek-cstring escaped-bytes))))
+ (free escaped-bytes)
+ escaped-string))
+
+(define (encode-pgsql-bytea bytes)
+ (guarantee-pgsql-available)
+ (pq-escape-bytea bytes))
+
+(define (decode-pgsql-bytea string)
+ (guarantee-pgsql-available)
+ (pq-unescape-bytea string))
+\f
+(define (exec-pgsql-query connection query)
+ (guarantee string? query 'EXEC-PGSQL-QUERY)
+ (let ((result
+ (let ((handle (connection->handle connection)))
+ (make-gc-finalized-object
+ results
+ (lambda (p)
+ (pq-exec handle query p))
+ (lambda (result-handle)
+ (if (alien-null? result-handle)
+ (error "Unable to execute PostgreSQL query:" query))
+ (make-result result-handle))))))
+ (if (not (memq (pgsql-result-status result)
+ '(PGSQL-COMMAND-OK
+ PGSQL-TUPLES-OK
+ PGSQL-COPY-OUT
+ PGSQL-COPY-IN)))
+ (error:pgsql-query query result))
+ result))
+
+(define (make-empty-pgsql-result connection status)
+ (let ((handle (connection->handle connection)))
+ (make-gc-finalized-object
+ results
+ (lambda (p)
+ (pq-make-empty-pg-result handle status p))
+ (lambda (result-handle)
+ (if (= 0 result-handle)
+ (error "Unable to create PostgreSQL result:" status))
+ (make-result result-handle)))))
+
+(define-integrable (result->handle result operator)
+ (guarantee-valid-result result operator))
+
+(define-syntax define-result-accessor
+ (sc-macro-transformer
+ (lambda (form environment)
+ environment
+ (if (syntax-match? '(SYMBOL) (cdr form))
+ (let* ((field (cadr form))
+ (operator (symbol 'PGSQL- field)))
+ `(DEFINE (,operator OBJECT)
+ (,(symbol 'PQ- field) (RESULT->HANDLE OBJECT ',operator))))
+ (ill-formed-syntax form)))))
+
+(define-result-accessor result-error-message)
+(define-result-accessor n-tuples)
+(define-result-accessor n-fields)
+(define-result-accessor cmd-status)
+
+(define (pgsql-result-status result)
+ (index->name (pq-result-status (result->handle result 'pgsql-result-status))
+ exec-status))
+
+(define (pgsql-clear result)
+ (remove-from-gc-finalizer! results result))
+
+(define (pgsql-field-name result index)
+ (pq-field-name (result->handle result 'pgsql-field-name) index))
+
+(define (pgsql-get-value result row column)
+ (let ((handle (result->handle result 'pgsql-get-value)))
+ (if (pq-get-is-null? handle row column)
+ #f
+ (pq-get-value handle row column))))
+
+(define (pgsql-get-is-null? result row column)
+ (pq-get-is-null? (result->handle result 'pgsql-get-is-null?) row column))
+
+(define (pgsql-cmd-tuples result)
+ (string->number (pq-cmd-tuples (result->handle result 'pgsql-cmd-tuples))))
\ No newline at end of file
--- /dev/null
+#!/bin/sh
+# -*-Scheme-*-
+#
+# Chop the generated $1-shim.c and $1-const.c files out of TAGS.
+
+set -e
+: ${MIT_SCHEME_EXE=mit-scheme}
+${MIT_SCHEME_EXE} --batch-mode -- ${1+"$@"} <<\EOF
+(let ((name (car (command-line))))
+ (let ((shim.c-prefix (string-append name "-shim.c,"))
+ (const.c-prefix (string-append name "-const.c,")))
+
+ (define (rewriter in out)
+ (let loop ((skipping? #f))
+ (let ((line (read-line in)))
+ (cond ((eof-object? line)
+ unspecific)
+ ((string=? line "\f")
+ (let ((next (read-line in)))
+ (cond ((eof-object? next) (error "Bogus TAGS format:" next))
+ ((or (string-prefix? shim.c-prefix next)
+ (string-prefix? const.c-prefix next))
+ (loop #t))
+ (else
+ (write-string line out)
+ (newline out)
+ (write-string next out)
+ (newline out)
+ (loop #f)))))
+ (skipping?
+ (loop skipping?))
+ (else
+ (write-string line out)
+ (newline out)
+ (loop skipping?))))))
+
+ (parameterize ((param:suppress-loading-message? #t))
+ (load-option 'FFI))
+ ((access rewrite-file (->environment '(ffi build)))
+ (merge-pathnames "TAGS")
+ rewriter)))
+EOF
projects / mit-scheme.git / commitdiff