suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add #:retry option to _fun

Browse Source
This commit is contained in:
Matthew Flatt 2015-03-27 12:26:08 -06:00
parent 7408ee4709
commit d22082f7e5
3 changed files with 148 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
pkgs/racket-doc/scribblings/foreign/types.scrbl
View File

@ -702,11 +702,10 @@ For @tech{callbacks} to Racket functions with the generated type:
(code:line #:keep keep-expr)
(code:line #:atomic? atomic?-expr)
(code:line #:async-apply async-apply-expr)
(code:line #:in-original-place? in-original-place?-expr)]
(code:line #:in-original-place? in-original-place?-expr)
(code:line #:retry (retry-id [arg-id init-expr]))]
[maybe-args code:blank
(code:line (id ...) ::)
(code:line id ::)
(code:line (id ... . id) ::)]
(code:line formals ::)]
[type-spec type-expr
(id : type-expr)
(type-expr = value-expr)
@ -723,42 +722,106 @@ straightforward function type.
For example,
@racketblock[
(_fun _int _string ->> _int)
(_fun _string _int ->> _int)
]
specifies a function that receives an integer and a
string, and returns an integer.
specifies a function that receives a string and an integer
and returns an integer.
See @racket[_cprocedure] for information about the @racket[#:abi],
@racket[#:save-errno], @racket[#:keep], @racket[#:atomic?],
@racket[#:async-apply], and @racket[#:in-original-place?] options.
In its full form, the @racket[_fun] syntax provides an IDL-like
language that can be used to create a wrapper function around the
primitive foreign function. These wrappers can implement complex
foreign interfaces given simple specifications. The full form of each
of the type specifications can include an optional label and an
expression. If a @racket[= value-expr] is provided, then the resulting
function will be a wrapper that calculates the argument for that
position itself, meaning that it does not expect an argument for that
position. The expression can use previous arguments if they were
labeled with @racket[id :]. In addition, the result of a function
call need not be the value returned from the foreign call: if the
optional @racket[output-expr] is specified, or if an expression is
provided for the output type, then this specifies an expression that
will be used as a return value. This expression can use any of the
previous labels, including a label given for the output which can be
used to access the actual foreign return value.
language that creates a wrapper function around the
primitive foreign function when the type is used for a @tech{callout}.
These wrappers can implement complex interfaces given simple
specifications:
@;
@itemlist[
In rare cases where complete control over the input arguments is needed, the
wrapper's argument list can be specified as @racket[maybe-args], in any form
(including a ``rest'' argument). Identifiers in this place are related to type
labels, so if an argument is there is no need to use an expression.
@item{The full form of each argument @racket[type-spec] can include
an optional label and an expression. A label @racket[id :]
makes the argument value accessible to later expressions using
@racket[id]. A @racket[= value-expr] expression causes the
wrapper function to calculates the argument for that position
using @racket[value-expr], implying that the wrapper does not
expect to be given an argument for that position.
For example,
For example,
@racketblock[
(_fun (s : _string) (_int = (string-length s)) ->> _int)
]
produces a wrapper that takes a single string argument and
calls a foreign function that takes a string and an integer;
the string's length is provided as the integer argument.}
@item{If the optional @racket[output-expr] is specified, or if an
expression is provided for the output type, then the expression
specifies an expression that will be used as a return value for
the function call, replacing the foreign function's result. The
@racket[output-expr] can use any of the previous labels,
including a label given for the output to access the foreign
function's return value.
For example,
@racketblock[
(_fun _string (len : _int) ->> (r : _int) ->> (min r len))
]
produces a wrapper that returns the minimum of the foreign
function's result and the given integer argument.}
@item{A @racket[#:retry (retry-id [arg-id init-expr] ...)]
specification binds @racket[retry-id] for use in an
@racket[output-expr] for retrying the foreign call (normally in
tail position). The function bound to @racket[retry-id] accepts
each @racket[arg-id] as an argument, each @racket[arg-id] can
be used in @racket[= value-expr]s, and each @racket[init-expr]s
provides the initial value for the corresponding
@racket[arg-id].
For example,
@racketblock[
(_fun #:retry (again [count 0])
_string _int ->> (r : _int)
->> (if (and (= r ERR_BUSY)
(< count 5))
(retry (add1 count))
r))
]
produces a wrapper that calls the foreign function up to five
times if it continues to produce a number equal to
@racket[ERR_BUSY].}
@item{In rare cases where complete control over the input arguments
is needed, the wrapper's argument list can be specified as
@racket[maybe-args] with a @racket[formals] as for
@racket[lambda] (including keyword arguments and/or a ``rest''
argument). When an argument @racket[type-spec] includes a label
that matches an binding identifier in @racket[formals], then
the identifier is used as the default value for the argument.
All argument @racket[type-spec]s must include either explicit
@racket[= value-expr] annotations or an implicit one through a
matching label.
For example,
@racketblock[
(_fun (n s) :: (s : _string) (n : _int) ->> _int)
]
produces a wrapper that receives an integer and a string, but
the foreign function receives the string first.}
@racketblock[
(_fun (n s) :: (s : _string) (n : _int) ->> _int)
]
specifies a function that receives an integer and a string, but the
foreign function receives the string first.}
@history[#:changed "6.2.0.2" @elem{Added the @racket[#:retry] option.}]}
@defproc[(function-ptr [ptr-or-proc (or cpointer? procedure?)]
[fun-type ctype?])

16
pkgs/racket-test-core/tests/racket/foreign-test.rktl
View File

@ -395,6 +395,22 @@
(test 10 ic7i-i1 (union-ref u2 0))
(test 89 ic7i-i2 (union-ref u2 0))
(test (map add1 v) ic7i-c7 (union-ref u2 0)))))
;; ---
;; test retries
(t 78 'add1_int_int
(_fun #:retry (again [count 0]) _int -> (v : _int) ->
(if (= count 0)
(again 76)
(+ count v)))
1)
(t 95 'add1_int_int
(_fun #:retry (again [count 0])
(a) :: (a : _int = (+ a count)) -> (v : _int) ->
(if (= count 0)
(again 92)
v))
2)
)
;; test setting vector elements

28
racket/collects/ffi/unsafe.rkt
View File

@ -495,7 +495,8 @@
(provide _fun)
(define-for-syntax _fun-keywords
`([#:abi ,#'#f] [#:keep ,#'#t] [#:atomic? ,#'#f] [#:in-original-place? ,#'#f]
[#:async-apply ,#'#f] [#:save-errno ,#'#f]))
[#:async-apply ,#'#f] [#:save-errno ,#'#f]
[#:retry #f]))
(define-syntax (_fun stx)
(define (err msg . sub) (apply raise-syntax-error '_fun msg stx sub))
(define xs #f)
@ -676,10 +677,31 @@
inputs)]
[ffi-args
(filter-map (lambda (x) (and (car x) (cadr x))) inputs)]
[retry-spec
(let ([r (kwd-ref '#:retry)])
(when r
(syntax-case r ()
[(retry-id [arg-id arg-val] ...)
(and (identifier? #'retry-id)
(andmap identifier? (syntax->list #'(arg-id ...))))
(let ([dup (check-duplicate-identifier (syntax->list #'(arg-id ...)))])
(when dup
(err "duplicate identifier in retry specification" dup))
r)]
[_
(err "ill-formed retry specification" r)]))
r)]
[add-retry
(lambda (body)
(if retry-spec
#`(let #,(car (syntax-e retry-spec)) #,(cdr (syntax-e retry-spec))
#,body)
body))]
;; the actual wrapper body
[body (quasisyntax/loc stx
(lambda #,input-names
(let* (#,@args
#,(add-retry
#`(let* (#,@args
#,@bind
#,@pre)
#,(if (or output-expr
@ -691,7 +713,7 @@
#,(or output-expr res)))
#`(begin0
(ffi #,@ffi-args)
(let* (#,@post) (void)))))))]
(let* (#,@post) (void))))))))]
;; if there is a string 'ffi-name property, use it as a name
[body (let ([n (cond [(syntax-property stx 'ffi-name)
=> syntax->datum]