90 lines
1.9 KiB
Racket
90 lines
1.9 KiB
Racket
#lang racket/base
|
|
|
|
(require "main.rkt"
|
|
racket/contract)
|
|
|
|
(provide define/contract/return
|
|
(all-from-out racket/contract)
|
|
(all-from-out "main.rkt")
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; define/return/contract
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define-syntax define/contract/return
|
|
(syntax-rules ()
|
|
((_ (name . formals) return (c ... last-pred) b1 ...)
|
|
(define/contract (name . formals)
|
|
(c ... last-pred)
|
|
(call/cc
|
|
(λ (ret)
|
|
(define/contract
|
|
(make-ret x)
|
|
(-> any/c last-pred)
|
|
x)
|
|
(define (return x)
|
|
(ret (make-ret x)))
|
|
|
|
b1
|
|
...
|
|
)
|
|
)))
|
|
((_ name last-pred value)
|
|
(define/contract name
|
|
last-pred
|
|
(call/cc
|
|
(λ (ret)
|
|
(define/contract
|
|
(make-ret x)
|
|
(-> any/c last-pred)
|
|
x)
|
|
(define (return x)
|
|
(ret (make-ret x)))
|
|
value))))
|
|
)
|
|
)
|
|
|
|
#|
|
|
(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)))
|
|
)
|
|
)
|
|
)
|
|
|
|
|#
|