capybara/xtemplate.rkt

#lang racket/base

(require racket/base racket/format racket/list racket/match racket/string
         syntax/parse syntax/parse/define
         (for-syntax racket/base racket/match racket/set))

(provide (rename-out [x:#%module-begin #%module-begin]
                     [x:#%top #%top])
         (except-out (all-from-out racket/base racket/format racket/list racket/match racket/string)
                     #%module-begin #%top))

(define-for-syntax *unbound-prop* 'xtemplate:unbound)

(define-for-syntax (collect-unbounds stx)
  (define (next stx)
    (match (syntax->list stx)
      [#f (set)]
      [lst (foldr set-union (set) (map collect-unbounds lst))]))
  (match (syntax-property stx *unbound-prop*)
    [#f (next stx)]
    [result (set-add (next stx) result)]))

(define-syntax-parse-rule (x:#%top . id:id)
  #:with #%template-args (datum->syntax #'id '#%template-args)
  #:with propped-id (syntax-property #'(quote id) *unbound-prop* (syntax->datum #'id))
  (hash-ref #%template-args propped-id))

(define-syntax-parse-rule (x:#%module-begin body)
  #:with #%template-args (datum->syntax #'body '#%template-args)
  #:with execute-fn #'(λ (#%template-args) body)
  #:with expanded-execute-fn #'execute-fn
  ; #:with expanded-execute-fn (local-expand #'execute-fn (syntax-local-context) '())
  ; #:with (unbound-ids ...)
  ;   (map (λ (stx) #`(quote #,stx)) (set->list (collect-unbounds #'expanded-execute-fn)))
  (#%module-begin
   ; (provide required-ids)
   ; (define required-ids (list unbound-ids ...))
   (provide execute)
   (define execute expanded-execute-fn)))