Initial import
This commit is contained in:
@@ -15,3 +15,4 @@ compiled/
|
||||
# Dependency tracking files
|
||||
*.dep
|
||||
|
||||
/*.bak
|
||||
|
||||
@@ -0,0 +1,27 @@
|
||||
#lang info
|
||||
|
||||
(define pkg-authors '(hnmdijkema))
|
||||
(define version "1.0.1")
|
||||
(define license '(Apache-2.0 OR MIT))
|
||||
(define collection "let-assert")
|
||||
(define pkg-desc "A let construct with assertions, i.e. when an assertion is not satisfied, one can prematurely exit a function with a given return value.")
|
||||
|
||||
(define scribblings
|
||||
'(
|
||||
("scrbl/let-assert.scrbl" () (library))
|
||||
)
|
||||
)
|
||||
|
||||
(define deps
|
||||
'("racket/base")
|
||||
)
|
||||
|
||||
(define build-deps
|
||||
'("racket-doc"
|
||||
"draw-doc"
|
||||
"rackunit-lib"
|
||||
"scribble-lib"
|
||||
))
|
||||
|
||||
(define test-omit-paths 'all)
|
||||
|
||||
@@ -0,0 +1,87 @@
|
||||
#lang racket/base
|
||||
|
||||
(provide let/assert
|
||||
make-assert
|
||||
a-eq? a-!eq?
|
||||
a->? a-<=?
|
||||
a->=? a-<?
|
||||
a-=? a-!=?
|
||||
a-<0? a->=0?
|
||||
a-<=0? a->0?
|
||||
a-=0? a-!=0?
|
||||
a-true? a-false?
|
||||
a-nullptr? a-!nullptr?
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; let/assert
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(define-syntax make-assert
|
||||
(syntax-rules ()
|
||||
((_ name not-name pred)
|
||||
(begin
|
||||
(define-syntax name
|
||||
(syntax-rules ()
|
||||
((_ const)
|
||||
(λ (x) (pred x const)))))
|
||||
(define-syntax not-name
|
||||
(syntax-rules ()
|
||||
((_ const)
|
||||
(λ (x) (not (pred x const))))))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(make-assert a-eq? a-!eq? eq?)
|
||||
|
||||
(define a-nullptr? (a-eq? #f))
|
||||
(define a-!nullptr? (a-!eq? #f))
|
||||
|
||||
(make-assert a->? a-<=? >)
|
||||
(make-assert a->=? a-<? >=)
|
||||
(make-assert a-=? a-!=? =)
|
||||
|
||||
(define (a-=0? x) (= x 0))
|
||||
(define (a-!=0? x) (not (= x 0)))
|
||||
(define (a->0? x) (> x 0))
|
||||
(define (a->=0? x) (>= x 0))
|
||||
(define (a-<0? x) (< x 0))
|
||||
(define (a-<=0? x) (<= x 0))
|
||||
|
||||
|
||||
(define a-true? (a-eq? #t))
|
||||
(define a-false? (a-eq? #f))
|
||||
|
||||
(struct exn:let/assert exn (value) #:transparent)
|
||||
|
||||
(define (raise-let/assert v)
|
||||
(raise (exn:let/assert "let/assert" (current-continuation-marks) v)))
|
||||
|
||||
(define (let/assert-value r)
|
||||
(exn:let/assert-value r))
|
||||
|
||||
(define-syntax assert-expr
|
||||
(syntax-rules ()
|
||||
((_ expr cond retval)
|
||||
(let ((a expr)) (if (cond a) a (raise-let/assert retval))))
|
||||
((_ expr)
|
||||
expr)
|
||||
)
|
||||
)
|
||||
|
||||
(define-syntax let/assert
|
||||
(syntax-rules ()
|
||||
((_ ((v rest ...) ...) b1 ...)
|
||||
(with-handlers ([exn:let/assert? let/assert-value])
|
||||
(let* ((v (assert-expr rest ...))
|
||||
...)
|
||||
b1
|
||||
...
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -0,0 +1,5 @@
|
||||
*.bak
|
||||
*.scrbl~
|
||||
*.js
|
||||
*.css
|
||||
*.html
|
||||
@@ -0,0 +1,198 @@
|
||||
#lang scribble/manual
|
||||
|
||||
@(require (for-label racket/base
|
||||
"../main.rkt"))
|
||||
|
||||
@title{let-assert}
|
||||
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||
|
||||
@defmodule[let-assert]
|
||||
|
||||
This module provides @racket[let/assert], a small sequential binding form
|
||||
with local assertions. It is useful for defensive programming around FFI
|
||||
bindings: checks for null pointers, exit codes, and similar failure values can
|
||||
be kept close to the binding that produced them, while the body stays on the
|
||||
happy path. When an assertion fails, the whole @racket[let/assert] expression
|
||||
returns the associated fallback value.
|
||||
|
||||
@section{Binding with assertions}
|
||||
|
||||
@defform[
|
||||
(let/assert (binding ...) body ...+)
|
||||
#:grammar
|
||||
([binding [id expr]
|
||||
[id expr predicate-expr fallback-expr]])]{
|
||||
|
||||
The form expands to an internal @racket[let*] structure. Bindings are
|
||||
therefore evaluated from left to right, and later bindings may refer to
|
||||
earlier ones.
|
||||
|
||||
A binding of the form @racket[[id expr]] simply binds @racket[id] to
|
||||
@racket[expr].
|
||||
|
||||
A binding of the form
|
||||
@racket[[id expr predicate-expr fallback-expr]] evaluates @racket[expr] once,
|
||||
applies @racket[predicate-expr] to the result, and binds @racket[id] to that
|
||||
result when the predicate accepts it. If the predicate returns @racket[#f],
|
||||
the body is not evaluated and the whole @racket[let/assert] form returns
|
||||
@racket[fallback-expr].
|
||||
|
||||
The fallback expression is evaluated only when the assertion fails. Internally,
|
||||
the failing assertion raises a private exception carrying that value; the
|
||||
exception is caught by @racket[let/assert] itself.
|
||||
}
|
||||
|
||||
@racketblock[
|
||||
(let/assert ([x 10 (a->? 0) 'too-small]
|
||||
[y (+ x 2) (a-=? 12) 'wrong-value])
|
||||
y)
|
||||
]
|
||||
|
||||
The example returns @racket[12]. The second binding can use @racket[x],
|
||||
because @racket[let/assert] has @racket[let*] scoping.
|
||||
|
||||
@section{FFI-style examples}
|
||||
|
||||
FFI libraries often report errors by returning a null pointer or a negative
|
||||
integer status code. With @racket[let/assert], those checks can be written
|
||||
next to the operation that may fail.
|
||||
|
||||
@racketblock[
|
||||
(define (open-ffmpeg-instance)
|
||||
(let/assert ([fh (fmpg-init) a-!nullptr? #f])
|
||||
fh))
|
||||
]
|
||||
|
||||
Here @racket[fmpg-init] is expected to return either a valid native handle or
|
||||
@racket[#f]. If the handle is @racket[#f], the complete
|
||||
@racket[let/assert] form returns @racket[#f]. Otherwise the valid handle is
|
||||
returned.
|
||||
|
||||
A slightly larger example can combine a pointer check with an FFmpeg-style
|
||||
return-code check:
|
||||
|
||||
@racketblock[
|
||||
(define (decode-next! ds)
|
||||
(let/assert ([pkt (av-packet-alloc) a-!nullptr? 'packet-allocation-failed]
|
||||
[ret (read-selected-audio-packet! ds pkt)
|
||||
(a->=? 0)
|
||||
'read-packet-failed]
|
||||
[pcm (receive-available-frames! ds)
|
||||
bytes?
|
||||
'decode-failed])
|
||||
pcm))
|
||||
]
|
||||
|
||||
The body contains only the successful path. If packet allocation fails, the
|
||||
result is @racket['packet-allocation-failed]. If reading the packet returns a
|
||||
negative status code, the result is @racket['read-packet-failed]. If decoding
|
||||
does not produce bytes, the result is @racket['decode-failed].
|
||||
|
||||
@section{Creating assertion factories}
|
||||
|
||||
@defform[(make-assert name not-name pred)]{
|
||||
|
||||
Defines two assertion factories in a definition context.
|
||||
|
||||
The form @racket[(name constant)] expands to a unary predicate that applies
|
||||
@racket[pred] to the value being checked and @racket[constant]. The form
|
||||
@racket[(not-name constant)] expands to the negated variant.
|
||||
|
||||
For example:
|
||||
|
||||
@racketblock[
|
||||
(make-assert a-eq? a-!eq? eq?)
|
||||
]
|
||||
|
||||
defines @racket[a-eq?] and @racket[a-!eq?]. Consequently,
|
||||
@racket[(a-eq? #f)] produces a predicate that accepts values that are
|
||||
@racket[eq?] to @racket[#f], while @racket[(a-!eq? #f)] accepts values that
|
||||
are not @racket[eq?] to @racket[#f].
|
||||
}
|
||||
|
||||
@section{Assertion factories}
|
||||
|
||||
@defform[(a-eq? constant)]{
|
||||
Produces a unary predicate that accepts values for which
|
||||
@racket[(eq? value constant)] is true.
|
||||
}
|
||||
|
||||
@defform[(a-!eq? constant)]{
|
||||
Produces a unary predicate that accepts values for which
|
||||
@racket[(eq? value constant)] is false.
|
||||
}
|
||||
|
||||
@defform[(a->? constant)]{
|
||||
Produces a unary predicate that accepts values greater than
|
||||
@racket[constant].
|
||||
}
|
||||
|
||||
@defform[(a-<=? constant)]{
|
||||
Produces a unary predicate that rejects values greater than
|
||||
@racket[constant].
|
||||
}
|
||||
|
||||
@defform[(a->=? constant)]{
|
||||
Produces a unary predicate that accepts values greater than or equal to
|
||||
@racket[constant].
|
||||
}
|
||||
|
||||
@defform[(a-<? constant)]{
|
||||
Produces a unary predicate that rejects values greater than or equal to
|
||||
@racket[constant].
|
||||
}
|
||||
|
||||
@defform[(a-=? constant)]{
|
||||
Produces a unary predicate that accepts values numerically equal to
|
||||
@racket[constant].
|
||||
}
|
||||
|
||||
@defform[(a-!=? constant)]{
|
||||
Produces a unary predicate that accepts values not numerically equal to
|
||||
@racket[constant].
|
||||
}
|
||||
|
||||
@section{Ready-made predicates}
|
||||
|
||||
@defproc[(a-=0? [x number?]) boolean?]{
|
||||
Returns @racket[#t] when @racket[x] is numerically equal to zero.
|
||||
}
|
||||
|
||||
@defproc[(a-!=0? [x number?]) boolean?]{
|
||||
Returns @racket[#t] when @racket[x] is not numerically equal to zero.
|
||||
}
|
||||
|
||||
@defproc[(a->0? [x real?]) boolean?]{
|
||||
Returns @racket[#t] when @racket[x] is greater than zero.
|
||||
}
|
||||
|
||||
@defproc[(a->=0? [x real?]) boolean?]{
|
||||
Returns @racket[#t] when @racket[x] is greater than or equal to zero.
|
||||
}
|
||||
|
||||
@defproc[(a-<0? [x real?]) boolean?]{
|
||||
Returns @racket[#t] when @racket[x] is less than zero.
|
||||
}
|
||||
|
||||
@defproc[(a-<=0? [x real?]) boolean?]{
|
||||
Returns @racket[#t] when @racket[x] is less than or equal to zero.
|
||||
}
|
||||
|
||||
@defthing[a-true? procedure?]{
|
||||
A predicate equivalent to @racket[(a-eq? #t)].
|
||||
}
|
||||
|
||||
@defthing[a-false? procedure?]{
|
||||
A predicate equivalent to @racket[(a-eq? #f)].
|
||||
}
|
||||
|
||||
@defthing[a-nullptr? procedure?]{
|
||||
A predicate equivalent to @racket[(a-eq? #f)]. The name is intended for FFI
|
||||
code where @racket[#f] is used to represent a null pointer.
|
||||
}
|
||||
|
||||
@defthing[a-!nullptr? procedure?]{
|
||||
A predicate equivalent to @racket[(a-!eq? #f)]. It accepts values that are
|
||||
not @racket[#f], which is often the success case for pointer-returning FFI
|
||||
calls.
|
||||
}
|
||||
Reference in New Issue
Block a user