a-macro-scope-example.rkt

#lang racket/base

(require (for-syntax racket/base
                     syntax/parse)
         racket/stxparam)

;; (bind x-id e-expr)
;; Bind x-id to some string in e-expr
;; Expands to a expression that constructs a hash
;; table storing e-expr in a field
(define-syntax (bind stx)
  (syntax-parse stx
    [(_ y (~datum in) e)
     ;; Here, `x` only captures `x` that appear in the template
     #'(let ([x "in-x"])
         (let ([y "in-y"])
           (make-hash
            `(["X" . ,x] ["Y" . ,y] ["E" . ,e]))))]))

(define x "out-x")
(define y "out-y")
(bind x in (make-hash
            `(["EX" . ,x] ["EY" . ,y])))





;; "Capture" break-loop in loop in the good way:
;; break-loop is still resolved lexically via bindings.
;; It expands to the fresh, locally bound identifier `fresh-exit-id`
;; that is inaccessible to the user of the macro.
(provide loop break-loop)

(define-syntax-parameter break-loop
  (λ (stx)
    (raise-syntax-error 'break-loop
                        "break-loop used out of loop"
                        stx)))

(define-syntax (loop AST)
  (syntax-parse AST
    [(_ body-expr ...)
     #'(call-with-current-continuation
        ;; Lexical scoping still exists:
        ;; if (λ (fresh-exit-id) ... is moved under (syntax-parameterize ...,
        ;; fresh-exit-id is going to be unbound.
        (λ (fresh-exit-id)
          (syntax-parameterize ([break-loop
                                 (λ (stx)
                                   (syntax-parse stx
                                     [(_ return-value-syntax:expr)
                                      #'(fresh-exit-id return-value-syntax)]))])
            (define (recursion)
              body-expr ...
              (recursion))
            (recursion))))]))

;; In REPL run (require (submod "." use-loop))
(module* use-loop racket/base
  (require (except-in (submod "..") break-loop)
           (rename-in (submod "..") [break-loop BreakLoop]))

  ;; break-loop is referenced by *binding* instead of *name*
  (loop

   (define v
     (loop
      (printf "before break in the inner loop\n")
      (BreakLoop "return-value-from-exit")
      (printf "after break in the inner loop\n")))

   (printf "the inner loop returns ~a\n" v)
   (BreakLoop "returning from outer loop"))
  )

another-macro-composition-example.rkt

#lang racket/base

(require syntax/parse/define
         (for-syntax racket/base
                     racket/syntax
                     syntax/parse)
         racket/stxparam)

;; An alias of `let`. Sort of.
(define-syntax (where stx)
  (syntax-parse stx
    #:track-literals
    [(_ body:expr
        (~seq X:id (~optional (~seq y:id ...+))
              (~literal =)
              def:expr)
        ...)
     #'(let ([X (~? (λ (y ...) def)
                    def)] ...)
         body)]))

{(plus x y)
 . where . x = 5
           y = 3
           plus n m = (+ n m)}





(define-syntax (repeat stx)
  (syntax-parse stx
    [(_ e)
     ;; Not until the macro expander actually expands the result of
     ;; `(repeat "hi")` with the definition of `while` can it
     ;; determine that the `dup` identifier, appearing free in
     ;; the output, should actually be fresh.
     #'{(dup e)
        . where . dup x = (string-append x x)}]))

(repeat "hi")




(define dup "'OS FFI dup2' ")
(define-syntax (copy-dup stx)
  (syntax-parse stx
    [(_ e)
     ;; The three `dup` identifier appearing free in the output
     ;; syntax object all have different roles. The `dup` at L47 is
     ;; a bound reference to the `dup` at L49; the `dup` at L49
     ;; introduces a local binding via `where`; the `dup` at L51
     ;; is free and therefore refers to the `dup` at L41.
     #'{(dup msg)
        . where . dup x = (string-append x x)
                  msg = (string-append dup e)}]))

(copy-dup "descriptor    ")








;; Hygiene bending. Doesn't really work because it doesn't compose.
;; More information: Eli Barzilay, Ryan Culpepper and Matthew Flatt.
;; Keeping it Clean with Syntax Parameters.
;; http://scheme2011.ucombinator.org/papers/Barzilay2011.pdf
(define-syntax (bad-loop stx)
  (syntax-parse stx
    [(bad-loop-invocation body-expr ...)
     ;; All hope is not lost. To the least we can ask DrRacket to draw
     ;; binding arrows based on the actual binding structure for us.
     #:with usesite-breakloop (syntax-property
                               (format-id stx "break-loop"
                                          #:source #'bad-loop-invocation)
                               'original-for-check-syntax #t)
     #'(call-with-escape-continuation
        (λ (usesite-breakloop)
          (define (recursion)
            body-expr ...
            (recursion))
          (recursion)))]))

(bad-loop
 (bad-loop
  (printf "before break\n")
  (break-loop "return val")
  (printf "after break\n"))
 (break-loop "goodbye"))









;; The reference to `fresh-exit-id` at L117 provides a good example of
;; local, lexically scoped reference in syntax objects in macros.
;; N.B. the transformer at L116-L119 is evaluated locally although
;; `break-loop` is defined globally.
(provide break-loop loop)
(define-syntax-parameter break-loop
  (λ (stx)
    (raise-syntax-error 'break-loop
                        "break-loop used out of loop"
                        stx)))

(define-syntax (loop stx)
  (syntax-parse stx
    [(loop-invocation body-expr ...)
     #'(call-with-escape-continuation
        ;; Lexical scoping still exists:
        ;;     if (λ (fresh-exit-id) ... is moved under (syntax-parameterize ...,
        ;;     fresh-exit-id is going to be unbound.
        (λ (fresh-exit-id)
          (syntax-parameterize ([break-loop
                                 (λ (stx)
                                   (syntax-parse stx
                                     [(_ return-value-syntax:expr)
                                      #'(fresh-exit-id return-value-syntax)]))])
            (define (recursion)
              body-expr ...
              (recursion))
            (recursion))))]))

;; In REPL run (require (submod "." use-loop))
(module* use-loop racket/base
  (require (except-in (submod "..") break-loop)
           (rename-in (submod "..") [break-loop BreakLoop]))

  ;; break-loop is referenced by *binding* instead of *name*
  (loop

   (define v
     (loop
      (printf "before break in the inner loop\n")
      (BreakLoop "return-value-from-exit")
      (printf "after break in the inner loop\n")))

   (printf "the inner loop returns ~a\n" v)
   (BreakLoop "returning from outer loop"))
  )









;; Modified from Michael Ballantyne's example:
;;   https://groups.google.com/g/racket-users/c/61cQImHJfZI/m/tyq3f8omAwAJ
;; `run-at-expansion` is actually to a *new* (although local)
;; macro introduction form.
(define-syntax (run-at-expansion stx)
  (syntax-parse stx
    [(_ body:expr ...+)
     #'(let ()
         (define-syntax (m unused-stx)
           body ...)
         (m))]))

(run-at-expansion
 (with-syntax ([val (+ 1 2)])
   #'val))

bindings-as-sets-of-scopes-derivative.rkt

#lang racket/base

(require syntax/parse/define
         (for-syntax racket/base
                     syntax/parse))

;; misc examples for definition contexts
;; Derived or copied from: bindings as sets of scopes 2.4
;; https://www.cs.utah.edu/plt/scope-sets/pattern-macros.html#%28part._intdef%29
;; Hygienic Macro Technology 7.3
;; lexi_lambda's tweet
;; https://twitter.com/lexi_lambda/status/1420966048250093575
(let ()
  (define-syntax-parse-rule (M)
    x)

  (define x "x-in-let")
  (M))

(let ()
  (define-syntax-parse-rule (M id)
    (define id "id-defined-by-M"))

  (M intro-by-M)

  intro-by-M)

(let ()
  (define-syntax-parse-rule (M id)
    (begin
      (define id "defined-by-M")
      (printf "in M, intro-by-M = ~s\n" intro-by-M)))

  (M intro-by-M)

  intro-by-M)





(let ([x "outer"])
  (let-syntax ([M (syntax-rules ()
                    [(_) x])])
    (let ([x "inner"])
      (M))))

(let ([x "outer"])
  (let-syntax ([M (syntax-rules ()
                    [(_ usesite-x)
                     (let ([usesite-x "inner"])
                       x)])])
    (M x)))

(let ([x "outermost-x"]) ; <- this one
  (let-syntax ([M (syntax-rules ()
                    [(_ M2 e)
                     (let-syntax ([M2 (syntax-rules ()
                                        [(_) x])]) ; <- reference to x
                       e)])])
    (let ([x "x-over-M-use-and-M2"]) ; <- not this one
      (M M2
         (let ([x "x-over-M2-use"]) ; <- not this one
           (M2))))))

(let ([x "outer"])
  (define-syntax-parse-rule (M usesite-x)
    (let ([usesite-x "inner"])
      x))
  (M x))

(let ([x "outer"])
  (define-syntax-parse-rule (M usesite-x)
    (begin
      (define usesite-x "recursive")
      x))
  (M x))

(let ([x "outer"])
  (define-syntax-parse-rule (M usesite-x)
    (begin
      (define usesite-x "inner-recursive")
      x))
  (let ()
    (M x)))

hygienic-macro-technology-7.3-example.rkt

#lang racket/base

(require (for-syntax racket/base))

(let ([x 0])
  (let-syntax ([m (syntax-rules ()
                    [(_ m2 body)
                     (let-syntax ([m2 (syntax-rules ()
                                        [(_) x])])
                       body)])])
    (let ([x 1])
      (m m2
         (let ([x 2]) (m2))))))



;; Further derived example: expansion assigns the symbolic name 'x' to y and z
;; Expected result: '(0 2 1)
;; #lang racket/base
;;
;; (require (for-syntax racket/base))

(let ([x 0])
  (let-syntax
      ([mplusplus
        (syntax-rules ()
          [(mplusplus mplus z e)
           (let-syntax ([mplus (syntax-rules ()
                                 [(mplus y)
                                  (let ([z 1])
                                    (list x y z))])])
             e)])])
    (mplusplus mplus
               x
               (let ([x 2])
                 (mplus x)))))