#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
          ...)))
     )
    )
  )