www

commit c76663a68930e4832a680b3c49ad4bb07d5af571
parent b38676e7f105c22958742d673af85dfbd781deec
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Sun, 29 Jan 2017 20:03:06 +0100

Added zero-scopes? scopes-equal? has-all-scopes? has-any-scope?

Diffstat:
M
main.rkt
 | 
38
+++++++++++++++++++++++++++++++-------
M
scribblings/scope-operations.scrbl
 | 
25
++++++++++++++++++++++++-

2 files changed, 55 insertions(+), 8 deletions(-)
diff --git a/main.rkt b/main.rkt
@@ -12,13 +12,17 @@
          scopes-intersect
          (rename-out [scopes-flip scopes-symmetric-difference])
          single-scope?
+         zero-scopes?
+         scopes-equal?
          scope-kind
          use-site-scope?
          macro-scope?
          module-scope?
          intdef-scope?
          local-scope?
-         top-scope?)
+         top-scope?
+         has-all-scopes?
+         has-any-scope?)
 
 (define scopes/c
   (->* (syntax?) ([or/c 'add 'remove 'flip]) syntax?))
@@ -65,7 +69,19 @@
 (define/contract (single-scope? sc)
   (-> (or/c syntax? scopes/c) boolean?)
   (= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes))
-                       'context))))
+                       'context))
+     1))
+
+(define/contract (zero-scopes? sc)
+  (-> (or/c syntax? scopes/c) boolean?)
+  (= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes))
+                       '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))))
 
 (define/contract (scope-kind sc)
   (-> (and/c (or/c syntax? scopes/c) single-scope?) symbol?)
@@ -92,9 +108,18 @@
   (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
   (eq? (scope-kind sc) 'local))
 
-;; Untested, I've seen this once, but can't remember where exactly. I think it
-;; occured while expanding a module with local-expand, and injecting the
-;; expanded body somewhere else.
+;; This appears on the #'module identifier itself, when expanding a module
+;; Run the macro stepper on an empty #lang racket program, and click on the
+;; #'module identifier, then on the "syntax object" tab to see it.
+;; (Stepper → View syntax properties to enable the "syntax object" tab).
 (define/contract (top-scope? sc)
   (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
-  (eq? (scope-kind sc) 'top))
-\ No newline at end of file
+  (eq? (scope-kind sc) 'top))
+
+(define/contract (has-all-scopes? sc1 sc2)
+  (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?)
+  (zero-scopes? (scopes-remove sc2 sc1)))
+
+(define/contract (has-any-scope? sc1 sc2)
+  (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) boolean?)
+  (not (zero-scopes? (scopes-intersect sc1 sc2))))
diff --git a/scribblings/scope-operations.scrbl b/scribblings/scope-operations.scrbl
@@ -71,10 +71,22 @@
          scopes/c]{Set intersection of the given sets of scopes.}
 
 
-@defproc[(single-scope? [sc (or/c syntax? scopes/c)]) boolean?]{
+@defproc[(single-scopes? [sc (or/c syntax? scopes/c)]) boolean?]{
  Predicate which returns @racket[#true] iff the given set of scopes contains
  only a single scope.}
 
+@defproc[(zero-scope? [sc (or/c syntax? scopes/c)]) boolean?]{
+ Predicate which returns @racket[#true] iff the given set of scopes contains
+ no scopes (e.g. because sc has been created with
+ @racket[(datum->syntax #f 'id)]).}
+
+@defproc[(scopes-equal? [sc1 (or/c syntax? scopes/c)]
+                        [sc2 (or/c syntax? scopes/c)]) boolean?]{
+ Predicate which returns @racket[#true] iff the two given sets of scopes contain
+ the same scopes. It is a generalised form of @racket[bound-identifier=?], which
+ also works for scopes represented as functions like the ones created by
+ @racket[make-syntax-introducer] and @racket[make-syntax-delta-introducer].}
+
 @defproc[(scope-kind [sc (and/c (or/c syntax? scopes/c) single-scope?)])
          symbol?]{
  Returns the kind of the single scope in @racket[sc]. To my knowledge, this
@@ -93,3 +105,13 @@
          boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'local)]}
 @defproc[(top-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
          boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'top)]}
+
+@defproc[(has-all-scopes? [sc1 (or/c syntax? scopes/c)]
+                      [sc2 (or/c syntax? scopes/c)]) boolean?]{
+ Predicate which returns @racket[#true] iff all the scopes contained within the
+ set of scopes @racket[sc1] are present in the set of scopes @racket[sc2].}
+
+@defproc[(has-any-scope? [sc1 (or/c syntax? scopes/c)]
+                         [sc2 (or/c syntax? scopes/c)]) boolean?]{
+ Predicate which returns @racket[#true] iff any of the scopes contained within
+ the set of scopes @racket[sc1] are present in the set of scopes @racket[sc2].}
+\ No newline at end of file