Compare commits

...

2 Commits

2 changed files with 36 additions and 8 deletions

View File

@ -19,6 +19,7 @@
racket/function
syntax/srcloc
hygienic-reader-extension/extend-reader
"unhygienic/hygienic-reader-extension--extend-reader--unhygienic.rkt"
(for-meta -10 racket/base)
(for-meta -9 racket/base)
(for-meta -8 racket/base)
@ -61,14 +62,14 @@
(require syntax/strip-context)
(define ((wrap-reader-unhygienic p) . p-args)
(strip-context
(apply (extend-reader p
(λ ([orig-rt (current-readtable)]
#:outer-scope outer-scope
#:arg-str [arg-str (current-arg-string)])
(make-aful-readtable orig-rt
#:outer-scope (λ (stx [mode 'flip]) stx)
#:arg-str arg-str))
#:hygiene? #f)
(apply (extend-reader-unhygienic p
(λ ([orig-rt (current-readtable)]
#:outer-scope outer-scope
#:arg-str [arg-str (current-arg-string)])
(make-aful-readtable orig-rt
#:outer-scope (λ (stx [mode 'flip]) stx)
#:arg-str arg-str))
#:hygiene? #f)
p-args)))
(define (make-aful-readtable [orig-rt (current-readtable)]

View File

@ -0,0 +1,27 @@
#lang racket
;; Copied and adjusted from
;; https://github.com/AlexKnauth/hygienic-reader-extension
;; /blob/master/hygienic-reader-extension/extend-reader.rkt
(provide extend-reader-unhygienic)
;; extend-reader : (-> (-> A ... Any)
;; (-> Readtable #:outer-scope (-> Syntax Syntax) Readtable)
;; (-> A ... Any))
(define (extend-reader-unhygienic proc extend-readtable #:hygiene? [hygiene? #t])
(lambda args
(define orig-readtable (current-readtable))
(define outer-scope (make-syntax-introducer/use-site))
(parameterize ([current-readtable (extend-readtable orig-readtable #:outer-scope outer-scope)])
(define stx (apply proc args))
(if (and (syntax? stx) hygiene?)
(outer-scope stx)
stx))))
;; make-syntax-introducer/use-site : (-> (-> Syntax Syntax))
(define (make-syntax-introducer/use-site)
(cond [(procedure-arity-includes? make-syntax-introducer 1)
(make-syntax-introducer #t)]
[else
(make-syntax-introducer)]))