83 lines
2.2 KiB
Racket
83 lines
2.2 KiB
Racket
#lang racket/base
|
|
|
|
(provide early-return
|
|
define/return
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; early-return
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax early-return*
|
|
(syntax-rules (=> ? ~ do)
|
|
((_ () (b1 ...))
|
|
(let () b1 ...))
|
|
((_ ((do d1 ...)) (b1 ...))
|
|
(let () d1 ...
|
|
(let () b1 ...)))
|
|
((_ ((do d1 ...) c1 ...) (b1 ...))
|
|
(let () d1 ...
|
|
(early-return* (c1 ...) (b1 ...))))
|
|
((_ ((v expr ? pred? => retval ~ cleanup)) (b1 ...))
|
|
(let ((v expr))
|
|
(cond (pred? cleanup retval)
|
|
(else (let () b1 ...)))))
|
|
((_ ((v expr ? pred? => retval ~ cleanup) c1 ...) (b1 ...))
|
|
(let ((v expr))
|
|
(cond (pred? cleanup retval)
|
|
(else (early-return* (c1 ...) (b1 ...))))))
|
|
((_ ((v expr ? pred? => retval)) (b1 ...))
|
|
(let ((v expr))
|
|
(cond (pred? retval)
|
|
(else (let () b1 ...)))))
|
|
((_ ((v expr ? pred? => retval) c1 ...) (b1 ...))
|
|
(let ((v expr))
|
|
(cond (pred? retval)
|
|
(else (early-return* (c1 ...) (b1 ...))))))
|
|
((_ ((? pred? => retval)) (b1 ...))
|
|
(cond (pred? retval)
|
|
(else (let () b1 ...))))
|
|
((_ ((? pred? => retval) c1 ...) (b1 ...))
|
|
(cond (pred? retval)
|
|
(else (early-return* (c1 ...) (b1 ...)))))
|
|
((_ ((? pred? => retval ~ cleanup)) (b1 ...))
|
|
(cond (pred? cleanup retval)
|
|
(else (let () b1 ...))))
|
|
((_ ((? pred? => retval ~ cleanup) c1 ...) (b1 ...))
|
|
(cond (pred? cleanup retval)
|
|
(else (early-return* (c1 ...) (b1 ...)))))
|
|
((_ ((v expr)) (b1 ...))
|
|
(let ((v expr))
|
|
b1 ...))
|
|
((_ ((v expr) c1 ...) (b1 ...))
|
|
(let ((v expr))
|
|
(early-return* (c1 ...) (b1 ...))))
|
|
)
|
|
)
|
|
|
|
(define-syntax early-return
|
|
(syntax-rules (=> ? ~ do)
|
|
((_ (er1 ...) b1 ...)
|
|
(early-return* (er1 ...) (b1 ...))
|
|
)
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; define/return
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax define/return
|
|
(syntax-rules ()
|
|
((_ def return
|
|
b1 ...)
|
|
(define def
|
|
(call/cc
|
|
(λ (return)
|
|
b1
|
|
...)))
|
|
)
|
|
)
|
|
)
|
|
|