www

commit e508ad1febcdabfa2d186af350a04bc79effdb98
parent d4e37ffaea88290b3b5d86e0713989bf0f66371b
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Sun, 29 Jan 2017 20:26:39 +0100

Bugfixes

Diffstat:
M
main.rkt
 | 
27
+++++++++++++++++----------
M
scribblings/scope-operations.scrbl
 | 
5
+++++

2 files changed, 22 insertions(+), 10 deletions(-)
diff --git a/main.rkt b/main.rkt
@@ -6,6 +6,7 @@
          (rename-out [→scopes ->scopes]
                      [→scopes* ->scopes*])
          empty-scopes
+         empty-scopes-syntax
          scopes-add
          scopes-remove
          scopes-flip
@@ -27,14 +28,18 @@
 (define scopes/c
   (->* (syntax?) ([or/c 'add 'remove 'flip]) syntax?))
 
+(define/contract empty-scopes-syntax
+  syntax?
+  (datum->syntax #f 'zero))
+
 (define/contract (→scopes stx)
   (-> syntax? scopes/c)
   (make-syntax-delta-introducer (datum->syntax stx 'stx)
-                                (datum->syntax #f 'zero)))
+                                empty-scopes-syntax))
 
 (define/contract empty-scopes
   scopes/c
-  (→scopes (datum->syntax #f 'zero)))
+  (→scopes empty-scopes-syntax))
 
 (define/contract (→scopes* stx)
   (-> (or/c syntax? scopes/c) scopes/c)
@@ -44,17 +49,17 @@
 
 (define/contract (scopes-add sc1 sc2)
   (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
-  (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes)
+  (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes-syntax)
                            'add)))
 
 (define/contract (scopes-remove sc1 sc2)
   (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
-  (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes)
+  (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes-syntax)
                            'remove)))
 
 (define/contract (scopes-flip sc1 sc2)
   (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
-  (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes)
+  (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes-syntax)
                            'flip)))
 
 (define/contract (scopes-intersect sc1 sc2)
@@ -68,24 +73,26 @@
 
 (define/contract (single-scope? sc)
   (-> (or/c syntax? scopes/c) boolean?)
-  (= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes))
+  (= (length (hash-ref (syntax-debug-info
+                        ((→scopes* sc) empty-scopes-syntax))
                        'context))
      1))
 
 (define/contract (zero-scopes? sc)
   (-> (or/c syntax? scopes/c) boolean?)
-  (= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes))
+  (= (length (hash-ref (syntax-debug-info
+                        ((→scopes* sc) empty-scopes-syntax))
                        'context))
      0))
 
 (define/contract (scopes-equal? sc1 sc2)
   (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?)
-  (bound-identifier=? ((→scopes* sc1) (datum->syntax #f 'test))
-                      ((→scopes* sc2) (datum->syntax #f 'test))))
+  (bound-identifier=? ((→scopes* sc1) empty-scopes-syntax)
+                      ((→scopes* sc2) empty-scopes-syntax)))
 
 (define/contract (scope-kind sc)
   (-> (and/c (or/c syntax? scopes/c) single-scope?) symbol?)
-  (define stx ((→scopes* sc) empty-scopes))
+  (define stx ((→scopes* sc) empty-scopes-syntax))
   (vector-ref (list-ref (hash-ref (syntax-debug-info stx) 'context) 0) 1))
 
 (define/contract (use-site-scope? sc)
diff --git a/scribblings/scope-operations.scrbl b/scribblings/scope-operations.scrbl
@@ -39,6 +39,11 @@
  @racketblock[(→scopes (datum->syntax #f 'zero))]
 }
 
+@defthing[empty-scopes-syntax]{
+ A syntax object with an empty set of scopes, as produced by:
+ @racketblock[(datum->syntax #f 'zero)]
+}
+
 @defproc[(scopes-add [sc1 (or/c syntax? scopes/c)]
                      [sc2 (or/c syntax? scopes/c)])
          scopes/c]{Set union of the given sets of scopes.}