commit 61d4a48d384b96f72d9b07be285975220aa0fc7e
parent 2c8423ac166e6345a9bd54c4d4863dad5a398622
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Wed, 14 Dec 2016 18:08:42 +0100
Removed naming of use-site scope, as it is handled specially by definition contexts.
Diffstat:
2 files changed, 8 insertions(+), 64 deletions(-)
diff --git a/named-scopes/exptime.rkt b/named-scopes/exptime.rkt
@@ -10,11 +10,6 @@
named-transformer
(rename-out [-syntax-local-introduce syntax-local-introduce]))
-(define (use-site-context?)
- (not (bound-identifier=? (syntax-local-introduce #'here)
- (syntax-local-identifier-as-binding
- (syntax-local-introduce #'here)))))
-
(define (make-named-scope nm)
(define name (if (symbol? nm) nm (string->symbol nm)))
(define E1
@@ -82,52 +77,24 @@
(datum->syntax #f 'zero)))
(datum->syntax #f 'zero)))
-(define (old-use-site-scope)
- (make-syntax-delta-introducer
- ((old-macro-scope) (syntax-local-introduce (datum->syntax #f 'zero)) 'remove)
- (datum->syntax #f 'zero)))
-
(define (convert-macro-scopes stx)
(if (sli-scopes)
- (let* ([macro (car (sli-scopes))]
- [use-site (cdr (sli-scopes))]
- [old-macro (old-macro-scope)]
- [old-use (old-use-site-scope)])
- ((compose (if (use-site-context?)
- (replace-scope old-use use-site)
- (λ (x) x))
- (replace-scope old-macro macro))
- stx))
+ (let* ([macro (sli-scopes)]
+ [old-macro (old-macro-scope)])
+ ((replace-scope old-macro macro) stx))
;; Otherwise leave unchanged.
stx))
(define ((named-transformer-wrap name f) stx)
- (parameterize ([sli-scopes
- (cons (make-named-scope (format "macro: ~a" name))
- (if (use-site-context?)
- (make-named-scope (format "use-site: ~a" name))
- (make-syntax-delta-introducer
- (datum->syntax #f 'zero)
- (datum->syntax #f 'zero))))])
+ (parameterize ([sli-scopes (make-named-scope (format "macro: ~a" name))])
;;; TODO: we should detect the presence of old-* here instead, and 'add them
- (displayln (+scopes stx))
- (displayln (use-site-context?))
- (displayln (+scopes (convert-macro-scopes stx)))
(let ([res (f (convert-macro-scopes stx))])
(when ((deep-has-scope (old-macro-scope)) res)
(error (format "original macro scope appeared within the result of a named transformer: ~a\n~a\n~a"
res
(+scopes res)
(with-output-to-string (λ () (print-full-scopes))))))
- (when (and (use-site-context?)
- ((deep-has-scope (old-use-site-scope)) res))
- (error "original use-site scope appeared within the result of a named transformer"))
- (let* ([/mm ((car (sli-scopes)) res 'flip)]
- [/mm/uu (if (use-site-context?) ((cdr (sli-scopes)) /mm 'flip) /mm)]
- [/mm/uu+m ((old-macro-scope) /mm/uu 'add)])
- (if (use-site-context?)
- ((old-use-site-scope) /mm/uu+m 'add)
- /mm/uu+m)))))
+ ((old-macro-scope) ((sli-scopes) res 'flip) 'add))))
(define-syntax-rule (named-transformer (name stx) . body)
(named-transformer-wrap 'name (λ (stx) . body)))
@@ -136,11 +103,5 @@
(define (-syntax-local-introduce stx)
(if (sli-scopes)
- ((cdr (sli-scopes)) ((car (sli-scopes)) stx 'flip)
- 'flip)
+ ((sli-scopes) stx 'flip)
(syntax-local-introduce stx)))
-
-(define (-syntax-local-identifier-as-binding stx)
- (if (and (sli-scopes) (use-site-context?))
- ((cdr (sli-scopes)) stx 'flip)
- (syntax-local-introduce stx)))
-\ No newline at end of file
diff --git a/test/named-scopes-test-use.rkt b/test/named-scopes-test-use.rkt
@@ -1,12 +1,8 @@
#lang racket
-(require ;"named-scopes-test-def.rkt"
- rackunit
- (for-syntax type-expander/debug-scopes
- ;debug-scopes/named-scopes
- ))
+(require "named-scopes-test-def.rkt"
+ rackunit)
-#|
(define r1 (foo-macro +))
(define r2 (let ([x 2])
(bar-macro x)))
@@ -19,14 +15,3 @@
(quux)))
(check-equal? (list r1 r2 r3 r4) (list + 2 3 +))
-|#
-
-(define-syntax (quux stx)
- (syntax-case stx ()
- [(_ m)
- (let ()
- (displayln (+scopes #'m))
- (displayln (+scopes (syntax-local-introduce #'+)))
- (print-full-scopes)
- (syntax-local-introduce #'+))]))
-(quux -)
-\ No newline at end of file
