#lang racket/base

(provide define/return
         return
         )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))
     )
    )
  )