diff --git a/.gitignore b/.gitignore index 39a4f9c..3bd7ab8 100644 --- a/.gitignore +++ b/.gitignore @@ -15,3 +15,4 @@ compiled/ # Dependency tracking files *.dep +/*.bak diff --git a/info.rkt b/info.rkt new file mode 100644 index 0000000..f8cc4ce --- /dev/null +++ b/info.rkt @@ -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) + diff --git a/main.rkt b/main.rkt new file mode 100644 index 0000000..4a56730 --- /dev/null +++ b/main.rkt @@ -0,0 +1,87 @@ +#lang racket/base + +(provide let/assert + make-assert + a-eq? a-!eq? + a->? a-<=? + a->=? 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 + ... + ) + ) + ) + ) + ) diff --git a/scrbl/.gitignore b/scrbl/.gitignore new file mode 100644 index 0000000..f150dc7 --- /dev/null +++ b/scrbl/.gitignore @@ -0,0 +1,5 @@ +*.bak +*.scrbl~ +*.js +*.css +*.html \ No newline at end of file diff --git a/scrbl/let-assert.scrbl b/scrbl/let-assert.scrbl new file mode 100644 index 0000000..57a9e6e --- /dev/null +++ b/scrbl/let-assert.scrbl @@ -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-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. +} \ No newline at end of file