[plt-scheme] scheme/foreign and C arrays

On Fri, Dec 26, 2008 at 9:54 AM, Ben Simon <benjisimon at gmail.com> wrote:

> On Fri, Dec 26, 2008 at 7:16 AM, troels knak-nielsen <troelskn at gmail.com>wrote:
>
>> I had a similar problem a few months back. Have a look over here:
>>
>> http://stackoverflow.com/questions/105816/how-do-i-access-a-char-through-ffi-in-plt-scheme
>
>
> Figures, the exact question I was asking was already asked - typical.
>
> The answer doesn't really make sense to me. But, it gives me a place to
> start, and I'll mull it over from there.
>

I've mulled it over, and gotten closer, but am not quite there yet.

The return type of mysql-fetch-row is described as:

This is a type-safe representation of one row of data. It is currently
implemented as an array of counted byte strings.

If I ignore for a second that they are byte counted strings, and not strings
represented by a final null, I can write:

(defmysql mysql-fetch-row : _result -> (_vector o _string
(mysql-field-count)))

(see below for all the source code.  Though, everything after the : above is
re-written into a (_fun ...))

This works remarkably well, but mysql-fetch-row returns NULL to signify the
end of result set has been reached.

With the above, I get the following error message when the end of a result
set is hit:

   ptr-ref: expects type <non-null-cpointer> as 1st argument, given: #f;
other arguments were: #<ctype> 1

Any suggestions for how to handle this?

I feel like I want to somehow use _cpointer/null - but just wrapping the
above in a _cpointer/null doesn't appear to help.

Also, to make this really robust, I'm going to need to think of this as a
vector of _pointer's and then make byte strings out of them using the
lenghts mysql tells me about.  Part of this solution seems straightforward:

 ;; careful, psudo code below
 (define _row (make-ctype (_vector o _pointer (mysql-field-count)) #f
                                                  (lambda (row)
                                                    ;; row is a vector of
_pointer's into strings
                                                    (for/list ([ptr row]
                                                                [length
(mysql-fetch-lengths RESULT)])
                                                        (
make-sized-byte-string<file:///C:/Program%20Files/PLT/doc/foreign/foreign_pointer-funcs.html#%28def._%28%28lib._scribblings/foreign/unsafe-foreign..ss%29._make-sized-byte-string%29%29>
ptr
length)))))


The tricky part here is that I need access to RESULT - which is the value
passed into mysql-fetch-row.  Any suggestions for how I can arrange for this
argument to be available for the ctype of resulting row?

Thanks again for all help.  Hopefully, this knowledge will be useful to
others who come along and want to develop their own FFIs.

-Ben

(require scheme/foreign)
(unsafe!)

(define current-mysql-handle (make-parameter #f))

(define libmysql (ffi-lib "libmysql"))

(define _handle (make-ctype _pointer #f
                            (lambda
(handle)
                              (when handle (register-finalizer handle
mysql-close))
                              handle)))

(define _result (make-ctype _pointer #f
                             (lambda (results)
                               (when results (register-finalizer results
mysql-free-result))
                               results)))

(define _data (make-ctype _pointer #f
                          (lambda (data)
                            (if data
                                data
                                (error 'mysql (mysql-error))))))

(define _ok? (make-ctype _int #f
                        (lambda (val)
                          (if (= val 0) #t
                              (error 'mysql (mysql-error))))))

(define-fun-syntax _handle*
  (syntax-id-rules ()
    [_ (type: _handle expr: (current-mysql-handle))]))

(define-fun-syntax _null_ptr*
  (syntax-id-rules ()
    [_ (type: _pointer expr: #f)]))

(define-syntax defmysql
  (syntax-rules (:)
    [(_ name : type ...)
     (define name (get-ffi-obj (regexp-replaces 'name '((#rx"-" "_")
(#rx"[*?]$" "")))
                                libmysql (_fun type ...)))]))

(defmysql mysql-init : _null_ptr* -> _handle)
(defmysql mysql-close : _handle -> _void)
(defmysql mysql-error : _handle* -> _string)

(current-mysql-handle (mysql-init))

(defmysql mysql-real-connect :
  _handle* _string _string _string _string _int _string _long -> _data)

(defmysql mysql-ping : _handle* -> _ok?)

(defmysql mysql-query : _handle* _string -> _ok?)
(defmysql mysql-free-result : _handle* _result -> _void)
(defmysql mysql-store-result : _handle* -> _result)
(defmysql mysql-num-fields : _result -> _int)
(defmysql mysql-num-rows : _result -> _int)
(defmysql mysql-field-count : _handle* -> _int)
(defmysql mysql-fetch-row : _result -> (_vector o _string
(mysql-field-count)))
(defmysql mysql-fetch-lengths : _result -> (_vector  o _long
(mysql-field-count)))


;; TEST CODE
(define (do-test)
  (mysql-real-connect "localhost" "root"  "PASSWORD" "DATABASE" 0 "" 0)
  (mysql-query "select ID, user_login from wp_users")
  (printf "You've got: ~a  columns.\n" (mysql-field-count))
  (let ([r (mysql-store-result)])
    (let loop ([i 0] [row (mysql-fetch-row r)])
      (cond (row
             (printf "Row: ~a\n" i)
             (printf " ~a\n" row)
             (printf "\n")
             (loop (add1 i) (mysql-fetch-row r)))
            (else 'done)))))








-- 
Have an idea for software?  I can make it happen -
http://www.ideas2executables.com
My Blog: http://benjisimon.blogspot.com
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20081227/fb1c61b8/attachment.html>