(define pffi-type->native-type
  (lambda (type)
    (cond ((equal? type 'int8) :int)
          ((equal? type 'uint8) :uint)
          ((equal? type 'int16) :int)
          ((equal? type 'uint16) :uint)
          ((equal? type 'int32) :int)
          ((equal? type 'uint32) :uint)
          ((equal? type 'int64) :int)
          ((equal? type 'uint64) :uint)
          ((equal? type 'char) :char)
          ((equal? type 'unsigned-char) :uchar)
          ((equal? type 'short) :short)
          ((equal? type 'unsigned-short) :ushort)
          ((equal? type 'int) :int)
          ((equal? type 'unsigned-int) :uint)
          ((equal? type 'long) :long)
          ((equal? type 'unsigned-long) :ulong)
          ((equal? type 'float) :float)
          ((equal? type 'double) :double)
          ((equal? type 'pointer) :pointer)
          ((equal? type 'string) :string)
          ((equal? type 'void) :void)
          ((equal? type 'struct) :void)
          (else (error "pffi-type->native-type -- No such pffi type" type)))))

(define pffi-pointer?
  (lambda (object)
    (display "HERE: ")
    (write object)
    (newline)
    (write (cpointer? object))
    (newline)
    (cpointer? object)))

(define-syntax pffi-define
  (syntax-rules ()
    ((pffi-define scheme-name shared-object c-name return-type argument-types)
     (begin
       (define pffi-type->native-type
  (lambda (type)
    (cond ((equal? type 'int8) :int)
          ((equal? type 'uint8) :uint)
          ((equal? type 'int16) :int)
          ((equal? type 'uint16) :uint)
          ((equal? type 'int32) :int)
          ((equal? type 'uint32) :uint)
          ((equal? type 'int64) :int)
          ((equal? type 'uint64) :uint)
          ((equal? type 'char) :char)
          ((equal? type 'unsigned-char) :uchar)
          ((equal? type 'short) :short)
          ((equal? type 'unsigned-short) :ushort)
          ((equal? type 'int) :int)
          ((equal? type 'unsigned-int) :uint)
          ((equal? type 'long) :long)
          ((equal? type 'unsigned-long) :ulong)
          ((equal? type 'float) :float)
          ((equal? type 'double) :double)
          ((equal? type 'pointer) :pointer)
          ((equal? type 'string) :string)
          ((equal? type 'void) :void)
          ((equal? type 'struct) :void)
          (else (error "pffi-type->native-type -- No such pffi type" type)))))
     (define scheme-name
       (make-external-function
         (symbol->string c-name)
         (map pffi-type->native-type argument-types)
         (pffi-type->native-type return-type)
         shared-object))))))

(define pffi-define-callback
  (lambda ()
    (error "Not implemented")))

; FIXME
(define size-of-type
  (lambda (type)
    (cond
      ((equal? type 'int8) 1)
      ((equal? type 'uint8) 1)
      ((equal? type 'int16) 2)
      ((equal? type 'uint16) 2)
      ((equal? type 'int32) 4)
      ((equal? type 'uint32) 4)
      ((equal? type 'int64) 8)
      ((equal? type 'uint64) 8)
      ((equal? type 'char) 1)
      ((equal? type 'unsigned-char) 1)
      ((equal? type 'short) 2)
      ((equal? type 'unsigned-short) 2)
      ((equal? type 'int) 4)
      ((equal? type 'unsigned-int) 4)
      ((equal? type 'long) 8)
      ((equal? type 'unsigned-long) 8)
      ((equal? type 'float) 4)
      ((equal? type 'double) 8)
      ((equal? type 'pointer) 8)

      )))

#;(define pffi-pointer-allocate
  (lambda (size)
    (allocate-bytes size)))

;; FIXME
(define pffi-pointer-address
  (lambda (pointer)
    0))

;; FIXME
(define pffi-pointer-null
  (lambda ()
    (let ((p (allocate-bytes 0)))
      (free-bytes p)
      p)))

#;(define pffi-pointer-free
  (lambda (pointer)
    (free-bytes pointer)))

(define pffi-pointer-null?
  (lambda (pointer)
    (and (cpointer? pointer)
         (cpointer-null? pointer))))

(define pffi-pointer-set!
  (lambda (pointer type offset value)
    (cond ((equal? type 'int8) (pointer-set-c-int8_t! pointer offset value))
          ((equal? type 'uint8) (pointer-set-c-uint8_t! pointer offset value))
          ((equal? type 'int16) (pointer-set-c-int16_t! pointer offset value))
          ((equal? type 'uint16) (pointer-set-c-uint16_t! pointer offset value))
          ((equal? type 'int32) (pointer-set-c-int32_t! pointer offset value))
          ((equal? type 'uint32) (pointer-set-c-uint32_t! pointer offset value))
          ((equal? type 'int64) (pointer-set-c-int64_t! pointer offset value))
          ((equal? type 'uint64) (pointer-set-c-uint64_t! pointer offset value))
          ((equal? type 'char) (pointer-set-c-char! pointer offset value))
          ((equal? type 'short) (pointer-set-c-short! pointer offset value))
          ((equal? type 'unsigned-short) (pointer-set-c-unsigned-short! pointer offset value))
          ((equal? type 'int) (pointer-set-c-int! pointer offset value))
          ((equal? type 'unsigned-int) (pointer-set-c-unsigned-int! pointer offset value))
          ((equal? type 'long) (pointer-set-c-long! pointer offset value))
          ((equal? type 'unsigned-long) (pointer-set-c-unsigned-long! pointer offset value))
          ((equal? type 'float) (pointer-set-c-float! pointer offset value))
          ((equal? type 'double) (pointer-set-c-double! pointer offset value))
          ((equal? type 'void) (pointer-set-c-pointer! pointer offset value))
          ((equal? type 'pointer) (pointer-set-c-pointer! pointer offset value)))))

(define pffi-pointer-get
  (lambda (pointer type offset)
    (cond ((equal? type 'int8) (pointer-ref-c-int8_t pointer offset))
          ((equal? type 'uint8) (pointer-ref-c-uint8_t pointer offset))
          ((equal? type 'int16) (pointer-ref-c-int16_t pointer offset))
          ((equal? type 'uint16) (pointer-ref-c-uint16_t pointer offset))
          ((equal? type 'int32) (pointer-ref-c-int32_t pointer offset))
          ((equal? type 'uint32) (pointer-ref-c-uint32_t pointer offset))
          ((equal? type 'int64) (pointer-ref-c-int64_t pointer offset))
          ((equal? type 'uint64) (pointer-ref-c-uint64_t pointer offset))
          ((equal? type 'char) (pointer-ref-c-char pointer offset))
          ((equal? type 'short) (pointer-ref-c-short pointer offset))
          ((equal? type 'unsigned-short) (pointer-ref-c-unsigned-short pointer offset))
          ((equal? type 'int) (pointer-ref-c-int pointer offset))
          ((equal? type 'unsigned-int) (pointer-ref-c-unsigned-int pointer offset))
          ((equal? type 'long) (pointer-ref-c-long pointer offset))
          ((equal? type 'unsigned-long) (pointer-ref-c-unsigned-long pointer offset))
          ((equal? type 'float) (pointer-ref-c-float pointer offset))
          ((equal? type 'double) (pointer-ref-c-double pointer offset))
          ((equal? type 'void) (pointer-ref-c-pointer pointer offset))
          ((equal? type 'pointer) (pointer-ref-c-pointer pointer offset)))))