Compare commits
2 Commits
unhygienic
...
before-6.3
Author | SHA1 | Date | |
---|---|---|---|
![]() |
78b507dd1d | ||
![]() |
ba98a1848b |
|
@ -19,6 +19,7 @@
|
||||||
racket/function
|
racket/function
|
||||||
syntax/srcloc
|
syntax/srcloc
|
||||||
hygienic-reader-extension/extend-reader
|
hygienic-reader-extension/extend-reader
|
||||||
|
"unhygienic/hygienic-reader-extension--extend-reader--unhygienic.rkt"
|
||||||
(for-meta -10 racket/base)
|
(for-meta -10 racket/base)
|
||||||
(for-meta -9 racket/base)
|
(for-meta -9 racket/base)
|
||||||
(for-meta -8 racket/base)
|
(for-meta -8 racket/base)
|
||||||
|
@ -61,7 +62,7 @@
|
||||||
(require syntax/strip-context)
|
(require syntax/strip-context)
|
||||||
(define ((wrap-reader-unhygienic p) . p-args)
|
(define ((wrap-reader-unhygienic p) . p-args)
|
||||||
(strip-context
|
(strip-context
|
||||||
(apply (extend-reader p
|
(apply (extend-reader-unhygienic p
|
||||||
(λ ([orig-rt (current-readtable)]
|
(λ ([orig-rt (current-readtable)]
|
||||||
#:outer-scope outer-scope
|
#:outer-scope outer-scope
|
||||||
#:arg-str [arg-str (current-arg-string)])
|
#:arg-str [arg-str (current-arg-string)])
|
||||||
|
|
|
@ -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)]))
|
Loading…
Reference in New Issue
Block a user