pgsql: downcase symbols, most names; fix copyright notices
authorMatt Birkholz <matt@birchwood-abbey.net>
Wed, 7 Aug 2019 00:05:48 +0000 (17:05 -0700)
committerMatt Birkholz <matt@birchwood-abbey.net>
Wed, 7 Aug 2019 18:47:41 +0000 (11:47 -0700)
src/pgsql/compile.scm
src/pgsql/compile.sh
src/pgsql/configure.ac
src/pgsql/make.scm
src/pgsql/optiondb.scm
src/pgsql/pgsql-check.scm
src/pgsql/pgsql-check.sh
src/pgsql/pgsql.scm

index 91c447aea8984fa8242431888365fae75fec5d85..f26bd7568fb952246d725889ffc3c521c47f218d 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*- |#
 
-;;;; Compile the PGSQL option.
+;;;; Compile the PostgreSQL option.
 
 (load-option 'cref)
 (with-working-directory-pathname (directory-pathname (current-load-pathname))
index 3fdf9a12bd2f776d9bee61bc6794a5b5963ebcbb..b4d7c9b4dd55ae4cdd08e29efe021d0e73b68ec0 100755 (executable)
@@ -7,20 +7,20 @@
 #     2015, 2016, 2017, 2018, 2019 Massachusetts Institute of
 #     Technology
 #
-# This file is part of a PostgreSQL plugin for MIT/GNU Scheme.
+# This file is part of MIT/GNU Scheme.
 #
-# This plugin 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 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 plugin is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
+# 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 this plugin; if not, write to the Free Software
+# along with MIT/GNU Scheme; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
 # 02110-1301, USA.
 
index 234fc939688c06391a8e55ef2fc08e51d2852bc5..e7952a234a3709c0cef94492fa525cbadeaa6b78 100644 (file)
@@ -1,7 +1,7 @@
 dnl Process this file with autoconf to produce a configure script.
 
 AC_PREREQ([2.69])
-AC_INIT([MIT/GNU Scheme pgsql plugin],
+AC_INIT([MIT/GNU Scheme PostgreSQL plugin],
         [1.0],
         [bug-mit-scheme@gnu.org],
         [mit-scheme-pgsql])
index bc7d1e3b0223638ad735a2d0d500a740ca774f90..fcb5e3bcee24263ec5b35ec81aefcc7f1c3c9d57 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*- |#
 
-;;;; Load the PGSQL option.
+;;;; Load the PostgreSQL option.
 
 (with-working-directory-pathname (directory-pathname (current-load-pathname))
   (lambda ()
index e5a0ef5dd2be124ade14764fedf36434555d7d1b..fab38d525165dbedd00fd1d0e2d4561574613d28 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*- |#
 
-(define-load-option 'PGSQL
+(define-load-option 'pgsql
   (standard-system-loader "."))
 
 (further-load-options #t)
\ No newline at end of file
index 67206a27c176838ad7cc40951a1c3c4e5e60ad61..6d751e49444f126c8aec9b4a5c6c062080796222 100644 (file)
@@ -24,7 +24,7 @@ USA.
 
 |#
 
-;;;; Test the PGSQL option.
+;;;; Test the PostgreSQL option.
 
 (let ((conn (ignore-errors (lambda () (open-pgsql-conn "")))))
 
index 8a67307d1f18f315fff33226491817c534edd8e6..94721acc5447c8ed264cbebfc975ca50ac6c4bc3 100755 (executable)
@@ -4,6 +4,6 @@
 
 set -e
 ${MIT_SCHEME_EXE} --prepend-library . <<\EOF
-(load-option 'PGSQL)
+(load-option 'pgsql)
 (load "pgsql-check" (->environment '(postgresql)))
 EOF
index c5761a2625ed9c801ccc9b8b6ed66812101cb842..ca2de2bd1062903dd32eb023fa7a50e0c29e2773 100644 (file)
@@ -283,46 +283,46 @@ USA.
    (lambda (form environment)
      environment
      (if (syntax-match? '(identifier * identifier) (cdr form))
-        `(BEGIN
+        `(begin
            ,@(let loop ((names (cddr form)) (index 0))
                (if (pair? names)
-                    `((DEFINE ,(car names) ,index)
+                    `((define ,(car names) ,index)
                       ,@(loop (cdr names) (+ index 1)))
                     '()))
-           (DEFINE ,(cadr form) '#(,@(cddr form))))
+           (define ,(cadr form) '#(,@(cddr form))))
         (ill-formed-syntax form)))))
 
 (define (index->name index enum)
-  (guarantee index-fixnum? index 'INDEX->NAME)
+  (guarantee index-fixnum? index 'index->name)
   (if (not (fix:< index (vector-length enum)))
-      (error:bad-range-argument index 'INDEX->NAME))
+      (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)
+  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)
+  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)
+  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)
@@ -340,20 +340,20 @@ USA.
      (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))))))
+                (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")
@@ -380,35 +380,35 @@ USA.
        (set! pgsql-initialized? #t))))
 \f
 (define condition-type:pgsql-error
-  (make-condition-type 'PGSQL-ERROR condition-type: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)
+  (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))))
+      (write-message (access-condition condition 'message) port))))
 
 (define error:pgsql-connection
   (condition-signaller condition-type:pgsql-connection-error
-                      '(MESSAGE)
+                      '(message)
                       standard-error-handler))
 
 (define condition-type:pgsql-query-error
-  (make-condition-type 'PGSQL-QUERY-ERROR condition-type:pgsql-error
-      '(QUERY RESULT)
+  (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))
+       (pgsql-result-error-message (access-condition condition 'result))
        port))))
 
 (define error:pgsql-query
   (condition-signaller condition-type:pgsql-query-error
-                      '(QUERY RESULT)
+                      '(query result)
                       standard-error-handler))
 
 (define (write-message string port)
@@ -444,7 +444,7 @@ USA.
      (lambda (handle)
        (cond ((alien-null? handle)
              (error:pgsql-connection #f))
-            ((= PGSQL-CONNECTION-BAD (pq-status handle))
+            ((= pgsql-connection-bad (pq-status handle))
              (let ((msg (pq-error-message handle)))
                (pq-finish handle)
                (error:pgsql-connection msg))))
@@ -466,11 +466,11 @@ USA.
                    unspecific))))
 
 (define (pgsql-conn-open? connection)
-  (guarantee-connection connection 'PGSQL-CONN-OPEN?)
+  (guarantee-connection connection 'pgsql-conn-open?)
   (if (connection-handle connection) #t #f))
 
 (define-integrable (connection->handle connection)
-  (guarantee-valid-connection connection 'CONNECTION->HANDLE))
+  (guarantee-valid-connection connection 'connection->handle))
 
 (define (poll-pgsql-conn connection)
   (index->name (pq-connect-poll (connection->handle connection))
@@ -486,8 +486,8 @@ USA.
      environment
      (if (syntax-match? '(symbol) (cdr form))
         (let ((field (cadr form)))
-          `(DEFINE (,(symbol 'PGSQL-CONN- field) OBJECT)
-             (,(symbol 'PQ- field) (CONNECTION->HANDLE OBJECT))))
+          `(define (,(symbol 'pgsql-conn- field) object)
+             (,(symbol 'pq- field) (connection->handle object))))
         (ill-formed-syntax form)))))
 
 (define-connection-accessor db)
@@ -531,7 +531,7 @@ USA.
   (pq-unescape-bytea string))
 \f
 (define (exec-pgsql-query connection query)
-  (guarantee string? query 'EXEC-PGSQL-QUERY)
+  (guarantee string? query 'exec-pgsql-query)
   (let ((result
         (let ((handle (connection->handle connection)))
           (make-gc-finalized-object
@@ -543,10 +543,10 @@ USA.
                  (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)))
+                  '(pgsql-command-ok
+                    pgsql-tuples-ok
+                    pgsql-copy-out
+                    pgsql-copy-in)))
        (error:pgsql-query query result))
     result))
 
@@ -570,9 +570,9 @@ USA.
      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))))
+               (operator (symbol 'pgsql- field)))
+          `(define (,operator object)
+             (,(symbol 'pq- field) (result->handle object ',operator))))
         (ill-formed-syntax form)))))
 
 (define-result-accessor result-error-message)