separated contract form from default form.

contract.rkt

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

info.rkt

@@ -9,6 +9,7 @@
 (define scribblings
   '(
     ("scrbl/define-return.scrbl" () (library))
+    ("scrbl/define-return-contract.scrbl" () (library))
     )
   )
 

scrbl/define-return-contract.rkt

@@ -0,0 +1,118 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     "../main.rkt"))
+
+@title{define/return/contract}
+@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
+
+@defmodule[define-return/contract]
+
+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.
+
+This module provides the contracted version of @racket{define/return}.
+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].
+
+Note. This can lead to clashes of symbol @racket[->] with module @racketmodname[ffi/unsafe].
+
+@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?].
+
+}
+

scrbl/define-return.scrbl

@@ -19,10 +19,8 @@ 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
+See @racketmodname[define-return/contract] for the contracted version of
-@racket[->], @racket[->*], @racket[any/c], @racket[or/c],
+this module. 
-@racket[and/c], and @racket[listof] are available from the same
-@racket[require].
 
 @section{Return}