Initial import

.gitignore

@@ -15,3 +15,4 @@ compiled/
 # Dependency tracking files
 *.dep
 
+/*.bak

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)
+

main.rkt

@@ -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
+         ...
+         )
+       )
+     )
+    )
+  )

scrbl/.gitignore

@@ -0,0 +1,5 @@
+*.bak
+*.scrbl~
+*.js
+*.css
+*.html

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-<? 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.
+}