Compare commits
2 Commits
unhygienic
...
before-6.3
Author | SHA1 | Date | |
---|---|---|---|
![]() |
78b507dd1d | ||
![]() |
ba98a1848b |
|
@ -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)]
|
||||
|
|
|
@ -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