44 lines
1.7 KiB
Racket
44 lines
1.7 KiB
Racket
#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 (begin
|
|
; (displayln "expanding!")
|
|
; (local-expand #'execute-fn (syntax-local-context) '()))
|
|
; #:with (unbound-ids ...)
|
|
; (begin
|
|
; (displayln "collecting unbounds")
|
|
; (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)))
|