+(define current-return-tag (make-parameter #f))
+
+(define (return expr)
+ (-> (abort (or (current-return-tag) (error "return outside function"))
+ (list expr)
+ (-> (const '())))))
+
+(define (with-return-prompt body-thunk)
+ (let ((tag (gensym "return")))
+ (parameterize ((current-return-tag
+ (-> (lexical 'return tag))))
+ (-> (let '(return) (list tag)
+ (list (-> (primcall 'make-prompt-tag)))
+ (-> (prompt (current-return-tag)
+ (body-thunk)
+ (let ((val (gensym "val")))
+ (-> (lambda-case
+ `(((k val) #f #f #f () (,(gensym) ,val))
+ ,(-> (lexical 'val val)))))))))))))
+