Skip to content

Instantly share code, notes, and snippets.

@jackfirth
Last active August 9, 2024 02:59
Show Gist options
  • Save jackfirth/027411d567385dadb3202bee75a847b4 to your computer and use it in GitHub Desktop.
Save jackfirth/027411d567385dadb3202bee75a847b4 to your computer and use it in GitHub Desktop.
Examples of how to build control flow structures with continuations

Lessons in Using Continuations

This gist contains examples of how to build different kinds of control flow structures in Racket using macros and continuations. Examples include:

  • Early exit from functions using a return statement.
  • Early exit from arbitrary expressions using a simple exception system.
  • Temporarily interrupting execution in order to check permissions.
#lang racket
(require (for-syntax syntax/parse/lib/function-header)
racket/stxparam
syntax/parse/define)
(define return-tag (make-continuation-prompt-tag))
(define (return-dynamically v)
(abort-current-continuation return-tag v))
(define (call/dynamic-return thunk)
(call-with-continuation-prompt thunk return-tag values))
(define-syntax-parameter return!
(λ (stx) (raise-syntax-error #false "cannot be used outside a define/return function body" stx)))
(define-syntax-parse-rule (define/return header:function-header body ...)
(define header
(call/dynamic-return
(syntax-parameterize ([return! (make-rename-transformer #'return-dynamically)])
(λ () body ...)))))
(define/return (abs x)
(when (negative? x)
(return! (- x)))
x)
(abs 10) ; returns 10
(abs 0) ; returns 0
(abs -10) ; returns 10
#lang racket
(require racket/stxparam
rebellion/base/result
syntax/parse/define)
(define try-tag (make-continuation-prompt-tag))
(define (fail-dynamically v) (abort-current-continuation try-tag v))
(define (try-dynamically thunk)
(call-with-continuation-prompt (λ () (success (thunk))) try-tag failure))
(define-syntax-parameter fail!
(λ (stx) (raise-syntax-error #false "cannot be used outside a try block" stx)))
(define-syntax-parse-rule (try body ...)
(try-dynamically
(λ ()
(syntax-parameterize ([fail! (make-rename-transformer #'fail-dynamically)])
body ...))))
;; evaluates to (success 3)
(try
(define x 1)
(define y 2)
(+ x y))
;; evaluates to (failure 'oops)
(try
(define x 1)
(define y (fail! 'oops))
(+ x y))
#lang racket
(require racket/stxparam
rebellion/base/result
syntax/parse/define)
(define permission-check-tag (make-continuation-prompt-tag 'permission-check))
(define (check-permission-dynamically permission)
(call-with-current-continuation
(λ (jump-back) (abort-current-continuation permission-check-tag permission jump-back))
permission-check-tag))
(define (make-permission-check-handler granted-permissions)
(define (handler permission jump-back)
(if (set-member? granted-permissions permission)
(call-with-continuation-prompt jump-back permission-check-tag handler)
(failure permission)))
handler)
(define (grant-permissions-dynamically permissions thunk)
(define handler (make-permission-check-handler permissions))
(call-with-continuation-prompt (λ () (success (thunk))) permission-check-tag handler))
(define-syntax-parameter in-grant-permissions-block? #false)
(define-syntax-parse-rule (check-permission! id:id)
#:fail-unless (syntax-parameter-value #'in-grant-permissions-block?)
"cannot be used outside a grant-permissions block"
(check-permission-dynamically 'id))
(define-syntax-parse-rule (grant-permissions (~seq #:allow sym:id) ... body ...)
(grant-permissions-dynamically
(set 'sym ...)
(λ ()
(syntax-parameterize ([in-grant-permissions-block? #true])
body ...))))
;; evaluates to (failure 'system-clock)
(grant-permissions
#:allow filesystem
#:allow network
(displayln "Stealing secret files...")
(check-permission! filesystem)
(displayln "Secret files stolen!")
(newline)
(displayln "Contacting the NSA...")
(check-permission! network)
(displayln "NSA contacted!")
(newline)
(displayln "Changing the system clock...")
(check-permission! system-clock)
;; this part is never printed
(displayln "System clock changed!"))
@Metaxal
Copy link

Metaxal commented Jun 26, 2023

(side note) Regarding the first case, one can also use a simple escape continuation ("ec"):

(define (abs x)
  (let/ec return
    (when (negative? x)
      (return (- x)))
    x))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment