diff options
author | Andy Wingo <wingo@pobox.com> | 2024-03-17 21:39:16 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2024-03-17 21:40:58 +0100 |
commit | e15617dc0e1e53a54798d88617f0095801a52f1c (patch) | |
tree | 32536ae66367f03145957f1018d99c625f287613 /module/system | |
parent | d7ae468c170454d807bd0dd29ae309ffa4f448ce (diff) | |
download | guile-e15617dc0e1e53a54798d88617f0095801a52f1c.tar.gz |
Expose read-c-struct, write-c-struct syntax
* module/system/foreign.scm (read-c-struct): Rename from read-fields.
Export.
(write-c-struct): Rename from write-fields. Export.
(%write-c-struct, %read-c-struct): Add % prefix to these private
bindings.
Diffstat (limited to 'module/system')
-rw-r--r-- | module/system/foreign.scm | 26 |
1 files changed, 14 insertions, 12 deletions
diff --git a/module/system/foreign.scm b/module/system/foreign.scm index 043d34409..a75c37da1 100644 --- a/module/system/foreign.scm +++ b/module/system/foreign.scm @@ -55,6 +55,8 @@ pointer->procedure ;; procedure->pointer (see below) + + read-c-struct write-c-struct make-c-struct parse-c-struct define-wrapped-pointer-type)) @@ -160,7 +162,7 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (... ...) (else (let ((offset (align offset (alignof type)))) - (values (read-c-struct bv offset type) + (values (%read-c-struct bv offset type) (+ offset (sizeof type))))))) (dispatch-read type @@ -178,10 +180,10 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (complex-double bytevector-complex-double-native-ref) ('* bytevector-pointer-ref)))) -(define-syntax-rule (read-fields %bv %offset ((field type) ...) k) +(define-syntax-rule (read-c-struct %bv %offset ((field type) ...) k) (let ((bv %bv) (offset %offset) - (size (compile-time-eval (sizeof '(type ...))))) + (size (compile-time-eval (sizeof (list type ...))))) (unless (<= (bytevector-length bv) (+ offset size)) (error "destination bytevector too small")) (let*-values (((field offset) @@ -205,7 +207,7 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (... ...) (else (let ((offset (align offset (alignof type)))) - (write-c-struct bv offset type value) + (%write-c-struct bv offset type value) (+ offset (sizeof type)))))) (dispatch-write type @@ -223,18 +225,18 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (complex-double bytevector-complex-double-native-set!) ('* bytevector-pointer-set!)))) -(define-syntax-rule (write-fields %bv %offset ((field type) ...)) +(define-syntax-rule (write-c-struct %bv %offset ((field type) ...)) (let ((bv %bv) (offset %offset) - (size (compile-time-eval (sizeof '(type ...))))) + (size (compile-time-eval (sizeof (list type ...))))) (unless (<= (bytevector-length bv) (+ offset size)) (error "destination bytevector too small")) (let* ((offset (write-field bv offset (compile-time-eval type) field)) ...) (values)))) -;; Same as write-fields, but with run-time dispatch. -(define (write-c-struct bv offset types vals) +;; Same as write-c-struct, but with run-time dispatch. +(define (%write-c-struct bv offset types vals) (let lp ((offset offset) (types types) (vals vals)) (match types (() (match vals @@ -246,8 +248,8 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (lp (write-field bv offset type val) types vals)) (() (error "too few values" vals))))))) -;; Same as read-fields, but with run-time dispatch. -(define (read-c-struct bv offset types) +;; Same as read-c-struct, but with run-time dispatch. +(define (%read-c-struct bv offset types) (let lp ((offset offset) (types types)) (match types (() '()) @@ -258,11 +260,11 @@ not cross-compiling; otherwise leave it to be evaluated at run-time." (define (make-c-struct types vals) (let ((bv (make-bytevector (sizeof types) 0))) - (write-c-struct bv 0 types vals) + (%write-c-struct bv 0 types vals) (bytevector->pointer bv))) (define (parse-c-struct foreign types) - (read-c-struct (pointer->bytevector foreign (sizeof types)) 0 types)) + (%read-c-struct (pointer->bytevector foreign (sizeof types)) 0 types)) ;;; |