Initial version

.gitignore

@@ -3,6 +3,7 @@
 # website: http://www.racket-lang.org/
 
 # DrRacket autosave files
+*.bak
 *.rkt~
 *.rkt.bak
 \#*.rkt#
@@ -15,3 +16,7 @@ compiled/
 # Dependency tracking files
 *.dep
 
+# Scribble stuff
+*.html
+*.js
+*.css

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 "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 scribblings
+  '(
+    ("scrbl/define-return.scrbl" () (library))
+    )
+  )
+
+(define deps
+  '("racket/base" "racket/contract")
+  )
+
+(define build-deps
+  '("racket-doc"
+    "draw-doc"
+    "rackunit-lib"
+    "scribble-lib"
+    ))
+
+(define test-omit-paths 'all)
+

main.rkt

@@ -0,0 +1,83 @@
+#lang racket/base
+
+(require racket/contract)
+
+(provide define/return
+         define/contract/return
+         return
+         (all-from-out racket/contract)
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; define/return
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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)))
+     )
+    )
+  )
+       

scrbl/define-return.scrbl

@@ -0,0 +1,179 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     "../main.rkt"))
+
+@title{define-return}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[define-return]
+
+The @racketmodname[define-return] library provides definition forms with an
+explicit early return. This is useful in small defensive functions, and
+especially around FFI bindings, where null pointers, error codes, unsupported
+states, or failed preconditions should leave the function immediately.
+
+The early return is implemented with an internal exception. A @racket[return]
+raises that exception, and the definition forms catch it around the function
+body. The contracted form additionally checks early-returned values against
+the result contract.
+
+The module re-exports @racketmodname[racket/contract], so contracts such as
+@racket[->], @racket[->*], @racket[any/c], @racket[or/c],
+@racket[and/c], and @racket[listof] are available from the same
+@racket[require].
+
+@section{Return}
+
+@defform[(return val)]{
+
+Returns @racket[val] from the nearest dynamically enclosing
+@racket[define/return] or @racket[define/contract/return] body.
+
+The form is not a general escape continuation. It raises an internal return
+exception. When used outside a body installed by this library, that exception
+escapes.
+
+}
+
+@section{Uncontracted definitions}
+
+@defform[(define/return def body ...)]{
+
+Like @racket[define], but @racket[body] may use @racket[return] to leave the
+definition early.
+
+@racketblock[
+(define/return (status->symbol code)
+  (when (= code 0) (return 'ok))
+  (when (< code 0) (return 'failed))
+  (when (> code 5) (return 'out-of-range))
+  (unless (number? code)
+    (return 'not-a-number))
+  (cond
+    ((= code 1) 'normal)
+    ((>= code 2) (string->symbol (format "code-~a" (* code code))))
+    )
+  )
+]
+
+The final expression is used when no early return is taken.
+
+@codeblock|{
+(status->symbol 0)    ; => 'ok
+(status->symbol -1)   ; => 'failed
+(status->symbol 10)   ; => 'out-of-range
+(status->symbol "Hi") ; => 'not-a-number
+(status->symbol 1)    ; => 'normal
+(status->symbol 3)    ; => 'code-9
+}|
+
+}
+
+@section{Contracted definitions}
+
+@defform*[
+((define/contract/return (name . formals)
+   (contract-part ... result-contract)
+   body ...)
+ (define/contract/return name
+   result-contract
+   value))
+]{
+
+Like @racket[define/contract], but the body may use @racket[return].
+
+The first form defines a contracted function. Ordinary results are checked by
+@racket[define/contract]. Early-returned values are checked separately
+against @racket[result-contract]. The implementation does this by defining a
+small local contracted returner with the same result contract, so the result
+contract is passed through Racket's contract machinery.
+
+The contract must be written inline as a parenthesized contract form. The
+last element is used as the early-return result contract.
+
+@racketblock[
+(define/contract/return (h x)
+  (-> number? (or/c symbol? number?))
+  (when (< x 0) (return 'x-not-positive))
+  (let ((y (* x x)))
+    (when (> y 100) (return 'maxed-out))
+    (when (= y 9) (return "Wrong answer!"))
+    y))
+]
+
+Here the result contract is @racket[(or/c symbol? number?)]. The symbol
+returns are accepted, ordinary numeric results are accepted, and the string
+@racket["Wrong answer!"] is rejected.
+
+@codeblock|{
+(h -1)  ; => 'x-not-positive
+(h 2)   ; => 4
+(h 11)  ; => 'maxed-out
+(h 3)   ; contract violation: string result
+}|
+
+A zero-argument function works in the same way:
+
+@racketblock[
+(define/contract/return (z)
+  (-> symbol?)
+  (let ((cs (current-seconds)))
+    (when (= (remainder cs 3) 0) (return "deelbaar door 3"))
+    (when (= (remainder cs 2) 0) (return 'dividable-by-2))
+    'yes))
+]
+
+The result contract is @racket[symbol?]. Returning
+@racket['dividable-by-2] or @racket['yes] is accepted. Returning the string
+@racket["deelbaar door 3"] is rejected.
+
+Rest arguments can be used when the corresponding contract form is accepted
+by @racket[define/contract]:
+
+@racketblock[
+(define/contract/return (sum . xs)
+  (->* () #:rest (listof number?) number?)
+  (when (null? xs) (return 0))
+  (apply + xs))
+]
+
+@codeblock|{
+(sum)       ; => 0
+(sum 1 2)   ; => 3
+(sum 1 'x)  ; contract violation
+}|
+
+The second form defines a contracted value. The value expression may use
+@racket[return], and the returned value is checked against
+@racket[result-contract].
+
+@racketblock[
+(define/contract/return v
+  number?
+  (return 'ss))
+]
+
+This definition raises a contract violation, because @racket['ss] does not
+satisfy @racket[number?].
+
+}
+
+@section{Notes}
+
+The mechanism is intentionally small. It uses @racket[with-handlers] and an
+internal exception type; it does not introduce prompts, continuations, or a
+new calling convention.
+
+For @racket[define/contract/return], the normal function contract remains the
+job of @racket[define/contract]. The extra returner only exists for the path
+where @racket[return] leaves the body through an exception handler. That path
+would otherwise bypass the ordinary result position of the function body.
+
+The contracted form does not try to parse arbitrary contract syntax. It
+splits the inline contract form syntactically and reuses its last element as
+the early-return result contract. This works well for ordinary result
+contracts such as @racket[number?], @racket[symbol?],
+@racket[(or/c symbol? number?)], and the result position of @racket[->*]
+contracts.