diff --git a/pkgs/racket-doc/scribblings/foreign/define.scrbl b/pkgs/racket-doc/scribblings/foreign/define.scrbl index ee329e54bf..5d8c7cc0dc 100644 --- a/pkgs/racket-doc/scribblings/foreign/define.scrbl +++ b/pkgs/racket-doc/scribblings/foreign/define.scrbl @@ -9,7 +9,8 @@ option ...) ([option (code:line #:provide provide-id) (code:line #:define core-define-id) - (code:line #:default-make-fail default-make-fail-expr)])]{ + (code:line #:default-make-fail default-make-fail-expr) + (code:line #:make-c-id make-c-id)])]{ Binds @racket[define-id] as a definition form to extract bindings from the library produced by @racket[ffi-lib-expr]. The syntax of @@ -45,6 +46,12 @@ The other options support further wrapping and configuration: @racket[_id] to report an error when it is applied if @racket[_c-id] was not found in the foreign library.} + @item{If provided, the @racket[#:make-c-id] option changes + the default behavior of @racket[_c-id] using an @tech{ffi + identifier convention}, such as converting hyphens to + underscores or camel case. + Several conventions are provided by + @racketmodname[ffi/unsafe/define/conventions].} ] If @racket[provide-id] is provided to @racket[define-ffi-definer], then @@ -84,6 +91,7 @@ error immediately. If @racket[define-gtk] is instead defined with then if @tt{gtk_rc_parse} is not found in @racket[gtk-lib], an error is reported only when @racket[gtk_rc_parse] is called.} +@history[#:changed "6.9.0.5" @elem{Added @racket[#:make-c-id] parameter.}] @defproc[(make-not-available [name symbol?]) (#:rest list? -> any/c)]{ @@ -97,3 +105,42 @@ with @racket[#:make-fail] or @racket[#:default-make-fail] in Equivalent to @racket[(provide (protect-out provide-spec ...))]. The @racket[provide-protected] identifier is useful with @racket[#:provide] in @racket[define-ffi-definer].} + +@section{FFI Identifier Conventions} + +@defmodule[ffi/unsafe/define/conventions] + +This module provides several +@deftech{FFI identifier conventions} for use with +@racket[#:make-c-id] in @racket[define-ffi-definer]. A +@tech{FFI identifier convention} is any +@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{syntax transformer} +that converts one identifier to another. + +@history[#:added "6.9.0.5"] + +@defidform[convention:hyphen->underscore]{ + + A convention that converts hyphens in an identifier to + underscores. For example, the identifier + @racket[gtk-rc-parse] will transform to @racket[gkt_rc_parse]. + +@racketblock[ + (define-ffi-definer define-gtk gtk-lib + #:make-c-id convention:hyphen->underscore) + (define-gtk gtk-rc-parse (_fun _path -> _void))] +} + +@defidform[convention:hyphen->camelcase]{ + + Similar to @racket[convention:hyphen->underscore], but + converts the identifier to camel case instead, following the + @racket[string-titlecase] function. For example, the + identifier @racket[camelCaseVariable] will transform to + @racket[came-case-variable]. + + @racketblock[ + (define-ffi-definer define-calib camel-lib + #:make-c-id conventon:hyphen->camelcase) + (define-calib camel-case-variable (_fun -> _void))] +} diff --git a/pkgs/racket-test-core/tests/racket/foreign-test.rktl b/pkgs/racket-test-core/tests/racket/foreign-test.rktl index ec083cadb0..69b3372509 100644 --- a/pkgs/racket-test-core/tests/racket/foreign-test.rktl +++ b/pkgs/racket-test-core/tests/racket/foreign-test.rktl @@ -5,6 +5,8 @@ (require ffi/unsafe ffi/unsafe/cvector + ffi/unsafe/define + ffi/unsafe/define/conventions ffi/vector racket/extflonum racket/place @@ -1190,6 +1192,20 @@ ;; ---------------------------------------- +(let () + (unless (eq? (system-type) 'windows) + (define-ffi-definer define-test-lib test-lib + #:make-c-id convention:hyphen->underscore) + (define-test-lib check-multiple-of-ten + (_fun #:save-errno 'posix _int -> _int)) + (test 0 check-multiple-of-ten 40) + (test -1 check-multiple-of-ten 42) + (test 2 saved-errno) + (saved-errno 5) + (test 5 saved-errno))) + +;; ---------------------------------------- + (report-errs) #| --- ignore everything below --- diff --git a/racket/collects/ffi/unsafe/define.rkt b/racket/collects/ffi/unsafe/define.rkt index 66874f613f..a8a7ba54f7 100644 --- a/racket/collects/ffi/unsafe/define.rkt +++ b/racket/collects/ffi/unsafe/define.rkt @@ -1,4 +1,5 @@ #lang racket/base + (require (for-syntax syntax/parse racket/base) ffi/unsafe) @@ -37,7 +38,10 @@ #:name "#:define keyword") (~optional (~seq #:default-make-fail default-make-fail:expr) #:defaults ([default-make-fail #'(lambda (id) #f)]) - #:name "#:default-make-fail keyword")) + #:name "#:default-make-fail keyword") + (~optional (~seq #:make-c-id make-c-id:id) + #:defaults ([make-c-id #'#f]) + #:name "#:make-c-id")) ...)) #`(begin (define the-ffi-lib @@ -52,7 +56,9 @@ (lambda (stx) (syntax-parse stx [(_ s-id:id type:expr (~seq (~or (~optional (~seq #:c-id c-id:id) - #:defaults ([c-id #'s-id]) + #:defaults ([c-id #,(if (identifier? (attribute make-c-id)) + #'((syntax-local-value #'make-c-id) #'s-id) + #'#'s-id)]) #:name "#:c-id keyword") (~optional (~seq #:wrap wrapper:expr) #:defaults ([wrapper #'values]) @@ -61,6 +67,10 @@ (~seq #:fail fail:expr)) #:defaults ([make-fail #'default-make-fail]))) (... ...))) + (unless (identifier? #'c-id) + (raise-syntax-error #f + "invalid make-c-id expression" + #'make-c-id)) (with-syntax ([fail (if (attribute fail) #'fail #'(make-fail 's-id))]) @@ -72,3 +82,4 @@ (provide s-id) def)) #'def)))])))))])) + diff --git a/racket/collects/ffi/unsafe/define/conventions.rkt b/racket/collects/ffi/unsafe/define/conventions.rkt new file mode 100644 index 0000000000..772bd5f17e --- /dev/null +++ b/racket/collects/ffi/unsafe/define/conventions.rkt @@ -0,0 +1,17 @@ +#lang racket/base + +(provide convention:hyphen->underscore + convention:hyphen->camelcase) +(require (for-syntax racket/base + racket/syntax + racket/string + syntax/parse)) + +(define-syntax (convention:hyphen->underscore id) + (format-id id (string-replace (symbol->string (syntax-e id)) "-" "_"))) + +(define-syntax (convention:hyphen->camelcase id) + (define str (symbol->string (syntax-e id))) + (format-id id + (apply string-append + (map string-titlecase (string-split str "-")))))