Macro that prints the names and values of local lexical variables

magic-macro.rkt

#lang racket/base

; Hastily adapted from debug-repl at https://github.com/AlexKnauth/debug/blob/master/debug/repl.rkt

; Note that this code relies on the output of `syntax-debug-info`, which the Racket documentation
; does not provide strong promises about. It may break with a future release of Racket.

; MIT License
;
; Copyright (c) 2015-2022 Alex Knauth, Suzanne Soy, Matthew Butterick, Sorawee Porncharoenwase,
; and Michael Ballantyne
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.

(provide magic-macro)
(require (for-syntax racket/base racket/list syntax/parse))

(define-syntax magic-macro
  (lambda (stx)
    (syntax-parse stx
      [(_)
       #:do [(define all-vars (syntax-find-local-variables stx))
             (define-values [xs ms]
               (partition non-macro-id? all-vars))]
       #:with [x ...] (reverse xs)
       #'(list (list (quote x) x) ...)])))
  
(begin-for-syntax
  ;; syntax-find-local-variables : Syntax -> (Listof Id)
  (define (syntax-find-local-variables stx)
    (define debug-info (syntax-debug-info stx (syntax-local-phase-level) #t))
    (unless (hash-has-key? debug-info 'bindings)
      (error 'syntax-find-local-variables
             (string-append
              "magic-macro cannot find the local bindings\n"
              "  debug-info: ~v\n")
             debug-info))
    (define context (hash-ref debug-info 'context))
    (define bindings (hash-ref debug-info 'bindings '()))
    (remove-duplicates
     (for/list ([binding (in-list bindings)]
                ;; Comment this line out if you'd like to include module-level bindings.
                #:when (hash-has-key? binding 'local)
                #:when (context-subset? (hash-ref binding 'context) context))
       (datum->syntax stx (hash-ref binding 'name) stx))
     bound-identifier=?))

  ;; context-subset? : Context Context -> Boolean
  (define (context-subset? a b)
    ;; TODO: use an actual set-of-scopes subset function
    (list-prefix? a b))

  ;; non-macro-id? : Id -> Boolean
  (define NON-MACRO (gensym 'NON-MACRO))
  (define (non-macro-id? id)
    (eq? NON-MACRO (syntax-local-value id (λ () NON-MACRO)))))

(module+ test
  (require rackunit)
  
  (define (foo x y z)
    (magic-macro))

  (check-equal?
   (foo 10 20 30)
   '((x 10) (y 20) (z 30))))