From 61d4a48d384b96f72d9b07be285975220aa0fc7e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Wed, 14 Dec 2016 18:08:42 +0100
Subject: [PATCH] Removed naming of use-site scope, as it is handled specially
 by definition contexts.

---
 named-scopes/exptime.rkt       | 51 ++++------------------------------
 test/named-scopes-test-use.rkt | 19 ++-----------
 2 files changed, 8 insertions(+), 62 deletions(-)

diff --git a/named-scopes/exptime.rkt b/named-scopes/exptime.rkt
index 2941be2..6642666 100644
--- 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
index d7c8ed4..3518bb1 100644
--- 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