(module tail mzscheme (define-syntax let-tail-continuation (syntax-rules () [(_ k body1 body2 ...) (let ([thunk (let/cc return (let-syntax ([k (syntax-rules () [(k e) (return (lambda () e))])]) (lambda () body1 body2 ...)))]) (thunk))])) (define-syntax let/tc (make-rename-transformer #'let-tail-continuation)) (define-syntax push-begin (syntax-rules () [(_ e1 e2 ...) (call-with-values (lambda () e1 e2 ...) values)])) (define (with-continuation-mark** key new update thunk) (let ([ccm (continuation-mark-set->list (current-continuation-marks) key)]) (if (null? ccm) (with-continuation-mark key new (thunk)) (let ([original (car ccm)]) (with-continuation-mark key 'dummy (if (= (length ccm) (length (continuation-mark-set->list (current-continuation-marks) key))) (with-continuation-mark key original (with-continuation-mark key (update original) (thunk))) (with-continuation-mark key new (thunk)))))))) (define-syntax with-continuation-mark* (syntax-rules () [(with-continuation-mark* key new update body) (with-continuation-mark** key new update (lambda () body))])) (provide let-tail-continuation let/tc push-begin with-continuation-mark*))