A "static continuation" system for Racket macros.

static-continuations.rkt

#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))