General cleanup of code

foreign/c.sld

@@ -207,7 +207,7 @@
               (ypsilon c-ffi)
               (ypsilon c-types)
               (only (core) define-macro syntax-case))))
-  (export ;; Primitives
+  (export ;;;; Primitives
           c-size-of
           define-c-library
           define-c-procedure
@@ -218,11 +218,12 @@
           c-bytevector-pointer-set!
           c-bytevector-pointer-ref
 
-          ;; c-bytevector
+          ;;;; c-bytevector
+          make-c-bytevector
+          make-c-null
+          c-null?
+          c-free
           native-endianness
-          ;; TODO Docs for all of these
-          ;c-bytevector->address
-          ;address->c-bytevector
           c-bytevector-s8-set!
           c-bytevector-s8-ref
           c-bytevector-s16-set!
@@ -261,23 +262,14 @@
           c-bytevector-ieee-double-native-set!
           c-bytevector-ieee-double-ref
           c-bytevector-ieee-double-native-ref
-
-          ;; c-bytevector
-          make-c-bytevector
-          ;c-bytevector ;; TODO docs, tests
-          make-c-null
-          c-null?
-          c-free
-
-
-          c-string-length ;; TODO Documentation, Testing
           bytevector->c-bytevector
           c-bytevector->bytevector
-          call-with-address-of-c-bytevector ;; Todo Documentation
+          call-with-address-of
+
           string->c-utf8
           c-utf8->string
 
-          ;c-bytevector-u8-ref ;; TODO Documentation, Testing
+          ;c-string-length ;; TODO Documentation, Testing
 
           ;; c-struct
           ;pffi-define-struct;define-c-struct
@@ -301,10 +293,8 @@
           ;define-c-variable (?)
           )
   (cond-expand
-    (chicken-6 (include-relative "c/types.scm")
+    (chicken-6 (include-relative "c/internal.scm"))
-               (include-relative "c/c-bytevector-get.scm"))
+    (else (include "c/internal.scm")))
-    (else (include "c/types.scm")
-          (include "c/c-bytevector-get.scm")))
   (cond-expand
     (chibi (include "c/primitives/chibi.scm"))
     (chicken-5 (export foreign-declare

foreign/c/internal.scm

@@ -1,3 +1,29 @@
+(define type->libffi-type-number
+  (lambda (type)
+    (cond ((equal? type 'int8) 1)
+          ((equal? type 'uint8) 2)
+          ((equal? type 'int16) 3)
+          ((equal? type 'uint16) 4)
+          ((equal? type 'int32) 5)
+          ((equal? type 'uint32) 6)
+          ((equal? type 'int64) 7)
+          ((equal? type 'uint64) 8)
+          ((equal? type 'char) 9)
+          ((equal? type 'unsigned-char) 10)
+          ((equal? type 'short) 11)
+          ((equal? type 'unsigned-short) 12)
+          ((equal? type 'int) 13)
+          ((equal? type 'unsigned-int) 14)
+          ((equal? type 'long) 15)
+          ((equal? type 'unsigned-long) 16)
+          ((equal? type 'float) 17)
+          ((equal? type 'double) 18)
+          ((equal? type 'void) 19)
+          ((equal? type 'pointer) 20)
+          ((equal? type 'pointer-address) 21)
+          ((equal? type 'callback) 22)
+          (else (error "Undefined type" type)))))
+
 (define c-bytevector-get
   (lambda (pointer type offset)
     (cond ((equal? type 'int8) (c-bytevector-s8-ref pointer offset))

foreign/c/pointer.scm

@@ -111,7 +111,7 @@
 
 (cond-expand
   ;(kawa #t) ; Defined in kawa.scm
-  (else (define-syntax call-with-address-of-c-bytevector
+  (else (define-syntax call-with-address-of
           (syntax-rules ()
             ((_ input-pointer thunk)
              (let ((address-pointer (make-c-bytevector (c-size-of 'pointer))))

foreign/c/types.scm

@@ -1,25 +0,0 @@
-(define type->libffi-type-number
-  (lambda (type)
-    (cond ((equal? type 'int8) 1)
-          ((equal? type 'uint8) 2)
-          ((equal? type 'int16) 3)
-          ((equal? type 'uint16) 4)
-          ((equal? type 'int32) 5)
-          ((equal? type 'uint32) 6)
-          ((equal? type 'int64) 7)
-          ((equal? type 'uint64) 8)
-          ((equal? type 'char) 9)
-          ((equal? type 'unsigned-char) 10)
-          ((equal? type 'short) 11)
-          ((equal? type 'unsigned-short) 12)
-          ((equal? type 'int) 13)
-          ((equal? type 'unsigned-int) 14)
-          ((equal? type 'long) 15)
-          ((equal? type 'unsigned-long) 16)
-          ((equal? type 'float) 17)
-          ((equal? type 'double) 18)
-          ((equal? type 'void) 19)
-          ((equal? type 'pointer) 20)
-          ((equal? type 'pointer-address) 21)
-          ((equal? type 'callback) 22)
-          (else (error "Undefined type" type)))))

tests/addressof.scm

@@ -71,7 +71,7 @@
        (write value)
        (newline)))))
 
-;; call-with-address-of-c-bytevector
+;; call-with-address-of
 
 (define-c-library c-testlib
                      '("libtest.h")
@@ -79,7 +79,7 @@
                      '((additional-paths ("." "./tests"))))
 
 
-(print-header 'call-with-address-of-c-bytevector)
+(print-header 'call-with-address-of)
 
 (define-c-procedure test-passing-pointer-address
                       c-testlib
@@ -92,7 +92,7 @@
 (assert equal? (= (c-bytevector-s32-native-ref input-pointer 0) 100) #t)
 (debug (c-bytevector-s32-native-ref input-pointer 0))
 (debug input-pointer)
-(call-with-address-of-c-bytevector
+(call-with-address-of
   input-pointer
   (lambda (address)
     (test-passing-pointer-address input-pointer address)))