From 088d1dadb407132ad3b2398fc50e480e86a2fab5 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 24 Aug 2012 14:23:34 -0600 Subject: [PATCH] add `ffi/unsafe/nsalloc' and `ffi/unsafe/nsstring' --- collects/ffi/unsafe/nsalloc.rkt | 28 ++++++++++++ collects/ffi/unsafe/nsstring.rkt | 45 ++++++++++++++++++ collects/mred/private/wx/cocoa/types.rkt | 24 ++-------- collects/mred/private/wx/cocoa/utils.rkt | 16 ++----- collects/scribblings/foreign/derived.scrbl | 1 + collects/scribblings/foreign/ns.scrbl | 53 ++++++++++++++++++++++ 6 files changed, 134 insertions(+), 33 deletions(-) create mode 100644 collects/ffi/unsafe/nsalloc.rkt create mode 100644 collects/ffi/unsafe/nsstring.rkt create mode 100644 collects/scribblings/foreign/ns.scrbl diff --git a/collects/ffi/unsafe/nsalloc.rkt b/collects/ffi/unsafe/nsalloc.rkt new file mode 100644 index 0000000000..326f94420c --- /dev/null +++ b/collects/ffi/unsafe/nsalloc.rkt @@ -0,0 +1,28 @@ +#lang racket/base +(require ffi/unsafe/objc + ffi/unsafe + ffi/unsafe/atomic) + +(provide (protect-out with-autorelease + call-with-autorelease)) + +;; Make sure Foundation is loaded: +(void (ffi-lib "/System/Library/Frameworks/Foundation.framework/Foundation" + #:fail (lambda () #f))) + +(import-class NSAutoreleasePool) + +(define-syntax-rule (with-autorelease expr ...) + (call-with-autorelease (lambda () expr ...))) + +(define (call-with-autorelease thunk) + (unless NSAutoreleasePool + (error 'NSAutoreleasePool "not available")) + (call-as-atomic + (lambda () + (let ([pool (tell (tell NSAutoreleasePool alloc) init)]) + (dynamic-wind + void + thunk + (lambda () + (tellv pool release))))))) diff --git a/collects/ffi/unsafe/nsstring.rkt b/collects/ffi/unsafe/nsstring.rkt new file mode 100644 index 0000000000..14ce3aaff1 --- /dev/null +++ b/collects/ffi/unsafe/nsstring.rkt @@ -0,0 +1,45 @@ +#lang racket/base +(require ffi/unsafe/objc + ffi/unsafe + ffi/unsafe/alloc + ffi/unsafe/atomic + "nsalloc.rkt") + +(provide (protect-out _NSString)) + +(import-class NSString) + +(define-syntax-rule (atomically e) + (begin + (start-atomic) + (begin0 + e + (end-atomic)))) + +;; Access this table on only in atomic mode, so +;; that _NSString can be used in atomic mode: +(define strings (make-weak-hash)) + +(define (release-string s) + (tellv s release)) + +(define allocate-string + ((allocator release-string) + (lambda (v) + (with-autorelease + (tell (tell NSString alloc) + initWithUTF8String: + #:type _string + v))))) + +(define _NSString (make-ctype _id + (lambda (v) + (or (atomically + (hash-ref strings v #f)) + (let ([s (allocate-string v)]) + (atomically (hash-set! strings v s)) + s))) + (lambda (v) + (with-autorelease + (let ([s (tell #:type _bytes v UTF8String)]) + (bytes->string/utf-8 s)))))) diff --git a/collects/mred/private/wx/cocoa/types.rkt b/collects/mred/private/wx/cocoa/types.rkt index 665aeae12a..2679f30a30 100644 --- a/collects/mred/private/wx/cocoa/types.rkt +++ b/collects/mred/private/wx/cocoa/types.rkt @@ -1,6 +1,7 @@ #lang racket/base (require ffi/unsafe/objc ffi/unsafe + ffi/unsafe/nsstring "../../lock.rkt" "utils.rkt") @@ -11,9 +12,9 @@ _NSSize _NSSize-pointer (struct-out NSSize) _NSRect _NSRect-pointer (struct-out NSRect) _NSRange _NSRange-pointer (struct-out NSRange) - NSObject - NSString _NSString - NSNotFound)) + NSObject + NSNotFound) + _NSString) (define _NSInteger _long) (define _NSUInteger _ulong) @@ -41,23 +42,6 @@ (import-class NSObject NSString) -(define strings (make-weak-hash)) -(define _NSString (make-ctype _id - (lambda (v) - (or (hash-ref strings v #f) - (let ([s (as-objc-allocation - (tell (tell NSString alloc) - initWithUTF8String: - #:type _string - v))]) - (hash-set! strings v s) - s))) - (lambda (v) - (atomically - (with-autorelease - (let ([s (tell #:type _bytes v UTF8String)]) - (bytes->string/utf-8 s))))))) - (define NSNotFound (if 64-bit? #x7fffffffffffffff #x7fffffff)) diff --git a/collects/mred/private/wx/cocoa/utils.rkt b/collects/mred/private/wx/cocoa/utils.rkt index 67a3032501..37d71d6637 100644 --- a/collects/mred/private/wx/cocoa/utils.rkt +++ b/collects/mred/private/wx/cocoa/utils.rkt @@ -3,6 +3,7 @@ ffi/unsafe ffi/unsafe/alloc ffi/unsafe/define + ffi/unsafe/nsalloc "../common/utils.rkt" "../../lock.rkt") @@ -17,13 +18,14 @@ as-objc-allocation-with-retain clean-up-deleted retain release - with-autorelease clean-menu-label ->wxb ->wx old-cocoa? version-10.6-or-later? version-10.7-or-later?) + with-autorelease + call-with-autorelease define-mz) (define cocoa-lib (ffi-lib (format "/System/Library/Frameworks/Cocoa.framework/Cocoa"))) @@ -59,18 +61,6 @@ (lambda (obj) (tellv obj retain)))) -(import-class NSAutoreleasePool) - -;; Use `with-autorelease' and `call-with-autorelease' -;; in atomic mode -(define-syntax-rule (with-autorelease expr ...) - (call-with-autorelease (lambda () expr ...))) -(define (call-with-autorelease thunk) - (let ([pool (tell (tell NSAutoreleasePool alloc) init)]) - (begin0 - (thunk) - (tellv pool release)))) - (define (clean-menu-label str) (regexp-replace* #rx"&(.)" str "\\1")) diff --git a/collects/scribblings/foreign/derived.scrbl b/collects/scribblings/foreign/derived.scrbl index cb9a6e5ee1..c7117c9f23 100644 --- a/collects/scribblings/foreign/derived.scrbl +++ b/collects/scribblings/foreign/derived.scrbl @@ -14,6 +14,7 @@ @include-section["atomic.scrbl"] @include-section["try-atomic.scrbl"] @include-section["objc.scrbl"] +@include-section["ns.scrbl"] @include-section["com.scrbl"] @include-section["file.scrbl"] @include-section["winapi.scrbl"] diff --git a/collects/scribblings/foreign/ns.scrbl b/collects/scribblings/foreign/ns.scrbl new file mode 100644 index 0000000000..dd22af239a --- /dev/null +++ b/collects/scribblings/foreign/ns.scrbl @@ -0,0 +1,53 @@ +#lang scribble/doc +@(require scribble/manual + (for-label racket/base + ffi/unsafe/nsalloc + ffi/unsafe/nsstring)) + +@title[#:tag "ns"]{Cocoa Foundation} + +The @racketmodname[ffi/unsafe/nsalloc] and +@racketmodname[ffi/unsafe/nsstring] libraries provide basic +facilities for working with Cocoa and/or Mac OS X Foundation +libraries (usually along with @racket[ffi/objc]). + +@; ---------------------------------------- + +@section{Strings} + +@defmodule[ffi/unsafe/nsstring] + +@defthing[_NSString ctype?]{ + +A type that converts between Racket strings and +@as-index{@tt{NSString}} (a.k.a. @as-index{@tt{CFString}}) +values. That is, use @tt{_NSString} as a type for a foreign-function +@tt{NSString} argument or result. + +The @racket[_NSString] conversion keeps a weak mapping from Racket +strings to converted strings, so that converting the same string (in +the @racket[equal?] sense) multiple times may avoid allocating +multiple @tt{NSString} objects.} + + +@; ---------------------------------------- + +@section{Allocation Pools} + +@defmodule[ffi/unsafe/nsalloc]{Calling any Foundation API that +allocates requires an @tt{NSAutoreleasePool} installed. The +@racketmodname[ffi/unsafe/nsalloc] library provides a function and +shorthand syntactic form for setting up such a context. (The +@racket[_NSString] type creates an autorelease pool implicitly while +converting from/to a Racket string, however.)} + +@defproc[(call-with-autorelease [thunk (-> any)]) any]{ + +Calls @racket[thunk] in atomic mode and with a fresh +@tt{NSAutoreleasePool} that is @tt{releas}ed after @racket[thunk] +returns.} + + +@defform[(with-autorelease expr)]{ + +A shorthand for @racket[(call-with-autorelease (lambda () expr))].}