95 lines
1.8 KiB
Racket
95 lines
1.8 KiB
Racket
#lang racket/base
|
|
|
|
(provide define/return
|
|
;return
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; define/return
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax define/return
|
|
(syntax-rules ()
|
|
((_ def return
|
|
b1 ...)
|
|
(define def
|
|
(call/cc
|
|
(λ (return)
|
|
b1
|
|
...)))
|
|
)
|
|
)
|
|
)
|
|
|
|
#|
|
|
|
|
|
|
(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)))
|
|
)
|
|
)
|
|
)
|
|
|# |