diff --git a/contract.rkt b/contract.rkt index 6a4120b..654f6e6 100644 --- a/contract.rkt +++ b/contract.rkt @@ -12,6 +12,40 @@ ;; 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) @@ -52,3 +86,4 @@ ) ) +|# diff --git a/main.rkt b/main.rkt index ef51566..b82110b 100644 --- a/main.rkt +++ b/main.rkt @@ -1,13 +1,29 @@ #lang racket/base (provide define/return - 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 @@ -76,4 +92,4 @@ ) ) ) - \ No newline at end of file +|# \ No newline at end of file