early-return construct added
This commit is contained in:
@@ -3,11 +3,11 @@
|
||||
(define pkg-authors '(hnmdijkema))
|
||||
(define version "1.0.1")
|
||||
(define license '(Apache-2.0 OR MIT))
|
||||
(define collection "define-return")
|
||||
(define pkg-desc "define/return and define/contract/return provide function definitions that can be used for defensive programming. Making functions return early when conditions are not met.")
|
||||
(define collection "early-return")
|
||||
(define pkg-desc "early-return, define/return and define/contract/return provide function definitions that can be used for defensive programming. Making functions return early when conditions are not met.")
|
||||
|
||||
(define scribblings
|
||||
'(
|
||||
'(("scrbl/early-return.scrbl" () (library))
|
||||
("scrbl/define-return.scrbl" () (library))
|
||||
("scrbl/define-return-contract.scrbl" () (library))
|
||||
)
|
||||
|
||||
@@ -1,13 +1,70 @@
|
||||
#lang racket/base
|
||||
|
||||
(provide define/return
|
||||
;return
|
||||
(provide early-return
|
||||
define/return
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; define/return
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(define-syntax early-return*
|
||||
(syntax-rules (-> ? ~ do)
|
||||
((_ () (b1 ...))
|
||||
(let () b1 ...))
|
||||
((_ ((do d1 ...)) (b1 ...))
|
||||
(let () d1 ...
|
||||
(let () b1 ...)))
|
||||
((_ ((do d1 ...) c1 ...) (b1 ...))
|
||||
(let () d1 ...
|
||||
(early-return* (c1 ...) (b1 ...))))
|
||||
((_ ((v expr ? pred? -> retval ~ cleanup)) (b1 ...))
|
||||
(let ((v expr))
|
||||
(cond (pred? cleanup retval)
|
||||
(else (let () b1 ...)))))
|
||||
((_ ((v expr ? pred? -> retval ~ cleanup) c1 ...) (b1 ...))
|
||||
(let ((v expr))
|
||||
(cond (pred? cleanup retval)
|
||||
(else (early-return* (c1 ...) (b1 ...))))))
|
||||
((_ ((v expr ? pred? -> retval)) (b1 ...))
|
||||
(let ((v expr))
|
||||
(cond (pred? retval)
|
||||
(else (let () b1 ...)))))
|
||||
((_ ((v expr ? pred? -> retval) c1 ...) (b1 ...))
|
||||
(let ((v expr))
|
||||
(cond (pred? retval)
|
||||
(else (early-return* (c1 ...) (b1 ...))))))
|
||||
((_ ((? pred? -> retval)) (b1 ...))
|
||||
(cond (pred? retval)
|
||||
(else (let () b1 ...))))
|
||||
((_ ((? pred? -> retval) c1 ...) (b1 ...))
|
||||
(cond (pred? retval)
|
||||
(else (early-return* (c1 ...) (b1 ...)))))
|
||||
((_ ((? pred? -> retval ~ cleanup)) (b1 ...))
|
||||
(cond (pred? cleanup retval)
|
||||
(else (let () b1 ...))))
|
||||
((_ ((? pred? -> retval ~ cleanup) c1 ...) (b1 ...))
|
||||
(cond (pred? cleanup retval)
|
||||
(else (early-return* (c1 ...) (b1 ...)))))
|
||||
((_ ((v expr)) (b1 ...))
|
||||
(let ((v expr))
|
||||
b1 ...))
|
||||
((_ ((v expr) c1 ...) (b1 ...))
|
||||
(let ((v expr))
|
||||
(early-return* (c1 ...) (b1 ...))))
|
||||
)
|
||||
)
|
||||
|
||||
(define-syntax early-return
|
||||
(syntax-rules ()
|
||||
((_ (er1 ...) b1 ...)
|
||||
(early-return* (er1 ...) (b1 ...))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(define-syntax define/return
|
||||
(syntax-rules ()
|
||||
((_ def return
|
||||
@@ -21,75 +78,3 @@
|
||||
)
|
||||
)
|
||||
|
||||
#|
|
||||
|
||||
|
||||
(struct exn:return exn (value) #:transparent)
|
||||
|
||||
(define-syntax raise-return
|
||||
(syntax-rules ()
|
||||
((_ v)
|
||||
(raise (exn:return "return" (current-continuation-marks) v)))))
|
||||
|
||||
(define (return-value r)
|
||||
(exn:return-value r))
|
||||
|
||||
(define-syntax return
|
||||
(syntax-rules ()
|
||||
((_ val)
|
||||
(raise-return val))))
|
||||
|
||||
(define-syntax define/return
|
||||
(syntax-rules ()
|
||||
((_ def b1 ...)
|
||||
(define def
|
||||
(with-handlers ([exn:return? return-value])
|
||||
b1
|
||||
...
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
(define-syntax def-returner
|
||||
(syntax-rules ()
|
||||
((_ pred name)
|
||||
(define/contract (name x)
|
||||
(-> any/c pred)
|
||||
(return-value x))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define-syntax call-returner
|
||||
(syntax-rules ()
|
||||
((_ x name)
|
||||
(name x))))
|
||||
|
||||
(define-syntax define/contract/return
|
||||
(syntax-rules ()
|
||||
((_ (name . formals) (c ... last-pred) b1 ...)
|
||||
(define/contract (name . formals)
|
||||
(c ... last-pred)
|
||||
|
||||
(let ((ret (λ (x)
|
||||
(def-returner last-pred name)
|
||||
(call-returner x name))))
|
||||
(with-handlers ([exn:return? ret])
|
||||
b1
|
||||
...)))
|
||||
)
|
||||
((_ name last-pred value)
|
||||
(define/contract name
|
||||
last-pred
|
||||
(let ((ret (λ (x)
|
||||
(def-returner last-pred name)
|
||||
(call-returner x name))))
|
||||
(with-handlers ([exn:return? ret])
|
||||
value)))
|
||||
)
|
||||
)
|
||||
)
|
||||
|#
|
||||
@@ -0,0 +1,278 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
"../main.rkt"))
|
||||
|
||||
@title{Early Return}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[early-return]
|
||||
|
||||
This module provides two small control-flow forms. The
|
||||
@racket[early-return] form is a local, structured early-exit form that
|
||||
expands to ordinary @racket[let] and @racket[cond] expressions. It is
|
||||
intended for guard-style code, especially around FFI bindings where null
|
||||
pointers, negative return values, failed allocations, or other explicit
|
||||
status values must be checked immediately.
|
||||
|
||||
The module also provides @racket[define/return], which gives a function a
|
||||
named return procedure by using @racket[call/cc]. That form is more general,
|
||||
but also a heavier control-flow mechanism. Prefer @racket[early-return]
|
||||
when the desired exit is local to one expression sequence.
|
||||
|
||||
@section{Guarded sequential evaluation}
|
||||
|
||||
@defform*[
|
||||
[(early-return
|
||||
(clause ...)
|
||||
body ...)]
|
||||
]{
|
||||
|
||||
Evaluates a sequence of @racket[clause]s from left to right. If no guard
|
||||
clause returns early, the @racket[body] expressions are evaluated and the
|
||||
value of the last body expression is returned.
|
||||
|
||||
The form behaves like a guarded @racket[let*]. Bindings introduced by an
|
||||
earlier clause are visible in later clauses and in the final body. The body
|
||||
is placed in a @racket[let] context, so internal definitions may be used.
|
||||
|
||||
The following clause forms are recognized:
|
||||
|
||||
@racketblock[
|
||||
(id expr)
|
||||
(id expr ? test-expr -> result-expr)
|
||||
(id expr ? test-expr -> result-expr ~ cleanup-expr)
|
||||
(? test-expr -> result-expr)
|
||||
(? test-expr -> result-expr ~ cleanup-expr)
|
||||
(do expr ...)
|
||||
]
|
||||
|
||||
A plain clause
|
||||
|
||||
@racketblock[
|
||||
(id expr)
|
||||
]
|
||||
|
||||
binds @racket[id] to the result of @racket[expr] and continues with the next
|
||||
clause.
|
||||
|
||||
A guarded binding clause
|
||||
|
||||
@racketblock[
|
||||
(id expr ? test-expr -> result-expr)
|
||||
]
|
||||
|
||||
first binds @racket[id] to @racket[expr]. The @racket[test-expr] is then
|
||||
evaluated in a scope where @racket[id] is available. If the test is true,
|
||||
@racket[result-expr] becomes the result of the whole @racket[early-return]
|
||||
form. Otherwise evaluation continues with the next clause.
|
||||
|
||||
A guarded binding clause with cleanup
|
||||
|
||||
@racketblock[
|
||||
(id expr ? test-expr -> result-expr ~ cleanup-expr)
|
||||
]
|
||||
|
||||
works the same way, except that @racket[cleanup-expr] is evaluated before
|
||||
@racket[result-expr] when the test is true. The value of
|
||||
@racket[cleanup-expr] is ignored.
|
||||
|
||||
A guard clause without a binding
|
||||
|
||||
@racketblock[
|
||||
(? test-expr -> result-expr)
|
||||
]
|
||||
|
||||
checks @racket[test-expr] immediately. If the test is true,
|
||||
@racket[result-expr] becomes the result of the whole form.
|
||||
|
||||
The cleanup variant
|
||||
|
||||
@racketblock[
|
||||
(? test-expr -> result-expr ~ cleanup-expr)
|
||||
]
|
||||
|
||||
evaluates @racket[cleanup-expr] before returning @racket[result-expr].
|
||||
|
||||
Finally,
|
||||
|
||||
@racketblock[
|
||||
(do expr ...)
|
||||
]
|
||||
|
||||
evaluates one or more expressions for their side effects and then continues
|
||||
with the next clause. This is useful for operations that must happen between
|
||||
guarded bindings, such as setting a pointer, updating state, or logging a
|
||||
value.
|
||||
|
||||
The identifiers @racket[?], @racket[->], @racket[~], and @racket[do] are
|
||||
literal keywords of the form.
|
||||
}
|
||||
|
||||
@section{Examples}
|
||||
|
||||
A simple validation function can be written as a sequence of guards followed
|
||||
by the actual computation:
|
||||
|
||||
@codeblock{
|
||||
(define (square-small-number x)
|
||||
(early-return
|
||||
((? (not (number? x)) -> 'not-a-number)
|
||||
(? (< x 0) -> 'negative)
|
||||
(v (* x x) ? (> v 100) -> 'too-big))
|
||||
v))
|
||||
|
||||
(square-small-number "x") ; => 'not-a-number
|
||||
(square-small-number -1) ; => 'negative
|
||||
(square-small-number 5) ; => 25
|
||||
(square-small-number 20) ; => 'too-big
|
||||
}
|
||||
|
||||
Bindings are sequential. A later clause can use values introduced by earlier
|
||||
clauses:
|
||||
|
||||
@racketblock[
|
||||
(define (h x)
|
||||
(early-return
|
||||
((? (not (number? x)) -> 'not-a-number)
|
||||
(z (+ x x))
|
||||
(do (displayln (format "z = ~a" z)))
|
||||
(v (* x x) ? (> v 100) -> 'too-big)
|
||||
(do (displayln (format "v = ~a" v)))
|
||||
(g (+ v 10) ? (< g 25) -> 'too-small)
|
||||
(do (displayln (format "g = ~a" g))))
|
||||
(+ g v 100 z)))
|
||||
]
|
||||
|
||||
The form is especially useful around FFI code. In the following example,
|
||||
two native blocks are allocated. If the second allocation fails, the first
|
||||
block is freed. Later failure paths use a local cleanup procedure.
|
||||
|
||||
@racketblock[
|
||||
(define (copy-native-block src nbytes)
|
||||
(early-return
|
||||
((tmp (malloc nbytes 'raw) ? (eq? tmp #f) -> #f)
|
||||
(out (malloc _pointer 1 'raw) ? (eq? out #f) -> #f ~ (free tmp))
|
||||
|
||||
(cleanup! (λ ()
|
||||
(unless (eq? out #f) (free out))
|
||||
(unless (eq? tmp #f) (free tmp))))
|
||||
|
||||
(do (ptr-set! out _pointer 0 tmp))
|
||||
(copied? (copy-from-native! tmp src nbytes)
|
||||
? (not copied?) -> #f
|
||||
~ (cleanup!))
|
||||
|
||||
(result (make-result tmp nbytes)
|
||||
? (not result) -> #f
|
||||
~ (cleanup!))
|
||||
)
|
||||
|
||||
(cleanup!)
|
||||
result))
|
||||
]
|
||||
|
||||
The cleanup expressions belong to the guard where they are written. They do
|
||||
not create an exception-safe resource scope. If an expression raises a
|
||||
Racket exception, the cleanup expressions in later guards are not evaluated.
|
||||
For exception-safe cleanup, use Racket's exception and dynamic-wind
|
||||
facilities. @racket[early-return] is designed for explicit status-code
|
||||
control flow, not for exception handling.
|
||||
|
||||
@section{A resampler drain example}
|
||||
|
||||
The following example shows the intended style for FFI-style code that must
|
||||
check return values and clean up native memory explicitly.
|
||||
|
||||
@racketblock[
|
||||
(define (drain-resampler! self)
|
||||
(let* ((dec (fmpg-instance-decoder self))
|
||||
(info (fmpg-instance-audio-info self))
|
||||
(channels (ais-channels info))
|
||||
(sample-rate (ais-rate info))
|
||||
(continue (gensym 'continue)))
|
||||
|
||||
(define (drain-once! delay max-bytes produced)
|
||||
(early-return
|
||||
((tmp (malloc max-bytes 'raw) ? (eq? tmp #f) -> -1)
|
||||
(out-planes (malloc _pointer 1 'raw)
|
||||
? (eq? out-planes #f) -> -1
|
||||
~ (free tmp))
|
||||
|
||||
(cleanup! (λ ()
|
||||
(unless (eq? out-planes #f) (free out-planes))
|
||||
(unless (eq? tmp #f) (free tmp))))
|
||||
|
||||
(do (ptr-set! out-planes _pointer 0 tmp))
|
||||
|
||||
(out-samples (swr_convert (ds-swr-ctx dec) out-planes delay #f 0)
|
||||
? (<= out-samples 0) -> produced
|
||||
~ (cleanup!))
|
||||
|
||||
(used-bytes (av_samples_get_buffer_size #f channels out-samples
|
||||
FMPG_OUTPUT_FMT 1)
|
||||
? (< used-bytes 0) -> produced
|
||||
~ (cleanup!))
|
||||
|
||||
(do
|
||||
(when (pcm-empty? dec)
|
||||
(ds-start-sample! dec (ds-next-sample-pos dec))
|
||||
(ds-timecode! dec
|
||||
(/ (exact->inexact (ds-start-sample dec))
|
||||
(exact->inexact sample-rate)))))
|
||||
|
||||
(appended? (append-bytes! dec tmp used-bytes)
|
||||
? (not appended?) -> -1
|
||||
~ (cleanup!))
|
||||
|
||||
(do
|
||||
(ds-last-samples! dec (+ (ds-last-samples dec) out-samples))
|
||||
(ds-next-sample-pos! dec (+ (ds-next-sample-pos dec)
|
||||
out-samples))
|
||||
(cleanup!)))
|
||||
|
||||
continue))
|
||||
|
||||
(let loop ((produced 0))
|
||||
(early-return
|
||||
((delay (swr_get_delay (ds-swr-ctx dec) sample-rate)
|
||||
? (<= delay 0) -> produced)
|
||||
|
||||
(max-bytes (av_samples_get_buffer_size #f channels delay
|
||||
FMPG_OUTPUT_FMT 1)
|
||||
? (<= max-bytes 0) -> produced)
|
||||
|
||||
(r (drain-once! delay max-bytes produced)
|
||||
? (not (eq? r continue)) -> r))
|
||||
|
||||
(loop 1)))))
|
||||
]
|
||||
|
||||
This keeps the ordinary success path at the bottom of the form and puts each
|
||||
failure path next to the operation that can fail. The generated code is just
|
||||
nested @racket[let] and @racket[cond] code; no continuation is captured.
|
||||
|
||||
@section{Named return}
|
||||
|
||||
@defform[
|
||||
(define/return (id arg ...) return-id
|
||||
body ...)
|
||||
]{
|
||||
|
||||
Defines a function like @racket[define], but binds @racket[return-id] inside
|
||||
the function body to an escape procedure. Calling @racket[return-id] exits
|
||||
the function immediately with the supplied value.
|
||||
|
||||
@racketblock[
|
||||
(define/return (classify x) return
|
||||
(when (not (number? x)) (return 'not-a-number))
|
||||
(when (< x 0) (return 'negative))
|
||||
(when (> x 100) (return 'too-large))
|
||||
'ok)
|
||||
]
|
||||
|
||||
This form is implemented with @racket[call/cc]. It is useful when a real
|
||||
non-local escape procedure is wanted, but it is more general than necessary
|
||||
for simple sequential guard code. For ordinary local checks, prefer
|
||||
@racket[early-return].
|
||||
}
|
||||
Reference in New Issue
Block a user