[m-rev.] diff: cleanup and fixes for odbc binding
Julien Fischer
juliensf at cs.mu.OZ.AU
Mon Apr 3 15:27:55 AEST 2006
(NOTE: unixODBC and postgresql are installed on earth)
Estimated hours taken: 6
Branches: main, release
A major cleanup of the ODBC binding. This is incorporates fixes for a number
of problems pointed out by Keri Harris the other day plus some fixes for some
other problems I encountered while working on it.
Also, add support for unixODBC to the ODBC binding.
extras/odbc/odbc.m:
extras/odbc/odbc_test.m:
Convert to four-space indentation throughout.
Use the new foreign-language interface throughout.
Make the type odbc.statement into a foreign_type. This cuts
down on the amount of casting required in the C code.
Use '.' as a module qualifier throughout.
Avoid unnecessary module qualification. Rename some local predicates
to help with this.
Fix places where we don't conform to the C or Mercury coding
standards.
Add support for unixODBC.
Don't use cast expressions as lvalues.
Add missing character escapes.
Avoid warnings about stat shadowing a global declaration.
extras/odbc/Mmakefile:
Support MODBC_UNIX (unixODBC) as a legal value for MODBC_DRIVER.
Remove a link to an old installation of iODBC.
Add the MLLIBS options necessary for building the ODBC binding
on Debian with either iODBC or unixODBC. (I've left the Windows
specific stuff intact, but I have no idea if it works or not.)
Julien.
Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/odbc/Mmakefile,v
retrieving revision 1.5
diff -u -b -r1.5 Mmakefile
--- Mmakefile 16 Jan 2003 10:44:21 -0000 1.5
+++ Mmakefile 3 Apr 2006 04:50:49 -0000
@@ -10,19 +10,17 @@
# Configuration
# The driver manager.
-# Legal values for MODBC_DRIVER are MODBC_IODBC and MODBC_MS.
+# Legal values for MODBC_DRIVER are MODBC_IODBC, MODBC_UNIX, and MODBC_MS.
# Feel free to add more (and handle them in odbc.m).
-MODBC_DRIVER=MODBC_IODBC
-#MODBC_DRIVER=MODBC_MS
+MODBC_DRIVER=MODBC_UNIX
# The database.
# Legal values for MODBC_DB are MODBC_MYSQL and MODBC_SQL_SERVER.
# Feel free to add more (and handle them in odbc.m).
MODBC_DB = MODBC_MYSQL
-#MODBC_DB=MODBC_SQL_SERVER
# Pathname for iODBC (only for MODBC_IODBC)
-IODBC_DIR=/home/aditi_db1/stayl/libiodbc-2.50.3
+#IODBC_DIR=
# Pathname for the ODBC SDK (only for MODBC_MS)
ODBC_SDK_DIR=/odbcsdk
@@ -37,10 +35,17 @@
ODBC_INCL_DIR=$(ODBC_SDK_DIR)/include
MLLIBS=-lodbc32
else
- ODBC_LIB_DIR=$(IODBC_DIR)/lib
- ODBC_INCL_DIR=$(IODBC_DIR)/include
+ #ODBC_LIB_DIR=$(IODBC_DIR)/lib
+ #ODBC_INCL_DIR=$(IODBC_DIR)/include
+
+ # The following are for Debian.
+
+ # for unixODBC
+ MLLIBS=-lodbc -lpthread -lltdl -ldl
+
+ # for iODBC
+ # MLLIBS=-liodbc l-pthread -ldl
# note: on a DEC Alpha using OSF1 remove the -ldl.
- MLLIBS=-L$(ODBC_LIB_DIR) -R$(ODBC_LIB_DIR) -liodbc -ldl
endif
MAIN_TARGET=odbc_test
Index: odbc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/odbc/odbc.m,v
retrieving revision 1.19
diff -u -b -r1.19 odbc.m
--- odbc.m 30 Mar 2006 01:21:18 -0000 1.19
+++ odbc.m 3 Apr 2006 05:04:40 -0000
@@ -1,18 +1,20 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1997 Mission Critical.
% Copyright (C) 1997-2000, 2002, 2004-2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
-% File: odbc.m
-% Authors: Renaud Paquay (rpa at miscrit.be), stayl
-% ODBC version: 2.0
-%
+
+% File: odbc.m.
+% Authors: Renaud Paquay (rpa at miscrit.be), stayl.
+% ODBC version: 2.0.
+
% The transaction interface used here is described in the following paper:
%
% Kemp, Conway, Harris, Henderson, Ramamohanarao and Somogyi,
-% "Database transactions in a purely declarative
-% logic programming language".
+% "Database transactions in a purely declarative logic programming language".
% In Proceedings of the Fifth International Conference on Database
% Systems for Advanced Applications, pp. 283-292.
% Melbourne, Australia, 1-4 April, 1997.
@@ -55,30 +57,33 @@
% SQL strings.
%
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- module odbc.
:- interface.
:- import_module list.
:- import_module io.
-:- import_module string.
:- import_module pair.
+:- import_module string.
%-----------------------------------------------------------------------------%
+%
+% Predicates and types for transaction processing
+%
- % Predicates and types for transaction processing.
-
-:- type odbc__data_source == string.
-:- type odbc__user_name == string.
-:- type odbc__password == string.
+:- type odbc.data_source == string.
+:- type odbc.user_name == string.
+:- type odbc.password == string.
% A closure to be executed atomically.
-:- type odbc__transaction(T) == pred(T, odbc__state, odbc__state).
-:- mode odbc__transaction == (pred(out, di, uo) is det).
+ %
+:- type odbc.transaction(T) == pred(T, odbc.state, odbc.state).
+:- mode odbc.transaction == (pred(out, di, uo) is det).
-:- type odbc__state.
+:- type odbc.state.
- % odbc__transaction(Source, UserName, Password, Transaction, Result).
+ % odbc.transaction(Source, UserName, Password, Transaction, Result).
%
% Open a connection to `Source' using the given `UserName'
% and `Password', perform `Transaction' within a transaction
@@ -89,157 +94,160 @@
% Whether updates are rolled back if the transaction aborts depends
% on the database. MySQL will not roll back updates.
%
- % If `Transaction' throws an exception, odbc__transaction will
+ % If `Transaction' throws an exception, odbc.transaction will
% attempt to roll back the transaction, and will then rethrow
% the exception to the caller.
-:- pred odbc__transaction(odbc__data_source, odbc__user_name, odbc__password,
- odbc__transaction(T), odbc__result(T), io__state, io__state).
-:- mode odbc__transaction(in, in, in, odbc__transaction, out, di, uo) is det.
+ %
+:- pred odbc.transaction(data_source::in, user_name::in, password::in,
+ transaction(T)::transaction, odbc.result(T)::out, io::di, io::uo) is det.
% Abort the current transaction, returning the given error message.
-:- pred odbc__rollback(string, odbc__state, odbc__state).
-:- mode odbc__rollback(in, di, uo) is erroneous.
+ %
+:- pred odbc.rollback(string::in, odbc.state::di, odbc.state::uo) is erroneous.
%-----------------------------------------------------------------------------%
+%
+% Predicates and types for execution of SQL statements
+%
- % Predicates and types for execution of SQL statements.
-
-:- type odbc__row == list(odbc__attribute).
+:- type odbc.row == list(odbc.attribute).
-:- type odbc__attribute
+:- type odbc.attribute
---> null % SQL NULL value
; int(int)
; string(string)
; float(float)
; time(string). % Time string: "YYYY-MM-DD hh:mm:ss.mmm"
- % The odbc__state arguments threaded through these predicates
- % enforce the restriction that database activity can only occur
- % within a transaction, since odbc__states are only available
- % to the closure called by odbc__transaction/5.
+% The odbc.state arguments threaded through these predicates
+% enforce the restriction that database activity can only occur
+% within a transaction, since odbc.states are only available
+% to the closure called by odbc.transaction/5.
% Execute an SQL statement which doesn't return any results, such
% as DELETE.
-:- pred odbc__execute(string, odbc__state, odbc__state).
-:- mode odbc__execute(in, di, uo) is det.
+ %
+:- pred odbc.execute(string::in, odbc.state::di, odbc.state::uo) is det.
% Execute an SQL statement, returning a list of results in the
% order they are returned from the database.
-:- pred odbc__solutions(string, list(odbc__row), odbc__state, odbc__state).
-:- mode odbc__solutions(in, out, di, uo) is det.
+ %
+:- pred odbc.solutions(string::in, list(odbc.row)::out,
+ odbc.state::di, odbc.state::uo) is det.
% Execute an SQL statement, applying the accumulator predicate
% to each element of the result set as it is returned from
% the database.
-:- pred odbc__aggregate(string, pred(odbc__row, T, T), T, T,
- odbc__state, odbc__state).
-:- mode odbc__aggregate(in, pred(in, in, out) is det, in, out, di, uo) is det.
-:- mode odbc__aggregate(in, pred(in, di, uo) is det, di, uo, di, uo) is det.
+ %
+:- pred odbc.aggregate(string, pred(odbc.row, T, T), T, T,
+ odbc.state, odbc.state).
+:- mode odbc.aggregate(in, pred(in, in, out) is det, in, out, di, uo) is det.
+:- mode odbc.aggregate(in, pred(in, di, uo) is det, di, uo, di, uo) is det.
%-----------------------------------------------------------------------------%
+%
+% Predicates and types to get information about database tables
+%
- % Predicates and types to get information about database tables.
- % This is very incomplete, it would be nice to be able to get
- % information about the columns in a table and about privileges
- % for tables and columns.
-
-:- type odbc__source_desc
- ---> odbc__source_desc(
- odbc__data_source, % name
+% This is very incomplete, it would be nice to be able to get
+% information about the columns in a table and about privileges
+% for tables and columns.
+
+:- type odbc.source_desc
+ ---> source_desc(
+ odbc.data_source, % name
string % description
).
-:- type odbc__search_pattern
- ---> any
- ; pattern(string). % _ matches any single character
- % % matches a sequence of characters
+:- type odbc.search_pattern
+ ---> any % _ matches any single character.
+ ; pattern(string). % Matches a sequence of characters.
% Information about a table accessible by a transaction.
-:- type odbc__table_desc
- ---> odbc__table_desc(
+ %
+:- type odbc.table_desc
+ ---> table_desc(
string, % table qualifier
string, % table owner
string, % table name
string, % table type
string, % description
- list(odbc__attribute) % data source specific columns
+ list(odbc.attribute) % data source specific columns
).
% Get a list of all the available data sources.
% Note that iODBC 2.12 doesn't implement this.
-:- pred odbc__data_sources(odbc__result(list(odbc__source_desc)),
- io__state, io__state).
-:- mode odbc__data_sources(out, di, uo) is det.
+ %
+:- pred odbc.data_sources(odbc.result(list(odbc.source_desc))::out,
+ io::di, io::uo) is det.
- % odbc__tables(QualifierPattern, OwnerPattern,
- % TableNamePattern, Result)
+ % odbc.tables(QualifierPattern, OwnerPattern, TableNamePattern, Result).
%
% Get a list of database tables matching the given description.
% Note that wildcards are not allowed in the QualifierPattern.
% This is fixed in ODBC 3.0.
-:- pred odbc__tables(odbc__search_pattern, odbc__search_pattern,
- odbc__search_pattern, list(odbc__table_desc),
- odbc__state, odbc__state).
-:- mode odbc__tables(in, in, in, out, di, uo) is det.
+ %
+:- pred odbc.tables(odbc.search_pattern::in, odbc.search_pattern::in,
+ odbc.search_pattern::in, list(odbc.table_desc)::out,
+ odbc.state::di, odbc.state::uo) is det.
%-----------------------------------------------------------------------------%
+%
+% The following types are used to return status and error information from
+% ODBC calls.
+%
- % The following types are used to return status and error
- % information from ODBC calls.
-
-:- type odbc__result == pair(odbc__status, list(odbc__message)).
+:- type odbc.result == pair(odbc.status, list(odbc.message)).
-:- type odbc__status
+:- type odbc.status
---> ok
; error.
% The message list returned from a transaction contains all errors
% and warnings reported by the driver during the transaction in
% the order that they were reported.
-:- type odbc__result(T) == pair(odbc__status(T), list(odbc__message)).
+ %
+:- type odbc.result(T) == pair(odbc.status(T), list(odbc.message)).
-:- type odbc__status(T)
+:- type odbc.status(T)
---> ok(T)
; error.
-:- type odbc__message == pair(odbc__message_type, string).
+:- type odbc.message == pair(odbc.message_type, string).
-:- type odbc__message_type
- ---> warning(odbc__warning)
- ; error(odbc__error).
+:- type odbc.message_type
+ ---> warning(odbc.warning)
+ ; error(odbc.error).
-:- type odbc__warning
+:- type odbc.warning
---> disconnect_error
; fractional_truncation
; general_warning
; null_value_in_set_function
; privilege_not_revoked
; privilege_not_granted
- ; string_data_truncated
- .
+ ; string_data_truncated.
-:- type odbc__error
- ---> connection_error(odbc__connection_error)
- ; execution_error(odbc__execution_error)
+:- type odbc.error
+ ---> connection_error(odbc.connection_error)
+ ; execution_error(odbc.execution_error)
; feature_not_implemented
; general_error
; internal_error
; timeout_expired
- ; transaction_error(odbc__transaction_error)
- ; user_requested_rollback
- .
+ ; transaction_error(odbc.transaction_error)
+ ; user_requested_rollback.
-:- type odbc__connection_error
+:- type odbc.connection_error
---> unable_to_establish
; invalid_authorization
; connection_name_in_use
; nonexistent_connection
; connection_rejected_by_server
; connection_failure
- ; timeout_expired
- .
+ ; timeout_expired.
-:- type odbc__execution_error
+:- type odbc.execution_error
---> column_already_exists
; column_not_found
; division_by_zero
@@ -265,15 +273,13 @@
; string_data_truncated
; syntax_error_or_access_violation
; table_or_view_already_exists
- ; table_or_view_not_found
- .
+ ; table_or_view_not_found.
-:- type odbc__transaction_error
+:- type odbc.transaction_error
---> rolled_back
; still_active
; serialization_failure
- ; invalid_state
- .
+ ; invalid_state.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -289,15 +295,16 @@
%-----------------------------------------------------------------------------%
- % We don't actually store anything in the odbc__state, since that
+ % We don't actually store anything in the odbc.state, since that
% would make the exception handling more inconvenient and error-prone.
- % The odbc__state would have to be stored in a global anyway just
+ % The odbc.state would have to be stored in a global anyway just
% before calling longjmp.
% All the data related to a transaction (ODBC handles, error messages)
% is stored in the global variables defined below.
-:- type odbc__state == unit.
+ %
+:- type odbc.state == unit.
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_imp.h""
#include <stdio.h>
@@ -308,7 +315,7 @@
/*
** odbc.m allocates memory within may_call_mercury pragma C code,
** which is a bit dodgy in non-conservative GC grades.
- ** Allowing non-convservative GC grades would require a bit of fairly
+ ** Allowing non-conservative GC grades would require a bit of fairly
** error-prone code to save/restore the heap pointer in the right
** places. When accurate garbage collection is implemented and a
** nicer way of allocating heap space from within C code is available,
@@ -321,36 +328,50 @@
Use a compilation grade containing .gc.""
#endif /* ! MR_CONSERVATIVE_GC */
+/*
+** For use with iODBC.
+*/
#ifdef MODBC_IODBC
-#include ""isql.h""
-#include ""isqlext.h""
-/* #include ""odbc_funcs.h"" */
-#include ""sqltypes.h""
+ #include ""isql.h""
+ #include ""isqlext.h""
+ /* #include ""odbc_funcs.h"" */
+ #include ""sqltypes.h""
/*
- ** Again, iODBC 2.12 doesn't define this, so define it to something
+ ** iODBC 2.12 doesn't define this, so define it to something
** harmless.
*/
-#ifndef SQL_NO_DATA
-#define SQL_NO_DATA SQL_NO_DATA_FOUND
-#endif
+ #ifndef SQL_NO_DATA
+ #define SQL_NO_DATA SQL_NO_DATA_FOUND
+ #endif
#endif /* MODBC_IODBC */
- /*
- ** For interfacing directly with ODBC driver bypassing driver manager
- ** such as iODBC
- */
+/*
+** For use with unixODBC.
+*/
+#ifdef MODBC_UNIX
+
+ #include ""sql.h""
+ #include ""sqlext.h""
+ #include ""sqltypes.h""
+
+#endif /* MODBC_UNIX */
+
+/*
+** For interfacing directly with ODBC driver bypassing driver managers
+** such as iODBC
+*/
#ifdef MODBC_ODBC
-#include ""sql.h""
-#include ""sqlext.h""
-#include ""sqltypes.h""
-
-#ifndef SQL_NO_DATA
-#define SQL_NO_DATA SQL_NO_DATA_FOUND
-#endif
+ #include ""sql.h""
+ #include ""sqlext.h""
+ #include ""sqltypes.h""
+
+ #ifndef SQL_NO_DATA
+ #define SQL_NO_DATA SQL_NO_DATA_FOUND
+ #endif
#endif /* MODBC_ODBC */
@@ -360,83 +381,87 @@
** ODBC_VER set to 0x0250 means that this uses only ODBC 2.0
** functionality but compiles with the ODBC 3.0 header files.
*/
-#define ODBC_VER 0x0250
+ #define ODBC_VER 0x0250
-/*
-** The following is needed to allow the Microsoft headers to
-** compile with GNU C under gnu-win32.
-*/
+ /*
+ ** The following is needed to allow the Microsoft headers to
+ ** compile with GNU C under gnu-win32.
+ */
-#if defined(__GNUC__) && !defined(__stdcall)
+ #if defined(__GNUC__) && !defined(__stdcall)
#define __stdcall __attribute__((stdcall))
-#endif
+ #endif
-#if defined(__CYGWIN32__) && !defined(WIN32)
+ #if defined(__CYGWIN32__) && !defined(WIN32)
#define WIN32 1
-#endif
+ #endif
-#include <windows.h>
-#include ""sql.h""
-#include ""sqlext.h""
-#include ""sqltypes.h""
+ #include <windows.h>
+ #include ""sql.h""
+ #include ""sqlext.h""
+ #include ""sqltypes.h""
#endif /* MODBC_MS */
- /*
- ** Assert the implication: a => b
- */
+/*
+** Assert the implication: a => b
+*/
#define MR_ASSERT_IMPLY(a,b) MR_assert( !(a) || (b) )
- /*
- ** All integers get converted to long by the driver, then to Integer.
- ** All floats get converted to double by the driver, then to Float.
- */
+/*
+** All integers get converted to long by the driver, then to MR_Integer.
+** All floats get converted to double by the driver, then to MR_Float.
+*/
typedef long MODBC_C_INT;
typedef double MODBC_C_FLOAT;
- /*
- ** Define some wrappers around setjmp and longjmp for exception
- ** handling. We need to use MR_setjmp and MR_longjmp because we'll
- ** be longjmping across C->Mercury calls, so we need to restore
- ** some state in runtime/engine.c.
- ** Beware: the Mercury registers must be valid when odbc_catch
- ** is called. odbc_throw will clobber the general-purpose registers
- ** r1, r2, etc.
- */
+/*
+** Define some wrappers around setjmp and longjmp for exception
+** handling. We need to use MR_setjmp and MR_longjmp because we'll
+** be longjmping across C->Mercury calls, so we need to restore
+** some state in runtime/engine.c.
+** Beware: the Mercury registers must be valid when odbc_catch
+** is called. odbc_throw will clobber the general-purpose registers
+** r1, r2, etc.
+*/
#define odbc_catch(longjmp_label) \
MR_setjmp(&odbc_trans_jmp_buf, longjmp_label)
#define odbc_throw() MR_longjmp(&odbc_trans_jmp_buf)
- /*
- ** odbc_trans_jmp_buf stores information saved by odbc_catch (setjmp)
- ** to be used by odbc_throw (longjmp) when a database exception is
- ** found.
- */
+/*
+** odbc_trans_jmp_buf stores information saved by odbc_catch (setjmp)
+** to be used by odbc_throw (longjmp) when a database exception is
+** found.
+*/
static MR_jmp_buf odbc_trans_jmp_buf;
- /*
- ** odbc_env_handle is the output of SQLAllocEnv. SQLAllocEnv must
- ** be called before attempting to open any connections.
- */
+/*
+** odbc_env_handle is the output of SQLAllocEnv. SQLAllocEnv must
+** be called before attempting to open any connections.
+*/
static SQLHENV odbc_env_handle = SQL_NULL_HENV;
- /* The connection being acted on by the current transaction. */
+/*
+** The connection being acted on by the current transaction.
+*/
static SQLHDBC odbc_connection = SQL_NULL_HDBC;
- /* The last return code from an ODBC system call. */
+/*
+** The last return code from an ODBC system call.
+*/
static SQLRETURN odbc_ret_code = SQL_SUCCESS;
- /*
- ** The list of accumulated warnings and errors for the transaction
- ** in reverse order.
- */
+/*
+** The list of accumulated warnings and errors for the transaction
+** in reverse order.
+*/
static MR_Word odbc_message_list;
-static void odbc_transaction_c_code(Word type_info, Word Connection,
- Word Closure, Word *Results, Word *GotMercuryException,
- Word *Exception, Word *Status,
- Word *Msgs, Word IO0, Word *IO);
+static void odbc_transaction_c_code(MR_Word type_info, MR_Word Connection,
+ MR_Word Closure, MR_Word *Results, MR_Word *GotMercuryException,
+ MR_Word *Exception, MR_Word *Status, MR_Word *Msgs);
+
static MR_bool odbc_check(SQLHENV, SQLHDBC, SQLHSTMT, SQLRETURN);
").
@@ -444,59 +469,57 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-odbc__transaction(Source, User, Password, Closure, Result) -->
+transaction(Source, User, Password, Closure, Result, !IO) :-
+ %
% We could have separate open and close connection predicates in the
% interface, but that would just be more effort for the programmer
% for a very minor efficiency gain. The connection time will be
% insignificant for even trivial queries.
- odbc__open_connection(Source, User, Password,
- ConnectStatus - ConnectMessages),
+ %
+ open_connection(Source, User, Password, ConnectStatus - ConnectMessages,
+ !IO),
(
- { ConnectStatus = ok(Connection) },
-
+ ConnectStatus = ok(Connection),
+ %
% Do the transaction.
- odbc__transaction_2(Connection, Closure, Data,
- GotMercuryException, Exception, Status, RevMessages),
- { list__reverse(RevMessages, TransMessages) },
-
- odbc__close_connection(Connection,
- CloseStatus - CloseMessages),
+ %
+ transaction_2(Connection, Closure, Data, GotMercuryException,
+ Exception, Status, RevMessages, !IO),
+ list.reverse(RevMessages, TransMessages),
+ close_connection(Connection, CloseStatus - CloseMessages, !IO),
%
% Pass on any exception that was found while
% processing the transaction.
%
- ( { GotMercuryException = 1 } ->
- { rethrow(exception(Exception)) }
+ ( GotMercuryException = 1 ->
+ rethrow(exception(Exception))
;
- []
+ true
),
- { list__condense(
- [ConnectMessages, TransMessages, CloseMessages],
- Messages) },
- ( { odbc__ok(Status), CloseStatus = ok } ->
- { Result = ok(Data) - Messages }
+ list.condense([ConnectMessages, TransMessages, CloseMessages],
+ Messages),
+ ( odbc.ok(Status), CloseStatus = ok ->
+ Result = ok(Data) - Messages
;
- { Result = error - Messages }
+ Result = error - Messages
)
;
- { ConnectStatus = error },
- { Result = error - ConnectMessages }
+ ConnectStatus = error,
+ Result = error - ConnectMessages
).
-:- pred odbc__transaction_2(odbc__connection,
- pred(T, odbc__state, odbc__state), T,
- int, univ, int, list(odbc__message), io__state, io__state).
-:- mode odbc__transaction_2(in, pred(out, di, uo) is det,
- out, out, out, out, out, di, uo) is det.
-
-:- pragma c_code(
- odbc__transaction_2(Connection::in,
- Closure::pred(out, di, uo) is det,
+:- pred transaction_2(connection::in,
+ pred(T, odbc.state, odbc.state)::in(pred(out, di, uo) is det),
+ T::out, int::out, univ::out, int::out, list(odbc.message)::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ transaction_2(Connection::in, Closure::in(pred(out, di, uo) is det),
Results::out, GotMercuryException::out, Exception::out,
Status::out, Msgs::out, IO0::di, IO::uo),
- may_call_mercury,
+ [promise_pure, may_call_mercury],
"
/*
** The Mercury registers must be valid at the call to odbc_catch
@@ -509,18 +532,18 @@
MR_save_transient_registers();
odbc_transaction_c_code(TypeInfo_for_T, Connection, Closure,
&Results, &GotMercuryException, &Exception,
- &Status, &Msgs, IO0, &IO);
+ &Status, &Msgs);
MR_restore_transient_registers();
+ IO = IO0;
").
-:- pragma c_code(
+:- pragma foreign_code("C",
"
static void
odbc_transaction_c_code(MR_Word TypeInfo_for_T, MR_Word Connection,
MR_Word Closure, MR_Word *Results, MR_Word *GotMercuryException,
- MR_Word *Exception, MR_Word *Status, MR_Word *Msgs,
- MR_Word IO0, MR_Word *IO)
+ MR_Word *Exception, MR_Word *Status, MR_Word *Msgs)
{
MR_Word DB0 = (MR_Word) 0;
MR_Word DB = (MR_Word) 0;
@@ -531,7 +554,6 @@
/*
** Mercury state to restore on rollback.
*/
-
odbc_connection = (SQLHDBC) Connection;
odbc_message_list = MR_list_empty();
@@ -547,7 +569,7 @@
*/
MODBC_odbc__do_transaction(TypeInfo_for_T, Closure,
- GotMercuryException, Results, Exception, DB0, &DB);
+ GotMercuryException, Results, Exception);
/*
** MR_longjmp() cannot be called after here.
@@ -557,8 +579,8 @@
rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_COMMIT);
- if (! odbc_check(odbc_env_handle, odbc_connection,
- SQL_NULL_HSTMT, rc)) {
+ if (! odbc_check(odbc_env_handle, odbc_connection, SQL_NULL_HSTMT,
+ rc)) {
goto transaction_error;
}
@@ -572,8 +594,7 @@
*/
MR_DEBUG(printf(
""Mercury exception in transaction: aborting\\n""));
- (void) SQLTransact(odbc_env_handle,
- odbc_connection, SQL_ROLLBACK);
+ (void) SQLTransact(odbc_env_handle, odbc_connection, SQL_ROLLBACK);
}
*Status = SQL_SUCCESS;
@@ -603,26 +624,23 @@
odbc_message_list = MR_list_empty();
odbc_connection = SQL_NULL_HDBC;
odbc_ret_code = SQL_SUCCESS;
- *IO = IO0;
MR_save_transient_registers();
}
").
%-----------------------------------------------------------------------------%
+%
+% Call the transaction closure
+%
- % Call the transaction closure.
-:- pred odbc__do_transaction(odbc__transaction(T), int, T, univ,
- odbc__state, odbc__state).
-:- mode odbc__do_transaction(odbc__transaction,
- out, out, out, di, uo) is cc_multi.
+:- pred do_transaction(transaction(T)::transaction, int::out, T::out,
+ univ::out, odbc.state::di, odbc.state::uo) is cc_multi.
-:- pragma export(odbc__do_transaction(odbc__transaction,
- out, out, out, di, uo),
+:- pragma export(do_transaction(transaction, out, out, out, di, uo),
"MODBC_odbc__do_transaction").
-odbc__do_transaction(Closure, GotException, Results,
- Exception, State0, State) :-
+do_transaction(Closure, GotException, Results, Exception, State0, State) :-
try((pred(TryResult::out) is det :-
unsafe_promise_unique(State0, State1),
Closure(Result, State1, ResultState),
@@ -642,92 +660,90 @@
% Produce a value which is never looked at, for returning
% discriminated unions to C.
+ %
:- pred make_dummy_value(T::out) is det.
-:- pragma c_code(make_dummy_value(T::out),
- [will_not_call_mercury, thread_safe],
- "T = 0;").
+:- pragma foreign_proc("C",
+ make_dummy_value(T::out),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ T = 0;
+").
%-----------------------------------------------------------------------------%
-odbc__rollback(Error) -->
- odbc__add_message(error(user_requested_rollback) - Error),
- odbc__throw.
-
-:- pred odbc__add_message(odbc__message, odbc__state, odbc__state).
-:- mode odbc__add_message(in, di, uo) is det.
-
-:- pragma c_code(odbc__add_message(Error::in, DB0::di, DB::uo),
- will_not_call_mercury,
+rollback(Error, !DB) :-
+ odbc.add_message(error(user_requested_rollback) - Error, !DB),
+ odbc.throw(!DB).
+
+:- pred add_message(odbc.message::in, odbc.state::di, odbc.state::uo) is det.
+
+:- pragma foreign_proc("C",
+ add_message(Error::in, DB0::di, DB::uo),
+ [promise_pure, will_not_call_mercury],
"
-{
odbc_message_list = MR_list_cons(Error, odbc_message_list);
DB = DB0;
-}
").
-:- pred odbc__throw(odbc__state, odbc__state).
-:- mode odbc__throw(di, uo) is erroneous.
+:- pred odbc.throw(odbc.state::di, odbc.state::uo) is erroneous.
-:- pragma c_code(odbc__throw(DB0::di, DB::uo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ odbc.throw(DB0::di, DB::uo),
+ [promise_pure, will_not_call_mercury],
"
-{
odbc_ret_code = SQL_ERROR;
odbc_throw();
/* DB = DB0; (not reached) */
-}
").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+%
+% Predicates and types to manage connections
+%
- % Predicates and types to manage connections.
-
-:- type odbc__connection. % A connection to a specific source.
+ % A connection to a specific source.
+ %
+:- type odbc.connection.
% Given the data source to connect to and a user name and password,
% open a connection.
-:- pred odbc__open_connection(odbc__data_source, odbc__user_name,
- odbc__password, odbc__result(odbc__connection),
- io__state, io__state).
-:- mode odbc__open_connection(in, in, in, out, di, uo) is det.
+ %
+:- pred open_connection(data_source::in, user_name::in,
+ password::in, odbc.result(odbc.connection)::out, io::di, io::uo) is det.
% Close the connection to the given data source.
-:- pred odbc__close_connection(odbc__connection, odbc__result,
- io__state, io__state).
-:- mode odbc__close_connection(in, out, di, uo) is det.
+ %
+:- pred close_connection(odbc.connection::in, odbc.result::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
-:- type odbc__connection == c_pointer.
+:- type odbc.connection == c_pointer.
-odbc__open_connection(Source, User, Password, Result - Messages) -->
- odbc__do_open_connection(Source, User, Password, Handle,
- ConnectStatus, RevMessages),
- { list__reverse(RevMessages, Messages) },
- ( { odbc__ok(ConnectStatus) } ->
- { Result = ok(Handle) }
+open_connection(Source, User, Password, Result - Messages, !IO) :-
+ do_open_connection(Source, User, Password, Handle, ConnectStatus,
+ RevMessages, !IO),
+ list.reverse(RevMessages, Messages),
+ ( odbc.ok(ConnectStatus) ->
+ Result = ok(Handle)
;
- { Result = error }
+ Result = error
).
%-----------------------------------------------------------------------------%
-:- pred odbc__do_open_connection(string, string, string,
- odbc__connection, int, list(odbc__message),
- io__state, io__state).
-:- mode odbc__do_open_connection(in, in, in, uo, out, out, di, uo) is det.
-
-:- pragma c_code(
- odbc__do_open_connection(Source::in, User::in, Password::in,
- Handle::uo, Status::out, Messages::out,
- IO0::di, IO::uo),
- may_call_mercury,
+:- pred do_open_connection(string::in, string::in, string::in,
+ odbc.connection::uo, int::out, list(odbc.message)::out, io::di, io::uo)
+ is det.
+
+:- pragma foreign_proc("C",
+ do_open_connection(Source::in, User::in, Password::in, Handle::uo,
+ Status::out, Messages::out, IO0::di, IO::uo),
+ [promise_pure, may_call_mercury],
"
-{
SQLHDBC connect_handle;
-
if (odbc_env_handle == SQL_NULL_HENV) {
Status = SQLAllocEnv(&odbc_env_handle);
} else {
@@ -772,30 +788,27 @@
Handle = (MR_Word) connect_handle;
odbc_connection = SQL_NULL_HDBC;
IO = IO0;
-}
").
%-----------------------------------------------------------------------------%
-odbc__close_connection(Connection, Result) -->
- odbc__do_close_connection(Connection, Status, RevMessages),
- { list__reverse(RevMessages, Messages) },
- ( { Status = 0 } ->
- { Result = ok - Messages }
+close_connection(Connection, Result, !IO) :-
+ do_close_connection(Connection, Status, RevMessages, !IO),
+ list.reverse(RevMessages, Messages),
+ ( Status = 0 ->
+ Result = ok - Messages
;
- { Result = error - Messages }
+ Result = error - Messages
).
-:- pred odbc__do_close_connection(odbc__connection, int,
- list(odbc__message), io__state, io__state).
-:- mode odbc__do_close_connection(in, out, out, di, uo) is det.
+:- pred do_close_connection(odbc.connection::in, int::out,
+ list(odbc.message)::out, io::di, io::uo) is det.
-:- pragma c_code(
- odbc__do_close_connection(Handle::in, Status::out,
- Messages::out, IO0::di, IO::uo),
- may_call_mercury,
+:- pragma foreign_proc("C",
+ do_close_connection(Handle::in, Status::out, Messages::out,
+ IO0::di, IO::uo),
+ [promise_pure, may_call_mercury],
"
-
Status = SQLDisconnect((SQLHDBC) Handle);
if (odbc_check(odbc_env_handle, (SQLHDBC) Handle,
SQL_NULL_HSTMT, Status)) {
@@ -804,7 +817,6 @@
SQL_NULL_HSTMT, Status);
}
-
Messages = odbc_message_list;
odbc_message_list = MR_list_empty();
@@ -814,193 +826,184 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-odbc__execute(SQLString) -->
- odbc__alloc_statement(Statement0),
- odbc__execute_statement(SQLString, Statement0, Statement),
- odbc__cleanup_statement_check_error(Statement).
+odbc.execute(SQLString, !DB) :-
+ some [!Statement] (
+ odbc.alloc_statement(!:Statement, !DB),
+ odbc.execute_statement(SQLString, !Statement, !DB),
+ odbc.cleanup_statement_check_error(!.Statement, !DB)
+ ).
-odbc__solutions(SQLString, Results) -->
+odbc.solutions(SQLString, Results, !DB) :-
% XXX optimize this when we have better support
% for last call optimization.
- odbc__do_aggregate(odbc__execute_statement(SQLString),
- odbc__cons, [], Results0),
- { list__reverse(Results0, Results) }.
-
-odbc__aggregate(SQLString, Accumulator, Acc0, Acc) -->
- odbc__do_aggregate(odbc__execute_statement(SQLString),
- Accumulator, Acc0, Acc).
-
- % XXX Remove this and use list.cons/3 after the next release.
-:- pred cons(T, list(T), list(T)).
-:- mode cons(in, in, out) is det.
-
-cons(H, T, [H|T]).
+ odbc.do_aggregate(odbc.execute_statement(SQLString), list.cons, [],
+ Results0, !DB),
+ list.reverse(Results0, Results).
+
+odbc.aggregate(SQLString, Accumulator, !Acc, !DB) :-
+ do_aggregate(odbc.execute_statement(SQLString), Accumulator, !Acc, !DB).
%-----------------------------------------------------------------------------%
-:- pred odbc__do_aggregate(pred(odbc__statement, odbc__statement,
- odbc__state, odbc__state), pred(odbc__row, T, T),
- T, T, odbc__state, odbc__state).
-:- mode odbc__do_aggregate(pred(di, uo, di, uo) is det,
- pred(in, in, out) is det,
- in, out, di, uo) is det.
-:- mode odbc__do_aggregate(pred(di, uo, di, uo) is det,
- pred(in, di, uo) is det,
- di, uo, di, uo) is det.
-
-odbc__do_aggregate(Execute, Accumulate, Result0, Result) -->
- odbc__alloc_statement(Statement0),
- call(Execute, Statement0, Statement1),
- odbc__bind_columns(Statement1, Statement2),
- odbc__get_rows(Accumulate, Result0, Result, Statement2, Statement),
- odbc__cleanup_statement_check_error(Statement).
+:- pred do_aggregate(
+ pred(odbc.statement, odbc.statement, odbc.state, odbc.state),
+ pred(odbc.row, T, T), T, T, odbc.state, odbc.state).
+:- mode do_aggregate(
+ pred(di, uo, di, uo) is det,
+ pred(in, in, out) is det, in, out, di, uo) is det.
+:- mode do_aggregate(
+ pred(di, uo, di, uo) is det,
+ pred(in, di, uo) is det, di, uo, di, uo) is det.
+
+do_aggregate(Execute, Accumulate, !Result, !DB) :-
+ some [!Statement] (
+ alloc_statement(!:Statement, !DB),
+ Execute(!Statement, !DB),
+ bind_columns(!Statement, !DB),
+ get_rows(Accumulate, !Result, !Statement, !DB),
+ cleanup_statement_check_error(!.Statement, !DB)
+ ).
%-----------------------------------------------------------------------------%
% Get the set of result rows from the statement.
-:- pred odbc__get_rows(pred(odbc__row, T, T), T, T,
- odbc__statement, odbc__statement, odbc__state, odbc__state).
-:- mode odbc__get_rows(pred(in, in, out) is det, in, out,
- di, uo, di, uo) is det.
-:- mode odbc__get_rows(pred(in, di, uo) is det, di, uo, di, uo, di, uo) is det.
-
-odbc__get_rows(Accumulate, Result0, Result, Statement0, Statement) -->
- odbc__get_number_of_columns(NumColumns, Statement0, Statement1),
- odbc__get_rows_2(NumColumns, Accumulate, Result0, Result,
- Statement1, Statement).
-
-:- pred odbc__get_rows_2(int, pred(odbc__row, T, T), T, T,
- odbc__statement, odbc__statement, odbc__state, odbc__state).
-:- mode odbc__get_rows_2(in, pred(in, in, out) is det, in, out,
- di, uo, di, uo) is det.
-:- mode odbc__get_rows_2(in, pred(in, di, uo) is det, di, uo,
- di, uo, di, uo) is det.
+ %
+:- pred get_rows(pred(odbc.row, T, T), T, T, odbc.statement, odbc.statement,
+ odbc.state, odbc.state).
+:- mode get_rows(pred(in, in, out) is det, in, out, di, uo, di, uo) is det.
+:- mode get_rows(pred(in, di, uo) is det, di, uo, di, uo, di, uo) is det.
+
+get_rows(Accumulate, !Result, !Statement, !DB) :-
+ get_number_of_columns(NumColumns, !Statement, !DB),
+ get_rows_2(NumColumns, Accumulate, !Result, !Statement, !DB).
+
+:- pred get_rows_2(int, pred(odbc.row, T, T), T, T,
+ odbc.statement, odbc.statement, odbc.state, odbc.state).
+:- mode get_rows_2(in, pred(in, in, out) is det, in, out, di, uo,
+ di, uo) is det.
+:- mode get_rows_2(in, pred(in, di, uo) is det, di, uo, di, uo,
+ di, uo) is det.
-odbc__get_rows_2(NumColumns, Accumulate, Result0, Result,
- Statement0, Statement) -->
+get_rows_2(NumColumns, Accumulate, !Result, !Statement, !DB) :-
% Try to fetch a new row.
- odbc__fetch(Statement0, Statement1, Status),
- ( { odbc__no_data(Status) } ->
- { Result = Result0 },
- { Statement = Statement1 }
- ;
- odbc__get_attributes(1, NumColumns, Row,
- Statement1, Statement2),
- { Accumulate(Row, Result0, Result1) },
- odbc__get_rows_2(NumColumns, Accumulate,
- Result1, Result, Statement2, Statement)
+ fetch_row(!Statement, Status, !DB),
+ ( no_data(Status) ->
+ true
+ ;
+ get_attributes(1, NumColumns, Row, !Statement, !DB),
+ Accumulate(Row, !Result),
+ get_rows_2(NumColumns, Accumulate, !Result, !Statement, !DB)
).
%-----------------------------------------------------------------------------%
% Get the values from the current fetched row.
-:- pred odbc__get_attributes(int, int, list(odbc__attribute),
- odbc__statement, odbc__statement,
- odbc__state, odbc__state).
-:- mode odbc__get_attributes(in, in, out, di, uo, di, uo) is det.
-
-odbc__get_attributes(CurrCol, NumCols, Row, Statement0, Statement) -->
- ( { CurrCol =< NumCols } ->
- { NextCol is CurrCol + 1 },
- odbc__get_attribute(CurrCol, Attribute, Statement0, Statement1),
- odbc__get_attributes(NextCol, NumCols, Row1,
- Statement1, Statement),
- { Row = [Attribute | Row1] }
+ %
+:- pred get_attributes(int::in, int::in, list(odbc.attribute)::out,
+ odbc.statement::di, odbc.statement::uo,
+ odbc.state::di, odbc.state::uo) is det.
+
+get_attributes(CurrCol, NumCols, Row, !Statement, !DB) :-
+ ( CurrCol =< NumCols ->
+ NextCol = CurrCol + 1,
+ get_attribute(CurrCol, Attribute, !Statement, !DB),
+ get_attributes(NextCol, NumCols, Row1, !Statement, !DB),
+ Row = [Attribute | Row1]
;
- { Row = [] },
- { Statement = Statement0 }
+ Row = []
).
%-----------------------------------------------------------------------------%
% Get the value of a column in the current fetched row.
-:- pred odbc__get_attribute(int, odbc__attribute, odbc__statement,
- odbc__statement, odbc__state, odbc__state) is det.
-:- mode odbc__get_attribute(in, out, di, uo, di, uo) is det.
-
-odbc__get_attribute(NumColumn, Value, Statement0, Statement) -->
- odbc__get_data(NumColumn, Int, Float, String, TypeInt,
- Statement0, Statement),
- { odbc__int_to_attribute_type(TypeInt, Type) },
+ %
+:- pred get_attribute(int::in, odbc.attribute::out,
+ odbc.statement::di, odbc.statement::uo, odbc.state::di, odbc.state::uo)
+ is det.
+
+get_attribute(NumColumn, Value, !Statement, !DB) :-
+ get_data(NumColumn, Int, Float, String, TypeInt, !Statement, !DB),
+ int_to_attribute_type(TypeInt, Type),
(
- { Type = null },
- { Value = null }
+ Type = null,
+ Value = null
;
- { Type = string },
- { Value = string(String) }
+ Type = string,
+ Value = string(String)
;
- { Type = time },
- { Value = time(String) }
+ Type = time,
+ Value = time(String)
;
- { Type = int },
- { Value = int(Int) }
+ Type = int,
+ Value = int(Int)
;
- { Type = float },
- { Value = float(Float) }
+ Type = float,
+ Value = float(Float)
).
%-----------------------------------------------------------------------------%
-:- type odbc__attribute_type
+:- type odbc.attribute_type
---> int
; float
; time
; string
; null.
-:- pred odbc__int_to_attribute_type(int, odbc__attribute_type).
-:- mode odbc__int_to_attribute_type(in, out) is det.
+:- pred int_to_attribute_type(int::in, odbc.attribute_type::out) is det.
-odbc__int_to_attribute_type(Int, Type) :-
- ( odbc__int_to_attribute_type_2(Int, Type1) ->
+int_to_attribute_type(Int, Type) :-
+ ( int_to_attribute_type_2(Int, Type1) ->
Type = Type1
;
- error("odbc__int_to_attribute_type: invalid type")
+ error("odbc.int_to_attribute_type: invalid type")
).
% Keep this in sync with the C enum MODBC_AttrType below.
-:- pred odbc__int_to_attribute_type_2(int, odbc__attribute_type).
-:- mode odbc__int_to_attribute_type_2(in, out) is semidet.
+ %
+:- pred int_to_attribute_type_2(int::in, odbc.attribute_type::out) is semidet.
-odbc__int_to_attribute_type_2(0, int).
-odbc__int_to_attribute_type_2(1, float).
-odbc__int_to_attribute_type_2(2, time).
-odbc__int_to_attribute_type_2(3, string).
-odbc__int_to_attribute_type_2(4, string).
-odbc__int_to_attribute_type_2(5, null).
+int_to_attribute_type_2(0, int).
+int_to_attribute_type_2(1, float).
+int_to_attribute_type_2(2, time).
+int_to_attribute_type_2(3, string).
+int_to_attribute_type_2(4, string).
+int_to_attribute_type_2(5, null).
%-----------------------------------------------------------------------------%
-:- type odbc__statement == c_pointer.
-
-:- pragma c_header_code("
-
- /*
- ** Notes on memory allocation:
- **
- ** C data structures (MODBC_Statement and MODBC_Column) are allocated
- ** using MR_GC_malloc/MR_GC_free.
- **
- ** MODBC_Statement contains a statement handle which must be freed
- ** using SQLFreeStmt.
- **
- ** Variable length data types are collected in chunks allocated on
- ** the Mercury heap using MR_incr_hp_atomic. The chunks are then
- ** condensed into memory allocated on the Mercury heap using
- ** string__append_list.
- ** XXX this may need revisiting when accurate garbage collection
- ** is implemented to make sure the collector can see the data when
- ** it is stored within a MODBC_Column.
- **
- ** Other data types have a buffer which is allocated once using
- ** MR_GC_malloc.
- */
+:- type odbc.statement.
- /*
- ** If the driver can't work out how much data is in a blob in advance,
- ** get the data in chunks. The chunk size is fairly arbitrary.
- ** MODBC_CHUNK_SIZE must be a multiple of sizeof(MR_Word).
- */
+:- pragma foreign_type("C", odbc.statement, "MODBC_Statement *").
+
+:- pragma foreign_decl("C", "
+
+/*
+** Notes on memory allocation:
+**
+** C data structures (MODBC_Statement and MODBC_Column) are allocated
+** using MR_GC_malloc/MR_GC_free.
+**
+** MODBC_Statement contains a statement handle which must be freed
+** using SQLFreeStmt.
+**
+** Variable length data types are collected in chunks allocated on
+** the Mercury heap using MR_incr_hp_atomic. The chunks are then
+** condensed into memory allocated on the Mercury heap using
+** string.append_list.
+** XXX this may need revisiting when accurate garbage collection
+** is implemented to make sure the collector can see the data when
+** it is stored within a MODBC_Column.
+**
+** Other data types have a buffer which is allocated once using
+** MR_GC_malloc.
+*/
+
+/*
+** If the driver can't work out how much data is in a blob in advance,
+** get the data in chunks. The chunk size is fairly arbitrary.
+** MODBC_CHUNK_SIZE must be a multiple of sizeof(MR_Word).
+*/
#define MODBC_CHUNK_WORDS 1024
#define MODBC_CHUNK_SIZE (MODBC_CHUNK_WORDS * sizeof(MR_Word))
@@ -1015,7 +1018,9 @@
typedef enum { MODBC_BIND_COL, MODBC_GET_DATA } MODBC_BindType;
- /* Information about a column in a result set. */
+/*
+** Information about a column in a result set.
+*/
typedef struct {
size_t size; /* size of allocated buffer */
MODBC_AttrType attr_type;
@@ -1036,7 +1041,9 @@
} MODBC_Column;
- /* Information about a result set. */
+/*
+** Information about a result set.
+*/
typedef struct {
SQLHSTMT stat_handle; /* statement handle */
int num_columns; /* columns per row */
@@ -1051,69 +1058,65 @@
*/
} MODBC_Statement;
-static SQLRETURN odbc_do_cleanup_statement(MODBC_Statement *stat);
+static SQLRETURN odbc_do_cleanup_statement(MODBC_Statement *statement);
static size_t sql_type_to_size(SWORD sql_type, UDWORD cbColDef,
SWORD ibScale, SWORD fNullable);
static MODBC_AttrType sql_type_to_attribute_type(SWORD sql_type);
static SWORD attribute_type_to_sql_c_type(MODBC_AttrType AttrType);
static MR_bool is_variable_length_sql_type(SWORD);
-void odbc_do_get_data(MODBC_Statement *stat, int column_id);
-void odbc_get_data_in_chunks(MODBC_Statement *stat, int column_id);
-void odbc_get_data_in_one_go(MODBC_Statement *stat, int column_id);
+void odbc_do_get_data(MODBC_Statement *statement, int column_id);
+void odbc_get_data_in_chunks(MODBC_Statement *statement, int column_id);
+void odbc_get_data_in_one_go(MODBC_Statement *statement, int column_id);
+
").
%-----------------------------------------------------------------------------%
-:- pred odbc__alloc_statement(odbc__statement, odbc__state, odbc__state).
-:- mode odbc__alloc_statement(uo, di, uo) is det.
+:- pred alloc_statement(odbc.statement::uo,
+ odbc.state::di, odbc.state::uo) is det.
-:- pragma c_code(odbc__alloc_statement(Statement::uo, DB0::di, DB::uo),
- may_call_mercury,
+:- pragma foreign_proc("C",
+ alloc_statement(Statement::uo, DB0::di, DB::uo),
+ [promise_pure, may_call_mercury],
"
-{
- MODBC_Statement *statement;
SQLRETURN rc;
-
/* Doing manual deallocation of the statement object. */
- statement = MR_GC_NEW(MODBC_Statement);
+ Statement = MR_GC_NEW(MODBC_Statement);
- statement->num_columns = 0;
- statement->row = NULL;
- statement->num_rows = 0;
- statement->stat_handle = SQL_NULL_HSTMT;
+ Statement->num_columns = 0;
+ Statement->row = NULL;
+ Statement->num_rows = 0;
+ Statement->stat_handle = SQL_NULL_HSTMT;
- rc = SQLAllocStmt(odbc_connection, &(statement->stat_handle));
+ rc = SQLAllocStmt(odbc_connection, &(Statement->stat_handle));
if (! odbc_check(odbc_env_handle, odbc_connection,
- statement->stat_handle, rc))
+ Statement->stat_handle, rc))
{
odbc_throw();
/* not reached */
}
- MR_assert(statement->stat_handle != SQL_NULL_HSTMT);
-
+ MR_assert(Statement->stat_handle != SQL_NULL_HSTMT);
DB = DB0;
- Statement = (MR_Word) statement;
-
-}
").
%-----------------------------------------------------------------------------%
-:- pred odbc__execute_statement(string, odbc__statement, odbc__statement,
- odbc__state, odbc__state).
-:- mode odbc__execute_statement(in, di, uo, di, uo) is det.
-
-:- pragma c_code(
- odbc__execute_statement(SQLString::in, Statement0::di,
- Statement::uo, DB0::di, DB::uo),
- may_call_mercury,
+:- pred execute_statement(string::in, odbc.statement::di, odbc.statement::uo,
+ odbc.state::di, odbc.state::uo) is det.
+
+:- pragma foreign_proc("C",
+ execute_statement(SQLString::in, Statement0::di, Statement::uo,
+ DB0::di, DB::uo),
+ [promise_pure, may_call_mercury],
"
-{
- MODBC_Statement *statement = (MODBC_Statement *) Statement0;
SQLRETURN rc;
- SQLHSTMT stat_handle = statement->stat_handle;
+ SQLHSTMT stat_handle;
+
+ Statement = Statement0;
+
+ stat_handle = Statement->stat_handle;
MR_DEBUG(printf(""executing SQL string: %s\\n"", SQLString));
@@ -1126,28 +1129,24 @@
** the programmer is likely to be more interested
** in the earlier error.
*/
- odbc_do_cleanup_statement(statement);
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
/* not reached */
}
rc = SQLExecute(stat_handle);
if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
- odbc_do_cleanup_statement(statement);
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
/* not reached */
}
MR_DEBUG(printf(""execution succeeded\\n""));
-
- Statement = (MR_Word) statement;
DB = DB0;
-
-}").
+").
%-----------------------------------------------------------------------------%
- %
% There are two methods to get data back from an ODBC application.
%
% One involves binding a buffer to each column using SQLBindCol,
@@ -1173,51 +1172,49 @@
% The first method is used if there are no variable length columns,
% otherwise the second method is used.
%
-:- pred odbc__bind_columns(odbc__statement, odbc__statement,
- odbc__state, odbc__state).
-:- mode odbc__bind_columns(di, uo, di, uo) is det.
+:- pred bind_columns(odbc.statement::di, odbc.statement::uo,
+ odbc.state::di, odbc.state::uo) is det.
-:- pragma c_code(odbc__bind_columns(Statement0::di, Statement::uo,
- DB0::di, DB::uo), may_call_mercury,
-"{
+:- pragma foreign_proc("C",
+ bind_columns(Statement0::di, Statement::uo, DB0::di, DB::uo),
+ [promise_pure, may_call_mercury],
+"
int column_no;
- MODBC_Statement *statement;
SQLSMALLINT num_columns;
MODBC_Column *column;
SQLRETURN rc;
SQLHSTMT stat_handle;
-
- statement = (MODBC_Statement *) Statement0;
- stat_handle = statement->stat_handle;
+ Statement = Statement0;
+ stat_handle = Statement->stat_handle;
/*
- ** Retrieve number of columns of statement
+ ** Retrieve the number of columns of the statement.
*/
rc = SQLNumResultCols(stat_handle, &num_columns);
if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
- odbc_do_cleanup_statement(statement);
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
/* not reached */
}
- statement->num_columns = num_columns;
+ Statement->num_columns = num_columns;
/*
** Allocate an array containing the info for each column.
** The extra column is because ODBC counts columns starting from 1.
*/
- statement->row = MR_GC_NEW_ARRAY(MODBC_Column, num_columns + 1);
+ Statement->row = MR_GC_NEW_ARRAY(MODBC_Column, num_columns + 1);
/*
** Use SQLBindCol unless there are columns with no set maximum length.
*/
- statement->binding_type = MODBC_BIND_COL;
+ Statement->binding_type = MODBC_BIND_COL;
/*
** Get information about the result set columns.
** ODBC counts columns from 1.
*/
- for (column_no = 1; column_no <= statement->num_columns; column_no++) {
+ for (column_no = 1; column_no <= Statement->num_columns; column_no++) {
char col_name[1]; /* Not looked at */
SWORD col_name_len;
@@ -1226,7 +1223,7 @@
SWORD pibScale;
SWORD pfNullable;
- column = &(statement->row[column_no]);
+ column = &(Statement->row[column_no]);
column->size = 0;
column->data = NULL;
@@ -1251,7 +1248,7 @@
! odbc_check(odbc_env_handle, odbc_connection,
stat_handle, rc))
{
- odbc_do_cleanup_statement(statement);
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
/* not reached */
}
@@ -1271,7 +1268,7 @@
column->attr_type, column->conversion_type));
if (is_variable_length_sql_type(col_type)) {
- statement->binding_type = MODBC_GET_DATA;
+ Statement->binding_type = MODBC_GET_DATA;
} else {
/*
** Do the buffer allocation once for columns which
@@ -1282,133 +1279,117 @@
} /* for */
- if (statement->binding_type == MODBC_BIND_COL) {
+ if (Statement->binding_type == MODBC_BIND_COL) {
- for (column_no = 1; column_no <= statement->num_columns;
- column_no++) {
+ for (column_no = 1; column_no <= Statement->num_columns; column_no++) {
MR_DEBUG(printf(""Binding column %d/%d\\n"",
- column_no, statement->num_columns));
- column = &(statement->row[column_no]);
+ column_no, Statement->num_columns));
+ column = &(Statement->row[column_no]);
rc = SQLBindCol(stat_handle, column_no,
column->conversion_type,
(SQLPOINTER) column->data,
column->size, &(column->value_info));
- if (! odbc_check(odbc_env_handle, odbc_connection,
- stat_handle, rc))
- {
- odbc_do_cleanup_statement(statement);
+ if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle,
+ rc)) {
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
/* not reached */
}
}
}
-
- Statement = (MR_Word) statement;
DB = DB0;
-
-} /* odbc__bind_columns */
").
%-----------------------------------------------------------------------------%
% Fetch the next row of the current statement.
-:- pred odbc__fetch(odbc__statement, odbc__statement,
- int, odbc__state, odbc__state).
-:- mode odbc__fetch(di, uo, out, di, uo) is det.
-
-:- pragma c_code(odbc__fetch(Statement0::di, Statement::uo,
- Status::out, DB0::di, DB::uo),
- may_call_mercury,
-"{
- MODBC_Statement *stat;
-
- stat = (MODBC_Statement *) Statement0;
+ %
+:- pred fetch_row(odbc.statement::di, odbc.statement::uo, int::out,
+ odbc.state::di, odbc.state::uo) is det.
+:- pragma foreign_proc("C",
+ fetch_row(Statement0::di, Statement::uo, Status::out, DB0::di, DB::uo),
+ [promise_pure, may_call_mercury],
+"
+ Statement = Statement0;
MR_assert(stat != NULL);
- if (stat->num_rows == 0 ) {
+ if (Statement->num_rows == 0 ) {
MR_DEBUG(printf(""Fetching rows...\\n""));
}
/* Fetching new row */
- Status = SQLFetch(stat->stat_handle);
+ Status = SQLFetch(Statement->stat_handle);
if (Status != SQL_NO_DATA_FOUND &&
! odbc_check(odbc_env_handle, odbc_connection,
- stat->stat_handle, Status))
+ Statement->stat_handle, Status))
{
- odbc_do_cleanup_statement(stat);
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
/* not reached */
}
/* Update number of rows fetched */
if (Status == SQL_SUCCESS) {
- stat->num_rows++;
+ Statement->num_rows++;
}
if (Status == SQL_NO_DATA_FOUND) {
- MR_DEBUG(printf(""Fetched %d rows\\n"", stat->num_rows));
+ MR_DEBUG(printf(""Fetched %d rows\\n"", Statement->num_rows));
}
- Statement = (MR_Word) stat;
DB = DB0;
-
-}").
+").
%-----------------------------------------------------------------------------%
-:- pred odbc__get_number_of_columns(int, odbc__statement, odbc__statement,
- odbc__state, odbc__state).
-:- mode odbc__get_number_of_columns(out, di, uo, di, uo) is det.
-
-:- pragma c_code(odbc__get_number_of_columns(NumColumns::out, Statement0::di,
- Statement::uo, DB0::di, DB::uo),
- will_not_call_mercury,
-"{
- MODBC_Statement * stat;
-
- stat = (MODBC_Statement *) Statement0;
-
- MR_assert(stat != NULL);
-
- NumColumns = stat->num_columns;
- DB = DB0;
+:- pred get_number_of_columns(int::out,
+ odbc.statement::di, odbc.statement::uo, odbc.state::di, odbc.state::uo)
+ is det.
+
+:- pragma foreign_proc("C",
+ get_number_of_columns(NumColumns::out, Statement0::di, Statement::uo,
+ DB0::di, DB::uo),
+ [promise_pure, will_not_call_mercury],
+"
Statement = Statement0;
-}").
+ MR_assert(Statement != NULL);
+ NumColumns = Statement->num_columns;
+ DB = DB0;
+").
%-----------------------------------------------------------------------------%
-:- pred odbc__get_data(int, int, float, string, int, odbc__statement,
- odbc__statement, odbc__state, odbc__state).
-:- mode odbc__get_data(in, out, out, out, out, di, uo, di, uo) is det.
-
-:- pragma c_code(odbc__get_data(Column::in, Int::out, Flt::out, Str::out,
- Type::out, Statement0::di, Statement::uo, DB0::di, DB::uo),
- may_call_mercury,
-"{
+:- pred get_data(int::in, int::out, float::out, string::out, int::out,
+ odbc.statement::di, odbc.statement::uo, odbc.state::di, odbc.state::uo)
+ is det.
- MODBC_Statement *stat;
+:- pragma foreign_proc("C",
+ get_data(Column::in, Int::out, Flt::out, Str::out, Type::out,
+ Statement0::di, Statement::uo, DB0::di, DB::uo),
+ [promise_pure, may_call_mercury],
+"
MODBC_Column *col;
SQLRETURN rc;
SDWORD column_info;
- stat = (MODBC_Statement *) Statement0;
+ Statement = Statement0;
- MR_assert(stat != NULL);
- MR_assert(stat->row != NULL);
+ MR_assert(Statement != NULL);
+ MR_assert(Statement->row != NULL);
- MR_DEBUG(printf(""Getting column %i\n"", (int) Column));
+ MR_DEBUG(printf(""Getting column %i\\n"", (int) Column));
- if (stat->binding_type == MODBC_GET_DATA) {
+ if (Statement->binding_type == MODBC_GET_DATA) {
/* Slurp up the data for this column. */
- odbc_do_get_data(stat, Column);
+ odbc_do_get_data(Statement, Column);
}
- col = &(stat->row[Column]);
+ col = &(Statement->row[Column]);
if (col->value_info == SQL_NULL_DATA) {
Type = MODBC_NULL;
@@ -1425,7 +1406,7 @@
MODBC_C_INT data = *(MODBC_C_INT *)(col->data);
- Int = (Integer) data;
+ Int = (MR_Integer) data;
MR_DEBUG(printf(""got integer %ld\\n"", (long) Int));
@@ -1436,7 +1417,7 @@
odbc_message_list =
MR_list_cons(overflow_message,
odbc_message_list);
- odbc_do_cleanup_statement(stat);
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
}
break;
@@ -1444,7 +1425,7 @@
case MODBC_FLOAT:
- Flt = (Float) *(MODBC_C_FLOAT *)(col->data);
+ Flt = (MR_Float) *(MODBC_C_FLOAT *)(col->data);
MR_DEBUG(printf(""got float %f\\n"", Flt));
@@ -1477,20 +1458,17 @@
default:
MR_fatal_error(
- ""odbc.m: invalid attribute type in odbc__get_data"");
+ ""odbc.m: invalid attribute type in odbc.get_data"");
break;
} /* end switch (Type) */
- Statement = (MR_Word) stat;
DB = DB0;
-
-} /* end odbc__get_data() */
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
-odbc_do_get_data(MODBC_Statement *stat, int column_id)
+odbc_do_get_data(MODBC_Statement *statement, int column_id)
{
MODBC_Column *column;
SQLRETURN rc;
@@ -1500,11 +1478,11 @@
** byte and nothing else.
*/
- column = &(stat->row[column_id]);
+ column = &(statement->row[column_id]);
if (column->attr_type == MODBC_VAR_STRING) {
/* Just get the length first time through. */
- rc = SQLGetData(stat->stat_handle, column_id,
+ rc = SQLGetData(statement->stat_handle, column_id,
column->conversion_type, dummy_buffer,
1, &(column->value_info));
@@ -1516,9 +1494,9 @@
if (rc != SQL_SUCCESS_WITH_INFO &&
! odbc_check(odbc_env_handle,
odbc_connection,
- stat->stat_handle, rc))
+ statement->stat_handle, rc))
{
- odbc_do_cleanup_statement(stat);
+ odbc_do_cleanup_statement(statement);
odbc_throw();
}
@@ -1537,11 +1515,11 @@
** since iODBC-2.12 uses a different interpretation
** of the ODBC standard to Microsoft, for which
** the length returned by the first call to SQLGetData
- ** above is the minimun of the buffer length and the
+ ** above is the minimum of the buffer length and the
** length of the available data, rather than the
** total length of data available.
*/
- odbc_get_data_in_chunks(stat, column_id);
+ odbc_get_data_in_chunks(statement, column_id);
} else {
MR_Word data;
@@ -1549,54 +1527,56 @@
** column->value_info == length of data
*/
column->size = column->value_info + 1;
- MR_incr_hp_atomic(MR_LVALUE_CAST(MR_Word, column->data),
+ MR_incr_hp_atomic(data,
(column->size + sizeof(MR_Word)) / sizeof(MR_Word));
- odbc_get_data_in_one_go(stat, column_id);
+ column->data = (MR_Word *) data;
+ odbc_get_data_in_one_go(statement, column_id);
}
} else {
/*
** It's a fixed length column, so we can
** get the lot in one go.
*/
- odbc_get_data_in_one_go(stat, column_id);
+ odbc_get_data_in_one_go(statement, column_id);
}
}
void
-odbc_get_data_in_one_go(MODBC_Statement *stat, int column_id)
+odbc_get_data_in_one_go(MODBC_Statement *statement, int column_id)
{
MODBC_Column *col;
SQLRETURN rc;
- MR_DEBUG(printf(""getting column %i in one go\n"", column_id));
+ MR_DEBUG(printf(""getting column %i in one go\\n"", column_id));
- col = &(stat->row[column_id]);
+ col = &(statement->row[column_id]);
- rc = SQLGetData(stat->stat_handle, column_id, col->conversion_type,
+ rc = SQLGetData(statement->stat_handle, column_id,
+ col->conversion_type,
(SQLPOINTER) col->data, col->size, &(col->value_info));
if (! odbc_check(odbc_env_handle, odbc_connection,
- stat->stat_handle, rc))
+ statement->stat_handle, rc))
{
- odbc_do_cleanup_statement(stat);
+ odbc_do_cleanup_statement(statement);
odbc_throw();
}
}
void
-odbc_get_data_in_chunks(MODBC_Statement *stat, int column_id)
+odbc_get_data_in_chunks(MODBC_Statement *statement, int column_id)
{
MODBC_Column *col;
SQLRETURN rc;
MR_Word this_bit;
MR_Word chunk_list;
- String result;
+ MR_String result;
- MR_DEBUG(printf(""getting column %i in chunks\n"", column_id));
+ MR_DEBUG(printf(""getting column %i in chunks\\n"", column_id));
chunk_list = MR_list_empty();
- col = &(stat->row[column_id]);
+ col = &(statement->row[column_id]);
rc = SQL_SUCCESS_WITH_INFO;
@@ -1607,7 +1587,7 @@
*/
while (rc == SQL_SUCCESS_WITH_INFO) {
- rc = SQLGetData(stat->stat_handle, column_id,
+ rc = SQLGetData(statement->stat_handle, column_id,
col->conversion_type, (SQLPOINTER) this_bit,
MODBC_CHUNK_SIZE - 1, &(col->value_info));
@@ -1617,9 +1597,9 @@
if (rc != SQL_SUCCESS_WITH_INFO &&
! odbc_check(odbc_env_handle, odbc_connection,
- stat->stat_handle, rc))
+ statement->stat_handle, rc))
{
- odbc_do_cleanup_statement(stat);
+ odbc_do_cleanup_statement(statement);
odbc_throw();
}
@@ -1632,41 +1612,37 @@
}
").
-:- pred odbc__overflow_message(odbc__message).
-:- mode odbc__overflow_message(out) is det.
-
-:- pragma export(odbc__overflow_message(out),
- "MODBC_overflow_message").
-
-odbc__overflow_message(Error) :-
- Error = error(execution_error(overflow))
- - "[Mercury][odbc.m]Integer overflow detected in result set. Integers must be no larger than a word.".
+:- pragma export(overflow_message(out), "MODBC_overflow_message").
+:- pred overflow_message(odbc.message::out) is det.
-:- pred odbc__condense_chunks(list(string), string).
-:- mode odbc__condense_chunks(in, out) is det.
+overflow_message(Error) :-
+ ErrorType = error(execution_error(overflow)),
+ ErrorMsg = "[Mercury][odbc.m]Integer overflow detected in result set." ++
+ " Integers must be no larger than a word.",
+ Error = ErrorType - ErrorMsg.
-:- pragma export(odbc__condense_chunks(in, out), "MODBC_odbc_condense_chunks").
+:- pragma export(condense_chunks(in, out), "MODBC_odbc_condense_chunks").
+:- pred condense_chunks(list(string)::in, string::out) is det.
-odbc__condense_chunks(RevChunks, String) :-
- list__reverse(RevChunks, Chunks),
- string__append_list(Chunks, String).
+condense_chunks(RevChunks, String) :-
+ list.reverse(RevChunks, Chunks),
+ string.append_list(Chunks, String).
%-----------------------------------------------------------------------------%
-:- pred odbc__cleanup_statement_check_error(odbc__statement,
- odbc__state, odbc__state).
-:- mode odbc__cleanup_statement_check_error(di, di, uo) is det.
+:- pred cleanup_statement_check_error(odbc.statement::di,
+ odbc.state::di, odbc.state::uo) is det.
-:- pragma c_code(
- odbc__cleanup_statement_check_error(Statement::di, DB0::di, DB::uo),
- may_call_mercury,
+:- pragma foreign_proc("C",
+ cleanup_statement_check_error(Statement::di, DB0::di, DB::uo),
+ [promise_pure, may_call_mercury],
"{
- MODBC_Statement *stat;
+ MODBC_Statement *statement;
SQLRETURN rc;
- stat = (MODBC_Statement *) Statement;
+ statement = (MODBC_Statement *) Statement;
- rc = odbc_do_cleanup_statement(stat);
+ rc = odbc_do_cleanup_statement(statement);
if (! odbc_check(odbc_env_handle, odbc_connection,
SQL_NULL_HSTMT, rc))
{
@@ -1675,48 +1651,49 @@
DB = DB0;
}").
-:- pragma c_code("
+:- pragma foreign_code("C", "
static SQLRETURN
-odbc_do_cleanup_statement(MODBC_Statement *stat)
+odbc_do_cleanup_statement(MODBC_Statement *statement)
{
int i;
SQLRETURN rc;
if (stat != NULL) {
MR_DEBUG(printf(""cleaning up statement\\n""));
- if (stat->row != NULL) {
- for (i = 1; i <= stat->num_columns; i++) {
+ if (statement->row != NULL) {
+ for (i = 1; i <= statement->num_columns; i++) {
/*
** Variable length types are allocated directly
** onto the Mercury heap, so don't free them here.
*/
if (! is_variable_length_sql_type(
- stat->row[i].sql_type))
+ statement->row[i].sql_type))
{
- MR_GC_free(stat->row[i].data);
+ MR_GC_free(statement->row[i].data);
}
}
- MR_GC_free(stat->row);
+ MR_GC_free(statement->row);
}
- rc = SQLFreeStmt(stat->stat_handle, SQL_DROP);
- MR_GC_free(stat);
+ rc = SQLFreeStmt(statement->stat_handle, SQL_DROP);
+ MR_GC_free(statement);
return rc;
} else {
return SQL_SUCCESS;
}
-}").
+}
+").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pragma c_code("
+:- pragma foreign_code("C", "
/*
** Map an ODBC SQL type to a supported attribute type.
** Currently, supported attribute types are minimal,
** but this function will allow us to ask ODBC to make
-** convertion from SQL types to supported types.
+** conversion from SQL types to supported types.
** Binary types are currently converted to strings.
*/
static MODBC_AttrType
@@ -1775,7 +1752,7 @@
case MODBC_STRING: return SQL_C_CHAR;
case MODBC_VAR_STRING: return SQL_C_CHAR;
default:
- /* Unsuported MODBC_xxx type */
+ /* Unsupported MODBC_xxx type */
MR_fatal_error(
""odbc.m: attribute_type_to_sql_c_type: unknown type"");
}
@@ -1962,58 +1939,55 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+%
+% Catalog functions
+%
- %
- % Catalog functions.
- %
-
-odbc__data_sources(MaybeSources - Messages) -->
- odbc__sql_data_sources(RevSourceNames, RevDescs, Status, RevMessages),
- ( { odbc__ok(Status) } ->
- { list__reverse(RevMessages, Messages) },
- { list__reverse(RevSourceNames, SourceNames) },
- { list__reverse(RevDescs, Descs) },
- { assoc_list__from_corresponding_lists(SourceNames,
- Descs, SourceAL) },
- { MakeSource = (pred(Pair::in, SourceDesc::out) is det :-
+odbc.data_sources(MaybeSources - Messages, !IO) :-
+ sql_data_sources(RevSourceNames, RevDescs, Status, RevMessages, !IO),
+ ( odbc.ok(Status) ->
+ list.reverse(RevMessages, Messages),
+ list.reverse(RevSourceNames, SourceNames),
+ list.reverse(RevDescs, Descs),
+ assoc_list.from_corresponding_lists(SourceNames, Descs, SourceAL),
+ MakeSource = (pred(Pair::in, SourceDesc::out) is det :-
Pair = SourceName - Desc,
- SourceDesc = odbc__source_desc(SourceName, Desc)
- ) },
- { list__map(MakeSource, SourceAL, Sources) },
- { MaybeSources = ok(Sources) }
- ; { odbc__no_data(Status) } ->
+ SourceDesc = odbc.source_desc(SourceName, Desc)
+ ),
+ list.map(MakeSource, SourceAL, Sources),
+ MaybeSources = ok(Sources)
+ ; odbc.no_data(Status) ->
% iODBC 2.12 doesn't implement this function.
- { Messages = [
+ Messages = [
error(feature_not_implemented) -
"[Mercury][odbc.m]SQLDataSources not implemented."
- ] },
- { MaybeSources = error }
+ ],
+ MaybeSources = error
;
- { list__reverse(RevMessages, Messages) },
- { MaybeSources = error }
+ list.reverse(RevMessages, Messages),
+ MaybeSources = error
).
-:- pred odbc__sql_data_sources(list(string)::out, list(string)::out, int::out,
- list(odbc__message)::out, io__state::di, io__state::uo) is det.
-
-:- pragma c_code(
- odbc__sql_data_sources(SourceNames::out, SourceDescs::out,
- Status::out, Messages::out, IO0::di, IO::uo),
- may_call_mercury,
-"{
- Status = odbc_do_get_data_sources(&SourceNames,
- &SourceDescs, &Messages);
+:- pred sql_data_sources(list(string)::out, list(string)::out, int::out,
+ list(odbc.message)::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ sql_data_sources(SourceNames::out, SourceDescs::out, Status::out,
+ Messages::out, IO0::di, IO::uo),
+ [promise_pure, may_call_mercury],
+"
+ Status = odbc_do_get_data_sources(&SourceNames, &SourceDescs, &Messages);
IO = IO0;
-}").
+").
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
-SQLRETURN odbc_do_get_data_sources(MR_Word *SourceNames,
- MR_Word *SourceDescs, MR_Word *Messages);
+SQLRETURN
+odbc_do_get_data_sources(MR_Word *SourceNames, MR_Word *SourceDescs,
+ MR_Word *Messages);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
SQLRETURN
odbc_do_get_data_sources(MR_Word *SourceNames, MR_Word *SourceDescs,
@@ -2085,66 +2059,58 @@
%-----------------------------------------------------------------------------%
-odbc__tables(Qualifier, Owner, TableName, Tables) -->
- { odbc__convert_pattern_argument(Qualifier, QualifierStr,
- QualifierStatus) },
- { odbc__convert_pattern_argument(Owner, OwnerStr, OwnerStatus) },
- { odbc__convert_pattern_argument(TableName, TableStr, TableStatus) },
- odbc__do_aggregate(odbc__sql_tables(QualifierStr, QualifierStatus,
+odbc.tables(Qualifier, Owner, TableName, Tables, !DB) :-
+ convert_pattern_argument(Qualifier, QualifierStr, QualifierStatus),
+ convert_pattern_argument(Owner, OwnerStr, OwnerStatus),
+ convert_pattern_argument(TableName, TableStr, TableStatus),
+ do_aggregate(odbc.sql_tables(QualifierStr, QualifierStatus,
OwnerStr, OwnerStatus, TableStr, TableStatus),
- odbc__cons, [], Results0),
- { list__reverse(Results0, Results) },
- ( { list__map(odbc__convert_table_desc, Results, Tables0) } ->
- { Tables = Tables0 }
- ;
- odbc__add_message(error(internal_error) -
- "[Mercury][odbc.m]Invalid results from SQLTables."),
- odbc__throw
+ list.cons, [], Results0, !DB),
+ list.reverse(Results0, Results),
+ ( list.map(convert_table_desc, Results, Tables0) ->
+ Tables = Tables0
+ ;
+ add_message(error(internal_error) -
+ "[Mercury][odbc.m]Invalid results from SQLTables.", !DB),
+ odbc.throw(!DB)
).
-:- pred odbc__convert_table_desc(odbc__row, odbc__table_desc).
-:- mode odbc__convert_table_desc(in, out) is semidet.
+:- pred convert_table_desc(odbc.row::in, odbc.table_desc::out) is semidet.
-odbc__convert_table_desc(Row0, Table) :-
- NullToEmptyStr =
- (pred(Data0::in, Data::out) is det :-
- ( Data0 = null ->
- Data = string("")
- ;
- Data = Data0
- )
+convert_table_desc(Row0, Table) :-
+ NullToEmptyStr = (pred(Data0::in, Data::out) is det :-
+ Data = ( Data0 = null -> string("") ; Data0 )
),
- list__map(NullToEmptyStr, Row0, Row),
+ list.map(NullToEmptyStr, Row0, Row),
Row = [string(Qualifier), string(Owner), string(Name),
string(Type), string(Description) | DriverColumns],
- Table = odbc__table_desc(Qualifier, Owner, Name,
+ Table = odbc.table_desc(Qualifier, Owner, Name,
Type, Description, DriverColumns).
%-----------------------------------------------------------------------------%
- % odbc__convert_pattern_argument(Pattern, String, Status).
+ % convert_pattern_argument(Pattern, String, Status).
% This is used in a fairly crude interface to C. If the Status is 0,
% the corresponding argument to the ODBC function should be NULL,
% meaning no constraint on the search. If the Status is 1, the
% argument to the ODBC function should be the given string.
+ %
+:- pred convert_pattern_argument(search_pattern::in, string::out, int::out)
+ is det.
-:- pred odbc__convert_pattern_argument(odbc__search_pattern::in,
- string::out, int::out) is det.
-
-odbc__convert_pattern_argument(any, "", 0).
-odbc__convert_pattern_argument(pattern(Str), Str, 1).
+convert_pattern_argument(any, "", 0).
+convert_pattern_argument(pattern(Str), Str, 1).
-:- pred odbc__sql_tables(string, int, string, int, string, int,
- odbc__statement, odbc__statement,
- odbc__state, odbc__state).
-:- mode odbc__sql_tables(in, in, in, in, in, in, di, uo, di, uo) is det.
+:- pred sql_tables(string::in, int::in, string::in, int::in, string::in,
+ int::in, odbc.statement::di, odbc.statement::uo,
+ odbc.state::di, odbc.state::uo) is det.
-:- pragma c_code(odbc__sql_tables(QualifierStr::in, QualifierStatus::in,
+:- pragma foreign_proc("C",
+ sql_tables(QualifierStr::in, QualifierStatus::in,
OwnerStr::in, OwnerStatus::in, TableStr::in, TableStatus::in,
Statement0::di, Statement::uo, DB0::di, DB::uo),
- may_call_mercury,
-"{
- MODBC_Statement *statement = (MODBC_Statement *) Statement0;
+ [may_call_mercury, promise_pure],
+"
char *qualifier_str = NULL;
char *owner_str = NULL;
char *table_str = NULL;
@@ -2153,6 +2119,8 @@
int table_len = 0;
SQLRETURN rc;
+ Statement = Statement0;
+
/*
** A NULL pointer in any of the string pattern fields
** means no constraint on the search for that field.
@@ -2170,41 +2138,41 @@
table_len = strlen(table_str);
}
- rc = SQLTables(statement->stat_handle, qualifier_str,
+ rc = SQLTables(Statement->stat_handle, qualifier_str,
qualifier_len, owner_str, owner_len,
table_str, table_len, NULL, 0);
if (! odbc_check(odbc_env_handle, odbc_connection,
- statement->stat_handle, rc)) {
- odbc_do_cleanup_statement(statement);
+ Statement->stat_handle, rc)) {
+ odbc_do_cleanup_statement(Statement);
odbc_throw();
}
DB = DB0;
- Statement = (MR_Word) statement;
-}").
+").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+%
+% Error checking
+%
- %
- % Error checking.
- %
-
-:- pred odbc__ok(int).
-:- mode odbc__ok(in) is semidet.
-
-:- pragma c_code(odbc__ok(Status::in), will_not_call_mercury,
+:- pred odbc.ok(int::in) is semidet.
+:- pragma foreign_proc("C",
+ odbc.ok(Status::in),
+ [promise_pure, will_not_call_mercury, thread_safe],
"
-SUCCESS_INDICATOR = (Status == SQL_SUCCESS || Status == SQL_SUCCESS_WITH_INFO);
+ SUCCESS_INDICATOR =
+ (Status == SQL_SUCCESS || Status == SQL_SUCCESS_WITH_INFO);
").
-:- pred odbc__no_data(int).
-:- mode odbc__no_data(in) is semidet.
+:- pred odbc.no_data(int::in) is semidet.
-:- pragma c_code(odbc__no_data(Status::in), will_not_call_mercury,
+:- pragma foreign_proc("C",
+ odbc.no_data(Status::in),
+ [promise_pure, will_not_call_mercury, thread_safe],
"
-SUCCESS_INDICATOR = (Status == SQL_NO_DATA_FOUND);
+ SUCCESS_INDICATOR = (Status == SQL_NO_DATA_FOUND);
").
%-----------------------------------------------------------------------------%
@@ -2213,13 +2181,14 @@
% provided with the ODBC SDK. The first two characters of the
% SQLSTATE are meant to specify an error class. Looking at the
% predicates below, the classes weren't terribly well chosen.
-:- pred odbc__sql_state_to_message(string::in, string::in,
- odbc__message::out) is det.
-:- pragma export(odbc__sql_state_to_message(in, in, out),
+ %
+:- pred sql_state_to_message(string::in, string::in,
+ odbc.message::out) is det.
+:- pragma export(sql_state_to_message(in, in, out),
"MODBC_odbc_sql_state_to_message").
-odbc__sql_state_to_message(SQLState, String, Message - String) :-
- string__split(SQLState, 2, Class, SubClass),
+sql_state_to_message(SQLState, String, Message - String) :-
+ string.split(SQLState, 2, Class, SubClass),
( Class = "01" ->
( sql_state_to_warning(SubClass, Warning) ->
Message = warning(Warning)
@@ -2234,7 +2203,8 @@
)
).
-:- pred sql_state_to_warning(string::in, odbc__warning::out) is semidet.
+:- pred sql_state_to_warning(string::in, odbc.warning::out) is semidet.
+
sql_state_to_warning("000", general_warning).
sql_state_to_warning("001", general_warning).
sql_state_to_warning("002", disconnect_error).
@@ -2245,8 +2215,7 @@
sql_state_to_warning("S03", general_warning).
sql_state_to_warning("S04", general_warning).
-:- pred sql_state_to_error(string::in, string::in,
- odbc__error::out) is semidet.
+:- pred sql_state_to_error(string::in, string::in, odbc.error::out) is semidet.
sql_state_to_error("07", "002", execution_error(incorrect_count_field)).
sql_state_to_error("07", "005", general_error).
@@ -2348,10 +2317,10 @@
Error = internal_error
).
-:- pragma c_code("
+:- pragma foreign_code("C", "
/*
-** Return MR_TRUE if the last ODBC call succeded.
+** Return MR_TRUE if the last ODBC call succeeded.
** Return MR_FALSE if the ODBC call failed.
** Add any error messages to odbc_message_list.
*/
@@ -2417,6 +2386,6 @@
").
-:- end_module odbc.
%-----------------------------------------------------------------------------%
+:- end_module odbc.
%-----------------------------------------------------------------------------%
Index: odbc_test.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/odbc/odbc_test.m,v
retrieving revision 1.4
diff -u -b -r1.4 odbc_test.m
--- odbc_test.m 30 Mar 2006 01:21:18 -0000 1.4
+++ odbc_test.m 3 Apr 2006 05:23:51 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Sample program for odbc.m.
% Author: stayl
% This source file is hereby placed in the public domain. -stayl.
@@ -6,13 +8,13 @@
% Assumes that there is an ODBC data source "test" containing a table
% named "test".
%-----------------------------------------------------------------------------%
-:- module odbc_test.
+:- module odbc_test.
:- interface.
:- import_module io.
-:- pred main(io__state::di, io__state::uo) is cc_multi.
+:- pred main(io::di, io::uo) is cc_multi.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -29,112 +31,109 @@
%-----------------------------------------------------------------------------%
-main -->
- odbc__data_sources(SourceResult - SourceMessages),
+main(!IO) :-
+ odbc.data_sources(SourceResult - SourceMessages, !IO),
(
- { SourceResult = ok(Sources) },
- io__write_string("Available data source names:"),
- io__nl,
- io__write_list(Sources, "\n", io__write),
- io__nl
+ SourceResult = ok(Sources),
+ io.write_string("Available data source names:", !IO),
+ io.nl(!IO),
+ io.write_list(Sources, "\n", io.write, !IO),
+ io.nl(!IO)
;
- { SourceResult = error },
- io__write_string("Error getting DSNs:"),
- io__nl
+ SourceResult = error,
+ io.write_string("Error getting DSNs:", !IO),
+ io.nl(!IO)
),
- io__write_list(SourceMessages, "\n", io__write),
- io__nl,
- odbc__transaction("test", "", "", odbc__tables(any, any, any),
- TableResult - TableMessages),
+ io.write_list(SourceMessages, "\n", io.write, !IO),
+ io.nl(!IO),
+ odbc.transaction("test", "", "", odbc.tables(any, any, any),
+ TableResult - TableMessages, !IO),
(
- { TableResult = ok(Tables) },
- io__write_string("Available tables:"),
- io__nl,
- io__write_list(Tables, "\n", io__write),
- io__nl
+ TableResult = ok(Tables),
+ io.write_string("Available tables:", !IO),
+ io.nl(!IO),
+ io.write_list(Tables, "\n", io.write, !IO),
+ io.nl(!IO)
;
- { TableResult = error },
- io__write_string("Error getting tables:"),
- io__nl
+ TableResult = error,
+ io.write_string("Error getting tables:", !IO),
+ io.nl(!IO)
),
- io__write_list(TableMessages, "\n", io__write),
- io__nl,
+ io.write_list(TableMessages, "\n", io.write, !IO),
+ io.nl(!IO),
- odbc__transaction("test", "", "", test_trans,
- TransResult - TransMessages),
+ odbc.transaction("test", "", "", test_trans,
+ TransResult - TransMessages, !IO),
(
- { TransResult = ok(Results) },
- io__write_string("transaction ok: "),
- { list__length(Results, NumRows) },
- io__write_int(NumRows),
- io__write_string(" result rows"),
- io__nl,
- io__write_list(Results, "\n", io__write),
- io__nl
+ TransResult = ok(Results),
+ io.write_string("transaction ok: ", !IO),
+ list.length(Results, NumRows),
+ io.write_int(NumRows, !IO),
+ io.write_string(" result rows", !IO),
+ io.nl(!IO),
+ io.write_list(Results, "\n", io.write, !IO),
+ io.nl(!IO)
;
- { TransResult = error },
- io__write_string("error in transaction:\n")
+ TransResult = error,
+ io.write_string("error in transaction:\n", !IO)
),
- io__write_list(TransMessages, "\n", io__write),
- io__nl,
+ io.write_list(TransMessages, "\n", io.write, !IO),
+ io.nl(!IO),
- try_io(odbc__transaction("test", "", "", test_trans_2),
- ExceptionResult),
+ try_io(odbc.transaction("test", "", "", test_trans_2),
+ ExceptionResult, !IO),
(
- { ExceptionResult = succeeded(Results2) },
- io__set_exit_status(1),
- io__write_string("Error: expected exception, got results:"),
- io__write(Results2),
- io__nl
+ ExceptionResult = succeeded(Results2),
+ io.set_exit_status(1, !IO),
+ io.write_string("Error: expected exception, got results:", !IO),
+ io.write(Results2, !IO),
+ io.nl(!IO)
;
- { ExceptionResult = exception(Exception) },
- { det_univ_to_type(Exception, ExceptionString) },
- io__write_string("Got exception: "),
- io__write_string(ExceptionString),
- io__nl
+ ExceptionResult = exception(Exception),
+ det_univ_to_type(Exception, ExceptionString),
+ io.write_string("Got exception: ", !IO),
+ io.write_string(ExceptionString, !IO),
+ io.nl(!IO)
).
-:- pred test_trans(list(odbc__row)::out,
- odbc__state::di, odbc__state::uo) is det.
+:- pred test_trans(list(odbc.row)::out, odbc.state::di, odbc.state::uo) is det.
-test_trans(Results) -->
- odbc__solutions("select * from test", Results).
+test_trans(Results, !DB) :-
+ odbc.solutions("select * from test", Results, !DB).
-:- pred test_trans_2(list(odbc__row)::out,
- odbc__state::di, odbc__state::uo) is det.
+:- pred test_trans_2(list(odbc.row)::out, odbc.state::di, odbc.state::uo)
+ is det.
-test_trans_2(Results) -->
- odbc__solutions("select * from test", Results),
- ( { semidet_succeed } ->
- { throw("exception in test_trans_2") }
+test_trans_2(Results, !DB) :-
+ odbc.solutions("select * from test", Results, !DB),
+ ( semidet_succeed ->
+ throw("exception in test_trans_2")
;
- []
+ true
).
-:- pred output_results(list(odbc__row)::in,
- io__state::di, io__state::uo) is det.
+:- pred output_results(list(odbc.row)::in, io::di, io::uo) is det.
-output_results(Rows) -->
- io__write_list(Rows, "\n", output_row).
+output_results(Rows, !IO) :-
+ io.write_list(Rows, "\n", output_row, !IO).
-:- pred output_row(odbc__row::in, io__state::di, io__state::uo) is det.
+:- pred output_row(odbc.row::in, io::di, io::uo) is det.
-output_row(Row) -->
- io__write_list(Row, " ", output_attribute).
-
-:- pred output_attribute(odbc__attribute::in,
- io__state::di, io__state::uo) is det.
-
-output_attribute(null) -->
- io__write_string("<NULL>").
-output_attribute(int(Int)) -->
- io__write_int(Int).
-output_attribute(string(Str)) -->
- io__write_string(Str).
-output_attribute(float(Float)) -->
- io__write_float(Float).
-output_attribute(time(String)) -->
- io__write_string(String).
+output_row(Row, !IO) :-
+ io.write_list(Row, " ", output_attribute, !IO).
+
+:- pred output_attribute(odbc.attribute::in, io::di, io::uo) is det.
+
+output_attribute(null, !IO) :-
+ io.write_string("<NULL>", !IO).
+output_attribute(int(Int), !IO) :-
+ io.write_int(Int, !IO).
+output_attribute(string(Str), !IO) :-
+ io.write_string(Str, !IO).
+output_attribute(float(Float), !IO) :-
+ io.write_float(Float, !IO).
+output_attribute(time(String), !IO) :-
+ io.write_string(String, !IO).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list