Skip to content

Instantly share code, notes, and snippets.

@jackfirth
Last active December 10, 2021 08:22
Show Gist options
  • Save jackfirth/95c66eeede00ff3c2c8a195638b44447 to your computer and use it in GitHub Desktop.
Save jackfirth/95c66eeede00ff3c2c8a195638b44447 to your computer and use it in GitHub Desktop.
A "static continuation" system for Racket macros.
#lang racket/base
;; This is a "static continuation" system, which I developed as a foundation for building macros like
;; the following:
;;
;; - The guard, guard-match, and guard-define statement macros in rebellion/private/guarded-block
;; - A (parameterize! id expr) statement macro that sets a parameter for the rest of the block
;; - An (open! disposable-expr) expression macro that allocates a resource and closes it at the end of
;; the block
;; - A (let! id expr) statement macro that's like define except it shadows preexisting bindings
;; - An (await! promise-expr) expression macro that's like async-await syntax in javascript/rust/etc.
(require (for-syntax racket/base
syntax/parse)
racket/match
racket/splicing
racket/stxparam
syntax/parse/define)
(define-syntax static-continuation-primitive-replace! #false)
(define-syntax-parse-rule (static-continuation-block form:expr ...)
(let () (static-continuation-begin form ...)))
(define-syntax static-continuation-begin
(syntax-parser
#:track-literals
[(_) #'(begin)]
[(_ initial-form leftover-form ...)
(define expanded-initial-form
(local-expand
#'initial-form
(syntax-local-context)
(list #'static-continuation-primitive-replace! #'define-values)))
(syntax-protect
(syntax-parse (syntax-disarm expanded-initial-form #false)
#:literal-sets (kernel-literals)
#:literals (static-continuation-primitive-replace!)
#:track-literals
[(begin ~! subform:expr ...)
#'(static-continuation-begin subform ... leftover-form ...)]
[(define-values ~! . _)
#`(begin #,expanded-initial-form (static-continuation-begin leftover-form ...))]
[(define-syntaxes ~! . _)
#`(begin #,expanded-initial-form (static-continuation-begin leftover-form ...))]
[(static-continuation-primitive-replace!
~!
(~optional (~and #:splicing splicing))
continuation-name:id
replacement-stx-expr:expr)
#:with continuation-wrapper
(if (attribute splicing) #'static-continuation-begin #'static-continuation-block)
#'(splicing-let-syntax
([transformed-continuation
(lambda (_)
(define continuation-name #'(continuation-wrapper leftover-form ...))
replacement-stx-expr)])
transformed-continuation)]
[e:expr #'(begin e (static-continuation-begin leftover-form ...))]))]))
(define-syntax-parse-rule (static-continuation-replace! replacement-body:expr ...)
#:with this-continuation-id (syntax-local-introduce #'this-continuation)
(static-continuation-primitive-replace!
k-stx
(with-syntax ([this-continuation-id k-stx]) #'(begin replacement-body ...))))
(static-continuation-block
(define a 1)
(define b 2)
(static-continuation-replace!
(printf "The continuation here is ~a\n"
'this-continuation)
this-continuation)
(+ a b))
;; the above evaluates to 3 and prints:
;; "The continuation here is (static-continuation-block (+ a b))"
(define-syntax-parse-rule (parameterize! parameter new-value:expr)
#:declare parameter (expr/c #'parameter?)
(static-continuation-replace!
(parameterize ([parameter new-value]) this-continuation)))
(define-syntax-parse-rule (let! id:id rhs:expr)
(static-continuation-replace! (let ([id rhs]) this-continuation)))
(define (do-stuff)
(displayln "doing stuff"))
(define (do-more-stuff)
(displayln "doing more stuff"))
(static-continuation-block
(do-stuff)
(let! a 1)
(do-more-stuff)
(let! b 2)
(+ a b))
(define p (make-parameter 1))
(static-continuation-block
(displayln (p)) ;; prints 1
(parameterize! p 2)
(displayln (p))) ;; prints 2
(define-syntax-parse-rule (guard condition:expr #:else fail-body:expr ...)
(static-continuation-replace!
(cond [condition this-continuation]
[else fail-body ...])))
(define-syntax-parse-rule
(guard-match match-pattern subject:expr (~optional (~seq #:else fail-body:expr ...)))
(~?
(static-continuation-replace!
(match subject
[match-pattern this-continuation]
[_ fail-body ...]))
(match-define match-pattern subject)))
(static-continuation-block
(guard-match (list a b) (list 1 2) #:else
#false)
(+ a b))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment